diff options
Diffstat (limited to 'gn')
| -rw-r--r-- | gn/data/strains.scm | 54 |
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])) |