@@ -25,10 +25,11 @@ (segment-pattern? pattern) (segment-matcher pattern input bindings) (single-pattern? pattern) (single-matcher pattern input bindings) (and - (sequential? pattern) - (sequential? input)) (recur (rest pattern) (rest input) - (pat-match (first pattern) (first input) - bindings)) + (sequential? pattern) + (sequential? input)) + (recur (rest pattern) (rest input) + (pat-match (first pattern) (first input) + bindings)) :else fail))) (defn segment-matcher @@ -66,9 +67,9 @@ [pat1 input start] ; (dbg :patmatch (format "first-match-pos %s %s %s" pat1 input start)) (cond - (and (not (sequential? pat1)) (not (variable? pat1))) + (and (not (coll? pat1)) (not (variable? pat1))) (position (partial = pat1) input start) - (< start (count input)) start + (<= start (count input)) start :else nil)) @@ -77,19 +78,19 @@ ([pattern input bindings] (segment-match pattern input bindings 0)) ([pattern input bindings start] - (dbg :patmatch (format "Segment Match %s %s %s" pattern input bindings start)) + (dbg :patmatch (format "Segment Match %s %s %s" pattern (first (list input)) bindings start)) (let [var (second (first pattern)) - pat (rest pattern)] + pat (rest pattern)] (if (empty? pat) - (match-variable var input bindings) - (let [pos (first-match-pos (first pat) input start)] - (if (nil? pos) - fail - (let [b2 (pat-match pat (map identity (subvec (vec input) pos)) - (match-variable var (map identity (subvec (vec input) 0 pos)) bindings))] - (if (= b2 fail) - (segment-match pattern input bindings (inc pos)) - b2)))))))) + (match-variable var input bindings) + (let [pos (first-match-pos (first pat) input start)] + (if (nil? pos) + fail + (let [b2 (pat-match pat (subvec (vec input) pos) + (match-variable var (subvec (vec input) 0 pos) bindings))] + (if (= b2 fail) + (segment-match pattern input bindings (inc pos)) + b2)))))))) (defn segment-match+ "Match one or more elements of input." @@ -211,9 +212,7 @@ [input rules :matcher pat-match :rule-if first :rule-then rest :action replace] (some (fn [rule] - (dbg :patmatch (format "Rule: %s" rule)) (let [result (matcher (rule-if rule) input)] - (dbg :patmmatch (format "Binding: " result)) (if (not= result fail) (action result (rule-then rule))))) rules)) ai/uk/co/fatvat/patmatch.clj @@ -262,8 +262,13 @@ (defn solve-equations "Print the equations and their solution" [equations] - (print-equations "The equations to be solved are:" equations)) -; (print-equations "The solution is:" (solve (map mk-exp-infix equations) nil))) + (print-equations "The equations to be solved are:" equations) + (solve (map mk-exp-infix equations) nil)) + +(deftest solve-equations-test + (is (= ({:op '=, :lhs 'y, :rhs 2} {:op '=, :lhs 'x, :rhs 2}) + (solve-equations '((= (+ 3 4) (* (- 5 (+ 2 x)) 7)) + (= (+ (* 3 x) y) 12)))))) (defn student "Solve certain Algebra Word Problems." ai/uk/co/fatvat/student.clj 75bea30c2a7155ea3534cd9add3c248e9a8a91c7 Jeff Foster jeff.foster@acm.org http://github.com/fffej/ClojureProjects/commit/a6c5593a836fe1c60ed96ea00447c73bae636b05 a6c5593a836fe1c60ed96ea00447c73bae636b05 2009-07-24T13:53:05-07:00 2009-07-24T13:53:05-07:00 final updates 2c3f5f78af3cb1270912175c7e7b7f366564f41e Jeff Foster jeff.foster@acm.org