blob: 7854cfeb887e94516abc7d004bd98cc9c707bc48 (
plain)
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
|
(define-module (gn data strains)
#:use-module (dbi dbi)
#:use-module (gn cache memoize)
#:use-module (gn data group)
#:use-module (gn db mysql)
#:use-module (gn util convert)
#:use-module (ice-9 format)
#:use-module (ice-9 iconv)
#:use-module (ice-9 match)
#:use-module (ice-9 receive)
#:use-module (ice-9 string-fun)
#:use-module (json)
#:use-module (web gn-uri)
#:export (
strain-id-names
is-a-bxd?
has-bxd?
bxd-strain-id-names
memo-bxd-strain-id-names
))
(define* (strain-id-names inbred-set #:key (used-for-mapping? #t))
"Return assoc list of tuples of strain id+names:
((4 . BXD1) (5 . BXD2) (6 . BXD5) (7 . BXD6)...
used-for-mapping? will say whether the strains/individuals are used for mapping. Always True, FIXME
"
(call-with-db
(lambda (db)
(dbi-query db (string-append "SELECT StrainId,Strain.Name FROM Strain, StrainXRef WHERE StrainXRef.StrainId = Strain.Id AND StrainXRef.InbredSetId = " (int-to-string inbred-set)
(if used-for-mapping?
" AND Used_for_mapping='Y'"
"")
" ORDER BY StrainId;"))
(get-rows-apply db (lambda (r) `(,(assoc-ref r "StrainId") . ,(assoc-ref r "Name"))) '()))))
(define* (bxd-strain-id-names #:key (used-for-mapping? #f))
"Return assoc list of tuples of strain id + names. Same as strain-id-names, but just for the BXD
used-for-mapping? will say whether the strains/individuals are used for mapping. Always True, FIXME"
(filter (lambda (l) l)
(map (lambda (l)
(let [(id (car l))
(name (cdr l))]
(if (or (< id 42) (string-contains name "BXD"))
l
#f))
) (strain-id-names 1 #:used-for-mapping? used-for-mapping?))))
(define memo-bxd-strain-id-names
(memoize bxd-strain-id-names))
(define (is-a-bxd? strain-id)
"Is a strain a member of the BXD? For speed we memoize tuples from the DB. Note that we check the DB list, as
well as the name. This won't work for the parents. We do it this way because the GN table is wrong."
(match (assoc strain-id (memo-bxd-strain-id-names))
[(id . name) (string-contains name "BXD")]
))
(define (has-bxd? trait-values)
"Walk tuples of trait strain-id and value. Check we have at least one BXD. Stops at the first match"
(match trait-values
[(trait . rest) (match trait
[(strain-id . value) (if (is-a-bxd? strain-id)
#t
(has-bxd? rest))])]
[() #f]))
|
