forked from webyrd/mediKanren
-
Notifications
You must be signed in to change notification settings - Fork 0
/
common.rkt
111 lines (95 loc) · 3.52 KB
/
common.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
#lang racket/base
(provide (all-from-out "base.rkt"
"db/semmed.rkt"
"db/rtx2-20210204.rkt"
"db/kgx-synonym.rkt") ; workaround:
; so long as KGX_synonym isn't specified in config.scm
; this won't signal an error even if KGX isn't present
cprop edge eprop
triple quad triple/eid is-a is-a/quad triple-property
write-list-to-tsv)
(require "base.rkt"
racket/dict
(prefix-in semmed: "db/semmed.rkt")
(prefix-in rtx: "db/rtx2-20210204.rkt")
(prefix-in kgx: "db/kgx-synonym.rkt"))
(printf "Configuration says to load these databases: ~s\n" (cfg:config-ref 'databases))
(for ((kgid (cfg:config-ref 'databases)))
(unless (dict-has-key? (cfg:config-ref 'version-for-database) kgid)
(printf "Warning: no version-for-database information for ~a (check etc/config.installer.scm)\n" kgid)))
(for-each database-load! (cfg:config-ref 'databases))
;; TODO: define higher-level relations over the db-specific relations
(define cprop (dynamic-relation 'cprop))
;; tag argument 0 (the edge id) with database name
(define edge (dynamic-relation 'edge 0))
(define eprop (dynamic-relation 'eprop 0))
;; Semantic-web flavored relations
(define-relation (rtx:triple s p o)
(fresh (id)
(rtx:eprop id "predicate" p)
(rtx:edge id s o)))
(define-relation (semmed:triple s p o)
(fresh (id)
(semmed:eprop id "edge_label" p)
(semmed:edge id s o)))
(define-relation (triple s p o)
(conde ((rtx:triple s p o))
((semmed:triple s p o))))
(define-relation (quad graph s p o)
(fresh (id)
(conde ((== graph rtx:kgid)
(rtx:triple s p o))
((== graph 'semmed)
(semmed:triple s p o)))))
(define-relation (triple/eid eid s p o)
(fresh (id graph)
(== eid `(,graph . ,id))
(conde ((== graph rtx:kgid)
(rtx:eprop id "predicate" p)
(rtx:edge id s o))
((== graph 'semmed)
(semmed:eprop id "edge_label" p)
(semmed:edge id s o)))))
(define-relation (is-a s c)
(cprop s "category" c))
(define-relation (is-a/quad graph s c)
(conde ((== graph rtx:kgid)
(rtx:cprop s "category" c))
((== graph 'semmed)
(semmed:cprop s "category" c))))
(define-relation (triple-property s p o k v)
(fresh (eid id graph)
(== eid `(,graph . ,id))
(conde ((== graph rtx:kgid)
(rtx:eprop id "predicate" p)
(rtx:edge id s o)
(rtx:eprop id k v))
((== graph 'semmed)
(semmed:eprop id "edge_label" p)
(semmed:edge id s o)
(semmed:eprop id k v)))))
(define-relation (edge-predicate eid p)
(eprop eid "predicate" p))
;; usage:
;(run*/set/steps 500 x (syn* "HGNC:5993" x))
(define write-list-to-tsv
(lambda (header-ls lol path)
(with-output-to-file path
;; thunk -- procedure that takes no arguments
(lambda ()
(for-each
(lambda (l)
(let loop ([l l])
(cond
((null? l)
(error 'output-to-tsv "where's the data!?"))
((null? (cdr l)) ;; l contains exactly 1 element
(display (car l))
(display #\newline))
(else
(display (car l))
(display #\tab)
(loop (cdr l))))))
(cons header-ls lol)))
#:mode 'text
#:exists 'replace)))