Reorganize DB handler and fetch first dataset

4 files changed, 45 insertions, 90 deletions

diff --git a/gn/data/hits.scm b/gn/data/hits.scm
new file mode 100644
index 0000000..91be81f
--- /dev/null
+++ b/gn/data/hits.scm
@@ -0,0 +1,15 @@
+(define-module (gn data hits)
+  #: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 db mysql)
+  #:use-module (gn data group)
+  #:use-module (web gn-uri)
+
+  #:export (
+            ))
diff --git a/gn/data/strains.scm b/gn/data/strains.scm
index b3e6744..241ecda 100644
--- a/gn/data/strains.scm
+++ b/gn/data/strains.scm
@@ -17,9 +17,10 @@
             ))
 
 (define* (strain-id-names inbred-set #:key (map? #f))
-  "Return assoc list of tuples of strain id+names, e.g.
-
+  "Return assoc list of tuples of strain id+names:
    ((4 . BXD1) (5 . BXD2) (6 . BXD5) (7 . BXD6)...
+
+map? will say whether the strains/individuals are used for mapping.
 "
   (call-with-db
    (lambda (db)
diff --git a/gn/db/mysql.scm b/gn/db/mysql.scm
index 4c6b35e..4e2b280 100644
--- a/gn/db/mysql.scm
+++ b/gn/db/mysql.scm
@@ -15,29 +15,18 @@
   #:export (
             ;; DB  <- don't export
             call-with-db
-            db-open
-            db-check
-            db-check2
-            db-query
-            db-get-row
             get-row
-            db-display-rows
-            db-get-rows
-            db-get-rows-apply
+            get-rows
             get-rows-apply
+            check
+            ;db-open
+            ;db-query
+            ;db-get-row
+            ;db-display-rows
+            ;db-get-rows-apply
             ))
 
-(define DB
-  (begin
-    (display "===> OPENING DB")
-    (newline)
-    (dbi-open "mysql" "webqtlout:webqtlout:db_webqtl:tcp:127.0.0.1:3306")
-    ))
-
 (define (db-open)
-  DB)
-
-(define (db-open2)
   (begin
     (display "===> OPENING DB")
     (newline)
@@ -45,18 +34,9 @@
     ))
 
 (define (call-with-db thunk)
-  (thunk (db-open2)))
+  (thunk (db-open)))
 
-(define (db-check)
-  "Use DBI-style handle to report an error. On error the program will stop."
-  (match (dbi-get_status DB)
-    ((stat . msg) (if (= stat 0)
-                     #t
-                     (begin
-                       (display msg)
-                       (newline)
-                       (assert stat))))))
-(define (db-check2 db)
+(define (check db)
   "Use DBI-style handle to report an error. On error the program will stop."
   (match (dbi-get_status db)
     ((stat . msg) (if (= stat 0)
@@ -66,25 +46,10 @@
                        (newline)
                        (assert stat))))))
 
-(define (db-query str)
-  (dbi-query (pk DB) str))
-
-(define (db-get-row)
-  (dbi-get_row DB))
-
 (define (get-row db)
   (dbi-get_row db))
 
-(define (db-display-rows)
-  (let [(row  (dbi-get_row db))]
-    (if row
-        (begin
-          (display row)
-          (get-rows DB)
-          )
-        #t)))
-
-(define (db-get-rows list)
+(define (get-rows db list)
   "After running dbi-query we can fetch all rows and return them as a list of records, which are assoc list:
 
     (dbi-query db \"SELECT StrainId,Strain.Name FROM Strain, StrainXRef WHERE StrainXRef.StrainId = Strain.Id AND StrainXRef.InbredSetId = 1 ORDER BY StrainId;\")
@@ -93,20 +58,9 @@
 
     (((StrainId . 4) (Name . BXD1)) ((StrainId . 5) (Name . BXD2))...
 "
-  (let [(row (dbi-get_row DB))]
-    (if row
-        (db-get-rows (append list `(,row)))
-        list)))
-
-(define (db-get-rows-apply func list)
-  "Similar to db-get-rows with a function that gets applied on every record, e.g.
-
-    (define ids (db-get-rows-apply db (lambda (r) `(,(assoc-ref r \"StrainId\") . ,(assoc-ref r \"Name\"))) '()))
-
-"
-  (let [(row (dbi-get_row DB))]
+  (let [(row (dbi-get_row db))]
     (if row
-        (db-get-rows-apply func (append list `(,(func row))))
+        (get-rows db (append list `(,row)))
         list)))
 
 (define (get-rows-apply db func lst)
@@ -117,7 +71,7 @@
 "
   (let [(row (dbi-get_row db))]
     (begin
-      (display row)
+      ; (display row)
       (if row
           (get-rows-apply db func (append lst `(,(func row))))
           lst)))
diff --git a/scripts/precompute/precompute-hits.scm b/scripts/precompute/precompute-hits.scm
index acd7cdf..a6617d9 100755
--- a/scripts/precompute/precompute-hits.scm
+++ b/scripts/precompute/precompute-hits.scm
@@ -16,45 +16,30 @@
 ;;    mysql -uwebqtlout -pwebqtlout -A -h 127.0.0.1 -P 3306 db_webqtl -e "show tables;"
 ;;
 
-#!
-(db-query "SELECT * FROM ProbeSetXRef LIMIT 3")
-(db-check)
-(let [(row (db-get-row))]
-  (display row)
-  )
-!#
-
 (call-with-db
  (lambda (db)
    (begin
-     (dbi-query db "SELECT * FROM ProbeSetXRef LIMIT 3")
-     (let [(row (get-row db))]
-       (display row)
-       )
-     (newline)
-     (dbi-query db "SELECT * FROM ProbeSetXRef LIMIT 3")
-     (let [(row (get-row db))]
-       (display row)
-       )
-     (newline)
+     ;(newline)
      ; (dbi-query db "SELECT StrainId,Strain.Name FROM Strain, StrainXRef WHERE StrainXRef.StrainId = Strain.Id AND StrainXRef.InbredSetId = 1 AND Used_for_mapping='Y' ORDER BY StrainId;")
      ; (let [(row (get-row db))]
      ;  (display row)
      ;  )
-     (let [(result (get-rows-apply db (lambda (r) `(,(assoc-ref r "StrainId") . ,(assoc-ref r "Name"))) '()))]
-       (display (car result)))
+     ;(let [(result (get-rows-apply db (lambda (r) `(,(assoc-ref r "StrainId") . ,(assoc-ref r "Name"))) '()))]
+     ;  (display (car result)))
 
-     (newline)
+     ;(newline)
      (define bxd-strains (bxd-strain-id-names #:map? #t))
-     (newline)
-     (display bxd-strains)
      (display (assoc 64728 bxd-strains))
      (newline)
-     (newline)
-     (dbi-query db "SELECT * FROM ProbeSetXRef LIMIT 3")
-     (let [(row (get-row db))]
-       (display row)
-       )
-     (db-check2 db)
+     ;(newline)
+     ;(dbi-query db "SELECT * FROM ProbeSetXRef LIMIT 3")
+     ;(let [(row (get-row db))]
+     ;  (display row)
+     ;  )
+     ;(db-check2 db)
+     ;(newline)
+     ;; get first dataset for precompute
+     (dbi-query db "select ProbeSetId, Locus, DataId from ProbeSetXRef where Locus_old is NULL LIMIT 1")
+     (display (get-row db))
      (newline)
 )))