#Tests for the trait wrapper functions cat("#### Test traitSmooth with small example\n") test_that("exampleData_traitSmooth", { skip_if_not_installed("growthPheno") skip_on_cran() library(growthPheno) data(exampleData) testthat::expect_true(all(abs(longi.dat$sPSA[1:3] - c(51.18456, 87.67343, 107.68232)) < 1e-03)) testthat::expect_true(all(abs(longi.dat$sPSA.AGR[2:4] - c(18.24443, 20.00889, 22.13115)) < 1e-03)) vline <- list(ggplot2::geom_vline(xintercept=29, linetype="longdash", linewidth=1)) trt.facets <- c("Smarthouse", "Treatment.1") #Get a chosen smooth - can set an option without worrying about the other option in traitSmooth testthat::expect_warning( smth.dat <- traitSmooth(data = longi.dat, response = "PSA", response.smoothed = "sPSA", individuals = "Snapshot.ID.Tag", times = "DAP", keep.columns = trt.facets, profile.plot.args = args4profile_plot(facet.y = trt.facets, include.raw = "no", breaks.spacing.x = -2, addMediansWhiskers = TRUE, #used whenever plotLongitudinal is used ggplotFuncs = vline), chosen.plot.args = args4chosen_plot(facet.y = trt.facets), mergedata = longi.dat), regexp = "containing missing values or values outside the scale range \\(\\`geom_vline\\(\\)\\`\\)") testthat::expect_equal(nrow(smth.dat), 280) testthat::expect_equal(ncol(smth.dat), 37) testthat::expect_true(all(names(longi.dat) %in% names(smth.dat))) testthat::expect_true(all(longi.dat$Snapshot.ID.Tag == smth.dat$Snapshot.ID.Tag)) testthat::expect_true(all(c("Smarthouse","Treatment.1","PSA","PSA.AGR","PSA.RGR", "sPSA","sPSA.AGR","sPSA.RGR") %in% names(smth.dat))) #Get the full set of smooths smth.dat <- traitSmooth(data = longi.dat, response = "PSA", response.smoothed = "sPSA", individuals = "Snapshot.ID.Tag",times = "DAP", keep.columns = trt.facets, chosen.smooth.args = NULL, which.plots = "profile", profile.plot.args = args4profile_plot(facet.y = trt.facets, include.raw = "no", collapse.facets.x = FALSE, breaks.spacing.x = -2, ggplotFuncs = vline)) testthat::expect_equal(nrow(smth.dat), 1960) testthat::expect_equal(ncol(smth.dat), 16) #Supply smth.dat and do just the profile plots tmp.dat <- traitSmooth(data = smth.dat, response = "PSA", response.smoothed = "sPSA", individuals = "Snapshot.ID.Tag",times = "DAP", chosen.smooth.args = NULL, which.plots = "profile", profile.plot.args = args4profile_plot(facet.y = trt.facets, include.raw = "facet.x", collapse.facets.x = FALSE, breaks.spacing.x = -2, ggplotFuncs = vline)) testthat::expect_equal(nrow(smth.dat), 1960) testthat::expect_equal(ncol(smth.dat), 16) #Supply smth.dat and do just the chosen plots tmp.dat <- traitSmooth(data = smth.dat, response = "PSA", response.smoothed = "sPSA", individuals = "Snapshot.ID.Tag",times = "DAP", which.plots = "none", chosen.smooth.args = args4chosen_smooth(lambda = 3.162), chosen.plot.args = args4chosen_plot(facet.y = trt.facets, ggplotFuncs = vline), mergedata = longi.dat) testthat::expect_equal(nrow(tmp.dat), 280) testthat::expect_equal(ncol(tmp.dat), 37) testthat::expect_true(all(names(longi.dat) %in% names(tmp.dat))) testthat::expect_true(all(longi.dat$Snapshot.ID.Tag == tmp.dat$Snapshot.ID.Tag)) testthat::expect_true(all(c("Smarthouse","Treatment.1","sPSA","sPSA.AGR","sPSA.RGR") %in% names(tmp.dat))) testthat::expect_true(all(abs(tmp.dat$sPSA[1:3] - c(58.6448, 87.0271, 105.4621)) < 1e-03)) testthat::expect_true(all(abs(tmp.dat$sPSA.AGR[2:4] - c(14.19115, 18.43499, 21.57451)) < 1e-03)) #Extract a single.smooth tmp.dat <- traitSmooth(data = smth.dat, response = "PSA", response.smoothed = "sPSA", individuals = "Snapshot.ID.Tag",times = "DAP", smoothing.args = args4smoothing(spline.types = "PS", df = NULL, lambdas = 3.162), which.plots = "none", chosen.smooth.args = NULL, chosen.plot.args = NULL) testthat::expect_equal(nrow(tmp.dat), 280) testthat::expect_equal(ncol(tmp.dat), 11) #Produce a single smooth testthat::expect_warning( smth.dat <- traitSmooth(data = longi.dat, response = "PSA", response.smoothed = "sPSA", individuals = "Snapshot.ID.Tag",times = "DAP", keep.columns = trt.facets, smoothing.args = args4smoothing(spline.types = "PS", df = NULL, lambdas = 3.162), chosen.smooth.args = NULL, which.plots = "profile", profile.plot.args = args4profile_plot(plots.by = "Type", facet.x = trt.facets, facet.y = "Tuning", include.raw = "facet.y", collapse.facets.x = FALSE, facet.scales = "free_y", breaks.spacing.x = -2, angle.x = 90, ggplotFuncs = vline)), regexp = "Removed 4 rows containing missing values or values outside the scale range \\(\\`geom_vline\\(\\)\\`\\)") testthat::expect_equal(nrow(smth.dat), 280) testthat::expect_equal(ncol(smth.dat), 37) #Test plotting raw in yfacet when yfacet is "." testthat::expect_warning( smth.dat <- traitSmooth(data = longi.dat, response = "PSA", response.smoothed = "sPSA", individuals = "Snapshot.ID.Tag",times = "DAP", keep.columns = trt.facets, smoothing.args = args4smoothing(spline.types = "PS", df = NULL, lambdas = 3.162), chosen.smooth.args = NULL, which.plots = "profile", profile.plot.args = args4profile_plot(plots.by = c("Type","Method","Tuning"), facet.x = trt.facets, facet.y = ".", include.raw = "facet.y", collapse.facets.x = FALSE, facet.scales = "free_y", breaks.spacing.x = -2, angle.x = 90, ggplotFuncs = vline)), regexp = "Removed 4 rows containing missing values or values outside the scale range \\(\\`geom_vline\\(\\)\\`\\)") testthat::expect_equal(nrow(smth.dat), 280) testthat::expect_equal(ncol(smth.dat), 37) #Test plotting raw in xfacet when xfacet is "." testthat::expect_warning( smth.dat <- traitSmooth(data = longi.dat, response = "PSA", response.smoothed = "sPSA", individuals = "Snapshot.ID.Tag",times = "DAP", keep.columns = trt.facets, smoothing.args = args4smoothing(spline.types = "PS", df = NULL, lambdas = 3.162), chosen.smooth.args = NULL, which.plots = "profile", profile.plot.args = args4profile_plot(plots.by = c("Type","Method","Tuning"), facet.x = ".", facet.y = trt.facets, include.raw = "facet.x", collapse.facets.x = FALSE, facet.scales = "free_y", breaks.spacing.x = -2, angle.x = 90, ggplotFuncs = vline)), regexp = "Removed 4 rows containing missing values or values outside the scale range \\(\\`geom_vline\\(\\)\\`\\)") testthat::expect_equal(nrow(smth.dat), 280) testthat::expect_equal(ncol(smth.dat), 37) #Test scales.pf #Supply smth.dat and do just the profile plots smth.dat <- traitSmooth(data = longi.dat, response = "PSA", response.smoothed = "sPSA", individuals = "Snapshot.ID.Tag",times = "DAP", keep.columns = trt.facets, chosen.smooth = NULL, which.plots = "profile", profile.plot.args = args4profile_plot(plots.by = "Type", facet.x = trt.facets, facet.y = "Tuning", include.raw = "facet.y", collapse.facets.x = FALSE, facet.scales = "free_y", breaks.spacing.x = -2, angle.x = 90, ggplotFuncs = vline)) testthat::expect_equal(nrow(smth.dat), 1960) testthat::expect_equal(ncol(smth.dat), 16) }) cat("#### Test traitExtractFeatures with tomato example\n") test_that("tomato_traitExtractFeatures", { skip_if_not_installed("growthPheno") skip_on_cran() library(dae) library(growthPheno) data(tomato.dat) DAP.endpts <- c(18,22,27,33,39,43,51) nDAP.endpts <- length(DAP.endpts) DAP.starts <- DAP.endpts[-nDAP.endpts] DAP.stops <- DAP.endpts[-1] DAP.mids <- (DAP.starts + DAP.stops)/2 DAP.segs <- list(c(DAP.endpts[1]-1, 39), c(40, DAP.endpts[nDAP.endpts])) #Add PSA rates and smooth PSA, also producing sPSA rates tom.dat <- byIndv4Times_SplinesGRs(data = tomato.dat, response = "PSA", response.smoothed = "sPSA", times = "DAP", rates.method = "differences", smoothing.method = "log", spline.type = "PS", lambda = 1, smoothing.segments = DAP.segs) #Smooth WU tom.dat <- byIndv4Times_SplinesGRs(data = tom.dat, response = "WU", response.smoothed = "sWU", rates.method = "none", times = "DAP", smoothing.method = "direct", spline.type = "PS", lambda = 10^(-0.5), smoothing.segments = DAP.segs) testthat::expect_equal(nrow(tom.dat), 1120) testthat::expect_equal(ncol(tom.dat), 20) #Test with overlapping segments and rates.method = "differences", DAP.segs <- list(c(DAP.endpts[1]-1, 39), c(38, DAP.endpts[nDAP.endpts])) #Add PSA rates and smooth PSA, also producing sPSA rates tmp.dat <- testthat::expect_error( byIndv4Times_SplinesGRs(data = tomato.dat, response = "PSA", response.smoothed = "sPSA", times = "DAP", rates.method = "differences", smoothing.method = "log", spline.type = "PS", lambda = 1, smoothing.segments = DAP.segs), regexp = "rates.method must be `none` when times values occur in more than one smoothing segment") #Test with overlapping segments and rates.method = "none", #Add PSA rates and smooth PSA, also producing sPSA rates tmp.dat <- testthat::expect_warning( byIndv4Times_SplinesGRs(data = tomato.dat, response = "PSA", response.smoothed = "sPSA", times = "DAP", rates.method = "none", smoothing.method = "log", spline.type = "PS", lambda = 1, smoothing.segments = DAP.segs), regexp = paste0("The values for some times occur in multiple smoothing.segments and so some individuals ", "will have multiple rows in the returned data.frame, one for each segment in which the ", "times occur.")) testthat::expect_true(all(table(tmp.dat$DAP) %in% c(32,64))) testthat::expect_equal(nrow(tmp.dat), 1184) table(with(tmp.dat, tmp.dat[c(DAP %in% 38:39),]$DAP)) tmp <- with(tmp.dat, tmp.dat[c(DAP %in% 38:39),c("DAP","sPSA")]) tmp$DAP <- factor(tmp$DAP) testthat::expect_true(all(table(tmp$DAP) == 64)) testthat::expect_true(all(diff(tmp$sPSA) != 0)) ### Omit responses for the outlier plant omit <- with(tom.dat, Zn==90 & AMF=="+" & Block ==4) responses.all <- names(tom.dat)[match("Weight.After", names(tom.dat)):length(tom.dat)] tom.dat[responses.all] <- lapply(tom.dat[responses.all], function(kcol, omit) { kcol[omit] <- NA return(kcol) }, omit = omit) #Set up for individual traits indv.cols <- c("Snapshot.ID.Tag", "Lane", "Position", "Block", "Cart", "AMF", "Zn") indv.ini <- subset(tom.dat, subset = DAP == DAP.endpts[1], select = indv.cols) #'## Extract single-valued smoothed traits for each individual indv.dat <- traitExtractFeatures(data = tom.dat, starts.intvl = DAP.starts, stops.intvl = DAP.stops, responses4intvl.rates = "sPSA", growth.rates = c("AGR", "RGR"), water.use4intvl.traits = "sWU", responses4water = "sPSA", responses4singletimes = "sPSA", responses4overall.total = "sWU", responses4overall.max = "sPSA.AGR", mergedata = indv.ini) testthat::expect_equal(nrow(indv.dat), 32) testthat::expect_equal(ncol(indv.dat), 47) #'## Extract single-valued unsmoothed and smoothed traits in parallel for each individual indv.dat <- traitExtractFeatures(data = tom.dat, times = "DAP", starts.intvl = DAP.starts, stops.intvl = DAP.stops, responses4intvl.rates = c("PSA", "sPSA"), growth.rates = c("AGR", "RGR"), water.use4intvl.traits = c("WU","sWU"), responses4water = c("PSA","sPSA"), responses4singletimes = c("PSA", "sPSA"), responses4overall.rates = c("PSA", "sPSA"), water.use4overall.water = c("WU","sWU"), responses4overall.water = c("PSA","sPSA"), intvl.overall = c(18,51), mergedata = indv.ini) testthat::expect_equal(nrow(indv.dat), 32) testthat::expect_equal(ncol(indv.dat), 7 + (2*7) + (4*6) + (6*6) + 4 + 6) #91 suffs <- paste(DAP.starts, DAP.stops, sep = "to") testthat::expect_true(all(names(indv.dat)[-(1:7)] == c(as.vector(outer(c("PSA","sPSA"), DAP.endpts, paste, sep = ".")), as.vector(outer(c("PSA.AGR","PSA.RGR"), suffs, paste, sep = ".")), as.vector(outer(c("sPSA.AGR","sPSA.RGR"), suffs, paste, sep = ".")), as.vector(outer(c("WU","WUR","PSA.WUI"), suffs, paste, sep = ".")), as.vector(outer(c("sWU","sWUR","sPSA.sWUI"), suffs, paste, sep = ".")), "PSA.AGR","PSA.RGR","sPSA.AGR","sPSA.RGR","WU","WUR","PSA.WUI", "sWU","sWUR","sPSA.sWUI"))) #'## Extract water traits only indv.dat <- traitExtractFeatures(data = tom.dat, times = "DAP", starts.intvl = DAP.starts, stops.intvl = DAP.stops, water.trait.types = "WU", water.use4intvl.traits = c("WU","sWU"), water.use4overall.water = c("WU","sWU"), intvl.overall = c(18,51), suffix.overall = "total", mergedata = indv.ini) testthat::expect_equal(nrow(indv.dat), 32) testthat::expect_equal(ncol(indv.dat), 7 + (2*6) + 2) #91 suffs <- paste(DAP.starts, DAP.stops, sep = "to") testthat::expect_true(all(names(indv.dat)[-(1:7)] == c(as.vector(outer("WU", suffs, paste, sep = ".")), as.vector(outer("sWU", suffs, paste, sep = ".")), "WU.total","sWU.total"))) #'## Extract single-valued unsmoothed and smoothed traits in parallel for each individual with "_" separator indv.dat <- traitExtractFeatures(data = tom.dat, times = "DAP", starts.intvl = DAP.starts, stops.intvl = DAP.stops, responses4intvl.rates = c("PSA", "sPSA"), growth.rates = c("AGR", "RGR"), water.use4intvl.traits = c("WU","sWU"), responses4water = c("PSA","sPSA"), responses4singletimes = c("PSA", "sPSA"), responses4overall.rates = c("PSA", "sPSA"), water.use4overall.water = c("WU","sWU"), responses4overall.water = c("PSA","sPSA"), intvl.overall = c(18,51), sep.growth.rates = "_", sep.water.traits = "_", sep.suffix.times = "_", sep.times.intvl = "_", mergedata = indv.ini) testthat::expect_equal(nrow(indv.dat), 32) testthat::expect_equal(ncol(indv.dat), 7 + (2*7) + (4*6) + (6*6) + 4 + 6) #91 suffs <- paste(DAP.starts, DAP.stops, sep = "_") testthat::expect_true(all(names(indv.dat)[-(1:7)] == c(as.vector(outer(c("PSA","sPSA"), DAP.endpts, paste, sep = "_")), as.vector(outer(c("PSA_AGR","PSA_RGR"), suffs, paste, sep = "_")), as.vector(outer(c("sPSA_AGR","sPSA_RGR"), suffs, paste, sep = "_")), as.vector(outer(c("WU","WU_R","PSA_WU_I"), suffs, paste, sep = "_")), as.vector(outer(c("sWU","sWU_R","sPSA_sWU_I"), suffs, paste, sep = "_")), "PSA_AGR","PSA_RGR","sPSA_AGR","sPSA_RGR","WU","WU_R","PSA_WU_I", "sWU","sWU_R","sPSA_sWU_I"))) #Check the overall values testthat::expect_true(all((indv.dat[1, c("PSA_AGR","PSA_RGR","sPSA_AGR","sPSA_RGR","WU","WU_R","PSA_WU_I", "sWU","sWU_R","sPSA_sWU_I")] - c( 4.899273,0.08852807,4.897457,0.08655332,932,28.24242,0.1734721, 921.4677,27.92326,0.1753898)) < 1e-04)) #'## Extract single-valued unsmoothed and smoothed traits in parallel for each individual with no separator indv.dat <- traitExtractFeatures(data = tom.dat, times = "DAP", starts.intvl = DAP.starts, stops.intvl = DAP.stops, responses4intvl.rates = c("PSA", "sPSA"), growth.rates = c("AGR", "RGR"), water.use4intvl.traits = c("WU","sWU"), responses4water = c("PSA","sPSA"), responses4singletimes = c("PSA", "sPSA"), responses4overall.rates = c("PSA", "sPSA"), water.use4overall.water = c("WU","sWU"), responses4overall.water = c("PSA","sPSA"), intvl.overall = c(18,51), sep.growth.rates = "", sep.water.traits = "", sep.suffix.times = "", sep.times.intvl = "", mergedata = indv.ini) testthat::expect_equal(nrow(indv.dat), 32) testthat::expect_equal(ncol(indv.dat), 7 + (2*7) + (4*6) + (6*6) + 4 + 6) #91 suffs <- paste(DAP.starts, DAP.stops, sep = "") testthat::expect_true(all(names(indv.dat)[-(1:7)] == c(as.vector(outer(c("PSA","sPSA"), DAP.endpts, paste, sep = "")), as.vector(outer(c("PSAAGR","PSARGR"), suffs, paste, sep = "")), as.vector(outer(c("sPSAAGR","sPSARGR"), suffs, paste, sep = "")), as.vector(outer(c("WU","WUR","PSAWUI"), suffs, paste, sep = "")), as.vector(outer(c("sWU","sWUR","sPSAsWUI"), suffs, paste, sep = "")), "PSAAGR","PSARGR","sPSAAGR","sPSARGR","WU","WUR","PSAWUI", "sWU","sWUR","sPSAsWUI"))) #one AGR for sPSA and its overall AGR indv.dat <- traitExtractFeatures(data = tom.dat, times = "DAP", starts.intvl = DAP.starts, stops.intvl = DAP.stops, responses4intvl.rates = "sPSA", growth.rates = "AGR", responses4overall.rates = "sPSA", intvl.overall = c(18,51), mergedata = indv.ini) testthat::expect_equal(nrow(indv.dat), 32) testthat::expect_equal(ncol(indv.dat), 14) #Overall values only for both unsmoothed and smoothed traits in parallel indv.dat <- traitExtractFeatures(data = tom.dat, times = "DAP", growth.rates = c("AGR", "RGR"), responses4overall.rates = c("PSA", "sPSA"), water.use4overall.water = c("WU","sWU"), responses4overall.water = c("PSA","sPSA"), intvl.overall = c(18,51), mergedata = indv.ini) #Check the overall values testthat::expect_true(all((indv.dat[1, c("PSA.AGR","PSA.RGR","sPSA.AGR","sPSA.RGR","WU","WUR","PSA.WUI", "sWU","sWUR","sPSA.sWUI")] - c( 4.899273,0.08852807,4.897457,0.08655332,932,28.24242,0.1734721, 921.4677,27.92326,0.1753898)) < 1e-04)) testthat::expect_equal(nrow(indv.dat), 32) testthat::expect_equal(ncol(indv.dat), 17) #Overall values only for smoothed traits testthat::expect_error(indv.diff.dat <- traitExtractFeatures(data = tom.dat, times = "DAP", responses4overall.rates = "sPSA", water.use4overall.water = "sWU", responses4overall.water = "sPSA", intvl.overall = c(18,51), mergedata = indv.ini), regexp = "growth.rates needs to be set for responses4overall.rates") indv.diff.dat <- traitExtractFeatures(data = tom.dat, times = "DAP", growth.rates = "AGR", responses4overall.rates = "sPSA", water.use4overall.water = "sWU", responses4overall.water = "sPSA", intvl.overall = c(18,51), mergedata = indv.ini) testthat::expect_equal(nrow(indv.diff.dat), 32) testthat::expect_equal(ncol(indv.diff.dat), 11) #only overall water traits indv.diff.dat <- traitExtractFeatures(data = tom.dat, times = "DAP", water.use4overall.water = "sWU", responses4overall.water = "sPSA", intvl.overall = c(18,51), mergedata = indv.ini) testthat::expect_equal(nrow(indv.diff.dat), 32) testthat::expect_equal(ncol(indv.diff.dat), 10) #Overall values only for unsmoothed and smoothed traits in parallel using ratesaverage testthat::expect_silent( indv.dat <- traitExtractFeatures(data = tom.dat, times = "DAP", growth.rates = c("AGR", "RGR"), rates.method = "ratesaverage", responses4overall.rates = c("PSA", "sPSA"), water.use4overall.water = c("WU","sWU"), responses4overall.water = c("PSA","sPSA"), intvl.overall = c(18,51), mergedata = indv.ini)) testthat::expect_equal(nrow(indv.dat), 32) testthat::expect_equal(ncol(indv.dat), 17) #Overall values only for smoothed traits using ratesaverage indv.dat <- traitExtractFeatures(data = tom.dat, times = "DAP", starts.intvl = DAP.starts, stops.intvl = DAP.stops, responses4intvl.rates = "sPSA", growth.rates = "AGR", rates.method = "ratesaverage", responses4overall.rates = "sPSA", water.use4overall.water = "sWU", responses4overall.water = "sPSA", intvl.overall = c(18,51), mergedata = indv.ini) testthat::expect_equal(nrow(indv.dat), 32) testthat::expect_equal(ncol(indv.dat), 17) #Check the overall values indv.dat <- traitExtractFeatures(data = tom.dat, times = "DAP", growth.rates = c("AGR", "RGR"), rates.method = "ratesaverage", responses4overall.rates = c("PSA","sPSA"), water.use4overall.water = c("WU","sWU"), responses4overall.water = c("PSA","sPSA"), intvl.overall = c(18,51), mergedata = indv.ini) testthat::expect_true(all((indv.dat[1, c("PSA.AGR","PSA.RGR","sPSA.AGR","sPSA.RGR","WU","WUR","PSA.WUI", "sWU","sWUR","sPSA.sWUI")] - c( 4.899273,0.08852807,4.897457,0.08655332,932,28.24242,0.1734721, 921.4677,27.92326,0.1753898)) < 1e-04)) #Only singletimes #'## Extract single-valued unsmoothed and smoothed traits in parallel for each individual with no separator indv.dat <- traitExtractFeatures(data = tom.dat, times = "DAP", responses4singletimes = c("PSA", "sPSA"), times.single = DAP.endpts, mergedata = indv.ini) testthat::expect_equal(nrow(indv.dat), 32) testthat::expect_equal(ncol(indv.dat), 21) suffs <- paste(DAP.starts, DAP.stops, sep = "") testthat::expect_true(all(names(indv.dat)[-(1:7)] == as.vector(outer(c("PSA","sPSA"), DAP.endpts, paste, sep = ".")))) })