Gameplay and Artificial Intelligence Programmer




Dijkstra’s Algorithm in LISP

Category : Uncategorized May 5th, 2014

Here’s something nice and computer sciency for a change.

Dijkstra’s Algorithm solves the shortest path problem for a graph with non-negative edge path costs. It’s a very helpful algorithm for routing and other graph traversal problems.  The graph is represented by edges with a cost for each.

(node node cost)

(defparameter *nodes*

'((a b 2)

(a c 6)

(b c 5)

(b d 1)

(c d 7)

(d e 12)

(e f 4)

(d f 5)

(f g 8)

(f z 8)

(y u 7)))

And called by:

(return_cheapest_path (start_node end_node graph))

Which will return the cost of the cheapest path from the start node to the end node.

Here’s the description of how the algorithm works from wikipedia. Further comments are in the code.

Let the node at which we are starting be called the initial node. Let the distance of node Y be the distance from the initial node to Y. Dijkstra’s algorithm will assign some initial distance values and will try to improve them step by step.

  1. Assign to every node a tentative distance value: set it to zero for our initial node and to infinity for all other nodes.
  2. Mark all nodes unvisited. Set the initial node as current. Create a set of the unvisited nodes called the unvisited set consisting of all the nodes.
  3. For the current node, consider all of its unvisited neighbors and calculate their tentative distances. Compare the newly calculated tentative distance to the current assigned value and assign the smaller one. For example, if the current node A is marked with a distance of 6, and the edge connecting it with a neighbor B has length 2, then the distance to B (through A) will be 6 + 2 = 8. If B was previously marked with a distance greater than 8 then change it to 8. Otherwise, keep the current value.
  4. When we are done considering all of the neighbors of the current node, mark the current node as visited and remove it from the unvisited set. A visited node will never be checked again.
  5. If the destination node has been marked visited (when planning a route between two specific nodes) or if the smallest tentative distance among the nodes in the unvisited set is infinity (when planning a complete traversal; occurs when there is no connection between the initial node and remaining unvisited nodes), then stop. The algorithm has finished.
  6. Select the unvisited node that is marked with the smallest tentative distance, and set it as the new “current node” then go back to step 3.

;;Returns all nodes.

(defun get_initial_uncon_nodes_helper (flat_list accum)

(cond

((null flat_list) accum)

((atom flat_list) accum)

(t (get_initial_uncon_nodes_helper (cdddr flat_list) (cons (first flat_list) (cons (cadr flat_list) accum))))

))

(defun get_initial_uncon_nodes (start_node nodes)

(let ((flatten_nodes (flat nodes nil)))

(remove start_node (remove_dupes (get_initial_uncon_nodes_helper flatten_nodes nil) nil))

))

(defun get_all_connected (curr nodes repeat result)

(cond

((> repeat 100) (remove_dupes(flat(remove_dupes result nil)nil)nil))

(t (get_all_connected (first (get_neighbours curr nodes nil)) nodes (1+ repeat) (cons (get_neighbours curr nodes nil) result)))

))

;;Returns cost of vertex between given nodes.

(defun get_cost (node1 node2 nodes)

(cond

((null nodes) nil)

(t (let ((curr_tuple (first nodes)))

(cond

((and (eq (first curr_tuple) node1) (eq (cadr curr_tuple) node2)) (caddr curr_tuple))

((and (eq (first curr_tuple) node2) (eq (cadr curr_tuple) node1)) (caddr curr_tuple))

(t (get_cost node1 node2 (rest nodes)))

)))))

;;Returns all connected nodes.

(defun get_neighbours (curr_node nodes accum)

(cond

((null nodes) accum)

(t (let ((curr_tuple (first nodes)))

(cond

((eq (first curr_tuple) curr_node) (get_neighbours curr_node (rest nodes) (cons (cadr curr_tuple) accum)))

((eq (cadr curr_tuple) curr_node) (get_neighbours curr_node (rest nodes) (cons (first curr_tuple) accum)))

(t (get_neighbours curr_node (rest nodes) accum))

)))))

