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

Kind	Covered	All	%
expression	188	222	84.7
branch	32	40	80.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 four query form operators for the 'org.datagraph.spocq' RDF engine."

6

7

(copyright

8

9

10

(:long-description

11

"The query forms (ask, construct, describe, and select) use the result of the algebra expression to

12

generate the response. select operates on the solution field to produce a result table as directed

13

by the variable list.

14

15

  In order to provide a uniform interface despite the distinct control flows, the query forms are implemented

16

  with operators which accept a continuation for the result field. In order to return an immediate result,

17

the implementation supplies that result to the continuation, which returns it as the query reply.

18

19

Select allows either an elementary form - which yields just the projection of the returned field, or

20

  an aggregate form - which combines field consituents according to identical variable values and reduces each

21

  bound value across each groups according to an aggregation function to produces the group's solution."))

22

23

(defparameter *select-translations*

24

25

(?s)

26

. ?args)

27

. (spocq.e:subjects :dimensions '(?s) :distinct nil . ?args))

28

((spocq.a:|select| (spocq.a:|order| (?s)

29

                                         (spocq.a:|bgp| (spocq.a:|triple| ?s (?is ?p variable-p) (?is ?o variable-p))))

30

(?s))

31

      . (spocq.e::with-dimensions (?s) (spocq.a:|order| (?s) (spocq.e:subjects :dimensions '(?s) :distinct nil))))

32

33

(?p)

34

. ?args)

35

. (spocq.e:predicates :dimensions '(?p) :distinct nil . ?args))

36

((spocq.a:|select| (spocq.a:|order| (?p)

37

                                         (spocq.a:|bgp| (spocq.a:|triple| (?is ?s variable-p) ?p (?is ?o variable-p))))

38

(?p))

39

      . (spocq.e::with-dimensions (?p) (spocq.a:|order| (?p) (spocq.e:predicates :dimensions '(?p) :distinct nil))))

40

41

(?o)

42

. ?args)

43

. (spocq.e:objects :dimensions '(?o) :distinct nil . ?args))

44

((spocq.a:|select| (spocq.a:|order| (?o)

45

                                         (spocq.a:|bgp| (spocq.a:|triple| (?is ?s variable-p) (?is ?p variable-p) ?o)))

46

(?o))

47

      . (spocq.e::with-dimensions (?o) (spocq.a:|order| (?o) (spocq.e:objects :dimensions '(?o) :distinct nil))))

48

     ((spocq.a:|select| (spocq.a:|graph| ?g (spocq.a:|bgp| (spocq.a:|triple| (?is ?s variable-p) (?is ?p variable-p) (?is ?o variable-p))))

49

(?g))

50

. (spocq.e:contexts :dimensions '(?g)))

51

52

;; 2013-04-03 re-enabled

53

#-spocq.scan-counts

54

55

((?count (spocq.a:|count| SPOCQ.S:*))))

56

. (spocq.e:bindings (lambda () (list (list (spocq.a:|count| ?s ?p ?o)))) '(?count)))

57

#-spocq.scan-counts

58

     ((spocq.a:|select| (spocq.a:|graph| ?g (spocq.a:|bgp| (spocq.a:|triple| ?s (?is ?p iri-or-variable-p) ?o)))

59

((?count (spocq.a:|count| SPOCQ.S:*))))

60

. (spocq.e:bindings (lambda () (list (list (spocq.a:|count| ?s ?p ?o ?g)))) '(?count)))))

61

62

(defun iri-or-variable-p (x)

63

(or (variable-p x) (iri-p x)))

64

65

 (defmacro spocq.a:|select| (&whole form expression selection-specification &rest args &key count end offset start)

66

(declare (ignore count end offset start))

67

(macroexpand-select form expression selection-specification args))

68

69

(defun macroexpand-select (form expression selection-specification args)

70

(or (and (null (dataset-default-graphs *task*))

71

(rule-based-translator form *select-translations*))

72

(let ((sliced-expression (when (and args (not (or (member :having selection-specification)

73

                                                         (member :group-by selection-specification))))

74

                                  (apply #'compute-expression-slice expression args))))

75

`(locally (declare (spocq.e::version-constraint nil))

76

,(if sliced-expression

77

(macroexpand-select-aux sliced-expression selection-specification)

78

(apply #'macroexpand-select-aux expression selection-specification args))))))

79

80

81

(defun macroexpand-select-aux (expression selection-specification &rest args)

82

"( ( solutionField ) solutionField )

83

A SELECT operation is implemented by reconstructing the select form to decompose it

84

into group, aggregate, project, and filter phases.

85

Where the having clause include group operations, combine the clauses

86

to put them in the proper places."

87

88

(setf args (apply #'canonicalize-algebra-arguments args))

89

(unless (consp selection-specification)

90

(setf selection-specification ()))

91

(let ((group-by nil)

92

(having nil))

93

(loop (if (keywordp (first selection-specification))

94

(ecase (pop selection-specification)

95

(:having (setf having (pop selection-specification)))

96

(:group-by (setf group-by (pop selection-specification))))

97

(return)))

98

;; de-duplicate simple projection specs

99

(when (every #'symbolp selection-specification)

100

(setf selection-specification (remove-duplicates selection-specification :from-end t)))

101

;; if any spec is a bindings, then treat them all as such

102

(let* ((bindings (when (find-if #'consp selection-specification)

103

(loop for spec in selection-specification

104

collect (if (consp spec) spec (list spec spec)))))

105

(temporary-bindings ())

106

            (projection-dimensions (mapcar #'(lambda (b) (if (consp b) (first b) b)) selection-specification))

107

(derived-projection-dimensions (or projection-dimensions

108

                                               (expression-projected-variables expression))))

109

(cond (group-by

110

;; given a grouping clause, group the stream and then aggregate it.

111

;; if no select specification is given, fabricate one to use the group key

112

(setf bindings

113

(if bindings

114

(loop for binding in bindings

115

                            collect (if (consp binding) binding `(,binding (spocq.a:|sample| ,binding))))

116

(loop for variable in (union-dimensions (bindings-variables group-by)

117

                                                              ;; nb. above excluded bindings in this

118

                                                              selection-specification)

119

for binding = `(,variable (spocq.a:|sample| ,variable))

120

do (push binding temporary-bindings)

121

collect binding)))

122

(labels ((ensure-group-and-aggregate (constraint)

123

(if (variable-p constraint)

124

(ensure-group-and-aggregate `(spocq.a:|sample| ,constraint))

125

(flet ((replace-expression (expression)

126

                                    (if (and (consp expression) (aggregate-operator-p (first expression)))

127

                                      (or (first (find expression bindings :test #'equal :key #'second))

128

                                          (let* ((alias (cons-variable "having-"))

129

                                                 (binding `(,alias ,expression)))

130

                                            (setf bindings (append bindings (list binding)))

131

                                            (push binding temporary-bindings)

132

alias))

133

expression)))

134

(declare (dynamic-extent #'replace-expression))

135

(map-tree #'replace-expression constraint))))

136

(abstract-aggregate (value-expression)

137

(flet ((replace-expression (expression)

138

(if (consp expression)

139

                                    (let ((group-binding (find expression group-by :test #'equal :key #'(lambda (e) (when (consp e) (second e))))))

140

(if group-binding

141

(first group-binding)

142

expression))

143

expression)))

144

(declare (dynamic-extent #'replace-expression))

145

(map-tree #'replace-expression value-expression))))

146

(declare (dynamic-extent #'ensure-group-and-aggregate #'abstract-aggregate))

147

(setf having (mapcar #'ensure-group-and-aggregate having))

148

(setf bindings (loop for (variable value-expression) in bindings

149

                                 collect (list variable (abstract-aggregate value-expression)))))

150

(dolist (variable (expression-variables having))

151

(unless (assoc variable bindings)

152

(let ((binding `(,variable ,variable)))

153

(push binding bindings)

154

(push binding temporary-bindings))))

155

(setf expression

156

(if (every #'symbolp bindings)

157

                        ;; if the group specification is all scalar, then there is no aggregation,

158

;; just order the projection in order to collect the solutions

159

`(spocq.a:|order| (spocq.a:|project| ,expression ,bindings) ,group-by)

160

;; otherwise, extend the field with the computed dimensions and

161

;; aggregate the result.

162

#+(or)

163

                      (let ((extension (loop for (variable expression) in (remove-if #'symbolp group-by)

164

                                         append (list variable expression))))

165

                      `(spocq.a:|aggregate| ,(if extension `(spocq.a::|extend| ,expression ,@extension) expression)

166

,bindings

167

,(bindings-variables group-by)))

168

`(spocq.a:|aggregate| ,expression ,bindings ,group-by)))

169

(when having

170

(setf expression `(spocq.a:|filter| ,expression ,having)))

171

;; havin add no reference as it is to group-bound variables

172

(when temporary-bindings

173

;; project back down from temporary intermediates

174

(setf expression `(spocq.a:|project| ,expression ,projection-dimensions))))

175

(bindings

176

;; bindings w/o grouping either aggregates or extends/projects the field

177

(if (find-if #'aggregate-expression-p bindings :key #'second)

178

(setf expression `(spocq.a:|aggregate| ,expression ,bindings ()))

179

(setf expression `(spocq.a:|project| ,expression ,bindings))))

180

((consp selection-specification)

181

;; given a restriction, apply it. otherwise leave the field unchanged.

182

(setf expression `(spocq.a:|project| ,expression ,selection-specification)))

183

#+agp-algebra-specialization

184

((bgp-form-p expression)

185

;; given a query which reduces to a naked bgp, wrap it in a null projection

186

(setf expression `(spocq.e:project ,expression ',(expression-dimensions expression)))))

187

(setf expression

188

`(locally (declare (spocq.e::projection-dimensions ,@derived-projection-dimensions))

189

,expression)))

190

(if args

191

(let ((sliced-expression (when args

192

                                  (apply #'compute-expression-slice expression args))))

193

(if sliced-expression

194

sliced-expression

195

`(spocq.e:slice ,expression ,@args)))

196

expression)))

197

198

199

(defun spocq.e:select (solution-field variables &rest args &key end start)

200

"An elementary select is just a project w/ the given result dimensions."

201

(declare (ignore end start))

202

203

(apply #'spocq.e:project solution-field variables args))

204

205

206

207

#|

208

209

;;; now unused where the select operator is decomposed

210

211

(defun spocq.e:select (solution-field variables &rest args)

212

"Collect the given variables into a result table.

213

The first element is a list of the variable names.

214

  The successive elements are lists of the respective values. Where no value is present nil is returned.

215

The default method delegates to elementary-select which performs the process element-by-element."

216

217

(apply #'spocq.e:elementary-select solution-field variables nil args))

218

219

220

(defgeneric spocq.e:elementary-select (solution-field result-dimensions bindings &key offset count)

221

(:documentation "Collect the given variables into a result table with one entry for solution set.

222

The first element is a list of the variable names.

223

  The successive elements are lists of the respective values. Where no value is present nil is returned.")

224

225

(:method ((field agp) result-dimensions bindings &rest args)

226

(declare (dynamic-extent args))

227

(apply #'spocq.e:elementary-select (agp-generator field) result-dimensions bindings args))

228

229

(:method ((field solution-generator) result-dimensions bindings &rest args)

230

(declare (dynamic-extent args))

231

(apply #'spocq.e:stream-elementary-select field result-dimensions bindings args)))

232

233

234

 (defun spocq.e:stream-elementary-select (field-generator result-dimensions bindings &rest args &key offset count)

235

(declare (ignore offset count))

236

(let* ((result-channel (make-channel :name (cons 'spocq.a:|select| (task-id *query*))

237

:dimensions result-dimensions))

238

(base-dimensions (solution-generator-dimensions field-generator)))

239

(if (and (equal result-dimensions base-dimensions) (null bindings))

240

(apply #'spocq.e:stream-slice field-generator args)

241

(labels ((run-elementary-select-thread (result-channel field-generator result-dimensions)

242

(let ((base-channel (solution-generator-channel field-generator))

243

(base-dimensions (solution-generator-dimensions field-generator))

244

(base-expression (solution-generator-expression field-generator)))

245

(query-run-in-thread *query* base-expression)

246

(apply #'process-elementary-select result-channel base-channel

247

base-dimensions

248

result-dimensions

249

bindings

250

args)

251

'spocq.a:|select|)))

252

(make-solution-generator :operator 'spocq.a:|select|

253

:dimensions result-dimensions

254

                                  :expression (list #'run-elementary-select-thread result-channel field-generator

255

result-dimensions)

256

:channel result-channel

257

:constituents (list field-generator))))))

258

259

260

 (defun process-elementary-select (destination source base-dimensions result-dimensions bindings &key end start)

261

(incf-stat *algebra-operations*)

262

(let* ((collector (compute-elementary-select-collector result-dimensions base-dimensions bindings))

263

(result-page-width (channel-page-width destination))

264

(result-page-length (channel-page-length destination))

265

(result-page nil)

266

(result-index result-page-length))

267

(assert (= (length result-dimensions) result-page-width) ()

268

               "Channel and operation dimensions do not match: ~a: ~a." destination result-dimensions)

269

(labels ((base-processor (base-page)

270

(dotimes (base-index (array-dimension base-page 0))

271

(when (or (null offset) (minusp (decf offset)))

272

(collect-solution base-page base-index)

273

(when (and count (<= (decf count) 0)) (complete-solutions)))))

274

(collect-solution (base-page base-index)

275

(next-solution-location)

276

(funcall collector result-page result-index base-page base-index))

277

(next-solution-location ()

278

                ;; return a page (possible newly created) and the next free location in that page

279

(when (>= (incf result-index) result-page-length)

280

(when result-page (funcall continuation result-page))

281

                  (setf result-page (new-field-page destination result-page-length result-page-width)

282

result-index 0)))

283

(complete-page ()

284

(when result-page

285

(let ((page-result-count (1+ result-index)))

286

(when (< page-result-count result-page-length)

287

(setf result-page

288

                            (adjust-array result-page (list page-result-count result-page-width)))))

289

(put-page result-page)))

290

(complete-solutions ()

291

(complete-page)

292

(complete-field destination)

293

(return-from process-elementary-select))

294

(put-page (page)

295

                (trace-data process-elementary-select destination base-dimensions (rlmdb:term-value-field page))

296

(put-field-page destination page)))

297

(unless (and (plusp result-page-length) (or (null end) (> end start))) (complete-solutions))

298

(loop for solutions = (get-field-page source)

299

until (null solutions)

300

do (progn (base-processor solutions)

301

(incf-stat *solutions-processed* (array-dimension solutions 0))

302

(check-query-status *query*)))

303

(complete-solutions))))

304

305

|#