core logic graph hacks

graph_cl.clj

(ns graph-cl
  (:refer-clojure :exclude [==])
  (:use clojure.core.logic))

(defrel edge a b)

(fact edge :b :a)
(fact edge :c :a)
(fact edge :d :b)
(fact edge :d :c)

(defne ancestorso [x y]
  ([x y]
     (edge x y))
  ([x y]
     (fresh [z]
            (edge x z)
            (ancestorso z y))))

(run* [q] (ancestorso :d q))
;; (:c :b :a :a)

(defne travel [a b visted path]
  ([a b visited [b . visited]]
     (edge a b))
  ([a b visited path]
     (fresh [c new-vis]
            (edge a c)
            (!= c b)
            (conso c visited new-vis)
            (travel c b new-vis path))))

(defn path [a b path]
  (travel a b [a] path))     ;; reverse path

(run* [q] (path :d :a q))
;; ((:a :c :d) (:a :b :d))

;; ----------------------------

(defne not-membero [x l]
  ([_ []])
  ([_ [h . t]]
    (!= x h)
    (not-membero x t)))

(run* [q]
      (conde
       [(== q :c)]
       [(== q :d)])
      (not-membero q [:a :b :c :c]))
;; (:d)

(defne dancestorso [a visited res]
  ([a visited _]
     (fresh [b]
            (== res b)
            (edge a b)
            (not-membero b visited)))
  ([a visited _]
    (fresh [b new-vis]
           (edge a b)
           (conso b visited new-vis)
           (dancestorso b new-vis res))))

(run* [q] (dancestorso :d [] q))
;; (:c :b :a :a)

(run* [q] (edge :d q))
;; (:c :b)

(run* [q]
      (fresh [a1 b1 visited1]
             (== a1 :d)
             (== visited1 [])
             (edge a1 b1)
             ;; b1 (:c :b)
             (not-membero b1 visited1)
             ;; s#
             (fresh [new-vis1]
                    (conso b1 visited1 new-vis1)
                    ;; new-vis1 ((:c) (:b)))
                    (fresh [a2 b2 visited2]
                           (== a2 b1)
                           (== visited2 new-vis1)
                           (edge a2 b2)
                           ;; b2 (:a :a)
                           (not-membero b2 visited2)
                           ;; s#
                           (== q b2)))))

;; These attempts are futile, since we are not visiting :a before we visit *both* of them.

(run* [q]
      (fresh [x y]
             (== q y)
             (edge :d x)   ;; x (:c :b)
             (edge x y)))   
;; (:a :a)