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

KindCoveredAll%
expression0158 0.0
branch06 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 sum operations for matrix fields"
6
   "This file implementes merge sums based on matrix fields.
7
  Matching segments are cross joined, while both unmatched left and right solutions are emitted with null extension.")
8
 
9
 ;;; (load (compile-file "/development/source/library/org/datagraph/spocq/src/algebra/matrix-operators/sum.lisp"))
10
 
11
 
12
 (defgeneric matrix-sum (result-field left-field right-field &rest arguments &key start end)
13
   (:documentation
14
   "given a result field and the contributing left and right fields, compute the natural-sum and
15
      emit it to the result field. ")
16
   
17
   (:method :before (result-field left-field right-field &rest rest)
18
            (declare (dynamic-extent rest))
19
            (trace-algebra matrix-sum :left-field left-field :right-field right-field :rest rest))
20
   
21
   (:method ((result-field null) left-field right-field &rest args)
22
     (declare (dynamic-extent args))
23
     (complete-field-data (apply #'matrix-sum (make-matrix-field) left-field right-field args)))
24
   
25
   (:method ((result-field matrix-field) left-field right-field &rest args)
26
     (declare (dynamic-extent args))
27
     ;; if the fields share dimensions, proceed with the sum, otherwise the result is the union
28
     (if (intersection (solution-field-dimensions left-field) (solution-field-dimensions right-field))
29
       (apply #'matrix-natural-sum result-field left-field right-field args)
30
       (let ((operator (apply #'matrix-union-operator
31
                              (solution-field-dimensions result-field)
32
                              (solution-field-dimensions left-field)
33
                              (solution-field-dimensions right-field)
34
                              args)))
35
         (apply operator result-field left-field right-field args)))))
36
 
37
 
38
 
39
          
40
 (defun matrix-natural-sum (result-field left-field right-field &rest args &key start end)
41
   "given a result field and the contributing left and right fields, compute the natural-sum and
42
  emit it to the result field. the operation extracts the dimensions from the contributing fields,
43
  uses them to generate a generic key and natural-sum map, to identify the implementation operator,
44
  which is generated at first use and then cached.
45
  the result solutions comprise the cross-join of any matching segment unioned with those left or
46
  right solutions for which no match was present.
47
  the result sort order is that of the largest argument field."
48
   (declare (ignore start end))
49
   (incf-stat *algebra-operations*)
50
   
51
   (let ((left-dimensions (solution-field-dimensions left-field))
52
         (right-dimensions (solution-field-dimensions right-field)))
53
     (multiple-value-bind (left-field right-field sort-order)
54
                          (reconcile-field-order left-field right-field)
55
       ;; then, retrieve or generate the combination-specific operator and apply it to the arguments
56
       (multiple-value-bind (operator result-dimensions key-dimensions)
57
                            (apply #'matrix-natural-sum-operator
58
                                   (or (result-field-dimensions result-field)
59
                                       (join-result-dimensions left-dimensions right-dimensions))
60
                                   left-dimensions right-dimensions
61
                                   args)
62
         (declare (ignore key-dimensions))         ; already generated and used, above
63
         (with-input-fields (left-field right-field)
64
           (with-result-field (result-field :dimensions result-dimensions :sort-dimensions sort-order)
65
             (apply operator result-field left-field right-field
66
                    args)))
67
         (values result-field
68
                 (+ (solution-field-length left-field) (solution-field-length right-field))
69
                 (solution-field-length result-field))))))
70
             
71
 
72
 (defun matrix-natural-sum-operator (result-dimensions left-dimensions right-dimensions &key start end)
73
   "find or generate a natural-sum operator based on the position map pair for the contributing fields.
74
    nb. nil removal to allow for constants which appear in immediate results of pattern matches."
75
 
76
   (let* ((left-projection (loop for variable in left-dimensions
77
                                 collect (when variable
78
                                           (or (position variable result-dimensions)
79
                                               (error "dimension not present in result: ~s, ~s" variable result-dimensions)))))
80
          (right-projection (loop for variable in right-dimensions
81
                                  collect (when variable
82
                                            (or (position variable result-dimensions)
83
                                                (error "dimension not present in result: ~s, ~s" variable result-dimensions)))))
84
          (key-dimensions (join-key-dimensions left-dimensions right-dimensions))
85
          (left-key (loop for variable in key-dimensions
86
                          collect (or (position variable left-dimensions)
87
                                      (error "key dimension not present in left field: ~s, ~s" variable left-dimensions))))
88
          (right-key (loop for variable in key-dimensions
89
                           collect (or (position variable right-dimensions)
90
                                       (error "key dimension not present in right field: ~s, ~s" variable right-dimensions)))))
91
  
92
     (values (ensure-matrix-operator 'natural-sum
93
                                     :result-column-count (length result-dimensions)
94
                                     :left-projection left-projection :right-projection right-projection
95
                                     :left-key left-key :right-key right-key
96
                                     :slice (not (null (or start end))))
97
             result-dimensions
98
             key-dimensions)))
99
 
100
 
101
 
102
 ;;; (compile nil (compute-matrix-natural-sum-lambda '(1 3 5) '(1 2 4 5) '(1 3) '(1 4)))
103
 
104
 (defmethod compute-matrix-operator-lambda ((operator (eql 'natural-sum)) &key
105
                                            result-column-count left-projection right-projection left-key right-key slice)
106
   "compute an operator which, given two field matrices which share key fields, peforms
107
  a natural merge sum of the two into another, given result field matrix. resize the result
108
  as required."
109
   (let* ((left-column-count (length left-projection))
110
          (right-column-count (length right-projection)))
111
     `(lambda (result-field left-field right-field ,@(when slice '(&key (start 0) end)))
112
        ,(format nil "natural sum operator for projection: ~s x ~s keys: ~s x ~s." left-projection right-projection left-key right-key)
113
        (declare (type matrix-field result-field left-field right-field)
114
                 (optimize ,@*field-optimization*)
115
                 ,@(when slice '((type fixnum start)))
116
                 )
117
 
118
        (unless (= (length (solution-field-dimensions result-field)) ,result-column-count) ()
119
                (matrix-dimension-error :matrix result-field :expected-dimensions '(* ,result-column-count)))
120
        (unless (= (length (solution-field-dimensions left-field)) ,left-column-count) ()
121
                (matrix-dimension-error :matrix left-field :expected-dimensions '(* ,left-column-count)))
122
        (unless (= (length (solution-field-dimensions right-field)) ,right-column-count) ()
123
                (matrix-dimension-error :matrix right-field :expected-dimensions '(* ,right-column-count)))
124
        (incf-stat *algebra-operations*)
125
 
126
        (let* ((%left-data (cffi:null-pointer))
127
               (%right-data (cffi:null-pointer))
128
               (%result-data (cffi::null-pointer))
129
               (left-row 0)
130
               (right-row 0)
131
               (left-row-count 0)
132
               (result-row -1))
133
          (declare (foreign-type (foreign-array ,+matrix-element-type+ (* ,left-column-count)) %left-data)
134
                   (foreign-type (foreign-array ,+matrix-element-type+ (* ,right-column-count)) %right-data)
135
                   (foreign-type (foreign-array ,+matrix-element-type+ (* ,result-column-count)) %result-data)
136
                   (type sb-sys:system-area-pointer %left-data %right-data %result-data)
137
                   (type fixnum left-row right-row result-row))
138
          (setf (values %left-data left-row-count) (solution-field-materialize left-field))
139
          (setf (values %right-data right-row) (first-field-row right-field))
140
 
141
          ;; cross-join matched segments until either side is exhausted, at which point no further combination is possible
142
          ;; the left side is materialized, given which it is processed iteratively, while
143
          ;; the right side is processed as a stream
144
          (flet ((emit-base ()
145
                   (trace-matrix "~&sum.emit-base")
146
                   (,@(if slice
147
                        '(when (> (incf result-count) start))
148
                        '(progn))
149
                    (setf (values %result-data result-row) (new-field-row result-field))
150
                    (trace-matrix "~&sum.next-result ~@{~a ~}" :base left-row :offset right-row :result result-row)
151
                    (project-foreign-solution (%result-data result-row) (%left-data left-row) ',left-projection))
152
                   (trace-matrix "~&sum.advance-base")
153
                   (setf (values %left-data left-row) (next-field-row left-field)))
154
                 (emit-offset ()
155
                   (trace-matrix "~&sum.emit-offset")
156
                   (,@(if slice
157
                        '(when (> (incf result-count) start))
158
                        '(progn))
159
                    (setf (values %result-data result-row) (new-field-row result-field))
160
                    (trace-matrix "~&sum.next-result ~@{~a ~}" :base left-row :offset right-row :result result-row)
161
                    (project-foreign-solution (%result-data result-row) (%right-data right-row) ',right-projection))
162
                   (trace-matrix "~&sum.advance-offset")
163
                   (setf (values %right-data right-row) (next-field-row right-field)))
164
                 (extend-cache (%cache row-count)
165
                   (when (and *solution-count-limit* (> row-count *solution-count-limit*))
166
                     (log-warn "sum: terminated @~a cached solutions." row-count)
167
                     (terminate-task *query*))
168
                   (rdfcache:matrix-append-rows %cache (- row-count (rdfcache:matrix-row-count %cache)))
169
                   (rdfcache:matrix-data-pointer %cache)))
170
            (let* ((cache-row-count 32)
171
                   (%cache (rdfcache:make-matrix cache-row-count ,left-column-count))
172
                   (%cache-data (rdfcache:matrix-data-pointer %left-cache)))
173
              (declare (foreign-type (foreign-array ,+matrix-element-type+ (* ,left-column-count)) %cache-data)
174
                       (type cffi:foreign-pointer %cache-data))
175
              (unwind-protect
176
                (loop ,@(when slice `(with result-count fixnum = 0))
177
                  do (trace-matrix "~&natural-sum.loop ~@{~s ~}" :left-data %left-data :right-data %right-data :left left-row :right right-row :result result-row :left-row-count left-row-count)
178
                  while (and (< left-row left-row-count)
179
                             (not (cffi:null-pointer-p %right-data))
180
                             ,@(when slice '((or (null end) (< result-count (the fixnum end))))))
181
                  do (ecase (compare-foreign-solutions (%left-data left-row) (%right-data right-row) ',left-key ',right-key)
182
                       (1
183
                        ;; if nothing matches and the offset preceeds, emit the offset solution
184
                        (emit-offset))
185
                       (-1
186
                        ;; iff nothing matches, and the base preceeds, emit the base solution
187
                        (emit-base))
188
                       (0 
189
                        (trace-matrix "~&natural-sum.segment-count")
190
                        ;; keys are equal, cache the left side segment and cross join within it against streamed right-side solutions
191
                        ;;
192
                        ;; for each segment, terminate when either the keys differ or the respective field is exhausted.
193
                        ;; in this regard it suffices that either is complete, as no futher combination is then possible.
194
                        (setf (rdfcache::matrix-row-index %left-cache) 0)
195
                        (loop with left-segment-count = (loop for left-segment-index from 0
196
                                                              do (progn (when (>= left-segment-index cache-row-count)
197
                                                                          (setf %cache-data (extend-cache %cache (incf cache-row-count cache-row-count))))
198
                                                                        (move-foreign-solution (%cache-data left-segment-index) (%left-data left-row)))
199
                                                              until (or (cffi:null-pointer-p (setf (values %left-data left-row) (next-field-row left-field)))
200
                                                                        (not (zerop (compare-foreign-solutions (%cache-data 0) (%left-data left-row)
201
                                                                                                               ',left-key ',left-key))))
202
                                                              finally (return (1+ left-segment-index)))
203
                              do (progn (trace-matrix "~&natural-sum.segment-cross ~@{~a ~}" :left left-row :right right-row :count left-segment-count)
204
                                        (loop for left-segment-row from 0 below left-segment-count
205
                                              ,@(when slice '(while (or (null end) (< result-count (the fixnum end)))))
206
                                              ;; iterate over the materialized left sub-field for each right solution and
207
                                              ;; emit the combined solution. terminate the pass, when either the left solution
208
                                              ;; no longer matches or the entire left field is exhausted
209
                                              do (,@(if slice
210
                                                      '(when (> (incf result-count) start))
211
                                                      '(progn))
212
                                                  (setf (values %result-data result-row) (new-field-row result-field))
213
                                                  (trace-matrix "~&natural-sum.next-result ~@{~a ~}" :left left-segment-row :right right-row :result result-row)
214
                                                  (combine-foreign-solutions (%result-data result-row) (%cache-data left-segment-row) (%right-data right-row)
215
                                                                             ',left-projection ',right-projection))))
216
                              ;; if the right sub-field is exhausted, terminate the cross-join and leave the
217
                              ;; left and right state at the 'next' solutions, otherwise leave the left and right at the next solutions to test
218
                              while (progn (trace-matrix "~&natural-sum.segment-next-right-in-segment")
219
                                           (and (not (cffi:null-pointer-p (setf (values %right-data right-row) (next-field-row right-field))))
220
                                                (zerop (compare-foreign-solutions (%cache 0) (%right-data right-row) ',left-key ',right-key)))))))
221
                  finally (progn (trace-matrix "~&sum.extra ~@{~a ~}"  :left-data %left-data :right-data %right-data :left-row left-row :right-row right-row)
222
                                 (loop ,@(when slice '(until (and end (>= result-count (the fixnum end)))))
223
                                       until (cffi:null-pointer-p %left-data)
224
                                       do (emit-base))
225
                                 (loop ,@(when slice '(until (and end (>= result-count (the fixnum end)))))
226
                                       until (cffi:null-pointer-p %left-data)
227
                                       do (emit-offset))))
228
                (rdfcache:matrix-release %left-cache))))
229
          result-field))))
230
 
231
 ;;; (spocq-compile (compute-matrix-operator-lambda 'natural-sum :left-projection '(1 3 5) :right-projection '(1 2 4 5) :left-key '(1 3) :right-key '(1 4)))
232
 ;;; (spocq-compile (compute-matrix-operator-lambda 'natural-sum :left-projection '(1 3 5) :right-projection '(1 2 4 5) :left-key '(1 3) :right-key '(1 4) :slice t))