aboutsummaryrefslogtreecommitdiff
path: root/gn
diff options
context:
space:
mode:
Diffstat (limited to 'gn')
-rw-r--r--gn/data/strains.scm54
1 files changed, 39 insertions, 15 deletions
diff --git a/gn/data/strains.scm b/gn/data/strains.scm
index 4a251d4..7854cfe 100644
--- a/gn/data/strains.scm
+++ b/gn/data/strains.scm
@@ -1,20 +1,23 @@
(define-module (gn data strains)
- #:use-module (json)
- #:use-module (ice-9 match)
- #:use-module (ice-9 format)
- #:use-module (ice-9 iconv)
- #:use-module (ice-9 receive)
- #:use-module (ice-9 string-fun)
- ;; #:use-module (gn db sparql)
#: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))
@@ -27,20 +30,41 @@ used-for-mapping? will say whether the strains/individuals are used for mapping.
(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'"
+ " 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?))))
+ (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]))