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

KindCoveredAll%
expression0290 0.0
branch020 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 "sparql join operations for matrix fields"
6
   "This file implementes merge joins based on matrix fields.
7
 ")
8
 
9
 ;;; (load (compile-file "/development/source/library/org/datagraph/spocq/src/algebra/matrix-operators/join.lisp"))
10
 
11
   
12
 (defmethod spocq.e:join ((field1 null-solution-field) (field2 matrix-field) &rest args)
13
   (declare (ignore args))
14
   (let* ((result-dimensions (union-dimensions (solution-field-dimensions field1)
15
                                               (solution-field-dimensions field2)))
16
          (result-field (make-matrix-field :dimensions result-dimensions)))
17
     (complete-field-data result-field)
18
     result-field))
19
 
20
 (defmethod spocq.e:join ((field1 matrix-field) (field2 null-solution-field) &rest args)
21
   (declare (ignore args))
22
   (let* ((result-dimensions (union-dimensions (solution-field-dimensions field1)
23
                                               (solution-field-dimensions field2)))
24
          (result-field (make-matrix-field :dimensions result-dimensions)))
25
     (complete-field-data result-field)
26
     result-field))
27
 
28
 (defmethod spocq.e:join ((field1 matrix-field) (field2 matrix-field) &rest args &key start end test)
29
     (declare (dynamic-extent args))
30
     (let* ((left-dimensions (solution-field-dimensions field1))
31
            (right-dimensions (solution-field-dimensions field2))
32
            (result-dimensions (join-result-dimensions left-dimensions right-dimensions))
33
            (length (- (or end (field-length field1)) (or start 0)))
34
            (width (length result-dimensions)))
35
       (multiple-value-bind (field1 field2 sort-order)
36
                            (reconcile-field-order field1 field2)
37
         (let* ((%data (rdfcache:make-matrix length width))
38
                (result-field (clone-matrix-field field1 :data %data
39
                                                  :dimensions result-dimensions
40
                                                  :sort-dimensions sort-order)))
41
           (if (intersection left-dimensions right-dimensions)
42
             (apply #'matrix-natural-join result-field field1 field2 args)
43
             (apply #'matrix-cross-join result-field field1 field2 args))))))
44
 
45
 
46
 (defmethod process-join ((result-field matrix-page-channel)
47
                          (left-field matrix-page-channel)
48
                          (right-field matrix-page-channel)
49
                          left-dimensions right-dimensions
50
                          &rest args)
51
     (declare (ignore start end test)
52
              (dynamic-extent args))
53
     (if (intersection left-dimensions right-dimensions)
54
             (apply #'matrix-natural-join result-field left-field right-field args)
55
             (apply #'matrix-cross-join result-field left-field right-field args))
56
     (values (+ (solution-field-length left-field) (solution-field-length right-field))
57
             (solution-field-length result-field)))
58
 
59
 
60
 
61
 (defun matrix-cross-join (result-field left-field right-field &rest args &key start end test)
62
   "given a result field and the contributing left and right fields, compute the cross-join and
63
  emit it to the result field. the operation extracts the dimensions from the contributing fields,
64
  uses them to generate a generic cross-join map, to identify the implementation operator, which is
65
  generated at first use and then cached.
66
  the result sort order is the catenation of the contributing field orders."
67
   (declare (ignore start end)
68
            (dynamic-extent args))
69
   
70
   (let* ((left-dimensions (field-dimensions left-field))
71
          (right-dimensions (field-dimensions right-field))
72
          (predicate (when test (matrix-binary-predicate-operator left-dimensions right-dimensions test))))
73
     (multiple-value-bind (operator result-dimensions)
74
                          (apply #'matrix-cross-join-operator
75
                                 (or (matrix-field-dimensions result-field)
76
                                     (join-result-dimensions left-dimensions right-dimensions))
77
                                 left-dimensions right-dimensions
78
                                 args)
79
        (with-input-fields (left-field right-field)
80
         (with-result-field (result-field :dimensions result-dimensions
81
                                          :sort-dimensions (solution-field-sort-dimensions right-field))
82
           (apply operator result-field left-field right-field
83
                  :test predicate
84
                  args))))))
85
 
86
 (defun matrix-natural-join (result-field left-field right-field &rest args &key start end test)
87
   "given a result field and the contributing left and right fields, compute the natural-join and
88
  emit it to the result field. the operation extracts the dimensions from the contributing fields,
89
  uses them to generate a generic key and natural-join maps, to identify the implementation operator,
90
  which is generated at first use and then cached.
91
  the result sort order is that of the largest arguemnt field."
92
   (declare (ignore start end)
93
            (dynamic-extent args))
94
 
95
   (let* ((left-dimensions (field-dimensions left-field))
96
          (right-dimensions (field-dimensions right-field))
97
          (predicate (when test (matrix-binary-predicate-operator left-dimensions right-dimensions test))))
98
     (multiple-value-bind (left-field right-field sort-order)
99
                          (reconcile-field-order left-field right-field)
100
       ;; then, retrieve or generate the combinatin-specific operator and apply it to the arguments
101
       (multiple-value-bind (operator result-dimensions)
102
                            (apply #'matrix-natural-join-operator
103
                                   (or (matrix-field-dimensions result-field)
104
                                       (join-result-dimensions left-dimensions right-dimensions))
105
                                   left-dimensions right-dimensions
106
                                   args)
107
         (with-input-fields (left-field right-field)
108
           (with-result-field (result-field :dimensions result-dimensions :sort-dimensions sort-order)
109
             (apply operator result-field left-field right-field
110
                    :test predicate
111
                    args)))))))
112
 
113
 (defun matrix-cross-join-operator (result-dimensions left-dimensions right-dimensions &key start end test)
114
   "find or generate a cross-join operator based on the position map pair for the contributing fields."
115
   
116
   (let* ((left-positions (loop for variable in left-dimensions
117
                                collect (position variable result-dimensions)))
118
          (right-positions (loop for variable in right-dimensions
119
                                collect (position variable result-dimensions))))
120
     (values (ensure-matrix-operator 'cross-join
121
                                     :result-column-count (length result-dimensions)
122
                                     :left-projection left-positions
123
                                     :right-projection right-positions
124
                                     :slice (not (null (or start end)))
125
                                     :test (not (null test)))
126
             result-dimensions)))
127
 
128
 
129
 (defmethod compute-matrix-operator-lambda ((operator (eql 'cross-join)) &key result-column-count left-projection right-projection slice test)
130
   "given position maps for the contributing fields, left and right, generate an operator which accepts the result, left
131
  and right fields, computes the cross-join based on the respective solution matrices, and emits it to the result field.
132
  observe null position indicators to suppress a column in the projection"
133
   
134
   (let* ((left-column-count (length left-projection))
135
          (right-column-count (length right-projection)))
136
     `(lambda (result-field left-field right-field ,@(when (or slice test) '(&key)) ,@(when slice '((start 0) end)) ,@(when test '(test)))
137
        ,(format nil "cross join operator for projection: ~s x ~s." left-projection right-projection)
138
        (declare (type matrix-field result-field left-field right-field)
139
                 (optimize ,@*field-optimization*)
140
                 ,@(when slice '((type fixnum start)))
141
                 ,@(when test '((type function test)))
142
                 )
143
 
144
        (unless (= (length (field-dimensions result-field)) ,result-column-count) ()
145
                (matrix-dimension-error :matrix result-field :expected-dimensions '(* ,result-column-count)))
146
        (unless (= (length (field-dimensions left-field)) ,left-column-count) ()
147
                (matrix-dimension-error :matrix left-field :expected-dimensions '(* ,left-column-count)))
148
        (unless (= (length (field-dimensions right-field)) ,right-column-count) ()
149
                (matrix-dimension-error :matrix right-field :expected-dimensions '(* ,right-column-count)))
150
        ,@(when test '((assert (typep test 'function) () "Invalid predicate: ~s." test)))
151
 
152
        (let ((%left-data (cffi::null-pointer))
153
              (%right-data (cffi::null-pointer))
154
              (%result-data (cffi::null-pointer))
155
              (right-row 0)
156
              (result-row 0)
157
              (left-row-count 0))
158
          (declare (foreign-type (foreign-array ,+matrix-element-type+ (* ,left-column-count)) %left-data)
159
                   (foreign-type (foreign-array ,+matrix-element-type+ (* ,right-column-count)) %right-data)
160
                   (foreign-type (foreign-array ,+matrix-element-type+ (* ,result-column-count)) %result-data)
161
                   (type sb-sys:system-area-pointer %left-data %right-data %result-data)
162
                   (type fixnum right-row result-row left-row-count)
163
                   )
164
          
165
          (setf (values %left-data left-row-count) (solution-field-materialize left-field))
166
          (setf (values %right-data right-row) (first-field-row right-field))
167
          (loop ,@(when slice `(with result-count fixnum = 0))
168
                while (and (not (cffi:null-pointer-p %right-data))
169
                           ,@(when slice '((or (null end) (< result-count (the fixnum end))))))
170
                do (progn (trace-matrix "~&cross-join.next-right ~@{~a ~}" :left-row-count left-row-count :right right-row :result result-row)
171
                          (loop for left-row from 0 below left-row-count
172
                                ,@(when slice '(while (or (null end) (< result-count (the fixnum end)))))
173
                                ,@(when test '(when (funcall test %left-data left-row %right-data right-row)))
174
                                do (,@(if slice
175
                                        '(when (> (incf result-count) start))
176
                                        '(progn))
177
                                    (setf (values %result-data result-row) (new-field-row result-field))
178
                                    (trace-matrix "~&cross-join.next-left ~@{~a ~}" :next-result :left left-row :right right-row :result result-row)
179
                                    (combine-foreign-solutions (%result-data result-row) (%left-data left-row) (%right-data right-row)
180
                                                               ',left-projection ',right-projection)))
181
                          (trace-matrix "~&cross-join.advance right")
182
                          (setf (values %right-data right-row) (next-field-row right-field))))
183
          result-field))))
184
 
185
 ;;; (spocq-compile (compute-matrix-operator-lambda 'cross-join :left-projection '(1 3 5) :right-projection '(2 4 6 7)))
186
 ;;; (spocq-compile (compute-matrix-operator-lambda 'cross-join :left-projection '(1 3 5) :right-projection '(2 4 6 7) :slice t))
187
 
188
 
189
 (defun matrix-natural-join-operator (result-dimensions left-dimensions right-dimensions &key
190
                                                        start end test)
191
   "find or generate a natural-join operator based on the position map pair for the contributing fields.
192
    nb. nil removal to allow for constants which appear in immediate results of pattern matches."
193
 
194
   (let* ((left-projection (loop for variable in left-dimensions
195
                                 collect (position variable result-dimensions)))
196
          (right-projection (loop for variable in right-dimensions
197
                                  collect (position variable result-dimensions)))
198
          (key-dimensions (join-key-dimensions left-dimensions right-dimensions))
199
          (left-key (loop for variable in key-dimensions
200
                          collect (when variable
201
                                    (or (position variable left-dimensions)
202
                                        (error "key dimension not present in left field: ~s, ~s" variable left-dimensions)))))
203
          (right-key (loop for variable in key-dimensions
204
                           collect (when variable
205
                                     (or (position variable right-dimensions)
206
                                         (error "key dimension not present in right field: ~s, ~s" variable right-dimensions))))))
207
  
208
     (values (ensure-matrix-operator 'natural-join
209
                                     :result-column-count (length result-dimensions)
210
                                     :left-projection left-projection :right-projection right-projection
211
                                     :left-key left-key :right-key right-key
212
                                     :slice (not (null (or start end)))
213
                                     :test (not (null test)))
214
             result-dimensions
215
             key-dimensions)))
216
 
217
 
218
 
219
 ;;; (compile nil (compute-matrix-natural-join-lambda '(1 3 5) '(1 2 4 5) '(1 3) '(1 4)))
220
 
221
 (defmethod compute-matrix-operator-lambda ((operator (eql 'natural-join)) &key
222
                                            result-column-count left-projection right-projection left-key right-key slice test)
223
   "compute an operator which, given two field matrices which share key fields, peforms
224
  a natural merge join of the two into another, given result field matrix. resize the result
225
  as required."
226
   (let* ((left-column-count (length left-projection))
227
          (right-column-count (length right-projection)))
228
     `(lambda (result-field left-field right-field ,@(when (or slice test) '(&key)) ,@(when slice '((start 0) end)) ,@(when test '(test)))
229
        ,(format nil "natural join operator for projection: ~s x ~s keys: ~s x ~s." left-projection right-projection left-key right-key)
230
        (declare (type matrix-field result-field left-field right-field)
231
                 (optimize ,@*field-optimization*)
232
                 ,@(when slice '((type fixnum start)))
233
                 ,@(when test '((type function test)))
234
                 )
235
 
236
        (unless (= (length (field-dimensions result-field)) ,result-column-count) ()
237
                (matrix-dimension-error :matrix result-field :expected-dimensions '(* ,result-column-count)))
238
        (unless (= (length (field-dimensions left-field)) ,left-column-count) ()
239
                (matrix-dimension-error :matrix left-field :expected-dimensions '(* ,left-column-count)))
240
        (unless (= (length (field-dimensions right-field)) ,right-column-count) ()
241
                (matrix-dimension-error :matrix right-field :expected-dimensions '(* ,right-column-count)))
242
        ,@(when test '((assert (typep test 'function) () "Invalid predicate: ~s." test)))
243
 
244
        (let* ((%left-data (cffi:null-pointer))
245
               (%right-data (cffi:null-pointer))
246
               (%result-data (cffi::null-pointer))
247
               (left-row 0)
248
               (right-row 0)
249
               (result-row -1))
250
          (declare (foreign-type (foreign-array ,+matrix-element-type+ (* ,left-column-count)) %left-data)
251
                   (foreign-type (foreign-array ,+matrix-element-type+ (* ,right-column-count)) %right-data)
252
                   (foreign-type (foreign-array ,+matrix-element-type+ (* ,result-column-count)) %result-data)
253
                   (type sb-sys:system-area-pointer %left-data %right-data %result-data)
254
                   (type fixnum left-row right-row result-row))
255
 
256
          ;; iterate over fields to locate and cross-join matched segments until either side is exhausted,
257
          ;; at which point no further combination is possible
258
          (setf (values %left-data left-row) (first-field-row left-field))
259
          (setf (values %right-data right-row) (first-field-row right-field))
260
          (flet ((extend-cache (%cache row-count)
261
                   (when (and *solution-count-limit* (> row-count *solution-count-limit*))
262
                     (log-warn "sum: terminated @~a cached solutions." row-count)
263
                     (terminate-task *query*))
264
                   (rdfcache:matrix-append-rows %cache (- row-count (rdfcache:matrix-row-count %cache)))
265
                   (rdfcache:matrix-data-pointer %cache)))
266
            (let* ((cache-row-count 32)
267
                   (%cache (rdfcache:make-matrix 32 ,left-column-count))
268
                   (%cache-data (rdfcache:matrix-data-pointer %cache)))
269
              (declare (foreign-type (foreign-array ,+matrix-element-type+ (* ,left-column-count)) %cache-data)
270
                       (type cffi:foreign-pointer %cache-data))
271
              (unwind-protect
272
                (loop ,@(when slice `(with result-count fixnum = 0 until (and end (>= result-count (the fixnum end)))))
273
                      do (trace-matrix "~&natural-join.loop ~@{~s ~}" :left-data %left-data :right-data %right-data :left left-row :right right-row :result result-row)
274
                      until (or (cffi:null-pointer-p %left-data)
275
                                (cffi:null-pointer-p %right-data))
276
                      do (ecase (compare-foreign-solutions (%left-data left-row) (%right-data right-row) ',left-key ',right-key)
277
                           (1 
278
                            (trace-matrix "~&natural-join.advance-right")
279
                            (setf (values %right-data right-row) (next-field-row right-field)))
280
                           (-1
281
                            (trace-matrix "~&natural-join.advance-left")
282
                            (setf (values %left-data left-row) (next-field-row left-field)))
283
                           (0 
284
                            (trace-matrix "~&natural-join.count-segment")
285
                            ;; keys are equal, determine the left side segment length and cross join within it against streamed right-side solutions
286
                            ;; the iteration requires, that the left segment be cached, in order that it be possible to repeat iteration over solution segments.
287
                            ;; the right may be streamed, as each solution is examined once only.
288
                            ;;
289
                            ;; for each segment, treminate when either the keys differ or the respective field is exhausted.
290
                            ;; in this regard it suffices that either is complete, as no futher combination is then possible.
291
                            (loop with left-segment-count = (loop for segment-index from 0
292
                                                                  do (progn (when (>= segment-index cache-row-count)
293
                                                                              (setf %cache-data (extend-cache %cache (incf cache-row-count cache-row-count))))
294
                                                                            (trace-matrix "~&natural-join.next-to-cache  ~@{~a ~}"
295
                                                                                         :cache-data %cache-data :segment-index segment-index
296
                                                                                         :%left-data %left-data :left-row left-row)
297
                                                                            (move-foreign-solution (%cache-data segment-index) (%left-data left-row)))
298
                                                                  until (or (cffi:null-pointer-p (setf (values %left-data left-row) (next-field-row left-field)))
299
                                                                            (not (zerop (compare-foreign-solutions (%cache-data 0) (%left-data left-row)
300
                                                                                                                   ',left-key ',left-key))))
301
                                                                  finally (return (1+ segment-index)))
302
                                  do (progn (trace-matrix "~&natural-join.segment-cross ~@{~a ~}" :left left-row :right right-row :count left-segment-count)
303
                                            (loop for left-segment-row from 0 below left-segment-count
304
                                                  ;; iterate over the materialized left sub-field for each right solution and
305
                                                  ;; emit the combined solution. terminate the pass, when either the left solution
306
                                                  ;; no longer matches or the entire left field is exhausted
307
                                                  ,@(when test '(when (funcall test %cache-data left-segment-row %right-data right-row)))
308
                                                  ,@(when slice '(while (or (null end) (< result-count (the fixnum end)))))
309
                                                  do (,@(if slice
310
                                                          '(when (> (incf result-count) start))
311
                                                          '(progn))
312
                                                      (setf (values %result-data result-row) (new-field-row result-field))
313
                                                      (trace-matrix "~&natural-join.next-result ~@{~a ~}" :left left-segment-row :right right-row :result result-row)
314
                                                      (combine-foreign-solutions (%result-data result-row) (%cache-data left-segment-row) (%right-data right-row)
315
                                                                                 ',left-projection ',right-projection))))
316
                                  while (progn (trace-matrix "~&natural-join.segment-next-right-in-segment")
317
                                               (and (not (cffi:null-pointer-p (setf (values %right-data right-row) (next-field-row right-field))))
318
                                                    ;; if the right sub-field is exhausted, terminate the cross-join and leave the
319
                                                    ;; left and right state at the 'next' solutions, otherwise reset the left state to the segment start
320
                                                    (progn (trace-matrix "~&natural-join.next-right ~@{~a ~}" :left-segment-count left-segment-count :left left-row :right right-row)
321
                                                           (zerop (compare-foreign-solutions (%cache-data 0) (%right-data right-row) ',left-key ',right-key)))))))))
322
                (rdfcache:matrix-release %cache))))
323
          result-field))))
324
 
325
 ;;; (spocq-compile (compute-matrix-operator-lambda 'natural-join :left-projection '(1 3 5) :right-projection '(1 2 4 5) :left-key '(1 3) :right-key '(1 4)))
326
 ;;; (spocq-compile (compute-matrix-operator-lambda 'natural-join :left-projection '(1 3 5) :right-projection '(1 2 4 5) :left-key '(1 3) :right-key '(1 4) :slice t))
327