Skip to content

Instantly share code, notes, and snippets.

@schmalz
Created February 3, 2023 19:44
Show Gist options
  • Save schmalz/aba4a60b393178c489829c4b430cdc75 to your computer and use it in GitHub Desktop.
Save schmalz/aba4a60b393178c489829c4b430cdc75 to your computer and use it in GitHub Desktop.
Clojure implementation of the Blocks World Keyboard Exercise from Common Lisp: A Gentle Introduction to Symbolic Computing
(ns blocks-world.core)
(def ^:private database
"The blocks database."
[[:b1 :shape :brick]
[:b1 :color :green]
[:b1 :size :small]
[:b1 :supported-by :b2]
[:b1 :supported-by :b3]
[:b2 :shape :brick]
[:b2 :color :red]
[:b2 :size :small]
[:b2 :supports :b1]
[:b2 :left-of :b3]
[:b3 :shape :brick]
[:b3 :color :red]
[:b3 :size :small]
[:b3 :supports :b1]
[:b3 :right-of :b2]
[:b4 :shape :pyramid]
[:b4 :color :blue]
[:b4 :size :large]
[:b4 :supported-by :b5]
[:b5 :shape :cube]
[:b5 :color :green]
[:b5 :size :large]
[:b5 :supports :b4]
[:b6 :shape :brick]
[:b6 :color :purple]
[:b6 :size :large]])
(defn- match-element
"Return true if two elements match (including if the second is :?)."
[e1 e2]
(or (= e1 e2)
(= e2 :?)))
(defn- match-triple
"Return true if ASSERTION matches PATTERN."
[assertion pattern]
(every? true? (map match-element assertion pattern)))
(defn- fetch
"Return all the assertions in the database that match PATTERN."
[pattern]
(filter #(match-triple % pattern) database))
(defn- color-pattern-for-block
"Return the pattern that will match the color of BLOCK."
[block]
[block :color :?])
(defn supporters
"Return the blocks that support BLOCK."
[block]
(map first
(fetch [:? :supports block])))
(defn supported-by-cube?
"Is BLOCK supported by a cube?"
[block]
(not-every? empty?
(map #(fetch [% :shape :cube])
(supporters block))))
(defn- desc-1
[block]
(fetch [block :? :?]))
(defn- desc-2
[block]
(map rest
(desc-1 block)))
(defn description
"BLOCK's description."
[block]
(apply concat
(desc-2 block)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment