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

KindCoveredAll%
expression0215 0.0
branch012 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 "Define the matrix implementation of the leftjoin operator for the 'org.datagraph.spocq' RDF engine."
6
 
7
  (copyright
8
   "Copyright 2013 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved."))
9
 
10
 
11
 (defmethod spocq.e:leftjoin ((base-field matrix-field) (offset-field matrix-field) &rest arguments &key start end test)
12
   "Generate a leftjoin field to a result given base and offset fields, and an optional test and and slice (start, end) specifications.
13
  If the fields share dimensions, perform the natural left join and emit either all joined solutions which satisfy the predicate
14
  or failing a match or all predicate applications, emit just the base solution.
15
  If the fields share no dimensions, perform the same process for each base solution against the cross join.
16
  See perez.2009 for a more explicit definition than in the spec. The second clause in the union is not exists any u2, not exists such that not u2."
17
 
18
   (declare (dynamic-extent arguments))
19
 
20
     (let* ((left-dimensions (solution-field-dimensions base-field))
21
            (right-dimensions (solution-field-dimensions offset-field))
22
            (result-dimensions (join-result-dimensions left-dimensions right-dimensions))
23
            (length (- (or end (field-length base-field)) (or start 0)))
24
            (width (length result-dimensions))
25
            (%data (rdfcache:make-matrix length width))
26
            (predicate (when test (matrix-binary-predicate-operator (solution-field-dimensions base-field)
27
                                                                     (solution-field-dimensions offset-field)
28
                                                                     test))))
29
       (multiple-value-bind (base-field offset-field sort-order)
30
                            (reconcile-field-order base-field offset-field)
31
         (let* ((operator (apply (if (null sort-order) #'matrix-cross-leftjoin-operator #'matrix-natural-leftjoin-operator)
32
                                 result-dimensions
33
                                 (solution-field-dimensions base-field) (solution-field-dimensions offset-field)
34
                                 arguments))
35
                (result-field (clone-matrix-field base-field :data %data
36
                                                  :dimensions result-dimensions
37
                                                  :sort-dimensions sort-order)))
38
           (apply operator result-field base-field offset-field
39
                  ;; supersede the :test with the compiled form
40
                  :test predicate
41
                  arguments)
42
           (values result-field
43
                   (+ (solution-field-length base-field) (solution-field-length offset-field))
44
                   (solution-field-length result-field))))))
45
 
46
 (defmethod process-left-join ((result-field matrix-page-channel)
47
                               (base-field matrix-page-channel)
48
                               (offset-field matrix-page-channel)
49
                               result-dimensions base-dimensions optional-dimensions
50
                               bindings
51
                               &rest arguments
52
                               &key
53
                               test
54
                               (start 0)
55
                               (end nil))
56
   (declare (ignore start end))
57
   (multiple-value-bind (base-field offset-field sort-order)
58
                        (reconcile-field-order base-field offset-field)
59
     (let ((predicate (when test (matrix-binary-predicate-operator (solution-field-dimensions base-field)
60
                                                                   (solution-field-dimensions offset-field)
61
                                                                   test))))
62
       (let ((operator (apply (if (null sort-order) #'matrix-cross-leftjoin-operator #'matrix-natural-leftjoin-operator)
63
                              result-dimensions
64
                              base-dimensions optional-dimensions
65
                              arguments)))
66
         (apply operator result-field base-field offset-field
67
                ;; supersede the :test with the compiled form
68
                :test predicate
69
                arguments))
70
       (values (+ (solution-field-length base-field) (solution-field-length offset-field))
71
               (solution-field-length result-field)))))
72
 
73
 
74
 (defun matrix-cross-leftjoin-operator (result-dimensions base-dimensions offset-dimensions &key start end test)
75
   (declare (ignore test))
76
   (let ((base-projection (loop for dimension in base-dimensions
77
                                collect (position dimension result-dimensions)))
78
         (offset-projection (loop for dimension in offset-dimensions
79
                                  collect (position dimension result-dimensions))))
80
     (values (ensure-matrix-operator 'cross-leftjoin
81
                    :result-column-count (length result-dimensions)
82
                    :base-projection base-projection
83
                    :offset-projection offset-projection
84
                    :slice (not (null (or start end))))
85
             result-dimensions)))
86
 
87
 (defun matrix-natural-leftjoin-operator (result-dimensions base-dimensions offset-dimensions &key start end test)
88
   (declare (ignore test))
89
   (let* ((base-projection (loop for dimension in base-dimensions
90
                                 collect (position dimension result-dimensions)))
91
          (offset-projection (loop for dimension in offset-dimensions
92
                                   collect (position dimension result-dimensions)))
93
          (key-dimensions (join-key-dimensions base-dimensions offset-dimensions))
94
          (base-key (loop for dimension in key-dimensions
95
                          collect (or (position dimension base-dimensions)
96
                                      (error "key dimension not present in base field: ~s: ~s." dimension base-dimensions))))
97
          (offset-key (loop for dimension in key-dimensions
98
                            collect (or (position dimension offset-dimensions)
99
                                        (error "key dimension not present in offset field: ~s: ~s." dimension offset-dimensions)))))
100
     (values (ensure-matrix-operator 'natural-leftjoin
101
                    :result-column-count (length result-dimensions)
102
                    :base-projection base-projection
103
                    :offset-projection offset-projection
104
                    :base-key base-key
105
                    :offset-key offset-key
106
                    :slice (not (null (or start end))))
107
             result-dimensions)))
108
 
109
 
110
 (defmethod compute-matrix-operator-lambda ((operator (eql 'cross-leftjoin)) &key 
111
                                            base-projection offset-projection result-column-count slice)
112
   "compute an operator which, given two field matrices which share key fields, peforms
113
  a natural merge join of the two into another, given result field matrix. resize the result
114
  as required."
115
   (let* ((base-column-count (length base-projection))
116
          (offset-column-count (length offset-projection)))
117
     `(lambda (result-field base-field offset-field &key ,@(when slice '((start 0) end)) test)
118
        ,(format nil "cross leftjoin operator for projection: ~s . ~s x ~s." base-projection offset-projection result-column-count)
119
        (declare (type matrix-field result-field base-field offset-field)
120
                 (optimize ,@*field-optimization*)
121
                 ,@(when slice '((type fixnum start)))
122
                 )
123
 
124
        (unless (= (length (solution-field-dimensions result-field)) ,result-column-count) ()
125
                (matrix-dimension-error :matrix result-field :expected-dimensions '(* ,result-column-count)))
126
        (unless (= (length (solution-field-dimensions base-field)) ,base-column-count) ()
127
                (matrix-dimension-error :matrix base-field :expected-dimensions '(* ,base-column-count)))
128
        (unless (= (length (solution-field-dimensions offset-field)) ,offset-column-count) ()
129
                (matrix-dimension-error :matrix offset-field :expected-dimensions '(* ,offset-column-count)))
130
 
131
        (let* ((%base-data (cffi:null-pointer))
132
               (%offset-data (cffi:null-pointer))
133
               (%result-data (cffi::null-pointer))
134
               (base-row 0)
135
               (offset-row-count 0)
136
               (result-row 0))
137
          (declare (foreign-type (foreign-array ,+matrix-element-type+ (* ,base-column-count)) %base-data)
138
                   (foreign-type (foreign-array ,+matrix-element-type+ (* ,offset-column-count)) %offset-data)
139
                   (foreign-type (foreign-array ,+matrix-element-type+ (* ,result-column-count)) %result-data)
140
                   (type sb-sys:system-area-pointer %base-data %offset-data %result-data)
141
                   (type fixnum base-row offset-row-count result-row))
142
 
143
          (setf (values %base-data base-row) (first-field-row base-field))
144
          (setf (values %offset-data offset-row-count) (solution-field-materialize offset-field))         
145
          ;; apply predicate to the cross-join of each base solution with the entire offset field
146
          ;; iff the predicate always returns false, then emit the base solution
147
          ;; the offset side is materialized, given which it is processed iteratively, while
148
          ;; the base side is processed as a stream
149
          (cffi:with-foreign-pointer (%null-data ,(* result-column-count +matrix-element-size+))
150
            (declare (foreign-type (foreign-array ,+matrix-element-type+ (* ,offset-column-count)) %null-data))
151
            (loop for i below ,offset-column-count
152
                  do (setf (foreign-array-ref %null-data 0 i) +null-term-id+))
153
            (loop ,@(when slice `(with result-count fixnum = 0 until (and end (>= result-count (the fixnum end)))))
154
                  until (cffi:null-pointer-p %base-data)
155
                  do (trace-matrix "~&cross-leftjoin.loop ~@{~s ~}" :base-data %base-data :offset-data %offset-data :base base-row :offset-row-count offset-row-count :result result-row)
156
                  do (loop with emitted = nil
157
                           for offset-row fixnum from 0 below offset-row-count
158
                           when (or (null test) (funcall test %base-data base-row %offset-data offset-row))
159
                           do (progn (setf emitted t)
160
                                     (,@(if slice
161
                                          '(when (> (incf result-count) start))
162
                                          '(progn))
163
                                      (setf (values %result-data result-row) (new-field-row result-field))
164
                                      (trace-matrix "~&cross-leftjoin.next-result-cross ~@{~a ~}" :base-row base-row :offset-row offset-row :result-row result-row)
165
                                      (combine-foreign-solutions (%result-data result-row) (%base-data base-row) (%offset-data offset-row)
166
                                                                 ',base-projection ',offset-projection)))
167
                           
168
                           finally (unless emitted
169
                                     (,@(if slice
170
                                          '(when (> (incf result-count) start))
171
                                          '(progn))
172
                                      (setf (values %result-data result-row) (new-field-row result-field))
173
                                      (trace-matrix "~&corss-leftjoin.next-result-base ~@{~a ~}" :base-row base-row :offset-row offset-row :result-row result-row)
174
                                      (combine-foreign-solutions (%result-data result-row) (%base-data base-row) (%null-data 0)
175
                                                                 ',base-projection ',offset-projection))))
176
                  do (setf (values %base-data base-row) (next-field-row base-field))))
177
          result-field))))
178
 
179
 
180
 (defmethod compute-matrix-operator-lambda ((operator (eql 'natural-leftjoin)) &key 
181
                                            base-projection offset-projection result-column-count base-key offset-key slice)
182
   "compute an operator which, given two field matrices which share key fields, peforms
183
  a natural merge join of the two into another, given result field matrix. resize the result
184
  as required."
185
   (let* ((base-column-count (length base-projection))
186
          (offset-column-count (length offset-projection)))    
187
     `(lambda (result-field base-field offset-field &key ,@(when slice '((start 0) end)) test)
188
        ,(format nil "natural leftjoin operator for projection: ~s . ~s x ~s keys: ~s . ~s." base-projection offset-projection result-column-count base-key offset-key)
189
        (declare (type matrix-field result-field base-field offset-field)
190
                 ;; (optimize ,@*field-optimization*)
191
                 ,@(when slice '((type fixnum start)))
192
                 )
193
 
194
        (unless (= (length (solution-field-dimensions result-field)) ,result-column-count) ()
195
                (matrix-dimension-error :matrix result-field :expected-dimensions '(* ,result-column-count)))
196
        (unless (= (length (solution-field-dimensions base-field)) ,base-column-count) ()
197
                (matrix-dimension-error :matrix base-field :expected-dimensions '(* ,base-column-count)))
198
        (unless (= (length (solution-field-dimensions offset-field)) ,offset-column-count) ()
199
                (matrix-dimension-error :matrix offset-field :expected-dimensions '(* ,offset-column-count)))
200
        
201
        (let* ((%base-data (cffi:null-pointer))
202
               (%offset-data (cffi:null-pointer))
203
               (%result-data (cffi::null-pointer))
204
               (base-row 0)
205
               (offset-row 0)
206
               (result-row 0))
207
          (declare (foreign-type (foreign-array ,+matrix-element-type+ (* ,base-column-count)) %base-data)
208
                   (foreign-type (foreign-array ,+matrix-element-type+ (* ,offset-column-count)) %offset-data)
209
                   (foreign-type (foreign-array ,+matrix-element-type+ (* ,result-column-count)) %result-data)
210
                   (type sb-sys:system-area-pointer %base-data %offset-data %result-data)
211
                   (type fixnum base-row offset-row result-row))
212
          (setf (values %base-data base-row) (first-field-row base-field))
213
          (setf (values %offset-data offset-row) (first-field-row offset-field))
214
          
215
          ;; locate matched segments until either side is exhausted, at which point any remaining base solutions are emitted
216
          ;; emit any the base solution which matched no offset solution
217
          ;; apply predicate to the cross-join of each base solution with the entire offset field
218
          ;; iff the predicate always returns false, then emit the base solution
219
          (cffi:with-foreign-pointer (%null-data ,(* offset-column-count +matrix-element-size+))
220
            (declare (foreign-type (foreign-array ,+matrix-element-type+ (* ,offset-column-count)) %null-data))
221
            (loop for i below ,offset-column-count
222
                  do (setf (foreign-array-ref %null-data 0 i) +null-term-id+))
223
            (flet ((extend-cache (%cache row-count)
224
                     (when (and *solution-count-limit* (> row-count *solution-count-limit*))
225
                       (log-warn "sum: terminated @~a cached solutions." row-count)
226
                       (terminate-task *query*))
227
                     (rdfcache:matrix-append-rows %cache (- row-count (rdfcache:matrix-row-count %cache)))
228
                     (rdfcache:matrix-data-pointer %cache)))
229
              (let* ((cache-row-count 32)
230
                     (%cache (rdfcache:make-matrix 32 ,offset-column-count))
231
                     (%cache-data (rdfcache:matrix-data-pointer %cache)))
232
                (declare (foreign-type (foreign-array ,+matrix-element-type+ (* ,offset-column-count)) %cache-data)
233
                         (type cffi:foreign-pointer %cache-data))
234
                (unwind-protect
235
                  (loop ,@(when slice `(with result-count fixnum = 0 until (and end (>= result-count (the fixnum end)))))
236
                        until (or (cffi:null-pointer-p %offset-data)
237
                                  (cffi:null-pointer-p %base-data))
238
                        do (trace-matrix "~&natural-leftjoin.loop ~@{~s ~}" :base-data %base-data :offset-data %offset-data  :result-data %result-data :base-row base-row :offset-row offset-row :result-row result-row)
239
                        do (ecase (compare-foreign-solutions (%base-data base-row) (%offset-data offset-row) ',base-key ',offset-key)
240
                             (1
241
                              ;; if nothing matches and the offset preceeds, advance the offset field
242
                              (trace-matrix "~&natural-leftjoin.advance-offset")
243
                              (setf (values %offset-data offset-row) (next-field-row offset-field)))
244
                             (-1
245
                              ;; iff nothing matches, and the base preceeds, emit the solution
246
                              (trace-matrix "~&natural-leftjoin.emit-base")
247
                              (,@(if slice
248
                                   '(when (> (incf result-count) start))
249
                                   '(progn))
250
                               (setf (values %result-data result-row) (new-field-row result-field))
251
                               (trace-matrix "~&natural-join.next-result-base ~@{~a ~}" :base base-row :result result-row)
252
                               (combine-foreign-solutions (%result-data result-row) (%base-data base-row) (%null-data 0)
253
                                                          ',base-projection ',offset-projection))
254
                              (trace-matrix "~&natural-leftjoin.advance-base")
255
                              (setf (values %base-data base-row) (next-field-row base-field)))
256
                             (0 
257
                              (trace-matrix "~&natural-leftjoin.count-segment")
258
                              ;; iff there is a test and the test falls for all matches, then emit the base solution
259
                              ;; if there is no test or some pair matches, then emit just the matching joined solution
260
                              (loop with offset-segment-count = (loop for segment-index from 0
261
                                                                 do (progn (when (>= segment-index cache-row-count)
262
                                                                             (setf %cache-data (extend-cache %cache (incf cache-row-count cache-row-count))))
263
                                                                           (trace-matrix "~&natural-leftjoin.next-to-cache  ~@{~a ~}"
264
                                                                                         :cache-data %cache-data :segment-index segment-index
265
                                                                                         :offset-data %offset-data :offset-row offset-row)
266
                                                                           (move-foreign-solution (%cache-data segment-index) (%offset-data offset-row)))
267
                                                                 until (or (cffi:null-pointer-p (setf (values %offset-data offset-row) (next-field-row offset-field)))
268
                                                                           (not (zerop (compare-foreign-solutions (%cache-data 0) (%offset-data offset-row)
269
                                                                                                                  ',offset-key ',offset-key))))
270
                                                                 finally (return (1+ segment-index)))
271
                                    do (progn (trace-matrix "~&natural-leftjoin.segment-cross ~@{~a ~}" :base-row base-row :offset-row offset-row :segment-count offset-segment-count)
272
                                              (loop for offset-segment-row from 0 below offset-segment-count
273
                                                    ;; iterate over the materialized offset sub-field for each base solution, apply any predicate and
274
                                                    ;; emit satisfying combined solutions terminate the pass, when either the left solution
275
                                                    ;; no longer matches or the entire left field is exhausted
276
                                                    ;; if nothing was emitted, emit just the base solution
277
                                                    with emitted fixnum = 0
278
                                                    when (or (null test) (funcall test %base-data base-row %cache-data offset-segment-row))
279
                                                    do (progn (incf emitted)
280
                                                              (,@(if slice
281
                                                                   '(when (> (incf result-count) start))
282
                                                                   '(progn))
283
                                                               (setf (values %result-data result-row) (new-field-row result-field))
284
                                                               (trace-matrix "~&natural-jeftjoin.next-result-joined ~@{~a ~}" :base-row base-row :offset-segment-row offset-segment-row :result-row result-row)
285
                                                               (combine-foreign-solutions (%result-data result-row) (%base-data base-row) (%cache-data offset-segment-row)
286
                                                                                          ',base-projection ',offset-projection)))
287
                                                    finally (unless (plusp emitted)
288
                                                              (,@(if slice
289
                                                                   '(when (> (incf result-count) start))
290
                                                                   '(progn))
291
                                                               (setf (values %result-data result-row) (new-field-row result-field))
292
                                                               (trace-matrix "~&natural-join.next-result-base ~@{~a ~}" :base-row base-row :result-row result-row)
293
                                                               (combine-foreign-solutions (%result-data result-row) (%base-data base-row) (%null-data 0)
294
                                                                                          ',base-projection ',offset-projection)))))
295
                                    while (progn (trace-matrix "~&natural-leftjoin.segment-next-base-in-segment")
296
                                                 (and (not (cffi:null-pointer-p (setf (values %base-data base-row) (next-field-row base-field))))
297
                                                      ;; if the base sub-field is exhausted, terminate the cross-join and leave the
298
                                                      ;; base and offset state at the 'next' solutions, otherwise reset the offset state to the segment start
299
                                                      (progn (trace-matrix "~&natural-leftjoin.next-base ~@{~a ~}" :offset-segment-count offset-segment-count :base base-row :offset offset-row)
300
                                                             (zerop (compare-foreign-solutions (%base-data base-row) (%cache-data 0) ',base-key ',offset-key))))))))
301
                        ;;; emit remaining base solutions
302
                        finally (progn (trace-matrix "~&natural-leftjoin.extra-base ~@{~a ~}" :base base-row :offset -1 :result result-row)
303
                                       (loop ,@(when slice '(until (and end (>= result-count (the fixnum end)))))
304
                                             until (cffi:null-pointer-p %base-data)
305
                                             do (progn (,@(if slice
306
                                                            '(when (> (incf result-count) start))
307
                                                            '(progn))
308
                                                        (setf (values %result-data result-row) (new-field-row result-field))
309
                                                        (trace-matrix "~&natural-leftjoin.next-result.extra-base ~@{~a ~}" :base base-row :offset -1 :result result-row)
310
                                                        (combine-foreign-solutions (%result-data result-row) (%base-data base-row) (%null-data 0)
311
                                                                                   ',base-projection ',offset-projection))
312
                                                       (trace-matrix "~&natural-leftjoin.advance-base.extra-base")
313
                                                       (setf (values %base-data base-row) (next-field-row base-field))))))
314
                (rdfcache:matrix-release %cache)))))
315
          result-field))))