Coverage report: /development/source/library/org/datagraph/spocq-shard/src/algebra/operators/describe.lisp

KindCoveredAll%
expression211319 66.1
branch1734 50.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 defines the describe operator for the 'org.datagraph.spocq' RDF engine."
6
 
7
  (copyright
8
   "Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved.")
9
 
10
  (:long-description
11
   "The describe query form collects the bindings from the initial result field  as subjects for
12
  a new query, which combines a construct and a bgp to produce the graph for those subjects. To produce
13
  the indirect results, an internal query is constructed to request statements for the generated subjects.
14
 
15
  The response graph is one of the variations on the 'concise bounded descritpion'[1,2] form, whereby the
16
  type of the concrete for is specified by concrete form is specified by *describe-form* and the
17
  respective depth by *describe-subject-depth* and *describe-object-depth*.
18
  ---
19
  [1] : http://www.w3.org/Submission/CBD
20
  [2] : http://patterns.dataincubator.org/book/bounded-description.html
21
  "))
22
    
23
 
24
 (defmacro spocq.a:|describe| (solution-field &optional subjects)
25
   "( ( solutionField anyURI* ) RDFSolutionField )
26
 A DESCRIBE form merges all resource IRI from the given solution-field and subject resource list,
27
 performs iteratve queries to produce the bounded descriptions for those resources and yields
28
 an RDF graph which  enumerates their relations in the store.
29
 
30
 The extent is governed by configuration parameters:
31
 - <urn:dydra:describeForm>
32
 - <urn:dydra:describeSubjectDepth>
33
 - <urn:dydra:describeObjectDepth>
34
 "
35
 
36
   (macroexpand-describe solution-field subjects))
37
 
38
 
39
 (defun macroexpand-describe (solution-field subjects)
40
   (let ((variables (expression-variables subjects)))
41
     `(spocq.e:describe (spocq.e::with-reference-dimensions ,variables ,solution-field) ',subjects)))
42
 ;;; (macroexpand-1 (parse-sparql "describe ?s where {?s ?p ?o}"))
43
 
44
 
45
 (defgeneric spocq.e:describe (solution-field subjects)
46
   (:documentation "Given a list of subject, perform a query for those values as subjects and return a graph which
47
  enumerates their relations in the store. The list permits both constant IRI and variables to
48
  be taken from the solutions sets of an optional query pattern.
49
 
50
  Solution modifiers are handled in the constituent where clause")
51
 
52
   (:method :before ((base-source t) subjects)
53
     (incf-stat *algebra-operations*)
54
     (trace-algebra spocq.e:describe base-source subjects (describe-form)))
55
 
56
   (:method ((solution-field solution-generator) subjects)
57
     (describe-generator  solution-field subjects))
58
 
59
   (:method ((null-field null) subjects)
60
     (describe-generator  (unit-table-generator) subjects)))
61
 
62
 
63
 (defun run-describe-thread (result-channel field-generator subjects)
64
   (let ((base-dimensions (solution-generator-dimensions field-generator))
65
         (base-channel (solution-generator-channel field-generator))
66
         (expression (solution-generator-expression field-generator)))
67
     (push 'spocq.a:|describe| (channel-name base-channel))
68
     (let ((*thread-operations* (cons (list 'spocq.a:|describe| base-dimensions subjects)
69
                                      *thread-operations*)))
70
       (query-run-in-thread *query* expression))
71
     (setf (channel-size result-channel) (channel-size base-channel)
72
           (channel-page-length result-channel) (channel-page-length base-channel))
73
     (process-describe *transaction* *transaction*
74
                       result-channel base-channel
75
                       base-dimensions
76
                       subjects)
77
     'spocq.a:|describe|))
78
 
79
 
80
 (defun describe-generator (field-generator subjects)
81
   (let ((result-channel (make-channel :name (list 'spocq.a:|describe| (task-id *query*))
82
                                       :dimensions *describe-dimensions*)))
83
     (make-describe-generator :expression (list #'run-describe-thread result-channel field-generator subjects)
84
                              :channel result-channel
85
                              :constituents (list field-generator))))
86
 
87
 
88
 (defmethod process-describe ((subject-source t) (object-source t)  ;; with lmdb support, this resolves to the specific index
89
                              (destination array-page-channel)
90
                              (base-source array-page-channel)
91
                              base-dimensions subjects)
92
   "Generate a descriptions for the given subjects in the specified form. The following forms
93
  are defined
94
  - dydra:simple-concise-bounded-description
95
  - dydra:inverse-simple-concise-bounded-description
96
  - dydra:symmetric-simple-concise-bounded-description
97
  where the distinction is to as direction. The variations recurse through blank node links
98
  the the depth specified by *describe-subject-depth* and *describe-object-depth*
99
 
100
  when rdf:rest is seen, the limit does not apply, but that does not happen until the second level
101
  it would be possible to triger directly on the blank node"
102
   
103
     (let* ((variables (remove-if-not #'variable-p subjects))
104
            (constants (remove-if #'variable-p subjects))
105
            (result-page-width 3)
106
            (result-page-length (min *field-page-length* (channel-page-length destination)))
107
            (result-page nil)
108
            (result-index result-page-length)
109
            (solution-count 0)
110
            (result-count 0)
111
            (context-term-id (object-term-number '|urn:dydra|:|all|))
112
            (wildcard-term-id (repository-wildcard-term *repository*))
113
            (describe-cache (make-hash-table :test 'equal))
114
            (describe-form (metadata-describe-form *task*))
115
            (describe-object-depth (metadata-describe-object-depth *task*))
116
            (describe-subject-depth (metadata-describe-subject-depth *task*))
117
            (rest-term-id (object-term-number |rdf|:|rest|)))
118
       ;;; special-case rdf list predicates.
119
       (labels ((describe-subject-term-id (term-id &optional (depth describe-subject-depth))
120
                  (when (and (or (null depth) (plusp depth))
121
                             (not (eql term-id +null-term-id+))
122
                             (not (< term-id 0)))
123
                    (trace-data process-describe.subject term-id (term-number-object term-id) depth)
124
                    (flet ((do-terms (context subject predicate object)
125
                             (trace-data process-describe.subject.step context subject predicate object (list (term-number-object predicate) depth))
126
                             (when (and (collect-solution subject predicate object)
127
                                        (or (repository-term-is-blank-node *transaction* object)
128
                                            (describe-property-p predicate)))
129
                               (describe-subject-term-id object (when depth (if (= predicate rest-term-id) depth (1- depth)))))
130
                             t))
131
                      (declare (dynamic-extent #'do-terms))
132
                      (map-repository-statements #'do-terms subject-source term-id wildcard-term-id wildcard-term-id context-term-id))))
133
                (describe-object-term-id (term-id &optional (depth describe-object-depth))
134
                  (when (and (or (null depth) (plusp depth))
135
                             (not (eql term-id +null-term-id+))
136
                             (not (< term-id 0)))
137
                    (trace-data process-describe.object term-id (term-number-object term-id) depth)
138
                    (flet ((do-terms (context subject predicate object)
139
                             (trace-data process-describe.object.step context subject predicate object (list (term-number-object predicate) depth))
140
                             (when (and (collect-solution subject predicate object)
141
                                        (or (repository-term-is-blank-node *transaction* subject)
142
                                            (describe-property-p predicate)))
143
                               (describe-object-term-id subject (when depth (if (= predicate rest-term-id) depth (1- depth)))))
144
                             t))
145
                      (declare (dynamic-extent #'do-terms))
146
                      (map-repository-statements #'do-terms object-source wildcard-term-id wildcard-term-id term-id context-term-id))))
147
                (collect-solution (subject predicate object)
148
                  (unless (gethash (list subject predicate object) describe-cache)
149
                    (next-solution-location)
150
                    (setf (aref result-page result-index 0) subject
151
                          (aref result-page result-index 1) predicate
152
                          (aref result-page result-index 2) object)
153
                    (setf (gethash (list subject predicate object) describe-cache) t)))
154
                (next-solution-location ()
155
                  (incf result-count)
156
                  ;; return a page (possible newly created) and the next free location in that page
157
                  (when (>= (incf result-index) result-page-length)
158
                    (when result-page (put-page result-page))
159
                    (setf result-page (new-field-page destination result-page-length result-page-width)
160
                          result-index 0)))
161
                (complete-solutions ()
162
                  (when result-page
163
                    (let ((page-result-count (1+ result-index)))
164
                      (when (< page-result-count result-page-length)
165
                        (setf result-page
166
                              (adjust-page result-page (list page-result-count result-page-width)))))
167
                    (put-page result-page))
168
                  (complete-field destination)
169
                  (incf-stat *solutions-processed* solution-count)
170
                  (incf-stat *solutions-constructed* result-count)
171
                  (return-from process-describe
172
                    (values solution-count result-count)))
173
                (put-page (page)
174
                  (trace-algebra process-describe destination (term-value-field page))
175
                  (put-field-page destination page)))
176
       (declare (dynamic-extent #'describe-subject-term-id #'describe-object-term-id))
177
       (loop for constant in constants
178
             for constant-term-number = (object-term-number constant)
179
             do (ecase describe-form
180
                  (|urn:dydra|:|simple-concise-bounded-description|
181
                   (describe-subject-term-id constant-term-number))
182
                  (|urn:dydra|:|simple-symmetric-concise-bounded-description|
183
                   (describe-subject-term-id constant-term-number)
184
                   (describe-object-term-id constant-term-number))
185
                  (|urn:dydra|:|simple-inverse-concise-bounded-description|
186
                   (describe-object-term-id constant-term-number))))
187
       (when base-dimensions
188
         (let ((subject-iterator (compute-binding-iterator base-dimensions variables)))
189
           (declare (type (function (function array fixnum)) subject-iterator))
190
           (do-pages (base-page base-source)
191
             (check-query-status *query*)
192
             (incf solution-count (array-dimension base-page 0))
193
             (dotimes (base-index (array-dimension base-page 0))
194
               (ecase describe-form
195
                 (|urn:dydra|:|simple-concise-bounded-description|
196
                  (funcall subject-iterator #'describe-subject-term-id base-page base-index))
197
                 (|urn:dydra|:|simple-symmetric-concise-bounded-description|
198
                  (funcall subject-iterator #'describe-subject-term-id base-page base-index)
199
                  (funcall subject-iterator #'describe-object-term-id base-page base-index))
200
                 (|urn:dydra|:|simple-inverse-concise-bounded-description|
201
                  (funcall subject-iterator #'describe-object-term-id base-page base-index)))))))
202
       (complete-solutions))))
203
 
204
 
205
 #+(or)
206
 (defun process-describe (destination base-source base-dimensions subjects)
207
   "Accept a solution field from a source, extract each s-p-o resource, perform a recursive select for each
208
  as the subject and emit consolidate those streams as the results."
209
 
210
   (declare (list base-dimensions subjects))
211
   (assert-argument-types process-describe
212
     (destination (or channel function))
213
     (base-source (or channel function))
214
     (base-dimensions list)
215
     (subjects list))
216
   (incf-stat *algebra-operations*)
217
   (trace-algebra process-describe base-source base-dimensions subjects)
218
 
219
   (let* ((variables (remove-if-not #'variable-p subjects))
220
          (constants (remove-if #'variable-p subjects))
221
          (result-page-width 3)
222
          (result-page-length (min *field-page-length* (channel-page-length destination)))
223
          (result-page nil)
224
          (result-index result-page-length)
225
          (solution-count 0)
226
          (result-count 0)
227
          (subject-cache (make-hash-table :test 'eql)))
228
     (labels ((describe-subject (subject-term-id &optional subject)
229
                ;; for each non-null subject perform a sub-query and pass the results through the destination
230
                (unless (or (eql subject-term-id +null-term-id+)
231
                            (< subject-term-id 0)
232
                            (gethash subject-term-id subject-cache))
233
                  (setf (gethash subject-term-id subject-cache) t)
234
                  (flet ((sub-query-processor (subquery-page)
235
                           (do-solution-field (p o) subquery-page
236
                             (incf solution-count)
237
                             (collect-solution subject-term-id p o))))
238
                    (let ((subject (or subject (term-number-object subject-term-id))))
239
                      ;; !!! change graph to (spocq.a:|graph| |urn:dydra|:|all|)
240
                      ;; and perform just one query
241
                      ;; describe from the default graph
242
                      (let* ((field-generator (spocq.e:select
243
                                               (agp-generator
244
                                                (make-agp :body `((spocq.a:|triple| ,subject ?::|p| ?::|o|))
245
                                                          :processing-mode :synchronous))
246
                                               '(?::|p| ?::|o|)))
247
                             (expression (solution-generator-expression field-generator))
248
                             (po-channel (solution-generator-channel field-generator)))
