tests/testthat/testTraitWrappers.r
In briencj/growthPheno: Functional Analysis of Phenotypic Growth Data to Smooth and Extract Traits
#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)
### 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 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 = "."))))
})
briencj/growthPheno documentation built on April 14, 2025, 6:17 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#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)
### 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 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 = "."))))
})
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.