1
\$\begingroup\$

As a free-time activity in order to learn some Lisp I had to implement depth first directed graph search. Due to large graph size (800K nodes, 5M arcs) recursion-based approach I could devise didn't work.

Below is my stack-based implementation that I would like to improve in terms of readability if nothing else. Any comments on style, use of Lisp idioms, code smell are welcome.

(defun depth-first-search (adjacency-array visit-function &optional (init-function nil init-function-supplied-p))
  (let* ((num-nodes (array-dimension adjacency-array 0))
         (init most-negative-fixnum)
         (nodes-seen (make-array num-nodes :element-type 'fixnum :initial-element init))
         (results (make-array num-nodes :element-type 'fixnum :initial-element init)))
    (labels ((visited-p (node) (not (eql init (aref results (1- node)))))
             (seen-p (node) (not (eql init (aref nodes-seen (1- node)))))
             (mark-seen (node) (setf (aref nodes-seen (1- node)) 1))
             (mark-visited (node)  (setf (aref results (1- node)) (funcall visit-function)))
             (visit (node)
               (unless (visited-p node)
                 (when init-function-supplied-p (funcall init-function node))
                 (mark-seen node)
                 (loop with stack = (list node)
                       until (null stack)
                       for head = (first stack)
                       for tails = (aref adjacency-array (1- head)) 
                       for fresh-tails = (unless (visited-p head) 
                                           (loop for tail in tails
                                                 unless (or (visited-p tail)
                                                            (seen-p tail))
                                                 collect tail))
                       do (if fresh-tails 
                            (progn
                              (mapcar #'mark-seen fresh-tails)
                              (setq stack (append fresh-tails stack)))
                            (progn
                              (pop stack)
                              (unless (visited-p head) (mark-visited head))))))))
      (loop for node from 1 to num-nodes
            unless (or (null node)
                     (visited-p node))
            do (visit node)
            finally (return results)))))

Some details:

  • adjacency-array for a graph 1->2;1->3;3->1 would be #((2 3) nil (1)).
  • visit-function returns a "visited" value for a node.
  • init-function makes necessary actions when new subgraph search starts.
\$\endgroup\$
1
\$\begingroup\$

This usage of LOOP is not supported by ANSI Common Lisp. You can't have an UNTIL clause (only in a main clause in LOOP syntax) before a FOR clause (a variable clause).

See: Macro LOOP.

\$\endgroup\$
0
\$\begingroup\$

If-else functionality is build-it into loop (no way).

This fragment inside the loop can be rewritten:

do (if fresh-tails 
     (progn
       (mapcar #'mark-seen fresh-tails)
       (setq stack (append fresh-tails stack)))
     (progn
       (pop stack)
       (unless (visited-p head) (mark-visited head))))

Using loop's if-else:

if fresh-tails do
  (mapcar #'mark-seen fresh-tails)
  (setq stack (append fresh-tails stack))                       
else do
  (pop stack)
  (unless (visited-p head) (mark-visited head))

Less clutter, however requires manual formatting.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.