249
                        (query-run-in-thread *query* expression)
250
                        (do-pages (po-page po-channel)
251
                          (incf solution-count (array-dimension po-page 0))
252
                          (sub-query-processor po-page)))
253
                      ;; describe from all named graphs
254
                      (let* ((field-generator (spocq.e:select
255
                                               (agp-generator
256
                                                (make-agp :body `((spocq.a:|triple| ,subject ?::|p| ?::|o|)
257
                                                                  (spocq.a:|graph| ?::|g|))
258
                                                          :processing-mode :synchronous))
259
                                               '(?::|p| ?::|o|)))
260
                             (expression (solution-generator-expression field-generator))
261
                             (po-channel (solution-generator-channel field-generator)))
262
                        (query-run-in-thread *query* expression)
263
                        (do-pages (po-page po-channel)
264
                          (incf solution-count (array-dimension po-page 0))
265
                          (sub-query-processor po-page)))))))
266
              (collect-solution (subject predicate object)
267
                (next-solution-location)
268
                (setf (aref result-page result-index 0) subject
269
                      (aref result-page result-index 1) predicate
270
                      (aref result-page result-index 2) object))
271
              (next-solution-location ()
272
                (incf result-count)
273
                ;; return a page (possible newly created) and the next free location in that page
274
                (when (>= (incf result-index) result-page-length)
275
                  (when result-page (put-page result-page))
276
                  (setf result-page (new-field-page destination result-page-length result-page-width)
277
                        result-index 0)))
278
              (complete-solutions ()
279
                (when result-page
280
                  (let ((page-result-count (1+ result-index)))
281
                    (when (< page-result-count result-page-length)
282
                      (setf result-page
283
                            (adjust-page result-page (list page-result-count result-page-width)))))
284
                  (put-page result-page))
285
                (put-page nil)
286
                (incf-stat *solutions-processed* solution-count)
287
                (incf-stat *solutions-constructed* result-count)
288
                (return-from process-describe
289
                  (values solution-count result-count)))
290
              (put-page (page)
291
                (trace-algebra process-describe destination (term-value-field page))
292
                (if page
293
                  (put-field-page destination page)
294
                  (complete-field destination))))
295
       (declare (dynamic-extent #'describe-subject))
296
       (dolist (constant constants)
297
         (describe-subject (object-term-number constant) constant))
298
       (when base-dimensions
299
         (let ((subject-iterator (compute-binding-iterator base-dimensions variables)))
300
           (declare (type (function (function array fixnum)) subject-iterator))
301
           (do-pages (base-page base-source)
302
             (check-query-status *query*)
303
             (incf solution-count (array-dimension base-page 0))
304
             (dotimes (base-index (array-dimension base-page 0))
305
               (funcall subject-iterator #'describe-subject base-page base-index)))))
306
       (complete-solutions))))
307
 
308
 
309