Created
October 19, 2018 18:01
-
-
Save Jaretbinford/210e2cb53c9d847b3dfc73010bb6b8ef to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| (ns datomic-db | |
| (:require [datomic.api :as d])) | |
| (def schema-tx [{:db/ident :person/id | |
| :db/cardinality :db.cardinality/one | |
| :db/unique :db.unique/identity | |
| :db/valueType :db.type/string} | |
| {:db/ident :person/dept | |
| :db/cardinality :db.cardinality/one | |
| :db/valueType :db.type/ref} | |
| {:db/ident :dept/id | |
| :db/cardinality :db.cardinality/one | |
| :db/unique :db.unique/identity | |
| :db/valueType :db.type/string} | |
| {:db/ident :relationship/manager | |
| :db/cardinality :db.cardinality/one | |
| :db/valueType :db.type/ref} | |
| {:db/ident :relationship/managed | |
| :db/cardinality :db.cardinality/one | |
| :db/valueType :db.type/ref} | |
| ]) | |
| (def data-tx [{:db/id "PersonA" | |
| :person/id "PersonA" | |
| :person/dept "DeptA"} | |
| {:db/id "PersonB" | |
| :person/id "PersonB" | |
| :person/dept "DeptA"} | |
| {:db/id "PersonC" | |
| :person/id "PersonC" | |
| :person/dept "DeptF"} | |
| {:db/id "PersonE" | |
| :person/id "PersonE" | |
| :person/dept "DeptE"} | |
| {:db/id "PersonF" | |
| :person/id "PersonF" | |
| :person/dept "DeptF"} | |
| {:db/id "DeptA" | |
| :dept/id "DeptA"} | |
| {:db/id "DeptE" | |
| :dept/id "DeptE"} | |
| {:db/id "DeptF" | |
| :dept/id "DeptF"} | |
| {:relationship/manager "PersonA" | |
| :relationship/managed "PersonB"} | |
| {:relationship/manager "PersonB" | |
| :relationship/managed "PersonC"} | |
| {:relationship/manager "PersonA" | |
| :relationship/managed "PersonE"} | |
| {:relationship/manager "PersonE" | |
| :relationship/managed "PersonF"} | |
| ]) | |
| (comment | |
| (do | |
| (def uri "datomic:mem://test3") | |
| (d/create-database uri) | |
| (def conn (d/connect uri)) | |
| @(d/transact conn schema-tx) | |
| @(d/transact conn data-tx)) | |
| ;; Given a Person, find all people they manage (recursively) | |
| ;; Given a collection of deparments, only include results that are "reachable" from within the given departments | |
| ;; Without regard for Deptartments | |
| (d/q '[:find ?pname | |
| :in $ % ?manager | |
| :where | |
| (managesRec ?manager ?p) | |
| [?p :person/id ?pname]] | |
| (d/db conn) | |
| '[[(manages ?a ?b) | |
| [?r :relationship/manager ?a] | |
| [?r :relationship/managed ?b]] | |
| [(managesRec ?a ?z) | |
| (manages ?a ?b) | |
| (managesRec ?b ?z)] | |
| [(managesRec ?a ?z) | |
| (manages ?a ?z)]] | |
| [:person/id "PersonA"]) | |
| ;; Marshall's approach: Naive filtering | |
| (d/q '[:find ?pname ?dname | |
| :in $ % ?manager [?d ...] | |
| :where | |
| (managesRec ?manager ?p) | |
| (staffInDept ?d ?p) | |
| [?p :person/id ?pname] | |
| [?d :dept/id ?dname]] | |
| (d/db conn) | |
| '[[(staffInDept ?d ?p) | |
| [?p :person/dept ?d]] | |
| [(manages ?a ?b) | |
| [?r :relationship/manager ?a] | |
| [?r :relationship/managed ?b]] | |
| [(managesRec ?a ?z) | |
| (manages ?a ?b) | |
| (managesRec ?b ?z)] | |
| [(managesRec ?a ?z) | |
| (manages ?a ?z)]] | |
| [:person/id "PersonA"] | |
| [[:dept/id "DeptA"] | |
| [:dept/id "DeptF"]]) | |
| ;; Getting closer: Filtering at each step of the rule. However, | |
| ;; incorrect because it only returns values for which manager and | |
| ;; managed have the *same* department (because ?d is bound to the same value | |
| ;; for each candidate set) | |
| (d/q '[:find ?pname ?dname | |
| :in $ % ?manager [?d ...] | |
| :where | |
| (managesRec ?manager ?p ?d) | |
| (staffInDept ?d ?p) | |
| [?p :person/id ?pname] | |
| [?d :dept/id ?dname]] | |
| (d/db conn) | |
| '[[(staffInDept ?d ?p) | |
| [?p :person/dept ?d]] | |
| [(manages ?a ?b ?dept) | |
| [?r :relationship/manager ?a] | |
| (staffInDept ?dept ?a) | |
| [?r :relationship/managed ?b]] | |
| [(managesRec ?a ?z ?dept) | |
| (manages ?a ?b ?dept) | |
| (managesRec ?b ?z ?dept)] | |
| [(managesRec ?a ?z ?dept) | |
| (manages ?a ?z ?dept)]] | |
| [:person/id "PersonA"] | |
| [[:dept/id "DeptA"] | |
| [:dept/id "DeptF"]]) | |
| ;; Correct. Pass around the *set* of departments, and filter by | |
| ;; predicate within the recursive rule to prevent transiting | |
| ;; through an external department. | |
| (d/q '[:find ?pname | |
| :in $ % ?manager ?depts | |
| :where | |
| (managesRec ?manager ?p ?depts) | |
| [?p :person/id ?pname]] | |
| (d/db conn) | |
| '[[(staffInDepts ?dname ?p) | |
| [?p :person/dept ?d] | |
| [?d :dept/id ?dname]] | |
| [(manages ?a ?b ?depts) | |
| [?r :relationship/manager ?a] | |
| [?r :relationship/managed ?b] | |
| (staffInDepts ?a-dep-name ?a) | |
| (staffInDepts ?b-dep-name ?b) | |
| [(clojure.core/contains? ?depts ?a-dep-name)] | |
| [(clojure.core/contains? ?depts ?b-dep-name)]] | |
| [(managesRec ?a ?z ?depts) | |
| (manages ?a ?b ?depts) | |
| (managesRec ?b ?z ?depts)] | |
| [(managesRec ?a ?z ?depts) | |
| (manages ?a ?z ?depts)]] | |
| [:person/id "PersonA"] | |
| '#{"DeptA" "DeptF"}) | |
| ) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment