;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
;;  distribution terms for this software are covered by the Eclipse Public
;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
;;  be found in the file epl-v10.html at the root of this distribution.  By
;;  using this software in any fashion, you are agreeing to be bound by the
;;  terms of this license.  You must not remove this notice, or any other,
;;  from this software.
;;
;;  softstrat.clj
;;
;;  A Clojure implementation of Datalog -- Soft Stratification
;;
;;  straszheimjeffrey (gmail)
;;  Created 28 Feburary 2009


(ns clojure.contrib.datalog.softstrat
  (:use clojure.contrib.datalog.util
        clojure.contrib.datalog.database
        clojure.contrib.datalog.literals
        clojure.contrib.datalog.rules
        clojure.contrib.datalog.magic)
  (:use [clojure.set :only (union intersection difference)])
  (:use [clojure.contrib.seq-utils :only (indexed)])
  (:require [clojure.contrib.graph :as graph]))


;;; Dependency graph

(defn- build-rules-graph
  "Given a rules-set (rs), build a graph where each predicate symbol in rs,
   there is a node n, and for each rule (<- h b-1 b-2 ...), there are edges
   from the (literal-predicate h) -> (literal-predicate b-*), one for each
   b-*."
  [rs]
  (let [preds (all-predicates rs)
        pred-map (predicate-map rs)
        step (fn [nbs pred]
               (let [rules (pred-map pred)
                     preds (reduce (fn [pds lits]
                                     (reduce (fn [pds lit]
                                               (if-let [pred (literal-predicate lit)]
                                                 (conj pds pred)
                                                 pds))
                                             pds
                                             lits))
                                   #{}
                                   (map :body rules))]
                 (assoc nbs pred preds)))
        neighbors (reduce step {} preds)]
    (struct graph/directed-graph preds neighbors)))

(defn- build-def
  "Given a rules-set, build its def function"
  [rs]
  (let [pred-map (predicate-map rs)
        graph (-> rs
                  build-rules-graph
                  graph/transitive-closure
                  graph/add-loops)]
    (fn [pred]
      (apply union (map set (map pred-map (graph/get-neighbors graph pred)))))))


;;; Soft Stratificattion REQ Graph                 

(defn- req
  "Returns a rules-set that is a superset of req(lit) for the lit at
  index lit-index"
  [rs soft-def rule lit-index]
  (let [head (:head rule)
        body (:body rule)
        lit (nth body lit-index)
        pre (subvec (vec body) 0 lit-index)]
    (conj (-> lit literal-predicate soft-def (magic-transform (all-predicates rs)))
          (build-rule (magic-literal lit) pre))))

(defn- rule-dep
  "Given a rule, return the set of rules it depends on."
  [rs mrs soft-def rule]
  (let [step (fn [nrs [idx lit]]
               (if (negated? lit)
                 (union nrs (req rs soft-def rule idx))
                 nrs))]
    (intersection mrs
                  (reduce step empty-rules-set (-> rule :body indexed)))))

(defn- soft-strat-graph
  "The dependency graph for soft stratification."
  [rs mrs]
  (let [soft-def (build-def rs)
        step (fn [nbrs rule]
               (assoc nbrs rule (rule-dep rs mrs soft-def rule)))
        nbrs (reduce step {} mrs)]
    (struct graph/directed-graph mrs nbrs)))

(defn- build-soft-strat
  "Given a rules-set (unadorned) and an adorned query, return the soft
   stratified list.  The rules will be magic transformed, and the
   magic seed will be appended."
  [rs q]
  (let [ars (adorn-rules-set rs q)
        mrs (conj (magic-transform ars)
                  (seed-rule q))
        gr (soft-strat-graph ars mrs)]
    (map make-rules-set (graph/dependency-list gr))))
        

;;; Work plan

(defstruct soft-strat-work-plan
  :query
  :stratification)

(defn build-soft-strat-work-plan
  "Return a work plan for the given rules-set and query"
  [rs q]
  (let [aq (adorn-query q)]
    (struct soft-strat-work-plan aq (build-soft-strat rs aq))))

(defn get-all-relations
  "Return a set of all relation names defined in this workplan"
  [ws]
  (apply union (map all-predicates (:stratification ws))))


;;; Evaluate

(defn- weak-consq-operator
  [db strat]
  (trace-datalog (println)
                 (println)
                 (println "=============== Begin iteration ==============="))
  (let [counts (database-counts db)]
    (loop [strat strat]
      (let [rs (first strat)]
        (if rs
          (let [new-db (apply-rules-set db rs)]
            (if (= counts (database-counts new-db))
              (recur (next strat))
              new-db))
          db)))))

(defn evaluate-soft-work-set
  ([ws db] (evaluate-soft-work-set ws db {}))
  ([ws db bindings]
     (let [query (:query ws)
           strat (:stratification ws)
           seed (seed-predicate-for-insertion query)
           seeded-db (project-literal db seed [bindings] is-query-var?)
           fun (fn [data]
                 (weak-consq-operator data strat))
           equal (fn [db1 db2]
                   (= (database-counts db1) (database-counts db2)))
           new-db (graph/fixed-point seeded-db fun nil equal)
           pt (build-partial-tuple query bindings)]
       (select new-db (literal-predicate query) pt))))



;; End of file