Warning: ob_start(): non-static method wpGoogleAnalytics::get_links() should not be called statically in /home/w01fe/w01fe.com/wordpress/wp-content/plugins/wp-google-analytics/wp-google-analytics.php on line 259
A Blog. » 2008 » December

Archive for December, 2008

Strongly Connected Components in (mostly?) idiomatic Clojure

A friend asked how to find strongly connected components in a graph in idiomatic Clojure. This is what I came up with:

(defn edge-list [g] 
  (mapcat (fn [[k v]] (map (partial vector k) v)) g)) 
(defn reverse-graph [g] 
  (reduce (fn [rev [from to]] (assoc rev to (cons from (get rev to)))) 
	  {} (edge-list g))) 
(import '(java.util HashSet))
(defn reduce-dfs-postorder-graph 
  ([g f init-val root] 
     (reduce-dfs-postorder-graph g f init-val root (HashSet.)))
  ([g f init-val root #^java.util.HashSet visited]
     (.add visited root)
     (f root (reduce (fn [val node] 
		       (if (.contains visited node) 
			 (reduce-dfs-postorder-graph g f val node visited))) 
		     init-val (get g root)))))
(defn kosaraju [g]
  (loop [reversed (reverse-graph g), 
	 s (reduce-dfs-postorder-graph g cons nil (ffirst g)), 
	 ccs nil, 
	 used #{}]
    (cond (empty? s)                 
	  (contains? used (first s)) 
            (recur reversed (rest s) ccs used)
            (let [cc (reduce-dfs-postorder-graph 
		      #(if (contains? used %1) %2 (cons %1 %2)) 
		      (first s))]
	       (apply dissoc reversed cc) 
	       (rest s) 
	       (cons cc ccs) 
	       (clojure.set/union used cc))))))
user> (kosaraju {:a '(:b :c) :b '(:c) :c '(:a :d) :d '(:e) :e '()})
((:e) (:d :c :b :a))

The only non-idiomatic part might be the use of a mutable HashMap in the reduce-dfs function. I used it because it makes the code clearer and faster than with immutable clojure maps; moreover, the mutability is safe since it’s all hidden within the execution of the function. But, I’m not sure if more seasoned users would share my aesthetic here.


Matching in Clojure

I was trying to write a PDDL parser in Clojure, and realized it could be handy to have something that does the opposite of `(~x ~@y). In other words, it takes a two versions of a syntax-tree, one with variables and one without, and returns the unique binding for the variables that will produce the given expansion (or throws an error otherwise). Here’s the code I came up with:

(defn match-vars   "Return a seq of the variables mentioned in the tree."
  (cond (not (coll? var-tree)) nil
	(= (first var-tree) 'unquote) [(second var-tree)]
	(and (coll? (first var-tree)) (= (ffirst var-tree) 'unquote-seq)) [(second (first var-tree))]
	:else (concat (match-vars (first var-tree)) (match-vars (rest var-tree)))))
(defn match-mapping "Return a map of variable bindings for this matching, or 
                     throw an error if a matching is not possible."
  [var-tree match-tree]
  (cond (not (coll? var-tree))
	  (when (not= var-tree match-tree)
	    (throw (Exception. (str "Bad Match: " var-tree " " match-tree))))
	(= (first var-tree) 'unquote)
	  {(second var-tree) match-tree}
	(and (coll? (first var-tree)) (= (ffirst var-tree) 'unquote-seq))
	  {(second (first var-tree)) match-tree}
	(not (coll? match-tree))
	  (throw (Exception. (str "Bad Match: " var-tree " " match-tree)))
	  (merge (match-mapping (first var-tree) (first match-tree))
		 (match-mapping (rest var-tree) (rest match-tree)))))	
(defmacro match "Take a var-tree with (unquote x) and (unquote-seq y) expressions
                 and match it with match-tree, binding these variables, and
                 throwing an exception if a valid matching cannot be found."
  [[var-tree match-tree] & body]
  (let [vars (match-vars var-tree) g (gensym)]
    `(let [~g (match-mapping '~var-tree ~match-tree)]
       (let ~(apply vector (mapcat #(vector % `(safe-get ~g '~%))  vars))
user> (match [[a [b [unquote-seq x]] [unquote y]] 
	     '[a [b c d] [c d e f]]] 
	[x y])
[(c d) [c d e f]]

In the future I think I’ll need to extend this to support unordered sets of subexpressions and optional subexpressions; if and when I write that code, I’ll post it here.

Update: Per this post on the group, Clojure now supports unquoting of unquoted expressions, so I’ll also be updating the match code to take advantage of this at some point.

Comments (4)