'[[0 3] [1 4] [2 5]]
)))
-(deftest test-new-ids
- (let [gr0 (gr/new-graph)
- [gr1 & ids] (gr/new-ids gr0 'and2 'or2 'not2 'e)]
- (is (= gr0 {:next-id 0 :conns ()}))
- (is (= gr1 {:next-id 4 :conns ()}))
- (is (= ids '(and2-0 or2-1 not2-2 e-3)))
- ))
-
-
-; gr-not1
-; _ |\ _
-; b |_|----------| >o---------|_| z
-; |/
-;
-; _ |\ _
-; a |_|----------| >o---------|_| y
-; |/
-;
-(def gr-not1
- (let [gr (gr/new-graph)
- [gr a b] (gr/inputs gr 'a 'b)
- [gr y] (gr/not1 gr a)
- [gr z] (gr/not1 gr b)
- gr (gr/outputs gr [y 'y] [z 'z])]
- gr))
-
-(deftest test-not1
- (is (= gr-not1
- {:next-id 10
- :conns '[ [[] [in-0 in a] [e-1]]
- [[] [in-2 in b] [e-3]]
- [[e-1] [not1-4 not1] [e-5]]
- [[e-3] [not1-6 not1] [e-7]]
- [[e-5] [out-8 out y] []]
- [[e-7] [out-9 out z] []]
- ]}))
- (is (= (gr/all-eids gr-not1)
- '[e-1 e-3 e-5 e-7]))
-)
-
-; gr-and2
-; _ __
-; b |_|----------| \ _
-; _ | |--------|_| z
-; a |_|----------|__/
-;
-(def gr-and2
- (let [gr (gr/new-graph)
- [gr a b] (gr/inputs gr 'a 'b)
- [gr z] (gr/and2 gr a b)
- gr (gr/outputs gr [z 'z])]
- gr))
-
-(deftest test-and2
- (is (= gr-and2
- {:next-id 7
- :conns '[ [[] [in-0 in a] [e-1]]
- [[] [in-2 in b] [e-3]]
- [[e-1 e-3] [and2-4 and2] [e-5]]
- [[e-5] [out-6 out z] [] ]
- ]}))
-)
-
-; gr-andn
-; _ __
-; c |_|----------| \
-; _ | | _
-; b |_|----------| |--------|_| z
-; _ | |
-; a |_|----------|__/
-;
-(def gr-andn
- (let [gr (gr/new-graph)
- [gr a b c] (gr/inputs gr 'a 'b 'c)
- [gr z] (gr/andn gr a b c)
- gr (gr/outputs gr [z 'z])]
- gr))
-
-(deftest test-andn
- (is (= gr-andn
- {:next-id 9
- :conns '[ [[] [in-0 in a] [e-1]]
- [[] [in-2 in b] [e-3]]
- [[] [in-4 in c] [e-5]]
- [[e-1 e-3 e-5] [andn-6 andn] [e-7]]
- [[e-7] [out-8 out z] [] ]
- ]}))
-)
-
-; gr-or2
-; _ __
-; b |_|----------\ \ _
-; _ | |--------|_| z
-; a |_|----------/__/
-;
-(def gr-or2
- (let [gr (gr/new-graph)
- [gr a b] (gr/inputs gr 'a 'b)
- [gr z] (gr/or2 gr a b)
- gr (gr/outputs gr [z 'z])]
- gr))
-
-(deftest test-or2
- (is (= gr-or2
- {:next-id 7
- :conns '[ [[] [in-0 in a] [e-1]]
- [[] [in-2 in b] [e-3]]
- [[e-1 e-3] [or2-4 or2] [e-5]]
- [[e-5] [out-6 out z] [] ]
- ]}))
-)
-
-; gr-orn
-; _ __
-; c |_|----------\ \
-; _ | | _
-; b |_|-----------| |--------|_| z
-; _ | |
-; a |_|----------/__/
-;
-(def gr-orn
- (let [gr (gr/new-graph)
- [gr a b c] (gr/inputs gr 'a 'b 'c)
- [gr z] (gr/orn gr a b c)
- gr (gr/outputs gr [z 'z])]
- gr))
-
-(deftest test-orn
- (is (= gr-orn
- {:next-id 9
- :conns '[ [[] [in-0 in a] [e-1]]
- [[] [in-2 in b] [e-3]]
- [[] [in-4 in c] [e-5]]
- [[e-1 e-3 e-5] [orn-6 orn] [e-7]]
- [[e-7] [out-8 out z] [] ]
- ]}))
-)
-
-
-(def gr-unrefered-conns1
- (struct gr/graph 14
- '[ [[] [in-0 in a] [e-1] ]
- [[] [in-2 in b] [e-3] ]
- [[] [in-4 in c] [e-5] ]
- [[e-1 e-3] [and2-6 and2] [e-7] ]
- [[e-5] [not1-8 not1] [e-9] ]
- [[e-9] [not1-10 not1] [e-11]]
- [[e-7] [out-12 out z] [e-13]] ]))
-
-(deftest test-remove-unrefered-conns
- (is (= (gr/remove-unrefered-conns gr-unrefered-conns1)
- {:next-id 14
- :conns '[ [[] [in-0 in a] [e-1] ]
- [[] [in-2 in b] [e-3] ]
- [[] [in-4 in c] [e-5] ]
- [[e-1 e-3] [and2-6 and2] [e-7] ]
- [[e-7] [out-12 out z] [e-13]]
- ]}))
-)
-
-(deftest test-map
- (let [gr (gr/new-graph)
- [gr a b c] (gr/inputs gr 'a 'b 'c)
- [gr d e f] (gr/map gr gr/not1 [a b c])]
- (is (= gr
- {:next-id 12
- :conns '[ [[] [in-0 in a] [e-1] ]
- [[] [in-2 in b] [e-3] ]
- [[] [in-4 in c] [e-5] ]
- [[e-1] [not1-6 not1] [e-7] ]
- [[e-3] [not1-8 not1] [e-9] ]
- [[e-5] [not1-10 not1] [e-11]]
- ]}))))
-
-; sel-2in1
-; _ __
-; b |_|--------------------| \ f
-; | |--+ __
-; +-------------|__/ +--\ \ _
-; _ | |\ __ | |----|_| z
-; c |_|------+---| >o------| \ +--/__/
-; _ |/ d | |--+
-; a |_|--------------------|__/ e
-;
-(def sel-2in1
- (let [gr (gr/new-graph)
- [gr a b c] (gr/inputs gr 'a 'b 'c)
- [gr d] (gr/not1 gr c)
- [gr e] (gr/and2 gr a d)
- [gr f] (gr/and2 gr b c)
- [gr z] (gr/or2 gr f e)
- gr (gr/outputs gr [z 'z])]
- gr))
-
-; dump of 'sel-2in1'
-; commit 170da87b24b320ae99b50eea4a95b4f8a6b6b7d3
-; (use '[clojure.contrib.duck-streams :only (writer)])
-; (with-open [wtr (writer "hoge")]
-; (binding [*out* wtr]
-; (println sel-2in1)))
-;
-; { :next-id 15
-; , :conns [[[] [in-0 in a] [e-1] ]
-; [[] [in-2 in b] [e-3] ]
-; [[] [in-4 in c] [e-5] ]
-; [[e-5] [not1-6 not1] [e-7] ]
-; [[e-1 e-7] [and2-8 and2] [e-9] ]
-; [[e-3 e-5] [and2-10 and2] [e-11]]
-; [[e-11 e-9] [or2-12 or2] [e-13]]
-; [[e-13] [out-14 out z] [] ]]
-; }
-
-(defn dependency-test [dpn]
- (loop [dpn dpn saws #{}]
- (if (empty? dpn)
- true
- (let [conn (first dpn)]
- (if (every? #(saws %) (first conn))
- (recur (rest dpn)
- (into saws (set (nth conn 2))))
- false)))))
-
-(deftest test-dependency
- (is (dependency-test (gr/dependency (:conns sel-2in1) 'e-13)))
- )
-
-(deftest test-calc-along-dependency-1
- (is (= (gr/calc-along-dependency
- '[ [[] [in-0 in a] [e-1]]
- [[e-1] [not1-2 not1] [e-3]]
- [[e-3] [out-4 out z] [] ] ]
- '{a 0})
- '{e-1 0, e-3 1}))
- (let [dep '[ [[] [in-0 in a] [e-1]]
- [[] [in-2 in b] [e-3]]
- [[e-1 e-3] [and2-4 and2] [e-5]]
- [[e-5] [out-6 out z] [] ] ]]
- (is (= (gr/calc-along-dependency dep '{a 1, b 0})
- '{e-1 1, e-3 0, e-5 0}))
- (is (= (gr/calc-along-dependency dep '{a 1, b 1})
- '{e-1 1, e-3 1, e-5 1})))
- (let [dep '[ [[] [in-0 in a] [e-1]]
- [[] [in-2 in b] [e-3]]
- [[e-1 e-3] [or2-4 or2] [e-5]]
- [[e-5] [out-6 out z] [] ] ]]
- (is (= (gr/calc-along-dependency dep '{a 0, b 0})
- '{e-1 0, e-3 0, e-5 0}))
- (is (= (gr/calc-along-dependency dep '{a 1, b 0})
- '{e-1 1, e-3 0, e-5 1})))
-)
-
-(deftest test-calc-along-dependency-2
- (let [[z-conn] (filter (fn [[_ [_ type o-name] _]]
- (and (= type 'out)
- (= o-name 'z)))
- (:conns sel-2in1))
- [[z-eid]] z-conn]
- (let [result (gr/calc-along-dependency
- (gr/dependency (:conns sel-2in1) z-eid)
- '{a 0, b 1, c 0})]
- (is (= (result z-eid) 0)))
- (let [result (gr/calc-along-dependency
- (gr/dependency (:conns sel-2in1) z-eid)
- '{a 0, b 1, c 1})]
- (is (= (result z-eid) 1))))
-)
-
-(deftest test-calc
- (is (= (gr/calc sel-2in1 '{a 1, b 0, c 0})
- '{z 1}))
- (is (= (gr/calc sel-2in1 '{a 1, b 0, c 1})
- '{z 0}))
-)
-
-(def ha-table '[[0 0] [0 0]
- [1 0] [1 0]
- [0 1] [1 0]
- [1 1] [0 1]])
-
-(def gr-ha
- (let [gr (gr/new-graph)
- [gr a b] (gr/inputs gr 'a 'b)
- [gr s cout] (gr/truth-table gr (partition 2 ha-table) [a b])
- gr (gr/outputs gr [s 's] [cout 'cout])]
- (gr/remove-unrefered-conns gr)))
-
-(deftest test-calc-ha
- (is (= (gr/calc gr-ha '{a 0, b 0}) '{s 0, cout 0}))
- (is (= (gr/calc gr-ha '{a 1, b 0}) '{s 1, cout 0}))
- (is (= (gr/calc gr-ha '{a 0, b 1}) '{s 1, cout 0}))
- (is (= (gr/calc gr-ha '{a 1, b 1}) '{s 0, cout 1}))
- )
-
-(def fa-table '[[0 0 0] [0 0]
- [1 0 0] [1 0]
- [0 1 0] [1 0]
- [1 1 0] [0 1]
- [0 0 1] [1 0]
- [1 0 1] [0 1]
- [0 1 1] [0 1]
- [1 1 1] [1 1]])
-
-(def gr-fa
- (let [gr (gr/new-graph)
- [gr a b cin] (gr/inputs gr 'a 'b 'cin)
- [gr s cout] (gr/truth-table gr (partition 2 fa-table) [a b cin])
- gr (gr/outputs gr [s 's] [cout 'cout])]
- (gr/remove-unrefered-conns gr)))
-
-(deftest test-calc-fa
- (is (= (gr/calc gr-fa '{a 0, b 0, cin 0}) '{s 0, cout 0}))
- (is (= (gr/calc gr-fa '{a 1, b 0, cin 0}) '{s 1, cout 0}))
- (is (= (gr/calc gr-fa '{a 0, b 1, cin 0}) '{s 1, cout 0}))
- (is (= (gr/calc gr-fa '{a 1, b 1, cin 0}) '{s 0, cout 1}))
- (is (= (gr/calc gr-fa '{a 0, b 0, cin 1}) '{s 1, cout 0}))
- (is (= (gr/calc gr-fa '{a 1, b 0, cin 1}) '{s 0, cout 1}))
- (is (= (gr/calc gr-fa '{a 0, b 1, cin 1}) '{s 0, cout 1}))
- (is (= (gr/calc gr-fa '{a 1, b 1, cin 1}) '{s 1, cout 1}))
-)
-
-(deftest test-remove-nin-nodes
- (let [gr-fa (gr/remove-nin-nodes gr-fa)]
- (is (= (gr/calc gr-fa '{a 0, b 0, cin 0}) '{s 0, cout 0}))
- (is (= (gr/calc gr-fa '{a 1, b 0, cin 0}) '{s 1, cout 0}))
- (is (= (gr/calc gr-fa '{a 0, b 1, cin 0}) '{s 1, cout 0}))
- (is (= (gr/calc gr-fa '{a 1, b 1, cin 0}) '{s 0, cout 1}))
- (is (= (gr/calc gr-fa '{a 0, b 0, cin 1}) '{s 1, cout 0}))
- (is (= (gr/calc gr-fa '{a 1, b 0, cin 1}) '{s 0, cout 1}))
- (is (= (gr/calc gr-fa '{a 0, b 1, cin 1}) '{s 0, cout 1}))
- (is (= (gr/calc gr-fa '{a 1, b 1, cin 1}) '{s 1, cout 1})))
- (let [gr-ha (gr/remove-nin-nodes gr-ha)]
- (is (= (gr/calc gr-ha '{a 0, b 0}) '{s 0, cout 0}))
- (is (= (gr/calc gr-ha '{a 1, b 0}) '{s 1, cout 0}))
- (is (= (gr/calc gr-ha '{a 0, b 1}) '{s 1, cout 0}))
- (is (= (gr/calc gr-ha '{a 1, b 1}) '{s 0, cout 1})))
-)
-
-; __
-; ?i1 --------------------| \
-; | |---- ?o1
-; +-------------|__/
-; | |\ __
-; ?i2 ------+---| >o------| \
-; |/ ?m0 | |---- ?o0
-; ?i0 --------------------|__/
-;
-(def sel-2in1-ptn
- '[[[] [?in0 in 0] [?i0]]
- [[] [?in1 in 1] [?i1]]
- [[] [?in2 in 2] [?i2]]
- [[?i0 ?m0] [?and2-0 and2] [?o0]]
- [[?i1 ?i2] [?and2-1 and2] [?o1]]
- [[?i2] [?not1-0 not1] [?m0]]
- [[?o0] [?out0 out 0] [] ]
- [[?o1] [?out1 out 1] [] ]])
-
-(def sel-2in1-ptn-aft
- '[[[] [?ain0 in 0] [?ai0]]
- [[] [?ain1 in 1] [?ai1]]
- [[] [?ain2 in 2] [?ai2]]
- [[?ai0] [?anot1-1 not1] [?am1]] ; added to sel-2in1-ptn
- [[?am1] [?anot1-2 not1] [?am2]] ; added to sel-2in1-ptn
- [[?am2 ?am0] [?aand2-0 and2] [?ao0]]
- [[?ai1 ?ai2] [?aand2-1 and2] [?ao1]]
- [[?ai2] [?anot1-0 not1] [?am0]]
- [[?ao0] [?aout0 out 0] [] ]
- [[?ao1] [?aout1 out 1] [] ]])
-
-(deftest test-match1-sel-2in1
- (is (= (gr/match1 sel-2in1 (remove gr/in-or-out? sel-2in1-ptn))
- '{ ?i0 e-1
- , ?i1 e-3
- , ?i2 e-5
- , ?m0 e-7
- , ?and2-0 and2-8
- , ?and2-1 and2-10
- , ?not1-0 not1-6
- , ?o0 e-9
- , ?o1 e-11 }))
-)
-
-(deftest test-cut
- (is (= (gr/cut gr-not1 '[e-5 e-7])
- {:next-id 12
- :conns '[ [[] [in-0 in a] [e-1] ]
- [[] [in-2 in b] [e-3] ]
- [[e-1] [not1-4 not1] [u-10]]
- [[e-3] [not1-6 not1] [u-11]]
- [[e-5] [out-8 out y] [] ]
- [[e-7] [out-9 out z] [] ]
- ]}))
-)
-
-(deftest test-connect
- (let [gr (gr/connect gr-not1
- '{?b0 e-1, ?b2 e-5}
- '[[[?b0] [?a1 not1] [?a2]]
- [[?a2] [?a3 not1] [?a4]]
- [[?a4] [?a5 not1] [?b2]]])]
- (is (not= um/fail
- (um/unify (:conns gr)
- '[ [[] [in-0 in a] [e-1]]
- [[] [in-2 in b] [e-3]]
- [[e-1] [not1-4 not1] [e-5]]
- [[e-3] [not1-6 not1] [e-7]]
- [[e-5] [out-8 out y] [] ]
- [[e-7] [out-9 out z] [] ]
- [[e-1] [?x1 not1] [?x2]]
- [[?x2] [?x3 not1] [?x4]]
- [[?x4] [?x5 not1] [e-5]]
- ]))))
-)
-
-(deftest test-replace1
- (let [gr (struct gr/graph 9
- '[[[] [in-0 in a] [e-1]]
- [[] [in-2 in b] [e-3]]
- [[] [in-4 in c] [e-5]]
- [[e-1 e-3 e-5] [andn-6 andn] [e-7]]
- [[e-7] [out-8 out z] [] ]
- ])
- bfr '[[[?b0 ?b1 ?b2] [?b3 andn] [?b4]]]
- aft '[[[?b0 ?b1] [?a2 and2] [?a3]]
- [[?a3 ?b2] [?a4 and2] [?b4]]]
- dep '[?b4]
- aft-gr (gr/replace1 gr {:bfr bfr, :aft aft, :dep dep})]
- (is (not= um/fail
- (um/unify (:conns aft-gr)
- '[[[] [in-0 in a] [e-1]]
- [[] [in-2 in b] [e-3]]
- [[] [in-4 in c] [e-5]]
- [[e-7] [out-8 out z] [] ]
- [[e-1 e-3] [?x1 and2] [?x2]]
- [[?x2 e-5] [?a8 and2] [e-7]]
- ])))))
-
-(deftest test-replace
- (let [gr (struct gr/graph 7
- '[[[] [in-0 in a] [e-1]]
- [[e-1] [not1-2 not1] [e-3]]
- [[e-3] [not1-4 not1] [e-5]]
- [[e-5] [out-6 out z] [] ]])
- bfr '[[[?b0] [?b1 not1] [?b2]]
- [[?b2] [?b3 not1] [?b4]]]
- aft '[[[?b0] [?a1 short] [?b4]]]
- dep '[?b4]
- aft-gr (gr/replace gr {:bfr bfr, :aft aft, :dep dep})]
- (is (not= um/fail
- (um/unify (:conns aft-gr)
- '[[[] [in-0 in a] [?x1]]
- [[?x1] [out-6 out z] [] ]
- ]))))
- (let [gr (struct gr/graph 5
- '[[[] [in-0 in a] [e-1]]
- [[e-1] [not1-2 not1] [e-3]]
- [[e-3] [out-4 out z] [] ]])
- bfr '[[[?b0] [?b1 not1] [?b2]]]
- aft '[[[?b0] [?a1 not1] [?b2]]]
- dep '[?b2]
- aft-gr (gr/replace gr {:bfr bfr, :aft aft, :dep dep} 100)]
- (is (not= um/fail
- (um/unify (:conns aft-gr)
- '[[[] [in-0 in a] [e-1]]
- [[?x2] [out-4 out z] [] ]
- [[e-1] [?x1 not1] [?x2]]
- ])))))
-
-(deftest test-can-be-bfr?
- (let [gr0 (struct gr/graph 10
- '[[[] [in-0 in a] [e-1]]
- [[] [in-2 in a] [e-3]]
- [[e-1] [not1-4 not1] [e-5]]
- [[e-3] [not1-6 not1] [e-7]]
- [[e-5] [out-8 out z] [] ]
- [[e-7] [out-9 out z] [] ]
- ])
- gr1 (struct gr/graph 10
- '[[[] [in-0 in a] [e-1]]
- [[] [in-2 in a] [e-3]]
- [[e-1] [not1-4 not1] [e-5]]
- [[e-3] [not1-6 not1] [e-7]]
- [[e-5] [out-8 out z] [] ]
- [[e-3] [out-9 out z] [] ] ; a inport shorted to outport
- ])
- gr2 (struct gr/graph 10
- '[[[] [in-0 in a] [e-1]] ; a inport is not refered
- [[] [in-2 in a] [e-3]]
- [[e-3] [not1-4 not1] [e-5]]
- [[e-3] [not1-6 not1] [e-7]]
- [[e-5] [out-8 out z] [] ]
- [[e-7] [out-9 out z] [] ]
- ])]
- (is (gr/can-be-bfr? gr0))
- (is (not (gr/can-be-bfr? gr1)))
- (is (not (gr/can-be-bfr? gr2)))
- ))
-
-(deftest test-sublis
- (is (= (gr/sublis '{a x, b y}
- '[[a b] [c b]])
- '[[x y] [c y]]
- )))
+;(deftest test-new-ids
+; (let [gr0 (gr/new-graph)
+; [gr1 & ids] (gr/new-ids gr0 'and2 'or2 'not2 'e)]
+; (is (= gr0 {:next-id 0 :conns ()}))
+; (is (= gr1 {:next-id 4 :conns ()}))
+; (is (= ids '(and2-0 or2-1 not2-2 e-3)))
+; ))
+;
+;
+;; gr-not1
+;; _ |\ _
+;; b |_|----------| >o---------|_| z
+;; |/
+;;
+;; _ |\ _
+;; a |_|----------| >o---------|_| y
+;; |/
+;;
+;(def gr-not1
+; (let [gr (gr/new-graph)
+; [gr a b] (gr/inputs gr 'a 'b)
+; [gr y] (gr/not1 gr a)
+; [gr z] (gr/not1 gr b)
+; gr (gr/outputs gr [y 'y] [z 'z])]
+; gr))
+;
+;(deftest test-not1
+; (is (= gr-not1
+; {:next-id 10
+; :conns '[ [[] [in-0 in a] [e-1]]
+; [[] [in-2 in b] [e-3]]
+; [[e-1] [not1-4 not1] [e-5]]
+; [[e-3] [not1-6 not1] [e-7]]
+; [[e-5] [out-8 out y] []]
+; [[e-7] [out-9 out z] []]
+; ]}))
+; (is (= (gr/all-eids gr-not1)
+; '[e-1 e-3 e-5 e-7]))
+;)
+;
+;; gr-and2
+;; _ __
+;; b |_|----------| \ _
+;; _ | |--------|_| z
+;; a |_|----------|__/
+;;
+;(def gr-and2
+; (let [gr (gr/new-graph)
+; [gr a b] (gr/inputs gr 'a 'b)
+; [gr z] (gr/and2 gr a b)
+; gr (gr/outputs gr [z 'z])]
+; gr))
+;
+;(deftest test-and2
+; (is (= gr-and2
+; {:next-id 7
+; :conns '[ [[] [in-0 in a] [e-1]]
+; [[] [in-2 in b] [e-3]]
+; [[e-1 e-3] [and2-4 and2] [e-5]]
+; [[e-5] [out-6 out z] [] ]
+; ]}))
+;)
+;
+;; gr-andn
+;; _ __
+;; c |_|----------| \
+;; _ | | _
+;; b |_|----------| |--------|_| z
+;; _ | |
+;; a |_|----------|__/
+;;
+;(def gr-andn
+; (let [gr (gr/new-graph)
+; [gr a b c] (gr/inputs gr 'a 'b 'c)
+; [gr z] (gr/andn gr a b c)
+; gr (gr/outputs gr [z 'z])]
+; gr))
+;
+;(deftest test-andn
+; (is (= gr-andn
+; {:next-id 9
+; :conns '[ [[] [in-0 in a] [e-1]]
+; [[] [in-2 in b] [e-3]]
+; [[] [in-4 in c] [e-5]]
+; [[e-1 e-3 e-5] [andn-6 andn] [e-7]]
+; [[e-7] [out-8 out z] [] ]
+; ]}))
+;)
+;
+;; gr-or2
+;; _ __
+;; b |_|----------\ \ _
+;; _ | |--------|_| z
+;; a |_|----------/__/
+;;
+;(def gr-or2
+; (let [gr (gr/new-graph)
+; [gr a b] (gr/inputs gr 'a 'b)
+; [gr z] (gr/or2 gr a b)
+; gr (gr/outputs gr [z 'z])]
+; gr))
+;
+;(deftest test-or2
+; (is (= gr-or2
+; {:next-id 7
+; :conns '[ [[] [in-0 in a] [e-1]]
+; [[] [in-2 in b] [e-3]]
+; [[e-1 e-3] [or2-4 or2] [e-5]]
+; [[e-5] [out-6 out z] [] ]
+; ]}))
+;)
+;
+;; gr-orn
+;; _ __
+;; c |_|----------\ \
+;; _ | | _
+;; b |_|-----------| |--------|_| z
+;; _ | |
+;; a |_|----------/__/
+;;
+;(def gr-orn
+; (let [gr (gr/new-graph)
+; [gr a b c] (gr/inputs gr 'a 'b 'c)
+; [gr z] (gr/orn gr a b c)
+; gr (gr/outputs gr [z 'z])]
+; gr))
+;
+;(deftest test-orn
+; (is (= gr-orn
+; {:next-id 9
+; :conns '[ [[] [in-0 in a] [e-1]]
+; [[] [in-2 in b] [e-3]]
+; [[] [in-4 in c] [e-5]]
+; [[e-1 e-3 e-5] [orn-6 orn] [e-7]]
+; [[e-7] [out-8 out z] [] ]
+; ]}))
+;)
+;
+;
+;(def gr-unrefered-conns1
+; (struct gr/graph 14
+; '[ [[] [in-0 in a] [e-1] ]
+; [[] [in-2 in b] [e-3] ]
+; [[] [in-4 in c] [e-5] ]
+; [[e-1 e-3] [and2-6 and2] [e-7] ]
+; [[e-5] [not1-8 not1] [e-9] ]
+; [[e-9] [not1-10 not1] [e-11]]
+; [[e-7] [out-12 out z] [e-13]] ]))
+;
+;(deftest test-remove-unrefered-conns
+; (is (= (gr/remove-unrefered-conns gr-unrefered-conns1)
+; {:next-id 14
+; :conns '[ [[] [in-0 in a] [e-1] ]
+; [[] [in-2 in b] [e-3] ]
+; [[] [in-4 in c] [e-5] ]
+; [[e-1 e-3] [and2-6 and2] [e-7] ]
+; [[e-7] [out-12 out z] [e-13]]
+; ]}))
+;)
+;
+;(deftest test-map
+; (let [gr (gr/new-graph)
+; [gr a b c] (gr/inputs gr 'a 'b 'c)
+; [gr d e f] (gr/map gr gr/not1 [a b c])]
+; (is (= gr
+; {:next-id 12
+; :conns '[ [[] [in-0 in a] [e-1] ]
+; [[] [in-2 in b] [e-3] ]
+; [[] [in-4 in c] [e-5] ]
+; [[e-1] [not1-6 not1] [e-7] ]
+; [[e-3] [not1-8 not1] [e-9] ]
+; [[e-5] [not1-10 not1] [e-11]]
+; ]}))))
+;
+;; sel-2in1
+;; _ __
+;; b |_|--------------------| \ f
+;; | |--+ __
+;; +-------------|__/ +--\ \ _
+;; _ | |\ __ | |----|_| z
+;; c |_|------+---| >o------| \ +--/__/
+;; _ |/ d | |--+
+;; a |_|--------------------|__/ e
+;;
+;(def sel-2in1
+; (let [gr (gr/new-graph)
+; [gr a b c] (gr/inputs gr 'a 'b 'c)
+; [gr d] (gr/not1 gr c)
+; [gr e] (gr/and2 gr a d)
+; [gr f] (gr/and2 gr b c)
+; [gr z] (gr/or2 gr f e)
+; gr (gr/outputs gr [z 'z])]
+; gr))
+;
+;; dump of 'sel-2in1'
+;; commit 170da87b24b320ae99b50eea4a95b4f8a6b6b7d3
+;; (use '[clojure.contrib.duck-streams :only (writer)])
+;; (with-open [wtr (writer "hoge")]
+;; (binding [*out* wtr]
+;; (println sel-2in1)))
+;;
+;; { :next-id 15
+;; , :conns [[[] [in-0 in a] [e-1] ]
+;; [[] [in-2 in b] [e-3] ]
+;; [[] [in-4 in c] [e-5] ]
+;; [[e-5] [not1-6 not1] [e-7] ]
+;; [[e-1 e-7] [and2-8 and2] [e-9] ]
+;; [[e-3 e-5] [and2-10 and2] [e-11]]
+;; [[e-11 e-9] [or2-12 or2] [e-13]]
+;; [[e-13] [out-14 out z] [] ]]
+;; }
+;
+;(defn dependency-test [dpn]
+; (loop [dpn dpn saws #{}]
+; (if (empty? dpn)
+; true
+; (let [conn (first dpn)]
+; (if (every? #(saws %) (first conn))
+; (recur (rest dpn)
+; (into saws (set (nth conn 2))))
+; false)))))
+;
+;(deftest test-dependency
+; (is (dependency-test (gr/dependency (:conns sel-2in1) 'e-13)))
+; )
+;
+;(deftest test-calc-along-dependency-1
+; (is (= (gr/calc-along-dependency
+; '[ [[] [in-0 in a] [e-1]]
+; [[e-1] [not1-2 not1] [e-3]]
+; [[e-3] [out-4 out z] [] ] ]
+; '{a 0})
+; '{e-1 0, e-3 1}))
+; (let [dep '[ [[] [in-0 in a] [e-1]]
+; [[] [in-2 in b] [e-3]]
+; [[e-1 e-3] [and2-4 and2] [e-5]]
+; [[e-5] [out-6 out z] [] ] ]]
+; (is (= (gr/calc-along-dependency dep '{a 1, b 0})
+; '{e-1 1, e-3 0, e-5 0}))
+; (is (= (gr/calc-along-dependency dep '{a 1, b 1})
+; '{e-1 1, e-3 1, e-5 1})))
+; (let [dep '[ [[] [in-0 in a] [e-1]]
+; [[] [in-2 in b] [e-3]]
+; [[e-1 e-3] [or2-4 or2] [e-5]]
+; [[e-5] [out-6 out z] [] ] ]]
+; (is (= (gr/calc-along-dependency dep '{a 0, b 0})
+; '{e-1 0, e-3 0, e-5 0}))
+; (is (= (gr/calc-along-dependency dep '{a 1, b 0})
+; '{e-1 1, e-3 0, e-5 1})))
+;)
+;
+;(deftest test-calc-along-dependency-2
+; (let [[z-conn] (filter (fn [[_ [_ type o-name] _]]
+; (and (= type 'out)
+; (= o-name 'z)))
+; (:conns sel-2in1))
+; [[z-eid]] z-conn]
+; (let [result (gr/calc-along-dependency
+; (gr/dependency (:conns sel-2in1) z-eid)
+; '{a 0, b 1, c 0})]
+; (is (= (result z-eid) 0)))
+; (let [result (gr/calc-along-dependency
+; (gr/dependency (:conns sel-2in1) z-eid)
+; '{a 0, b 1, c 1})]
+; (is (= (result z-eid) 1))))
+;)
+;
+;(deftest test-calc
+; (is (= (gr/calc sel-2in1 '{a 1, b 0, c 0})
+; '{z 1}))
+; (is (= (gr/calc sel-2in1 '{a 1, b 0, c 1})
+; '{z 0}))
+;)
+;
+;(def ha-table '[[0 0] [0 0]
+; [1 0] [1 0]
+; [0 1] [1 0]
+; [1 1] [0 1]])
+;
+;(def gr-ha
+; (let [gr (gr/new-graph)
+; [gr a b] (gr/inputs gr 'a 'b)
+; [gr s cout] (gr/truth-table gr (partition 2 ha-table) [a b])
+; gr (gr/outputs gr [s 's] [cout 'cout])]
+; (gr/remove-unrefered-conns gr)))
+;
+;(deftest test-calc-ha
+; (is (= (gr/calc gr-ha '{a 0, b 0}) '{s 0, cout 0}))
+; (is (= (gr/calc gr-ha '{a 1, b 0}) '{s 1, cout 0}))
+; (is (= (gr/calc gr-ha '{a 0, b 1}) '{s 1, cout 0}))
+; (is (= (gr/calc gr-ha '{a 1, b 1}) '{s 0, cout 1}))
+; )
+;
+;(def fa-table '[[0 0 0] [0 0]
+; [1 0 0] [1 0]
+; [0 1 0] [1 0]
+; [1 1 0] [0 1]
+; [0 0 1] [1 0]
+; [1 0 1] [0 1]
+; [0 1 1] [0 1]
+; [1 1 1] [1 1]])
+;
+;(def gr-fa
+; (let [gr (gr/new-graph)
+; [gr a b cin] (gr/inputs gr 'a 'b 'cin)
+; [gr s cout] (gr/truth-table gr (partition 2 fa-table) [a b cin])
+; gr (gr/outputs gr [s 's] [cout 'cout])]
+; (gr/remove-unrefered-conns gr)))
+;
+;(deftest test-calc-fa
+; (is (= (gr/calc gr-fa '{a 0, b 0, cin 0}) '{s 0, cout 0}))
+; (is (= (gr/calc gr-fa '{a 1, b 0, cin 0}) '{s 1, cout 0}))
+; (is (= (gr/calc gr-fa '{a 0, b 1, cin 0}) '{s 1, cout 0}))
+; (is (= (gr/calc gr-fa '{a 1, b 1, cin 0}) '{s 0, cout 1}))
+; (is (= (gr/calc gr-fa '{a 0, b 0, cin 1}) '{s 1, cout 0}))
+; (is (= (gr/calc gr-fa '{a 1, b 0, cin 1}) '{s 0, cout 1}))
+; (is (= (gr/calc gr-fa '{a 0, b 1, cin 1}) '{s 0, cout 1}))
+; (is (= (gr/calc gr-fa '{a 1, b 1, cin 1}) '{s 1, cout 1}))
+;)
+;
+;(deftest test-remove-nin-nodes
+; (let [gr-fa (gr/remove-nin-nodes gr-fa)]
+; (is (= (gr/calc gr-fa '{a 0, b 0, cin 0}) '{s 0, cout 0}))
+; (is (= (gr/calc gr-fa '{a 1, b 0, cin 0}) '{s 1, cout 0}))
+; (is (= (gr/calc gr-fa '{a 0, b 1, cin 0}) '{s 1, cout 0}))
+; (is (= (gr/calc gr-fa '{a 1, b 1, cin 0}) '{s 0, cout 1}))
+; (is (= (gr/calc gr-fa '{a 0, b 0, cin 1}) '{s 1, cout 0}))
+; (is (= (gr/calc gr-fa '{a 1, b 0, cin 1}) '{s 0, cout 1}))
+; (is (= (gr/calc gr-fa '{a 0, b 1, cin 1}) '{s 0, cout 1}))
+; (is (= (gr/calc gr-fa '{a 1, b 1, cin 1}) '{s 1, cout 1})))
+; (let [gr-ha (gr/remove-nin-nodes gr-ha)]
+; (is (= (gr/calc gr-ha '{a 0, b 0}) '{s 0, cout 0}))
+; (is (= (gr/calc gr-ha '{a 1, b 0}) '{s 1, cout 0}))
+; (is (= (gr/calc gr-ha '{a 0, b 1}) '{s 1, cout 0}))
+; (is (= (gr/calc gr-ha '{a 1, b 1}) '{s 0, cout 1})))
+;)
+;
+;; __
+;; ?i1 --------------------| \
+;; | |---- ?o1
+;; +-------------|__/
+;; | |\ __
+;; ?i2 ------+---| >o------| \
+;; |/ ?m0 | |---- ?o0
+;; ?i0 --------------------|__/
+;;
+;(def sel-2in1-ptn
+; '[[[] [?in0 in 0] [?i0]]
+; [[] [?in1 in 1] [?i1]]
+; [[] [?in2 in 2] [?i2]]
+; [[?i0 ?m0] [?and2-0 and2] [?o0]]
+; [[?i1 ?i2] [?and2-1 and2] [?o1]]
+; [[?i2] [?not1-0 not1] [?m0]]
+; [[?o0] [?out0 out 0] [] ]
+; [[?o1] [?out1 out 1] [] ]])
+;
+;(def sel-2in1-ptn-aft
+; '[[[] [?ain0 in 0] [?ai0]]
+; [[] [?ain1 in 1] [?ai1]]
+; [[] [?ain2 in 2] [?ai2]]
+; [[?ai0] [?anot1-1 not1] [?am1]] ; added to sel-2in1-ptn
+; [[?am1] [?anot1-2 not1] [?am2]] ; added to sel-2in1-ptn
+; [[?am2 ?am0] [?aand2-0 and2] [?ao0]]
+; [[?ai1 ?ai2] [?aand2-1 and2] [?ao1]]
+; [[?ai2] [?anot1-0 not1] [?am0]]
+; [[?ao0] [?aout0 out 0] [] ]
+; [[?ao1] [?aout1 out 1] [] ]])
+;
+;(deftest test-match1-sel-2in1
+; (is (= (gr/match1 sel-2in1 (remove gr/in-or-out? sel-2in1-ptn))
+; '{ ?i0 e-1
+; , ?i1 e-3
+; , ?i2 e-5
+; , ?m0 e-7
+; , ?and2-0 and2-8
+; , ?and2-1 and2-10
+; , ?not1-0 not1-6
+; , ?o0 e-9
+; , ?o1 e-11 }))
+;)
+;
+;(deftest test-cut
+; (is (= (gr/cut gr-not1 '[e-5 e-7])
+; {:next-id 12
+; :conns '[ [[] [in-0 in a] [e-1] ]
+; [[] [in-2 in b] [e-3] ]
+; [[e-1] [not1-4 not1] [u-10]]
+; [[e-3] [not1-6 not1] [u-11]]
+; [[e-5] [out-8 out y] [] ]
+; [[e-7] [out-9 out z] [] ]
+; ]}))
+;)
+;
+;(deftest test-connect
+; (let [gr (gr/connect gr-not1
+; '{?b0 e-1, ?b2 e-5}
+; '[[[?b0] [?a1 not1] [?a2]]
+; [[?a2] [?a3 not1] [?a4]]
+; [[?a4] [?a5 not1] [?b2]]])]
+; (is (not= um/fail
+; (um/unify (:conns gr)
+; '[ [[] [in-0 in a] [e-1]]
+; [[] [in-2 in b] [e-3]]
+; [[e-1] [not1-4 not1] [e-5]]
+; [[e-3] [not1-6 not1] [e-7]]
+; [[e-5] [out-8 out y] [] ]
+; [[e-7] [out-9 out z] [] ]
+; [[e-1] [?x1 not1] [?x2]]
+; [[?x2] [?x3 not1] [?x4]]
+; [[?x4] [?x5 not1] [e-5]]
+; ]))))
+;)
+;
+;(deftest test-replace1
+; (let [gr (struct gr/graph 9
+; '[[[] [in-0 in a] [e-1]]
+; [[] [in-2 in b] [e-3]]
+; [[] [in-4 in c] [e-5]]
+; [[e-1 e-3 e-5] [andn-6 andn] [e-7]]
+; [[e-7] [out-8 out z] [] ]
+; ])
+; bfr '[[[?b0 ?b1 ?b2] [?b3 andn] [?b4]]]
+; aft '[[[?b0 ?b1] [?a2 and2] [?a3]]
+; [[?a3 ?b2] [?a4 and2] [?b4]]]
+; dep '[?b4]
+; aft-gr (gr/replace1 gr {:bfr bfr, :aft aft, :dep dep})]
+; (is (not= um/fail
+; (um/unify (:conns aft-gr)
+; '[[[] [in-0 in a] [e-1]]
+; [[] [in-2 in b] [e-3]]
+; [[] [in-4 in c] [e-5]]
+; [[e-7] [out-8 out z] [] ]
+; [[e-1 e-3] [?x1 and2] [?x2]]
+; [[?x2 e-5] [?a8 and2] [e-7]]
+; ])))))
+;
+;(deftest test-replace
+; (let [gr (struct gr/graph 7
+; '[[[] [in-0 in a] [e-1]]
+; [[e-1] [not1-2 not1] [e-3]]
+; [[e-3] [not1-4 not1] [e-5]]
+; [[e-5] [out-6 out z] [] ]])
+; bfr '[[[?b0] [?b1 not1] [?b2]]
+; [[?b2] [?b3 not1] [?b4]]]
+; aft '[[[?b0] [?a1 short] [?b4]]]
+; dep '[?b4]
+; aft-gr (gr/replace gr {:bfr bfr, :aft aft, :dep dep})]
+; (is (not= um/fail
+; (um/unify (:conns aft-gr)
+; '[[[] [in-0 in a] [?x1]]
+; [[?x1] [out-6 out z] [] ]
+; ]))))
+; (let [gr (struct gr/graph 5
+; '[[[] [in-0 in a] [e-1]]
+; [[e-1] [not1-2 not1] [e-3]]
+; [[e-3] [out-4 out z] [] ]])
+; bfr '[[[?b0] [?b1 not1] [?b2]]]
+; aft '[[[?b0] [?a1 not1] [?b2]]]
+; dep '[?b2]
+; aft-gr (gr/replace gr {:bfr bfr, :aft aft, :dep dep} 100)]
+; (is (not= um/fail
+; (um/unify (:conns aft-gr)
+; '[[[] [in-0 in a] [e-1]]
+; [[?x2] [out-4 out z] [] ]
+; [[e-1] [?x1 not1] [?x2]]
+; ])))))
+;
+;(deftest test-can-be-bfr?
+; (let [gr0 (struct gr/graph 10
+; '[[[] [in-0 in a] [e-1]]
+; [[] [in-2 in a] [e-3]]
+; [[e-1] [not1-4 not1] [e-5]]
+; [[e-3] [not1-6 not1] [e-7]]
+; [[e-5] [out-8 out z] [] ]
+; [[e-7] [out-9 out z] [] ]
+; ])
+; gr1 (struct gr/graph 10
+; '[[[] [in-0 in a] [e-1]]
+; [[] [in-2 in a] [e-3]]
+; [[e-1] [not1-4 not1] [e-5]]
+; [[e-3] [not1-6 not1] [e-7]]
+; [[e-5] [out-8 out z] [] ]
+; [[e-3] [out-9 out z] [] ] ; a inport shorted to outport
+; ])
+; gr2 (struct gr/graph 10
+; '[[[] [in-0 in a] [e-1]] ; a inport is not refered
+; [[] [in-2 in a] [e-3]]
+; [[e-3] [not1-4 not1] [e-5]]
+; [[e-3] [not1-6 not1] [e-7]]
+; [[e-5] [out-8 out z] [] ]
+; [[e-7] [out-9 out z] [] ]
+; ])]
+; (is (gr/can-be-bfr? gr0))
+; (is (not (gr/can-be-bfr? gr1)))
+; (is (not (gr/can-be-bfr? gr2)))
+; ))
+;
+;(deftest test-sublis
+; (is (= (gr/sublis '{a x, b y}
+; '[[a b] [c b]])
+; '[[x y] [c y]]
+; )))
(run-tests)
OSDN Git Service
