Mercurial > lasercutter

     1 ;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and

     2 ;;  distribution terms for this software are covered by the Eclipse Public

     3 ;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can

     4 ;;  be found in the file epl-v10.html at the root of this distribution.  By

     5 ;;  using this software in any fashion, you are agreeing to be bound by the

     6 ;;  terms of this license.  You must not remove this notice, or any other,

     7 ;;  from this software.

     8 ;;

     9 ;;  test-rules.clj

    10 ;;

    11 ;;  A Clojure implementation of Datalog -- Rule Tests

    12 ;;

    13 ;;  straszheimjeffrey (gmail)

    14 ;;  Created 12 Feburary 2009

    15 

    16 

    17 (ns clojure.contrib.datalog.tests.test-rules

    18   (:use clojure.test

    19         clojure.contrib.datalog.rules

    20         clojure.contrib.datalog.literals

    21         clojure.contrib.datalog.database))

    22 

    23 

    24 (def tr-1 (<- (:fred :x ?x :y ?y) (:mary :x ?x :z ?z) (:sally :z ?z :y ?y)))

    25 (def tr-2 (<- (:fred) (not! :mary :x 3)))

    26 (def tr-3 (<- (:fred :x ?x :y ?y) (if > ?x ?y) (:mary :x ?x) (:sally :y ?y)))

    27 

    28 

    29 

    30 (deftest test-rule-safety

    31   (is (thrown-with-msg? Exception #".*Head vars.*not bound.*"

    32          (<- (:fred :x ?x) (:sally :y ?y))))

    33   (is (thrown-with-msg? Exception #".*Body vars.*not bound.*negative position.*"

    34          (<- (:fred :x ?x) (:becky :x ?x) (not! :sally :y ?y))))

    35   (is (thrown-with-msg? Exception #".*Body vars.*not bound.*negative position.*"

    36          (<- (:fred :x ?x) (:becky :x ?x) (if > ?x ?y)))))

    37 

    38 

    39 (deftest test-sip

    40   (is (= (compute-sip #{:x} #{:mary :sally} tr-1)

    41          (<- ({:pred :fred :bound #{:x}} :x ?x :y ?y)

    42                       ({:pred :mary :bound #{:x}} :z ?z :x ?x)

    43                       ({:pred :sally :bound #{:z}} :y ?y :z ?z))))

    44 

    45   (is (= (compute-sip #{} #{:mary :sally} tr-1)

    46          (<- (:fred :y ?y :x ?x) (:mary :z ?z :x ?x) ({:pred :sally :bound #{:z}} :y ?y :z ?z))))

    47 

    48   (is (= (compute-sip #{} #{:mary} tr-2)

    49          (<- (:fred) (not! {:pred :mary :bound #{:x}} :x 3))))

    50   

    51   (is (= (compute-sip #{} #{} tr-2)

    52          tr-2))

    53 

    54   (is (= (display-rule (compute-sip #{:x} #{:mary :sally} tr-3))

    55          (display-rule (<- ({:pred :fred :bound #{:x}} :x ?x :y ?y)

    56                                ({:pred :mary :bound #{:x}} :x ?x)

    57                                (:sally :y ?y)

    58                                (if > ?x ?y))))))

    59                    ; Display rule is used because = does not work on

    60                    ; (if > ?x ?y) because it contains a closure

    61 

    62 

    63 (def rs

    64      (rules-set

    65         (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?y))

    66         (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y))

    67         (<- (:edge :a ?x :b ?y) (:route :a ?x :b ?y) (if not= ?x ?y))))

    68 

    69 (deftest test-rules-set

    70   (is (= (count rs) 3))

    71   (is (contains? rs (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y)))))

    72   

    73 (deftest test-predicate-map

    74   (let [pm (predicate-map rs)]

    75     (is (= (pm :path)

    76            #{(<- (:path :a ?x :b ?y) (:edge :a ?x :b ?y))

    77              (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y))}))

    78     (is (= (-> :edge pm count) 1))))

    79 

    80 

    81 (def db1 (make-database

    82            (relation :fred [:x :y])

    83            (index :fred :x)

    84            (relation :sally [:x])

    85            (relation :ben [:y])))

    86 

    87 (def db2 (add-tuples db1

    88              [:fred :x 1 :y :mary]

    89              [:fred :x 1 :y :becky]

    90              [:fred :x 3 :y :sally]

    91              [:fred :x 4 :y :joe]

    92              [:fred :x 4 :y :bob]

    93              [:sally :x 1]

    94              [:sally :x 2]

    95              [:sally :x 3]

    96              [:sally :x 4]

    97              [:ben :y :bob]))

    98 

    99 

   100 (deftest test-apply-rule

   101   (is (= (apply-rule db2 empty-database (<- (:becky :y ?y) (:sally :x ?x)

   102                                                            (:fred :x ?x :y ?y)

   103                                                            (not! :ben :y ?y)

   104                                                            (if not= ?x 3)))

   105          (datalog-database

   106           {

   107            :becky

   108            (datalog-relation

   109             ;; Schema

   110             #{:y}

   111             ;; Data

   112             #{

   113               {:y :joe}

   114               {:y :mary}

   115               {:y :becky}

   116               }

   117             ;; Indexes

   118             {

   119              })

   120            }))))

   121 

   122 

   123 

   124 

   125 (comment

   126   (run-tests)

   127 )

   128 

   129 ;; End of file

   130
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 21 Aug 2010 06:25:44 -0400
parents
children