Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Working

  • Loading branch information...
commit 4460a769a1a72f821876e967f86870e05e2f70a3 1 parent 002346a
@marick authored
View
7 src/peano/blank_filling.clj
@@ -25,6 +25,13 @@
(symbol? form) :presupplied-lvar
(map? form) :blank-with-properties))
+(defn generate-run-form
+ ([guidance tree]
+ (let [q (gensym "q")]
+ `(l/run false [~q]
+ (l/fresh [~@(guidance :lvars-needed)]
+ (l/== ~tree ~q)
+ ~@(guidance :narrowers))))))
(comment
View
5 src/peano/guidance.clj
@@ -30,8 +30,11 @@
(with-lvar new-symbol))
new-symbol)))
+(defn typecast-lvar [lvar relation]
+ `(~(query-symbol relation) ~lvar))
+
(defn property-narrower [[relation property] lvar required-value]
- `(l/== (~(query-symbol relation property) ~lvar ~required-value)))
+ `(~(query-symbol relation property) ~lvar ~required-value))
(defn with-narrower [guidance narrower]
(assoc-into-vector guidance :narrowers narrower))
View
3  src/peano/selectors.clj
@@ -10,7 +10,8 @@
;; --
;; TODO: These `generate` functions are similar enough that an
-;; abstraction should be abstracted from them.
+;; abstraction should be abstracted from them. See also
+;; `generate-run-form` in blank-filling.
(defn generate-did-run-form
([run-count relation kvs]
View
1  test/peano/t_blank_filling.clj
@@ -54,6 +54,7 @@
+
(comment
(fact "trivial case produces no change"
View
6 test/peano/t_guidance.clj
@@ -39,10 +39,12 @@
(fact "you can write a logic clause that forces an lvar to associate with a property"
(property-narrower [:animal :name] 'animal-0 "bessy")
- => '(clojure.core.logic/== (animal-name?? animal-0 "bessy")))
+ => '(animal-name?? animal-0 "bessy"))
(fact "narrowers can be added into the guidance"
(with-narrower {:key 1} '(a narrower)) => {:key 1, :narrowers '[(a narrower)]})
-
+(fact "you can 'typecast' a variable to a relation"
+ (typecast-lvar 'animal-0 :animal)
+ => '(animal?? animal-0))
View
65 test/peano/t_reservation_example.clj
@@ -2,9 +2,10 @@
(:require [clojure.core.logic :as l])
(:use midje.sweet
clojure.pprint
+ [clojure.math.combinatorics :only [combinations]]
peano.core
peano.guidance
- [peano.blank-filling :only [suggested-classifier]]))
+ [peano.blank-filling :only [suggested-classifier generate-run-form]]))
(defmulti processor
(fn [guidance blank & _] ((:classifier guidance) blank)))
@@ -42,11 +43,35 @@
(defn simplify-and-process [guidance blank _ count-to-left]
(processor guidance blank
- (if (= 0 count-to-left) :procedure :animal)))
+ (if (= 0 count-to-left) :procedure :animal)))
+
+(defn permitted-pairs-narrowers [guidance]
+ (map (fn [procedure animal] `(permitted?? ~procedure ~animal))
+ (guidance :procedure)
+ (guidance :animal)))
+
+(defn no-duplicate-groups-narrowers [uses]
+ (map (fn [[one two]] `(l/!= ~one ~two))
+ (combinations uses 2)))
+
+(fact "remove duplicate groups"
+ (no-duplicate-groups-narrowers [ [1 1] ]) => []
+ (no-duplicate-groups-narrowers [ [1 1] [2 2] [3 3]])
+ => (just '(clojure.core.logic/!= [1 1] [2 2])
+ '(clojure.core.logic/!= [1 1] [3 3])
+ '(clojure.core.logic/!= [2 2] [3 3])
+ :in-any-order))
+
+(defn postprocessor [guidance tree]
+ (let [narrowers (concat (permitted-pairs-narrowers guidance)
+ (no-duplicate-groups-narrowers tree))
+ ]
+ (vector (merge-with concat guidance {:narrowers narrowers})
+ tree)))
(def guidance {:classifier suggested-classifier
:processor simplify-and-process
- :postprocessor (fn [x y] [x y])})
+ :postprocessor postprocessor})
;;; About processing
@@ -94,4 +119,36 @@
:narrowers [narrower]})))
-(prn (fill-in-the-blanks guidance '[[_ "hank"] [myproc {:legs 4}]]))
+
+(data [animal :by :name]
+ {:name "betty" :species :bovine :legs 4}
+ {:name "julie" :species :bovine :legs 4}
+ {:name "jeff" :species :equine :legs 4}
+ {:name "hank" :species :equine :legs 3}) ; poor hank
+
+(data [procedure :by :name]
+ {:name "hoof trim" :species :equine :days-delay 0}
+ {:name "casting teeth" :species :equine :days-delay 0}
+ {:name "superovulation" :species :bovine :days-delay 90})
+
+(defn permitted?? [procedure animal]
+ (l/fresh [species]
+ (procedure-species?? procedure species)
+ (animal-species?? animal species)))
+
+(defmacro reservations [& tree]
+ (apply generate-run-form (fill-in-the-blanks guidance (vec tree))))
+
+(println "============== SIMPLE")
+(pprint (reservations [- -]))
+
+
+(println "============== BIG")
+(pprint (reservations [- "hank"] [- {:legs 3}]))
+
+
+
+
+; (pprint (apply generate-run-form (fill-in-the-blanks guidance '[[- "hank"] [- {:legs 3}]])))
+
+
Please sign in to comment.
Something went wrong with that request. Please try again.