Coverage report: /development/source/library/org/datagraph/spocq-shard/src/extensions/inference/bgp.lisp

KindCoveredAll%
expression0190 0.0
branch018 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.datagraph.spocq.implementation; -*-
2
 
3
 (in-package :org.datagraph.spocq.implementation)
4
 
5
 (:documentation "This file implements pattern-directed entialment rules the 'org.datagraph.spocq' RDF engine."
6
   (copyright
7
   "Copyright 2019 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved.")
8
   (long-description
9
    "It applies rules by unifying their consequents with BGP statement patterns
10
  and merging their antecedents into the original query as alternative bgps.
11
 
12
     rewrite-bgp
13
     -> graph-pattern-processsor
14
        -> load-graph-rewrite-processor
15
           -> run-sparql
16
           -> compute-isparql-processor
17
     -> activate-statement-processor
18
     -> apply-rewrite-rule
19
 
20
  macroexpand-bgp invokes the rewrite-bgp operation as the :inference phase.
21
  that function accepts the original basic graph pattern statement patterns,
22
  a rule library and the model repository.
23
  it loads the rule definitions from the library and composes their
24
  consequents into an activation graph which filters statement patterns to
25
  yield matched rules.
26
  the match process yields also the bindings necessary to transform the
27
  abstract antecedent espression into a concrete bgp to be incorporated
28
  into the query as an alternaitve to the original.
29
 
30
  rules appear in the library dataset as either sparql construct queries
31
  or n3 inference rules.
32
  n3 rules are reformulated as construct queries to maintain a uniform
33
  basis.
34
  the library includes also grouping and prcedence information which
35
  specifies rule application order.
36
  the result patterns from construct queries serve as consequents and the
37
  where clauses as the antecedents.
38
 
39
  the activation process unifies query statement patterns with abstract rule
40
  patterns in order to permit variable substitution in either direction.
41
  rules are applied by translating them through the unification map and
42
  adding them to the query as an alternative bgp - subject to a test of
43
  their presence in the model repository.
44
 
45
  !!! the current implementation marks expanded patterns such that they
46
  are not re-expanded. this limits expansion combinations while it should
47
  limit just recusrive expansion with the same rule or mechanism.
48
 "))
49
 
50
 (defstruct (pattern-rewrite-state (:include isparql:state))
51
   repository)
52
 
53
 (defparameter *rewrite-bgp.expand-all* nil
54
   "When true, relay the presence constraint on statement pattern eligibility")
55
 
56
 (defun include-rewritten-statement? (statement repository)
57
   (or *rewrite-bgp.expand-all*
58
       (destructuring-bind (subject predicate object) (statement-terms statement)
59
         (or (plusp (repository-pattern-count repository subject predicate object nil))
60
             (plusp (repository-pattern-count repository subject predicate object '?::tmp))))))
61
 
62
 (defun activate-statement-processor (processor statement-pattern continuation state)
63
   (funcall processor statement-pattern
64
            :continuation continuation
65
            :state state))
66
 
67
 (defgeneric rewrite-bgp (statement-patterns library model-repository environment)
68
   (:documentation "compute and return a rewritten bgp if one a replacement is found.
69
    otherwise return the original - to indicate no change.")
70
   (:method ((statement-patterns null) (source-repository t) (model-repository t) (env t))
71
     nil)
72
   (:method ((statement-patterns cons) (query query) (model-repository t) (env t))
73
     (rewrite-bgp statement-patterns (query-library query) model-repository env))
74
   (:method ((statement-patterns cons) (library t) (model-repository string) (env t))
75
     (rewrite-bgp statement-patterns library (repository model-repository) env))
76
   (:method ((statement-patterns cons) (library rule-library) (model-repository repository) (env t))
77
     "Once the arguments have been resolved to the actual library and target repository,
78
      retrieve the library's spin:constraint, spin:rule, spin:constructor
79
      rules ordered by spin:nextRuleProperty"
80
     (rewrite-bgp statement-patterns (graph-rewrite-processor library model-repository) model-repository env))
81
 
82
   (:method ((form cons) (processor graph-rewrite-processor) (model-repository repository) env)
83
     "Combine a set of bgp statement patterns with a library rule index to
84
      activate rules and apply them to rewrite the bgp.
85
      Use each additional statement pattern to activate rules, sort them according to
86
      declared ruleset precedence and individual ordinal.
87
      Apply the successive highest-priority rule to transform the pattern set.
88
      Extract the delta at each pass.
89
      When no active rules remains, return the pattern set as a bgp form."
90
     (let* ((state (make-pattern-rewrite-state :repository model-repository))
91
            (active-rule nil)
92
            (active-solution nil)
93
            (applied-rules '(nil))
94
            (original-form form)
95
            (expanded-forms (list form))
96
            (statement-processor (graph-rewrite-processor-statement-processor processor))
97
            (new-patterns form)
98
            (rule-catalog (graph-rewrite-processor-rules processor)))
99
       (labels ((select-rule ()
100
                  (setf active-rule ()
101
                        active-solution ())
102
                  (flet ((collect-rule (rule-solution)
103
                           (let ((rule-name (getf rule-solution '?::?ruleName)))
104
                             (if rule-name
105
                                 (let* ((rule (gethash rule-name rule-catalog)))
106
                                   (cond ((new-rule? rule)
107
                                          (cond ((null active-rule)
108
                                                 (setf active-rule rule)
109
                                                 (setf active-solution rule-solution))
110
                                                ((rule-precedes rule active-rule)
111
                                                 (setf active-rule rule)
112
                                                 (setf active-solution rule-solution))
113
                                                (t
114
                                                 nil)))
115
                                         (t
116
                                          nil)))
117
                                 nil))))
118
                    (declare (dynamic-extent #'collect-rule))
119
                    (loop for statement-pattern in new-patterns
120
                      do (activate-statement-processor statement-processor statement-pattern #'collect-rule state)
121
                      finally (activate-statement-processor statement-processor nil #'collect-rule state))
122
                    (when active-rule
123
                      (push active-rule applied-rules)
124
                      (make-instance 'active-rule :rule active-rule :bindings active-solution))))
125
                (rule-precedes (r1 r2) (member r2 (rule-successors r1)))
126
                (new-rule? (rule) (not (member rule applied-rules)))
127
                (include-statement? (statement)
128
                  (include-rewritten-statement? statement model-repository)))
129
         (declare (dynamic-extent #'include-statement?)
130
                  (dynamic-extent #'new-rule?))
131
         (loop for active-rule = (select-rule)
132
           until (null active-rule)
133
           do (let* ((new-form (apply-rewrite-rule form active-rule model-repository env)))
134
                (unless (eq new-form form) ;; rule did nothing - eg 0 cardinality
135
                  (setf new-patterns new-form ;; should this delta?
136
                        form new-form))
137
                (push form expanded-forms)))
138
         (values (let ((unique-forms (remove-duplicates expanded-forms)))
139
                   (unless (every #'include-statement? original-form)
140
                     (setf unique-forms (remove original-form unique-forms)))
141
                   (if (rest unique-forms)
142
                     (reduce #'(lambda (f1 f2) `(spocq.a:|union| ,f1 ,f2))
143
                             (loop for form in unique-forms
144
                               ;;;!!! this should collect the rule name as a declration in the bgp
145
                               collect `(spocq.a:|bgp| ,@form)))
146
                     `(spocq.a:|bgp| ,@(first unique-forms))))
147
                 (reverse (mapcar #'cons applied-rules expanded-forms)))))))
148
 
149
 (defgeneric apply-rewrite-rule (form rule model environment)
150
   ;; augment the bgp according to the rule
151
   ;; add elements to the patterns which specifies the rules which generated it.
152
   (:method ((form cons) (active-rule active-rule) (model-repository repository) (env t))
153
     (let* ((rule (active-rule-rule active-rule))
154
            (consequent (active-rule-consequent active-rule))
155
            (antecedent (active-rule-antecedent active-rule))
156
            (independents (set-difference form consequent)))
157
       (flet ((include-statement? (statement)
158
                (include-rewritten-statement? statement model-repository)))
159
         (declare (dynamic-extent #'include-statement?))
160
         (typecase antecedent
161
           (spocq.a:|bgp| ;; replace the matched pattern
162
                    (if (every #'include-statement? (rest antecedent))
163
                        (rest antecedent)
164
                        form))
165
           (t ;; arrange for a sub-query
166
            (let* ((parameters (mapcar #'statement-object consequent))
167
                   (results (mapcar #'statement-subject consequent))
168
                   (predicate (rule-name rule))
169
                   (replacement `((spocq.a:|triple| ,(cons-variable )
170
                                           ,(make-view-verb :url predicate :parameters parameters :results results
171
                                                            :query antecedent)))))
172
              (append independents replacement))))))))
173
 
174