about summary refs log tree commit diff
diff options
context:
space:
mode:
authorPjotr Prins2024-06-29 06:17:38 -0500
committerPjotr Prins2024-06-29 06:17:38 -0500
commit3fcc0a58f6a4ad3f86e0e8c96b58ad8bc179b3cf (patch)
treedfb19fba52071d6a7222eeac3caa9cbbc8de41a7
parent191a98261ad8336c51a59655c2bf3a3b282f00fe (diff)
downloadgn-guile-3fcc0a58f6a4ad3f86e0e8c96b58ad8bc179b3cf.tar.gz
Using a record instead of assoc is cleaner
-rw-r--r--gn/data/hits.scm20
-rwxr-xr-xscripts/precompute/list-traits-to-compute.scm28
2 files changed, 31 insertions, 17 deletions
diff --git a/gn/data/hits.scm b/gn/data/hits.scm
index f7ce49e..88dee11 100644
--- a/gn/data/hits.scm
+++ b/gn/data/hits.scm
@@ -5,6 +5,7 @@
   #:use-module (ice-9 iconv)
   #:use-module (ice-9 receive)
   #:use-module (ice-9 string-fun)
+  #:use-module (srfi srfi-9)
   ;; #:use-module (gn db sparql)
   #:use-module (dbi dbi)
   #:use-module (gn db mysql)
@@ -17,11 +18,24 @@
             get-precompute-hit
             set-precompute-hit-status!
             update-precompute!
+            hit-data-id
+            hit-probeset-id
             ))
 
-(define (get-precompute-hits db prev-id num)
-  (dbi-query db (string-append "select Locus, DataId, ProbeSetId, ProbeSetFreezeId from ProbeSetXRef where DataId>" (int-to-string prev-id) " AND Locus_old is NULL ORDER BY DataId LIMIT " (format #f "~d" num)))
-  (get-rows db '()))
+
+(define-record-type <hit>
+  (make-hit data-id probeset-id)
+  hit?
+  (data-id hit-data-id)
+  (probeset-id hit-probeset-id)
+  )
+
+(define (get-precompute-hits db first-id num)
+  (dbi-query db (string-append "select Locus, DataId, ProbeSetId, ProbeSetFreezeId from ProbeSetXRef where DataId>" (int-to-string first-id) " AND Locus_old is NULL ORDER BY DataId LIMIT " (format #f "~d" num)))
+  (map (lambda (r)
+         (make-hit (assoc-ref r "DataId") (assoc-ref r "ProbeSetId")))
+         (get-rows db '())
+  ))
 
 (define (get-precompute-hit db prev-id)
   (car (get-precompute-hits db prev-id 1)))
diff --git a/scripts/precompute/list-traits-to-compute.scm b/scripts/precompute/list-traits-to-compute.scm
index a9e1340..199f457 100755
--- a/scripts/precompute/list-traits-to-compute.scm
+++ b/scripts/precompute/list-traits-to-compute.scm
@@ -78,6 +78,7 @@ When that is the case we might as well write the phenotype file because we have
              (json)
              (rnrs bytevectors)
              (srfi srfi-1)
+             (srfi srfi-9)
              (srfi srfi-19) ; time
              )
 
@@ -146,9 +147,8 @@ The following is produced by gemma-wrapper as metadata
                            num))
                 (rest (- num count))
                 (hits (get-precompute-hits db prev-id count))
-                (data-ids (map (lambda (hit)
-                                 (let* [(data-id (assoc-ref hit "DataId"))]
-                                   data-id))
+                (data-ids (map (lambda (h)
+                                 (hit-data-id h))
                                hits))
                 (data-str-ids (map (lambda (id) (string-append "Id=" (int-to-string id))) data-ids))
                 (data-ids-query (string-join data-str-ids " OR "))
@@ -171,20 +171,20 @@ The following is produced by gemma-wrapper as metadata
                       (set! nrecs (assoc-set! nrecs data-id lst))))
                        id-traits)
              ;; --- create the json output as a file
-             (for-each (lambda (r hit)
-                         (let* [(probeset-id (assoc-ref hit "ProbeSetId"))
-                                (data-id (assoc-ref hit "DataId"))
-                                (data-id-str (int-to-string data-id))
-                                (probesetfreeze-id (assoc-ref hit "ProbeSetFreezeId"))
-                                (trait (get-trait db probeset-id))
-                                (trait-name (assoc-ref trait "Name"))
-                                (name (dataset-name db probesetfreeze-id))
-                               ]
+             (for-each (lambda (r h)
+                         ;; (let* [;; (probeset-id (assoc-ref hit "ProbeSetId"))
+                                ;; (data-id (assoc-ref hit "DataId"))
+                                ;; (data-id-str (int-to-string data-id))
+                                ;; (probesetfreeze-id (assoc-ref hit "ProbeSetFreezeId"))
+                                ;; (trait (get-trait db probeset-id))
+                                ;; (trait-name (assoc-ref trait "Name"))
+                                ;; (name (dataset-name db probesetfreeze-id))
+                               ;; ]
                            (match r
                              ((id . recs) (if (has-bxd? recs)
-                                              (write-json-ld id probeset-id recs)
+                                              (write-json-ld id (hit-probeset-id h) recs)
                                               ))
-                             ))) nrecs hits)
+                             )) nrecs hits)
              (if (> rest 0)
                  (run-list-traits-to-compute db rest (first (reverse data-ids)))) ;; start precompute
            )))