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

Kind	Covered	All	%
expression	0	1241	0.0
branch	0	74	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: org.datagraph.spocq.implementation; -*-

2

3

(in-package :org.datagraph.spocq.implementation)

4

5

(:documentation "This file defines an introspection functions for the 'org.datagraph.spocq' RDF engine."

6

7

(copyright

8

9

10

(long-description

11

"The compute-instance-model function generates a model for the various service entities

12

- account

13

- repository

14

- view

15

16

The covering-pattern-sets and pattern-expression functions combine patterns with

17

predicate constraints to compute the required patterns an the query which they

18

imply."))

19

20

21

;;; externalize instance models for service elements

22

23

(defclass pattern-class ()

24

((type

25

:initarg :type :initform nil :accessor pattern-type)

26

(predicates

27

:initarg :predicates :initform nil :accessor pattern-predicates)

28

(subject-signature

29

:initarg :subject-signature :initform nil :accessor pattern-subject-signature)

30

(object-signature

31

:initarg :object-signature :initform nil :accessor pattern-object-signature)

32

(superclasses

33

:initarg :superclasses :initform nil :accessor pattern-superclasses)

34

(subclasses

35

:initarg :subclasses :initform nil :accessor pattern-subclasses)

36

(count

37

:initarg :count :initform 0 :accessor pattern-class-count)))

38

39

(defmethod print-object ((object pattern-class) stream)

40

(print-unreadable-object (object stream :identity t :type t)

41

(format stream "~b/~b ~@[(~a)~]x~a (~{~b~^ ~}) [~{~a~^ ~}]"

42

(pattern-subject-signature object)

43

(pattern-object-signature object)

44

(pattern-type object)

45

(pattern-class-count object)

46

(mapcar #'pattern-subject-signature (pattern-superclasses object))

47

(pattern-predicates object))))

48

49

(defun make-pattern-class (&rest args)

50

(apply #'make-instance 'pattern-class args))

51

52

(defclass pattern-path ()

53

((object-predicate

54

     :initarg :object-predicate :initform (error "object-predicate is required") :accessor pattern-path-object-predicate)

55

(subject-predicate

56

     :initarg :subject-predicate :initform (error "subject-predicate is required") :accessor pattern-path-subject-predicate)

57

(count

58

:initarg :count :initform 0

59

:accessor pattern-path-count)))

60

61

(defmethod print-object ((object pattern-path) stream)

62

(print-unreadable-object (object stream :identity t :type t)

63

(format stream "~a/~a"

64

(pattern-path-object-predicate object)

65

(pattern-path-subject-predicate object))))

66

67

(defun make-pattern-path (&rest args)

68

(apply #'make-instance 'pattern-path args))

69

70

71

(defgeneric view-construct-patterns (view)

72

(:documentation

73

"Compute those of the patterns from the view's repository which provide the

74

most coverage to the templates of the view's construct clause.

75

Return a list of pattern instances, each of which provide the most coverage

76

for at least one of the sets of predicates.")

77

(:method ((view view))

78

(when (construct-form-p (view-sse-expression view))

79

(let* ((repository (view-repository view))

80

(patterns (repository-pattern-classes repository))

81

(predicate-set (mapcar #'statement-predicate (third (view-sse-expression view))))

82

(ordered-patterns (sort (copy-list patterns) #'>

83

                                      :key #'(lambda (pattern) (length (intersection predicate-set (pattern-predicates pattern)))))))

84

(when ordered-patterns

85

(list (first ordered-patterns)))))))

86

87

(defgeneric view-modify-patterns (view)

88

(:documentation

89

"Compute those of the patterns from the view's repository which provide the

90

most coverage to the templates of the view's modify clause.

91

Return a list of pattern instances, each of which provide the most coverage

92

for at least one of the sets of predicates.")

93

(:method ((view view))

94

(when (update-form-p (view-sse-expression view))

95

(let* ((repository (view-repository view))

96

(patterns (repository-pattern-classes repository))

97

(predicate-sets (loop for form in (rest (view-sse-expression view))

98

when (modify-form-p form)

99

                                collect (let* ((template (first (getf (cddr form) :insert)))

100

                                               (triples (remove-if-not #'triple-form-p template))

101

                                               (graphs (remove-if-not #'graph-form-p template)))

102

                                          (append (when triples (list (mapcar #'statement-predicate triples)))

103

                                                  (loop for graph in graphs

104

                                                    collect (mapcar #'statement-predicate (third graph))))))))

105

(remove-duplicates

106

(loop for predicate-set in predicate-sets

107

for pattern = (first (sort (copy-list patterns) #'>

108

                                     :key #'(lambda (pattern) (length (intersection predicate-set (pattern-predicates pattern))))))

109

when pattern collect pattern))))))

110

111

(defgeneric view-where-patterns (view)

112

(:documentation

113

"Compute a list of the respective least repository which covers each bgp instances.")

114

(:method ((view view))

115

(let* ((repository (view-repository view))

116

(patterns (repository-pattern-classes repository))

117

(view-patterns (expression-pattern-classes (view-sse-expression view))))

118

(remove-duplicates

119

(loop for view-pattern in view-patterns

120

for covering-patterns = (remove-if-not #'(lambda (pattern)

121

                                                     (every #'(lambda (predicate) (find predicate (pattern-predicates pattern)))

122

                                                            view-pattern))

123

patterns)

124

          for pattern = (when covering-patterns (reduce #'(lambda (p1 p2) (if (< (length (pattern-predicates p1)) (length (pattern-predicates p2))) p1 p2))

125

                                                        covering-patterns))

126

when pattern collect pattern)))))

127

128

(defgeneric view-where-attributes (view)

129

(:documentation

130

"Compute the list of where dimensions from the (should be single) select clause.")

131

(:method ((view view))

132

(let ((form (view-sse-expression view)))

133

(when (and (construct-form-p form)

134

(> (length (expression-table-forms (second form))) 0))

135

(let ((selects (expression-select-forms form)))

136

(unless (= (length selects) 1)

137

(warn "multiple select forms: ~a" view))

138

(let* ((select (first selects))

139

(projection (third select)))

140

(loop until (not (keywordp (first projection)))

141

do (setf projection (cddr projection)))

142

(loop for attribute in projection

143

collect (if (consp attribute) (first attribute) attribute))))))))

144

145

146

(defun classify-star-instances (node-signatures ordinal-predicates)

147

(let ((subject-patterns (make-hash-table :test 'eql))

148

(type-patterns (make-hash-table :test 'eql)))

149

(flet ((note-class (instance)

150

(destructuring-bind (type subject-signature object-signature) instance

151

(declare (ignore object-signature))

152

                  (when type (setf (gethash type type-patterns) instance)) ;; cache it although not used

153

(setf (gethash subject-signature subject-patterns) instance))))

154

(loop for instance being each hash-value of node-signatures

155

do (note-class instance)))

156

(let ((objects (make-hash-table :test 'eql)))

157

(flet ((get-object-term (term-number)

158

(or (gethash term-number objects)

159

(setf (gethash term-number objects) (term-number-object term-number))))

160

(signature-superclass (super? sub?)

161

                (= (logand (pattern-subject-signature super?) (pattern-subject-signature sub?)) (pattern-subject-signature super?))))

162

(let ((classes

163

                (loop for (type subject-signature object-signature) being each hash-value of subject-patterns

164

collect (make-pattern-class

165

:type (when type (get-object-term type))

166

                           :predicates (reverse (loop with length = (integer-length subject-signature)

167

                                                  for ordinal below length

168

                                                  for present = (= 1 (ldb (byte 1 ordinal) subject-signature))

169

                                                  when present collect (get-object-term (gethash ordinal ordinal-predicates))))

170

:subject-signature subject-signature

171

:object-signature object-signature))))

172

(setf classes (sort classes #'(lambda (c1 c2)

173

                                           (let ((s1 (pattern-subject-signature c1))

174

                                                 (s2 (pattern-subject-signature c2)))

175

                                             (> (logcount s1) (logcount s2))))))

176

(loop for (sub? . rest) on classes

177

for sub-signature = (pattern-subject-signature sub?)

178

for supers = (remove-if #'(lambda (super?)

179

                                         (loop for super-sub? in (ldiff rest (member super? rest))

180

                                           when (and (signature-superclass super? super-sub?)

181

                                                     (signature-superclass super-sub? sub?))

182

return t))

183

(remove-if-not #'(lambda (super?)

184

                                                        (signature-superclass super? sub?))

185

rest))

186

do (setf (pattern-superclasses sub?) supers)

187

do (loop for super in supers

188

do (push sub? (pattern-subclasses super))

189

                  do (setf (pattern-object-signature super) (logior (pattern-object-signature super) (pattern-object-signature sub?)))))

190

classes)))))

191

192

193

194

195

196

(defparameter *repository-pattern-classes.verbose* nil)

197

198

(defparameter *repository-graph-pattern-query*

199

"select ?protoS ?p ?o

200

where {

201

{ select distinct ?protoS

202

where {

203

select (sample (?s) as ?protoS)

204

where { ?s ?p ?o . }

205

group by ?p

206

}

207

}

208

?protoS ?p ?o

209

}"

210

"generate exemplary star sub-graphs for a repository:

211

- enumerate predicates.

212

- collect one subject respective each predicate.

213

- generate the full description for each subject.

214

nb. no comments allowed, as it is sent as a single line.")

215

216

(defgeneric repository-pattern-classes (repository)

217

(:documentation

218

"Compute the tree of patterns present in the repository based on the star graphs connected

219

to subject nodes.")

220

(:method ((designator string))

221

(repository-pattern-classes (repository designator)))

222

223

(:method ((repository repository))

224

(let ((instances (make-hash-table :test 'eql))

225

(node-patterns (make-hash-table :test 'eql))

226

(node-counts (make-hash-table :test 'eql))

227

(type-patterns (make-hash-table :test 'eql))

228

(predicate-ordinals (make-hash-table :test 'eql))

229

(ordinal-predicates (make-hash-table :test 'eql))

230

(type-predicate (object-term-number |rdf|:|type|))

231

(cached (gethash :classes (repository-library-cache repository))))

232

(when cached (return-from repository-pattern-classes cached))

233

;; enumerate the subject and object combinations

234

(flet ((note-instance (%quad)

235

(let* ((as-subject (or (gethash (%quad-subject %quad) instances)

236

                                        (setf (gethash (%quad-subject %quad) instances)

237

(list nil 0 0))))

238

(as-object (or (gethash (%quad-object %quad) instances)

239

                                      (setf (gethash (%quad-object %quad) instances)

240

(list nil 0 0))))

241

(predicate (%quad-predicate %quad)))

242

(cond ((eql predicate type-predicate)

243

(setf (first as-subject) (%quad-object %quad))

244

(setf (first as-object) (%quad-object %quad)))

245

(t

246

                         (let ((predicate-ordinal (or (gethash (%quad-predicate %quad) predicate-ordinals)

247

                                                      (setf (gethash (hash-table-count predicate-ordinals) ordinal-predicates)

248

                                                            (%quad-predicate %quad)

249

                                                            (gethash (%quad-predicate %quad) predicate-ordinals)

250

                                                            (hash-table-count predicate-ordinals)))))

251

                           (setf (ldb (byte 1 predicate-ordinal) (second as-subject)) 1

252

                                 (ldb (byte 1 predicate-ordinal) (third as-object)) 1)))))))

253

(rlmdb:map-repository-statements #'note-instance repository #(0 0 0 0)))

254

;; de-duplicate

255

(when *repository-pattern-classes.verbose*

256

(loop for predicate being each hash-value of ordinal-predicates using (hash-key ordinal)

257

do (print (list ordinal predicate (term-number-object predicate)))))

258

;;;!!! this should be revised to use classify-star-instances

259

(flet ((note-class (node-signatures)

260

(destructuring-bind (type subject-signature object-signature) node-signatures

261

(declare (ignore object-signature))

262

                  (when type (setf (gethash type type-patterns) node-signatures)) ;; cache it although not used

263

(setf (gethash subject-signature node-patterns) node-signatures)

264

(incf (gethash subject-signature node-counts 0)))))

265

(loop for instance being each hash-value of instances

266

do (note-class instance)))

267

(let ((objects (make-hash-table :test 'eql)))

268

(flet ((get-object-term (term-number)

269

(or (gethash term-number objects)

270

(setf (gethash term-number objects) (term-number-object term-number))))

271

(signature-superclass (super? sub?)

272

                  (= (logand (pattern-subject-signature super?) (pattern-subject-signature sub?)) (pattern-subject-signature super?))))

273

(let ((classes

274

                  (loop for (type subject-signature object-signature) being each hash-value of node-patterns

275

                    for predicates = (reverse (loop with length = (integer-length subject-signature)

276

                                                for ordinal below length

277

                                                for present = (= 1 (ldb (byte 1 ordinal) subject-signature))

278

                                                when present collect (get-object-term (gethash ordinal ordinal-predicates))))

279

for count = (gethash subject-signature node-counts)

280

collect (make-pattern-class

281

:type (when type (get-object-term type))

282

:predicates predicates

283

:subject-signature subject-signature

284

:object-signature object-signature

285

:count count))))

286

(setf classes (sort classes #'(lambda (c1 c2)

287

                                           (let ((s1 (pattern-subject-signature c1))

288

                                                 (s2 (pattern-subject-signature c2)))

289

                                             (> (logcount s1) (logcount s2))))))

290

(loop for (sub? . rest) on classes

291

for sub-signature = (pattern-subject-signature sub?)

292

for supers = (remove-if #'(lambda (super?)

293

                                           (loop for super-sub? in (ldiff rest (member super? rest))

294

                                             when (and (signature-superclass super? super-sub?)

295

                                                       (signature-superclass super-sub? sub?))

296

return t))

297

(remove-if-not #'(lambda (super?)

298

                                                          (signature-superclass super? sub?))

299

rest))

300

do (setf (pattern-superclasses sub?) supers)

301

do (loop for super in supers

302

do (push sub? (pattern-subclasses super))

303

                    do (setf (pattern-object-signature super) (logior (pattern-object-signature super) (pattern-object-signature sub?)))))

304

(setf (gethash :classes (repository-library-cache repository))

305

classes))))))

306

307

(:method ((repository service-repository))

308

"Given a service repository, rather than scan the entire repository in

309

order to enumerate the star graph instances, extract exemplary subgraphs and

310

base the inventory on them."

311

312

(let ((instances (make-hash-table :test 'eql))

313

(predicate-ordinals (make-hash-table :test 'eql))

314

(ordinal-predicates (make-hash-table :test 'eql))

315

(type-predicate (object-term-number |rdf|:|type|))

316

(cached (gethash :classes (repository-library-cache repository))))

317

(when cached (return-from repository-pattern-classes cached))

318

(flet ((note-instance (s p o)

319

(let ((%subject (object-term-number s))

320

(%predicate (object-term-number p))

321

(%object (object-term-number o)))

322

(let* ((as-subject (or (gethash %subject instances)

323

(setf (gethash %subject instances)

324

(list nil 0 0))))

325

                         ;; given that the query sample subjects, this will not likely yield anything

326

(as-object (or (gethash %object instances)

327

                                        (setf (gethash %object instances) (list nil 0 0)))))

328

(cond ((eql %predicate type-predicate)

329

(setf (first as-subject) %object)

330

(setf (first as-object) %object))

331

(t

332

                           (let ((predicate-ordinal (or (gethash %predicate predicate-ordinals)

333

                                                        (setf (gethash (hash-table-count predicate-ordinals) ordinal-predicates)

334

                                                              %predicate

335

                                                              (gethash %predicate predicate-ordinals)

336

                                                              (hash-table-count predicate-ordinals)))))

337

                             (setf (ldb (byte 1 predicate-ordinal) (second as-subject)) 1

338

                                   (ldb (byte 1 predicate-ordinal) (third as-object)) 1))))))))

339

(with-open-repository ("system/null" :read-only-p t :normal-disposition :abort)

340

(map-external-service-response #'note-instance repository *repository-graph-pattern-query*)))

341

(when *repository-pattern-classes.verbose*

342

(loop for predicate being each hash-value of ordinal-predicates using (hash-key ordinal)

343

do (print (list ordinal predicate (term-number-object predicate)))))

344

(setf (gethash :classes (repository-library-cache repository))

345

(classify-star-instances instances ordinal-predicates)))))

346

347

;;; (repository-pattern-classes (service-repository "https://www.dydra.com/test/test/sparql") )

348

;;; (repository-pattern-classes (service-repository "http://edan.si.edu/saam/sparql") )

349

#|

350

curl "-L" "-X" "POST" "-D" "-" "-k" "--silent" --data-binary @- \

351

"-H" "Accept: text/csv,application/sparql-results+json" \

352

"-H" "Content-Type: application/sparql-query" \

353

http://edan.si.edu/saam/sparql <<EOF

354

select ?protoS ?p ?o

355

where {

356

{ select distinct ?protoS

357

where {

358

select (sample (?s) as ?protoS)

359

where { ?s ?p ?o . }

360

group by ?p

361

}

362

}

363

?protoS ?p ?o

364

}

365

EOF

366

367

|#

368

369

(defgeneric repository-pattern-paths (repository)

370

(:documentation

371

"Compute the predicate pairs which share respective object/subject nodes.

372

This differs from the intermediate data gathered to compute the classes in that

373

those signatures record all possible predicates per subject/object rather than

374

the respective specific predicate for a specific subject/object.")

375

(:method ((designator string))

376

(repository-pattern-paths (repository designator)))

377

(:method ((repository repository))

378

(let ((linkages (make-hash-table :test 'equal))

379

(statements (make-hash-table :test 'eql))

380

(terms (make-hash-table :test 'eql))

381

(cached (gethash :pattern-paths (repository-library-cache repository))))

382

(when cached (return-from repository-pattern-paths cached))

383

(flet ((collect-statements (%quad)

384

(let ((statement (list (%quad-subject %quad)

385

(%quad-predicate %quad)

386

(%quad-object %quad))))

387

(push statement (gethash (%quad-subject %quad) statements))))

388

(get-predicate-term (term-number)

389

(or (gethash term-number terms)

390

(setf (gethash term-number terms) (term-number-object term-number)))))

391

(rlmdb:map-repository-statements #'collect-statements repository #(0 0 0 0))

392

(loop for by-subject-statements being each hash-value of statements

393

do (loop for by-subject in by-subject-statements

394

for via-object-statements = (gethash (third by-subject) statements)

395

do (loop for via-object in via-object-statements

396

do (incf (gethash (list (second by-subject) (second via-object))

397

linkages

398

0)))))

399

(values

400

(setf (gethash :pattern-paths (repository-library-cache repository))

401

(loop for (object-predicate subject-predicate) being each hash-key of linkages

402

using (hash-value count)

403

                  collect (make-pattern-path :object-predicate (get-predicate-term object-predicate)

404

                                             :subject-predicate (get-predicate-term subject-predicate)

405

:count count)))

406

(hash-table-count statements)

407

(loop for statement-list being each hash-value of statements

408

sum (length statement-list)))))))

409

410

411

(defgeneric repository-referenced-pattern-classes (repository &key abstract)

412

(:documentation "Return the repository graph patterns which are

413

referenced from some view as a where pattern.")

414

415

(:method ((repository repository) &key (abstract nil))

416

(let* ((patterns (repository-pattern-classes repository))

417

(views (repository-view-definitions repository))

418

(referenced-graph-patterns (make-hash-table :test 'equal))

419

(where-patterns (make-hash-table :test 'equal)))

420

;; note referencing patterns

421

(loop for view in views

422

do (loop for pattern in (view-where-patterns view)

423

for signature = (pattern-subject-signature pattern)

424

do (setf (gethash signature where-patterns) pattern)))

425

;; note referenced patterns

426

(loop for pattern in patterns

427

for signature = (pattern-subject-signature pattern)

428

when (gethash signature where-patterns)

429

do (setf (gethash signature referenced-graph-patterns) pattern))

430

(when abstract

431

;; include abstractions - everything where the signature is subsumed

432

(loop for pattern in patterns

433

for signature = (pattern-subject-signature pattern)

434

when (loop for referenced-pattern being each hash-value of referenced-graph-patterns

435

#|do (format *trace-output* "~&test: ~b . ~b = ~b"

436

signature

437

(pattern-subject-signature referenced-pattern)

438

                             (logand signature (pattern-subject-signature referenced-pattern)))|#

439

                  when (= signature (logand signature (pattern-subject-signature referenced-pattern)))

440

return t)

441

do (setf (gethash signature referenced-graph-patterns) pattern)))

442

(loop for pattern being each hash-value of referenced-graph-patterns

443

collect pattern))))

444

445

(defgeneric repository-predicates (repository)

446

(:documentation

447

"Compute the predicate pairs which share respective object/subject nodes.

448

This differs from the intermediate data gathered to compute the classes in that

449

those signatures record all possible predicates per subject/object rather than

450

the respective specific predicate for a specific subject/object.")

451

(:method ((designator string))

452

(repository-pattern-paths (repository designator)))

453

(:method ((repository repository))

454

(let ((predicates ())

455

(cached (gethash :predicates (repository-library-cache repository))))

456

(flet ((collect-predicates (term-number)

457

(push (term-number-object term-number) predicates)))

458

(declare (dynamic-extent #'collect-predicates))

459

(cond (cached cached)

460

(t

461

(map-repository-predicates #'collect-predicates repository :distinct t)

462

(setf (gethash :predicates (repository-library-cache repository)) predicates)))))))

463

464

(defgeneric compute-instance-model (resource as &key predicates views)

465

(:method ((account account) (as mime:application/json) &rest args)

466

     "Generate a model for an account to include the repositories, their views and classes and the classes constituent predicates.

467

Only the repositories are included immediately.

468

The other entities appear in the respective repository."

469

(declare (ignore args))

470

(let* ((repositories (account-repositories account))

471

            ;; (views (loop for repository in repositories append (spocq.i::repository-view-definitions repository)))

472

(repository-models (map 'vector #'(lambda (repository)

473

                                                (let ((model (compute-instance-model repository as)))

474

                                                  (loop for entry in model

475

                                                    for (name . value) = entry

476

                                                    if (eq name 'views)

477

                                                    collect `(name . ,(map 'vector #'(lambda (v) (rest (assoc 'name v))) value))

478

                                                    else collect entry)))

479

repositories)))

480

`(("@type" . "account")

481

("name" . ,(account-name account))

482

("location" . ,(resource-uri account))

483

("identifier" . ,(instance-identifier account))

484

("repositories" . ,repository-models))))

485

486

(:method ((repository repository-revision) (as t) &rest args)

487

(apply #'compute-instance-model (repository-revision-reference repository) as args))

488

489

(:method ((repository repository) (as mime:application/json) &key predicates views)

490

     "Generate a model for arepository to include the views and classes and the classes constituent predicates"

491

(flet ((view-predicates (view)

492

              (let ((patterns (append (view-construct-patterns view) (view-modify-patterns view) (view-where-patterns view))))

493

;; duplicates do not matter for the use

494

(reduce #'append patterns :key #'pattern-predicates))))

495

       ;; (when (and views (not predicates)) (setf predicates (reduce #'append views :key #'view-predicates)))

496

(let* ((all-views (remove-if-not #'(lambda (view)

497

(if views

498

                                                (find (view-name view) views :test #'string-equal :key #'view-name)

499

(or (null predicates)

500

                                                    (some #'(lambda (predicate) (find (iri-lexical-form predicate) predicates :test #'string-equal

501

                                                                                      :key #'iri-lexical-form))

502

                                                          (view-predicates view)))))

503

                                        (spocq.i::repository-view-definitions repository)))

504

(update-views (remove-if-not #'(lambda (view)

505

                                               (let ((form (view-sse-expression view)))

506

                                                 (update-form-p form)))

507

all-views))

508

(post-views (remove-if-not #'(lambda (view)

509

                                             (let ((form (view-sse-expression view)))

510

                                               (and (construct-form-p form)

511

                                                    (> (length (expression-table-forms (second form))) 0))))

512

all-views))

513

(get-views (set-difference all-views (append post-views update-views)))

514

(patterns (remove-if-not #'(lambda (pattern)

515

(or (null predicates)

516

                                               (some #'(lambda (predicate) (find (iri-lexical-form predicate) predicates :test #'string-equal

517

                                                                                 :key #'iri-lexical-form))

518

                                                     (pattern-predicates pattern))))

519

(if (null all-views)

520

                                           (remove-if #'pattern-subclasses (repository-pattern-classes repository))

521

                                           (repository-referenced-pattern-classes repository))))

522

(paths (remove-if-not #'(lambda (pattern-path)

523

(or (null predicates)

524

                                            (find (iri-lexical-form (pattern-path-object-predicate pattern-path)) predicates :test #'string-equal

525

                                                  :key #'iri-lexical-form)

526

                                            (find (iri-lexical-form  (pattern-path-subject-predicate pattern-path)) predicates :test #'string-equal

527

                                                  :key #'iri-lexical-form)))

528

(repository-pattern-paths repository))))

529

;; (print (list (repository-name repository) update-views post-views get-views))

530

`(("@type" . "repository")

531

("name" . ,(repository-name repository))

532

("location" . ,(resource-uri repository))

533

("identifier" . ,(instance-identifier repository))

534

           ("getViews" . ,(map 'vector #'(lambda (view) (compute-instance-model view as)) get-views))

535

           ("updateViews" . ,(map 'vector #'(lambda (view) (compute-instance-model view as)) update-views))

536

           ("postViews" . ,(map 'vector #'(lambda (view) (compute-instance-model view as)) post-views))

537

           ("patterns" . ,(map 'vector #'(lambda (pattern)  (compute-instance-model pattern as)) patterns))

538

("description" . ,(repository-description repository))

539

("predicates" . ,(map 'vector #'identity (repository-predicates repository)))

540

("paths" . ,(remove-duplicates

541

                        (map 'vector #'(lambda (pattern-path) (vector (pattern-path-object-predicate pattern-path)

542

                                                                      (pattern-path-subject-predicate pattern-path)))

543

paths)

544

:test #'equalp))))))

545

546

#+(or) ;; this yields a graph from which the relations are mediated by the predicates

547

(:method ((repository repository) (as mime:image/vnd.dydra.sparql-results+circos+svg+xml) &rest args)

548

(declare (ignore args))

549

(let ((model (compute-instance-model repository mime:application/json)))

550

(let ((identifier (json-member-value model "identifier"))

551

(views (concatenate 'vector (json-member-value model "getViews")

552

(json-member-value model "updateViews")

553

(json-member-value model "postViews")))

554

(patterns (json-member-value model "patterns")))

555

(append (loop for pattern across patterns

556

                   collect `(,identifier <urn:dydra:pattern> ,(json-member-value pattern "signature")))

557

(loop for view-model across views

558

for view-identifier = (json-member-value view-model "identifier")

559

for patterns = (json-member-value view-model "wherePatterns")

560

append (cons `(,identifier <urn:dydra:view> ,view-identifier)

561

(loop for pattern across patterns

562

                                  collect `(,view-identifier <urn:dydra:pattern> ,(json-member-value pattern "signature")))))))))

563

564

(:method ((repository repository) (as mime:image/vnd.dydra.sparql-results+circos+svg+xml) &rest args)

565

     "Generate the repository model and transform it into a query result suitable for circos table processing.

566

      Use the profile sp|:|Construct| or sp|:|Select| (the default) to specify the dimensions to determine

567

wheter the predicate appears in the rendering"

568

(labels ((signature-iri (signature)

569

(when signature

570

(intern-iri (format nil "urn:dydra:signature:~a" signature))))

571

(type-iri (type)

572

type)

573

(path-iri (p1 p2)

574

(intern-iri (concatenate 'string (iri-local-part p1) "..." (iri-local-part p2))))

575

(pattern-identifier (pattern)

576

(or (type-iri (json-member-value pattern "type"))

577

(signature-iri (json-member-value pattern "signature"))

578

|rdf|:|nil|)))

579

(let* ((model (apply #'compute-instance-model repository mime:application/json args))

580

(repository-identifier (json-member-value model "identifier"))

581

(views (concatenate 'vector (json-member-value model "getViews")

582

(json-member-value model "updateViews")

583

(json-member-value model "postViews")))

584

(patterns (json-member-value model "patterns"))

585

(paths (json-member-value model "paths"))

586

;; choose between select and construct

587

(as-graph (mime-type-profile-p as |sp|:|Construct|)))

588

(cond ((> (length views) 0) (print :for-views)

589

                (cons (if as-graph *construct-dimensions* '(?::reference ?::predicate ?repository))

590

(append (loop for pattern across patterns

591

                                for pattern-identifier = (pattern-identifier pattern)

592

;; this could use rdf:nil as the counterpart

593

                                collect `(,repository-identifier ,pattern-identifier ,repository-identifier))

594

(loop for view-model across views

595

                                for view-identifier = (json-member-value view-model "identifier")

596

                                for patterns = (json-member-value view-model "wherePatterns")

597

append (loop for pattern across patterns

598

                                         for pattern-identifier = (pattern-identifier pattern)

599

                                         collect `(,view-identifier ,pattern-identifier ,repository-identifier))))))

600

(t

601

(let ((predicate-pattern-map (make-hash-table))

602

(pattern-join-map (make-hash-table :test #'equal)))

603

;; (print patterns) (print paths)

604

(loop for pattern across patterns

605

                    for pattern-identifier = (pattern-identifier pattern) ;; do (print pattern)

606

do (loop for predicate across (json-member-value pattern "predicates")

607

                         do (push pattern-identifier (gethash predicate predicate-pattern-map))))

608

(loop for path across paths

609

for p1 = (elt path 0)

610

for p2 = (elt path 1)

611

do (loop for pattern-identifier1 in (gethash p1 predicate-pattern-map)

612

                         do (loop for pattern-identifier2 in (gethash p2 predicate-pattern-map)

613

                              do (setf (gethash (list pattern-identifier1 pattern-identifier2) pattern-join-map)

614

(list p1 p2)))))

615

                  (cons (if as-graph *construct-dimensions* '(?::signature1 ?::predicate ?::signature2))

616

                        (loop for (pattern-identifier1 pattern-identifier2) being each hash-key of pattern-join-map

617

using (hash-value path)

618

for (p1 p2) = path

619

collect (list pattern-identifier1

620

(path-iri p1 p2)

621

pattern-identifier2)))))))))

622

623

(:method ((view view) (as mime:application/json) &rest args)

624

(declare (ignore args))

625

(let ((expression (view-sse-expression view))

626

(header-attributes (view-where-attributes view)))

627

`(("@type" . "view")

628

("name" . ,(view-name view))

629

("location" . ,(resource-uri view))

630

("identifier" . ,(view-identifier view))

631

       ("constructPatterns" . ,(map 'vector #'(lambda (p) (compute-instance-model p as)) (remove-duplicates (view-construct-patterns view) :test #'eql)))

632

       ("modifyPatterns" . ,(map 'vector #'(lambda (p) (compute-instance-model p as)) (remove-duplicates (view-modify-patterns view) :test #'eql)))

633

       ("wherePatterns" .  ,(map 'vector #'(lambda (p) (compute-instance-model p as)) (remove-duplicates (view-where-patterns view) :test #'eql)))

634

       ,@(when header-attributes `(("whereHeader" . (("@type" . "header") ("attributes" . ,(map 'vector #'string header-attributes))))))

635

("predicates" . ,(map 'vector #'iri-lexical-form

636

(remove-if-not #'iri-p

637

(remove-duplicates

638

                                             (map 'vector #'statement-predicate (expression-pattern-statements expression))))))

639

("references" . ,(let ((services (view-service-references view))

640

(views (view-view-references view)))

641

                          ;; services are either the external url of a service or the id of a repository

642

;; views are the three-part view identifiers

643

                          `(("services" . ,(map 'vector #'repository-external-name services))

644

                            ("views" . ,(map 'vector #'(lambda (view) (concatenate 'string (repository-id (view-repository view)) "/" (view-name view)))

645

views)))))

646

("description" . ,(sparql-query-description view)))))

647

648

(:method ((class pattern-class) (as mime:application/json) &rest args)

649

(declare (ignore args))

650

`(("@type" . "pattern")

651

,@(when (pattern-type class) `(("type" . ,(pattern-type class))))

652

("predicates" . ,(map 'vector #'identity (pattern-predicates class)))

653

       ;;,@(when (pattern-subject-signature class) `(("signature" . ,(format nil "~b" (pattern-subject-signature class)))))

654

       ;;,@(when (pattern-object-signature class) `(("paths" . ,(format nil "~b" (pattern-object-signature class)))))

655

,@(when (pattern-subject-signature class) `(("signature" . ,(pattern-subject-signature class))))

656

,@(when (pattern-object-signature class) `(("paths" . ,(pattern-object-signature class))))

657

       #+(or) ("subclasses" . ,(map 'vector #'(lambda (sc) (compute-instance-model sc as)) (pattern-subclasses class)))

658

       ("subclasses" . ,(map 'vector #'(lambda (sc) (or (pattern-subject-signature sc) -1)) (pattern-subclasses class))))))

659

660

661

662

(defstruct (pattern-node (:conc-name node-))

663

pattern

664

value

665

object-links

666

subject-links

667

subject

668

covered-predicates)

669

(defmethod node-predicates ((node pattern-node))

670

(pattern-predicates (node-pattern node)))

671

(defmethod node-count ((node pattern-node))

672

(pattern-class-count (node-pattern node)))

673

(defmethod node-object-signature ((node pattern-node))

674

(pattern-object-signature (node-pattern node)))

675

(defmethod node-subject-signature ((node pattern-node))

676

(pattern-subject-signature (node-pattern node)))

677

(defun ensure-node-subject (node)

678

(or (node-subject node)

679

(setf (node-subject node) (make-variable (string (gensym "pattern"))))))

680

681

(defstruct (path-link (:conc-name link-))

682

path

683

destination)

684

(defmethod link-value ((link path-link))

685

(pattern-path-count (link-path link)))

686

(defmethod link-object-predicate ((link path-link))

687

(pattern-path-object-predicate (link-path link)))

688

(defmethod link-subject-predicate ((link path-link))

689

(pattern-path-subject-predicate (link-path link)))

690

691

692

(defun compute-combinations (sets continuation &optional list)

693

(if sets

694

(loop for member in (first sets)

695

do (compute-combinations (rest sets) continuation (cons member list)))

696

(funcall continuation (reverse list))))

697

698

699

700

(defmethod compute-pattern-expression (pattern-lists iri-attributes)

701

;; compute equivalent variables

702

;; - use the attribute name directly

703

;; - generate non-distinguished variables for join nodes

704

;; compute the covering graph

705

;; compute connected paths which incorporate all patterns

706

;; translate that into sparql

707

;; (print iri-attributes)

708

(let ((all-patterns (remove-duplicates (reduce #'append pattern-lists))))

709

(labels ((predicate-variable (predicate)

710

(make-variable (rest (assoc predicate iri-attributes))))

711

(compute-join (form-list)

712

(reduce #'(lambda (form1 form2) `(spocq.a:|join| ,form1 ,form2))

713

form-list))

714

(compute-union (form-list)

715

(reduce #'(lambda (form1 form2) `(spocq.a:|union| ,form1 ,form2))

716

form-list))

717

(compute-pattern-form (form)

718

(let ((subject (ensure-node-subject form)))

719

                ;; (let ((*print-circle* t) (*print-level* 4))(print (list subject (node-predicates form) (node-object-links form))))

720

;; first collect the specified predicates.

721

;; consider them datatype properties which constitute a natural join

722

;; join them with a union of all link (object) predicates.

723

(let* ((datatype-predicates (loop for predicate in (node-predicates form)

724

                                              when (assoc predicate iri-attributes)

725

collect predicate))

726

(object-links (loop for predicate in (node-predicates form)

727

for link = (find-if #'(lambda (link)

728

                                                        (and (not (eq form (link-destination link))) ;; suppress reflexive paths

729

                                                             (eq predicate (link-object-predicate link))

730

                                                             (member (link-destination link) all-patterns)))

731

                                                    (node-object-links form))

732

when link collect link))

733

                       (datatype-statement-patterns (loop for predicate in datatype-predicates

734

                                                      unless (find predicate object-links :key #'link-object-predicate)

735

                                                      collect `(spocq.a:|triple| ,subject

736

                                                                        ,predicate

737

                                                                        ,(predicate-variable predicate))))

738

(object-statement-patterns (loop for link in object-links

739

                                                    collect `(spocq.a:|bgp|

740

                                                                      (spocq.a:|triple| ,subject

741

                                                                               ,(link-object-predicate link)

742

                                                                               ,(ensure-node-subject (link-destination link))))))

743

(base (if datatype-statement-patterns

744

(cons 'spocq.a:|bgp| datatype-statement-patterns)

745

'(spocq.a:|table| spocq.a:|unit|))))

746

(if object-statement-patterns

747

`(spocq.a:|join|

748

,base

749

                                ,(reduce #'(lambda (form1 form2) `(spocq.a:|union| ,form1 ,form2))

750

object-statement-patterns))

751

base)))))

752

#+(or)

753

(labels ((typed (x)

754

(typecase x

755

(cons (mapcar #'typed x))

756

(t (type-of x)))))

757

(print (typed pattern-lists)))

758

(compute-join (loop for pattern-list in pattern-lists

759

when pattern-list ;; skip empty intermediates

760

collect (compute-union (loop for pattern in pattern-list

761

                                              ;; do (print (list :in-pattern-list (type-of pattern)))

762

                                              collect (compute-pattern-form pattern))))))))

763

764

#|

765

for saam, :predicate-pattern-sets, the straight combination yields unwieldy intermediates

766

  (reduce #'* '(1 1 1 1 1 2 1 2 1 1 1 1 1 1 1 1 1 2 2 1 2 2 4 2 3 2 3 2 3 3 3 5 2 1 1 1 1 2 2

767

2 1 2 5 6 9 7))

768

150493593600

769

|#

770

(defun compute-covering-pattern-sets (patterns paths predicates &aux (*print-circle* t))

771

"

772

- build the adjacency graph based on object.subject links

773

- iterate over all patterns

774

- for each one which includes some of the given predicates, add a node to the graph

775

- collate each node according to the predicates which it covers

776

- associate with each one the paths for which it is either the subject or the object

777

- arrange sets of nodes by covered predicates

778

- take the node sets of the covered predicate cache

779

- order the group by aggregate cardinality

780

- enumerate traversals between groupd nodes

781

782

return a list of node sets.

783

the intent is that the list be joined into unions of each se

784

"

785

;;(print (list (length patterns) (length paths) predicates))

786

(let* ((predicate-patterns (make-hash-table))

787

(covering-patterns (make-hash-table :test 'equal))

788

(nodes (loop for pattern in patterns

789

                   for covered-predicates = (sort (intersection predicates (pattern-predicates pattern))

790

#'spocq.e:<)

791

                   ;; need to include intermediates which cover nothing - when covered-predicates

792

collect (make-pattern-node :pattern pattern

793

                                              :covered-predicates covered-predicates))))

794

;; collate patterns according to the predicates which they include

795

(loop for node in nodes

796

do (progn

797

(loop for predicate in (node-predicates node)

798

unless (eq predicate |rdf|:|type|)

799

do (push node (gethash predicate predicate-patterns)))

800

(when (node-covered-predicates node)

801

(push node (gethash (node-covered-predicates node) covering-patterns)))))

802

#+(or) (

803

(print (list predicate-patterns covering-patterns))

804

     (print (list :predicate-pattern-sets (loop for pattern-set being each hash-value of predicate-patterns

805

                                            collect (length pattern-set))))

806

(print (list :covering-pattern-sets (loop for pattern-set being each hash-value of covering-patterns

807

using (hash-key predicates)

808

                                           collect (cons (length pattern-set) predicates)))) )

809

;; link neighbors

810

(loop for path in paths

811

for subject-predicate = (pattern-path-subject-predicate path)

812

for object-predicate = (pattern-path-object-predicate path)

813

for nodes-with-object = (gethash object-predicate predicate-patterns)

814

for nodes-with-subject = (gethash subject-predicate predicate-patterns)

815

do (loop for nwop in nodes-with-object

816

do (loop for nwsp in nodes-with-subject

817

;;if (eq nwop nwsp) do (print (list :reflexive path nwo nws))

818

do (push (make-path-link :path path :destination nwsp)

819

(node-object-links nwop))

820

do (push (make-path-link :path path :destination nwop)

821

(node-subject-links nwsp)))))

822

;; collect the sequence of pattern sets for each intended attribute's predicate,

823

#+(or)

824

(let ((node-list (remove-duplicates (reduce #'append (loop for predicate in predicates

825

                                                            collect (gethash predicate predicate-patterns))))))

826

(print (list :reduced-pattern-sets (length node-list) node-list)))

827

(let ((covering-pattern-sets (loop for pattern-set being each hash-value of covering-patterns

828

collect pattern-set)))

829

(setf covering-pattern-sets

830

             (sort covering-pattern-sets #'< :key #'(lambda (set) (reduce #'+ set :key #'node-count))))

831

;; (print (list :covering-pattern-sets covering-pattern-sets))

832

(let ((collected-paths ()))

833

(labels ((connect-nodes (start-nodes end-nodes)

834

;; clear entire graph

835

(loop for node in nodes do (setf (node-value node) nil))

836

;; derive intermediate paths and respective end nodes

837

(let ((intermediate-paths ()) (new-end-nodes ()))

838

(flet ((collect (path node)

839

                               (setf path (butlast path)) ;; remove the start node

840

(when path

841

(pushnew path intermediate-paths :test #'equal))

842

(pushnew node new-end-nodes)))

843

(declare (dynamic-extent #'collect))

844

(loop for start-node in start-nodes

845

                          for path = (extend-path (list start-node) end-nodes #'collect)))

846

(values intermediate-paths new-end-nodes)))

847

(extend-path (path end-nodes collect)

848

(flet ((extend-to-node (node)

849

(cond ((member node end-nodes)

850

(funcall collect (reverse path) node))

851

((null (node-value node))

852

(setf (node-value node) (node-count node))

853

                                    (extend-path (cons node path) end-nodes collect)))))

854

(loop for link in (node-object-links (first path))

855

for node = (link-destination link)

856

do (extend-to-node node))

857

(loop for link in (node-subject-links (first path))

858

for node = (link-destination link)

859

do (extend-to-node node)))))

860

(loop with start-nodes = (pop covering-pattern-sets)

861

for end-nodes = (pop covering-pattern-sets)

862

until (null end-nodes)

863

;; do (print (list :start-nodes start-nodes))

864

do (multiple-value-bind (intermediates end-nodes)

865

(connect-nodes start-nodes end-nodes)

866

;; (print (list :intermediates-and-ends intermediates end-nodes))

867

(push start-nodes collected-paths)

868

(when intermediates

869

(push (first (sort intermediates #'< :key #'length)) collected-paths))

870

(setf start-nodes end-nodes))

871

finally (push start-nodes collected-paths)))

872

(reverse collected-paths)))))

873

874

#|

875

876

(let* ((predicate-pattern-sets (loop for predicate in predicates

877

                                      collect (gethash predicate predicate-patterns)))

878

            #+(or) ;;; for saam there would be 150493593600 combinations for 21 patterns by 46 predicates

879

(pattern-sets (sort (loop for set in (let ((combinations ()))

880

                                                   (compute-combinations predicate-pattern-sets

881

                                                                         #'(lambda (combo) (push combo combinations)))

882

combinations)

883

                                  collect (sort (remove-duplicates set) #'< :key #'node-count))

884

                                #'< :key #'(lambda (set) (node-count (first set)))))

885

(destinations (sort (remove-duplicates (reduce #'append predicate-pattern-sets))

886

#'< :key #'node-count)))

887

;; attempt to connect all patterns in a given set

888

(print (list :destinations (length destinations)

889

(mapcar #'(lambda (n) (list (ensure-node-subject n)

890

                                                (node-subject-signature n)

891

                                                (node-object-signature n)

892

(node-predicates n)))

893

destinations)))

894

(loop for destination in destinations do (describe destination))

895

(labels ((build-tree (node)

896

(setf (node-value node) (node-count node))

897

(let ((sub-tree (loop for link in (node-object-links node)

898

for destination = (link-pattern link)

899

unless (node-value destination)

900

collect (build-tree destination))))

901

(cons node sub-tree)))

902

(flatten-tree (tree)

903

(cons (first tree) (loop for branch in (rest tree)

904

append (flatten-tree branch)))))

905

906

(let ((all-sets (loop for node = (find-if #'(lambda (node) (null (node-value node)))

907

destinations)

908

while node

909

collect (flatten-tree (build-tree node)))))

910

(print (loop for set in all-sets collect (length set)))

911

(setf all-sets (sort all-sets #'< :key #'length))

912

all-sets)))))

913

|#

914

915

;;; (spocq.i::repository-view-definitions (repository "james/cms"))

916

 ;;; (compute-instance-model (repository-view-definition (repository "james/cms") "topics") mime:application/json)

917

;;; (compute-instance-model (repository "james/cms") mime:application/json)

918

;;; (compute-instance-model (repository "james/cms") mime:image/vnd.dydra.sparql-results+circos+svg+xml)

919

;;; (defparameter *m* (compute-instance-model (account "james") mime:application/json))

920

;;; (view-construct-patterns (repository-view-definition (repository "fbfpt/kombuchadata") "ph_sensor_1"))

921

;;; (view-modify-patterns (repository-view-definition (repository "fbfpt/kombuchadata") "ph_sensor_1"))

922

 ;;; (view-where-patterns (repository-view-definition (repository "fbfpt/kombuchadata") "sugarPercentageReadings"))

923

;;; (compute-instance-model (repository "fbfpt/kombuchadata") mime:application/json)

924

;;; (defparameter *m* (compute-instance-model (account "fbfpt") mime:application/json))

925

;;; (format-json-object *trace-output* *m*)

926

;;; (format-json-compact *trace-output* *m*)

927

 ;;; curl -H "Accept: application/json" -H "Authorization: Bearer $TOKEN" -H "application/json" https://nl4.dydra.com/system/accounts/james

928

 ;;; curl -H "Accept: application/json" -H "Authorization: Bearer $TOKEN" -H "application/json" https://nl4.dydra.com/system/accounts/james/repositories/test

929

930

#+(or)

931

(progn

932

(compute-covering-pattern-sets

933

(list (make-pattern-class :count 5 :predicates '(<http://example.org/p1> <http://example.org/pa>))

934

(make-pattern-class :count 10 :predicates '(<http://example.org/p2> <http://example.org/pb>)))

935

(list (make-pattern-path :count 10

936

                                      :object-predicate <http://example.org/pa> :subject-predicate <http://example.org/pb>))

937

'(<http://example.org/p1> <http://example.org/p2>))

938

939

(compute-pattern-expression

940

(compute-covering-pattern-sets

941

(list (make-pattern-class :count 5 :predicates '(<http://example.org/p1> <http://example.org/pa>))

942

            (make-pattern-class :count 10 :predicates '(<http://example.org/p2> <http://example.org/pb>)))

943

(list (make-pattern-path :count 10

944

                               :object-predicate <http://example.org/pa> :subject-predicate <http://example.org/pb>))

945

'(<http://example.org/p1> <http://example.org/p2>))

946

'((<http://example.org/p1> . ?::p1)

947

(<http://example.org/p2> . ?::p2)

948

(<http://example.org/pa> . ?::pa)

949

(<http://example.org/pb> . ?::pb)))

950

951

(let* ((repository (repository "saam-mirror/saam"))

952

(*print-circle* t)

953

(sets

954

(compute-covering-pattern-sets

955

(remove-if #'spocq.i::pattern-subclasses (spocq.i::repository-pattern-classes repository))

956

(spocq.i::repository-pattern-paths repository)

957

'(<http://edan.si.edu/saam/id/ontologies/PE_lastname>

958

<http://edan.si.edu/saam/id/ontologies/PE_firstname>

959

<http://www.cidoc-crm.org/cidoc-crm/P69_is_associated_with>))))

960

(print (list :sets sets))

961

(length sets))

962

963

(let* ((repository (repository "saam-mirror/saam"))

964

(*print-circle* t)

965

(sets

966

(compute-covering-pattern-sets

967

(remove-if #'spocq.i::pattern-subclasses (spocq.i::repository-pattern-classes repository))

968

(spocq.i::repository-pattern-paths repository)

969

'(<http://edan.si.edu/saam/id/ontologies/PE_lastname>

970

<http://edan.si.edu/saam/id/ontologies/PE_firstname>

971

<http://www.cidoc-crm.org/cidoc-crm/P69_is_associated_with>)))

972

(sparql (compute-pattern-expression sets

973

                                            '((<http://edan.si.edu/saam/id/ontologies/PE_lastname> . "lastname")

974

                                              (<http://edan.si.edu/saam/id/ontologies/PE_firstname> . "firstname")

975

                                              (<http://www.cidoc-crm.org/cidoc-crm/P69_is_associated_with>. "is_associated_with")))))

976

(print-sparql sparql)

977

sparql)

978

979

(let* ((repository (repository "saam-mirror/saam"))

980

(*print-circle* t)

981

(sets

982

(compute-covering-pattern-sets

983

(remove-if #'spocq.i::pattern-subclasses (spocq.i::repository-pattern-classes repository))

984

(spocq.i::repository-pattern-paths repository)

985

'(<http://edan.si.edu/saam/id/ontologies/PE_lastname>

986

<http://edan.si.edu/saam/id/ontologies/PE_firstname>

987

<http://www.cidoc-crm.org/cidoc-crm/P69_is_associated_with>)))

988

(sparql (compute-pattern-expression sets

989

                                            '((<http://edan.si.edu/saam/id/ontologies/PE_lastname> . "lastname")

990

                                              (<http://edan.si.edu/saam/id/ontologies/PE_firstname> . "firstname")

991

                                              (<http://www.cidoc-crm.org/cidoc-crm/P69_is_associated_with>. "is_associated_with")))))

992

(print-sparql sparql)

993

(let ((result (test-sparql sparql :repository-id (repository-id repository))))

994

(list (length result) (subseq result 0 10)))

995

)

996

)

997

998

;;; (test-sparql "select distinct ?p where {?s ?p ?o}" :repository-id "james/cms")

999

;;; (repository-pattern-classes "james/cms")

1000

;;; (repository-pattern-classes "james/test")

1001

;;; (repository-pattern-classes "fbfpt/kombuchadata")

1002

;;; (repository-pattern-classes "nxp/plm")

1003

 ;;; (test-sparql "select (count (distinct ?p) as ?count) from <urn:dydra:all> where {?s ?p ?o}" :repository-id "nxp/plm")

1004

1005

 ;;; (time (length (repository-pattern-paths (repository "nxp/plm")))) ca 40s, 32368029 stmts, 2536605 subjects

1006

;;; (time (compute-instance-model (repository "nexperia/pcn") mime:application/json))

1007

;;; (time (compute-instance-model (repository "nexperia/public-data") mime:application/json))

1008

;;; (time (defparameter *m* (compute-instance-model (account "nexperia") mime:application/json)))

1009

;;; (time (compute-instance-model (repository "nexperia/plm") mime:application/json))

1010

;;; (length (repository-referenced-pattern-classes (repository "nexperia/plm") :abstract t))

1011

;;; (length (repository-pattern-paths (repository "nexperia/plm")))

1012

;;; (length (remove-duplicates (repository-pattern-paths (repository "nexperia/plm"))))

1013

1014

#|

1015

1016

the test target is the account "ui-test", which comprises the repositories

1017

- internal : with a simple foaf pattern

1018

- withServiceClause : with a service clause

1019

- withSubquery : : with a view as the service location

1020

- asImport : with a construct clause and some empty where

1021

1022

(compute-instance-model (account "ui-test") mime:application/json)

1023

(compute-instance-model (repository "ui-test/base") mime:application/json)

1024

 (compute-instance-model (repository-view-definition (repository "ui-test/base") "asImport") mime:application/json)

1025

 (compute-instance-model (repository-view-definition (repository "ui-test/base") "withServiceClause") mime:application/json)

1026

 (compute-instance-model (repository-view-definition (repository "ui-test/base") "withSubquery") mime:application/json)

1027

(view-construct-patterns (repository-view-definition (repository "ui-test/base") "asImport"))

1028

(view-servicereferences (repository-view-definition (repository "ui-test/base") "asImport"))

1029

(view-view-references (repository-view-definition (repository "ui-test/base") "withSubquery"))

1030

1031

(run-sparql-internal "

1032

insert data {

1033

<http://example.org/basePerson>

1034

a foaf:Person ;

1035

foaf:name 'Base Person' ;

1036

foaf:mbox <mailto:base.person@example.org> ;

1037

foaf:homepage <https://dydra.com/ui-test> ;

1038

foaf:knows [

1039

a foaf:Person ;

1040

foaf:name 'ServicePerson'

1041

] .

1042

}

1043

"

1044

:repository-id "ui-test/base"

1045

:agent (system-agent))

1046

1047

(run-sparql-internal "

1048

insert data {

1049

<http://example.org/servicePerson>

1050

a foaf:Person ;

1051

foaf:name 'ServicePerson' ;

1052

foaf:mbox <mailto:service.person@example.org> ;

1053

foaf:homepage <https://dydra.com/ui-test> ;

1054

foaf:knows [

1055

a foaf:Person ;

1056

foaf:name 'Base Person'

1057

] .

1058

}

1059

"

1060

:repository-id "ui-test/service-target"

1061

:agent (system-agent))

1062

|#