# rm(list=ls()) # library(testthat) # This holds various tests that we want to keep but take too long so are skipped. # Periodically we can comment out the top skip to check everything works ok. capture.output({ ## stops printing outputs on assigning skip("Extended function tests") # adjust_rate ------------------------------------------------------------- # These don't actually take that long, but caused issues during R CMD CHK when they just crawled # to a halt. No idea why. (Haven't actually tested if that still happens). ## These tests basically run EVERY combination of EVERY acceptable input for 'x', 'by' and 'by2' ## and check they output the correct adjusted rate { suppressWarnings(suppressMessages(insp_obj_single <- inspect(urchins.rd, time = 1, oxygen = 2, plot = F))) suppressWarnings(suppressMessages(insp_obj_multiple <- inspect(urchins.rd, time = 1, oxygen = 2:5, plot = F))) cr_obj_single <- calc_rate(insp_obj_single, from = 3, to = 40, by = "time", plot = F) cr_obj_three <- calc_rate(insp_obj_single, from = c(3,13,23), to = c(12,22,32), by = "time", plot = F) cr_obj_eight <- calc_rate(insp_obj_single, from = c(3,6,9,12,15,18,21,24), to = c(6,9,12,15,18,21,24,27), by = "time", plot = F) ar_obj <- auto_rate(insp_obj_single, plot = F) ## auto_rate object with single rate ar_obj_single <- ar_obj ar_obj_single$summary <- ar_obj_single$summary[2,] ar_obj_single$rate <- ar_obj_single$rate[2] ## bg objects bg_single <- calc_rate.bg(urchins.rd, time = 1, oxygen = 18, plot = F) bg_three <- calc_rate.bg(urchins.rd, time = 1, oxygen = 12:14, plot = F) bg_four <- calc_rate.bg(urchins.rd, time = 1, oxygen = 12:15, plot = F) bg_eight <- calc_rate.bg(urchins.rd, time = 1, oxygen = 12:19, plot = F) ## calc_rate objects cr_single <- suppressWarnings(calc_rate(inspect(urchins.rd, time = 1, oxygen = 18, plot = F), plot = F)) cr_three <- suppressWarnings(calc_rate(inspect(urchins.rd, time = 1, oxygen = 12:14, plot = F), plot = F)) cr_four <- suppressWarnings(calc_rate(inspect(urchins.rd, time = 1, oxygen = 12:15, plot = F), plot = F)) cr_eight <- suppressWarnings(calc_rate(inspect(urchins.rd, time = 1, oxygen = 12:19, plot = F), plot = F)) # dfs with diff column numbers bg_df2col <- urchins.rd[,c(1,18)] bg_df3col <- urchins.rd[,c(1,18,19)] bg_df7col <- urchins.rd[,c(1,18,19,18,19,18,19,18)] # inspect of above insp_bg_df2col <- suppressWarnings(suppressMessages(inspect(bg_df2col, time = 1, oxygen = 2, plot = F))) insp_bg_df3col <- suppressWarnings(suppressMessages(inspect(bg_df3col, time = 1, oxygen = 2:3, plot = F))) insp_bg_df7col <- suppressWarnings(suppressMessages(inspect(bg_df7col, time = 1, oxygen = 2:8, plot = F))) # calc_rate.bg of above crbg_df2col <- calc_rate.bg(bg_df2col, plot = F) crbg_df3col <- calc_rate.bg(bg_df3col, plot = F) crbg_df7col <- calc_rate.bg(bg_df7col, plot = F) # objects for "linear" and "exponential" testing # "pre" experiment background rate # gives "low" bg rate of -0.0004567706 crbg_pre_2col <- urchins.rd[1:70, c(1,18)] %>% calc_rate.bg(plot = FALSE) crbg_pre_3col <- urchins.rd[1:70, c(1,18:19)] %>% calc_rate.bg(plot = FALSE) ## as df bgdf_pre_2col <- urchins.rd[1:70, c(1,18)] bgdf_pre_3col <- urchins.rd[1:70, c(1,18:19)] ## as inspect insp_pre_2col <- suppressWarnings(suppressMessages(inspect(urchins.rd[1:70, c(1,18)], plot = FALSE))) insp_pre_3col <- suppressWarnings(suppressMessages(inspect(urchins.rd[1:70, c(1,18:19)], time = 1, oxygen = 2:3, plot = F))) ## as calc_rate - this for testing warning of rate timestamp outside time range of by/by2 cr_pre <- calc_rate(urchins.rd[1:70, c(1,18)], plot = FALSE) # "post" experiment background rate # gives "high" bg rate of -0.001268691 crbg_post_2col <- urchins.rd[230:271, c(1,19)] %>% calc_rate.bg(plot = FALSE) crbg_post_3col <- urchins.rd[230:271, c(1,18:19)] %>% calc_rate.bg(plot = FALSE) ## as df bgdf_post_2col <- urchins.rd[230:271, c(1,19)] bgdf_post_3col <- urchins.rd[230:271, c(1,18:19)] ## as inspect insp_post_2col <- suppressWarnings(suppressMessages(inspect(urchins.rd[230:271, c(1,19)], plot = FALSE))) insp_post_3col <- suppressWarnings(suppressMessages(inspect(urchins.rd[230:271, c(1,18:19)], plot = FALSE))) ## versions of above with POSITIVE background rates rev_pre <- urchins.rd[1:70, c(1,18:19)] rev_pre[[2]] <- rev(rev_pre[[2]]) rev_pre[[3]] <- rev(rev_pre[[3]]) crbg_pre_2col_pos <- rev_pre[,1:2] %>% calc_rate.bg(plot = FALSE) crbg_pre_3col_pos <- rev_pre %>% calc_rate.bg(plot = FALSE) ## as df bgdf_pre_2col_pos <- rev_pre[,1:2] bgdf_pre_3col_pos <- rev_pre ## as inspect insp_pre_2col_pos <- suppressWarnings(suppressMessages(inspect(rev_pre[,1:2], plot = FALSE))) insp_pre_3col_pos <- suppressWarnings(suppressMessages(inspect(rev_pre, time = 1, oxygen = 2:3, plot = F))) ## versions of above with POSITIVE background rates rev_post <- urchins.rd[230:271, c(1,18:19)] rev_post[[2]] <- rev(rev_post[[2]]) rev_post[[3]] <- rev(rev_post[[3]]) crbg_post_2col_pos <- rev_post[,1:2] %>% calc_rate.bg(plot = FALSE) crbg_post_3col_pos <- rev_post %>% calc_rate.bg(plot = FALSE) ## as df bgdf_post_2col_pos <- rev_post[,1:2] bgdf_post_3col_pos <- rev_post ## as inspect insp_post_2col_pos <- suppressWarnings(suppressMessages(inspect(rev_post[,1:2], plot = FALSE))) insp_post_3col_pos <- suppressWarnings(suppressMessages(inspect(rev_post, time = 1, oxygen = 2:3, plot = F))) ## intermediately timed data of a specimen # gives specimen rate of -0.0280796 ## as df spec_df <- urchins.rd[71:199, c(1,2)] ## as inspect spec_insp <- suppressWarnings(suppressMessages(inspect(urchins.rd[71:199, c(1,2)], plot = FALSE))) ## as calc_rate object spec_cr <- urchins.rd[71:199, c(1,2)] %>% calc_rate(plot = FALSE) ## as auto_rate object - gives three rates spec_ar <- urchins.rd[71:199, c(1,2)] %>% auto_rate(plot = FALSE) ## as auto_rate object - with single rate spec_ar_single <- spec_ar spec_ar_single$summary <- spec_ar_single$summary[2,] spec_ar_single$rate <- spec_ar_single$rate[2] ## objs with rates of different sign cr_obj_mixed_sign <- calc_rate(intermittent.rd, from = c(30, 1000, 1900, 2000), to = c(130, 1100, 2000, 2100), by = "time", plot = FALSE) cr_obj_pos <- calc_rate(intermittent.rd, from = c(1900, 2000, 3550, 3600), to = c(2000, 2100, 3650, 3700), by = "time", plot = FALSE) ar_obj_pos <- auto_rate( data.frame(urchins.rd[[1]], rev(urchins.rd[[2]])), plot = FALSE) ar_obj_mixed_sign <- auto_rate(intermittent.rd, plot = FALSE) ## auto_rate objects of different methods with lots of rates ar_obj_highest <- auto_rate(urchins.rd[,1:2], method = "highest", plot = F) ar_obj_lowest <- auto_rate(urchins.rd[,1:2], method = "lowest", plot = F) ar_obj_interval <- auto_rate(urchins.rd[,1:2], method = "interval", width = 0.05, plot = F) } # end make objects # ----------- "linear" method ------------ { # Create testing objects ## names of inputs - for creating assertion and therefore reporting which combinations fail x_in <- c("c(-0.030)", "c(0.030)", "c(0)", "c(-0.030, -0.029, -0.028, -0.027, -0.026)", "c(0.030, 0.029, 0.028, 0.027, 0.026)", "c(-0.030, -0.029, 0.028, 0.027, 0.026)", "cr_obj_single", "cr_obj_three", "cr_obj_eight", "cr_obj_pos", "cr_obj_mixed_sign", "ar_obj", "ar_obj_single", "ar_obj_pos", "ar_obj_mixed_sign", "ar_obj_highest", "ar_obj_lowest", "ar_obj_interval") by_in <- c("c(-0.001)", "c(0.001)", "c(-0.003)", "c(0.003)", "bgdf_pre_2col", "bgdf_pre_3col", "insp_pre_2col", "insp_pre_3col", "crbg_pre_2col", "crbg_pre_3col") by2_in <- c("c(-0.001)", "c(0.001)", "c(-0.003)", "c(0.003)", "bgdf_post_2col", "bgdf_post_3col", "insp_post_2col", "insp_post_3col", "crbg_post_2col", "crbg_post_3col") ## matrix of all combinations of above name_mat <- expand.grid(x_in, by_in, by2_in, stringsAsFactors = FALSE) ## list of lists of ALL POSSIBLE inputs all_objs <- list(x_in = list(c(-0.030), c(0.030), c(0), c(-0.030, -0.029, -0.028, -0.027, -0.026), c(0.030, 0.029, 0.028, 0.027, 0.026), c(-0.030, -0.029, 0.028, 0.027, 0.026), cr_obj_single, cr_obj_three, cr_obj_eight, cr_obj_pos, cr_obj_mixed_sign, ar_obj, ar_obj_single, ar_obj_pos, ar_obj_mixed_sign, ar_obj_highest, ar_obj_lowest, ar_obj_interval), time_x_in = list(c(20), c(20), c(20), # time inputs need to be paired with above appropriately c(20,25,30,35,40), c(20,25,30,35,40), c(20,25,30,35,40), NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL), by_in = list(c(-0.001), c(0.001), c(-0.003), c(0.003), bgdf_pre_2col, bgdf_pre_3col, insp_pre_2col, insp_pre_3col, crbg_pre_2col, crbg_pre_3col), time_by_in = list(c(5), c(5), c(0), c(1), NULL, NULL, NULL, NULL, NULL, NULL), by2_in = list(c(-0.001), c(0.001), c(-0.003), c(0.003), bgdf_post_2col, bgdf_post_3col, insp_post_2col, insp_post_3col, crbg_post_2col, crbg_post_3col), time_by2_in = list(c(40), c(40), c(45), c(40), NULL, NULL, NULL, NULL, NULL, NULL)) ## numeric matrix of inputs for choosing inputs on each loop num_mat <- expand.grid(1:length(x_in), 1:length(by_in), 1:length(by2_in)) ## column of row/iteration numbers - used to build assertion num_mat[[4]] <- 1:nrow(num_mat) } ## test every combination apply(num_mat, 1, function(z) { method <- "linear" ## select x, by, by2 inputs x <- all_objs$x_in[[z[[1]]]] by <- all_objs$by_in[[z[[2]]]] by2 <- all_objs$by2_in[[z[[3]]]] ## associated timestamps time_x <- all_objs$time_x_in[[z[[1]]]] time_by <- all_objs$time_by_in[[z[[2]]]] time_by2 <- all_objs$time_by2_in[[z[[3]]]] ## Calculate what the adjusted rates SHOULD be. ## We calculate these the same way, but outside the adjust_rate function ## as much as possible. # x rate should be this # extract based on input type if(is.numeric(x)) o_x <- x else o_x <- x$rate if(is.numeric(time_x)) o_time_x <- time_x else o_time_x <- (x$summary$endtime + x$summary$time)/2 ## CHANGE # adjustment should be this # extract rate and timestamp based on input type if(is.numeric(by)) { o_by <- by o_time_by <- time_by } else if(is.data.frame(by)) { o_by <- mean(suppressMessages(calc_rate.bg(as.data.frame(by), plot = F))$rate.bg) o_time_by <- sum(range(by[[1]]))/2 } else { o_by <- mean(suppressMessages(calc_rate.bg(as.data.frame(by$dataframe), plot = F))$rate.bg) o_time_by <- sum(range(by$dataframe[[1]]))/2 } if(is.numeric(by2)) { o_by2 <- by2 o_time_by2 <- time_by2 } else if(is.data.frame(by2)) { o_by2 <- mean(suppressMessages(calc_rate.bg(as.data.frame(by2), plot = F))$rate.bg) o_time_by2 <- sum(range(by2[[1]]))/2 } else { o_by2 <- mean(suppressMessages(calc_rate.bg(as.data.frame(by2$dataframe), plot = F))$rate.bg) o_time_by2 <- sum(range(by2$dataframe[[1]]))/2 } ## calc adjustment lm <- lm(c(o_by, o_by2) ~ c(o_time_by, o_time_by2)) # adjustment model o_adj <- as.numeric(o_time_x * lm$coef[2] + lm$coef[1]) # actual adjustment value for each x rate timestamp ## build assertion so we know which test fails assertion <- glue::glue("adjust_rate: method = 'linear' outputs correct results - combination x = {name_mat[z[[4]],][[1]]}, by = {name_mat[z[[4]],][[2]]}, by2 = {name_mat[z[[4]],][[3]]}}") test_that(assertion,{ expect_equal(suppressWarnings(adjust_rate(x = x, time_x = time_x, method = method, by = by, time_by = time_by, by2 = by2, time_by2 = time_by2))$rate.adjusted, o_x - o_adj) }) }) # "exponential" method ---------------------------------------------------- ## for exponential - can't mix signs of by and by2 so we run it twice = all neg, all pos # Negative bg rates { # Create testing objects ## names of inputs - for creating assertion and therefore reporting which combinations fail x_in <- c("c(-0.030)", "c(0.030)", "c(0)", "c(-0.030, -0.029, -0.028, -0.027, -0.026)", "c(0.030, 0.029, 0.028, 0.027, 0.026)", "c(-0.030, -0.029, 0.028, 0.027, 0.026)", "cr_obj_single", "cr_obj_three", "cr_obj_eight", "cr_obj_pos", "cr_obj_mixed_sign", "ar_obj", "ar_obj_single", "ar_obj_pos", "ar_obj_mixed_sign", "ar_obj_highest", "ar_obj_lowest", "ar_obj_interval") by_in <- c("c(-0.001)", "c(-0.001)", "c(-0.003)", "c(-0.003)", "bgdf_pre_2col", "bgdf_pre_3col", "insp_pre_2col", "insp_pre_3col", "crbg_pre_2col", "crbg_pre_3col") by2_in <- c("c(-0.001)", "c(-0.001)", "c(-0.003)", "c(-0.003)", "bgdf_post_2col", "bgdf_post_3col", "insp_post_2col", "insp_post_3col", "crbg_post_2col", "crbg_post_3col") ## matrix of all combinations of above name_mat <- expand.grid(x_in, by_in, by2_in, stringsAsFactors = FALSE) ## list of lists of ALL POSSIBLE inputs all_objs <- list(x_in = list(c(-0.030), c(0.030), c(0), c(-0.030, -0.029, -0.028, -0.027, -0.026), c(0.030, 0.029, 0.028, 0.027, 0.026), c(-0.030, -0.029, 0.028, 0.027, 0.026), cr_obj_single, cr_obj_three, cr_obj_eight, cr_obj_pos, cr_obj_mixed_sign, ar_obj, ar_obj_single, ar_obj_pos, ar_obj_mixed_sign, ar_obj_highest, ar_obj_lowest, ar_obj_interval), time_x_in = list(c(20), c(20), c(20), # time inputs need to be paired with above appropriately c(20,25,30,35,40), c(20,25,30,35,40), c(20,25,30,35,40), NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL), by_in = list(c(-0.001), c(-0.001), c(-0.003), c(-0.003), bgdf_pre_2col, bgdf_pre_3col, insp_pre_2col, insp_pre_3col, crbg_pre_2col, crbg_pre_3col), time_by_in = list(c(5), c(5), c(0), c(1), NULL, NULL, NULL, NULL, NULL, NULL), by2_in = list(c(-0.001), c(-0.001), c(-0.003), c(-0.003), bgdf_post_2col, bgdf_post_3col, insp_post_2col, insp_post_3col, crbg_post_2col, crbg_post_3col), time_by2_in = list(c(40), c(40), c(45), c(40), NULL, NULL, NULL, NULL, NULL, NULL)) ## numeric matrix of inputs for choosing inputs on each loop num_mat <- expand.grid(1:length(x_in), 1:length(by_in), 1:length(by2_in)) ## column of row/iteration numbers - used to build assertion num_mat[[4]] <- 1:nrow(num_mat) } ## test every combination apply(num_mat, 1, function(z) { method <- "exponential" ## select x, by, by2 inputs x <- all_objs$x_in[[z[[1]]]] by <- all_objs$by_in[[z[[2]]]] by2 <- all_objs$by2_in[[z[[3]]]] ## associated timestamps time_x <- all_objs$time_x_in[[z[[1]]]] time_by <- all_objs$time_by_in[[z[[2]]]] time_by2 <- all_objs$time_by2_in[[z[[3]]]] ## Calculate what the adjusted rates SHOULD be. ## We calculate these the same way, but outside the adjust_rate function ## as much as possible. # x rate should be this # extract based on input type if(is.numeric(x)) o_x <- x else o_x <- x$rate if(is.numeric(time_x)) o_time_x <- time_x else o_time_x <- (x$summary$endtime + x$summary$time)/2 ## CHANGE # adjustment should be this # extract rate and timestamp based on input type if(is.numeric(by)) { o_by <- by o_time_by <- time_by } else if(is.data.frame(by)) { o_by <- mean(suppressMessages(calc_rate.bg(as.data.frame(by), plot = F))$rate.bg) o_time_by <- sum(range(by[[1]]))/2 } else { o_by <- mean(suppressMessages(calc_rate.bg(as.data.frame(by$dataframe), plot = F))$rate.bg) o_time_by <- sum(range(by$dataframe[[1]]))/2 } if(is.numeric(by2)) { o_by2 <- by2 o_time_by2 <- time_by2 } else if(is.data.frame(by2)) { o_by2 <- mean(suppressMessages(calc_rate.bg(as.data.frame(by2), plot = F))$rate.bg) o_time_by2 <- sum(range(by2[[1]]))/2 } else { o_by2 <- mean(suppressMessages(calc_rate.bg(as.data.frame(by2$dataframe), plot = F))$rate.bg) o_time_by2 <- sum(range(by2$dataframe[[1]]))/2 } ## convert to positive (ONLY FOR NEGATIVE BG RATES) ## can't fit exponential to negatives o_by <- o_by * -1 o_by2 <- o_by2 * -1 ## calc adjustment - EXPONENTIAL expm <- lm(log(c(o_by, o_by2)) ~ c(o_time_by, o_time_by2)) # adjustment model ## extract slope and intercept ## needs to convert back from log expm_int <- exp(coef(expm)[1]) expm_slp <- exp(coef(expm)[2]) o_adj <- as.numeric(unname(expm_int * expm_slp ^ o_time_x)) ## convert back to negative (ONLY FOR NEGATIVE BG RATES) o_adj <- o_adj * -1 ## build assertion so we know which test fails assertion <- glue::glue("adjust_rate: method = 'exponential' outputs correct results - combination x = {name_mat[z[[4]],][[1]]}, by = {name_mat[z[[4]],][[2]]}, by2 = {name_mat[z[[4]],][[3]]}}") test_that(assertion, { expect_equal(suppressWarnings(adjust_rate(x = x, time_x = time_x, method = method, by = by, time_by = time_by, by2 = by2, time_by2 = time_by2))$rate.adjusted, o_x - o_adj) }) }) # Positive bg rates { # Create testing objects ## names of inputs - for creating assertion and therefore reporting which combinations fail x_in <- c("c(-0.030)", "c(0.030)", "c(0)", "c(-0.030, -0.029, -0.028, -0.027, -0.026)", "c(0.030, 0.029, 0.028, 0.027, 0.026)", "c(-0.030, -0.029, 0.028, 0.027, 0.026)", "cr_obj_single", "cr_obj_three", "cr_obj_eight", "cr_obj_pos", "cr_obj_mixed_sign", "ar_obj", "ar_obj_single", "ar_obj_pos", "ar_obj_mixed_sign") by_in <- c("c(0.001)", "c(0.001)", "c(0.003)", "c(0.003)", "bgdf_pre_2col_pos", "bgdf_pre_3col_pos", "insp_pre_2col_pos", "insp_pre_3col_pos", "crbg_pre_2col_pos", "crbg_pre_3col_pos") by2_in <- c("c(0.001)", "c(0.001)", "c(0.003)", "c(0.003)", "bgdf_post_2col_pos", "bgdf_post_3col_pos", "insp_post_2col_pos", "insp_post_3col_pos", "crbg_post_2col_pos", "crbg_post_3col_pos") ## matrix of all combinations of above name_mat <- expand.grid(x_in, by_in, by2_in, stringsAsFactors = FALSE) ## list of lists of ALL POSSIBLE inputs all_objs <- list(x_in = list(c(-0.030), c(0.030), c(0), c(-0.030, -0.029, -0.028, -0.027, -0.026), c(0.030, 0.029, 0.028, 0.027, 0.026), c(-0.030, -0.029, 0.028, 0.027, 0.026), cr_obj_single, cr_obj_three, cr_obj_eight, cr_obj_pos, cr_obj_mixed_sign, ar_obj, ar_obj_single, ar_obj_pos, ar_obj_mixed_sign), time_x_in = list(c(20), c(20), c(20), # time inputs need to be paired with above appropriately c(20,25,30,35,40), c(20,25,30,35,40), c(20,25,30,35,40), NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL), by_in = list(c(0.001), c(0.001), c(0.003), c(0.003), bgdf_pre_2col_pos, bgdf_pre_3col_pos, insp_pre_2col_pos, insp_pre_3col_pos, crbg_pre_2col_pos, crbg_pre_3col_pos), time_by_in = list(c(5), c(5), c(0), c(1), NULL, NULL, NULL, NULL, NULL, NULL), by2_in = list(c(0.001), c(0.001), c(0.003), c(0.003), bgdf_post_2col_pos, bgdf_post_3col_pos, insp_post_2col_pos, insp_post_3col_pos, crbg_post_2col_pos, crbg_post_3col_pos), time_by2_in = list(c(40), c(40), c(45), c(40), NULL, NULL, NULL, NULL, NULL, NULL)) ## numeric matrix of inputs for choosing inputs on each loop num_mat <- expand.grid(1:length(x_in), 1:length(by_in), 1:length(by2_in)) ## column of row/iteration numbers - used to build assertion num_mat[[4]] <- 1:nrow(num_mat) } # z<-num_mat[1,] ## test every combination apply(num_mat, 1, function(z) { method <- "exponential" ## select x, by, by2 inputs x <- all_objs$x_in[[z[[1]]]] by <- all_objs$by_in[[z[[2]]]] by2 <- all_objs$by2_in[[z[[3]]]] ## associated timestamps time_x <- all_objs$time_x_in[[z[[1]]]] time_by <- all_objs$time_by_in[[z[[2]]]] time_by2 <- all_objs$time_by2_in[[z[[3]]]] ## Calculate what the adjusted rates SHOULD be. ## We calculate these the same way, but outside the adjust_rate function ## as much as possible. # x rate should be this # extract based on input type if(is.numeric(x)) o_x <- x else o_x <- x$rate if(is.numeric(time_x)) o_time_x <- time_x else o_time_x <- (x$summary$endtime + x$summary$time)/2 ## CHANGE # adjustment should be this # extract rate and timestamp based on input type if(is.numeric(by)) { o_by <- by o_time_by <- time_by } else if(is.data.frame(by)) { o_by <- mean(suppressMessages(calc_rate.bg(as.data.frame(by), plot = F))$rate.bg) o_time_by <- sum(range(by[[1]]))/2 } else { o_by <- mean(suppressMessages(calc_rate.bg(as.data.frame(by$dataframe), plot = F))$rate.bg) o_time_by <- sum(range(by$dataframe[[1]]))/2 } if(is.numeric(by2)) { o_by2 <- by2 o_time_by2 <- time_by2 } else if(is.data.frame(by2)) { o_by2 <- mean(suppressMessages(calc_rate.bg(as.data.frame(by2), plot = F))$rate.bg) o_time_by2 <- sum(range(by2[[1]]))/2 } else { o_by2 <- mean(suppressMessages(calc_rate.bg(as.data.frame(by2$dataframe), plot = F))$rate.bg) o_time_by2 <- sum(range(by2$dataframe[[1]]))/2 } ## calc adjustment - EXPONENTIAL expm <- lm(log(c(o_by, o_by2)) ~ c(o_time_by, o_time_by2)) # adjustment model ## extract slope and intercept ## needs to convert back from log expm_int <- exp(coef(expm)[1]) expm_slp <- exp(coef(expm)[2]) o_adj <- as.numeric(unname(expm_int * expm_slp ^ o_time_x)) ## build assertion so we know which test fails assertion <- glue::glue("adjust_rate: method = 'exponential' outputs correct results - combination x = {name_mat[z[[4]],][[1]]}, by = {name_mat[z[[4]],][[2]]}, by2 = {name_mat[z[[4]],][[3]]}}") test_that(assertion, { expect_equal(suppressWarnings(adjust_rate(x = x, time_x = time_x, method = method, by = by, time_by = time_by, by2 = by2, time_by2 = time_by2))$rate.adjusted, o_x - o_adj) }) }) # convert_MR -------------------------------------------------------------- # Rationale of these tests - convert_rate with relevant output units should produce same result # as converting various output units # create testing objects { S <- 35 t <- 12 P <- 1.01 # single unconverted rate to convert rate <- -1.82 # multiple unconverted rates to convert rates <- c(-1.82, -2.3, -0.56, 5.677, 3.88) # Absolute in.units <- c("mg/h", "ug.min", "mol s-1", "mmol per hour", "UMOLE/s", "pmol/s-1", "ml/day", "ul.hour", "cm3_h", "mm3 per s", "mgO2 day-1") out.units <- c("mg/h", "ug.min", "mol s-1", "mmol per hour", "UMOLE/s", "pmol/s-1", "ml/day", "ul.hour", "cm3_h", "mm3 per s", "mgO2 day-1") all_combs_abs <- expand.grid(in.units, out.units, stringsAsFactors = FALSE) # Mass-specific in.units <- c("mg/h/ug", "ug.min.mg", "mol s-1 g-1", "mmol per hour per kilogram", "UMOLE/s/ug", "pmol/s-1/mg-1", "ml/day/g", "ul/hour/kg", "cm3/h/ug", "mm3 per s per mg", "mgO2/day/KG") out.units <- c("mg/h/ug", "ug.min.mg", "mol s-1 g-1", "mmol per hour per kilogram", "UMOLE/s/ug", "pmol/s-1/mg-1", "ml/day/g", "ul/hour/kg", "cm3/h/ug", "mm3 per s per mg", "mgO2/day/KG") masses <- round(runif(121, 0.001, 0.5), 2) all_combs_ms <- expand.grid(in.units, out.units, stringsAsFactors = FALSE) all_combs_ms[[3]] <- masses # Area-specific in.units <- c("mg/h/mm2", "ug.min.cm^2", "mol s-1 m-2", "mmol per hour per kilometresq", "UMOLE/s/mmsq", "pmol/s-1/cm-2", "ml/day/m2", "ul/hour/km2", "cm3/h/mm2", "mm3 per s per cmsq", "mgO2/day/KMsq") out.units <- c("mg/h/mm2", "ug.min.cm^2", "mol s-1 m-2", "mmol per hour per kilometresq", "UMOLE/s/mmsq", "pmol/s-1/cm-2", "ml/day/m2", "ul/hour/km2", "cm3/h/mm2", "mm3 per s per cmsq", "mgO2/day/KMsq") areas <- round(runif(121, 0.001, 0.5), 2) all_combs_as <- expand.grid(in.units, out.units, stringsAsFactors = FALSE) all_combs_as[[3]] <- areas } # Absolute rate checks ---------------------------------------------------- test_that("convert_MR - absolute rates from convert_rate objects are converted correctly", { apply(all_combs_abs, 1, function(z) { res1 <- convert_rate(rate, oxy.unit = "mg/l", time.unit = "min", output.unit = z[1], volume = 1.09, S = S, t = t, P = P) res2 <- convert_rate(rate, oxy.unit = "mg/l", time.unit = "min", output.unit = z[2], volume = 1.09, S = S, t = t, P = P) res3 <- convert_MR(res1, #from = z[1], to = z[2], S = S, t = t, P = P) #print(z) expect_equal(res2$rate.output, res3$rate.output) expect_identical(res2$to, res3$to) expect_true(all.equal(res2$summary, res3$summary)) }) }) test_that("convert_MR - absolute rates from convert_rate objects with multiple rates are converted correctly", { apply(all_combs_abs, 1, function(z) { res1 <- convert_rate(rates, oxy.unit = "mg/l", time.unit = "min", output.unit = z[1], volume = 1.09, S = S, t = t, P = P) res2 <- convert_rate(rates, oxy.unit = "mg/l", time.unit = "min", output.unit = z[2], volume = 1.09, S = S, t = t, P = P) res3 <- convert_MR(res1, #from = z[1], to = z[2], S = S, t = t, P = P) #print(z) expect_equal(res2$rate.output, res3$rate.output) expect_identical(res2$to, res3$to) expect_true(all.equal(res2$summary, res3$summary)) }) }) test_that("convert_MR - absolute rates from convert_rate.ft objects are converted correctly", { apply(all_combs_abs, 1, function(z) { res1 <- convert_rate.ft(rate, oxy.unit = "mg/l", time.unit = "min", flowrate.unit = "l/m", output.unit = z[1], S = S, t = t, P = P) res2 <- convert_rate.ft(rate, oxy.unit = "mg/l", time.unit = "min", flowrate.unit = "l/m", output.unit = z[2], S = S, t = t, P = P) res3 <- convert_MR(res1, #from = z[1], to = z[2], S = S, t = t, P = P) #print(z) expect_equal(res2$rate.output, res3$rate.output) expect_identical(res2$to, res3$to) expect_true(all.equal(res2$summary, res3$summary)) }) }) test_that("convert_MR - absolute rates from convert_rate.ft objects with multiple rates are converted correctly", { apply(all_combs_abs, 1, function(z) { res1 <- convert_rate.ft(rates, oxy.unit = "mg/l", time.unit = "min", flowrate.unit = "l/m", output.unit = z[1], S = S, t = t, P = P) res2 <- convert_rate.ft(rates, oxy.unit = "mg/l", time.unit = "min", flowrate.unit = "l/m", output.unit = z[2], S = S, t = t, P = P) res3 <- convert_MR(res1, #from = z[1], to = z[2], S = S, t = t, P = P) #print(z) expect_equal(res2$rate.output, res3$rate.output) expect_identical(res2$to, res3$to) expect_true(all.equal(res2$summary, res3$summary)) }) }) test_that("convert_MR - absolute rates from single numerics are converted correctly", { # 100 random rates rates <- round(runif(121, -5, 5), 2) all_combs_abs[[3]] <- rates apply(all_combs_abs, 1, function(z) { res1 <- convert_rate(as.numeric(z[3]), oxy.unit = "mg/l", time.unit = "min", output.unit = z[1], volume = 1.09, S = S, t = t, P = P) res2 <- convert_rate(as.numeric(z[3]), oxy.unit = "mg/l", time.unit = "min", output.unit = z[2], volume = 1.09, S = S, t = t, P = P) res3 <- convert_MR(res1$rate.output, from = z[1], to = z[2], S = S, t = t, P = P) #print(z) expect_equal(res2$rate.output, res3) }) }) test_that("convert_MR - absolute rates from vector numerics are converted correctly", { # 100 random rates rates <- round(runif(121, -5, 5), 2) all_combs_abs[[3]] <- rates # This just tests one conversion from ul/hr to ug/min # Just to test it actually outputs a numeric vector res1 <- convert_rate(as.numeric(all_combs_abs[[3]]), oxy.unit = "mg/l", time.unit = "min", output.unit = all_combs_abs[18,1], volume = 1.09, S = S, t = t, P = P) res2 <- convert_rate(as.numeric(all_combs_abs[[3]]), oxy.unit = "mg/l", time.unit = "min", output.unit = all_combs_abs[18,2], volume = 1.09, S = S, t = t, P = P) res3 <- convert_MR(res1$rate.output, from = all_combs_abs[18,1], to = all_combs_abs[18,2], S = S, t = t, P = P) #print(z) expect_equal(res2$rate.output, res3) expect_equal(nrow(all_combs_abs), length(res3)) }) # Mass-specific rate checks ----------------------------------------------- test_that("convert_MR - mass-specific rates from convert_rate objects are converted correctly", { apply(all_combs_ms, 1, function(z) { res1 <- convert_rate(rate, oxy.unit = "mg/l", time.unit = "min", output.unit = z[1], volume = 1.09, mass = as.numeric(z[3]), S = S, t = t, P = P) res2 <- convert_rate(rate, oxy.unit = "mg/l", time.unit = "min", output.unit = z[2], volume = 1.09, mass = as.numeric(z[3]), S = S, t = t, P = P) res3 <- convert_MR(res1, #from = z[1], to = z[2], S = S, t = t, P = P) print(z) expect_equal(res2$rate.output, res3$rate.output) expect_identical(res2$to, res3$to) expect_true(all.equal(res2$summary, res3$summary)) }) }) test_that("convert_MR - mass-specific rates from convert_rate objects with multiple rates are converted correctly", { apply(all_combs_ms, 1, function(z) { res1 <- convert_rate(rates, oxy.unit = "mg/l", time.unit = "min", output.unit = z[1], volume = 1.09, mass = as.numeric(z[3]), S = S, t = t, P = P) res2 <- convert_rate(rates, oxy.unit = "mg/l", time.unit = "min", output.unit = z[2], volume = 1.09, mass = as.numeric(z[3]), S = S, t = t, P = P) res3 <- convert_MR(res1, #from = z[1], to = z[2], S = S, t = t, P = P) print(z) expect_equal(res2$rate.output, res3$rate.output) expect_identical(res2$to, res3$to) expect_true(all.equal(res2$summary, res3$summary)) }) }) test_that("convert_MR - mass-specific rates from convert_rate.ft objects are converted correctly", { apply(all_combs_ms, 1, function(z) { res1 <- convert_rate.ft(rate, oxy.unit = "mg/l", time.unit = "min", flowrate.unit = "l/m", output.unit = z[1], mass = as.numeric(z[3]), S = S, t = t, P = P) res2 <- convert_rate.ft(rate, oxy.unit = "mg/l", time.unit = "min", flowrate.unit = "l/m", output.unit = z[2], mass = as.numeric(z[3]), S = S, t = t, P = P) res3 <- convert_MR(res1, #from = z[1], to = z[2], S = S, t = t, P = P) #print(z) expect_equal(res2$rate.output, res3$rate.output) expect_identical(res2$to, res3$to) expect_true(all.equal(res2$summary, res3$summary)) }) }) test_that("convert_MR - mass-specific rates from convert_rate.ft objects with multiple rates are converted correctly", { apply(all_combs_ms, 1, function(z) { res1 <- convert_rate.ft(rates, oxy.unit = "mg/l", time.unit = "min", flowrate.unit = "l/m", output.unit = z[1], mass = as.numeric(z[3]), S = S, t = t, P = P) res2 <- convert_rate.ft(rates, oxy.unit = "mg/l", time.unit = "min", flowrate.unit = "l/m", output.unit = z[2], mass = as.numeric(z[3]), S = S, t = t, P = P) res3 <- convert_MR(res1, #from = z[1], to = z[2], S = S, t = t, P = P) #print(z) expect_equal(res2$rate.output, res3$rate.output) expect_identical(res2$to, res3$to) expect_true(all.equal(res2$summary, res3$summary)) }) }) test_that("convert_MR - mass-specific rates from single numerics are converted correctly", { # 100 random rates rates <- round(runif(121, -5, 5), 2) all_combs_ms[[4]] <- rates apply(all_combs_ms, 1, function(z) { res1 <- convert_rate(as.numeric(z[4]), oxy.unit = "mg/l", time.unit = "min", output.unit = z[1], volume = 1.09, mass = as.numeric(z[3]), S = S, t = t, P = P) res2 <- convert_rate(as.numeric(z[4]), oxy.unit = "mg/l", time.unit = "min", output.unit = z[2], volume = 1.09, mass = as.numeric(z[3]), S = S, t = t, P = P) res3 <- convert_MR(res1$rate.output, from = z[1], to = z[2], S = S, t = t, P = P) #print(z) expect_equal(res2$rate.output, res3) }) }) test_that("convert_MR - mass-specific rates from vector numerics are converted correctly", { # 100 random rates rates <- round(runif(121, -5, 5), 2) all_combs_ms[[4]] <- rates # This just tests one conversion from ul/hr to ug/min # Just to test it actually outputs a numeric vector res1 <- convert_rate(as.numeric(all_combs_ms[[4]]), oxy.unit = "mg/l", time.unit = "min", output.unit = all_combs_ms[18,1], volume = 1.09, mass = as.numeric(all_combs_ms[18,3]), S = S, t = t, P = P) res2 <- convert_rate(as.numeric(all_combs_ms[[4]]), oxy.unit = "mg/l", time.unit = "min", output.unit = all_combs_ms[18,2], volume = 1.09, mass = as.numeric(all_combs_ms[18,3]), S = S, t = t, P = P) res3 <- convert_MR(res1$rate.output, from = all_combs_ms[18,1], to = all_combs_ms[18,2], S = S, t = t, P = P) expect_equal(res2$rate.output, res3) expect_equal(nrow(all_combs_ms), length(res3)) }) # Area-specific rate checks ----------------------------------------------- test_that("convert_MR - area-specific rates from convert_rate objects are converted correctly", { apply(all_combs_as, 1, function(z) { res1 <- convert_rate(rate, oxy.unit = "mg/l", time.unit = "min", output.unit = z[1], volume = 1.09, area = as.numeric(z[3]), S = S, t = t, P = P) res2 <- convert_rate(rate, oxy.unit = "mg/l", time.unit = "min", output.unit = z[2], volume = 1.09, area = as.numeric(z[3]), S = S, t = t, P = P) res3 <- convert_MR(res1, #from = z[1], to = z[2], S = S, t = t, P = P) print(z) expect_equal(res2$rate.output, res3$rate.output) expect_identical(res2$to, res3$to) expect_true(all.equal(res2$summary, res3$summary)) }) }) test_that("convert_MR - area-specific rates from convert_rate objects with multiple rates are converted correctly", { apply(all_combs_as, 1, function(z) { res1 <- convert_rate(rates, oxy.unit = "mg/l", time.unit = "min", output.unit = z[1], volume = 1.09, area = as.numeric(z[3]), S = S, t = t, P = P) res2 <- convert_rate(rates, oxy.unit = "mg/l", time.unit = "min", output.unit = z[2], volume = 1.09, area = as.numeric(z[3]), S = S, t = t, P = P) res3 <- convert_MR(res1, #from = z[1], to = z[2], S = S, t = t, P = P) print(z) expect_equal(res2$rate.output, res3$rate.output) expect_identical(res2$to, res3$to) expect_true(all.equal(res2$summary, res3$summary)) }) }) test_that("convert_MR - area-specific rates from convert_rate.ft objects are converted correctly", { apply(all_combs_as, 1, function(z) { res1 <- convert_rate.ft(rate, oxy.unit = "mg/l", time.unit = "min", flowrate.unit = "l/m", output.unit = z[1], area = as.numeric(z[3]), S = S, t = t, P = P) res2 <- convert_rate.ft(rate, oxy.unit = "mg/l", time.unit = "min", flowrate.unit = "l/m", output.unit = z[2], area = as.numeric(z[3]), S = S, t = t, P = P) res3 <- convert_MR(res1, #from = z[1], to = z[2], S = S, t = t, P = P) #print(z) expect_equal(res2$rate.output, res3$rate.output) expect_identical(res2$to, res3$to) expect_true(all.equal(res2$summary, res3$summary)) }) }) test_that("convert_MR - area-specific rates from convert_rate.ft objects with multiple rates are converted correctly", { apply(all_combs_as, 1, function(z) { res1 <- convert_rate.ft(rates, oxy.unit = "mg/l", time.unit = "min", flowrate.unit = "l/m", output.unit = z[1], area = as.numeric(z[3]), S = S, t = t, P = P) res2 <- convert_rate.ft(rates, oxy.unit = "mg/l", time.unit = "min", flowrate.unit = "l/m", output.unit = z[2], area = as.numeric(z[3]), S = S, t = t, P = P) res3 <- convert_MR(res1, #from = z[1], to = z[2], S = S, t = t, P = P) #print(z) expect_equal(res2$rate.output, res3$rate.output) expect_identical(res2$to, res3$to) expect_true(all.equal(res2$summary, res3$summary)) }) }) test_that("convert_MR - area-specific rates from single numerics are converted correctly", { # 100 random rates rates <- round(runif(121, -5, 5), 2) all_combs_as[[4]] <- rates apply(all_combs_as, 1, function(z) { res1 <- convert_rate(as.numeric(z[4]), oxy.unit = "mg/l", time.unit = "min", output.unit = z[1], volume = 1.09, area = as.numeric(z[3]), S = S, t = t, P = P) res2 <- convert_rate(as.numeric(z[4]), oxy.unit = "mg/l", time.unit = "min", output.unit = z[2], volume = 1.09, area = as.numeric(z[3]), S = S, t = t, P = P) res3 <- convert_MR(res1$rate.output, from = z[1], to = z[2], S = S, t = t, P = P) #print(z) expect_equal(res2$rate.output, res3) }) }) test_that("convert_MR - area-specific rates from vector numerics are converted correctly", { # 100 random rates rates <- round(runif(121, -5, 5), 2) all_combs_as[[4]] <- rates # This just tests one conversion from ul/hr to ug/min # Just to test it actually outputs a numeric vector res1 <- convert_rate(as.numeric(all_combs_as[[4]]), oxy.unit = "mg/l", time.unit = "min", output.unit = all_combs_as[18,1], volume = 1.09, area = as.numeric(all_combs_as[18,3]), S = S, t = t, P = P) res2 <- convert_rate(as.numeric(all_combs_as[[4]]), oxy.unit = "mg/l", time.unit = "min", output.unit = all_combs_as[18,2], volume = 1.09, area = as.numeric(all_combs_as[18,3]), S = S, t = t, P = P) res3 <- convert_MR(res1$rate.output, from = all_combs_as[18,1], to = all_combs_as[18,2], S = S, t = t, P = P) expect_equal(res2$rate.output, res3) expect_equal(nrow(all_combs_as), length(res3)) }) # convert.rate.ft --------------------------------------------------------- # Extensive output tests # # These take absolutely FOREVER! # This creates a matrix of every combination of input and output values and # units, adds the appropriate divisor for the volume unit, and an iteration # number. Then expect_equal compares the outputs of cr and crft, prints the # inputs so you can see where it stops if it meets an error. test_that("convert_rate and convert_rate.ft output same results - huge block of tests", { #job::job({ # Absolute rates ---------------------------------------------------------- inputs_abs <- list( # random rates oxy.rates = c(-0.002755, -0.035, -0.88, -5.42, 0.00132, 0.0484, 0.5902, 6.4747), # input oxygen units oxy.units = c("mg/l", "hPa", "ug/l", "%Air", "mmol/L", "umol/kg", "inHg", "mL/L"), # flow units separated flow.vol.units = c("ul", "ml", "L"), flow.time.units = c("s", "m", "h", "d"), # output units out.units = c("ug/s", "mg/min", "umol/h", "mmol/day", "mL/min") ) # all combinations grid_abs <- expand.grid(inputs_abs, stringsAsFactors = FALSE) # create flow units grid_abs$flow.units <- paste(grid_abs$flow.vol.units, grid_abs$flow.time.units, sep = "/") # add appropriate volume divisor grid_abs$vol.div <- apply(grid_abs, 1, function(z) { if(z[[3]] == "ul") return(1000000) else if(z[[3]] == "ml") return(1000) else if(z[[3]] == "L") return(1) }) # add iteration grid_abs$iter <- 1:nrow(grid_abs) # S t P for units which require them S = 30 t = 15 P = 1 test_that("convert_rate and convert_rate.ft output same results - ABSOLUTE RATES", { apply(grid_abs, 1, function(z) { expect_equal(suppressMessages(convert_rate.ft(as.numeric(z[[1]]), oxy.unit = z[[2]], flowrate.unit = z[[6]], output.unit = z[[5]], area = NULL, mass = NULL, S = S, t = t, P = P))$rate.output, suppressMessages(convert_rate(as.numeric(z[[1]]), oxy.unit = z[[2]], time.unit = z[[4]], volume = 1/as.numeric(z[[7]]), output.unit = z[[5]], area = NULL, mass = NULL, S = S, t = t, P = P))$rate.output, label = glue::glue("FAILED on row {z[[8]]}")) #print(paste(z)) }) }) # Mass-specific rates ----------------------------------------------------- # not row indexes change because of extra mass/area columns inputs_ms <- list( # random rates oxy.rates = c(-0.002755, -0.035, -0.88, -5.42, 0.00132, 0.0484, 0.5902, 6.4747), # input oxygen units oxy.units = c("mg/l", "hPa", "ug/l", "%Air", "mmol/L", "umol/kg", "inHg", "mL/L"), # flow units separated flow.vol.units = c("ul", "ml", "L"), flow.time.units = c("s", "m", "h", "d"), # output units - mass spec out.units = c("ug/s/ug", "mg/min/mg", "umol/h/g", "mmol/day/kg", "mL/min/g"), mass = c(0.0034, 0.065, 0.122, 2.78, 87.6) # all in kg ) # all combinations grid_ms <- expand.grid(inputs_ms, stringsAsFactors = FALSE) # create flow units grid_ms$flow.units <- paste(grid_ms$flow.vol.units, grid_ms$flow.time.units, sep = "/") # add appropriate volume divisor grid_ms$vol.div <- apply(grid_ms, 1, function(z) { if(z[[3]] == "ul") return(1000000) else if(z[[3]] == "ml") return(1000) else if(z[[3]] == "L") return(1) }) # add iteration grid_ms$iter <- 1:nrow(grid_ms) # S t P for units which require them S = 30 t = 15 P = 1 test_that("convert_rate and convert_rate.ft output same results - MASS SPECIFIC", { apply(grid_ms, 1, function(z) { expect_equal(suppressMessages(convert_rate.ft(as.numeric(z[[1]]), oxy.unit = z[[2]], flowrate.unit = z[[7]], output.unit = z[[5]], area = NULL, mass = as.numeric(z[[6]]), S = S, t = t, P = P))$rate.output, suppressMessages(convert_rate(as.numeric(z[[1]]), oxy.unit = z[[2]], time.unit = z[[4]], volume = 1/as.numeric(z[[8]]), output.unit = z[[5]], area = NULL, mass = as.numeric(z[[6]]), S = S, t = t, P = P))$rate.output, label = glue::glue("FAILED on row {z[[9]]}")) #print(paste(z)) }) }) # Area-specific rates ----------------------------------------------------- inputs_as <- list( # random rates oxy.rates = c(-0.002755, -0.035, -0.88, -5.42, 0.00132, 0.0484, 0.5902, 6.4747), # input oxygen units oxy.units = c("mg/l", "hPa", "ug/l", "%Air", "mmol/L", "umol/kg", "inHg", "mL/L"), # flow units separated flow.vol.units = c("ul", "ml", "L"), flow.time.units = c("s", "m", "h", "d"), # output units - area spec out.units = c("ug/s/mm2", "mg/min/cm2", "umol/h/m2", "mmol/day/km2", "mL/min/mm2"), area = c(0.0034, 0.065, 0.122, 2.78, 87.6) # all in m2 ) # all combinations grid_as <- expand.grid(inputs_as, stringsAsFactors = FALSE) # create flow units grid_as$flow.units <- paste(grid_as$flow.vol.units, grid_as$flow.time.units, sep = "/") # add appropriate volume divisor grid_as$vol.div <- apply(grid_as, 1, function(z) { if(z[[3]] == "ul") return(1000000) else if(z[[3]] == "ml") return(1000) else if(z[[3]] == "L") return(1) }) # add iteration grid_as$iter <- 1:nrow(grid_as) # S t P for units which require them S = 30 t = 15 P = 1 test_that("convert_rate and convert_rate.ft output same results - AREA SPECIFIC", { apply(grid_as, 1, function(z) { expect_equal(suppressMessages(convert_rate.ft(as.numeric(z[[1]]), oxy.unit = z[[2]], flowrate.unit = z[[7]], output.unit = z[[5]], mass = NULL, area = as.numeric(z[[6]]), S = S, t = t, P = P))$rate.output, suppressMessages(convert_rate(as.numeric(z[[1]]), oxy.unit = z[[2]], time.unit = z[[4]], volume = 1/as.numeric(z[[8]]), output.unit = z[[5]], mass = NULL, area = as.numeric(z[[6]]), S = S, t = t, P = P))$rate.output, label = glue::glue("FAILED on row {z[[9]]}")) #print(paste(z)) }) }) #}) #job::job end }) # select_rate ------------------------------------------------------------- # These are tests which take a wee bit too long # # Create test objects { # large object conv_rt_ar_low_obj <- inspect(sardine.rd) %>% auto_rate(method = "lowest", plot = FALSE) %>% convert_rate(oxy.unit = "mg/l", time.unit = "min", output.unit = "mg/h/g", volume = 2.379, mass = 0.006955) } test_that("select_rate: works with method = row_omit and n input of multiple random", { skip_on_cran() # 10 random rows ran <- round(runif(5, 500, 4500)) # runs ok expect_error(conv_rt_ar_low_obj_subset_row_omit <- select_rate(conv_rt_ar_low_obj, method = "row_omit", n = ran), regexp = NA) ## check omitted times not within times for each regression for(i in ran) apply(conv_rt_ar_low_obj_subset_row_omit$summary, 1, function(x) expect_false(i %in% x[7]:x[8])) }) test_that("select_rate: works with method = row_omit and n input of range as both range and vector gives same result", { skip_on_cran() expect_identical(conv_rt_ar_subset_row_omit <- select_rate(conv_rt_ar_low_obj, method = "row_omit", n = c(2000,2200))$summary, conv_rt_ar_subset_row_omit <- select_rate(conv_rt_ar_low_obj, method = "row_omit", n = 2000:2200)$summary) }) test_that("select_rate: works with method = time_omit and n input of multiple random", { skip_on_cran() # 10 random times ran <- runif(5, 500, 4500) # runs ok expect_error(conv_rt_ar_low_obj_subset_time_omit <- select_rate(conv_rt_ar_low_obj, method = "time_omit", n = ran), regexp = NA) ## check omitted times not within times for each regression for(i in ran) apply(conv_rt_ar_low_obj_subset_time_omit$summary, 1, function(x) expect_false(i %in% x[9]:x[10])) }) test_that("select_rate: works with method = time_omit and n input of range as both range and vector gives same result", { skip_on_cran() expect_identical(conv_rt_ar_subset_row_omit <- select_rate(conv_rt_ar_low_obj, method = "time_omit", n = c(1000,1500))$summary, conv_rt_ar_subset_row_omit <- select_rate(conv_rt_ar_low_obj, method = "time_omit", n = 1000:1500)$summary) }) }) ## end capture.output