a few clojure core.logic relations

rels.clj

(ns logic-data-transform.core
  (:use [clojure.core.logic])
  (:require [clojure.test :as test])
  (:require [clojure.core.match :refer [match]]))

(defn assoco
  ([base & args]
   (let [out (last args)
         bindings (partition 2 (butlast args))]
     (apply conjo base (conj (vec bindings) out)))))

(test/is (= (run* [q]
              (assoco q 2 2  {2 2 3 3}))
            '({3 3})))
(test/is (= (run* [q]
              (assoco q 2 2 3 3 {2 2 3 3}))
            '({})))
(test/is (= (run* [q]
              (assoco q 1 2 3 3 {2 2 3 3}))
            '()))


(defne removeo [x col removed]
  ([_ [] []])
  ([_ [x . ys] _]
   (removeo x ys removed))
  ([_ [y . ys] _]
   (!= x y)
   (fresh [removed%]
     (conso y removed% removed)
     (removeo x ys removed%))))

(test/is (= (run 1 [q]
              (removeo 1 [1 3 1 2] q))
            '((3 2))))

(defne uniqifyo [col uniqcol]
  ([[] []])
  ([[x . xs] _]
   (fresh [no-x uniqcol%]
     (conso x uniqcol% uniqcol)
     (removeo x xs no-x)
     (uniqifyo no-x uniqcol%))))

(test/is (= (run 1 [q]
              (uniqifyo [1 1 1] q))
            '((1))))

(test/is (= (run 1 [q]
              (uniqifyo [1 1 2 1] q))
            '((1 2))))

(test/is (= (into #{} (run 3 [q]
                        (uniqifyo q q)))
            '#{[] (_0) ((_0 _1) :- (!= (_0 _1)))}))


(defn uniq-eltso [q] (uniqifyo q q))
(test/is (= (into #{} (run 3 [q] (uniq-eltso q)))
            '#{[] (_0) ((_0 _1) :- (!= (_0 _1)))}))

;;;  more efficient unique?

(defne drop-while= [x lst dropped]
  ([_ [] []])
  ([_ [x . ys] _]
   (drop-while= x ys dropped))
  ([_ [y . _] lst]
   (!= y x)))

(test/is (= (run 1 [q]
              (drop-while= 1 [1 1 2 3 1] q))
            '((2 3 1))))
(test/is (= (run 1 [q]
              (drop-while= 1 [1 1 1] q))
            '([])))


(defn rename-keyo [lmap lkey rkey rmap]
  (fresh [val basemap]
    (conjo basemap [lkey val] lmap)
    (conjo basemap [rkey val] rmap)))

(run 1 [q]
  (rename-keyo {:x 1} :x :y q))