diff options
| -rw-r--r-- | gn/data/hits.scm | 8 | ||||
| -rwxr-xr-x | scripts/precompute/list-traits-to-compute.scm | 80 |
2 files changed, 43 insertions, 45 deletions
diff --git a/gn/data/hits.scm b/gn/data/hits.scm index 94b4749..f7ce49e 100644 --- a/gn/data/hits.scm +++ b/gn/data/hits.scm @@ -13,14 +13,18 @@ #:use-module (web gn-uri) #:export ( + get-precompute-hits get-precompute-hit set-precompute-hit-status! update-precompute! )) +(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 (get-precompute-hit db prev-id) - (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 1")) - (get-row db)) + (car (get-precompute-hits db prev-id 1))) (define (set-precompute-hit-status! db data-id-str status-str) "Set status of precompute record - typically from NULL to 'GEMMA-START' or 'NON-BXD'. diff --git a/scripts/precompute/list-traits-to-compute.scm b/scripts/precompute/list-traits-to-compute.scm index 3cba292..68f0711 100755 --- a/scripts/precompute/list-traits-to-compute.scm +++ b/scripts/precompute/list-traits-to-compute.scm @@ -59,47 +59,41 @@ Now list the next 1000 trait IDs: (dbi-query db (string-append "select Id,Chr,Mb,Name,Symbol,description from ProbeSet where Id=" (int-to-string probeset-id) " limit 1")) (get-row db)) (define (run-list-traits-to-compute db prev-id count) - (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) - (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)) - (if (eq? non-bxd '()) - (set-precompute-hit-status! db data-id-str "GEMMA-START") - ;; disable precompute if non-bxd, for now, so it won't try again - (set-precompute-hit-status! db data-id-str "NON-BXD")) - (if (> count 0) - (run-list-traits-to-compute db data-id (- count 1)) ;; next round - ) - )))) + (let [(hits (get-precompute-hits db prev-id count))] + (for-each (lambda (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) + (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)) + #t)) + hits))) (run-list-traits-to-compute db 0 5) ;; start precompute -))) + ))) |