AScall/generics.R at master · kablag/AScall · GitHub

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
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
toLog <- function(logMessage, timeStamp =  date()) {
  cat(sprintf("%s: %s \n", timeStamp, logMessage))
}

addMarkersKits <- function(descrTbl) {
  descrTbl %>%
    mutate(marker = str_split(target, "_", simplify = TRUE)[, 1],
           allele = str_split(target, "_", simplify = TRUE)[, 2]) %>%
    group_by(position) %>%
    mutate(kit = paste(marker, collapse = ", ")) %>%
    ungroup() %>%
    mutate(kit = kit %>%
             as.factor() %>%
             as.numeric() %>%
             sprintf("kit_%02i", .))
}

dataType$set("public", "rawAdp",
             NA,
             overwrite = TRUE)
dataType$set("public", "rawCq",
             NA,
             overwrite = TRUE)

dataType$set("public", "Init",
             function() {
               if (!is.environment(self$rawAdp)) {
                 # first preprocess init
                 self$rawAdp <- self$adp #self$adp$copy() undo is turned off
                 self$rawCq <- self$cq
               } else {
                 self$adp <- self$rawAdp #self$rawAdp$copy() undo is turned off
                 self$cq <- self$rawCq
               }
             },
             overwrite = TRUE)

dataType$set("public", "Preprocess",
             function(bgRange, modelType, cqMethod, thrCq) {
               # library(chipPCR)
               # library(qpcR)
               fpoints <- self$adp$fpoints
               fpoints$fluor <-
                 chipPCR::CPP(fpoints$cyc, fpoints$fluor,
                              trans = TRUE,
                              bg.range = bgRange)$y.norm
               self$adp$fpoints <- fpoints
               result <- "Ok"
               if (thrCq > max(fpoints$fluor))
                 thrCq <- max(fpoints$fluor)
               tryCatch({
                 ampModel <- pcrfit(fpoints[, c("cyc", "fluor")],
                                    cyc = 1, fluo = 2,
                                    model = get(modelType))
                 fpoints$fluor <- predict(ampModel)
                 self$adp$fpoints <- fpoints
                 self$cq <-
                   efficiency(
                     ampModel,
                     plot = FALSE,
                     type = if (cqMethod == "Threshold") "cpD2" else cqMethod,
                     thresh = if (cqMethod == "Threshold") thrCq else NULL
                   )[[
                     {
                       switch(cqMethod,
                              "cpD2" = "cpD2",
                              "cpD1" = "cpD1",
                              "maxE" = "cpE",
                              "expR" = "cpR",
                              "CQ" = "cpCQ",
                              "Cy0" = "Cy0",
                              "Threshold" = "cpT"
                       )
                     }
                     ]]
               },
               error = function(e) {
                 result <<- list(date(), "Calc Cq error")
                 max(fpoints$cyc)
               })
               result
             },
             overwrite = TRUE)


dataType$set("public", "InitEndPt",
             function() {
               self$endPt <- tail(self$adp$fpoints$fluor, 1)
             },
             overwrite = TRUE)

runType$set("public", "Preprocess",
            function(bgRange, modelType, cqMethod, thrCq) {
              self$react <- foreach(reactN = self$react
                                    # , .verbose = TRUE
                                    ) %dopar% {
                for (dat in reactN$data)
                  dat$Preprocess(bgRange, modelType, cqMethod, thrCq)
                reactN
              }
            },
            overwrite = TRUE)

runType$set("public", "Init",
            function() {
              self$react <- foreach(reactN = self$react) %dopar% {
                for (dat in reactN$data)
                  dat$Init()
                reactN
              }
            },
            overwrite = TRUE)