diff options
| -rw-r--r-- | gn/data/hits.scm | 6 | ||||
| -rw-r--r-- | gn/db/mysql.scm | 15 | ||||
| -rwxr-xr-x | scripts/precompute/precompute-hits.scm | 62 |
3 files changed, 52 insertions, 31 deletions
diff --git a/gn/data/hits.scm b/gn/data/hits.scm index 91be81f..a66eee5 100644 --- a/gn/data/hits.scm +++ b/gn/data/hits.scm @@ -9,7 +9,13 @@ #:use-module (dbi dbi) #:use-module (gn db mysql) #:use-module (gn data group) + #:use-module (gn util convert) #:use-module (web gn-uri) #:export ( + get-next-hit-for-precompute )) + +(define (get-next-hit-for-precompute db prev-id) + (dbi-query db (string-append "select Locus, DataId, ProbeSetId from ProbeSetXRef where DataId>" (int-to-string prev-id) " AND Locus_old is NULL ORDER BY DataId LIMIT 1")) + (get-row db)) diff --git a/gn/db/mysql.scm b/gn/db/mysql.scm index fb7093a..760e578 100644 --- a/gn/db/mysql.scm +++ b/gn/db/mysql.scm @@ -18,7 +18,8 @@ get-row get-rows get-rows-apply - check + has-result? + ensure ;db-open ;db-query ;db-get-row @@ -36,7 +37,7 @@ (define (call-with-db thunk) (thunk (db-open))) -(define (check db) +(define (ensure db) "Use DBI-style handle to report an error. On error the program will stop." (match (dbi-get_status db) ((stat . msg) (if (= stat 0) @@ -46,15 +47,21 @@ (newline) (assert stat)))))) +(define (has-result? db) + "Return #t or #f if result is valid" + (match (dbi-get_status db) + ((stat . msg) (= stat 0)))) + (define (get-row db) + "Return record and #f is it was the last one" (dbi-get_row db)) (define (get-rows db list) "After running dbi-query we can fetch all rows and return them as a list of records, which is an alist: (dbi-query db \"SELECT StrainId,Strain.Name FROM Strain, StrainXRef WHERE StrainXRef.StrainId = Strain.Id AND StrainXRef.InbredSetId = 1 ORDER BY StrainId;\") - (db-check db) - (display (db-get-rows db '())) + (ensure db) + (display (get-rows db '())) (((StrainId . 4) (Name . BXD1)) ((StrainId . 5) (Name . BXD2))... " diff --git a/scripts/precompute/precompute-hits.scm b/scripts/precompute/precompute-hits.scm index 28dabc9..0088431 100755 --- a/scripts/precompute/precompute-hits.scm +++ b/scripts/precompute/precompute-hits.scm @@ -6,6 +6,7 @@ (use-modules (dbi dbi) (gn db mysql) + (gn data hits) (gn data strains) (gn util convert) (rnrs base) @@ -34,8 +35,8 @@ ;(newline) (define bxd-strains (bxd-strain-id-names #:map? #t)) - (display (assoc 64728 bxd-strains)) - (newline) + ;(display (assoc 64728 bxd-strains)) + ;(newline) ;(newline) ;(dbi-query db "SELECT * FROM ProbeSetXRef LIMIT 3") ;(let [(row (get-row db))] @@ -44,31 +45,38 @@ ;(db-check2 db) ;(newline) ;; ---- get first available dataset for precompute: - (dbi-query db "select Locus, DataId, ProbeSetId from ProbeSetXRef where Locus_old is NULL LIMIT 1") - (define hit (get-row db)) - (display hit) - (define data-id (assoc-ref hit "DataId")) - (display data-id) - (newline) - ;; ---- Get strains and phenotypes for this dataset - (dbi-query db (string-append "SELECT StrainId,value from ProbeSetData WHERE Id=" (int-to-string data-id))) - (define 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)]) - (if (assoc id bxd-strains) - lst - (append lst `(,id))))) + ;; @@ order by dataid - recurse + + + (define (run-precompute db prev-id) + (let* [(hit (get-next-hit-for-precompute db prev-id)) + (data-id (assoc-ref hit "DataId"))] + (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=" (int-to-string data-id))) + (define 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)]) + (if (assoc id bxd-strains) + lst + (append lst `(,id))))) - '() - traits)) - (if (= 0 (length non-bxd)) - (begin - (display "WE HAVE OUR BXD DATASET for precompute!") - (display traits) - (newline) + '() + traits)) + (if (= 0 (length non-bxd)) + (begin + (display "WE HAVE OUR BXD DATASET for precompute!\n") + (display data-id) + (display traits) + (newline) + )) + (run-precompute db data-id) )) + (run-precompute db 0) ))) |