Precompute will run gemma and update the DB status

3 files changed, 64 insertions, 47 deletions

diff --git a/gn/data/hits.scm b/gn/data/hits.scm
index 5108bd0..29d377b 100644
--- a/gn/data/hits.scm
+++ b/gn/data/hits.scm
@@ -15,6 +15,7 @@
   #:export (
             get-precompute-hit
             set-precompute-hit-status!
+            update-precompute!
             ))
 
 (define (get-precompute-hit db prev-id)
@@ -22,9 +23,19 @@
   (get-row db))
 
 (define (set-precompute-hit-status! db data-id-str status-str)
-  "Set status of precompute record - typically 'RUN' or 'NON-BXD'.
+  "Set status of precompute record - typically from NULL to 'GEMMA-START' or 'NON-BXD'.
+On completion it is set to 'GEMMA-DONE'.
 This is a temporary measure to get precompute going.
 Note we are counting on automated MariaDB transactions to not compete."
   (dbi-query db (string-append "UPDATE ProbeSetXRef SET Locus_old=\"" status-str "\" WHERE DataId=" data-id-str " AND Locus_old is NULL"))
   (ensure db)
   )
+
+;; MariaDB [db_webqtl]> UPDATE ProbeSetXRef SET Locus_old=Locus,LRS_old=LRS,Locus="new",LRS=9.9,pValue=1.0,additive=1.0 WHERE ProbeSetFreezeId=1 AND DataId=2 AND Locus_old="GEMMA-START" ;
+
+(define (update-precompute! db data-id-str status-str locus lrs pvalue, additive)
+  "Once precompute is run we can update the table moving old values and plugging in the new.
+"
+  (dbi-query db (string-append "UPDATE ProbeSetXRef SET Locus_old=Locus,LRS_old=LRS,Locus=\"" locus "\",LRS=" lrs ",pValue=" pvalue ",additive=" additive " WHERE DataId=" data-id-str " AND Locus_old is \"GEMMA-START\""))
+  (ensure db)
+  )
diff --git a/gn/runner/gemma.scm b/gn/runner/gemma.scm
index 2edb7b2..a31846a 100644
--- a/gn/runner/gemma.scm
+++ b/gn/runner/gemma.scm
@@ -13,10 +13,11 @@
             ))
 
 (define (run-gemma population data-id name trait-name traits)
+  "Run gemma-wrapper to compute GRM and GWA. On failure the run will stop(!)"
   (define bxd-inds (geno-inds-bxd "BXD.json"))
   (assert (= 235 (length bxd-inds)))
   (if name
-      (display (string-append "WE HAVE OUR BXD DATASET " name " and trait " trait-name " for precompute!\n")))
+      (display (string-append "WE HAVE OUR " population " DATASET " name " and trait " trait-name " for precompute!\n")))
   (display data-id)
   (display traits)
   (newline)
@@ -38,7 +39,9 @@
                         (newline)
                         (display outvalue port)
                         (newline port))))
-                  bxd-inds)))
+                  bxd-inds)
+        (close port)
+       ))
 
     ;; set up with ./.guix-shell -- guile -L . -s ./scripts/precompute/precompute-hits.scm
 
@@ -56,4 +59,5 @@
     (delete-file k-json-fn)
     (rmdir tmpdir)
     )
+  #t
   )
diff --git a/scripts/precompute/precompute-hits.scm b/scripts/precompute/precompute-hits.scm
index 0fabe8f..7385995 100755
--- a/scripts/precompute/precompute-hits.scm
+++ b/scripts/precompute/precompute-hits.scm
@@ -64,49 +64,51 @@ ssh -L 3306:127.0.0.1:3306 -f -N tux02.genenetwork.org
    )
 
      (define (run-precompute db prev-id)
-       (let* [(hit (get-precompute-hit db prev-id))
-              (data-id (assoc-ref hit "DataId"))
-              (data-id-str (int-to-string data-id))
-              (probesetfreeze-id (assoc-ref hit "ProbeSetFreezeId"))
-              (probeset-id (assoc-ref hit "ProbeSetId"))
-              (trait (get-trait db probeset-id))
-              (trait-name (assoc-ref trait "Name"))
-              (name (dataset-name db probesetfreeze-id))
-              ]
-         (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=" data-id-str))
-         (define id_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))
-                                   (name (assoc id bxd-strains))]
-                              (if name
-                                  lst
-                                  (append lst `(,name)))))
+       (let [(hit (get-precompute-hit db prev-id))]
+         (if hit
+             (let* [(data-id (assoc-ref hit "DataId"))
+                    (data-id-str (int-to-string data-id))
+                    (probesetfreeze-id (assoc-ref hit "ProbeSetFreezeId"))
+                    (probeset-id (assoc-ref hit "ProbeSetId"))
+                    (trait (get-trait db probeset-id))
+                    (trait-name (assoc-ref trait "Name"))
+                    (name (dataset-name db probesetfreeze-id))
+                    ]
+               (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=" data-id-str))
+               (define id_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))
+                                         (name (assoc id bxd-strains))]
+                                    (if name
+                                        lst
+                                        (append lst `(,name)))))
 
-                          '()
-                          id_traits))
-         (define traits (map
-                         (lambda (t)
-                           (match t
-                             ((id . value) (cons (assoc-ref bxd-strains id) value)
-                             )))
-                         id_traits))
-         (display traits)
-         ;; (if (= 0 (length non-bxd))
-         (if (eq? non-bxd '())
-             (begin
-               (set-precompute-hit-status! db data-id-str "GEMMA-START")
-               (run-gemma "BXD" data-id name trait-name traits)))
-             ;; disable precompute if non-bxd, for now, so it won't try again
-             (set-precompute-hit-status! db data-id-str "NON-BXD")
-         ;;(run-precompute db data-id)
-         ))
-     (run-precompute db 0)
+                                '()
+                                id_traits))
+               (define traits (map
+                               (lambda (t)
+                                 (match t
+                                   ((id . value) (cons (assoc-ref bxd-strains id) value)
+                                    )))
+                               id_traits))
+               (display traits)
+               ;; (if (= 0 (length non-bxd))
+               (if (eq? non-bxd '())
+                   (begin
+                     (set-precompute-hit-status! db data-id-str "GEMMA-START")
+                     (run-gemma "BXD" data-id name trait-name traits)
+                     (set-precompute-hit-status! db data-id-str "GEMMA-DONE")))
+               ;; disable precompute if non-bxd, for now, so it won't try again
+               (set-precompute-hit-status! db data-id-str "NON-BXD")
+               (run-precompute db data-id) ;; next round
+               ))))
+         (run-precompute db 0) ;; start precompute
 )))