Cybernetic1

backward chaining in Clojure

Apr 17th, 2012
83
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. ;; Backward chaining in Clojure
  2. ;; -- implemented as a parallel search
  3. ;; -- the search tree interleaves calling of solve-goal and solve-rule
  4. ;; -- solveGoals takes the first result available (OR)
  5. ;; -- solveRules collects all results before calculating an answer (AND)
  6. ;; -- technically this is called an AND-OR tree
  7.  
  8. (ns backward)
  9. (import '(java.util.concurrent Executors ExecutorCompletionService))
  10.  
  11. (declare start solve-goal solve-rule collect unify)
  12.  
  13. ;; Choose between using parallel collect or sequential collect.
  14. (def use-parallel-collect true)
  15. (def collect (if use-parallel-collect pmap map))
  16.  
  17. (defn start []
  18.     (loop []
  19.         (print "Enter query: ") (flush)
  20.         (let [query (read-line)
  21.               truth (solve-goal (symbol query))]
  22.             (printf "Answer is: %s\n" truth))
  23.         (recur)))
  24.  
  25. ;; The rule base
  26. (defn fetch-rules [goal]
  27.     (case goal
  28.         g '[[a,b,c],[d,e,f]]
  29.         a '[[e,f]]
  30.         b '[[c,d,e,f]]
  31.         c '[[e,f]]
  32.         d '[[e,f]]
  33.         e '[[]]
  34.         f '[[]]
  35.         true (throw (Exception. "No applicable rule"))))
  36.  
  37. (defn solve-goal [goal]
  38.     (let [rules (fetch-rules goal)]
  39.         (if (some empty? rules)
  40.             1.0     ; return a truth value
  41.             (let [comp-service (ExecutorCompletionService.
  42.                     (Executors/newCachedThreadPool))]
  43.                 (doseq [rule rules]
  44.                     (.submit comp-service #(solve-rule rule)))
  45.                 (.get (.take comp-service))))))
  46.  
  47. (defn solve-rule [rule-tail]
  48.     (let [truths (collect solve-goal rule-tail)]
  49.         (apply + truths)))      ; sum up truth values -- for testing
Advertisement
Add Comment
Please, Sign In to add comment