From 3759d14baf2024d9d58c70e21c6ef2ea11079615 Mon Sep 17 00:00:00 2001 From: Michiel Borkent Date: Fri, 11 Mar 2022 12:23:31 +0100 Subject: [PATCH] Add clojure.data.priority-map as built-in, support aysylu/loom lib (#1207) --- deps.edn | 7 +- doc/build.md | 1 + doc/libraries.csv | 1 + .../babashka/impl/priority_map.clj | 11 + project.clj | 3 + resources/META-INF/babashka/deps.edn | 7 +- script/compile | 1 + script/uberjar | 7 + script/uberjar.bat | 6 + src/babashka/impl/classes.clj | 2 + src/babashka/impl/features.clj | 4 + src/babashka/main.clj | 11 +- .../lib_tests/babashka/run_all_libtests.clj | 3 +- test-resources/lib_tests/bb-tested-libs.edn | 3 +- test-resources/lib_tests/loom/test/alg.cljc | 626 ++++++++++++++++++ .../lib_tests/loom/test/alg_generic.cljc | 217 ++++++ test-resources/lib_tests/loom/test/attr.cljc | 31 + .../loom/test/compliance_tester.cljc | 195 ++++++ .../lib_tests/loom/test/derived.cljc | 67 ++ test-resources/lib_tests/loom/test/flow.cljc | 54 ++ test-resources/lib_tests/loom/test/graph.cljc | 207 ++++++ test-resources/lib_tests/loom/test/label.cljc | 26 + .../lib_tests/loom/test/network_simplex.cljc | 270 ++++++++ .../lib_tests/loom/test/runner.cljs | 12 + 24 files changed, 1762 insertions(+), 10 deletions(-) create mode 100644 feature-priority-map/babashka/impl/priority_map.clj create mode 100644 test-resources/lib_tests/loom/test/alg.cljc create mode 100644 test-resources/lib_tests/loom/test/alg_generic.cljc create mode 100644 test-resources/lib_tests/loom/test/attr.cljc create mode 100644 test-resources/lib_tests/loom/test/compliance_tester.cljc create mode 100644 test-resources/lib_tests/loom/test/derived.cljc create mode 100644 test-resources/lib_tests/loom/test/flow.cljc create mode 100644 test-resources/lib_tests/loom/test/graph.cljc create mode 100644 test-resources/lib_tests/loom/test/label.cljc create mode 100644 test-resources/lib_tests/loom/test/network_simplex.cljc create mode 100644 test-resources/lib_tests/loom/test/runner.cljs diff --git a/deps.edn b/deps.edn index 9f7e855c..72c3dbe5 100644 --- a/deps.edn +++ b/deps.edn @@ -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 diff --git a/doc/build.md b/doc/build.md index 62f0ed43..5571fa02 100644 --- a/doc/build.md +++ b/doc/build.md @@ -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. diff --git a/doc/libraries.csv b/doc/libraries.csv index c8b044fc..dcabbad8 100644 --- a/doc/libraries.csv +++ b/doc/libraries.csv @@ -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 diff --git a/feature-priority-map/babashka/impl/priority_map.clj b/feature-priority-map/babashka/impl/priority_map.clj new file mode 100644 index 00000000..52f46c8f --- /dev/null +++ b/feature-priority-map/babashka/impl/priority_map.clj @@ -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)}) diff --git a/project.clj b/project.clj index ffbb9ac2..dbeff965 100644 --- a/project.clj +++ b/project.clj @@ -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} diff --git a/resources/META-INF/babashka/deps.edn b/resources/META-INF/babashka/deps.edn index 9f7e855c..72c3dbe5 100644 --- a/resources/META-INF/babashka/deps.edn +++ b/resources/META-INF/babashka/deps.edn @@ -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 diff --git a/script/compile b/script/compile index f56d0c83..22ea8eec 100755 --- a/script/compile +++ b/script/compile @@ -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[@]}" diff --git a/script/uberjar b/script/uberjar index 126e659b..880aba4e 100755 --- a/script/uberjar +++ b/script/uberjar @@ -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 diff --git a/script/uberjar.bat b/script/uberjar.bat index b7bcd2d1..2ae3beb6 100755 --- a/script/uberjar.bat +++ b/script/uberjar.bat @@ -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 diff --git a/src/babashka/impl/classes.clj b/src/babashka/impl/classes.clj index 72b8896d..aa339c11 100644 --- a/src/babashka/impl/classes.clj +++ b/src/babashka/impl/classes.clj @@ -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 diff --git a/src/babashka/impl/features.clj b/src/babashka/impl/features.clj index 22c7a326..00eaa26e 100644 --- a/src/babashka/impl/features.clj +++ b/src/babashka/impl/features.clj @@ -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])) diff --git a/src/babashka/main.clj b/src/babashka/main.clj index 42020e46..6a3cf951 100644 --- a/src/babashka/main.clj +++ b/src/babashka/main.clj @@ -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? diff --git a/test-resources/lib_tests/babashka/run_all_libtests.clj b/test-resources/lib_tests/babashka/run_all_libtests.clj index 19a8f04f..56fcda74 100644 --- a/test-resources/lib_tests/babashka/run_all_libtests.clj +++ b/test-resources/lib_tests/babashka/run_all_libtests.clj @@ -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)))))))) diff --git a/test-resources/lib_tests/bb-tested-libs.edn b/test-resources/lib_tests/bb-tested-libs.edn index dafbe85b..2c4a7428 100644 --- a/test-resources/lib_tests/bb-tested-libs.edn +++ b/test-resources/lib_tests/bb-tested-libs.edn @@ -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"}} diff --git a/test-resources/lib_tests/loom/test/alg.cljc b/test-resources/lib_tests/loom/test/alg.cljc new file mode 100644 index 00000000..3b009ab1 --- /dev/null +++ b/test-resources/lib_tests/loom/test/alg.cljc @@ -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))) diff --git a/test-resources/lib_tests/loom/test/alg_generic.cljc b/test-resources/lib_tests/loom/test/alg_generic.cljc new file mode 100644 index 00000000..e98330b1 --- /dev/null +++ b/test-resources/lib_tests/loom/test/alg_generic.cljc @@ -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)) diff --git a/test-resources/lib_tests/loom/test/attr.cljc b/test-resources/lib_tests/loom/test/attr.cljc new file mode 100644 index 00000000..8ca252e6 --- /dev/null +++ b/test-resources/lib_tests/loom/test/attr.cljc @@ -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))))) diff --git a/test-resources/lib_tests/loom/test/compliance_tester.cljc b/test-resources/lib_tests/loom/test/compliance_tester.cljc new file mode 100644 index 00000000..bca9d65f --- /dev/null +++ b/test-resources/lib_tests/loom/test/compliance_tester.cljc @@ -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))))) diff --git a/test-resources/lib_tests/loom/test/derived.cljc b/test-resources/lib_tests/loom/test/derived.cljc new file mode 100644 index 00000000..c6dce6e4 --- /dev/null +++ b/test-resources/lib_tests/loom/test/derived.cljc @@ -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])))))) diff --git a/test-resources/lib_tests/loom/test/flow.cljc b/test-resources/lib_tests/loom/test/flow.cljc new file mode 100644 index 00000000..55415874 --- /dev/null +++ b/test-resources/lib_tests/loom/test/flow.cljc @@ -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)) diff --git a/test-resources/lib_tests/loom/test/graph.cljc b/test-resources/lib_tests/loom/test/graph.cljc new file mode 100644 index 00000000..7f493dc8 --- /dev/null +++ b/test-resources/lib_tests/loom/test/graph.cljc @@ -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)))))) diff --git a/test-resources/lib_tests/loom/test/label.cljc b/test-resources/lib_tests/loom/test/label.cljc new file mode 100644 index 00000000..42e1198a --- /dev/null +++ b/test-resources/lib_tests/loom/test/label.cljc @@ -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))))) diff --git a/test-resources/lib_tests/loom/test/network_simplex.cljc b/test-resources/lib_tests/loom/test/network_simplex.cljc new file mode 100644 index 00000000..7a388f20 --- /dev/null +++ b/test-resources/lib_tests/loom/test/network_simplex.cljc @@ -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}}))))) diff --git a/test-resources/lib_tests/loom/test/runner.cljs b/test-resources/lib_tests/loom/test/runner.cljs new file mode 100644 index 00000000..2287b358 --- /dev/null +++ b/test-resources/lib_tests/loom/test/runner.cljs @@ -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)