luciano/babashka
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add clojure.data.priority-map as built-in, support aysylu/loom lib (#1207)

Browse source
This commit is contained in:
Michiel Borkent 2022-03-11 12:23:31 +01:00 committed by GitHub
parent f9451f5de0
commit 3759d14baf
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
24 changed files with 1762 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
deps.edn
View file

@ -9,6 +9,7 @@
"feature-spec-alpha"
"feature-selmer"
"feature-logging"
"feature-priority-map"
"pods/src"
"babashka.nrepl/src"
"depstar/src" "process/src"
@ -40,7 +41,8 @@
rewrite-clj/rewrite-clj {:mvn/version "1.0.699-alpha"}
selmer/selmer {:mvn/version "1.12.44"}
com.taoensso/timbre {:mvn/version "5.1.2"}
org.clojure/tools.logging {:mvn/version "1.1.0"}}
org.clojure/tools.logging {:mvn/version "1.1.0"}
org.clojure/data.priority-map {:mvn/version "1.1.0"}}
:aliases {:babashka/dev
{:main-opts ["-m" "babashka.main"]}
:profile
@ -124,7 +126,8 @@
io.lambdaforge/datalog-parser {:mvn/version "0.1.9"}
clj-stacktrace/clj-stacktrace {:mvn/version "0.2.8"}
clojure-msgpack/clojure-msgpack {:mvn/version "1.2.1"}
cli-matic/cli-matic {:git/url "https://github.com/l3nz/cli-matic.git", :git/sha "9cd53ba7336363e3d06650dbad413b6f8b06e471"}}
cli-matic/cli-matic {:git/url "https://github.com/l3nz/cli-matic.git", :git/sha "9cd53ba7336363e3d06650dbad413b6f8b06e471"}
aysylu/loom {:mvn/version "1.0.2"}}
:classpath-overrides {org.clojure/clojure nil
org.clojure/spec.alpha nil}}
:clj-nvd

1
doc/build.md
View file

