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 ;;  example.clj

    10 ;;

    11 ;;  A Clojure implementation of Datalog - Example

    12 ;;

    13 ;;  straszheimjeffrey (gmail)

    14 ;;  Created 2 March 2009

    15 

    16 

    17 (ns clojure.contrib.datalog.example

    18   (:use [clojure.contrib.datalog :only (build-work-plan run-work-plan)]

    19         [clojure.contrib.datalog.rules :only (<- ?- rules-set)]

    20         [clojure.contrib.datalog.database :only (make-database add-tuples)]

    21         [clojure.contrib.datalog.util :only (*trace-datalog*)]))

    22 

    23 

    24 

    25 

    26 (def db-base

    27      (make-database

    28       (relation :employee [:id :name :position])

    29       (index :employee :name)

    30 

    31       (relation :boss [:employee-id :boss-id])

    32       (index :boss :employee-id)

    33 

    34       (relation :can-do-job [:position :job])

    35       (index :can-do-job :position)

    36 

    37       (relation :job-replacement [:job :can-be-done-by])

    38       ;(index :job-replacement :can-be-done-by)

    39 

    40       (relation :job-exceptions [:id :job])))

    41 

    42 (def db

    43      (add-tuples db-base

    44            [:employee :id 1  :name "Bob"    :position :boss]

    45            [:employee :id 2  :name "Mary"   :position :chief-accountant]

    46            [:employee :id 3  :name "John"   :position :accountant]

    47            [:employee :id 4  :name "Sameer" :position :chief-programmer]

    48            [:employee :id 5  :name "Lilian" :position :programmer]

    49            [:employee :id 6  :name "Li"     :position :technician]

    50            [:employee :id 7  :name "Fred"   :position :sales]

    51            [:employee :id 8  :name "Brenda" :position :sales]

    52            [:employee :id 9  :name "Miki"   :position :project-management]

    53            [:employee :id 10 :name "Albert" :position :technician]

    54            

    55            [:boss :employee-id 2  :boss-id 1]

    56            [:boss :employee-id 3  :boss-id 2]

    57            [:boss :employee-id 4  :boss-id 1]

    58            [:boss :employee-id 5  :boss-id 4]

    59            [:boss :employee-id 6  :boss-id 4]

    60            [:boss :employee-id 7  :boss-id 1]

    61            [:boss :employee-id 8  :boss-id 7]

    62            [:boss :employee-id 9  :boss-id 1]

    63            [:boss :employee-id 10 :boss-id 6]

    64 

    65            [:can-do-job :position :boss               :job :management]

    66            [:can-do-job :position :accountant         :job :accounting]

    67            [:can-do-job :position :chief-accountant   :job :accounting]

    68            [:can-do-job :position :programmer         :job :programming]

    69            [:can-do-job :position :chief-programmer   :job :programming]           

    70            [:can-do-job :position :technician         :job :server-support]

    71            [:can-do-job :position :sales              :job :sales]

    72            [:can-do-job :position :project-management :job :project-management]

    73 

    74            [:job-replacement :job :pc-support :can-be-done-by :server-support]

    75            [:job-replacement :job :pc-support :can-be-done-by :programming]

    76            [:job-replacement :job :payroll    :can-be-done-by :accounting]

    77 

    78            [:job-exceptions :id 4 :job :pc-support]))

    79 

    80 (def rules

    81      (rules-set

    82         (<- (:works-for :employee ?x :boss ?y) (:boss :employee-id ?e-id :boss-id ?b-id)

    83                                                (:employee :id ?e-id :name ?x)

    84                                                (:employee :id ?b-id :name ?y))

    85         (<- (:works-for :employee ?x :boss ?y) (:works-for :employee ?x :boss ?z)

    86                                                (:works-for :employee ?z :boss ?y))

    87         (<- (:employee-job* :employee ?x :job ?y) (:employee :name ?x :position ?pos)

    88                                                   (:can-do-job :position ?pos :job ?y))

    89         (<- (:employee-job* :employee ?x :job ?y) (:job-replacement :job ?y :can-be-done-by ?z)

    90                                                   (:employee-job* :employee ?x  :job ?z))

    91         (<- (:employee-job* :employee ?x :job ?y) (:can-do-job :job ?y)

    92                                                   (:employee :name ?x :position ?z)

    93                                                   (if = ?z :boss))

    94         (<- (:employee-job :employee ?x :job ?y) (:employee-job* :employee ?x :job ?y)

    95                                                  (:employee :id ?id :name ?x)

    96                                                  (not! :job-exceptions :id ?id :job ?y))

    97         (<- (:bj :name ?x :boss ?y) (:works-for :employee ?x :boss ?y)

    98                                     (not! :employee-job :employee ?y :job :pc-support))))

    99 

   100 

   101 

   102 (def wp-1 (build-work-plan rules (?- :works-for :employee '??name :boss ?x)))

   103 (run-work-plan wp-1 db {'??name "Albert"})

   104 

   105 (def wp-2 (build-work-plan rules (?- :employee-job :employee '??name :job ?x)))

   106 (binding [*trace-datalog* true]

   107   (run-work-plan wp-2 db {'??name "Li"}))

   108 

   109 (def wp-3 (build-work-plan rules (?- :bj :name '??name :boss ?x)))

   110 (run-work-plan wp-3 db {'??name "Albert"})

   111 

   112 (def wp-4 (build-work-plan rules (?- :works-for :employee ?x :boss ?y)))

   113 (run-work-plan wp-4 db {})

   114 

   115 

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