;;Returns neighbours not passed in connected_nodes

(defun get_neighbours_unconnected(curr_node nodes connected_nodes)

(let ((neighbours (get_neighbours curr_node nodes nil)))

(remove_many_items connected_nodes neighbours)

))

;;Returns the cheapest neighbour not in the visited_nodes list.

(defun get_cheapest_neighbour_helper(start_node nodes neighbours cheapest_node)

(cond

((null neighbours) cheapest_node)

(t (let ((curr_node (first neighbours)) (curr_cost (get_cost start_node (first neighbours) nodes)))

(if (< curr_cost (get_cost start_node cheapest_node nodes))

(get_cheapest_neighbour_helper start_node nodes (rest neighbours) curr_node)

(get_cheapest_neighbour_helper start_node nodes (rest neighbours) cheapest_node)

)))))

(defun get_cheapest_neighbour(curr_node nodes visited_nodes)

(let ((neighbours (remove_many_items visited_nodes (get_neighbours curr_node nodes nil))))

(get_cheapest_neighbour_helper curr_node nodes neighbours (first neighbours))

))

(defun check_neighbours_and_update_helper (curr_node neighbours nodes connected_nodes unconnected_nodes desired_tree tentative_cost predecessors)

(cond

((null neighbours) (dijkstra nodes connected_nodes unconnected_nodes desired_tree tentative_cost predecessors))

(t (let ((new_cost (+( rest (assoc curr_node tentative_cost)) (get_cost curr_node (first neighbours) nodes))) (old_cost (rest (assoc (first neighbours) tentative_cost))))

(cond

((null old_cost) (check_neighbours_and_update_helper curr_node (rest neighbours) nodes connected_nodes unconnected_nodes desired_tree (acons (first neighbours) new_cost tentative_cost) (acons (first neighbours) curr_node predecessors)))

((< new_cost old_cost) (check_neighbours_and_update_helper curr_node (rest neighbours) nodes connected_nodes unconnected_nodes desired_tree (acons (first neighbours) new_cost tentative_cost) (acons (first neighbours) curr_node predecessors)))

(t (check_neighbours_and_update_helper curr_node (rest neighbours) nodes connected_nodes unconnected_nodes desired_tree tentative_cost predecessors))

)))))

(defun check_neighbours_and_update (curr_node nodes connected_nodes unconnected_nodes desired_tree tentative_cost predecessors)

(let ((neighbour_list (get_neighbours_unconnected curr_node nodes connected_nodes)))

(check_neighbours_and_update_helper curr_node neighbour_list nodes connected_nodes unconnected_nodes desired_tree tentative_cost predecessors)

))

(defun get_next_node_helper(unconnected_nodes tentative_cost chosen_node)

(cond

((null unconnected_nodes) chosen_node)

(t (let ((curr_node (first unconnected_nodes)))

(if (null (first (assoc curr_node tentative_cost)))

(get_next_node_helper (rest unconnected_nodes) tentative_cost chosen_node)

(let ((curr_cost (rest (assoc curr_node tentative_cost))))

(cond

((null chosen_node) (get_next_node_helper (rest unconnected_nodes) tentative_cost curr_node))

((null curr_cost) (get_next_node_helper (rest unconnected_nodes) tentative_cost chosen_node))

((<= curr_cost (rest (assoc chosen_node tentative_cost))) (get_next_node_helper (rest unconnected_nodes) tentative_cost curr_node))

(t (get_next_node_helper (rest unconnected_nodes) tentative_cost chosen_node))

)))))))

(defun get_next_node (unconnected_nodes tentative_cost)

(get_next_node_helper unconnected_nodes tentative_cost nil))

