From cd868747703585661efac3b85a423b6dae9b71c2 Mon Sep 17 00:00:00 2001
From: Pjotr Prins
Date: Sun, 19 Nov 2023 14:53:12 +0100
Subject: Iterate precompute datasets

---
 gn/data/hits.scm                       |  6 ++++
 gn/db/mysql.scm                        | 15 +++++---
 scripts/precompute/precompute-hits.scm | 62 +++++++++++++++++++---------------
 3 files changed, 52 insertions(+), 31 deletions(-)

diff --git a/gn/data/hits.scm b/gn/data/hits.scm
index 91be81f..a66eee5 100644
--- a/gn/data/hits.scm
+++ b/gn/data/hits.scm
@@ -9,7 +9,13 @@
   #:use-module (dbi dbi)
   #:use-module (gn db mysql)
   #:use-module (gn data group)
+  #:use-module (gn util convert)
   #:use-module (web gn-uri)
 
   #:export (
+            get-next-hit-for-precompute
             ))
+
+(define (get-next-hit-for-precompute db prev-id)
+  (dbi-query db (string-append "select Locus, DataId, ProbeSetId from ProbeSetXRef where DataId>" (int-to-string prev-id) " AND Locus_old is NULL ORDER BY DataId LIMIT 1"))
+  (get-row db))
diff --git a/gn/db/mysql.scm b/gn/db/mysql.scm
index fb7093a..760e578 100644
--- a/gn/db/mysql.scm
+++ b/gn/db/mysql.scm
@@ -18,7 +18,8 @@
             get-row
             get-rows
             get-rows-apply
-            check
+            has-result?
+            ensure
             ;db-open
             ;db-query
             ;db-get-row
@@ -36,7 +37,7 @@
 (define (call-with-db thunk)
   (thunk (db-open)))
 
-(define (check db)
+(define (ensure 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)
@@ -46,15 +47,21 @@
                        (newline)
                        (assert stat))))))
 
+(define (has-result? db)
+  "Return #t or #f if result is valid"
+  (match (dbi-get_status db)
+    ((stat . msg) (= stat 0))))
+
 (define (get-row db)
+  "Return record and #f is it was the last one"
   (dbi-get_row db))
 
 (define (get-rows db list)
   "After running dbi-query we can fetch all rows and return them as a list of records, which is an alist:
 
     (dbi-query db \"SELECT StrainId,Strain.Name FROM Strain, StrainXRef WHERE StrainXRef.StrainId = Strain.Id AND StrainXRef.InbredSetId = 1 ORDER BY StrainId;\")
-    (db-check db)
-    (display (db-get-rows db '()))
+    (ensure db)
+    (display (get-rows db '()))
 
     (((StrainId . 4) (Name . BXD1)) ((StrainId . 5) (Name . BXD2))...
 "
diff --git a/scripts/precompute/precompute-hits.scm b/scripts/precompute/precompute-hits.scm
index 28dabc9..0088431 100755
--- a/scripts/precompute/precompute-hits.scm
+++ b/scripts/precompute/precompute-hits.scm
@@ -6,6 +6,7 @@
 
 (use-modules (dbi dbi)
              (gn db mysql)
+             (gn data hits)
              (gn data strains)
              (gn util convert)
              (rnrs base)
@@ -34,8 +35,8 @@
 
      ;(newline)
      (define bxd-strains (bxd-strain-id-names #:map? #t))
-     (display (assoc 64728 bxd-strains))
-     (newline)
+     ;(display (assoc 64728 bxd-strains))
+     ;(newline)
      ;(newline)
      ;(dbi-query db "SELECT * FROM ProbeSetXRef LIMIT 3")
      ;(let [(row (get-row db))]
@@ -44,31 +45,38 @@
      ;(db-check2 db)
      ;(newline)
      ;; ---- get first available dataset for precompute:
-     (dbi-query db "select Locus, DataId, ProbeSetId from ProbeSetXRef where Locus_old is NULL LIMIT 1")
-     (define hit (get-row db))
-     (display hit)
-     (define data-id (assoc-ref hit "DataId"))
-     (display data-id)
-     (newline)
-     ;; ---- Get strains and phenotypes for this dataset
-     (dbi-query db (string-append "SELECT StrainId,value from ProbeSetData WHERE Id=" (int-to-string data-id)))
-     (define traits (get-rows-apply db
-                              (lambda (r) `(,(assoc-ref r "StrainId") . ,(assoc-ref r "value")))
-                              '()))
-     ;; ---- Now we need to make sure that all strains belong to BXD
-     (define non-bxd (fold
-               (lambda (strain lst)
-                 (let ([id (car strain)])
-                   (if (assoc id bxd-strains)
-                       lst
-                       (append lst `(,id)))))
+     ;; @@ order by dataid - recurse
+
+
+     (define (run-precompute db prev-id)
+       (let* [(hit (get-next-hit-for-precompute db prev-id))
+              (data-id (assoc-ref hit "DataId"))]
+         (display hit)
+         (display data-id)
+         (newline)
+         ;; ---- Get strains and phenotypes for this dataset
+         (dbi-query db (string-append "SELECT StrainId,value from ProbeSetData WHERE Id=" (int-to-string data-id)))
+         (define traits (get-rows-apply db
+                                        (lambda (r) `(,(assoc-ref r "StrainId") . ,(assoc-ref r "value")))
+                                        '()))
+         ;; ---- Now we need to make sure that all strains belong to BXD
+         (define non-bxd (fold
+                          (lambda (strain lst)
+                            (let ([id (car strain)])
+                              (if (assoc id bxd-strains)
+                                  lst
+                                  (append lst `(,id)))))
 
-               '()
-               traits))
-     (if (= 0 (length non-bxd))
-         (begin
-           (display "WE HAVE OUR BXD DATASET for precompute!")
-           (display traits)
-           (newline)
+                          '()
+                          traits))
+         (if (= 0 (length non-bxd))
+             (begin
+               (display "WE HAVE OUR BXD DATASET for precompute!\n")
+               (display data-id)
+               (display traits)
+               (newline)
+               ))
+         (run-precompute db data-id)
          ))
+     (run-precompute db 0)
 )))
-- 
cgit v1.2.3