cat("#### Test \\dontrun examples for exampleData\n")
test_that("exampleData_growthPheno", {
skip_if_not_installed("growthPheno")
skip_on_cran()
library(growthPheno)
library(ggplot2)
#Load the data
data(exampleData)
#longi.dat
longit.dat <- prepImageData(data=raw.dat, smarthouse.lev=1)
testthat::expect_equal(ncol(longit.dat), 35)
longit.dat <- prepImageData(data=raw.dat, smarthouse.lev=1,
traits = list(a = "Area", c = "Compactness"),
labsCamerasViews = list(all = c("SV1", "SV2", "TV"),
t = "TV"))
testthat::expect_equal(ncol(longit.dat), 20)
longit.dat <- prepImageData(data=raw.dat, smarthouse.lev=1,
traits = c("Area.SV1", "Area.SV2", "Area.TV",
"Compactness.TV"),
labsCamerasViews = NULL)
testthat::expect_equal(ncol(longit.dat), 20)
longit.dat <- prepImageData(data=raw.dat, smarthouse.lev=1,
calcWaterUse = FALSE,
traits = list(img = c("Area", "Compactness"),
H20 = c("Weight.Before","Weight.After",
"Water.Amount")),
labsCamerasViews = list(all = c("SV1", "SV2", "TV"),
H2O = NULL))
testthat::expect_equal(ncol(longit.dat), 21)
#plotImagetimes
longit.dat <- calcTimes(longit.dat, imageTimes = "Snapshot.Time.Stamp",
timePositions = "Hour")
testthat::expect_equal(ncol(longit.dat), 21)
testthat::expect_message(
plotImagetimes(data = longi.dat, intervals = "DAP", timePositions = "Hour",
ggplotFuncs=list(scale_colour_gradient(low="grey20", high="black"),
geom_line(aes(group=Snapshot.ID.Tag, colour=Lane)))))
#plotProfiles
testthat::expect_true("sPSA" %in% names(longi.dat))
testthat::expect_silent(
plotProfiles(data = longi.dat, response = "sPSA"))
testthat::expect_silent(
plt <- plotProfiles(data = longi.dat, response = "sPSA", times = "DAP",
y.title = "sPSA (kpixels)",
facet.x = "Treatment.1", facet.y = "Smarthouse",
printPlot=FALSE))
testthat::expect_message(
plt <- plt + ggplot2::geom_vline(xintercept=29, linetype="longdash", linewidth=1) +
ggplot2::scale_x_continuous(breaks=seq(28, 42, by=2)) +
ggplot2::scale_y_continuous(limits=c(0,750)))
testthat::expect_silent(
print(plt))
testthat::expect_silent(
plotProfiles(data = longi.dat, response = "sPSA", times = "DAP",
y.title = "sPSA (kpixels)",breaks.spacing.x = 2,
facet.x = "Treatment.1", facet.y = "Smarthouse",
ggplotFuncs = list(ggplot2::geom_vline(xintercept=29, linetype="longdash",
size=1),
ggplot2::scale_y_continuous(limits=c(0,750)))))
#plotAnom
testthat::expect_warning(
anomalous <- plotAnom(longi.dat, response="sPSA.AGR", times = "DAP",
lower=2.5, start.time=40,
vertical.line=29,
breaks.spacing.x = 2,
whichPrint=c("innerPlot"),
y.title="sPSA AGR (kpixels)"),
regexp = "Removed 1 row containing missing values or values outside the scale range \\(\\`geom_vline\\(\\)\\`\\)")
#plotDeviationsBoxes
testthat::expect_silent(
plotDeviationsBoxes(longi.dat, observed = "PSA", smoothed = "sPSA",
x.factor="DAP", df =5))
#probeSmooths
vline <- list(ggplot2::geom_vline(xintercept=29, linetype="longdash", size=1))
testthat::expect_warning(
tmp <- probeSmooths(data = longi.dat,
response = "PSA", times = "DAP",
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "N",
df = c(4,7), lambdas = NULL),
profile.plot.args =
args4profile_plot(facet.x = "Tuning",
facet.y = "Treatment.1",
ggplotFuncs = vline)),
regexp = "Removed 6 rows containing missing values or values outside the scale range \\(\\`geom_vline\\(\\)\\`\\)")
testthat::expect_equal(nrow(tmp), 560)
testthat::expect_equal(ncol(tmp), 15)
testthat::expect_silent(
traits <- probeSmooths(data = longi.dat, response = "PSA",
individuals = "Snapshot.ID.Tag",
times = "DAP", keep.columns = "Treatment.1",
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "N",
df = c(4,7), lambdas = NULL),
which.plots = "none"))
testthat::expect_silent(
med <- plotSmoothsMedianDevns(data = traits,
response = "PSA", response.smoothed = "sPSA",
times = "DAP",
x.title = "DAP",
trait.types = "response",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = ".", facet.y = "Treatment.1",
propn.types = 0.05,
ggplotFuncs = vline)))
#smoothSpline
testthat::expect_silent(
fit <- smoothSpline(longi.dat, response = "PSA", response.smoothed = "sPSA",
x="xDAP", df = 4,
rates = "AGR", suffices.rates = "AGRdv",
extra.derivs = 2, suffices.extra.derivs = "Acc"))
testthat::expect_equal(nrow(fit$predictions), 280)
testthat::expect_equal(ncol(fit$predictions), 4)
testthat::expect_true(all(c("xDAP","sPSA","sPSA.AGRdv","sPSA.Acc")
%in% names(fit$predictions)))
#byIndv4Times_GRsDiff
testthat::expect_silent(
tmp <- byIndv4Times_GRsDiff(data = longi.dat, response="sPSA",
which.rates=c("AGR", "RGR")))
#byIndv4Times_SplinesGRs
testthat::expect_silent(
tmp <- byIndv4Times_SplinesGRs(data = longi.dat, response="PSA", times="DAP",
df = 4, rates.method = "deriv",
which.rates = c("AGR", "RGR"),
suffices.rates = c("AGRdv", "RGRdv")))
testthat::expect_silent(
sPSA.GR <- byIndv4Intvl_GRsAvg(data = tmp, responses = "sPSA",
which.rates = c("AGR","RGR"),
suffices.rates = c("AGRdv","RGRdv"),
start.time = 31, end.time = 35,
suffix.interval = "31to35"))
#twoLevelOpcreate
responses <- c("sPSA.AGR","sPSA.RGR")
cols.retained <- c("Snapshot.ID.Tag","Smarthouse","Lane","Position",
"DAP","Snapshot.Time.Stamp", "Hour", "xDAP",
"Zone","cZone","SHZone","ZLane","ZMainunit",
"cMainPosn", "Genotype.ID")
longi.SIIT.dat <-
twoLevelOpcreate(dat = longi.dat, responses = responses,
suffices.treatment=c("C","S"),
operations = c("-", "/"),
suffices.results = c("diff", "SIIT"),
columns.retained = cols.retained,
by = c("Smarthouse","Zone","ZMainunit","DAP"))
longi.SIIT.dat <- with(longi.SIIT.dat,
longi.SIIT.dat[order(Smarthouse,Zone,ZMainunit,DAP),])
testthat::expect_equal(ncol(longi.SIIT.dat), 21)
testthat::expect_true("sPSA.RGR.SIIT" %in% names(longi.SIIT.dat))
testthat::expect_true(is.na(longi.SIIT.dat$sPSA.RGR.SIIT[1]) &&
abs(longi.SIIT.dat$sPSA.RGR.SIIT[2] - 0.854679) < 1e-03)
})
cat("#### Test byIndv_ValueCalc for exampleData\n")
test_that("exampleData_byIndv_ValueCalc", {
skip_if_not_installed("growthPheno")
skip_on_cran()
library(growthPheno)
#Load the data
data(exampleData)
#Test byIndv_ValueCalc
tmp <- byIndv_ValueCalc(data=longi.dat, response = "sPSA.AGR", FUN="max")
testthat::expect_equal(ncol(tmp), 2)
testthat::expect_equal(nrow(tmp), 20)
testthat::expect_true(abs(tmp[1,2] - 42.82888) < 1e-03)
testthat::expect_true("sPSA.AGR.max" %in% names(tmp))
tmp <- byIndv_ValueCalc(data=longi.dat, response = "sPSA.AGR", FUN="max", which.values = "DAP")
testthat::expect_equal(ncol(tmp), 3)
testthat::expect_equal(nrow(tmp), 20)
testthat::expect_true(tmp[1,3] == 42)
testthat::expect_true("sPSA.AGR.max.DAP" %in% names(tmp))
tmp <- byIndv_ValueCalc(data=longi.dat, response = "sPSA.AGR", FUN="max", which.obs = T)
testthat::expect_equal(ncol(tmp), 3)
testthat::expect_equal(nrow(tmp), 20)
testthat::expect_equal(tmp[1,3], 14)
testthat::expect_true("sPSA.AGR.max.obs" %in% names(tmp))
tmp <- byIndv_ValueCalc(data=longi.dat, response = "sPSA.AGR", FUN="max",
which.values = "DAP", which.obs = T)
testthat::expect_equal(ncol(tmp), 4)
testthat::expect_equal(nrow(tmp), 20)
testthat::expect_true(all(c("sPSA.AGR.max.DAP",
"sPSA.AGR.max.obs") %in% names(tmp)))
#Test numeric which.values
tmp <- byIndv_ValueCalc(data=longi.dat, response = "sPSA.AGR", FUN="max",
which.values = "xDAP", which.obs = T)
testthat::expect_equal(ncol(tmp), 4)
testthat::expect_equal(nrow(tmp), 20)
testthat::expect_true(all(c("sPSA.AGR.max.xDAP",
"sPSA.AGR.max.obs") %in% names(tmp)))
testthat::expect_true(abs(tmp[1,2] - 42.82888) < 1e-03)
#Test quantile that involves the probs argument and is not an exact observed value
tmp <- byIndv_ValueCalc(data=longi.dat, response = "sPSA", FUN="quantile",
which.values = "DAP", probs = 0.1)
tmp <- cbind(tmp, longi.dat$sPSA[longi.dat$DAP == 28],
longi.dat$sPSA[longi.dat$DAP == 30])
names(tmp)[4:5] <- c("sPSA.28", "sPSA.30")
testthat::expect_equal(nrow(tmp), 20)
#CHeck that sPSA.quantile is closer to sPSA.30 than to sPSA.28
testthat::expect_true(all(with(tmp, (sPSA.28 - sPSA.quantile) <
(sPSA.30 - sPSA.quantile))))
#Test byIndv4Intvl_ValueCalc
tmp <- byIndv4Intvl_ValueCalc(data=longi.dat, response = "sPSA.AGR", FUN="max", which.obs=T)
testthat::expect_equal(ncol(tmp), 3)
testthat::expect_equal(nrow(tmp), 20)
testthat::expect_true(tmp[1,3] == 14)
testthat::expect_true("sPSA.AGR.max.obs" %in% names(tmp))
tmp <- byIndv4Intvl_ValueCalc(data=longi.dat, response = "sPSA.AGR", FUN="max",
which.obs = T, which.values = "DAP")
testthat::expect_equal(ncol(tmp), 4)
testthat::expect_equal(nrow(tmp), 20)
testthat::expect_true(all(c("sPSA.AGR.max.DAP",
"sPSA.AGR.max.obs") %in% names(tmp)))
AGR.max.dat <- byIndv4Intvl_ValueCalc(data=longi.dat, response = "sPSA.AGR",
FUN="max",
start.time = 31, end.time = 35,
suffix.interval = "31to35",
which.values = "DAP", which.obs = TRUE)
testthat::expect_equal(ncol(AGR.max.dat), 4)
testthat::expect_equal(nrow(AGR.max.dat), 20)
testthat::expect_true(all(c("Snapshot.ID.Tag", "sPSA.AGR.max.31to35",
"sPSA.AGR.max.obs.31to35",
"sPSA.AGR.max.DAP.31to35") %in% names(AGR.max.dat)))
testthat::expect_true(abs(AGR.max.dat[1,2] - 29.24427) < 1e-03)
testthat::expect_true(AGR.max.dat[1,3] == 5)
testthat::expect_true(AGR.max.dat[1,4] == 35)
#Test byIndv_ValueCalc handling of which.levels, a deprecaed argument
testthat::expect_error(byIndv_ValueCalc(data=longi.dat, response = "sPSA.AGR",
FUN="max", which.levels = "DAP"))
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.