@ -114,6 +114,7 @@ Babashka supports the following feature flags:
| `BABASHKA_FEATURE_DATASCRIPT` | Includes [datascript](https://github.com/tonsky/datascript) | `false` |
| `BABASHKA_FEATURE_LANTERNA` | Includes [clojure-lanterna](https://github.com/babashka/clojure-lanterna) | `false` |
| `BABASHKA_FEATURE_LOGGING` | Includes [clojure.tools.logging](https://github.com/clojure/tools.logging) with [taoensso.timbre](https://github.com/ptaoussanis/timbre) as the default implementation| `true` |
| `BABASHKA_FEATURE_PRIORITY_MAP` | Includes [clojure.data.priority-map](https://github.com/clojure/data.priority-map) | `true` |
Note that httpkit server is currently experimental, the feature flag could be toggled to `false` in a future release.

1
doc/libraries.csv
View file

@ -1,6 +1,7 @@
maven-name,git-url
aero/aero,http://github.com/juxt/aero
amperity/vault-clj,https://github.com/amperity/vault-clj
aysylu/loom,https://github.com/aysylu/loom
babashka/babashka.curl,https://github.com/babashka/babashka.curl
better-cond/better-cond,https://github.com/Engelberg/better-cond
borkdude/deps,https://github.com/borkdude/deps.clj

1 maven-name git-url
2 aero/aero http://github.com/juxt/aero
3 amperity/vault-clj https://github.com/amperity/vault-clj
4 aysylu/loom https://github.com/aysylu/loom
5 babashka/babashka.curl https://github.com/babashka/babashka.curl
6 better-cond/better-cond https://github.com/Engelberg/better-cond
7 borkdude/deps https://github.com/borkdude/deps.clj

11
feature-priority-map/babashka/impl/priority_map.clj Normal file
View file

@ -0,0 +1,11 @@
(ns babashka.impl.priority-map
(:require [clojure.data.priority-map :as pm]
[sci.core :as sci]))
(def pmns (sci/create-ns 'clojure.data.priority-map))
(def priority-map-namespace
{'priority-map (sci/copy-var pm/priority-map pmns)
'priority-map-keyfn (sci/copy-var pm/priority-map-keyfn pmns)
'subseq (sci/copy-var pm/subseq pmns)
'rsubseq (sci/copy-var pm/rsubseq pmns)})

3
project.clj
View file

@ -64,6 +64,8 @@
:feature/logging {:source-paths ["feature-logging"]
:dependencies [[com.taoensso/timbre "5.1.2"]
[org.clojure/tools.logging "1.1.0"]]}
:feature/priority-map {:source-paths ["feature-priority-map"]
:dependencies [[org.clojure/data.priority-map "1.1.0"]]}
:test [:feature/xml
:feature/lanterna
:feature/yaml
@ -80,6 +82,7 @@
:feature/spec-alpha
:feature/selmer
:feature/logging
:feature/priority-map
{:dependencies [[com.clojure-goes-fast/clj-async-profiler "0.5.0"]
[com.opentable.components/otj-pg-embedded "0.13.3"]]}]
:uberjar {:global-vars {*assert* false}

7
resources/META-INF/babashka/deps.edn
View file

@ -9,6 +9,7 @@
"feature-spec-alpha"
"feature-selmer"
"feature-logging"
"feature-priority-map"
"pods/src"
"babashka.nrepl/src"
"depstar/src" "process/src"
@ -40,7 +41,8 @@
rewrite-clj/rewrite-clj {:mvn/version "1.0.699-alpha"}
selmer/selmer {:mvn/version "1.12.44"}
com.taoensso/timbre {:mvn/version "5.1.2"}
org.clojure/tools.logging {:mvn/version "1.1.0"}}
org.clojure/tools.logging {:mvn/version "1.1.0"}
org.clojure/data.priority-map {:mvn/version "1.1.0"}}
:aliases {:babashka/dev
{:main-opts ["-m" "babashka.main"]}
:profile
@ -124,7 +126,8 @@
io.lambdaforge/datalog-parser {:mvn/version "0.1.9"}
clj-stacktrace/clj-stacktrace {:mvn/version "0.2.8"}
clojure-msgpack/clojure-msgpack {:mvn/version "1.2.1"}
cli-matic/cli-matic {:git/url "https://github.com/l3nz/cli-matic.git", :git/sha "9cd53ba7336363e3d06650dbad413b6f8b06e471"}}
cli-matic/cli-matic {:git/url "https://github.com/l3nz/cli-matic.git", :git/sha "9cd53ba7336363e3d06650dbad413b6f8b06e471"}
aysylu/loom {:mvn/version "1.0.2"}}
:classpath-overrides {org.clojure/clojure nil
org.clojure/spec.alpha nil}}
:clj-nvd

1
script/compile
View file

@ -103,6 +103,7 @@ then
export BABASHKA_FEATURE_SPEC_ALPHA="${BABASHKA_FEATURE_SPEC_ALPHA:-false}"
export BABASHKA_FEATURE_SELMER="${BABASHKA_FEATURE_SELMER:-false}"
export BABASHKA_FEATURE_LOGGING="${BABASHKA_FEATURE_LOGGING:-false}"
export BABASHKA_FEATURE_PRIORITY_MAP="${BABASHKA_FEATURE_PRIORITY_MAP:-false}"
fi
"$GRAALVM_HOME/bin/native-image" "${args[@]}"

7
script/uberjar
View file

@ -161,6 +161,13 @@ else
BABASHKA_LEIN_PROFILES+=",-feature/logging"
fi
if [ "$BABASHKA_FEATURE_PRIORITY_MAP" != "false" ]
then
BABASHKA_LEIN_PROFILES+=",+feature/priority-map"
else
BABASHKA_LEIN_PROFILES+=",-feature/priority-map"
fi
cp deps.edn resources/META-INF/babashka/deps.edn
if [ -z "$BABASHKA_JAR" ]; then

6
script/uberjar.bat
View file

@ -124,6 +124,12 @@ set BABASHKA_LEIN_PROFILES=%BABASHKA_LEIN_PROFILES%,+feature/logging
set BABASHKA_LEIN_PROFILES=%BABASHKA_LEIN_PROFILES%,-feature/logging
)
if not "%BABASHKA_FEATURE_PRIORITY_MAP%"=="false" (
set BABASHKA_LEIN_PROFILES=%BABASHKA_LEIN_PROFILES%,+feature/priority-map
) else (
set BABASHKA_LEIN_PROFILES=%BABASHKA_LEIN_PROFILES%,-feature/priority-map
)
call lein with-profiles %BABASHKA_LEIN_PROFILES% bb "(+ 1 2 3)"
call lein with-profiles %BABASHKA_LEIN_PROFILES%,+reflection,-uberjar do run

2
src/babashka/impl/classes.clj
View file

@ -133,6 +133,7 @@
java.io.FileInputStream
java.io.FileOutputStream
java.io.FileReader
java.io.FileWriter
java.io.RandomAccessFile
java.io.InputStream
java.io.IOException
@ -462,6 +463,7 @@
clojure.lang.ReaderConditional
clojure.lang.Repeat
clojure.lang.Reversible
clojure.lang.Sorted
clojure.lang.Symbol
clojure.lang.Sequential
clojure.lang.Seqable

4
src/babashka/impl/features.clj
View file

@ -16,6 +16,7 @@
(def test-check? (not= "false" (System/getenv "BABASHKA_FEATURE_TEST_CHECK")))
(def selmer? (not= "false" (System/getenv "BABASHKA_FEATURE_SELMER")))
(def logging? (not= "false" (System/getenv "BABASHKA_FEATURE_LOGGING")))
(def priority-map? (not= "false" (System/getenv "BABASHKA_FEATURE_PRIORITY_MAP")))
;; excluded by default
(def jdbc? (= "true" (System/getenv "BABASHKA_FEATURE_JDBC")))
@ -72,3 +73,6 @@
(when logging?
(require '[babashka.impl.logging]))
(when priority-map?
(require '[babashka.impl.priority-map]))

11
src/babashka/main.clj
View file

@ -253,7 +253,8 @@ Use bb run --help to show this help output.
:feature/test-check %s
:feature/spec-alpha %s
:feature/selmer %s
:feature/logging %s}")
:feature/logging %s
:feature/priority-map %s}")
version
features/csv?
features/java-nio?
@ -272,7 +273,8 @@ Use bb run --help to show this help output.
features/test-check?
features/spec-alpha?
features/selmer?
features/logging?)))
features/logging?
features/priority-map?)))
(defn read-file [file]
(let [f (io/file file)]
@ -436,8 +438,9 @@ Use bb run --help to show this help output.
'clojure.tools.logging.impl
@(resolve 'babashka.impl.logging/tools-logging-impl-namespace)
'clojure.tools.logging.readable
@(resolve 'babashka.impl.logging/tools-logging-readable-namespace))))
@(resolve 'babashka.impl.logging/tools-logging-readable-namespace))
features/priority-map? (assoc 'clojure.data.priority-map
@(resolve 'babashka.impl.priority-map/priority-map-namespace))))
(def edn-readers (cond-> {}
features/yaml?

3
test-resources/lib_tests/babashka/run_all_libtests.clj
View file

@ -34,7 +34,8 @@
(when (seq namespaces)
(doseq [n namespaces]
(require n)
(filter-vars! (find-ns n) #(-> % meta :skip-bb not)))
(filter-vars! (find-ns n) #(-> % meta ((some-fn :skip-bb
:test-check-slow)) not)))
(let [m (apply t/run-tests namespaces)]
(swap! status (fn [status]
(merge-with + status (dissoc m :type))))))))

3
test-resources/lib_tests/bb-tested-libs.edn
View file

@ -107,4 +107,5 @@
io.lambdaforge/datalog-parser {:git-url "https://github.com/lambdaforge/datalog-parser", :test-namespaces (datalog.parser.pull-test datalog.parser.test.util datalog.parser.impl-test datalog.parser-test datalog.unparser-test), :git-sha "02d193f397afc3f93da704e7c6c850b194f0e797"}
clj-stacktrace/clj-stacktrace {:git-url "https://github.com/mmcgrana/clj-stacktrace", :test-namespaces (clj-stacktrace.repl-test clj-stacktrace.core-test), :git-sha "94dc2dd748710e79800e94b713e167e5dc525717"}
clojure-msgpack/clojure-msgpack {:git-url "https://github.com/edma2/clojure-msgpack", :test-namespaces (msgpack.core-check msgpack.core-test), :git-sha "a4bca2cf064a87d9c4a564c634c6ebb65578dad5"}
cli-matic/cli-matic {:git-url "https://github.com/l3nz/cli-matic.git", :test-namespaces (cli-matic.utils-test cli-matic.presets-test cli-matic.help-gen-test cli-matic.utils-convert-config-test cli-matic.utils-candidates-test cli-matic.core-test cli-matic.utils-v2-test), :git-sha "9cd53ba7336363e3d06650dbad413b6f8b06e471"}}
cli-matic/cli-matic {:git-url "https://github.com/l3nz/cli-matic.git", :test-namespaces (cli-matic.utils-test cli-matic.presets-test cli-matic.help-gen-test cli-matic.utils-convert-config-test cli-matic.utils-candidates-test cli-matic.core-test cli-matic.utils-v2-test), :git-sha "9cd53ba7336363e3d06650dbad413b6f8b06e471"}
aysylu/loom {:git-url "https://github.com/aysylu/loom", :test-namespaces (loom.test.network-simplex loom.test.label loom.test.alg-generic loom.test.compliance-tester loom.test.flow loom.test.alg loom.test.attr loom.test.graph loom.test.derived), :git-sha "d458f0c0dee9021983c64381b90a470f0178cc8e"}}

626
test-resources/lib_tests/loom/test/alg.cljc Normal file
View file

@ -0,0 +1,626 @@
(ns loom.test.alg
(:require [loom.graph :refer [graph weighted-graph digraph weighted-digraph nodes
successors remove-nodes add-nodes edges
add-edges]]
[loom.alg :refer [pre-traverse post-traverse pre-span topsort
bf-traverse bf-span bf-path
bf-path-bi dijkstra-path dijkstra-path-dist
dijkstra-traverse dijkstra-span johnson
all-pairs-shortest-paths connected-components
connected? scc strongly-connected? connect
dag? shortest-path loners bellman-ford
bipartite-color bipartite? bipartite-sets
coloring? greedy-coloring prim-mst-edges
prim-mst-edges prim-mst astar-path astar-dist
degeneracy-ordering maximal-cliques
subgraph? eql? isomorphism?]]
[loom.derived :refer [mapped-by]]
clojure.walk
#?@(:clj [[clojure.test :refer :all]]
:cljs [cljs.test]))
#?@(:cljs [(:require-macros [cljs.test :refer (deftest testing are is)])]))
;; http://en.wikipedia.org/wiki/Dijkstra's_algorithm
(def g1
(weighted-graph
[1 2 7] [1 3 9] [1 6 14] [2 3 10] [2 4 15]
[3 4 11] [3 6 2] [4 5 6] [5 6 9]))
;; http://www.algolist.com/Dijkstra's_algorithm
(def g2
(weighted-graph
[:r :g 10] [:r :b 5] [:r :o 8] [:g :b 3] [:b :p 7] [:p :o 2]))
;; http://fr.wikipedia.org/wiki/Algorithme_de_Dijkstra
(def g4
(weighted-graph
[:a :b 85]
[:b :f 80]
[:f :i 250]
[:i :j 84]
[:a :c 217]
[:c :g 186]
[:c :h 103]
[:d :h 183]
[:h :j 167]
[:a :e 173]
[:e :j 502]))
;; Algorithm Design Manual, p 179
(def g5
(digraph {:a [:b :c]
:b [:c :d]
:c [:e :f]
:d []
:e [:d]
:f [:e]
:g [:a :f]}))
(def g6 (graph [0 1] [1 2] [1 3] [2 4] [3 4] [0 5]))
(def g7 (digraph [1 2] [2 3] [3 1] [5 6] [6 7]))
(def g8 (graph {1 [2 3 4] 5 [6 7 8]}))
;; Algorithm Design Manual, p 182
(def g9
(digraph {8 #{6},
7 #{5},
6 #{7},
5 #{6},
4 #{1 6 8},
3 #{1},
2 #{3 4 5},
1 #{2}}))
;; http://en.wikipedia.org/wiki/Strongly_connected_component
(def g10
(digraph {:a [:b]
:b [:c :e :f]
:c [:d :g]
:d [:c :h]
:e [:a :f]
:f [:g]
:g [:f]
:h [:g :d]}))
;; Weighted directed graph with a negative-weight cycle
;; which is reachable from sources :a, :b, :d, and :e.
;; http://www.seas.gwu.edu/~simhaweb/alg/lectures/module9/module9.html
(def g11
(weighted-digraph [:a :b 3]
[:b :c 4]
[:b :d 5]
[:d :e 2]
[:e :b -8]))
;; Weighted directed graph with a non-negative-weight cycle,
;; similar to g11, but with the edge [:e :b] reweighed.
(def g12
(weighted-digraph [:a :b 3]
[:b :c 4]
[:b :d 5]
[:d :e 2]
[:e :b -7]))
;; Directed graph with 4 strongly connected components.
(def g13
(digraph [1 5]
[2 4]
[3 1]
[3 2]
[3 6]
[4 10]
[5 3]
[6 1]
[6 10]
[7 8]
[8 9]
[8 11]
[9 3]
[9 5]
[9 7]
[10 2]
[11 2]
[11 4]))
(def g14
(digraph [1 2]
[2 3]
[2 4]))
(def g15
(digraph [1 2]
[3 2]
[2 4]))
(def g16
(digraph [:a :e]
[:a :b]
[:a :c]
[:e :d]
[:d :c]))
;; simple directed "triangle" graph
(def triangle (digraph [:a :b]
[:b :c]
[:c :a]))
;; graphs for mst
;; http://en.wikipedia.org/wiki/Kruskal's_algorithm
(def mst_wt_g1 (weighted-graph '(:a, :e , 1)
'(:c, :d ,2)
'(:a,:b, 3),
'(:b,:e,4),
'(:b,:c,5)
'(:e,:c,6)
'(:e,:d,7)))
;;graph with 2 components
(def mst_wt_g2 (weighted-graph [:a :b 2]
[:a :d 1]
[:b :d 2]
[:c :d 3]
[:b :c 1]
[:e :f 1]
))
(def mst_unweighted_g3 (graph [:a :b] [:a :c] [:a :d] [:b :d] [:c :d]))
(def mst_wt_g4 (weighted-graph [:a :b 1]))
(def mst_wt_g5 (weighted-graph [:a :b 5] [:a :c 2] [:b :c 2]))
;;graph from Cormen et all
(def mst_wt_g6 (weighted-graph [:a :b 4] [:a :h 8]
[:b :c 8] [:b :h 11]
[:c :d 7] [:c :f 4] [:c :i 2]
[:d :f 14] [:d :e 9]
[:e :f 10]
[:f :g 2]
[:i :h 7] [:i :g 6]
[:h :g 1] ))
;;graph with 2 components and 2 isolated nodes
(def mst_wt_g7 (weighted-graph [:a :b 2]
[:b :d 2]
[:e :f 1]
:g :h
))
(deftest depth-first-test
(are [expected got] (= expected got)
#{1 2 3 5 6 7} (set (pre-traverse g7))
#{1 2 3} (set (pre-traverse g7 1))
#{1 2 3 4 5 6 7 8} (set (pre-traverse g8))
#{1 2 3 4 5 6 7 8} (set (post-traverse g8))
[:d :e :f :c :b :a :g] (post-traverse g5 :g)
false (not (some #{(pre-traverse g16 :a)} [[:a :e :d :c :b]
[:a :b :c :e :d]
[:a :b :e :d :c]
[:a :c :b :e :d]
[:a :c :e :d :b]]))
false (not (some #{(post-traverse g7 1)} [[3 2 1] [2 3 1]]))
#{1 2 3 4 5 6 7 8} (set (nodes (digraph (pre-span g8))))
#{2 3 4} (set (successors (digraph (pre-span g8)) 1))
#{1 5} (set (successors (digraph (pre-span g6)) 0))
true (let [span (digraph (pre-span g6))]
(and (or (= #{3} (set (successors span 4)))
(= #{2} (set (successors span 4))))
(or (= #{3} (set (successors span 1)))
(= #{2} (set (successors span 1))))))
[:g :a :b :c :f :e :d] (topsort g5)
nil (topsort g7)
[5 6 7] (topsort g7 5)
[1 2 4] (topsort g15 1)))
(deftest depth-first-test-2
(is (#{[1 2 3 4] [1 2 4 3]} (topsort g14 1))))
(deftest breadth-first-test
(are [expected got] (= expected got)
#{1 2 3 5 6 7} (set (bf-traverse g7))
#{1 2 3} (set (bf-traverse g7 1))
#{1 2 3 4 5 6 7 8} (set (bf-traverse g8))
#{1 2 3 4 5 6 7 8} (set (nodes (digraph (bf-span g8))))
#{2 3} (set (successors (digraph (bf-span g6)) 1))
false (not (some #{(bf-traverse (remove-nodes g6 5))}
[[0 1 2 3 4] [0 1 3 2 4]]))
#{:r} (set (bf-traverse g2 :r :when #(< %3 1)))
#{:r :o :b :g} (set (bf-traverse g2 :r :when #(< %3 2)))
#{:r :o :b :g :p} (set (bf-traverse g2 :r :when #(< %3 3)))
[:a :e :j] (bf-path g4 :a :j)
[:a :c :h :j] (bf-path g4 :a :j :when (fn [n p d] (not= :e n)))
#?@(:clj [[:a :e :j] (bf-path-bi g4 :a :j)
true (some #(= % (bf-path-bi g5 :g :d)) [[:g :a :b :d] [:g :f :e :d]])])))
(deftest dijkstra-test
(are [expected got] (= expected got)
[:a :c :h :j] (dijkstra-path g4 :a :j)
[[:a :c :h :j] 487] (dijkstra-path-dist g4 :a :j)
[[:r :o :p] 10] (dijkstra-path-dist g2 :r :p)
#{:r :g :b :o :p} (set (map first (dijkstra-traverse g2)))
{:r {:o 8 :b 5} :b {:g 8} :o {:p 10}} (dijkstra-span g2 :r)))
(deftest johnson-test
(are [expected got] (= expected got)
{:p {:p {:o 2, :b 7}
:o {:r 10}
:b {:g 10}}
:o {:o {:p 2, :r 8}
:p {:b 9}
:b {:g 12}}
:g {:g {:b 3}
:b {:r 8, :p 10}
:p {:o 12}}
:b {:b {:p 7, :g 3, :r 5}
:p {:o 9}}
:r {:r {:o 8, :b 5}
:b {:g 8}
:o {:p 10}}} (johnson g2)
{1 {1 {5 1}, 5 {3 2}, 3 {2 3, 6 3}, 2 {4 4}, 6 {10 4}}
2 {2 {4 1}, 4 {10 2}}
3 {3 {1 1, 2 1, 6 1}, 1 {5 2}, 2 {4 2}, 6 {10 2}}
4 {4 {10 1}, 10 {2 2}}
5 {5 {3 1}, 3 {1 2, 2 2, 6 2}, 2 {4 3}, 6 {10 3}}
6 {6 {1 1, 10 1}, 1 {5 2}, 10 {2 2}, 2 {4 3}, 5 {3 3}}
7 {4 {10 4}, 8 {11 2, 9 2}, 7 {8 1}, 9 {5 3, 3 3}, 11 {4 3, 2 3}, 3 {6 4, 1 4}}
8 {4 {10 3}, 8 {11 1, 9 1}, 9 {7 2, 5 2, 3 2}, 11 {4 2, 2 2}, 3 {6 3, 1 3}}
9 {8 {11 3}, 6 {10 3}, 7 {8 2}, 2 {4 3}, 9 {7 1, 5 1, 3 1}, 3 {6 2, 2 2, 1 2}}
10 {10 {2 1}, 2 {4 2}}
11 {11 {2 1, 4 1}, 4 {10 2}}} (johnson g13)
false (johnson g11)
{:e {:e {:b 0}
:b {:d 0, :c 0}}
:d {:d {:e 0}
:e {:b 0}
:b {:c 0}}
:b {:b {:d 0, :c 0}
:d {:e 0}}
:c {}
:a {:a {:b 10}
:b {:d 10, :c 10}
:d {:e 10}}} (johnson g12)))
(deftest all-pairs-shortest-paths-test
(is (= {:p {:p {:o 2, :b 7}
:o {:r 10}
:b {:g 10}}
:o {:o {:p 2, :r 8}
:p {:b 9}
:b {:g 12}}
:g {:g {:b 3}
:b {:r 8, :p 10}
:p {:o 12}}
:b {:b {:p 7, :g 3, :r 5}
:p {:o 9}}
:r {:r {:o 8, :b 5}
:b {:g 8}
:o {:p 10}}}
(all-pairs-shortest-paths g2)))
(let [vecs->sets #(clojure.walk/postwalk
(fn [x]
(if-not (map? x)
x
(reduce
(fn [m [k v]] (assoc m k (if (vector? v) (set v) v)))
{}
x)))
%)]
(is (= (vecs->sets
{1 {1 [5], 5 [3], 3 [6 2], 2 [4], 6 [10]}
2 {2 [4], 4 [10]}
3 {3 [1 6 2], 1 [5], 2 [4], 6 [10]}
4 {4 [10], 10 [2]}
5 {5 [3], 3 [1 6 2], 2 [4], 6 [10]}
6 {6 [1 10], 1 [5], 10 [2], 5 [3], 2 [4]}
7 {4 [10], 8 [11 9], 7 [8], 9 [3 5], 11 [4 2], 3 [1 6]}
8 {4 [10], 8 [11 9], 9 [7 3 5], 11 [4 2], 3 [1 6]}
9 {8 [11], 6 [10], 7 [8], 2 [4], 9 [7 3 5], 3 [1 6 2]}
10 {10 [2], 2 [4]}
11 {11 [4 2], 4 [10]}})
(vecs->sets (all-pairs-shortest-paths g13))))))
(deftest connectivity-test
(are [expected got] (= expected got)
#{#{5 6 7 8} #{1 2 3 4} #{9}} (set (map set (connected-components
(add-nodes g8 9))))
[#{:r :g :b :o :p}] (map set (connected-components g2))
[#{1 2 3 4 5 6 8 7}] (map set (connected-components g9))
true (connected? g6)
false (connected? g7)
true (connected? g9)
#{#{2 3 4 1} #{8} #{7 5 6}} (set (map set (scc g9)))
#{#{:b :e :a} #{:h :d :c} #{:f :g}} (set (map set (scc g10)))
false (strongly-connected? g9)
true (strongly-connected? (digraph g2))
#{1 2 3 4 5 6 7 8} (set (nodes (connect g8)))
#{:r :g :b :o :p} (set (nodes (connect g2)))))
(deftest other-stuff-test
(are [expected got] (= expected got)
false (dag? g2)
true (dag? (digraph (bf-span g2)))
true (dag? g5)
[:a :c :h :j] (shortest-path g4 :a :j)
[:a :e :j] (shortest-path (graph g4) :a :j)
#{9 10} (set (loners (add-nodes g8 9 10)))
;; TODO: the rest
))
(deftest bellman-ford-test
(are [expected graph start]
(= expected (bellman-ford graph start))
false g11 :a
false g11 :b
[{:e ##Inf
:d ##Inf
:b ##Inf
:a ##Inf
:c 0}{:c [:c]}] g11 :c
false g11 :d
false g11 :e
[{:e 10,
:d 8,
:b 3,
:c 7,
:a 0}
{:a [:a],
:c [:a :b :c],
:b [:a :b],
:d [:a :b :d],
:e [:a :b :d :e]}] g12 :a
[{:e 7,
:d 5,
:c 4,
:a ##Inf,
:b 0}
{:b [:b],
:c [:b :c],
:d [:b :d],
:e [:b :d :e]}] g12 :b
[{:e ##Inf
:d ##Inf
:b ##Inf
:a ##Inf
:c 0}
{:c [:c]}] g12 :c
[{:e 2,
:b -5,
:c -1,
:a ##Inf,
:d 0}
{:d [:d],
:c [:d :e :b :c],
:b [:d :e :b],
:e [:d :e]}] g12 :d
[{:d -2,
:b -7,
:c -3,
:a ##Inf,
:e 0}
{:e [:e],
:c [:e :b :c],
:b [:e :b],
:d [:e :b :d]}] g12 :e))
(deftest bipartite-test
(are [expected got] (= expected got)
nil (bipartite-color g1)
true (bipartite? g6)
true (bipartite? g8)
false (bipartite? g1))
(are [options result] (contains? options result)
#{{0 1, 1 0, 5 0, 2 1, 3 1, 4 0}} (bipartite-color g6)
#{{1 1, 2 0, 3 0, 4 0, 5 0, 6 1, 7 1, 8 1}
{1 1, 2 0, 3 0, 4 0, 5 1, 6 0, 7 0, 8 0}} (bipartite-color g8)
#{#{#{2 3 4 5} #{1 6 7 8}}
#{#{2 3 4 6 7 8} #{1 5}}} (set (bipartite-sets g8))))
(deftest coloring?-test
(are [expected got] (= expected got)
true (coloring? g1 {1 0, 2 1, 3 2, 4 0, 5 2, 6 1})
false (coloring? g1 {1 0, 2 1, 3 2, 4 0, 5 1, 6 1})
true (coloring? g2 {:r 0, :g 1, :b 2, :p 0, :o 1})
true (coloring? g5 {:a 0, :b 1, :c 2, :d 0, :e 1, :f 0, :g 1})
false (coloring? g5 {:a 0 :b 1 :c 2 :d 0 :e 1 :f 0 :g nil})))
(deftest greedy-coloring-test
(are [expected got] (= expected got)
true (coloring? g1 (greedy-coloring g1))
true (coloring? g2 (greedy-coloring g2))
true (coloring? g4 (greedy-coloring g4))
true (coloring? g5 (greedy-coloring g5))
true (coloring? g6 (greedy-coloring g6))
true (coloring? g13 (greedy-coloring g13))
; expected colors are 0, 1, and 2
2 (apply max (vals (greedy-coloring triangle)))))
(deftest scc-test
(are [expected got] (= expected got)
#{#{2 4 10} #{1 3 5 6} #{11} #{7 8 9}} (set (map set (scc g13)))))
(deftest prim-mst-edges-weighted-test
; edges are described in different orders depending on platform, probably due
; to priority map impl differences -- thus testing edges as sets
(letfn [(edge-set [edge]
(into [(set (take 2 edge))] (drop 2 edge)))
(edge-sets [edges] (set (map edge-set edges)))]
(are [expected got] (= (edge-sets expected) (edge-sets got))
[[:e :a 1] [:a :b 3] [:b :c 5] [:c :d 2]] (prim-mst-edges mst_wt_g1)
[[:b :a 1]] (prim-mst-edges mst_wt_g4)
[[:c :a 2] [:c :b 2]] (prim-mst-edges mst_wt_g5)
[[:b :a 4] [:c :b 8] [:c :i 2] [:c :f 4] [:f :g 2]
[:g :h 1] [:d :c 7] [:e :d 9]] (prim-mst-edges mst_wt_g6))
(are [solutions result] (contains? solutions result)
#{(edge-sets [[:d :a 1] [:b :d 2] [:c :b 1] [:e :f 1]])
(edge-sets [[:d :a 1] [:a :b 2] [:c :b 1] [:e :f 1]])}
(edge-sets (prim-mst-edges mst_wt_g2))
#{(edge-sets [[:c :a] [:d :b] [:c :d]])
(edge-sets [[:a :b] [:a :c] [:a :d]])}
(edge-sets (prim-mst-edges mst_unweighted_g3)))))
(deftest prim-mst-test
(are [expected got] (= expected got)
[#{:a :b :d :e :f :g :h} (set [[:a :b] [:b :d] [:b :a] [:f :e] [:d :b] [:e :f]])]
(let [mst (prim-mst mst_wt_g7)]
[(nodes mst) (set (edges mst))])
[#{:a :b :c} (set [[:a :c] [:c :b] [:c :a] [:b :c]])]
(let [mst (prim-mst mst_wt_g5)]
[(nodes mst) (set (edges mst))])))
;;;;graphs for A* path
(def astar-simple-path-g1 (graph [:a :b]
[:b :c]
[:c :d]
[:d :e]))
;;graph, with unreachable node
(def astar-with-unreachable-target-g2 (graph [:a :b]
[:b :c]
[:d :e]))
(def astar-with-cycle-g3 (digraph [:a :b]
[:b :c]
[:c :d]
[:d :a]))
(def astar-weighted-graph-g4 (weighted-digraph [:a :b 10]
[:b :c 20]
[:c :d 5]
[:a :e 10]
[:e :d 100]))
(deftest astar-path-test
(are [expected got](= expected got)
{:e :d :d :c :c :b :b :a :a nil}
(astar-path astar-simple-path-g1 :a :e (fn [x y] 0))
{:a nil :b :a :c :b}
(astar-path astar-with-cycle-g3 :a :c (fn [x y] 0))
{:a nil :b :a :c :b :d :c}
(astar-path astar-with-cycle-g3 :a :d (fn [x y] 0))
{:a nil :b :a :c :b :d :c}
(astar-path astar-weighted-graph-g4 :a :d (fn [x y] 0))
;;all test graphs used for Dijkstra should work for A* as well
{:a nil, :c :a, :h :c, :j :h} (astar-path g4 :a :j nil)
{:r nil, :o :r, :p :o} (astar-path g2 :r :p nil))
(is (thrown? #?(:clj Exception :cljs js/Error)
(astar-path astar-with-unreachable-target-g2 :a :e nil))))
(deftest astar-dist-test
(are [expected got](= expected got)
4
(astar-dist astar-simple-path-g1 :a :e (fn [x y] 0))
2
(astar-dist astar-with-cycle-g3 :a :c (fn [x y] 0))
3
(astar-dist astar-with-cycle-g3 :a :d (fn [x y] 0))
35
(astar-dist astar-weighted-graph-g4 :a :d (fn [x y] 0))
)
)
(deftest astar-visit-test
(let [g (graph [0 1] [1 2] [2 3] [3 4])
i (atom 0)]
(astar-path g 2 4 (fn [x y] (swap! i inc) (if (> x y) (- x y) (- y x))))
(is (= 3 @i) "This implementation of A* is incorrect. It is not optimal.")))
(def degeneracy-g1 (graph {:a [:b]
:b [:c :d]}))
(def degeneracy-g2 (graph {:a [:b]
:b [:c :d :e :f]
:d [:e :f]
:e [:f]}))
(deftest degeneracy-ordering-test
(let [ns (degeneracy-ordering degeneracy-g1)]
(is (= #{:a :c :b :d} (set ns)))
(is (contains? (set (drop 2 ns)) :b)))
(let [ns (degeneracy-ordering degeneracy-g2)]
(is (= #{:a :c :b :d :e :f} (set ns)))
(is (= #{:a :c} (set (take 2 ns))))
(is (contains? (set (drop 2 ns)) :b))))
;; Graph with 4 maximal cliques: [:a :b :c], [:c :d], [:d :e :f :g], [:d :h].
(def maximal-cliques-g1 (graph {:a [:b :c]
:b [:c]
:c [:d]
:d [:e :f :g :h]
:e [:f :g]
:f [:g]}))
;; Graph with 3 maximal cliques: #{:a :b :c} #{:b :d :e} #{:e :f}
(def maximal-cliques-g2 (weighted-graph [:a :b 1]
[:a :c 1]
[:b :c 1]
[:b :d 1]
[:d :e 1]
[:b :e 1]
[:e :f 1]))
(deftest maximal-cliques-test
(are [expected got](= expected got)
#{#{:a :b :c} #{:c :d} #{:d :e :f :g} #{:d :h}}
(set (maximal-cliques maximal-cliques-g1))
#{#{:a :b :c} #{:b :d :e} #{:e :f}}
(set (maximal-cliques maximal-cliques-g2))))
(def subgraph-g6 (graph [0 1] [1 2] [1 3]))
(def subgraph-g7 (digraph [1 2] [2 3] [3 1]))
(deftest subgraph-test
(are [expected got] (= expected got)
true (subgraph? subgraph-g6 g6)
false (subgraph? (add-edges subgraph-g6 [0 3])
g6)
true (subgraph? subgraph-g7 g7)
false (subgraph? (add-nodes subgraph-g7 0)
g7)
false (subgraph? (digraph [2 1] [2 3] [3 1])
g7)))
(deftest eql-test
(are [expected got] (= expected got)
true (eql? (graph) (graph))
true (eql? (digraph) (digraph))
true (eql? g6 (graph g6))
true (eql? g7 (digraph g7))
false (eql? (digraph) (graph))
false (eql? (graph) (digraph))
false (eql? g6 (graph 1 2))
false (eql? g7 (digraph 1 2))
false (eql? (digraph [1 2]) (graph [1 2]))
false (eql? g7 g6)))
(deftest isomorphism-test
(are [expected got] (= expected got)
true (isomorphism? (graph) (graph) identity)
true (isomorphism? g6 g6 identity)
true (isomorphism? g7 g7 identity)
true (isomorphism? (graph) (graph) identity)
true (isomorphism? g6 (mapped-by inc g6) inc)
true (isomorphism? g7 (mapped-by inc g7) inc)
false (isomorphism? g7 (mapped-by inc g7) dec)
false (isomorphism? (digraph) (graph) identity)
false(isomorphism? (digraph [1 2]) (graph [1 2]) identity)))

217
test-resources/lib_tests/loom/test/alg_generic.cljc Normal file
View file

@ -0,0 +1,217 @@
(ns loom.test.alg-generic
(:require [loom.alg-generic :as lag]
[loom.graph :as g]
[clojure.set :as set]
[clojure.test.check :as tc]
[clojure.test.check.generators :as gen]
#?@(:clj [[clojure.test :refer :all]
[clojure.test.check.clojure-test :refer [defspec]]
[clojure.test.check.properties :as prop]]
:cljs [clojure.test.check.properties]))
#?@(:cljs [(:require-macros [cljs.test :refer (deftest testing are is)]
[clojure.test.check.clojure-test :refer [defspec]]
[clojure.test.check.properties :as prop])]))
(defn dag-samples-gen
[dag percent]
(let [dag-size (count dag)
sample-count (int (* percent dag-size))]
(gen/bind (apply gen/tuple
;; May collide but this is fine.
(repeat (* 2 sample-count) (gen/choose 0 dag-size)))
(fn [samples]
(gen/tuple (gen/return dag) (gen/return samples))))))
(defn gen-dag
([] (gen-dag [#{}] 10))
([nodes] (gen-dag [#{}] nodes))
([dag-so-far nodes]
(gen/bind (gen/frequency [[80 (gen/return 1)]
[19 (gen/return 2)]
[1 (gen/return 0)]])
(fn [parent-count]
(gen/bind (gen/such-that
(fn [& parents]
(when (not (empty? parents))
(apply distinct? parents)))
(apply gen/tuple
(repeat (min (count dag-so-far) parent-count)
(gen/choose 0 (dec (count dag-so-far))))))
(fn [parents]
(if (< 0 nodes)
(gen-dag (conj dag-so-far (set parents))
(dec nodes))
(dag-samples-gen dag-so-far 0.5))))))))
(defn anc-model-new [] {})
(defn anc-model-add
[anc-model node & parents]
(let [ancs (reduce set/union
(map #(get anc-model %)
parents))
ancs (into ancs parents)
ancs (disj ancs nil)]
(assoc anc-model node ancs)))
(defn anc-model-anc?
[anc-model childer parenter]
(boolean
(get
(get anc-model childer)
parenter)))
(defn anc->anc-model
[ancestry]
(let [anc-nodes (lag/ancestry-nodes ancestry)]
(zipmap anc-nodes
(map #(set (lag/ancestors ancestry %)) anc-nodes))))
(def dag-similarity-props
(prop/for-all [[dag samples] (gen/bind (gen/choose 0 100)
(fn [dag-size]
(gen-dag dag-size)))]
(let [anc (reduce (fn [a [i ps]]
(apply lag/ancestry-add a i (seq ps)))
(lag/ancestry-new)
(map-indexed vector dag))
anc-model (reduce (fn [a [i ps]]
(apply anc-model-add a i (seq ps)))
(anc-model-new)
(map-indexed vector dag))
samp-pairs (partition 2 samples)
anc-to-model (anc->anc-model anc)]
(and
(= anc-model anc-to-model)
(every?
(fn [[a b]]
(and
(= (lag/ancestor? anc b a)
(anc-model-anc? anc-model b a))
(= (lag/ancestor? anc a b)
(anc-model-anc? anc-model a b))))
samp-pairs)))))
(defspec ^:test-check-fast dag-similarity-100
100
dag-similarity-props)
(defspec ^:test-check-slow dag-similarity-2000
2000
dag-similarity-props)
(def g1
{:a [:b :c]
:b [:d]
:c [:d]
:d nil})
(def g2
{:a [:b]
:b [:a]})
(def g3
{:a [:b]
:b [:a :c :d]
:c [:b :e]
:d [:b :c :e]
:e [:c :d :f]
:f []})
(def g4 ; like g3 with some loops
{:a [:b]
:b [:a :c :d]
:c [:b :c :e]
:d [:b :c :e]
:e [:c :d :f]
:f [:f]})
(def g5 ; like g1 but as an undirected graph
{:a [:b :c]
:b [:d :a]
:c [:a :d]
:d [:c :b]})
(def g6 ; unconnected with some loops
{:a [:a]
:b [:a :c]
:c [:b :c]
:d [:e]
:e [:d :f]
:f [:f]})
(deftest tracing-paths
(are [g n p] (= (sort (lag/trace-paths g n)) p)
{:a nil} :a
[[:a]]
{:a #{:b} :b nil} :a
[[:a :b]]
g1 :a
[[:a :b :d] [:a :c :d]]))
(deftest bf-paths-bi-test
(are [g start end paths] (= (lag/bf-paths-bi g g start end) paths)
g2 :a :b
[[:a :b]]
g3 :a :c
[[:a :b :c]]
g3 :a :e
[[:a :b :c :e] [:a :b :d :e]]))
(deftest edge-traverse
; works with nodes without outgoing edges or just a loop to iself
(are [g start expected] (let [pre (lag/pre-edge-traverse g start)
post (lag/post-edge-traverse g start)]
(= expected pre (seq (reverse post))))
g1 :d nil
g4 :f '([:f :f]))
; covers the whole graph when it's totally connected from start
(are [g start expected] (let [pre (lag/pre-edge-traverse g start)
post (lag/post-edge-traverse g start)
dg (g/digraph g)
edges (g/edges dg)]
(and
(= expected pre (seq (reverse post)))
(= (count edges) (count post))
(= (set edges) (set post))))
g1 :a '([:a :b] [:b :d] [:a :c] [:c :d])
g4 :a '([:a :b] [:b :a] [:b :c] [:c :b] [:c :c] [:c :e] [:e :c]
[:e :d] [:d :b] [:d :c] [:d :e] [:e :f] [:f :f] [:b :d])
g4 :c '([:c :b] [:b :a] [:a :b] [:b :c] [:b :d] [:d :b] [:d :c]
[:d :e] [:e :c] [:e :d] [:e :f] [:f :f] [:c :c] [:c :e])
g5 :a '([:a :b] [:b :d] [:d :c] [:c :a]
[:c :d] [:d :b] [:b :a] [:a :c]))
; post traversal returning seen nodes allows complete graph coverage
; without duplicates when iterating on all nodes of the graph
(are [g] (let [dg (g/digraph g)
edges (g/edges dg)
loop-post-traverse
(loop [nodes (reverse (g/nodes dg))
; reverse makes this more interesting as graphs
; are often specified in the forward direction
seen #{}
acc ()]
(if-let [node (first nodes)]
(let [[edges seen]
(lag/post-edge-traverse
g
node
:seen seen
:return-seen true)]
(recur (next nodes)
seen
(concat acc edges)))
acc))]
(and
(= (count edges) (count loop-post-traverse))
(= (set edges) (set loop-post-traverse))))
g1 g2 g3 g4 g5 g6))

31
test-resources/lib_tests/loom/test/attr.cljc Normal file
View file

@ -0,0 +1,31 @@
(ns loom.test.attr
(:require [loom.graph :refer (digraph)]
[loom.attr :refer (add-attr attr add-attr-to-nodes add-attr-to-edges)]
#?@(:clj [[clojure.test :refer :all]]))
#?@(:cljs [(:require-macros [cljs.test :refer (deftest testing are is)])]))
(deftest attr-graph-test
(let [g (digraph [1 2] [2 3] [2 4] [3 5] [4 5])
lg1 (-> g
(add-attr 1 :label "node label")
(add-attr 2 3 :label "edge label"))
lg2 (-> g
(add-attr-to-nodes
:label "node odd" [1 3 5])
(add-attr-to-nodes
:label "node even" [2 4])
(add-attr-to-edges
:label "edge from node 2" [[2 3] [2 4]])
(add-attr-to-edges
:label "edge to node 5" [[3 5] [4 5]]))]
(is (= "node label" (attr lg1 1 :label)))
(is (= "edge label" (attr lg1 2 3 :label)))
(is (= "node odd" (attr lg2 1 :label)))
(is (= "node odd" (attr lg2 3 :label)))
(is (= "node odd" (attr lg2 5 :label)))
(is (= "node even" (attr lg2 2 :label)))
(is (= "node even" (attr lg2 4 :label)))
(is (= "edge from node 2" (attr lg2 2 3 :label)))
(is (= "edge from node 2" (attr lg2 2 4 :label)))
(is (= "edge to node 5" (attr lg2 3 5 :label)))
(is (= "edge to node 5" (attr lg2 4 5 :label)))))

195
test-resources/lib_tests/loom/test/compliance_tester.cljc Normal file
View file

@ -0,0 +1,195 @@
(ns loom.test.compliance-tester
"Provides compliance tests for graph protocols."
(:require [loom.graph :refer [add-edges add-nodes nodes edges has-node? has-edge?
successors out-degree remove-nodes remove-edges
add-edges* transpose predecessors in-degree weight]]
[loom.attr :as attr]
#?@(:clj [[clojure.test :refer :all]]))
#?@(:cljs [(:require-macros [cljs.test :refer (deftest testing are is)])]))
(defn graph-test
"Collection of simple graph tests. Uses the provided empty graph instance, g, to create
various graphs and test the implementation."
[g]
(let [g1 (-> g (add-edges [1 2] [1 3] [2 3]) (add-nodes 4))
g4 (-> g1 (add-edges [5 6] [7 8]) (add-nodes 9))
g5 g]
(testing "Construction, nodes, edges"
(are [expected got] (= expected got)
#{1 2 3 4} (set (nodes g1))
#{[1 2] [2 1] [1 3] [3 1] [2 3] [3 2]} (set (edges g1))
#{1 2 3 4 5 6 7 8 9} (set (nodes g4))
#{[1 2] [2 1] [1 3] [3 1] [2 3]
[3 2] [5 6] [6 5] [7 8] [8 7]} (set (edges g4))
#{} (set (nodes g5))
#{} (set (edges g5))
true (has-node? g1 4)
true (has-edge? g1 1 2)
false (has-node? g1 5)
false (has-edge? g1 4 1)))
(testing "Successors"
(are [expected got] (= expected got)
#{2 3} (set (successors g1 1))
#{1 2} (set (successors g1 3))
#{} (set (successors g1 4))
2 (out-degree g1 1)
2 (out-degree g1 3)
0 (out-degree g1 4)))
(testing "Add & remove"
(are [expected got] (= expected got)
#{1 2 3 4 5} (set (nodes (add-nodes g1 5)))
#{:a :b :c} (set (nodes (add-nodes g5 :a :b :c)))
#{{:id 1} {:id 2}} (set (nodes (add-nodes g5 {:id 1} {:id 2})))
#{[1 2] [2 1]} (set (edges (add-edges g5 [1 2])))
#{1 2} (set (nodes (remove-nodes g1 3 4)))
#{[1 2] [2 1]} (set (edges (remove-nodes g1 3 4)))
#{1 2 3 4} (set (nodes (remove-edges g1 [1 2] [2 1] [1 3] [3 1])))
#{[2 3] [3 2]} (set (edges (remove-edges
g1 [1 2] [2 1] [1 3] [3 1])))))
(testing "Adding multiple edges"
(are [expected got] (= expected got)
#{1 2 3 4 5} (set (nodes (add-edges* g5 [[1 2] [2 3] [3 4] [4 5]])))
#{[1 2] [2 1] [2 3] [3 2] [3 4] [4 3] [4 5] [5 4]} (set (edges (add-edges* g5 [[1 2] [2 3] [3 4] [4 5]])))))))
(defn digraph-test
"Test the provided digraph implementation. The dg parameter is a digraph instance and may be used to construct
other digraphs for testing."
[dg]
(let [g1 (-> dg (add-edges [1 2] [1 3] [2 3]) (add-nodes 4))
g4 (-> g1 (add-edges [5 6] [6 5] [7 8]) (add-nodes 9))
g5 dg
g6 (transpose g1)]
(testing "Construction, nodes, edges"
(are [expected got] (= expected got)
#{1 2 3 4} (set (nodes g1))
#{1 2 3 4} (set (nodes g6))
#{[1 2] [1 3] [2 3]} (set (edges g1))
#{[2 1] [3 1] [3 2]} (set (edges g6))
#{1 2 3 4 5 6 7 8 9} (set (nodes g4))
#{[1 2] [1 3] [2 3] [5 6] [6 5] [7 8]} (set (edges g4))
true (has-node? g1 4)
true (has-edge? g1 1 2)
false (has-node? g1 5)
false (has-edge? g1 2 1)))
(testing "Successors"
(are [expected got] (= expected got)
#{2 3} (set (successors g1 1))
#{} (set (successors g1 3))
#{} (set (successors g1 4))
2 (out-degree g1 1)
0 (out-degree g1 3)
0 (out-degree g1 4)
#{1 2} (set (predecessors g1 3))
#{} (set (predecessors g1 1))
2 (in-degree g1 3)
0 (in-degree g1 1)
#{1 2} (set (successors g6 3))
#{} (set (successors g6 1))
2 (out-degree g6 3)
0 (out-degree g6 1)))
(testing "Add & remove"
(are [expected got] (= expected got)
#{1 2 3 4 5} (set (nodes (add-nodes g1 5)))
#{:a :b :c} (set (nodes (add-nodes g5 :a :b :c)))
#{{:id 1} {:id 2}} (set (nodes (add-nodes g5 {:id 1} {:id 2})))
#{[1 2]} (set (edges (add-edges g5 [1 2])))
#{1 2} (set (nodes (remove-nodes g1 3 4)))
#{[1 2]} (set (edges (remove-nodes g1 3 4)))
#{1 2 3 4} (set (nodes (remove-edges g1 [1 2] [1 3])))
#{[2 3]} (set (edges (remove-edges g1 [1 2] [1 3])))))))
(defn weighted-graph-test
[wg]
(let [g1 (-> wg (add-edges [1 2 77] [1 3 88] [2 3 99]) (add-nodes 4))
g4 (-> g1 (add-edges [5 6 88] [7 8]) (add-nodes 9))
g5 wg]
(testing "Construction, nodes, edges"
(are [expected got] (= expected got)
#{1 2 3 4} (set (nodes g1))
#{[1 2] [2 1] [1 3] [3 1] [2 3] [3 2]} (set (edges g1))
#{1 2 3 4 5 6 7 8 9} (set (nodes g4))
#{[1 2] [2 1] [1 3] [3 1] [2 3]
[3 2] [5 6] [6 5] [7 8] [8 7]} (set (edges g4))
#{} (set (nodes g5))
#{} (set (edges g5))
true (has-node? g1 4)
true (has-edge? g1 1 2)
false (has-node? g1 5)
false (has-edge? g1 4 1)))
(testing "Successors"
(are [expected got] (= expected got)
#{2 3} (set (successors g1 1))
#{1 2} (set (successors g1 3))
#{} (set (successors g1 4))
2 (out-degree g1 1)
2 (out-degree g1 3)
0 (out-degree g1 4)))
(testing "Add & remove"
(are [expected got] (= expected got)
#{1 2 3 4 5} (set (nodes (add-nodes g1 5)))
#{:a :b :c} (set (nodes (add-nodes g5 :a :b :c)))
#{{:id 1} {:id 2}} (set (nodes (add-nodes g5 {:id 1} {:id 2})))
#{[1 2] [2 1]} (set (edges (add-edges g5 [1 2])))
#{1 2} (set (nodes (remove-nodes g1 3 4)))
#{[1 2] [2 1]} (set (edges (remove-nodes g1 3 4)))
#{1 2 3 4} (set (nodes (remove-edges g1 [1 2] [2 1] [1 3] [3 1])))
#{[2 3] [3 2]} (set (edges (remove-edges
g1 [1 2] [2 1] [1 3] [3 1])))))
(testing "Weight"
(are [expected got] (= expected got)
77 (weight g1 1 2)
88 (weight g4 6 5)
1 (weight g4 7 8)))))
(defn weighted-digraph-test
[dwg]
(let [g1 (-> dwg (add-edges [1 2 77] [1 3 88] [2 3 99]) (add-nodes 4))
g4 (-> g1 (add-edges [5 6 88] [6 5 88] [7 8]) (add-nodes 9))
g5 dwg
g6 (transpose g1)]
(testing "Construction, nodes, edges"
(are [expected got] (= expected got)
#{1 2 3 4} (set (nodes g1))
#{1 2 3 4} (set (nodes g6))
#{[1 2] [1 3] [2 3]} (set (edges g1))
#{[2 1] [3 1] [3 2]} (set (edges g6))
#{1 2 3 4 5 6 7 8 9} (set (nodes g4))
#{[1 2] [1 3] [2 3] [5 6] [6 5] [7 8]} (set (edges g4))
#{} (set (nodes g5))
#{} (set (edges g5))
true (has-node? g1 4)
true (has-edge? g1 1 2)
false (has-node? g1 5)
false (has-edge? g1 2 1)))
(testing "Successors"
(are [expected got] (= expected got)
#{2 3} (set (successors g1 1))
#{} (set (successors g1 3))
#{} (set (successors g1 4))
2 (out-degree g1 1)
0 (out-degree g1 3)
0 (out-degree g1 4)
#{1 2} (set (predecessors g1 3))
#{} (set (predecessors g1 1))
2 (in-degree g1 3)
0 (in-degree g1 1)
#{1 2} (set (successors g6 3))
#{} (set (successors g6 1))
2 (out-degree g6 3)
0 (out-degree g6 1)))
(testing "Add & remove"
(are [expected got] (= expected got)
#{1 2 3 4 5} (set (nodes (add-nodes g1 5)))
#{:a :b :c} (set (nodes (add-nodes g5 :a :b :c)))
#{{:id 1} {:id 2}} (set (nodes (add-nodes g5 {:id 1} {:id 2})))
#{[1 2]} (set (edges (add-edges g5 [1 2])))
#{1 2} (set (nodes (remove-nodes g1 3 4)))
#{[1 2]} (set (edges (remove-nodes g1 3 4)))
#{1 2 3 4} (set (nodes (remove-edges g1 [1 2] [1 3])))
#{[2 3]} (set (edges (remove-edges g1 [1 2] [1 3])))))
(testing "Weight"
(are [expected got] (= expected got)
77 (weight g1 1 2)
77 (weight g6 2 1)
88 (weight g4 6 5)
1 (weight g4 7 8)))))

67
test-resources/lib_tests/loom/test/derived.cljc Normal file
View file

@ -0,0 +1,67 @@
(ns loom.test.derived
(:require [loom.derived :refer [mapped-by nodes-filtered-by edges-filtered-by
subgraph-reachable-from bipartite-subgraph]]
[loom.graph :refer (graph digraph edges)]
[loom.alg :refer (eql?)]
#?@(:clj [[clojure.test :refer :all]]
:cljs [cljs.test]))
#?@(:cljs [(:require-macros [cljs.test :refer (deftest testing are is)])]))
(deftest derived-graph-test
(let [g (graph [1 2] [1 3] [2 3] 4)
dg (digraph [1 2] [1 3] [2 3] 4)]
(testing "mapped-by"
(are [expected got] (= expected got)
true (eql? g
(mapped-by identity g))
true (eql? (graph [2 3] [2 4] [3 4] 5)
(mapped-by inc g))
true (eql? (graph [2 0] [2 1] [0 1] 2)
(mapped-by #(mod % 3) g))
;; digraph
true (eql? dg
(mapped-by identity dg))
true (eql? (digraph [2 3] [2 4] [3 4] 5)
(mapped-by inc dg))
true (eql? (digraph [2 0] [1 2] [1 0])
(mapped-by #(mod % 3) dg))))
(testing "nodes filtered"
(are [expected got] (= expected got)
true (eql? (graph)
(nodes-filtered-by #{} g))
true (eql? (graph [1 2] 4)
(nodes-filtered-by #{1 2 4} g))
true (eql? (digraph [1 2] 4)
(nodes-filtered-by #{1 2 4} dg))))
(testing "edges filtered"
(are [expected got] (= expected got)
true (eql? (graph 1 2 3 4)
(edges-filtered-by #(= nil %) g))
true (eql? (graph [1 2] [1 3] 4)
(edges-filtered-by #(= 1 (first %)) g))
true (eql? (digraph [1 2] 3 4)
(edges-filtered-by #{[1 2] [2 4]} dg))))
(testing "subgraph from start node"
(are [expected got] (= expected got)
true (eql? (graph [1 2] [1 3] [2 3])
(subgraph-reachable-from g 2))
true (eql? (graph 4)
(subgraph-reachable-from g 4))
true (eql? (digraph [2 3])
(subgraph-reachable-from dg 2))))))
(deftest bipartite-subgraph-test
(let [dg (digraph [1 2] [2 3] [4 5] [5 6] [3 4] [2 4] [1 6])
ug (graph dg)]
(testing "bipartite subgraph"
(are [expected got] (= expected got)
'([1 6] [2 4] [3 4]) (sort (edges (bipartite-subgraph dg [1 2 3])))
'([5 6]) (edges (bipartite-subgraph dg [4 5]))
true (eql? (graph [2 4] [3 4] [5 6])
(bipartite-subgraph ug [4 5]))))))

54
test-resources/lib_tests/loom/test/flow.cljc Normal file
View file

@ -0,0 +1,54 @@
(ns loom.test.flow
(:require [loom.graph :refer (weighted-digraph successors predecessors weight)]
[loom.flow :refer (edmonds-karp is-admissible-flow?)]
[loom.alg :refer [max-flow]]
#?@(:clj [[clojure.test :refer :all]]
:cljs [cljs.test]))
#?@(:cljs [(:require-macros [cljs.test :refer (deftest testing are is)])]))
;; Trivial case
(def g0
(weighted-digraph
[:s :t 100]))
;; From Cormen et al. Algorithms, 3 ed. p. 726-727
(def g1
(weighted-digraph
[:s :v1 16]
[:s :v2 13]
[:v1 :v3 12]
[:v2 :v1 4]
[:v2 :v4 14]
[:v3 :v2 9]
[:v3 :t 20]
[:v4 :v3 7]
[:v4 :t 4]))
;; Source and sink disconnected
(def g2
(weighted-digraph
[:s :a 5]
[:b :t 10]))
(deftest edmonds-karp-test
(are [max-value network]
(let [[flow value] (edmonds-karp (successors network)
(predecessors network)
(weight network)
:s :t)]
(and (= max-value value)
(is-admissible-flow? flow (weight network)
:s :t)))
23 g1
100 g0
0 g2))
(deftest max-flow-convenience-test
(are [max-value network]
(let [[flow value] (max-flow (weighted-digraph network) :s :t)]
(and (= max-value value)
(is-admissible-flow? flow (weight network) :s :t)))
23 g1))

207
test-resources/lib_tests/loom/test/graph.cljc Normal file
View file

@ -0,0 +1,207 @@
(ns loom.test.graph
(:require [loom.graph :refer (graph digraph weighted-graph weighted-digraph
nodes edges has-node? has-edge? transpose fly-graph
weight graph? Graph directed? Digraph weighted?
WeightedGraph subgraph add-path add-cycle)]
[loom.attr :as attr]
#?@(:clj [[clojure.test :refer (deftest testing are is)]])
[loom.test.compliance-tester :refer [graph-test digraph-test
weighted-graph-test weighted-digraph-test]])
#?@(:cljs [(:require-macros [cljs.test :refer (deftest testing are is)])]))
(deftest test-default-implementations
(graph-test (graph))
(digraph-test (digraph))
(weighted-graph-test (weighted-graph))
(weighted-digraph-test (weighted-digraph)))
(deftest build-graph-test
(let [g1 (graph [1 2] [1 3] [2 3] 4)
g2 (graph {1 [2 3] 2 [3] 4 []})
g3 (graph g1)
g4 (graph g3 (digraph [5 6]) [7 8] 9)
g5 (graph)]
(testing "Construction, nodes, edges"
(are [expected got] (= expected got)
#{1 2 3 4} (set (nodes g1))
#{[1 2] [2 1] [1 3] [3 1] [2 3] [3 2]} (set (edges g1))
(set (nodes g2)) (set (nodes g1))
(set (edges g2)) (set (edges g1))
(set (nodes g3)) (set (nodes g1))
(set (nodes g3)) (set (nodes g1))
#{1 2 3 4 5 6 7 8 9} (set (nodes g4))
#{[1 2] [2 1] [1 3] [3 1] [2 3]
[3 2] [5 6] [6 5] [7 8] [8 7]} (set (edges g4))
#{} (set (nodes g5))
#{} (set (edges g5))
true (has-node? g1 4)
true (has-edge? g1 1 2)
false (has-node? g1 5)
false (has-edge? g1 4 1)))))
(deftest simple-graph-test
(let [g1 (graph [1 2] [1 3] [2 3] 4)
g2 (graph {1 [2 3] 2 [3] 4 []})
g3 (graph g1)
g4 (graph g3 (digraph [5 6]) [7 8] 9)
g5 (graph)]
(testing "Construction, nodes, edges"
(are [expected got] (= expected got)
#{1 2 3 4} (set (nodes g1))
#{[1 2] [2 1] [1 3] [3 1] [2 3] [3 2]} (set (edges g1))
(set (nodes g2)) (set (nodes g1))
(set (edges g2)) (set (edges g1))
(set (nodes g3)) (set (nodes g1))
(set (nodes g3)) (set (nodes g1))
#{1 2 3 4 5 6 7 8 9} (set (nodes g4))
#{[1 2] [2 1] [1 3] [3 1] [2 3]
[3 2] [5 6] [6 5] [7 8] [8 7]} (set (edges g4))
#{} (set (nodes g5))
#{} (set (edges g5))
true (has-node? g1 4)
true (has-edge? g1 1 2)
false (has-node? g1 5)
false (has-edge? g1 4 1)))))
(deftest simple-digraph-test
(let [g1 (digraph [1 2] [1 3] [2 3] 4)
g2 (digraph {1 [2 3] 2 [3] 4 []})
g3 (digraph g1)
g4 (digraph g3 (graph [5 6]) [7 8] 9)
g5 (digraph)
g6 (transpose g1)]
(testing "Construction, nodes, edges"
(are [expected got] (= expected got)
#{1 2 3 4} (set (nodes g1))
#{1 2 3 4} (set (nodes g6))
#{[1 2] [1 3] [2 3]} (set (edges g1))
#{[2 1] [3 1] [3 2]} (set (edges g6))
(set (nodes g2)) (set (nodes g1))
(set (edges g2)) (set (edges g1))
(set (nodes g3)) (set (nodes g1))
(set (nodes g3)) (set (nodes g1))
#{1 2 3 4 5 6 7 8 9} (set (nodes g4))
#{[1 2] [1 3] [2 3] [5 6] [6 5] [7 8]} (set (edges g4))
#{} (set (nodes g5))
#{} (set (edges g5))
true (has-node? g1 4)
true (has-edge? g1 1 2)
false (has-node? g1 5)
false (has-edge? g1 2 1)))))
(deftest simple-weighted-graph-test
(let [g1 (weighted-graph [1 2 77] [1 3 88] [2 3 99] 4)
g2 (weighted-graph {1 {2 77 3 88} 2 {3 99} 4 []})
g3 (weighted-graph g1)
g4 (weighted-graph g3 (weighted-digraph [5 6 88]) [7 8] 9)
g5 (weighted-graph)]
(testing "Construction, nodes, edges"
(are [expected got] (= expected got)
#{1 2 3 4} (set (nodes g1))
#{[1 2] [2 1] [1 3] [3 1] [2 3] [3 2]} (set (edges g1))
(set (nodes g2)) (set (nodes g1))
(set (edges g2)) (set (edges g1))
(set (nodes g3)) (set (nodes g1))
(set (nodes g3)) (set (nodes g1))
#{1 2 3 4 5 6 7 8 9} (set (nodes g4))
#{[1 2] [2 1] [1 3] [3 1] [2 3]
[3 2] [5 6] [6 5] [7 8] [8 7]} (set (edges g4))
#{} (set (nodes g5))
#{} (set (edges g5))
true (has-node? g1 4)
true (has-edge? g1 1 2)
false (has-node? g1 5)
false (has-edge? g1 4 1)))))
(deftest simple-weighted-digraph-test
(let [g1 (weighted-digraph [1 2 77] [1 3 88] [2 3 99] 4)
g2 (weighted-digraph {1 {2 77 3 88} 2 {3 99} 4 []})
g3 (weighted-digraph g1)
g4 (weighted-digraph g3 (weighted-graph [5 6 88]) [7 8] 9)
g5 (weighted-digraph)
g6 (transpose g1)]
(testing "Construction, nodes, edges"
(are [expected got] (= expected got)
#{1 2 3 4} (set (nodes g1))
#{1 2 3 4} (set (nodes g6))
#{[1 2] [1 3] [2 3]} (set (edges g1))
#{[2 1] [3 1] [3 2]} (set (edges g6))
(set (nodes g2)) (set (nodes g1))
(set (edges g2)) (set (edges g1))
(set (nodes g3)) (set (nodes g1))
(set (nodes g3)) (set (nodes g1))
#{1 2 3 4 5 6 7 8 9} (set (nodes g4))
#{[1 2] [1 3] [2 3] [5 6] [6 5] [7 8]} (set (edges g4))
#{} (set (nodes g5))
#{} (set (edges g5))
true (has-node? g1 4)
true (has-edge? g1 1 2)
false (has-node? g1 5)
false (has-edge? g1 2 1)))))
(deftest fly-graph-test
(let [fg1 (fly-graph :nodes [1 2 3]
:successors #(if (= 3 %) [1] [(inc %)])
:weight (constantly 88))
fg2 (fly-graph :successors #(if (= 3 %) [1] [(inc %)])
:start 1)]
(testing "Construction, nodes, edges"
(are [expected got] (= expected got)
#{1 2 3} (set (nodes fg1))
#{1 2 3} (set (nodes fg2))
#{[1 2] [2 3] [3 1]} (set (edges fg1))
#{[1 2] [2 3] [3 1]} (set (edges fg2))
88 (weight fg1 1 2)))
(testing "Predicates"
(are [expected got] (= expected got)
1 (has-node? fg1 1)
nil (has-node? fg1 11)
2 (has-node? fg2 2)
nil (has-node? fg2 11)))
;; TODO: finish
))
(deftest merge-graph-test
(testing "two graphs with attributes"
(let [g1 (attr/add-attr (digraph [1 2] 3 [1 4]) 1 :label "One")
g2 (attr/add-attr (digraph [1 3] [3 5]) 5 :label "Five")
merged (digraph g1 g2)]
(is (= "One" (attr/attr merged 1 :label)))
(is (= "Five" (attr/attr merged 5 :label)))))
(testing "with two weighted graphs"
(let [g1 (attr/add-attr (weighted-graph [1 2] 3 [1 4]) 1 :label "One")
g2 (attr/add-attr (weighted-graph [1 3] [3 5]) 5 :label "Five")
merged (weighted-graph g1 g2)]
(is (= "One" (attr/attr merged 1 :label)))
(is (= "Five" (attr/attr merged 5 :label))))))
(deftest utilities-test
(testing "Predicates"
(are [expected got] (= expected got)
true (every? true? (map graph? [(graph [1 2])
(digraph [1 2])
(weighted-graph [1 2])
(weighted-digraph [1 2])
(fly-graph :successors [1 2])
(reify Graph)]))
true (every? true? (map directed? [(digraph [1 2])
(weighted-digraph [1 2])
(fly-graph :predecessors [1 2])
(reify Digraph)]))
true (every? true? (map weighted? [(weighted-graph [1 2])
(weighted-digraph [1 2])
(fly-graph :weight (constantly 1))
(reify WeightedGraph)]))))
(testing "Adders"
(let [g (weighted-digraph [1 2] [2 3] [3 1])
sg (subgraph g [1 2])
pg (add-path (digraph) 1 2 3 4 5)
cg (add-cycle (digraph) 1 2 3)]
(are [expected got] (= expected got)
#{1 2} (set (nodes sg))
#{[1 2]} (set (edges sg))
true (graph? sg)
true (directed? sg)
true (weighted? sg)
#{[1 2] [2 3] [3 4] [4 5]} (set (edges pg))
#{[1 2] [2 3] [3 1]} (set (edges cg))))))

26
test-resources/lib_tests/loom/test/label.cljc Normal file
View file

@ -0,0 +1,26 @@
(ns loom.test.label
(:require [loom.graph :as g]
[loom.label :as lbl]
#?@(:clj [[clojure.test :refer (deftest is)]]))
#?@(:cljs [(:require-macros [cljs.test :refer (deftest is)])]))
(deftest labeled-graph-test
(let [g (g/digraph [1 2] [2 3] [2 4] [3 5] [4 5])
lg1 (-> g
(lbl/add-label 1 "node label")
(lbl/add-label 2 3 "edge label"))
lg2 (-> (g/digraph)
(lbl/add-labeled-nodes
1 "node label 1"
2 "node label 2")
(lbl/add-labeled-edges
[1 2] "edge label 1"
[2 3] "edge label 2"))]
(is (= "node label" (lbl/label lg1 1)))
(is (= "edge label" (lbl/label lg1 2 3)))
(is (= #{1 2 3} (set (g/nodes lg2))))
(is (= #{[1 2] [2 3]} (set (g/edges lg2))))
(is (= "node label 1" (lbl/label lg2 1)))
(is (= "node label 2" (lbl/label lg2 2)))
(is (= "edge label 1" (lbl/label lg2 1 2)))
(is (= "edge label 2" (lbl/label lg2 2 3)))))

270
test-resources/lib_tests/loom/test/network_simplex.cljc Normal file
View file

@ -0,0 +1,270 @@
(ns loom.test.network-simplex
(:require
[loom.network-simplex :refer [build-graph solve]]
#?(:cljs [cljs.test :as t :refer-macros [is are deftest testing run-tests]]
:clj [clojure.test :as t :refer [is are deftest testing]])))
;; The majority of these tests are ported to cljc from networkx's python implementation:
;; https://github.com/networkx/networkx/blob/master/networkx/algorithms/flow/tests/test_mincost.py
;; All credit is due to the networkx team, whose code comments are also included below:
(def simple-graph
(build-graph
[[:a :b {:capacity 4 :cost 3}]
[:a :c {:capacity 10 :cost 6}]
[:b :d {:capacity 9 :cost 1}]
[:c :d {:capacity 5 :cost 2}]]
[[:a {:demand -5}]
[:d {:demand 5}]]))
(deftest simple-test
(testing "Simple graph"
(let [g simple-graph
[cost flow] (solve g)]
(is (= cost 24))
(is (= flow {:a {:b 4 :c 1}
:b {:d 4}
:c {:d 1}})))))
(def hex-graph
;; Algorithms in Java, Part 5: Graph Algorithms (third edition)
;; Figure 22.41.
(build-graph
[[:a :b {:capacity 3 :cost 3}]
[:a :c {:capacity 3 :cost 1}]
[:b :d {:capacity 2 :cost 1}]
[:b :e {:capacity 2 :cost 1}]
[:c :d {:capacity 1 :cost 4}]
[:c :e {:capacity 2 :cost 2}]
[:d :f {:capacity 2 :cost 2}]
[:e :f {:capacity 2 :cost 1}]]
[[:a {:demand -4}]
[:f {:demand 4}]]))
(deftest hex-test
(testing "Hex graph"
(let [g hex-graph
[cost flow] (solve g)]
(is (= cost 20))
(is (= flow
{:a {:b 2 :c 2}
:b {:d 2 :e 0}
:c {:e 2 :d 0}
:d {:f 2}
:e {:f 2}})))))
(def trans-graph
(build-graph
[[:a :c {:cost 3}]
[:r :a {:cost 2}]
[:b :a {:cost 9}]
[:r :c {:cost 0}]
[:b :r {:cost -6}]
[:c :d {:cost 5}]
[:e :r {:cost 4}]
[:e :f {:cost 3}]
[:h :b {:cost 4}]
[:f :d {:cost 7}]
[:f :h {:cost 12}]
[:g :d {:cost 12}]
[:f :g {:cost -1}]
[:h :g {:cost -10}]]
[[:a {:demand 1}]
[:b {:demand -2}]
[:c {:demand -2}]
[:d {:demand 3}]
[:e {:demand -4}]
[:f {:demand -4}]
[:g {:demand 3}]
[:h {:demand 2}]
[:r {:demand 3}]]))
(deftest trans-shipment-test
(testing "Trans-shipment"
(let [g trans-graph
[cost flow] (solve g)
]
(is (= cost 41))
(is (= flow
{:a {:c 0},
:b {:a 0, :r 2},
:c {:d 3},
:e {:r 3, :f 1},
:f {:d 0, :g 3, :h 2},
:g {:d 0}
:h {:b 0, :g 0},
:r {:a 1, :c 1}})))))
(def maxflow-mincost-graph
(build-graph
[[:s :a {:capacity 6}]
[:s :c {:capacity 10 :cost 10}]
[:a :b {:cost 6}]
[:b :d {:capacity 8 :cost 7}]
[:c :d {:cost 10}]
[:d :t {:capacity 5 :cost 5}]]
[[:s {:demand -5}]
[:t {:demand 5}]]))
(deftest maxflow-mincost-test
(testing "Maxflow-mincost"
(let [g maxflow-mincost-graph
[cost flow] (solve g)]
(is (= cost 90))
(is (= flow
{:s {:a 5 :c 0}
:a {:b 5}
:b {:d 5}
:c {:d 0}
:d {:t 5}})))))
(def digraph1
;; From Bradley, S. P., Hax, A. C. and Magnanti, T. L.
;; Applied Mathematical Programming. Addison-Wesley, 1977.
(build-graph
[[1 2 {:capacity 15 :cost 4}]
[1 3 {:capacity 8 :cost 4}]
[2 3 {:cost 2}]
[2 4 {:capacity 4 :cost 2}]
[2 5 {:capacity 10 :cost 6}]
[3 4 {:capacity 15 :cost 1}]
[3 5 {:capacity 5 :cost 3}]
[4 5 {:cost 2}]
[5 3 {:capacity 4 :cost 1}]]
[[1 {:demand -20}]
[4 {:demand 5}]
[5 {:demand 15}]]))
(deftest digraph1-test
(testing "Digraph 1"
(let [g digraph1
[cost flow] (solve g)]
(is (= cost 150))
(is (= flow
{1 {2 12, 3 8},
2 {3 8, 4 4, 5 0},
3 {4 11, 5 5},
4 {5 10},
5 {3 0}})))))
(def digraph2
;; Example from ticket #430 from mfrasca.
;; See slide 11 for original source:
;; http://www.cs.princeton.edu/courses/archive/spr03/cs226/lectures/mincost.4up.pdf
(build-graph
[[:s 1 {:capacity 12}]
[:s 2 {:capacity 6}]
[:s 3 {:capacity 14}]
[1 2 {:capacity 11 :cost 4}]
[2 3 {:capacity 9 :cost 6}]
[1 4 {:capacity 5 :cost 5}]
[1 5 {:capacity 2 :cost 12}]
[2 5 {:capacity 4 :cost 4}]
[2 6 {:capacity 2 :cost 6}]
[3 6 {:capacity 31 :cost 3}]
[4 5 {:capacity 18 :cost 4}]
[5 6 {:capacity 9 :cost 5}]
[4 :t {:capacity 3}]
[5 :t {:capacity 7}]
[6 :t {:capacity 22}]]
[[:s {:demand -32}]
[:t {:demand 32}]]))
(deftest digraph2-test
(testing "Digraph 2"
(let [g digraph2
[cost flow] (solve g)]
(is (= cost 193))
(is (= flow
{1 {2 6, 4 5, 5 1},
2 {3 6, 5 4, 6 2},
3 {6 20},
4 {5 2, :t 3},
5 {6 0, :t 7}
6 {:t 22}
:s {1 12, 2 6, 3 14}})))))
(def digraph3
;; Combinatorial Optimization: Algorithms and Complexity,
;; Papadimitriou Steiglitz at page 140 has an example, 7.1, but that
;; admits multiple solutions, so I alter it a bit.
;; From ticket #430 by mfrasca.
(build-graph
[[:s :a {:capacity 2 :cost 4}]
[:s :b {:capacity 2 :cost 1}]
[:a :b {:capacity 5 :cost 2}]
[:a :t {:capacity 1 :cost 5}]
[:b :a {:capacity 1 :cost 3}]
[:b :t {:capacity 3 :cost 2}]]
[[:s {:demand -4}]
[:t {:demand 4}]]))
(deftest digraph3-test
(testing "Digraph 3"
(let [g digraph3
[cost flow] (solve g)]
;; PS.ex.7.1: testing main function
(is (= cost 23))
(is (= flow
{:s {:a 2, :b 2}
:a {:b 1, :t 1}
:b {:a 0, :t 3}})))))
(def digon
(build-graph
[[1 2 {:capacity 3 :cost 600000}]
[2 1 {:capacity 2 :cost 0}]
[2 3 {:capacity 5 :cost 714285}]
[3 2 {:capacity 1 :cost 0}]]
[[2 {:demand -4}]
[3 {:demand 4}]]))
(deftest digon-test
(testing "Digon"
(let [g digon
[cost flow] (solve g)]
(is (= cost 2857140))
(is (= flow
{1 {2 0}
2 {1 0, 3 4}
3 {2 0}})))))
(def neg-self-loop
(build-graph
[[1 1 {:capacity 2 :cost -1}]]
[]))
(deftest neg-self-loop-test
;; Negative selfloops should cause an exception if uncapacitated and
;; always be saturated otherwise.
(testing "Negative self-loops"
(let [g neg-self-loop
[cost flow] (solve g)]
(is (= cost -2))
(is (= flow
{1 {1 2}})))))
(def bone-shaped
(build-graph
[[0 1 {:capacity 4}]
[0 2 {:capacity 4}]
[4 3 {:capacity 4}]
[5 3 {:capacity 4}]
[0 3 {:capacity 0}]]
[[0 {:demand -4}]
[1 {:demand 2}]
[2 {:demand 2}]
[3 {:demand 4}]
[4 {:demand -2}]
[5 {:demand -2}]]))
(deftest bone-shaped-test
(testing "Bone-shaped"
(let [g bone-shaped
[cost flow] (solve g)]
(is (= cost 0))
(is (= flow
{0 {1 2, 2 2, 3 0}
4 {3 2}
5 {3 2}})))))

12
test-resources/lib_tests/loom/test/runner.cljs Normal file
View file

@ -0,0 +1,12 @@
(ns loom.test.runner
(:require [cljs.test :as test]
[doo.runner :refer-macros [doo-all-tests doo-tests]]
loom.test.alg
loom.test.alg-generic
loom.test.attr
loom.test.derived
loom.test.flow
loom.test.graph
loom.test.label))
(doo-all-tests)