(defun dijkstra (nodes connected_nodes unconnected_nodes desired_tree tentative_cost predecessors)

(cond

((null unconnected_nodes) (cons desired_tree tentative_cost))

(t (let ((cheapest_neighbour (get_next_node unconnected_nodes tentative_cost)))

(let (( new_desired_tree (cons (cons cheapest_neighbour (rest (assoc cheapest_neighbour predecessors))) desired_tree)))

(check_neighbours_and_update cheapest_neighbour nodes (cons cheapest_neighbour connected_nodes) (remove cheapest_neighbour unconnected_nodes) new_desired_tree tentative_cost predecessors)

)))))

(defun cheapest_paths_no_formatting (start_node nodes)

(let ((connected_nodes (cons start_node nil))

(unconnected_nodes (get_all_connected start_node nodes 0 nil))

(desired_tree nil)

(tentative_cost (acons start_node 0 nil))

(predecessors (acons start_node nil nil)))

(check_neighbours_and_update start_node nodes connected_nodes unconnected_nodes desired_tree tentative_cost predecessors)

))

(defun get_tentative_cost (node1 node2 tentative_cost)

(let ((cost1 (rest (assoc node1 tentative_cost))) (cost2 (rest (assoc node2 tentative_cost))))

(if (> cost1 cost2) cost1 cost2)

))

;;Formatting Final Answer

(defun return_highers_helper (list element result)

(cond

((null list) result)

((equalp (first element) (first (first list)))

(cond

((< (rest element) (rest(car list))) (return_highers_helper (cdr list) element (cons (car list) result)))

(t (return_highers_helper (cdr list) element result))

))

(t (return_highers_helper (cdr list) element result))

))

(defun strip_highers (list fulllist result)

(cond

((null list) result)

((strip_highers (cdr list) fulllist (return_highers_helper fulllist (first list) result)))

))

(defun remove_listp_items_helper (item list result)

(cond

((null list) result)

((if (and (equalp (car item) (car (car list))) (eq (rest item) (rest (first list)))) (remove_listp_items_helper item (cdr list) result)))

(t (remove_listp_items_helper item (cdr list) (cons (car list) result)))

)

)

(defun remove_listp_items (items_to_remove list_to_remove_from)

(cond

((null items_to_remove) list_to_remove_from)

(t (remove_listp_items (cdr items_to_remove) (remove_listp_items_helper (car items_to_remove) list_to_remove_from nil)))

))

(defun return_all_cheapest_paths (start_node nodes)

(let ((result_list (rest (cheapest_paths_no_formatting start_node nodes))))

(remove_listp_items (strip_highers result_list result_list nil) result_list)

))

(defun return_cheapest_path_helper (result_list end_node)

(cond

((null result_list) nil)

((equalp end_node (car (car result_list))) (cdr (car result_list)))

(t (return_cheapest_path_helper (cdr result_list) end_node))

))

(defun return_cheapest_path (start_node end_node nodes)

(let ((result_list (return_all_cheapest_paths start_node nodes)))

(return_cheapest_path_helper result_list end_node)

))

;;Helper Functions

(defun get_from_index (index list current_index)

(cond

((eq index current_index) (first list))

((minusp index) nil)

((eq (length list) current_index) nil)

(t (get_from_index index (rest list) (+ 1 current_index)))

))

(defun contains (element list)

(cond

((null list) nil)

((equal element (first list)) t)

(t (contains element (rest list)))

))

(defun flat(x y)

(cond

((null x) y)

((atom x) (cons x y))

(t (flat (first x) (flat (rest x) y)))

))

(defun flatten (li)

(cond ((null li) nil)

((listp li) `(,li) )

(t (mapcan #'flatten li))))

(defun remove_dupes (x y)

(cond

((null x) y)

(t (if (contains (first x) y) (remove_dupes (rest x) y) (remove_dupes (rest x) (cons (first x) y))))

))

(defun remove_many_items (items_to_remove list_of_elements)

(cond

((null items_to_remove) list_of_elements)

(t (remove_many_items (rest items_to_remove) (remove (first items_to_remove) list_of_elements)))

))

SHARE :