Topic: Daily Info
Here's that wicked homework I was working on.
Note: I absolve myself of any guarantees about this code, except that is you use it in a homework assignment without giving me full credit, you are plagiarizing my code. I am coverning my ass against academic dishonesty, as this assingment was due Friday, March 11, 2005.
Now that those pleasantries are over, on to some LISPy goodness:
;;Builds a structure from which we can glena information about the minimum
;;spanning tree
(defun build-mst-struct (map)
(if (eql map '())
'()
(cons (cons (caar map) (cons 'INFINITY 'NOPRED))
(build-mst-struct (cdr map)))))
;;Determines if some symbol is in the map, used in the actual Prim's MST
;;algorithm
(defun in-map-list (map symbol)
(if (eql map '())
'()
(if (eql (caar map) symbol)
T
(in-map-list (cdr map) symbol))))
;;Sets both the key and the predecessor of a node in one shot to save excess
;;tree traversal
(defun set-key-pred-helper (node keyval predval)
(setf (cadr node) keyval)
(setf (cddr node) predval)
keyval)
;;Finds symbol in mst-struct and sets its key=keyval and predecssor=predval
(defun set-key-pred (symbol keyval predval mst-struct)
(if (eql mst-struct '())
'()
(if (eql (caar mst-struct) symbol)
(set-key-pred-helper (car mst-struct) keyval predval)
(set-key-pred symbol keyval predval (cdr mst-struct)))))
;;Used to extract the adjaceny list from the topmost node of the map
(defun pull-adj-list (map)
(car (cddr (car map))))
;;Determines the weight of the edge of the first node in the adjacency list
(defun adj-weight (adj-list)
(cdar adj-list))
;;Retrieves the key associated with symbol in the mst-struct
(defun get-key (symbol mst-struct)
(if (eql mst-struct '())
'()
(if (eql (caar mst-struct) symbol)
(cadar mst-struct)
(get-key symbol (cdr mst-struct)))))
;;My work-around since I didn't know if LISP had the concept of infinity
;;I have defined my own infinity symbol and this checks first to see if
;;keyval is infinite (from Prim's setup) and if not, compares against the
;;passed in weight
(defun weight-less-than-key (weight keyval)
(if (eql keyval 'INFINITY)
T
(< weight keyval)))
(defun set-and-loop (symbol keyval predval map mst-struct adj-list)
(set-key-pred symbol
keyval
predval
mst-struct)
(proc-adj-list mst-struct map (cdr adj-list)))
;;This is the inner loop of Prim's algorithm
(defun proc-adj-list (mst-struct map adj-list)
(if (eql adj-list '())
'()
;;Checking if the next node in the adjanceny list is still in Q
;;If not, we can move onto the next node
(if (not (in-map-list map (caar adj-list)))
(proc-adj-list mst-struct map (cdr adj-list))
;;The node in the adjancency list was in the map still, so no we
;;Do the meat of Prim's, check w(u,v) < key[v]
(if (weight-less-than-key (adj-weight adj-list)
(get-key (caar adj-list) mst-struct))
(set-and-loop (caar adj-list)
(adj-weight adj-list)
(caar map)
map
mst-struct
adj-list)))))
;;This is the main worker of Prim's Algorithm
(defun mst-worker-loop (mst-struct map)
(proc-adj-list mst-struct map (pull-adj-list map))
(mst-worker mst-struct (cdr map)))
(defun mst-worker (mst-struct map)
(if (eql map '())
mst-struct
(mst-worker-loop mst-struct map)))
;;Finally the main mst
(defun mst (map)
(setf mst-struct (build-mst-struct map))
(mst-worker mst-struct map))
(defun mst-cost (to-visit map)
(defun mst-helper (to-visit mst-struct)
(if (eql to-visit '())
0
(+ (get-key (car to-visit) mst-struct)
(mst-helper (cdr to-visit) mst-struct))))
(mst-helper to-visit (mst map)))
Crazy, ain't it?