Coverage report: /development/source/library/org/datagraph/spocq-shard/src/core/encoding/sparql-results-circos.lisp

Kind	Covered	All	%
expression	0	643	0.0
branch	0	78	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

;;; (load #p"patches/20160512-graphviz/mime-types.lisp")

4

;;; (load #p"patches/20160512-graphviz/sparql-results-circo.lisp")

5

;;; (sb-ext:save-lisp-and-die "sbcl-spocq-jsonld+revisions+dot.core")

6

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

7

8

;;; results+circos serializer

9

;;; http://mkweb.bcgsc.ca/tableviewer/

10

;;; http://circos.ca/

11

;;;

12

13

;;; (load (compile-file "/development/source/library/org/datagraph/spocq/src/core/parameters.lisp"))

14

 ;;; (load (compile-file "/development/source/library/org/datagraph/spocq/src/core/encoding/sparql-results-circo.lisp"))

15

16

;;; output-only

17

18

(:documentation "Circos Encoding"

19

   "In a Circos projection(http://circos.ca), RDF nodes are projected into a sequence, which is arranged in a circle,

20

and links are drawn between the nodes. Variations in the projection

21

- combine nodes to create circos' atomic component (the 'cytogenetic band')

22

- collect nodes into segments circos' first-level elements (the 'chromosome')

23

- array nodes on data tracks

24

- combine segments into clrcle sectors (the 'karyotype')

25

- link immediately among nodes

26

- mediate links through nodes in each solution. (to depict the graph)

27

- selectively enable tracks as link sources and sinks.

28

  according to different criteria and add additional bands within the circle, each of which anchors links

29

for a selected subset of the nodes.

30

31

alternative visualization:

32

- a general overview : http://www.mkbergman.com/414/large-scale-rdf-graph-visualization-tools/

33

- Cytoscape : incompatible with java 1.5

34

- OpenDX : dx does not compile on 10.4

35

- http://www.opendx.org/

36

- http://www-lsp.ujf-grenoble.fr/recherche/a3t2/a3t2a2/bahram/OpenDX/index.html

37

- RDF-Gravity : http://semweb.salzburgresearch.at/apps/rdf-gravity/index.html

38

- loads public repositories, eg http://dydra.com/jhacker/foaf.rdf

39

    - requires rdf+xml, but does not (appear to) specify accept types, which means that, for a construct

40

      or describe query response to succeed, the default response mime type must be application/rdf+xml

41

- SemaSpace : http://residence.aec.at/didi/FLweb/ (requires 3dvia, which requires a restart)

42

  - VisualBrowser : http://nlp.fi.muni.cz/projekty/visualbrowser/index.html (fails to display its own examples)

43

- Walrus : http://www.caida.org/tools/visualization/walrus/ : requires a special file format

44

45

- mizbee : http://www.cs.utah.edu/~miriah/mizbee : chromasome mapping in processing -> js

46

47

  the analogy to gene sequence mapping would be to array on the chromasome ring sequences of 'related' statements.

48

the relation could be

49

- pattern match (identity after wildcard substitution)

50

- membership in a graph (that's wildcard on spo w/ just the graph left to be equal)

51

- vocabulary constituency

52

- network depth

53

")

54

55

(defparameter *circos-node-limit* 512)

56

(defparameter *circos-terms* ()

57

"a list of the terms which serve as the ideogram basis")

58

(defparameter *circos-require-iri-p* nil

59

"when true (default) encode only relations between iri terms")

60

61

(defclass occurrence-collector ()

62

((relations

63

:initform (make-hash-table :test 'equalp)

64

:accessor occurrence-collector-relations)

65

(labels

66

:initform (make-hash-table :test 'equalp)

67

:accessor occurrence-collector-labels)

68

(terms

69

:initform (make-hash-table :test 'equalp) :initarg :terms

70

:accessor occurrence-collector-terms)

71

(label-generator

72

:initform #'write-to-string :initarg :label-generator

73

:accessor occurrence-collector-label-generator)

74

(filter

75

:initform #'(lambda (s p o) (and s p o)) :initarg :filter

76

:accessor occurrence-collector-filter)))

77

78

(defclass direct-occurrence-collector (occurrence-collector)

79

())

80

81

(defun make-direct-occurrence-collector (&rest args)

82

(apply #'make-instance 'direct-occurrence-collector args))

83

84

(defmethod initialize-instance :after ((instance occurrence-collector) &key)

85

#+(or) ;; creates too many insignificant ideograms

86

(loop with relations = (occurrence-collector-relations instance)

87

for term in terms

88

do (progn (occurrence-collector-label instance term)

89

(setf (gethash term relations) nil)))

90

(unless (occurrence-collector-terms instance)

91

(setf (occurrence-collector-terms instance) (make-hash-table :test 'equalp))))

92

93

(defgeneric collect-occurrence (collector from relation to)

94

(:method ((collector direct-occurrence-collector) from (relation t) to)

95

(when (funcall (occurrence-collector-filter collector) from relation to)

96

(let* ((relations (occurrence-collector-relations collector)))

97

(unless (gethash to relations)

98

           ;; ensure it is present as a key with no content, but do not overwrite anything present

99

(setf (gethash to relations) nil))

100

(let ((entry (gethash from relations)))

101

(cond (entry

102

(let ((connection (assoc to entry)))

103

(if connection

104

(incf (rest connection))

105

(setf (gethash from relations) (acons to 1 entry)))))

106

(t

107

;;(print from )

108

(setf (gethash from relations) (acons to 1 nil)))))))))

109

110

(defun occurrence-collector-values (collector)

111

(loop for value being each hash-key of (occurrence-collector-relations collector)

112

for i below *circos-node-limit*

113

collect value))

114

115

(defun occurrence-collector-correlated-values (collector value)

116

(gethash value (occurrence-collector-relations collector)))

117

118

(defun escape-circos-label (label)

119

(loop with escape-count = 0

120

for i below (length label)

121

for char across label

122

;;; it is a rather incapable syntax

123

unless (find char "01234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ-.")

124

do (progn (unless (plusp escape-count)

125

(setf label (copy-seq label)))

126

(setf (char label i) #\.)))

127

label)

128

129

(defgeneric occurrence-collector-label (collector node)

130

(:method ((collector occurrence-collector) node)

131

(or (gethash node (occurrence-collector-labels collector))

132

(let ((label (funcall (occurrence-collector-label-generator collector) node)))

133

(setf label (escape-circos-label label))

134

(when (gethash label (occurrence-collector-terms collector))

135

(setf label (string (gensym label))))

136

(setf (gethash label (occurrence-collector-terms collector)) node)

137

(setf (gethash node (occurrence-collector-labels collector))

138

label)))))

139

140

141

;;; writing - either just bindings

142

143

(defun write-occurrence-table (collector stream)

144

(let ((values (remove-duplicates (occurrence-collector-values collector) :test #'equalp)))

145

(log-debug "write-occurrence-table: x~s values: ~s" (length values) values)

146

(write-string "labels" stream)

147

(loop for from-value in values

148

do (format stream "~a\"~a\"" #\tab (occurrence-collector-label collector from-value)))

149

(loop with cell-count = 0 with connection-count = 0

150

for from-value in values

151

do (progn (format stream "~%\"~a\"" (occurrence-collector-label collector from-value))

152

(loop with to-occurrences = (occurrence-collector-correlated-values collector from-value)

153

for to-value in values

154

for to-occurrence = (rest (assoc to-value to-occurrences :test #'eql))

155

              do (progn (format stream "~a~a" #\tab (if (numberp to-occurrence) to-occurrence "-"))

156

                   (when (numberp to-occurrence) (incf cell-count) (incf connection-count to-occurrence)))))

157

finally (progn (log-debug "write-occurrence-table: cell count: ~s, connection count: ~s"

158

cell-count

159

connection-count)

160

(terpri stream)

161

(return cell-count)))))

162

163

(defgeneric write-sparql-results+circos (results stream &key terms)

164

(:documentation "Encode the result field to the stream as a circos connection table.

165

Return the count of links actually encoded.")

166

167

(:method ((result symbol) (stream t) &key terms)

168

(declare (ignore terms))

169

;; do nothing

170

0)

171

172

(:method ((result list-solution-field) (stream t) &rest args)

173

(apply #'write-sparql-results+circos

174

(cons (list-solution-field-dimensions result)

175

(list-solution-field-solutions result))

176

args))

177

178

(:method ((results cons) (stream t) &key (terms *circos-terms*))

179

(let* ((dimensions (first results))

180

(solutions (rest results))

181

(index 0)

182

(count 0)

183

(start (or (response-offset) 0))

184

(end (response-end))

185

(label-stream (make-string-output-stream))

186

(*expand-literal-values* nil)

187

(*namespace-bindings* (metadata-namespace-bindings *task*)))

188

(flet ((encode-term-label (term)

189

(let ((label ""))

190

(typecase term

191

(iri

192

;; try to parse the iri to eliminate some components, but

193

;; fall back on the full namestring

194

(setf label (or (ignore-errors (iri-label term))

195

(spocq:iri-lexical-form term))))

196

(t

197

(encode-turtle-object term label-stream)

198

(setf label (get-output-stream-string label-stream))))

199

(when (zerop (length label))

200

(log-warn "bad label: ~s" term)

201

(setf label (string (gensym "badlabel"))))

202

label)))

203

(let ((collector (make-direct-occurrence-collector

204

:terms terms

205

:label-generator #'encode-term-label

206

:filter #'(lambda (s p o)

207

(declare (ignore p))

208

(when (or (null *circos-require-iri-p*)

209

                                                 (and (iri-p s) (iri-p o)))

210

(incf count))))))

211

(flet ((put-graph-field ()

212

(log-debug "write-sparql-results+circos: graph field")

213

(loop for solution in solutions

214

for (s p o) = solution

215

until (and end (>= index end))

216

do (incf index)

217

when (> index start)

218

do (collect-occurrence collector s p o)))

219

(put-solution-field ()

220

(log-debug "write-sparql-results+circos: solution field")

221

(dolist (solution solutions)

222

(when (>= index start)

223

(when (and end (>= index end))

224

(return))

225

(loop for values on solution

226

for names on dimensions

227

for from-value = (first values)

228

when from-value

229

do (loop for to-value in (rest values)

230

for to-name in (rest names)

231

when to-value

232

                               do (collect-occurrence collector from-value to-name to-value)))

233

(incf index)))))

234

(log-warn "write-sparql-results+circos: dimensions ~s" dimensions)

235

(cond ((or (equal dimensions *construct-dimensions*)

236

(equal dimensions *quad-dimensions*))

237

(put-graph-field))

238

(dimensions

239

(put-solution-field))

240

(t ; do nothing

241

))

242

(log-warn "write-sparql-results+circos: solutions ~s / ~s" count index)

243

(write-occurrence-table collector stream)

244

(incf-stat *statements-returned* index)

245

count)))))

246

247

(:method ((results boolean-generator) (stream t) &key terms)

248

(declare (ignore terms))

249

;; do nothing

250

0)

251

252

(:method ((results solution-generator) (stream t) &key (terms *circos-terms*))

253

(let* ((dimensions (solution-generator-dimensions results))

254

(channel (solution-generator-channel results))

255

(base-width (length dimensions))

256

(index 0)

257

(count 0)

258

(start (or (response-offset) 0))

259

(end (response-end))

260

(label-stream (make-string-output-stream))

261

(*expand-literal-values* nil)

262

(*namespace-bindings* (metadata-namespace-bindings *task*)))

263

(flet ((encode-term-id-label (term-id)

264

(case term-id

265

(0 "null")

266

(-1 "urn:dydra:default")

267

(-2 "urn:dydra:named")

268

(t (encode-turtle-term-number term-id label-stream)

269

(let ((label (get-output-stream-string label-stream)))

270

(when (repository-term-is-iri *transaction* term-id)

271

(setf label (or (ignore-errors (iri-label label))

272

label)))

273

(when (zerop (length label))

274

(log-warn "bad label: ~s" term-id)

275

(setf label (string (gensym "label"))))

276

label)))))

277

(let ((collector (make-direct-occurrence-collector

278

:terms terms

279

:label-generator #'encode-term-id-label

280

:filter #'(lambda (s p o)

281

(declare (ignore p))

282

(when (or (null *circos-require-iri-p*)

283

                                                 (and (repository-term-is-iri *transaction* s)

284

                                                      (repository-term-is-iri *transaction* o)))

285

(incf count))))))

286

(flet ((do-solution-pages ()

287

(do-pages (page channel)

288

(cond ((and (= base-width (array-dimension page 1))

289

(= (length (array-dimensions page)) 2))

290

(if (and end (>= index end))

291

(return)

292

                                 (if (>= (+ index (array-dimension page 0)) start)

293

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

294

(when (>= index start)

295

(when (and end (>= index end))

296

(return))

297

                                         (loop for from-index from 0 below base-width

298

for names on dimensions

299

                                           for from-value = (aref page page-index from-index)

300

when (plusp from-value)

301

                                           do (loop for to-index from (1+ from-index) below base-width

302

for name in names

303

                                                for to-value = (aref page page-index to-index)

304

when (plusp to-value)

305

                                                ;; no need to externalize, they are just counted

306

                                                do (collect-occurrence collector from-value name to-value))))

307

(incf index))

308

; otherwise skip the entire page

309

(incf index (array-dimension page 0)))))

310

(t

311

(log-warn "field width mismatch: ~s : ~s."

312

dimensions (array-dimension page 1))))

313

(incf index (array-dimension page 0))))

314

(do-graph-pages ()

315

(do-pages (page channel)

316

(cond ((and (= base-width (array-dimension page 1))

317

(= (length (array-dimensions page)) 2))

318

(if (and end (>= index end))

319

(return)

320

                                 (if (>= (+ index (array-dimension page 0)) start)

321

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

322

(when (>= index start)

323

(when (and end (>= index end))

324

(return))

325

                                         (let* ((s-id (aref page page-index 0))

326

                                                (p-id (aref page page-index 1))

327

                                                (o-id (aref page page-index 2))) ;; ignore graph

328

(when (plusp o-id)

329

                                             (collect-occurrence collector s-id p-id o-id))))

330

(incf index))

331

; otherwise skip the entire page

332

(incf index (array-dimension page 0)))))

333

(t

334

(log-warn "field width mismatch: ~s : ~s."

335

dimensions (array-dimension page 1))))

336

(incf index (array-dimension page 0)))))

337

(log-warn "write-sparql-results+circos: dimensions ~s" dimensions)

338

(cond ((or (equal dimensions *construct-dimensions*)

339

(equal dimensions *quad-dimensions*))

340

(do-graph-pages))

341

(dimensions

342

(do-solution-pages))

343

(t ; do nothing

344

)))

345

(log-warn "write-sparql-results+circos: solutions ~s / ~s" count index)

346

(write-occurrence-table collector stream)

347

(incf-stat *statements-returned* index)

348

count)))))

349

350

;;;

351

;;;

352

353

 (defmethod send-response-message (operation (message t) (stream t) (content-type mime:*/sparql-results+circos))

354

"Given a MESSAGE, and a STREAM with a generic circos CONTENT-TYPE, encode as a circos data table"

355

(when *encoding-trace-output*

356

(setf stream (make-broadcast-stream *encoding-trace-output* stream)))

357

(let ((*package* *spocq-reader-package*))

358

(write-sparql-results+circos message stream)))

359

360

(defmethod send-response-message ((operation t) (generator t) (stream t) (content-type mime:image/circos))

361

   "Given a solution field, emit the results as a circos tabular document and render that as an image"

362

(let ((pathname (tmp-export-pathname (account (repository-account *repository*))

363

(repository *repository*))))

364

(unwind-protect

365

(when (plusp (with-open-file (tsv-stream pathname :direction :output

366

:if-exists :error

367

                                                  :if-does-not-exist :create)

368

(call-next-method operation generator tsv-stream content-type)))

369

;; require encoded content before rendering

370

(render-circos-file pathname stream content-type))

371

(conditional-delete-file pathname))))

372

373

(defun circos-executable-pathname ()

374

(concatenate 'string "/opt/rails/script/circos/circos-table"))

375

376

(defgeneric render-circos-file (from to media-type)

377

;; type eventually to allow png v/s svg

378

(:method ((from pathname) (to stream) (type string))

379

(let ((process (run-program "/bin/bash"

380

(list (circos-executable-pathname)

381

(namestring from)

382

"/dev/stdout"

383

)

384

:output to

385

:wait t)))

386

(cond (process

387

(case (run-program-exit-code process)

388

(0 )

389

(t

390

(write-string (read-file from) *trace-output*)

391

(let ((content (read-file from)))

392

(write-string content to))

393

(error "circos generation failed: ~s." (run-program-exit-code process))))

394

(run-program-close process))

395

(t

396

(error "circos generation failed.")))))

397

(:method ((from t) (to pathname) (type string))

398

(with-open-file (stream to :direction :output)

399

(render-circos-file from stream type)))

400

401

(:method ((from t) (to t) (type mime:image/circos))

402

(render-circos-file from to (de.setf.utility.implementation::mime-type-file-type type))))

403

404

(defgeneric circos-sparql (query pathname &rest args)

405

(:method ((query t) (destination pathname) &rest args)

406

(with-open-file (output-stream destination :direction :output

407

:element-type 'character

408

                                    :if-does-not-exist :create :if-exists :supersede)

409

(apply #'circos-sparql query output-stream args)))

410

(:method ((query t) (destination stream) &rest args)

411

(let* ((type (pathname-type destination))

412

(response-content-type (cond ((equalp type "txt") MIME:APPLICATION/SPARQL-RESULTS+CIRCOS)

413

                                         ((equalp type "svg") MIME:IMAGE/VND.DYDRA.SPARQL-RESULTS+CIRCOS+SVG+XML)

414

                                         (t (error "anomalous file type: ~s" type)))))

415

(multiple-value-bind (results dimensions *task*)

416

(apply #'run-sparql query args)

417

(let ((*expand-literal-values* nil)

418

(*repository* (task-repository *task*)))

419

(with-accounting

420

; (write-sparql-results+circos (cons dimensions results) destination)

421

               (send-response-message :query (cons dimensions results) destination response-content-type)))))))

422

#|

423

(write-sparql-results+circos '((?::a ?::b) (1 2) (1 1) (3 1)) *trace-output*)

424

425

(circos-sparql "select ?s ?p ?o where {?s ?p ?o}" #p"/tmp/test.txt" :repository-id "schema/owl")

426

(render-circos-file #p"/tmp/test.txt" #p"/tmp/test.svg" "svg")

427

428

429

(circos-sparql "SELECT * WHERE {

430

?p rdfs:comment ?c

431

FILTER regex(str(?c), '[^.;>]\\\\s*$')

432

}" #p"/tmp/test.txt" :repository-id "danbri/schema-org")

433

434

(ORG.DATAGRAPH.SPOCQ.IMPLEMENTATION::WRITE-SPARQL-RESULTS+CIRCOS

435

'((?::|c| ?::|p|)

436

        ("UserInteraction and its subtypes is an old way of talking about users interacting with pages. It is generally better to use

437

           <a href=\"/Action\">Action</a>-based vocabulary, alongside types such as <a href=\"/Comment\">Comment</a>.

438

"

439

<http://schema.org/UserComments>))

440

*trace-output*)

441

442

(compute-instance-model (repository "saam-mirror/saam") mime:application/json)

443

444

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

445

446

(repository-referenced-pattern-classes (repository "saam-mirror/saam"))

447

448

(repository-pattern-classes (repository "saam-mirror/saam"))

449

450

 curl https://de17.dydra.com/system/accounts/saam-mirror/repositories/saam   -H "Accept: image/vnd.dydra.sparql-results+circos+svg+xml"

451

 curl https://de17.dydra.com/system/accounts/saam-mirror/repositories/saam   -H "Accept: text/sparql-results+circos"

452

453

454

(write-sparql-results+circos (cons *construct-dimensions*

455

'((a s d)

456

(a s b)))

457

*trace-output*)

458

459

(send-response-message :query (cons *construct-dimensions*

460

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

461

                                      (<http://example.org/s> <http://example.org/p2> <http://example.org/o2>)))

462

*trace-output*

463

mime:*/sparql-results+circos)

464

465

(let ((*repository* (repository "test/test")))

466

(send-response-message :query (cons *construct-dimensions*

467

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

468

                                      (<http://example.org/s> <http://example.org/p2> <http://example.org/o2>)))

469

*trace-output*

470

mime:image/vnd.dydra.sparql-results+circos+svg+xml))

471

472

 (with-open-file (output "/tmp/circos-select.txt" :direction :output :if-exists :supersede :if-does-not-exist :create)

473

(send-response-message :query (compute-instance-model (repository "saam-mirror/saam")

474

                                  (mime-type "image/vnd.dydra.sparql-results+circos+svg+xml;profile=http://spinrdf.org/sp#Select"))

475

output

476

mime:*/sparql-results+circos))

477

478

 (with-open-file (output "/tmp/circos-graph.txt" :direction :output :if-exists :supersede :if-does-not-exist :create)

479

(send-response-message :query (compute-instance-model (repository "saam-mirror/saam")

480

                                                       (mime-type "image/vnd.dydra.sparql-results+circos+svg+xml;profile=http://spinrdf.org/sp#Construct"))

481

output

482

mime:*/sparql-results+circos))

483

484

(let ((*repository* (repository "test/test")))

485

(send-response-message :query (cons *construct-dimensions*

486

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

487

*trace-output*

488

mime:image/vnd.dydra.sparql-results+circos+svg+xml))

489

490

491

492

493

|#