Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

188 lines (157 sloc) 5.59 kB
;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and
;; distribution terms for this software are covered by the Eclipse Public
;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
;; be found in the file epl-v10.html at the root of this distribution. By
;; using this software in any fashion, you are agreeing to be bound by the
;; terms of this license. You must not remove this notice, or any other,
;; from this software.
;;
;; test-graph
;;
;; Basic Graph Theory Algorithms Tests
;;
;; straszheimjeffrey (gmail)
;; Created 23 June 2009
(ns clojure.contrib.test-graph
(use clojure.test
clojure.contrib.graph))
(def empty-graph (struct directed-graph #{} {}))
(def test-graph-1
(struct directed-graph
#{:a :b :c :d :e}
{:a #{:b :c}
:b #{:a :c}
:c #{:d :e}
:d #{:a :b}
:e #{:d}}))
(deftest test-reverse-graph
(is (= (reverse-graph test-graph-1)
(struct directed-graph
#{:a :b :c :d :e}
{:c #{:b :a}
:e #{:c}
:d #{:c :e}
:b #{:d :a}
:a #{:d :b}})))
(is (= (reverse-graph (reverse-graph test-graph-1))
test-graph-1))
(is (= (reverse-graph empty-graph) empty-graph)))
(deftest test-add-loops
(let [tg1 (add-loops test-graph-1)]
(is (every? (fn [n] (contains? (get-neighbors tg1 n) n)) (:nodes tg1))))
(is (= (add-loops empty-graph) empty-graph)))
(deftest test-remove-loops
(let [tg1 (remove-loops (add-loops test-graph-1))]
(is (not-any? (fn [n] (contains? (get-neighbors tg1 n) n)) (:nodes tg1))))
(is (= (remove-loops empty-graph) empty-graph)))
(def test-graph-2
(struct directed-graph
#{:a :b :c :d :e :f :g :h :i :j}
{:a #{:b :c}
:b #{:a :c}
:c #{:d :e}
:d #{:a :b}
:e #{:d}
:f #{:f}
:g #{:a :f}
:h #{}
:i #{:j}
:j #{:i}}))
(deftest test-lazy-walk
(is (= (lazy-walk test-graph-2 :h) [:h]))
(is (= (lazy-walk test-graph-2 :j) [:j :i])))
(deftest test-transitive-closure
(let [tc-1 (transitive-closure test-graph-1)
tc-2 (transitive-closure test-graph-2)
get (fn [n] (set (get-neighbors tc-2 n)))]
(is (every? #(= #{:a :b :c :d :e} (set %))
(map (partial get-neighbors tc-1) (:nodes tc-1))))
(is (= (get :a) #{:a :b :c :d :e}))
(is (= (get :h) #{}))
(is (= (get :j) #{:i :j}))
(is (= (get :g) #{:a :b :c :d :e :f}))))
(deftest test-post-ordered-nodes
(is (= (set (post-ordered-nodes test-graph-2))
#{:a :b :c :d :e :f :g :h :i :j}))
(is (empty? (post-ordered-nodes empty-graph))))
(deftest test-scc
(is (= (set (scc test-graph-2))
#{#{:h} #{:g} #{:i :j} #{:b :c :a :d :e} #{:f}}))
(is (empty? (scc empty-graph))))
(deftest test-component-graph
(let [cg (component-graph test-graph-2)
ecg (component-graph empty-graph)]
(is (= (:nodes cg) (set (scc test-graph-2))))
(is (= (get-neighbors cg #{:a :b :c :d :e})
#{#{:a :b :c :d :e}}))
(is (= (get-neighbors cg #{:g})
#{#{:a :b :c :d :e} #{:f}}))
(is (= (get-neighbors cg #{:i :j})
#{#{:i :j}}))
(is (= (get-neighbors cg #{:h})
#{}))
(is (= (apply max (map count (self-recursive-sets cg))) 1))
(is (= ecg empty-graph))))
(deftest test-recursive-component?
(let [sccs (scc test-graph-2)]
(is (= (set (filter (partial recursive-component? test-graph-2) sccs))
#{#{:i :j} #{:b :c :a :d :e} #{:f}}))))
(deftest test-self-recursive-sets
(is (= (set (self-recursive-sets test-graph-2))
(set (filter
(partial recursive-component? test-graph-2)
(scc test-graph-2)))))
(is (empty? (self-recursive-sets empty-graph))))
(def test-graph-3
(struct directed-graph
#{:a :b :c :d :e :f}
{:a #{:b}
:b #{:c}
:c #{:d}
:d #{:e}
:e #{:f}
:f #{}}))
(def test-graph-4
(struct directed-graph
#{:a :b :c :d :e :f :g :h}
{:a #{}
:b #{:a}
:c #{:a}
:d #{:a :b}
:e #{:d :c}
:f #{:e}
:g #{:d}
:h #{:f}}))
(def test-graph-5
(struct directed-graph
#{:a :b :c :d :e :f :g :h}
{:a #{}
:b #{}
:c #{:b}
:d #{}
:e #{}
:f #{}
:g #{:f}
:h #{}}))
(deftest test-dependency-list
(is (thrown-with-msg? Exception #".*Fixed point overflow.*"
(dependency-list test-graph-2)))
(is (= (dependency-list test-graph-3)
[#{:f} #{:e} #{:d} #{:c} #{:b} #{:a}]))
(is (= (dependency-list test-graph-4)
[#{:a} #{:b :c} #{:d} #{:g :e} #{:f} #{:h}]))
(is (= (dependency-list test-graph-5)
[#{:f :b :a :d :h :e} #{:g :c}]))
(is (= (dependency-list empty-graph)
[#{}])))
(deftest test-stratification-list
(is (thrown-with-msg? Exception #".*Fixed point overflow.*"
(stratification-list test-graph-2 test-graph-2)))
(is (= (stratification-list test-graph-4 test-graph-5)
[#{:a} #{:b :c} #{:d} #{:e} #{:f :g} #{:h}]))
(is (= (stratification-list empty-graph empty-graph)
[#{}])))
(comment
(run-tests)
)
;; End of file
Jump to Line
Something went wrong with that request. Please try again.