1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/test_contrib/datalog/tests/test_literals.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,187 @@
     1.4 +;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
     1.5 +;;  distribution terms for this software are covered by the Eclipse Public
     1.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
     1.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
     1.8 +;;  using this software in any fashion, you are agreeing to be bound by the
     1.9 +;;  terms of this license.  You must not remove this notice, or any other,
    1.10 +;;  from this software.
    1.11 +;;
    1.12 +;;  test-literals.clj
    1.13 +;;
    1.14 +;;  A Clojure implementation of Datalog -- Literals tests
    1.15 +;;
    1.16 +;;  straszheimjeffrey (gmail)
    1.17 +;;  Created 25 Feburary 2009
    1.18 +
    1.19 +
    1.20 +(ns clojure.contrib.datalog.tests.test-literals
    1.21 +  (:use clojure.test)
    1.22 +  (:use clojure.contrib.datalog.literals
    1.23 +        clojure.contrib.datalog.database))
    1.24 +
    1.25 +
    1.26 +(def pl (eval (build-literal '(:fred :x ?x :y ?y :z 3))))
    1.27 +(def nl (eval (build-literal '(not! :fred :x ?x :y ?y :z 3))))
    1.28 +(def cl (eval (build-literal '(if > ?x 3))))
    1.29 +
    1.30 +(def bl (eval (build-literal '(:fred))))
    1.31 +
    1.32 +(def bns {:x '?x :y '?y :z 3})
    1.33 +
    1.34 +(deftest test-build-literal
    1.35 +  (is (= (:predicate pl) :fred))
    1.36 +  (is (= (:term-bindings pl) bns))
    1.37 +  (is (= (:predicate nl) :fred))
    1.38 +  (is (= (:term-bindings nl) bns))
    1.39 +  (is (= (:symbol cl) '>))
    1.40 +  (is (= (:terms cl) '(?x 3)))
    1.41 +  (is ((:fun cl) [4 3]))
    1.42 +  (is (not ((:fun cl) [2 4])))
    1.43 +  (is (= (:predicate bl) :fred)))
    1.44 +
    1.45 +(deftest test-literal-predicate
    1.46 +  (is (= (literal-predicate pl) :fred))
    1.47 +  (is (= (literal-predicate nl) :fred))
    1.48 +  (is (nil? (literal-predicate cl)))
    1.49 +  (is (= (literal-predicate bl) :fred)))
    1.50 +
    1.51 +(deftest test-literal-columns
    1.52 +  (is (= (literal-columns pl) #{:x :y :z}))
    1.53 +  (is (= (literal-columns nl) #{:x :y :z}))
    1.54 +  (is (nil? (literal-columns cl)))
    1.55 +  (is (empty? (literal-columns bl))))
    1.56 +
    1.57 +(deftest test-literal-vars
    1.58 +  (is (= (literal-vars pl) #{'?x '?y}))
    1.59 +  (is (= (literal-vars nl) #{'?x '?y}))
    1.60 +  (is (= (literal-vars cl) #{'?x}))
    1.61 +  (is (empty? (literal-vars bl))))
    1.62 +
    1.63 +(deftest test-positive-vars
    1.64 +  (is (= (positive-vars pl) (literal-vars pl)))
    1.65 +  (is (nil? (positive-vars nl)))
    1.66 +  (is (nil? (positive-vars cl)))
    1.67 +  (is (empty? (positive-vars bl))))
    1.68 +
    1.69 +(deftest test-negative-vars
    1.70 +  (is (nil? (negative-vars pl)))
    1.71 +  (is (= (negative-vars nl) (literal-vars nl)))
    1.72 +  (is (= (negative-vars cl) (literal-vars cl)))
    1.73 +  (is (empty? (negative-vars bl))))
    1.74 +
    1.75 +(deftest test-negated?
    1.76 +  (is (not (negated? pl)))
    1.77 +  (is (negated? nl))
    1.78 +  (is (not (negated? cl))))
    1.79 +
    1.80 +(deftest test-vs-from-cs
    1.81 +  (is (= (get-vs-from-cs pl #{:x}) #{'?x}))
    1.82 +  (is (empty? (get-vs-from-cs pl #{:z})))
    1.83 +  (is (= (get-vs-from-cs pl #{:x :r}) #{'?x}))
    1.84 +  (is (empty? (get-vs-from-cs pl #{}))))
    1.85 +
    1.86 +(deftest test-cs-from-vs
    1.87 +  (is (= (get-cs-from-vs pl #{'?x}) #{:x}))
    1.88 +  (is (= (get-cs-from-vs pl #{'?x '?r}) #{:x}))
    1.89 +  (is (empty? (get-cs-from-vs pl #{}))))
    1.90 +
    1.91 +(deftest test-literal-appropriate?
    1.92 +  (is (not (literal-appropriate? #{} pl)))
    1.93 +  (is (literal-appropriate? #{'?x} pl))
    1.94 +  (is (not (literal-appropriate? #{'?x} nl)))
    1.95 +  (is (literal-appropriate? #{'?x '?y} nl))
    1.96 +  (is (not (literal-appropriate? #{'?z} cl)))
    1.97 +  (is (literal-appropriate? #{'?x} cl)))
    1.98 +
    1.99 +(deftest test-adorned-literal
   1.100 +  (is (= (literal-predicate (adorned-literal pl #{:x}))
   1.101 +         {:pred :fred :bound #{:x}}))
   1.102 +  (is (= (literal-predicate (adorned-literal nl #{:x :y :q}))
   1.103 +         {:pred :fred :bound #{:x :y}}))
   1.104 +  (is (= (:term-bindings (adorned-literal nl #{:x}))
   1.105 +         {:x '?x :y '?y :z 3}))
   1.106 +  (is (= (adorned-literal cl #{})
   1.107 +         cl)))
   1.108 +
   1.109 +(deftest test-get-adorned-bindings
   1.110 +  (is (= (get-adorned-bindings (literal-predicate (adorned-literal pl #{:x})))
   1.111 +         #{:x}))
   1.112 +  (is (= (get-adorned-bindings (literal-predicate pl))
   1.113 +         nil)))
   1.114 +
   1.115 +(deftest test-get-base-predicate
   1.116 +  (is (= (get-base-predicate (literal-predicate (adorned-literal pl #{:x})))
   1.117 +         :fred))
   1.118 +  (is (= (get-base-predicate (literal-predicate pl))
   1.119 +         :fred)))
   1.120 +
   1.121 +(deftest test-magic-literal
   1.122 +  (is (= (magic-literal pl)
   1.123 +         {:predicate {:pred :fred :magic true}, :term-bindings {}, :literal-type :clojure.contrib.datalog.literals/literal}))
   1.124 +  (is (= (magic-literal (adorned-literal pl #{:x}))
   1.125 +         {:predicate {:pred :fred :magic true :bound #{:x}},
   1.126 +          :term-bindings {:x '?x},
   1.127 +          :literal-type :clojure.contrib.datalog.literals/literal})))
   1.128 +
   1.129 +(comment
   1.130 +  (use 'clojure.contrib.stacktrace) (e)
   1.131 +  (use :reload 'clojure.contrib.datalog.literals)
   1.132 +)
   1.133 +
   1.134 +
   1.135 +(def db1 (make-database
   1.136 +           (relation :fred [:x :y])
   1.137 +           (index :fred :x)
   1.138 +           (relation :sally [:x])))
   1.139 +
   1.140 +(def db2 (add-tuples db1
   1.141 +             [:fred :x 1 :y :mary]
   1.142 +             [:fred :x 1 :y :becky]
   1.143 +             [:fred :x 3 :y :sally]
   1.144 +             [:fred :x 4 :y :joe]
   1.145 +             [:sally :x 1]
   1.146 +             [:sally :x 2]))
   1.147 +
   1.148 +(def lit1 (eval (build-literal '(:fred :x ?x :y ?y))))
   1.149 +(def lit2 (eval (build-literal '(not! :fred :x ?x))))
   1.150 +(def lit3 (eval (build-literal '(if > ?x ?y))))
   1.151 +(def lit4 (adorned-literal (eval (build-literal '(:joan :x ?x :y ?y))) #{:x}))
   1.152 +
   1.153 +(deftest test-join-literal
   1.154 +  (is (= (set (join-literal db2 lit1 [{'?x 1} {'?x 2} {'?x 3}]))
   1.155 +         #{{'?x 1, '?y :mary} {'?x 1, '?y :becky} {'?x 3, '?y :sally}}))
   1.156 +  (is (= (join-literal db2 lit2 [{'?x 1} {'?x 2} {'?x 3}])
   1.157 +         [{'?x 2}]))
   1.158 +  (is (= (join-literal db2 lit3 [{'?x 1 '?y 2} {'?x 3 '?y 1}])
   1.159 +         [{'?x 3 '?y 1}])))
   1.160 +         
   1.161 +(deftest test-project-literal
   1.162 +  (is (= ((project-literal db2 lit4 [{'?x 1 '?y 3}{'?x 4 '?y 2}]) {:pred :joan :bound #{:x}})
   1.163 +         (datalog-relation
   1.164 +          ;; Schema
   1.165 +          #{:y :x}
   1.166 +
   1.167 +          ;; Data
   1.168 +          #{
   1.169 +            {:x 1, :y 3}
   1.170 +            {:x 4, :y 2}
   1.171 +            }
   1.172 +          
   1.173 +          ;; Indexes
   1.174 +          {
   1.175 +           :x
   1.176 +           {
   1.177 +            4
   1.178 +            #{{:x 4, :y 2}}
   1.179 +            1
   1.180 +            #{{:x 1, :y 3}}
   1.181 +            }
   1.182 +           }))))
   1.183 +
   1.184 +
   1.185 +
   1.186 +(comment
   1.187 +  (run-tests)
   1.188 +)
   1.189 +
   1.190 +;; End of file