Re: Floyd Warshall

On Aug 30, 3:39 am, andrea <kerny...@xxxxxxxxx> wrote:
On 30 Ago, 02:02, Gene <gene.ress...@xxxxxxxxx> wrote:





On Aug 29, 6:27 pm, andrea <kerny...@xxxxxxxxx> wrote:

In a few words I have to find the minimum distance between many
cities, where
(get-dist c1 c2)
tells me the distance (100 if there are no direct path).

This is the algorithm

(defun floyd-warshall ()
"crea una tabella n*n con le distanze piu brevi fra le citta"
;; primo ciclo imposta i collegamenti diretti fra le citta (k == 0)
;; citta con se stesse
(setq min-dist nil)
(dolist (c1 cities)
(let*
((pos (position c1 cities)) ;; in questo modo minimizzo le chiamate a
get-dist
(sublist (drop pos cities)))
(dolist (c2 sublist)
(add-to-min-dist c1 c2 (list c2) 0 (get-dist c1 c2))))) ;; add-to-min-
dist aggiunge anche al simmetrico
;; ora vado iterativamente a calcolare tutte le distanze minime
(do
((k 1 (incf k)))
((equal k (length cities)))
(dolist (c1 cities)
;; (let*
;; ((pos (position c1 cities :test 'equal)) ;; in questo modo
minimizzo le chiamate a get-dist
;; (sublist (drop (1+ pos) cities)))
(dolist (c2 cities)
(let*
((direct (get-min-path c1 c2 (1- k)))
(before (get-min-path c1 (nth (1- k) cities) (1- k)))
(after (get-min-path (nth (1- k) cities) c2 (1- k)))
(total (cons (append (car after) (car before)) (+ (cdr before)
(cdr after)))))
(if
(<= (cdr direct) (cdr total)) ;; preferisco i percorsi diretti
;; il percorso diretto per k-1 nodi e' il piu breve
(add-to-min-dist c1 c2 (car direct) k (cdr direct))
;; percorso con una tappa
;;TODO aggiustare questo stupido problema di indici
(add-to-min-dist c1 c2 (car total) k (cdr total))))))))

And it almost works, but sometimes it doesn't find the shortest route,
and I don't really understand why...

This is the implementation of the min-dist table (hash-table)

(defun add-to-min-dist (src dst infra k dist)
"aggiunge una riga alla tabella"
(let
((key1 (list src dst k)) (key2 (list dst src k))
(val (cons infra dist)))
(cond
((null min-dist)
(setq min-dist (make-hash-table :test 'equal))
(add-to-min-dist src dst infra k dist))
(t (setf (gethash key1 min-dist) val)
(if (not (equal src dst))
(setf (gethash key2 min-dist) val))))))

(defun get-min-path (src dst k)
"prende dalla tabella di hash"
(gethash (list src dst k) min-dist))

Any suggestion (even for style) is welcome...

PS. I just trasnlated this algorithm
floyd-warshall(W):
n = rows[W]
D(0) = W
for k in (1,n):
for i in (1,n):
for j in (1,n):
dij(k) = min(dij(k-1),***(k-1)+dkj(k-1))

and I don't see where is the mistake..

Well, when this happens, you have two ways to proceed.

Method 1: you can very carefully review the code to find where it
diverges from the spec. It sounds like you tried that. Either you
didn't try hard enough, or your skills aren't at the right level.

Method 2: Find a small case that fails. Work it by hand or with
another program. Add tracing code or use a debugger to find the point
where your program diverges from the correct internal values. Study
that point to figure out where your code goes wrong.

Your post is a bit unfair. You are asking people to use Method 1 with
no prior knowledge. That's asking a lot. If you provided runnable
code and a small failing test case, you'd be more likely to get a
useful answer.

Yes you're right, I just didn't want to post too much code, because
the whole program looks for a path and before parses the data
(distances cities etc etc) from a file.

I'll see if I can make it executable without posting everything.



As to style, this is pretty crufty. It apparently relies on special
(global) variables we can't see, and nothing is encapsulated. It's
probably more efficient to assign indices to cities initially (with a
hash-array mapping pair) and do the computation with matrices rather
than hashes. Certainly this way the code will end up looking a lot
more like the spec. Finally, I can't see any reason to keep all of
the intermediate "k" values around. The usual implementation destroys
iteration k-1 to create k.

What do you mean for encapsulated?
The only global variables here are only "cities" and "min-dist".
I know this is not very clever, but I dind't want to pass a thousand
arguments for every function...
Is there a way to fix the problem without having too many arguments??

Thanks for now- Hide quoted text -

- Show quoted text -

You want to write code so that if tomorrow you need to do 2 or 2000 sp
analyses side-by-side in the same program, you don't have to rewrite
anything. So-called "object-oriented languages" encourage this, but
you don't need them if you think the right way. Here's some code to
show what I mean. The structs encapsulate maps and shortest path
databases.

;;; bijective map between cities and indices
(defstruct (city-index-map (:constructor raw-city-index-map))
to-index ;; hash taking cities to indices
to-city) ;; vector taking indices to cities

;;; construct a map from a list of cities
(defun make-city-index-map (cities)
(do ((to-city (coerce cities 'simple-vector))
(to-index (make-hash-table :test #'equal))
(i 0 (1+ i))
(rest-of-cities cities (cdr rest-of-cities)))
((null rest-of-cities) ; stop when no more cities
(raw-city-index-map :to-index to-index ; return the map
:to-city to-city))
(setf (gethash (car rest-of-cities) to-index) i)))

;;; return the index of given city
(defun to-index (map city)
(gethash city (city-index-map-to-index map)))

;;; return the city for a given index
(defun to-city (map index)
(svref (city-index-map-to-city map) index))

;;; database of shortest path info
(defstruct (shortest-path-db (:constructor raw-shortest-path-db))
dist ;; distance matrix
inter ;; intermediate city matrix
map) ;; map between cities and indices

;;; set one element of a city-city matrix
(defun set-elt (matrix map city-a city-b value)
(setf (aref matrix (to-index map city-a) (to-index map city-b))
value))

;;; addition where nil means positive infinity
(defun nil-inf-+ (a b)
(cond ((or (null a) (null b)) nil)
(t (+ a b))))

;;; less than test where nil means positive infinity
(defun nil-inf-< (a b)
(cond ((null a) nil)
((null b) t)
(t (< a b))))

;;; do a floyd-warshall update
(defun update (dist inter i j k)
(let ((through-k-dist (nil-inf-+ (aref dist i k) (aref dist k j))))
(when (nil-inf-< through-k-dist (aref dist i j))
(setf (aref dist i j) through-k-dist
(aref inter i j) k))))

;;; make a database of shortest paths
;;; distances are given as a list of ("city A" "city B" distance)
triples
(defun make-shortest-path-db (distances &key undirected-p)
(let* ((cities (sort (delete-duplicates
(mapcan #'(lambda (x) (subseq x 0 2))
distances)
:test #'equal)
#'string-lessp))
(n-cities (length cities))
(map (make-city-index-map cities))
(dist (make-array `(,n-cities ,n-cities)))
(inter (make-array `(,n-cities ,n-cities))))

;; set up directed distances
(loop for (city-a city-b distance) in distances
do (set-elt dist map city-a city-b distance)
when undirected-p
do (set-elt dist map city-b city-a distance))

;; zero the diagonal
(dotimes (i n-cities)
(setf (aref dist i i) 0))

;; floyd-warshall "matrix multiplication"
(dotimes (k n-cities)
(dotimes (i n-cities)
(dotimes (j n-cities)
(update dist inter i j k))))

;; return the database
(raw-shortest-path-db :dist dist :inter inter :map map)))

;;; retrieve a path from the database using indices
(defun shortest-path (db i j)
(labels ((sp (i j tail) ;; return shortest i->j path omitting i,
appending tail
(let ((inter (aref (shortest-path-db-inter db) i j)))
(cond ((= i j) tail)
((null inter) (cons j tail))
(t (sp i inter (sp inter j tail)))))))
(cons i (sp i j nil))))

;;; retrieve a path from the database using names
(defun shortest-path-by-name (db city-i city-j)
(let ((map (shortest-path-db-map db)))
(mapcar #'(lambda (x) (to-city map x))
(shortest-path db (to-index map city-i) (to-index map city-j)))))

(defun test ()
(let* ((distances '(("A" "B" 3)
("A" "C" 8)
("A" "E" -4)
("B" "D" 1)
("B" "E" 7)
("C" "B" 4)
("D" "A" 2)
("D" "C" -5)
("E" "D" 6)))
(db (make-shortest-path-db distances)))
(format t "db: ~a~%" db)
(dolist (i '("A" "B" "C" "D" "E"))
(dolist (j '("A" "B" "C" "D" "E"))
(format t "~a -> ~a: ~a~%" i j (shortest-path-by-name db i j))))))

.

Quantcast