R/add_fluorescence_deviation_injection.R

Defines functions add_fluorescence_deviation_injection

Documented in add_fluorescence_deviation_injection

#' Add fluorescence deviation due to injection
#'
#' @param plate_layout a data frame generated by \code{seed_plate}
#'
#' @import dplyr
#' @import tibble
#' @import purrr
#' @export
add_fluorescence_deviation_injection <- function(plate_layout) {
    if (unique(plate_layout$what_test) == "mito") {
        num.injections <- 3
    }
    
    # the probability of a well is an "outlier"
    prob_outlier <- rbeta(1, 2, 94)
    
    # is the well an "outlier"?
    plate_layout$outlier <- rbernoulli(96, p = prob_outlier)
    
    # if a well is an "outlier", the next step is to decide since which injection
    # the fluoresence values will always be larger or smaller than what should be
    injection.id <- paste("Injection", seq(from = 1, to = num.injections, by = 1))
    plate_layout$starting_injection <- sample(injection.id, size = 96, replace = TRUE)
    
    # In the following steps
    # I find the Tick that corresponding to the 1st fluoresence value
    # after an injection
    measurement_tick <- seed_rawdata_table(num.injections) %>% 
        mutate(deviation_fluoresence_injection = 0) %>% 
        tbl_df()
    
    measurement_injection <- tibble(Measurement = 1:max(measurement_tick$Measurement), 
                                    Injection = rep(c("No injection", injection.id), each = 3))
    
    measurement_injection_tick <- measurement_injection %>% 
        left_join(measurement_tick, by = "Measurement") %>% 
        filter(Injection != "No injection")
    
    injection_starting_tick <- measurement_injection %>% 
        left_join(measurement_tick, by = "Measurement") %>% 
        filter(Injection != "No injection") %>% 
        group_by(Injection) %>% 
        summarize(Tick = min(Tick))
    
    plate_layout <- plate_layout %>% 
        mutate(starting_tick = map_dbl(starting_injection, ~ injection_starting_tick$Tick[injection_starting_tick$Injection == .x]))
    
    plate_layout <- plate_layout %>% 
        mutate(tmp_deviation_fluoresence_injection = list(measurement_tick))
    
    # fluoresence after the Tick will have a non-zero deviation due to injection
    add_additional_fluoresence <- function(outlier, starting_tick, df) {
        if (outlier == TRUE) {
            df$deviation_fluoresence_injection[df$Tick >= starting_tick] <- rnorm(1, mean = 0, sd = 1000)
        }
        return(df)
    }
    
    plate_layout <- plate_layout %>% 
        mutate(deviation_fluoresence_injection = pmap(list(outlier, starting_tick, tmp_deviation_fluoresence_injection), add_additional_fluoresence))
    
    plate_injection_deviation <- plate_layout %>% 
        select(Well, Group, outlier, starting_injection, deviation_fluoresence_injection)
    
    return(plate_injection_deviation)
}
XiangZhangSC/rwave documentation built on Aug. 26, 2020, 10:34 a.m.