From 162b4c5cfb49766c66d274f9ddb414f6bd4d087e Mon Sep 17 00:00:00 2001
From: Pjotr Prins
Date: Fri, 5 Jan 2024 09:27:39 +0100
Subject: Precompute will run gemma and update the DB status

---
 scripts/precompute/precompute-hits.scm | 90 +++++++++++++++++-----------------
 1 file changed, 46 insertions(+), 44 deletions(-)

(limited to 'scripts/precompute')

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
 )))
-- 
cgit v1.2.3