Mercurial > lasercutter
view src/clojure/contrib/datalog/softstrat.clj @ 10:ef7dbbd6452c
added clojure source goodness
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Sat, 21 Aug 2010 06:25:44 -0400 |
parents | |
children |
line wrap: on
line source
1 ;; Copyright (c) Jeffrey Straszheim. All rights reserved. The use and2 ;; distribution terms for this software are covered by the Eclipse Public3 ;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can4 ;; be found in the file epl-v10.html at the root of this distribution. By5 ;; using this software in any fashion, you are agreeing to be bound by the6 ;; terms of this license. You must not remove this notice, or any other,7 ;; from this software.8 ;;9 ;; softstrat.clj10 ;;11 ;; A Clojure implementation of Datalog -- Soft Stratification12 ;;13 ;; straszheimjeffrey (gmail)14 ;; Created 28 Feburary 200917 (ns clojure.contrib.datalog.softstrat18 (:use clojure.contrib.datalog.util19 clojure.contrib.datalog.database20 clojure.contrib.datalog.literals21 clojure.contrib.datalog.rules22 clojure.contrib.datalog.magic)23 (:use [clojure.set :only (union intersection difference)])24 (:use [clojure.contrib.seq :only (indexed)])25 (:require [clojure.contrib.graph :as graph]))28 ;;; Dependency graph30 (defn- build-rules-graph31 "Given a rules-set (rs), build a graph where each predicate symbol in rs,32 there is a node n, and for each rule (<- h b-1 b-2 ...), there are edges33 from the (literal-predicate h) -> (literal-predicate b-*), one for each34 b-*."35 [rs]36 (let [preds (all-predicates rs)37 pred-map (predicate-map rs)38 step (fn [nbs pred]39 (let [rules (pred-map pred)40 preds (reduce (fn [pds lits]41 (reduce (fn [pds lit]42 (if-let [pred (literal-predicate lit)]43 (conj pds pred)44 pds))45 pds46 lits))47 #{}48 (map :body rules))]49 (assoc nbs pred preds)))50 neighbors (reduce step {} preds)]51 (struct graph/directed-graph preds neighbors)))53 (defn- build-def54 "Given a rules-set, build its def function"55 [rs]56 (let [pred-map (predicate-map rs)57 graph (-> rs58 build-rules-graph59 graph/transitive-closure60 graph/add-loops)]61 (fn [pred]62 (apply union (map set (map pred-map (graph/get-neighbors graph pred)))))))65 ;;; Soft Stratificattion REQ Graph67 (defn- req68 "Returns a rules-set that is a superset of req(lit) for the lit at69 index lit-index"70 [rs soft-def rule lit-index]71 (let [head (:head rule)72 body (:body rule)73 lit (nth body lit-index)74 pre (subvec (vec body) 0 lit-index)]75 (conj (-> lit literal-predicate soft-def (magic-transform (all-predicates rs)))76 (build-rule (magic-literal lit) pre))))78 (defn- rule-dep79 "Given a rule, return the set of rules it depends on."80 [rs mrs soft-def rule]81 (let [step (fn [nrs [idx lit]]82 (if (negated? lit)83 (union nrs (req rs soft-def rule idx))84 nrs))]85 (intersection mrs86 (reduce step empty-rules-set (-> rule :body indexed)))))88 (defn- soft-strat-graph89 "The dependency graph for soft stratification."90 [rs mrs]91 (let [soft-def (build-def rs)92 step (fn [nbrs rule]93 (assoc nbrs rule (rule-dep rs mrs soft-def rule)))94 nbrs (reduce step {} mrs)]95 (struct graph/directed-graph mrs nbrs)))97 (defn- build-soft-strat98 "Given a rules-set (unadorned) and an adorned query, return the soft99 stratified list. The rules will be magic transformed, and the100 magic seed will be appended."101 [rs q]102 (let [ars (adorn-rules-set rs q)103 mrs (conj (magic-transform ars)104 (seed-rule q))105 gr (soft-strat-graph ars mrs)]106 (map make-rules-set (graph/dependency-list gr))))109 ;;; Work plan111 (defstruct soft-strat-work-plan112 :query113 :stratification)115 (defn build-soft-strat-work-plan116 "Return a work plan for the given rules-set and query"117 [rs q]118 (let [aq (adorn-query q)]119 (struct soft-strat-work-plan aq (build-soft-strat rs aq))))121 (defn get-all-relations122 "Return a set of all relation names defined in this workplan"123 [ws]124 (apply union (map all-predicates (:stratification ws))))127 ;;; Evaluate129 (defn- weak-consq-operator130 [db strat]131 (trace-datalog (println)132 (println)133 (println "=============== Begin iteration ==============="))134 (let [counts (database-counts db)]135 (loop [strat strat]136 (let [rs (first strat)]137 (if rs138 (let [new-db (apply-rules-set db rs)]139 (if (= counts (database-counts new-db))140 (recur (next strat))141 new-db))142 db)))))144 (defn evaluate-soft-work-set145 ([ws db] (evaluate-soft-work-set ws db {}))146 ([ws db bindings]147 (let [query (:query ws)148 strat (:stratification ws)149 seed (seed-predicate-for-insertion query)150 seeded-db (project-literal db seed [bindings] is-query-var?)151 fun (fn [data]152 (weak-consq-operator data strat))153 equal (fn [db1 db2]154 (= (database-counts db1) (database-counts db2)))155 new-db (graph/fixed-point seeded-db fun nil equal)156 pt (build-partial-tuple query bindings)]157 (select new-db (literal-predicate query) pt))))161 ;; End of file