aboutsummaryrefslogtreecommitdiff
path: root/gn
diff options
context:
space:
mode:
Diffstat (limited to 'gn')
-rw-r--r--gn/data/strains.scm17
-rw-r--r--gn/db/mysql.scm4
2 files changed, 14 insertions, 7 deletions
diff --git a/gn/data/strains.scm b/gn/data/strains.scm
index f1348ac..4a251d4 100644
--- a/gn/data/strains.scm
+++ b/gn/data/strains.scm
@@ -17,17 +17,17 @@
bxd-strain-id-names
))
-(define* (strain-id-names inbred-set #:key (used-for-mapping? #f))
+(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.
+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'"
+ ;; " AND Used_for_mapping='Y'"
"")
" ORDER BY StrainId;"))
(get-rows-apply db (lambda (r) `(,(assoc-ref r "StrainId") . ,(assoc-ref r "Name"))) '()))))
@@ -35,5 +35,12 @@ used-for-mapping? will say whether the strains/individuals are used for mapping.
(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."
- (strain-id-names 1))
+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?))))
diff --git a/gn/db/mysql.scm b/gn/db/mysql.scm
index 66f28db..ccd414a 100644
--- a/gn/db/mysql.scm
+++ b/gn/db/mysql.scm
@@ -29,8 +29,8 @@
(define (db-open)
(begin
- (display "===> OPENING DB")
- (newline)
+ ;; (display "===> OPENING DB")
+ ;; (newline)
(let [(db (dbi-open "mysql" "webqtlout:webqtlout:db_webqtl:tcp:127.0.0.1:3306"))]
(ensure db)
db