Logic Programming Solution to Stair Climbing Problem

gistfile1.clj

(use 'clojure.core.logic)

;;;; Library Functions...not my code ;;;;

(defn build-num [n]
  (cond
   (zero? n) ()
   (and (even? n) (not (zero? n)))  (cons 0 (build-num (/ n 2)))
   (odd? n) (cons 1 (build-num (/ (dec n) 2)))))

(defne poso [x]
  ([[_ . _]]))

(defne >1o [x]
  ([[_ _ . _]]))

(defne bit-xoro [x y r]
  ([1 1 0])
  ([0 1 1])
  ([1 0 1])
  ([0 0 0]))

(defne bit-ando [x y c]
  ([1 1 1])
  ([0 1 0])
  ([1 0 0])
  ([0 0 0]))

(defn half-addero [x y r c]
  (fresh []
         (bit-xoro x y r)
         (bit-ando x y c)))

(defn full-addero [b x y r c]
  (fresh [w xy wz]
         (half-addero x y w xy)
         (half-addero w b r wz)
         (bit-xoro xy wz c)))

(declare addero)

(defne gen-addero [d n m r]
  ([_ [?a . ?x] [?b . ?y] [?c . ?z]]
     (fresh [e]
            (poso ?y)
            (poso ?z)
            (full-addero d ?a ?b ?c e)
            (addero e ?x ?y ?z))))

(defne addero [d n m r]
  ([0 _ () _] (== n r))
  ([0 () _ _] (== m r) (poso m))
  ([1 _ () _] (addero 0 n [1] r))
  ([1 () _ _] (poso m) (addero 0 [1] m r))
  ([_ [1] [1] _]
     (fresh [a c]
            (== [a c] r)
            (full-addero d 1 1 a c)))
  ([_ [1] _ _]
     (gen-addero d n m r))
  ([_ _ [1] _]
     (>1o n)
     (>1o r)
     (addero d [1] n r))
  ([_ _ _ _]
     (>1o n)
     (gen-addero d n m r)))

(defn pluso [n m k]
  (addero 0 n m k))

(defn minuso [n m k]
  (pluso m k n))

;;;; My code starts here ;;;;

(defn wayso [amt result]
  (conde
   ((== (build-num 0) amt) (== result succeed))
   ((poso amt)
    (fresh [steps rem]
      (membero steps (map build-num [1 2 3]))
      (minuso amt steps rem)
      (wayso rem result)))))

(defn different-ways [x]
  (count
   (run* [result]
     (wayso (build-num x) result))))

(defn -main []
  (println (different-ways 5)))