# 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
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.