Coverage report: /development/source/library/org/datagraph/spocq-shard/src/core/compare.lisp

KindCoveredAll%
expression0180 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 "solution field isomorphism test"
6
   "In order to compare to fields, one must not only test equivalence of
7
  literal and uri terms, one must also recognize and identify analogous blank
8
  node. As they are just intermediates between other values, their individual
9
  identity does not signify difference, so long as they relations are the same.
10
  The problem is to determine if there is some one-to-one map between nodes
11
  such that the relation equivalence applied.
12
  
13
  This test is performed on a solution field by recording all literal terms
14
  and expressing each blank in terms of the the signature of each position
15
  it occupies in the graph. these are sorted into a canonical order, become
16
  the nodes identity and used to rewrite the graph by replacing each node with its
17
  signature identity. The solution sets are then compared to ensure that
18
  equivalent solutions are present in each set with none left over.")
19
  
20
  
21
 
22
 (defun canonicalize-solution-field (dimensions solutions terms)
23
   (labels ((list-less-p (list1 list2)
24
              (if list1
25
                (if list2
26
                  (and (< (first list1) (first list2))
27
                       (list-less-p (rest list1) (rest list2)))
28
                  nil)
29
                t)))
30
     (let ((cache (make-hash-table)))
31
       (loop for solution in solutions
32
             do (loop for dimension in dimensions
33
                      for value in solution
34
                      when (spocq:blank-node-p value)
35
                      do (let ((contexts (gethash value cache)))
36
                           (push (loop for other-value in solution
37
                                     collect (if (spocq:blank-node-p other-value)
38
                                               0
39
                                               (1+ (position other-value terms :test #'equalp))))
40
                                 (getf contexts dimension))
41
                          ;;  (print contexts)
42
                           (setf (gethash value cache) contexts))))
43
       (maphash #'(lambda (k v)
44
                    (setf v (loop for (dim contexts) on v by #'cddr
45
                                  collect (list dim (sort contexts #'list-less-p))))
46
                    (setf (gethash k cache)
47
                          (intern (format nil "~{~{~a.~{~{~a~^,~}~^.~}~}~^-~}" v) :keyword)))
48
                cache)
49
       (loop for solution in solutions
50
             collect (loop for value in solution
51
                           collect (if (spocq:blank-node-p value)
52
                                     (gethash value cache)
53
                                     value))))))
54
 
55
 (defun field-match-p (field1 field2 &optional dimensions)
56
   (flet ((equalp-union (&optional set1 set2)
57
            (if set1
58
              (if set2
59
                (union set1 set2 :test #'equalp)
60
                set1)
61
              set2)))
62
     (let* ((dim1 (or dimensions (pop field1)))
63
            (dim2 (or dimensions (pop field2)))
64
            (terms (coerce (reduce #'equalp-union (append field1 field2)) 'vector))
65
            (c-field1 (canonicalize-solution-field dim1 field1 terms))
66
            (c-field2 (canonicalize-solution-field dim2 field2 terms))
67
            (cache1 (make-hash-table :test #'equal))
68
            (cache2 (make-hash-table :test #'equal))
69
            )
70
       (dolist (s1 (rest c-field1))
71
         (incf (gethash s1 cache1 0)))
72
       (dolist (s2 (rest c-field2))
73
         (incf (gethash s2 cache2 0)))
74
       (maphash #'(lambda (key1 value1)
75
                    (unless (eql (gethash key1 cache2) value1)
76
                      (return-from field-match-p nil))
77
                    (remhash key1 cache2))
78
                cache1)
79
       (zerop (hash-table-count cache2)))))
80
 
81
 ;; (canonicalize-solution-field '(a s) '((1 2) (<_:b1> 3) (4 <_:b2>) (5 <_:b2>)) '(1 2 <_:b1> 3 4 <_:b2> 5 <_:b2>))
82
 ;; (canonicalize-solution-field '(a s) '((1 2) (<_:c1> 3) (4 <_:c2>) (5 <_:c2>)))
83
 ;; (field-match-p '((a s) (1 2) (<_:b1> 3) (4 <_:b2>) (5 <_:b2>)) '((a s) (1 2) (<_:c1> 3) (4 <_:c2>) (5 <_:c2>)))
84
 ;; (field-match-p '((a s) (1 2) (<_:b1> 3) (4 <_:b2>) (5 <_:b3>)) '((a s) (1 2) (<_:c1> 3) (4 <_:c2>) (5 <_:c2>)))
85
 
86
 
87
 (unless (fboundp 'cl-user::format-turtle-term)
88
   (defun cl-user::format-turtle-term (stream term &optional option arg)
89
     (declare (ignore option arg))
90
     (encode-turtle-object term stream)))
91
 
92
 (defgeneric canonicalize-graph (graph)
93
   (:method ((graph list-solution-field))
94
     (canonicalize-graph (solution-field-solutions graph)))
95
   (:method ((graph list))
96
     ;;
97
     ;; sort the list based on n-triples keys which replace all blank nodes with _:blank
98
     (let* ((genterm-map (make-hash-table :test 'equalp))
99
            (genterm-counter 0)
100
            (node-zero (spocq:make-blank-node "zero"))
101
            (stream (make-string-output-stream))
102
            (sorted-graph (mapcar #'rest
103
                                 (sort (loop for statement in graph
104
                                         for key = (progn
105
                                                     (format stream "~{~/format-turtle-term/ ~}."
106
                                                             (loop for term in statement
107
                                                               collect (if (spocq:blank-node-p term)
108
                                                                           node-zero
109
                                                                           term)))
110
                                                     (get-output-stream-string stream))
111
                                         collect (cons key statement))
112
                                       #'string-lessp
113
                                       :key #'first))))
114
       (labels ((abstract-blank-nodes (statement)
115
                  (loop for term in statement
116
                    collect (if (spocq:blank-node-p term)
117
                                (or (gethash term genterm-map)
118
                                    (setf (gethash term genterm-map)
119
                                          (spocq:make-blank-node (format nil "_~d" (incf genterm-counter)))))
120
                                term))))
121
         (let* ((abstract-graph (loop for statement in sorted-graph
122
                                  collect (abstract-blank-nodes statement))))
123
           abstract-graph)))))
124
                
125
 #+(or)
126
 (canonicalize-graph
127
  '((<_:node1> <http://example.org/predicate1> "value1")
128
    (<_:node1> <http://example.org/predicate1> "value2")
129
    (<http://example.org/subject1> <http://example.org/predicate2> <_:node1>)
130
    (<http://example.org/subject1> <http://example.org/predicate3> "value3")
131
    (<http://example.org/subject1> <http://example.org/predicate4> 4)))
132
 
133
 
134
 (defgeneric hash-graph (graph)
135
   (:method ((graph list-solution-field))
136
     (hash-graph (solution-field-solutions graph)))
137
   (:method ((graph list))
138
     (let* ((canonical-graph (canonicalize-graph graph))
139
            (digest (ironclad:make-digest *revision-signature-type*))
140
            (ntriples-string (with-output-to-string (stream) (write-rdf-turtle canonical-graph stream)))
141
            (ntriples-buffer (SB-IMPL::STRING->UTF8 ntriples-string 0 (length ntriples-string) 0)))
142
       (ironclad:update-digest digest ntriples-buffer)
143
       (ironclad:byte-array-to-hex-string (ironclad:produce-digest digest)))))
144
 
145
 #+(or)
146
 (hash-graph
147
  '((<_:node1> <http://example.org/predicate1> "value1")
148
    (<_:node1> <http://example.org/predicate1> "value2")
149
    (<http://example.org/subject1> <http://example.org/predicate2> <_:node1>)
150
    (<http://example.org/subject1> <http://example.org/predicate3> "value3")
151
    (<http://example.org/subject1> <http://example.org/predicate4> 4)))
152
 
153
 #+(or)
154
 (progn
155
 (parse-sparql "select *
156
 where {
157
  {_:f1 <http://example.org/superpred1> 0 , 1 ;
158
        <http://example.org/superpred2> 2}
159
    <http://example.org/predicate> 3 .
160
 }")
161
 (macroexpand-bgp-phase :formula
162
  (rest (second (parse-sparql "select *
163
 where {
164
  {_:f1 <http://example.org/superpred1> 0 , 1 ;
165
        <http://example.org/superpred2> 2}
166
    <http://example.org/predicate> 3 .
167
    }")))
168
  nil)
169
 -> (ORG.DATAGRAPH.SPOCQ.ALGEBRA:|bgp|
170
   (ORG.DATAGRAPH.SPOCQ.ALGEBRA:|triple|
171
    <urn:graph:6a9a7cab8c7b33e8775b7011555dbca97b8e0425597b78413a7f6c4730051084>
172
    <http://example.org/predicate> 3))
173
 
174
 (macroexpand-bgp-phase :formula
175
  (rest (second (parse-sparql "select *
176
 where {
177
  {_:f1 <http://example.org/superpred1> 0 , ?o ;
178
        <http://example.org/superpred2> 2}
179
    <http://example.org/predicate> 3 .
180
    }")))
181
  nil)
182
 -> (ORG.DATAGRAPH.SPOCQ.ALGEBRA:|bgp|
183
   ORG.DATAGRAPH.SPOCQ.ALGEBRA:|join|
184
   (ORG.DATAGRAPH.SPOCQ.ALGEBRA:|graph| ?::?1
185
                                        (ORG.DATAGRAPH.SPOCQ.ALGEBRA:|bgp|
186
                                          (ORG.DATAGRAPH.SPOCQ.ALGEBRA:|triple|
187
                                           <_:f1>
188
                                           <http://example.org/superpred1> 0)
189
                                          (ORG.DATAGRAPH.SPOCQ.ALGEBRA:|triple|
190
                                           <_:f1>
191
                                           <http://example.org/superpred1>
192
                                           ?::|o|)
193
                                          (ORG.DATAGRAPH.SPOCQ.ALGEBRA:|triple|
194
                                           <_:f1>
195
                                           <http://example.org/superpred2> 2)))
196
   ((ORG.DATAGRAPH.SPOCQ.ALGEBRA:|triple| ?::?1 <http://example.org/predicate>
197
                                          3)))
198
 
199
 (macroexpand-bgp
200
  (rest (second (parse-sparql "select *
201
 where {
202
  {_:f1 <http://example.org/superpred1> 0 , ?o ;
203
        <http://example.org/superpred2> 2}
204
    <http://example.org/predicate> 3 .
205
    }")))
206
  nil)
207
 
208
 (macroexpand-bgp
209
  (rest (second (parse-sparql "select *
210
 where {
211
  <<_:f1 <http://example.org/superpred1> 0 >>
212
    <http://example.org/predicate> 3 .
213
    }")))
214
  nil)
215
 (macroexpand-bgp
216
  (rest (second (parse-sparql "select *
217
 where {
218
  <<_:f1 <http://example.org/superpred1> ?v0 >>
219
    <http://example.org/predicate> 3 .
220
    }")))
221
  nil)
222
 )
223
 
224
 
225
 
226
 
227
 
228