jdormit/sicp-logic
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[WIP] Write tests

Browse Source 
The rules tests don't pass right now, need to dig into that
This commit is contained in:
Jeremy Dormitzer 2019-07-19 19:53:26 -04:00
parent 81c8f01c12
commit 1d37d9d9e0
1 changed files with 120 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

120
tests/sicp_logic/tests.clj Normal file
View File

@ -0,0 +1,120 @@
(ns sicp-logic.tests
(:require [clojure.test :refer :all]
[sicp-logic.core :as logic]
[sicp-logic.db.memory :as memdb]))
(defn setup-sicp-dataset! [db]
"Loads the example data set from SICP into `db`."
(let [facts '[(address (Bitdiddle Ben) (Slumerville (Ridge Road) 10))
(job (Bitdiddle Ben) (computer wizard))
(salary (Bitdiddle Ben) 60000)
(address (Hacker Alyssa P) (Cambridge (Mass Ave) 78))
(job (Hacker Alyssa P) (computer programmer))
(salary (Hacker Alyssa P) 40000)
(supervisor (Hacker Alyssa P) (Bitdiddle Ben))
(address (Fect Cy D) (Cambridge (Ames Street) 3))
(job (Fect Cy D) (computer programmer))
(salary (Fect Cy D) 35000)
(supervisor (Fect Cy D) (Bitdiddle Ben))
(address (Tweakit Lem E) (Boston (Bay State Road) 22))
(job (Tweakit Lem E) (computer technician))
(salary (Tweakit Lem E) 25000)
(supervisor (Tweakit Lem E) (Bitdiddle Ben))
(address (Reasoner Louis) (Slumerville (Pine Tree Road) 80))
(job (Reasoner Louis) (computer programmer trainee))
(salary (Reasoner Louis) 30000)
(supervisor (Reasoner Louis) (Hacker Alyssa P))
(supervisor (Bitdiddle Ben) (Warbucks Oliver))
(address (Warbucks Oliver) (Swellesley (Top Heap Road)))
(job (Warbucks Oliver) (administration big wheel))
(salary (Warbucks Oliver) 150000)
(address (Scrooge Eben) (Weston (Shady Lane) 10))
(job (Scrooge Eben) (accounting chief accountant))
(salary (Scrooge Eben) 75000)
(supervisor (Scrooge Eben) (Warbucks Oliver))
(address (Cratchet Robert) (Allston (N Harvard Street) 16))
(job (Cratchet Robert) (accounting scrivener))
(salary (Cratchet Robert) 18000)
(supervisor (Cratchet Robert) (Scrooge Eben))
(address (Aull DeWitt) (Slumerville (Onion Square) 5))
(job (Aull DeWitt) (administration secretary))
(salary (Aull DeWitt) 25000)
(supervisor (Aull DeWitt) (Warbucks Oliver))
(can-do-job (computer wizard) (computer programmer))
(can-do-job (computer wizard) (computer technician))
(can-do-job (computer programmer) (computer programmer trainee))
(can-do-job (administration secretary) (administration big wheel))]
rules '[((same ?x ?x))
((lives-near ?person-1 ?person-2)
(and (address ?person-1 (?town . ?rest-1))
(address ?person-2 (?town . ?rest-2))
(not (same ?person-1 ?person-2))))
((wheel ?person)
(and (supervisor ?middle-manager ?person)
(supervisor ?x ?middle-manager)))
((outranked-by ?staff-person ?boss)
(or (supervisor ?staff-person ?boss)
(and (supervisor ?staff-person ?middle-manager)
(outranked-by ?middle-manager ?boss))))]]
(doseq [fact facts]
(logic/assert! db fact))
(doseq [rule rules]
(logic/add-rule! db rule))))
(deftest basic-pattern-matching
(let [db (memdb/new-db)]
(setup-sicp-dataset! db)
(is (= (logic/query db [job ?x [computer programmer]])
'[(job (Hacker Alyssa P) (computer programmer))
(job (Fect Cy D) (computer programmer))]))
(is (= (logic/query db [job ?x [computer ?type]])
'[(job (Bitdiddle Ben) (computer wizard))
(job (Hacker Alyssa P) (computer programmer))
(job (Fect Cy D) (computer programmer))
(job (Tweakit Lem E) (computer technician))]))))
(deftest compound-queries
(let [db (memdb/new-db)]
(setup-sicp-dataset! db)
(is (= (logic/query db (and [job ?person [computer programmer]]
[address ?person ?where]))
'[(and (job (Hacker Alyssa P) (computer programmer))
(address (Hacker Alyssa P) (Cambridge (Mass Ave) 78)))
(and (job (Fect Cy D) (computer programmer))
(address (Fect Cy D) (Cambridge (Ames Street) 3)))]))
(is (= (logic/query db (or [supervisor ?x [Bitdiddle Ben]]
[supervisor ?x [Hacker Alyssa P]]))
'[(or (supervisor (Hacker Alyssa P) (Bitdiddle Ben))
(supervisor (Hacker Alyssa P) (Hacker Alyssa P)))
(or (supervisor (Fect Cy D) (Bitdiddle Ben))
(supervisor (Fect Cy D) (Hacker Alyssa P)))
(or (supervisor (Tweakit Lem E) (Bitdiddle Ben))
(supervisor (Tweakit Lem E) (Hacker Alyssa P)))
(or (supervisor (Reasoner Louis) (Bitdiddle Ben))
(supervisor (Reasoner Louis) (Hacker Alyssa P)))]))
(is (= (logic/query db (and [supervisor ?x [Bitdiddle Ben]]
(not [job ?x [computer programmer]])))
'[(and (supervisor (Tweakit Lem E) (Bitdiddle Ben))
(not (job (Tweakit Lem E) (computer programmer))))]))
(is (= (logic/query db (and [salary ?person ?amount]
(lisp-value > ?amount 30000)))
'[(and (salary (Bitdiddle Ben) 60000)
(lisp-value > 60000 30000))
(and (salary (Hacker Alyssa P) 40000)
(lisp-value > 40000 30000))
(and (salary (Fect Cy D) 35000)
(lisp-value > 35000 30000))
(and (salary (Warbucks Oliver) 150000)
(lisp-value > 150000 30000))
(and (salary (Scrooge Eben) 75000)
(lisp-value > 75000 30000))]))))
(deftest rules
(let [db (memdb/new-db)]
(setup-sicp-dataset! db)
(is (= (logic/query db [lives-near ?x [Bitdiddle Ben]])
'[(lives-near (Reasoner Louis) (Bitdiddle Ben))
(lives-near (Aull DeWitt) (Bitdiddle Ben))]))
(is (= (logic/query db (and [job ?x [computer programmer]]
[lives-near ?x [Bitdiddle Ben]]))
'[(lives-near (Reasoner Louis) (Bitdiddle Ben))]))))