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

KindCoveredAll%
expression0267 0.0
branch018 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 "This file defines the MINUS operator for the 'org.datagraph.spocq' RDF engine."
6
 
7
  (copyright
8
   "Copyright 2011 [dataraph inc.](mailto:info@datagraph.org) All Rights Reserved."))
9
 
10
 
11
 (defmacro spocq.a:|minus| (solution-field1 solution-field2 &rest args &key count end offset start)
12
   "( ( solutionField solutionField ) solutionField )
13
 A MINUS form combines two solution fields to produce a result field which
14
 contains all solutions from the first field for which no compatible solution is
15
 present in the second field."
16
 
17
   (declare (ignore count end offset start))
18
   (apply #'macroexpand-minus solution-field1 solution-field2 args))
19
 
20
 
21
 (defun macroexpand-minus (solution-field1 solution-field2 &rest args)
22
   ;; no transparency is required
23
   (setf args (apply #'canonicalize-algebra-arguments args))
24
   `(spocq.e::minus ,solution-field1 ,solution-field2 ,@args))
25
 
26
 
27
 (defgeneric spocq.e::minus (solution-field1 solution-field2 &key end start)
28
   (:documentation "MINUS computes the sub-bag of from the first solution field for which
29
  each member has no counterpart in the second solution field. This differs from DIFF, in that
30
  there is no additional predicate.")
31
 
32
   (:method :before ((base-field t) (offset-field agp) &key end start)
33
     (assert-argument-types process-minus
34
     (start (or null (integer 0)))
35
     (end (or null (integer 0))))
36
     (incf-stat *algebra-operations*)
37
     (trace-algebra spocq.e::minus base-field offset-field
38
                    :start start :end end))
39
 
40
   (:method ((field1 solution-generator) (field2 solution-generator) &rest args)
41
     (declare (dynamic-extent args))
42
     (apply 'spocq.e:stream-minus field1 field2
43
            args)))
44
 
45
 
46
 (defun spocq.e:stream-minus (base-field-generator offset-field-generator &rest args &key end start)
47
   (if (solution-generator-dimensions offset-field-generator)
48
       (let* ((base-dimensions (solution-generator-dimensions base-field-generator))
49
              (result-channel (make-channel :name (list 'spocq.a:|slice| (task-id *query*))
50
                                            :dimensions base-dimensions
51
                                            :size (effective-channel-size :start start :end end)
52
                                            :page-length (effective-page-length :start start :end end))))
53
                                       
54
         (labels ((run-minus-thread (result-channel base-field-generator offset-field-generator)
55
                    (let* ((base-dimensions (solution-generator-dimensions base-field-generator))
56
                           (offset-dimensions (solution-generator-dimensions offset-field-generator))
57
                           (base-channel (solution-generator-channel base-field-generator))
58
                           (offset-channel (solution-generator-channel offset-field-generator))
59
                           (base-expression (solution-generator-expression base-field-generator))
60
                           (offset-expression (solution-generator-expression offset-field-generator))
61
                           (*thread-operations* (cons (list* 'spocq.a:|minus| (task-id *task*)
62
                                                             base-dimensions offset-dimensions args)
63
                                                      *thread-operations*)))
64
                      (push 'spocq.a:|minus| (channel-name base-channel))
65
                      (query-run-in-thread *query* base-expression)
66
                      (query-run-in-thread *query* offset-expression)
67
                      (setf (channel-size result-channel) (min (channel-size base-channel)
68
                                                               (channel-size result-channel))
69
                            (channel-page-length result-channel) (min (channel-page-length base-channel)
70
                                                                      (channel-page-length result-channel)))
71
                      (apply #'process-minus result-channel base-channel offset-channel
72
                             base-dimensions
73
                             offset-dimensions
74
                             args)
75
                      'spocq.a:|minus|)))
76
           ;; return the binding function to the combination operator
77
           (make-solution-generator :operator 'spocq.a:|minus|
78
                                    :dimensions base-dimensions
79
                                    :expression (list #'run-minus-thread result-channel base-field-generator offset-field-generator)
80
                                    :channel result-channel
81
                                    :constituents (list base-field-generator offset-field-generator))))
82
       (apply #'spocq.e:stream-slice base-field-generator args)))
83
 
84
 
85
 (defmethod process-minus ((destination array-page-channel)
86
                           (base-source array-page-channel)
87
                           (offset-source array-page-channel)
88
                           base-dimensions offset-dimensions
89
                           &key (start 0) end)
90
   (declare (type (or channel (function ((or null array)) t)) destination)
91
            (type (or channel (function () (or array null))) base-source offset-source))
92
 
93
   (multiple-value-bind (type join-dimensions base-cache-operator offset-cache-operator collector)
94
                        (compute-minus-operators base-dimensions offset-dimensions)
95
     (declare (ignore join-dimensions))
96
     (ecase type
97
       ;; w/o shared dimensions all solutions are compatible - the result is an empty field
98
       (:cross (complete-field destination))
99
       (:natural
100
        (let* ((result-page-width (channel-page-width destination))
101
               (result-page-length (channel-page-length destination))
102
               (result-page nil)
103
               (result-index result-page-length)
104
               (offset-cache (make-term-id-cache :single-thread t))
105
               (result-count 0)
106
               (solution-count 0))
107
          (declare (type (function (array fixnum array fixnum) t) collector)
108
                   (type (function (array fixnum hash-table) t) base-cache-operator offset-cache-operator))
109
          (assert (= (length base-dimensions) result-page-width) ()
110
               "Channel and operation dimensions do not match: ~a: ~a." destination base-dimensions)
111
          (labels ((base-processor (base-page)
112
                     (dotimes (base-index (array-dimension base-page 0))
113
                       (unless (funcall base-cache-operator base-page base-index offset-cache)
114
                         (collect-solution base-page base-index))))
115
                   (offset-processor (offset-page)
116
                     (dotimes (offset-index (array-dimension offset-page 0))
117
                       (funcall offset-cache-operator offset-page offset-index offset-cache)))
118
                   (collect-solution (base-page base-index)
119
                     (when (> (incf result-count) start)
120
                       (next-solution-location)
121
                       (funcall collector result-page result-index base-page base-index)
122
                       (when (and end (>= result-count end)) (complete-solutions))))
123
                   (next-solution-location ()
124
                     ;; return a page (possible newly created) and the next free location in that page
125
                     (when (>= (incf result-index) result-page-length)
126
                       (when result-page (put-page result-page))
127
                       (setf result-page (new-field-page destination result-page-length result-page-width)
128
                             result-index 0)))
129
                   (complete-solutions ()
130
                     (when result-page
131
                       (let ((page-result-count (1+ result-index)))
132
                         (when (< page-result-count result-page-length)
133
                           (setf result-page
134
                                 (adjust-page result-page (list page-result-count result-page-width)))))
135
                       (put-page result-page))
136
                     (put-page nil)
137
                     (incf-stat *solutions-processed* solution-count)
138
                     (incf-stat *solutions-constructed* result-count)
139
                     (return-from process-minus (values solution-count result-count)))
140
                (put-page (page)
141
                  (trace-data process-minus destination base-dimensions (term-value-field page))
142
                  (if page
143
                    (put-field-page destination page)
144
                    (complete-field destination))))
145
            (unless (and (plusp result-page-length) (or (null end) (> end start))) (complete-solutions))
146
            (do-pages (solutions offset-source)
147
              (check-query-status *query*)
148
              (incf solution-count (array-dimension solutions 0))
149
              (offset-processor (copy-page solutions)))
150
            (do-pages (solutions base-source)
151
              (check-query-status *query*)
152
              (incf solution-count (array-dimension solutions 0))
153
              (base-processor solutions))
154
            (complete-solutions)))))))
155
 
156
 
157
 (defun compute-minus-operators (base-dimensions offset-dimensions)
158
   (let ((result-dimensions (union-dimensions base-dimensions offset-dimensions)))
159
     (if (intersection base-dimensions offset-dimensions)
160
       (values :natural result-dimensions
161
               (compute-read-cache-op base-dimensions offset-dimensions)
162
               (compute-write-cache-op offset-dimensions base-dimensions)
163
               (compute-unary-collector base-dimensions base-dimensions))
164
       (values :cross result-dimensions))))