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

KindCoveredAll%
expression0209 0.0
branch014 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-variant of the DIFF 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:diff ((base-field matrix-field) (offset-field matrix-field) &rest arguments &key start end (test-not nil tn-s) (test nil t-s))
12
   "Generate a diff field to a result given a base field, offset field, and optional test and slice (start, end) specifications.
13
   If the fields share dimensions use them as a key to determine identity, otherwise emit only base solutions for which
14
   the predicate fails the entire crossjoin with the offset field."
15
 
16
   (declare (ignore start end)
17
            (dynamic-extent arguments))
18
   
19
     (let* ((base-dimensions (matrix-field-dimensions base-field))
20
            (length (- (or end (field-length base-field)) (or start 0))))
21
       (multiple-value-bind (base-field offset-field sort-order)
22
                            (reconcile-field-order base-field offset-field)
23
         (let ((predicate (cond (test-not (complement (coerce (matrix-binary-predicate-operator (solution-field-dimensions base-field)
24
                                                                                                (solution-field-dimensions offset-field)
25
                                                                                                test-not)
26
                                                              'function)))
27
                                (test (matrix-binary-predicate-operator (solution-field-dimensions base-field)
28
                                                                        (solution-field-dimensions offset-field)
29
                                                                        test)))))
30
           (when (or t-s tn-s)
31
             (setf arguments (copy-list arguments))
32
             (remf arguments :test)
33
             (remf arguments :test-not)
34
             (setf arguments (list* :test predicate arguments)))
35
           (let* ((%data (rdfcache:make-matrix length (field-width base-field)))
36
                  (result-dimensions (solution-field-dimensions base-field))
37
                  (result-field (clone-matrix-field base-field :data %data :sort-dimensions sort-order))
38
                  (operator (apply (if (null sort-order) #'matrix-cross-diff-operator #'matrix-natural-diff-operator)
39
                                   result-dimensions
40
                                   result-dimensions
41
                                   (solution-field-dimensions offset-field)
42
                                   arguments)))
43
             (apply operator result-field base-field offset-field
44
                    arguments)
45
             (values result-field
46
                     (+ (solution-field-length base-field) (solution-field-length offset-field))
47
                     (solution-field-length result-field)))))))
48
 
49
 (defmethod process-diff ((result-field matrix-page-channel)
50
                          (base-field matrix-page-channel)
51
                          (offset-field matrix-page-channel)
52
                          base-dimensions offset-dimensions
53
                          &rest arguments
54
                          &key test-not (test (when test-not (complement test-not))) (start 0) end)
55
   (let* ((sort-dimensions (field-sort-dimensions result-field))
56
          (operator (apply (if (null sort-dimensions) #'matrix-cross-diff-operator #'matrix-natural-diff-operator)
57
                           (field-dimensions result-field)
58
                           (field-dimensions base-field) (field-dimensions offset-field)
59
                           arguments)))
60
     (apply operator result-field base-field offset-field
61
            arguments)
62
     (values (channel-solution-count result-field)
63
             (+ (channel-solution-count base-field) (channel-solution-count offset-field)))))
64
 
65
 
66
 (defun matrix-cross-diff-operator (result-dimensions base-dimensions offset-dimensions &key start end test)
67
   (declare (ignore test))
68
   (let ((projection (loop for dimension in base-dimensions
69
                           collect (position dimension result-dimensions))))
70
     (values (ensure-matrix-operator 'cross-diff
71
                    :projection projection
72
                    :result-column-count (length result-dimensions)
73
                    :offset-column-count (length offset-dimensions)
74
                    :slice (not (null (or start end))))
75
             result-dimensions)))
76
 
77
 (defun matrix-natural-diff-operator (result-dimensions base-dimensions offset-dimensions &key start end test)
78
   (declare (ignore test))
79
   (let* ((projection (loop for dimension in base-dimensions
80
                            collect (position dimension result-dimensions)))
81
          (join-key (join-key-dimensions base-dimensions offset-dimensions))
82
          (base-key (loop for dimension in join-key
83
                          collect (or (position dimension base-dimensions)
84
                                      (error "key dimension not present in base field: ~s: ~s." dimension base-dimensions))))
85
          (offset-key (loop for dimension in join-key
86
                            collect (or (position dimension offset-dimensions)
87
                                        (error "key dimension not present in offset field: ~s: ~s." dimension offset-dimensions)))))
88
     (values (ensure-matrix-operator 'natural-diff
89
                                     :projection projection
90
                                     :result-column-count (length result-dimensions)
91
                                     :offset-column-count (length offset-dimensions)
92
                                     :base-key base-key
93
                                     :offset-key offset-key
94
                                     :slice (not (null (or start end))))
95
             result-dimensions)))
96
 
97
 
98
 (defmethod compute-matrix-operator-lambda ((operator (eql 'cross-diff)) &key 
99
                                            projection result-column-count offset-column-count slice)
100
   "compute an operator which, given two field matrices which share key fields, peforms
101
  a cross merge diff of the two into another, given result field matrix. resize the result
102
  as required."
103
   (let* ((base-column-count (length projection)))
104
          
105
     `(lambda (result-field base-field offset-field &key ,@(when slice '((start 0) end)) predicate)
106
        ,(format nil "cross diff operator for projection: ~s x ~s" projection result-column-count)
107
        (declare (type matrix-field result-field base-field offset-field)
108
                 (optimize ,@*field-optimization*)
109
                 ,@(when slice '((type fixnum start)))
110
                 )
111
        
112
        (unless (= (field-width result-field) ,result-column-count) ()
113
                (matrix-dimension-error :matrix result-field :expected-dimensions '(* ,result-column-count)))
114
        (unless (= (field-width base-field) ,base-column-count) ()
115
                (matrix-dimension-error :matrix base-field :expected-dimensions '(* ,base-column-count)))
116
        (unless (= (field-width offset-field) ,offset-column-count) ()
117
                (matrix-dimension-error :matrix offset-field :expected-dimensions '(* ,offset-column-count)))
118
        (let* ((%base-data (cffi:null-pointer))
119
               (%offset-data (cffi:null-pointer))
120
               (%result-data (cffi::null-pointer))
121
               (base-row 0)
122
               (offset-row-count 0)
123
               (result-row 0))
124
          (declare (foreign-type (foreign-array ,+matrix-element-type+ (* ,base-column-count)) %base-data)
125
                   (foreign-type (foreign-array ,+matrix-element-type+ (* ,offset-column-count)) %offset-data)
126
                   (foreign-type (foreign-array ,+matrix-element-type+ (* ,result-column-count)) %result-data)
127
                   (type sb-sys:system-area-pointer %base-data %offset-data %result-data)
128
                   (type fixnum base-row result-row))
129
          (setf (values %offset-data offset-row-count) (solution-field-materialize offset-field))
130
 
131
          ;; apply predicate to the cross-join of each base solution with the entire offset field
132
          ;; iff the predicate always returns true, then emit the base solution
133
          ;; the offset side is materialized, given which it is processed iteratively, while
134
          ;; the base side is processed as a stream
135
          (loop ,@(when slice `(with result-count fixnum = 0 until (and end (>= result-count (the fixnum end)))))
136
                until (cffi:null-pointer-p (setf (values %base-data base-row) (next-field-row base-field)))
137
                do (trace-matrix "~&cross-diff.loop ~@{~s ~}" :base-data %base-data :offse-data %offset-data :base base-row :offset-row-count offset-row-count :result result-row)
138
                do (loop for offset-row fixnum from 0 below offset-row-count
139
                         do (trace-matrix "~&cross-diff.cross ~@{~s ~}" :base-data %base-data :offse-data %offset-data :base base-row :offset-row offset-row :result result-row)
140
                         unless (or (null predicate) (funcall predicate %base-data base-row %offset-data offset-row))
141
                         do (return)
142
                         finally (,@(if slice
143
                                      '(when (> (incf result-count) start))
144
                                      '(progn))
145
                                      (setf (values %result-data result-row) (new-field-row result-field))
146
                                      (trace-matrix "~&cross-diff.next-result ~@{~a ~}" :base-row base-row :offset offset-row :result result-row)
147
                                      (project-foreign-solution (%result-data result-row) (%base-data base-row) ',projection)))
148
                )
149
          result-field))))
150
 
151
 (defmethod compute-matrix-operator-lambda ((operator (eql 'natural-diff)) &key 
152
                                            projection result-column-count offset-column-count base-key offset-key slice)
153
   "compute an operator which, given two field matrices which share key fields, peforms
154
  a natural merge diff of the two into another, given result field matrix. resize the result
155
  as required."
156
   (let* ((base-column-count (length projection)))
157
     
158
     `(lambda (result-field base-field offset-field &key ,@(when slice '((start 0) end)) test)
159
        ,(format nil "natural diff operator for projection: ~s x ~s keys: ~s x ~s." projection result-column-count base-key offset-key)
160
        (declare (type matrix-field result-field base-field offset-field)
161
                 ;; (optimize ,@*field-optimization*)
162
                 ,@(when slice '((type fixnum start)))
163
                 )
164
 
165
        (unless (= (field-width result-field) ,result-column-count) ()
166
                (matrix-dimension-error :matrix result-field :expected-dimensions '(* ,result-column-count)))
167
        (unless (= (field-width base-field) ,base-column-count) ()
168
                (matrix-dimension-error :matrix base-field :expected-dimensions '(* ,base-column-count)))
169
        (unless (= (field-width offset-field) ,offset-column-count) ()
170
                (matrix-dimension-error :matrix offset-field :expected-dimensions '(* ,offset-column-count)))
171
        (let* ((%base-data (cffi:null-pointer))
172
               (%offset-data (cffi:null-pointer))
173
               (%result-data (cffi::null-pointer))
174
               (base-row 0)
175
               (offset-row 0)
176
               (result-row 0))
177
          (declare (foreign-type (foreign-array ,+matrix-element-type+ (* ,base-column-count)) %base-data)
178
                   (foreign-type (foreign-array ,+matrix-element-type+ (* ,offset-column-count)) %offset-data)
179
                   (foreign-type (foreign-array ,+matrix-element-type+ (* ,result-column-count)) %result-data)
180
                   (type sb-sys:system-area-pointer %base-data %offset-data %result-data)
181
                   (type fixnum offset-segment-count)
182
                   (type fixnum base-row offset-row result-row))
183
          (setf (values %base-data base-row) (next-field-row base-field))
184
          (setf (values %offset-data offset-row) (next-field-row offset-field))
185
          
186
          ;;(print (list :base (rdfcache:matrix-to-list (matrix-field-solutions base-field))))
187
          ;;(print (list :offset (rdfcache:matrix-to-list (matrix-field-solutions offset-field))))
188
          ;; locate matched segments until either side is exhausted, at which point any remaining base solutions are emitted
189
          ;; apply the predicate test to the cross-join of each base solution with the entire offset field
190
          ;; iff the predicate always returns false, then emit the base solution
191
          ;; the offset side is materialized, given which it is processed iteratively, while
192
          ;; the base side is processed as a stream
193
          (flet ((extend-cache (%cache row-count)
194
                   (when (and *solution-count-limit* (> row-count *solution-count-limit*))
195
                     (log-warn "sum: terminated @~a cached solutions." row-count)
196
                     (terminate-task *query*))
197
                   (rdfcache:matrix-append-rows %cache (- row-count (rdfcache:matrix-row-count %cache)))
198
                   (rdfcache:matrix-data-pointer %cache)))
199
            (let* ((cache-row-count 32)
200
                   (%cache (when test (rdfcache:make-matrix 32 ,offset-column-count)))
201
                   (%cache-data (if %cache (rdfcache:matrix-data-pointer %cache) (cffi:null-pointer))))
202
              (declare (foreign-type (foreign-array ,+matrix-element-type+ (* ,offset-column-count)) %cache-data)
203
                       (type cffi:foreign-pointer %cache-data))
204
              (unwind-protect
205
                (loop ,@(when slice `(with result-count fixnum = 0 until (and end (>= result-count (the fixnum end)))))
206
                      until (or (cffi:null-pointer-p %offset-data)
207
                                (cffi:null-pointer-p %base-data))
208
                      do (trace-matrix "~&natural-diff.loop ~@{~s ~}" :base-data %base-data :offset-data %offset-data  :result-data %result-data :base base-row :offset offset-row :result result-row)
209
                      do (ecase (compare-foreign-solutions (%base-data base-row) (%offset-data offset-row) ',base-key ',offset-key)
210
                           (1
211
                            ;; if nothing matches and the offset preceeds, advance the offset field
212
                            (trace-matrix "natural-diff.advance-offset")
213
                            (setf (values %offset-data offset-row) (next-field-row offset-field)))
214
                           (-1
215
                            ;; iff nothing matches, and the base preceeds, emit the solution
216
                            (trace-matrix "~&natural-diff.emit-base")
217
                            (,@(if slice
218
                                 '(when (> (incf result-count) start))
219
                                 '(progn))
220
                             (setf (values %result-data result-row) (new-field-row result-field))
221
                             (trace-matrix "~&natural-diff.next-result ~@{~a ~}" :base base-row :offset offset-row :result result-row)
222
                             (project-foreign-solution (%result-data result-row) (%base-data base-row) ',projection))
223
                            (trace-matrix "~&natural-diff.advance-base")
224
                            (setf (values %base-data base-row) (next-field-row base-field)))
225
                           (0 
226
                            (trace-matrix "natural-diff.equal")
227
                            ;; iff there is a test, cache the offset segment in order to cross-test against it for each matching base solutions
228
                            ;; if the test falls for all matches, then emit the base solution
229
                            ;; if some pair matches, then suppress the respective base solution
230
                            ;; if there is no test, then suppress the solution immediately
231
                            (when test
232
                              (loop with offset-segment-count = (loop for segment-index from 0
233
                                                                      do (progn (when (>= segment-index cache-row-count)
234
                                                                                  (setf %cache-data (extend-cache %cache (incf cache-row-count cache-row-count))))
235
                                                                                (trace-matrix "~&next cache entry ~@{~s ~}" segment-index cache-row-count)
236
                                                                                (move-foreign-solution (%cache-data segment-index) (%offset-data offset-row)))
237
                                                                      until (or (cffi:null-pointer-p (setf (values %offset-data offset-row) (next-field-row offset-field)))
238
                                                                                (not (zerop (compare-foreign-solutions (%cache-data 0) (%offset-data offset-row)
239
                                                                                                                       ',offset-key ',offset-key))))
240
                                                                      finally (return (1+ segment-index)))
241
                                do (progn (trace-matrix "~&natural-diff.test ~@{~a ~}" :offset-segment-count offset-segment-count)
242
                                          (loop for offset-segment-row from 0 below offset-segment-count
243
                                                unless (funcall test %base-data base-row %cache-data offset-segment-row)
244
                                                do (return)      ; suppress if some matched pair does not satisfy the predicate
245
                                                finally (,@(if slice
246
                                                             '(when (> (incf result-count) start))
247
                                                             '(progn))
248
                                                         (setf (values %result-data result-row) (new-field-row result-field))
249
                                                         (trace-matrix "~&natural-diff.next-result-condition ~@{~a ~}" :base base-row :offset offset-row :segment offset-segment-count :result result-row)
250
                                                         (project-foreign-solution (%result-data result-row) (%base-data base-row) ',projection))))
251
                                while (progn (trace-matrix "~&natural-diff.segment-next-base-in-segment")
252
                                             (and (not (cffi:null-pointer-p (setf (values %base-data base-row) (next-field-row base-field))))
253
                                                  (progn (trace-matrix "~&natural-diff.next-base ~@{~a ~}"  :offset-segment-count offset-segment-count :base base-row :offset offset-row)
254
                                                         (zerop (compare-foreign-solutions (%base-data base-row) (%cache-data 0) ',base-key ',offset-key)))))))))
255
 
256
                      ;;; emit remaining base solutions
257
                      finally (progn (trace-matrix "~&natural-diff.extra-base ~@{~a ~}" :base base-row :offset -1 :result result-row)
258
                                     (loop ,@(when slice '(until (and end (>= result-count (the fixnum end)))))
259
                                           until (cffi:null-pointer-p %base-data)
260
                                           do (progn (,@(if slice
261
                                                          '(when (> (incf result-count) start))
262
                                                          '(progn))
263
                                                      (setf (values %result-data result-row) (new-field-row result-field))
264
                                                      (trace-matrix "~&natural-diff.next-result.extra-base ~@{~a ~}" :base base-row :offset -1 :result result-row)
265
                                                      (project-foreign-solution (%result-data result-row) (%base-data base-row) ',projection))
266
                                                     (trace-matrix "~&natural-diff.advance-base.extra-base")
267
                                                     (setf (values %base-data base-row) (next-field-row base-field))))))
268
                (when %cache (rdfcache:matrix-release %cache)))))
269
          result-field))))