aboutsummaryrefslogtreecommitdiff
path: root/scripts/precompute/precompute-hits.scm
blob: d8170db02c417200a9702ac590ed0b9c33f79b01 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
#! Run from base dir with

.guix-shell -- guile -L . -s ./scripts/precompute/precompute-hits.scm

!#

(use-modules (dbi dbi)
             (gn db mysql)
             (gn data dataset)
             (gn data hits)
             (gn data strains)
             (gn util convert)
             (rnrs base)
             (ice-9 match)
             (srfi srfi-1)
             )

;; potentially you want to test connection with mysql client:
;;
;;    mysql -uwebqtlout -pwebqtlout -A -h 127.0.0.1 -P 3306 db_webqtl -e "show tables;"
;;
;; for now update Locus_old with
;;
;;    update ProbeSetXRef set Locus_old=NULL;

(call-with-db
 (lambda (db)
   (begin
     ;(newline)
     ; (dbi-query db "SELECT StrainId,Strain.Name FROM Strain, StrainXRef WHERE StrainXRef.StrainId = Strain.Id AND StrainXRef.InbredSetId = 1 AND Used_for_mapping='Y' ORDER BY StrainId;")
     ; (let [(row (get-row db))]
     ;  (display row)
     ;  )
     ;(let [(result (get-rows-apply db (lambda (r) `(,(assoc-ref r "StrainId") . ,(assoc-ref r "Name"))) '()))]
     ;  (display (car result)))

     ;(newline)
     (define bxd-strains (bxd-strain-id-names #:map? #t))
                                        ;(display (assoc 64728 bxd-strains))
     ;(newline)
     ;(newline)
     ;(dbi-query db "SELECT * FROM ProbeSetXRef LIMIT 3")
     ;(let [(row (get-row db))]
     ;  (display row)
     ;  )
     ;(db-check2 db)
     ;(newline)
     ;; ---- get first available dataset for precompute:
     ;; @@ order by dataid - recurse

     (define (get-trait-name db probeset-id)
       (dbi-query db (string-append "select Name,Symbol from ProbeSet where Id=" (int-to-string probeset-id) " limit 1"))
       (get-row db)
   )

     (define (run-precompute db prev-id)
       (let* [(hit (get-next-hit-for-precompute 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-name db probeset-id))
              (trait-name (assoc-ref trait "Name"))
              ]
         (display hit)
         (display data-id)
         (newline)
         (define name (dataset-name db probesetfreeze-id))
         ;; ---- Get strains and phenotypes for this dataset
         (dbi-query db (string-append "SELECT StrainId,value from ProbeSetData WHERE Id=" data-id-str))
         (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
               (if name
                   (display (string-append "WE HAVE OUR BXD DATASET " name " and trait " trait-name " for precompute!\n")))
               (display data-id)
               (display traits)
               (newline)

               ))
         (run-precompute db data-id)
         ))
     (run-precompute db 0)
)))