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
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
|
#! /usr/bin/env guile
!#
(add-to-load-path (dirname (current-filename)))
(use-modules (rnrs io ports)
(srfi srfi-1)
(srfi srfi-26)
(ice-9 match)
(ice-9 string-fun)
(dump sql))
;;; GeneNetwork database connection parameters and dump path
(define (call-with-genenetwork-database proc)
(let ((connection-settings (call-with-input-file "conn.scm" read)))
(call-with-database "mysql" (string-join
(list (assq-ref connection-settings 'username)
(assq-ref connection-settings 'password)
(assq-ref connection-settings 'database)
"tcp"
(assq-ref connection-settings 'host)
(number->string
(assq-ref connection-settings 'port)))
":")
proc)))
(define %dump-directory
(string-append (getenv "HOME") "/data/dump"))
(define (call-with-dump-file filename proc)
(let ((absolute-path (string-append %dump-directory filename)))
(display absolute-path)
(newline)
(call-with-output-file absolute-path proc)))
;; Dump schema annotations to org
(define (get-tables-from-comments db)
(sql-map (match-lambda
((("TableName" . table)) table))
db
"SELECT TableName FROM TableComments"))
(define (dump-table-fields db table)
(format #t "* ~a~%" table)
(match (sql-find db (format #f "SELECT Comment FROM TableComments WHERE TableName = '~a'"
table))
((("Comment" . comment))
(format #t "~a~%" comment)))
(sql-for-each (lambda (row)
(match row
((("TableField" . table-field)
("Foreign_Key" . foreign-key)
("Annotation" . annotation))
(format #t "** ~a~%" (substring table-field (1+ (string-length table))))
(unless (string-null? foreign-key)
(format #t "Foreign key to ~a~%" foreign-key))
(unless (string-null? annotation)
(display annotation)
(newline)))))
db
(format #f "SELECT TableField, Foreign_Key, Annotation FROM TableFieldAnnotation WHERE TableField LIKE '~a.%'"
table))
(newline))
(define (dump-schema-annotations db)
(call-with-genenetwork-database
(lambda (db)
(for-each (cut dump-table-fields db <>)
(get-tables-from-comments db)))))
;;; Dump tables
(define (delete-substrings str . substrings)
(fold (lambda (substring result)
(string-replace-substring result substring ""))
str
substrings))
(define (snake->lower-camel str)
(let ((char-list (string->list str)))
(call-with-output-string
(lambda (port)
(put-char port (char-downcase (string-ref str 0)))
(map (lambda (char previous-char)
(unless (char=? char #\_)
(put-char port (if (char=? previous-char #\_)
(char-upcase char)
char))))
(drop char-list 1)
char-list)))))
(define (camel->lower-camel str)
(string-append (string-downcase (substring str 0 1))
(substring str 1)))
(define (scm->triples alist id)
(for-each (match-lambda
((predicate . object)
(triple id predicate object)))
alist))
(define (process-metadata-alist alist)
(filter-map (match-lambda
((key . "") #f)
((key . value)
(cons (string->symbol
(string-append
"gn:" (camel->lower-camel
(snake->lower-camel key))))
value)))
alist))
(define (triple subject predicate object)
(format #t "~a ~a ~s .~%" subject predicate object))
(define (binomial-name->species-id binomial-name)
(string->symbol
(string-append "gn:" (string-replace-substring binomial-name " " "_"))))
(define (dump-species db)
(sql-for-each (lambda (alist)
(match alist
(((_ . common-name)
(_ . menu-name)
(_ . binomial-name))
(let ((id (binomial-name->species-id binomial-name)))
(triple id 'rdf:type 'gn:species)
;; Common name
(triple id 'gn:name common-name)
;; Menu name (TODO: Maybe, drop this
;; field. It can be inferred from the
;; common name.)
(triple id 'gn:menuName menu-name)
;; Binomial name
(triple id 'gn:binomialName binomial-name)))))
db
"SELECT SpeciesName, MenuName, FullName FROM Species"))
(define (dump-strain db)
(sql-for-each (lambda (alist)
(match alist
(((_ . binomial-name)
(_ . name)
(_ . name2)
(_ . symbol)
(_ . alias))
(let ((id
;; TODO: Ensure this identifier does not collide.
(string-append "gn:"
(string-map (lambda (c)
(case c
((#\/ #\< #\> #\+ #\( #\) #\space) #\_)
(else c)))
name))))
(triple id 'rdf:type 'gn:strain)
;; The species this is a strain of
(triple id 'gn:strainOfSpecies
(binomial-name->species-id binomial-name))
;; Name
(triple id 'gn:name name)
;; A second name, if there is one
(unless (string=? name name2)
(triple id 'gn:name name2))
;; Symbol, if there is one
(unless (string-null? symbol)
(triple id 'gn:symbol symbol))
;; Alias, if there is one
(unless (string-null? alias)
(triple id 'gn:alias alias))))))
db
"SELECT Species.FullName, Strain.Name, Strain.Name2, Strain.Symbol, Strain.Alias FROM Strain JOIN Species ON Strain.SpeciesId = Species.SpeciesId"))
;; TODO: This function is unused. Remove if not required.
(define (mapping-method-name->id name)
(string->symbol (string-append "gn:mappingMethod" name)))
;; TODO: This function is unused. Remove if not required.
(define (dump-mapping-method db)
(sql-for-each (match-lambda
(((_ . name))
(triple (string-append "gn:mappingMethod" name)
'rdf:type 'gn:mappingMethod)))
db
"SELECT Name FROM MappingMethod"))
(define (inbred-set-name->id name)
(string->symbol (string-append "gn:inbredSet" name)))
(define (dump-inbred-set db)
(sql-for-each (lambda (alist)
(let ((id (inbred-set-name->id (assoc-ref alist "Name"))))
(triple id 'rdf:type 'gn:phenotype)
(scm->triples
(filter-map (match-lambda
(('gn:binomialName . binomial-name)
(cons 'gn:inbredSetOfSpecies
(binomial-name->species-id binomial-name)))
(x x))
(process-metadata-alist alist))
id)))
db
"SELECT InbredSet.Name, InbredSet.FullName, GeneticType, Family,
Species.FullName AS BinomialName
FROM InbredSet
INNER JOIN Species USING (SpeciesId)"))
(define (phenotype-id->id id)
(string->symbol (string-append "gn:phenotype" (number->string id))))
(define (dump-phenotype db)
(sql-for-each (lambda (alist)
(let ((id (phenotype-id->id (assoc-ref alist "Id"))))
(triple id 'rdf:type 'gn:phenotype)
(scm->triples
(filter (match-lambda
(('gn:id . _) #f)
(('gn:units . value)
(string-ci=? value "unknown"))
(_ #t))
(process-metadata-alist alist))
id)))
db
"SELECT Id, Pre_publication_description, Post_publication_description,
Original_description, Units, Pre_publication_abbreviation, Post_publication_abbreviation,
Lab_code, Submitter, Owner, Authorized_Users FROM Phenotype"))
(define (dump-publication db)
(sql-for-each (lambda (alist)
(let ((id (string-append "gn:publication"
(number->string (assoc-ref alist "Id")))))
(triple id 'rdf:type 'gn:publication)
(scm->triples
(append-map (match-lambda
(('gn:id . _) '())
;; The authors field is a comma
;; separated list. Split it.
(('gn:authors . authors)
(map (lambda (author-name)
(cons 'gn:author (string-trim author-name)))
(string-split authors #\,)))
(('gn:abstract . abstract)
;; TODO: Handle unprintable
;; characters better.
(list (cons 'gn:abstract
(delete-substrings abstract "\x01"))))
(x (list x)))
(process-metadata-alist alist))
id)))
db
"SELECT Id, PubMed_ID, Abstract, Authors, Title, Journal, Volume, Pages, Month, Year FROM Publication"))
(define (dump-publish-xref db)
(sql-for-each (match-lambda
(((_ . inbred-set-name)
(_ . phenotype-id))
(triple (phenotype-id->id phenotype-id)
'gn:phenotypeOfSpecies
(inbred-set-name->id inbred-set-name))))
db
"SELECT Name, PhenotypeId
FROM PublishXRef
INNER JOIN InbredSet USING (InbredSetId)"))
(define (tissue-short-name->id short-name)
(string->symbol (string-append "gn:tissue" short-name)))
(define (dump-tissue db)
;; The Name and TissueName fields seem to be identical. BIRN_lex_ID
;; and BIRN_lex_Name are mostly NULL.
(sql-for-each (match-lambda
(((_ . name)
(_ . short-name))
;; Hopefully the Short_Name field is distinct and
;; can be used as an identifier.
(let ((id (tissue-short-name->id short-name)))
(triple id 'rdf:type 'gn:tissue)
(triple id 'gn:name name))))
db
"SELECT Name, Short_Name FROM Tissue"))
;; One email ID in the Investigators table has spaces in it. This
;; function fixes that.
(define (fix-email-id email)
(string-replace-substring email " " ""))
(define (investigator-email->id email)
(string->symbol
(string-append "gn:investigator"
(string-replace-substring
(fix-email-id email) "@" "_"))))
(define (dump-investigators db)
(sql-for-each (lambda (alist)
(let ((id (investigator-email->id (assoc-ref alist "Email"))))
(triple id 'rdf:type 'foaf:Person)
(scm->triples
(cons (cons 'foaf:name (string-append
(assoc-ref alist "FirstName")
" " (assoc-ref alist "LastName")))
(map (match-lambda
(('gn:firstName . first-name)
(cons 'foaf:givenName first-name))
(('gn:lastName . last-name)
(cons 'foaf:familyName last-name))
(('gn:phone . phone)
(cons 'foaf:phone phone))
(('gn:email . email)
(cons 'foaf:mbox (fix-email-id email)))
(('gn:url . url)
(cons 'foaf:homepage url))
(x x))
(process-metadata-alist alist)))
id)))
db
;; There are a few duplicate entries. We group by
;; email to deduplicate.
;; TODO: Find email ID for records with none. (This is
;; just one record corresponding to "Evan Williams")
"SELECT FirstName, LastName, Address, City, State, ZipCode, Phone, Email, Country, Url FROM Investigators
WHERE Email != ''
GROUP BY Email"))
(define (avg-method-name->id name)
(string->symbol
(string-append "gn:avgmethod"
(string-replace-substring
(string-replace-substring
(string-downcase name) " " "_")
"/" "_"))))
(define (dump-avg-method db)
(sql-for-each (match-lambda
(((_ . name))
(let ((id (avg-method-name->id name)))
(triple id 'rdf:type 'gn:avgMethod)
(triple id 'gn:name name))))
db
;; The Name and Normalization fields seem to be the
;; same. Dump only the Name field.
;;
;; There are two records with Name as
;; "N/A". Deduplicate.
"SELECT DISTINCT Name FROM AvgMethod"))
(define (gene-chip-name->id name)
(string->symbol
(string-replace-substring (string-append "gn:platform" name)
" " "_")))
(define (dump-gene-chip db)
(sql-for-each (match-lambda
(((_ . gene-chip-name)
(_ . name))
(let ((id (gene-chip-name->id name)))
(triple id 'rdf:type 'gn:platform)
(triple id 'gn:name gene-chip-name))))
db
"SELECT GeneChipName, Name FROM GeneChip"))
(define (dump-info-files db)
(sql-for-each (lambda (alist)
(let ((id (string-append "gn:dataset"
(number->string
(assoc-ref alist "GN_AccesionId")))))
(triple id 'rdf:type 'gn:dataset)
(scm->triples
(filter-map (match-lambda
(('gn:gNAccesionId . accession-id)
(cons 'gn:accessionId
(string-append "GN" (number->string accession-id))))
(('gn:datasetStatusName . status)
(cons 'gn:datasetStatus
(string-downcase status)))
(('gn:binomialName . binomial-name)
(cons 'gn:datasetOfSpecies
(binomial-name->species-id binomial-name)))
(('gn:inbredSetName . inbred-set-name)
(cons 'gn:datasetOfInbredSet
(inbred-set-name->id inbred-set-name)))
(('gn:shortName . short-name)
(cons 'gn:datasetOfTissue
(tissue-short-name->id short-name)))
(('gn:email . email)
(cons 'gn:datasetOfInvestigator
(investigator-email->id email)))
(('gn:avgMethodName . avg-method-name)
(cons 'gn:normalization
(avg-method-name->id avg-method-name)))
(('gn:geneChip . name)
(cons 'gn:datasetOfPlatform
(gene-chip-name->id name)))
(('gn:summary . summary)
;; TODO: Why are there unprintable
;; characters in the summary?
(cons 'gn:summary
(delete-substrings summary "\x01" "\x03")))
(('gn:aboutTissue . about-tissue)
;; TODO: Why are there unprintable
;; characters in the summary?
(cons 'gn:aboutTissue
(delete-substrings about-tissue "\x01" "\x03")))
(('gn:geoSeries . geo-series)
(and (not (string-prefix-ci? "no geo series" geo-series))
(cons 'gn:geoSeries geo-series)))
(x x))
(process-metadata-alist alist))
id)))
db
;; TODO: Find email ID for records with none. (This is
;; just one record corresponding to "Evan Williams")
;; TODO: Double check Platforms. It doesn't seem to
;; match up.
"SELECT GN_AccesionId, InfoPageTitle AS Name, InfoFiles.Title,
Specifics, DatasetStatusName,
Datasets.DatasetName AS DatasetGroup, Datasets.Summary, Datasets.GeoSeries, Datasets.AboutCases,
Datasets.AboutPlatform, Datasets.AboutTissue, Datasets.AboutDataProcessing,
Datasets.Notes, Datasets.ExperimentDesign, Datasets.Contributors,
Datasets.Citation, Datasets.Acknowledgment,
Species.FullName AS BinomialName,
InbredSet.Name AS InbredSetName,
Tissue.Short_Name,
Investigators.Email,
AvgMethod.Name AS AvgMethodName,
GeneChip.Name AS GeneChip
FROM InfoFiles
LEFT JOIN Datasets USING (DatasetId)
LEFT JOIN DatasetStatus USING (DatasetStatusId)
LEFT JOIN Species USING (SpeciesId)
LEFT JOIN InbredSet USING (InbredSetId)
LEFT JOIN Tissue USING (TissueId)
LEFT JOIN Investigators USING (InvestigatorId)
LEFT JOIN AvgMethod USING (AvgMethodId)
LEFT JOIN GeneChip USING (GeneChipId)
WHERE Investigators.Email != ''"))
(define (dump-data-table db table-name data-field)
(let ((dump-directory (string-append %dump-directory "/" table-name))
(port #f)
(current-strain-id #f))
(unless (file-exists? dump-directory)
(mkdir dump-directory))
(sql-for-each (match-lambda
(((_ . strain-id)
(_ . value))
;; Close file if new strain.
(when (and port
(not (= current-strain-id strain-id)))
(close-port port)
(set! port #f))
;; If no file is open, open new file.
(unless port
(set! current-strain-id strain-id)
(let ((filename (string-append dump-directory
"/" (number->string strain-id))))
(display filename (current-error-port))
(newline (current-error-port))
(set! port (open-output-file filename))))
(display value port)
(newline port)))
db
(format #f "SELECT StrainId, ~a FROM ~a ORDER BY StrainId"
data-field table-name))
(close-port port)))
(define (prefix prefix iri)
(format #t "@prefix ~a ~a .~%" prefix iri))
(call-with-genenetwork-database
(lambda (db)
(with-output-to-file (string-append %dump-directory "/dump.ttl")
(lambda ()
(prefix "rdf:" "<http://www.w3.org/1999/02/22-rdf-syntax-ns#>")
(prefix "foaf:" "<http://xmlns.com/foaf/0.1/>")
(prefix "gn:" "<http://genenetwork.org/>")
(newline)
(dump-species db)
(dump-strain db)
(dump-mapping-method db)
(dump-inbred-set db)
(dump-phenotype db)
(dump-publication db)
(dump-publish-xref db)
(dump-tissue db)
(dump-investigators db)
(dump-avg-method db)
(dump-gene-chip db)
(dump-info-files db)))))
|