diff options
| -rw-r--r-- | gn/data/hits.scm | 13 | ||||
| -rw-r--r-- | gn/runner/gemma.scm | 8 | ||||
| -rwxr-xr-x | scripts/precompute/precompute-hits.scm | 90 |
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 ))) |