tests/testthat/testProbeSmooths.r
In briencj/growthPheno: Functional Analysis of Phenotypic Growth Data to Smooth and Extract Traits
cat("#### Test smooth.frames with a baby example\n")
test_that("smooth.frames_growthPheno", {
skip_if_not_installed("growthPheno")
skip_on_cran()
library(growthPheno)
library(scales)
dat <- read.table(header = TRUE, text = "
Type TunePar TuneVal Tuning Method ID DAP PSA sPSA
NCSS df 4 df-4 direct 045451-C 28 57.446 51.18456
NCSS df 4 df-4 direct 045451-C 30 89.306 87.67343
NCSS df 7 df-7 direct 045451-C 28 57.446 57.01589
NCSS df 7 df-7 direct 045451-C 30 89.306 87.01316
")
dat[1:7] <- lapply(dat[1:6], factor)
dat <- as.smooths.frame(dat, individuals = "ID", times = "DAP")
testthat::expect_true(is.smooths.frame(dat))
testthat::expect_true(validSmoothsFrame(dat))
tmp <- dat[,-c(2,8)]
testthat::expect_true(is.smooths.frame(tmp))
testthat::expect_silent(validsframe <- validSmoothsFrame(tmp))
testthat::expect_equal(validsframe[2],
paste0("\n The followng attributes of a smooths.frame are NULL: ",
"t, nschemes, individuals, times"))
testthat::expect_equal(validsframe[3],
"\n Do not have the following required smoothing-parameters columns in a smooths.frame: TunePar")
testthat::expect_error(as.smooths.frame(tmp),
regexp = paste0("Cannot assign smooths.frame class to supplied data.frame because it does not ",
"contain the following smoothing-parameters columns: TunePar"),
fixed = TRUE)
})
cat("#### Test probeSmooths with Judith Atieno 0278\n")
test_that("chickpea_growthPheno", {
skip_if_not_installed("growthPheno")
skip_on_cran()
library(growthPheno)
library(ggplot2)
data(dat1)
#'## Values of df for which to obtain plots
df <- c(4,7)
#'## Obtain separate plots Tunings
testthat::expect_warning(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = df, lambdas = NULL),
profile.plot.args =
args4profile_plot(breaks.spacing.x = 2,
plots.by = "Tuning",
facet.x = "Treatment.1",
facet.y = "Smarthouse")
),
regexp = "NaNs produced")
testthat::expect_equal(nrow(t), 16960)
testthat::expect_equal(ncol(t), 16)
#'## Obtain separate plots Tunings, when includes NCSS for lambda
testthat::expect_warning(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df=df,
lambdas = list(NCSS = 0.0001)),
profile.plot.args =
args4profile_plot(breaks.spacing.x = 2,
plots.by = "Tuning",
facet.x = "Treatment.1",
facet.y = "Smarthouse",
include.raw = "alone")),
regexp = "NaNs produced")
testthat::expect_equal(nrow(t), 25440)
testthat::expect_equal(ncol(t), 16)
#'## Obtain separate plots Tunings, when includes NCSS & PS for lambda
testthat::expect_error(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df=7,
lambdas = list(NCSS = 0.0001, PS = 1)),
profile.plot.args =
args4profile_plot(breaks.spacing.x = 2,
plots.by = "Tuning",
facet.x = "Treatment.1",
facet.y = "Smarthouse")
),
regexp = "The following names for the components of lambdas are not in the specified spline.types: PS")
#'## Obtain separate plots Tunings, when includes NCSS & PS for lambda
testthat::expect_warning(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = c("NCSS","PS"),
df=7,
lambdas = list(NCSS = 0.0001, PS = 1)),
profile.plot.args =
args4profile_plot(breaks.spacing.x = 2,
plots.by = c("Type","Tuning"),
facet.x = "Treatment.1", facet.y = "Smarthouse",
include.raw = "facet.x")),
regexp = "NaNs produced")
testthat::expect_equal(nrow(t), 25440)
testthat::expect_equal(ncol(t), 16)
#'## Obtain separate plots Tunings, when includes NCSS & PS for lambda and set include.raw to "alone"
testthat::expect_warning(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = c("NCSS","PS"),
df=7,
lambdas = list(NCSS = 0.0001, PS = 1)),
profile.plot.args =
args4profile_plot(breaks.spacing.x = 2,
plots.by = c("Type","Tuning"),
facet.x = "Treatment.1", facet.y = "Smarthouse",
include.raw = "alone")),
regexp = "NaNs produced")
testthat::expect_equal(nrow(t), 25440)
testthat::expect_equal(ncol(t), 16)
#Test various combinations of smoothing and non-smoothing factors in facet.x
testthat::expect_warning(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
get.rates = FALSE,
keep.columns = c("Smarthouse", "Treatment.1"),
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = df, lambdas = NULL),
which.plots = "none"),
repexp = paste0("The calculation of smoothed growth rates have not been specified; ",
"trait.types changed to response and propn.type.med reduced to its first element"))
testthat::expect_equal(nrow(t), 16960)
testthat::expect_equal(ncol(t), 11)
testthat::expect_true(all(c("Smarthouse", "Treatment.1") %in% names(t)))
#test for incorrect trait.types
testthat::expect_error(plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Treatment.1", "Method", "Tuning"),
facet.y = ".",
include.raw = "no")),
regexp = paste0("The following traits are not in the smooths.frame: ShootArea1000.AGR, ",
"ShootArea1000.RGR; perhaps, trait.types needs to be set differently"))
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(plots.by = "Tuning",
facet.x = c("Smarthouse", "Treatment.1"),
facet.y = ".",
include.raw = "no")))
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Treatment.1", "Tuning"),
facet.y = ".",
include.raw = "no")))
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Treatment.1", "Tuning"),
collapse.facets.x = FALSE,
facet.y = ".",
include.raw = "no")))
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Treatment.1", "Tuning"),
facet.y = ".",
include.raw = "facet.x")))
#Don't collapse the facet.x
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Treatment.1", "Tuning"),
facet.y = ".",
include.raw = "no",
collapse.facets.x = FALSE)))
#Inclusion of raw with both smoothing-parameter and other factors in facet.x
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Treatment.1", "Tuning"),
facet.y = ".",
collapse.facets.x = FALSE,
include.raw = "facet.x")))
#Inclusion of raw with both smoothing-parameter and other factors in facet.y
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = ".",
facet.y = c("Method", "Treatment.1", "Tuning"),
collapse.facets.y = FALSE, include.raw = "facet.y")))
#Inclusion of raw in facet.y = "."
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Treatment.1", "Tuning"),
facet.y = ".",
collapse.facets.x = FALSE, include.raw = "facet.y")))
#Inclusion of raw with other factors in facet.x and facet.y
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Tuning"),
facet.y = "Treatment.1",
collapse.facets.x = FALSE,
include.raw = "facet.x")))
#removes Median whiskers
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = ".",
facet.y = c("Method", "Treatment.1", "Tuning"),
collapse.facets.y = FALSE,
include.raw = "facet.y")))
#removes Median whiskers
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Treatment.1", "Tuning"),
facet.y = ".",
include.raw = "no",
addMediansWhiskers = FALSE)))
#Must specify either plots.by or plots.compare
testthat::expect_warning(testthat::expect_error(
t <- probeSmooths(dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = df, lambdas = NULL)),
regexp = paste0("There are no smoothing-parameter factors assigned to the plots and facet ",
"arguments - enough of them need to be assigned so that they uniquely index ",
"the combinations of the smoothing-parameter values in the smooths.frame")),
regexp = "NaNs produced")
#Check breaks.spacing.x = -1
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(breaks.spacing.x = -1,
plots.by = "Smarthouse",
facet.x = c("Method", "Treatment.1", "Tuning"),
facet.y = ".",
collapse.facets.x = FALSE,
include.raw = "facet.x")))
#Plot medians.deviations only with only facet.y.med set
testthat::expect_warning(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = "response",
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = df, lambdas = NULL),
which.plots = "medians.dev",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = ".",
facet.y = c("Smarthouse", "Treatment.1"),
propn.types = 0.05)))
testthat::expect_equal(nrow(t), 16960)
testthat::expect_equal(ncol(t), 11)
#Plot with plots.by.pf set to Tuning, plots.compare set to NULL and facet.x.pf set to Treatment.1
testthat::expect_silent(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types=c("AGR"),
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = df, lambdas = NULL),
profile.plot.args =
args4profile_plot(breaks.spacing.x = -1,
plots.by = "Tuning",
facet.x = "Treatment.1",
facet.y = "Smarthouse",
include.raw = "alone")))
testthat::expect_equal(nrow(t), 16960)
testthat::expect_equal(ncol(t), 14)
#specify Treatment.1 and Tuning for facet.x.pf
testthat::expect_silent(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types=c("response"), get.rates=FALSE,
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = df, lambdas = NULL),
profile.plot.args =
args4profile_plot(breaks.spacing.x = -1,
plots.by = NULL,
facet.x = c("Treatment.1", "Tuning"),
facet.y = "Smarthouse")))
#include raw plots with compare and no facet.x.pf
testthat::expect_silent(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types=c("response"), get.rates=FALSE,
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = df, lambdas = NULL),
profile.plot.args =
args4profile_plot(breaks.spacing.x = -1,
plots.by = NULL,
facet.x = "Tuning",
facet.y = "Treatment.1",
include.raw = "facet.x")))
testthat::expect_equal(nrow(t), 16960)
testthat::expect_true(all(c("Type", "TunePar", "TuneVal", "Tuning", "Method",
"Snapshot.ID.Tag", "TimeAfterPlanting",
"Treatment.1", "ShootArea1000", "sShootArea1000")
%in% names(t)))
#'## Plots of response and deviations boxplots
testthat::expect_silent(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
x.title = "DAP",
trait.types=c("response"), get.rates=FALSE,
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = df, lambdas = NULL),
which.plots = c("profiles", "absolute"),
profile.plot.args =
args4profile_plot(plots.by = NULL,
facet.x = "Tuning",
facet.y = "Treatment.1"),
devnboxes.plot.args =
args4devnboxes_plot(plots.by = NULL,
facet.x = "Tuning",
facet.y = "Treatment.1")))
testthat::expect_equal(nrow(t), 16960)
testthat::expect_true(all(c("Type", "TunePar", "TuneVal", "Tuning", "Method",
"Snapshot.ID.Tag", "TimeAfterPlanting",
"Treatment.1", "ShootArea1000", "sShootArea1000")
%in% names(t)))
#Check plots.by in plotSmoothsDevnBoxplots
plts <- plotSmoothsDevnBoxplots(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
x.title = "DAP",
trait.types=c("response"),
devnboxes.plot.args =
args4devnboxes_plot(plots.by = "Tuning",
facet.x = "'Tuning'",
facet.y = "Treatment.1"))
testthat::expect_equal(length(plts), 1)
testthat::expect_equal(names(plts), "ShootArea1000")
testthat::expect_equal(names(plts[[1]]), "absolute")
testthat::expect_equal(length(plts[[1]][["absolute"]]), 2)
testthat::expect_true(all(names(plts[[1]][["absolute"]]) == c("df-4", "df-7")))
#plots.by.pf gives separate plots
testthat::expect_warning(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types=c("response", "AGR"),
x.title = "DAP",
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = df, lambdas = NULL),
which.plots = c("profiles", "absolute", "relative"),
profile.plot.args =
args4profile_plot(plots.by = NULL,
facet.x = "Tuning",
facet.y = "Treatment.1"),
devnboxes.plot.args =
args4devnboxes_plot(plots.by = NULL,
facet.x = "Tuning",
facet.y = "Treatment.1")))
testthat::expect_equal(nrow(t), 16960)
testthat::expect_lt(max(abs(t[t$TuneVal == "4", "ShootArea1000"] - t[t$TuneVal == "4", "sShootArea1000"]),
na.rm = TRUE) - 5.563407, 1e-07)
testthat::expect_lt(max(abs(t[t$TuneVal == "4", "ShootArea1000"] - t[t$TuneVal == "4", "sShootArea1000"])/
t[t$TuneVal == "4", "sShootArea1000"]) - 370.7951, 1e-04)
testthat::expect_silent(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
x.title = "DAP",
trait.types=c("response", "AGR"),
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = df, lambdas = NULL),
profile.plot.args =
args4profile_plot(plots.by = NULL,
facet.x = "Tuning",
facet.y = c("Smarthouse", "Treatment.1"))))
testthat::expect_equal(nrow(t), 16960)
})
cat("#### Test probeSmooths with small example\n")
test_that("exampleData_growthPheno", {
skip_if_not_installed("growthPheno")
skip_on_cran()
library(growthPheno)
data(exampleData)
vline <- list(ggplot2::geom_vline(xintercept=29, linetype="longdash", linewidth=1))
plotDeviationsBoxes(longi.dat, observed = "PSA", smoothed = "sPSA",
x.factor="DAP", df =5)
testthat::expect_warning(
tmp <- probeSmooths(data = longi.dat,
response = "PSA", times = "DAP",
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL),
profile.plot.args =
args4profile_plot(plots.by = NULL,
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_warning(testthat::expect_error(
tmp <- probeSmooths(data = longi.dat,
response = "PSA", times = "DAP",
get.rates = FALSE,
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL),
profile.plot.args =
args4profile_plot(plots.by = NULL,
facet.x = "Method",
facet.y = ".",
ggplotFuncs = vline)),
regexp = paste0("\n The number of different combinations of \\(i\\) the smoothing-parameter values that ",
"are available and \\(ii\\) the levels combination of the following factors nominated ",
"in the facet/plots arguments are not equal: Method")),
regexp = paste0("The calculation of smoothed growth rates have not been specified; ",
"trait.types changed to response and propn.type reduced to its first element"))
testthat::expect_warning(
tmp <- probeSmooths(data = longi.dat,
response = "PSA", times = "DAP",
get.rates = FALSE,
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL),
profile.plot.args =
args4profile_plot(plots.by = NULL,
facet.x = "Tuning",
facet.y = ".",
ggplotFuncs = vline)))
testthat::expect_equal(nrow(tmp), 560)
testthat::expect_equal(ncol(tmp), 9)
testthat::expect_warning(
tmp <- probeSmooths(data = longi.dat,
response = "PSA", times = "DAP",
get.rates = FALSE,
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL),
profile.plot.args =
args4profile_plot(plots.by = NULL,
facet.x = "Tuning",
facet.y = ".",
alpha = 0.6,
ggplotFuncs = vline)),
regexp = paste0("The calculation of smoothed growth rates have not been specified; ",
"trait.types changed to response and propn.type reduced to its first element"))
testthat::expect_equal(nrow(tmp), 560)
testthat::expect_equal(ncol(tmp), 9)
#AGR trait plot only
testthat::expect_warning(
tmp <- probeSmooths(data = longi.dat,
response = "PSA", times = "DAP",
trait.types = "AGR",
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL),
profile.plot.args =
args4profile_plot(plots.by = NULL,
facet.x = "Tuning",
facet.y = ".",
alpha = 0.5,
ggplotFuncs = vline)),
regexp = "Removed 3 rows containing missing values or values outside the scale range \\(\\`geom_vline\\(\\)\\`\\)")
testthat::expect_equal(nrow(tmp), 560)
testthat::expect_equal(ncol(tmp), 12)
#Compare medians and profiles for multiple traits
testthat::expect_warning(
tmp <- probeSmooths(data = longi.dat,
response = "PSA", times = "DAP",
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL),
which.plots = c("profiles", "medians.dev"),
profile.plot.args =
args4profile_plot(plots.by = NULL,
facet.x = "Tuning",
facet.y = ".",
ggplotFuncs = vline),
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = ".",
facet.y = ".",
propn.types = c(0.02,0.1, 0.2))))
testthat::expect_equal(nrow(tmp), 560)
testthat::expect_equal(ncol(tmp), 14)
#Compare medians for multiple traits
testthat::expect_warning(
tmp <- probeSmooths(data = longi.dat,
response = "PSA", times = "DAP",
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL),
which.plots = "medians.dev",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = ".",
facet.y = ".",
propn.types = c(0.02,0.1, 0.2))))
testthat::expect_equal(nrow(tmp), 560)
testthat::expect_equal(ncol(tmp), 14)
testthat::expect_warning(
tmp <- probeSmooths(data = longi.dat,
response = "PSA", times = "DAP",
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL),
profile.plot.args =
args4profile_plot(plots.by = NULL,
facet.x = "Tuning",
facet.y = "Treatment.1",
ggplotFuncs = vline)),
regexp = "Removed 6 rows containing missing values or values outside the scale range \\(\\`geom_vline\\(\\)\\`\\)")
#Test for a single line per plot - caused by plots.by.med
testthat::expect_silent(
med <- plotSmoothsMedianDevns(data = tmp,
response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
trait.types = "response",
x.title = "DAP",
meddevn.plot.args =
args4meddevn_plot(plots.by = "Tuning",
plots.group = NULL,
facet.x = ".",
facet.y = ".",
propn.types = 0.05,
ggplotFuncs = vline)))
testthat::expect_equal(length(med$plots), 1)
testthat::expect_equal(nrow(med$med.devn.dat), 28)
testthat::expect_equal(ncol(med$med.devn.dat), 3)
#Test for a single line per plot - caused by plots.by.med; specification of colour and shape
testthat::expect_silent(
med <- plotSmoothsMedianDevns(data = tmp,
response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
trait.types = "response",
x.title = "DAP",
meddevn.plot.args =
args4meddevn_plot(plots.by = "Tuning",
plots.group = NULL,
facet.x = ".",
facet.y = ".",
propn.types = 0.05,
colour.values = "blue",
shape.values = 17,
ggplotFuncs = vline)))
testthat::expect_equal(length(med$plots), 1)
testthat::expect_equal(nrow(med$med.devn.dat), 28)
testthat::expect_equal(ncol(med$med.devn.dat), 3)
#Compare medians and absolute deviations for multiple traits
testthat::expect_warning(
traits <- probeSmooths(data = longi.dat,
response = "PSA", times = "DAP",
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL),
which.plots = c("medians.dev", "absolute"),
profile.plot.args = NULL,
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = ".",
facet.y = ".",
propn.types = NULL,
ggplotFuncs = vline),
devnboxes.plot.args =
args4devnboxes_plot(plots.by = NULL,
facet.x = "Tuning",
facet.y = ".",
ggplotFuncs = vline)))
testthat::expect_equal(nrow(traits), 560)
testthat::expect_equal(ncol(traits), 14)
#Form and save the data.frame containing the smooths produced by probeSmooths for testing associated functions
testthat::expect_silent(
traits <- probeSmooths(data = longi.dat,
response = "PSA", times = "DAP",
keep.columns = c("Treatment.1", "Genotype.ID"), #so in smooths.frame
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL),
which.plots = "none"))
#Fit simple and four-parameter logistics and obtain the fitted values
library(nlme)
extra.dat <- longi.dat[, -grep("sPSA", names(longi.dat), fixed = TRUE)]
logist.grp <- nlme::groupedData(PSA ~ xDAP | Snapshot.ID.Tag, data = longi.dat)
#Fit the simple logistic model
logist.lis <- nlme::nlsList(SSlogis, logist.grp, na.action = na.pass)
logist.dat <- within(extra.dat, sPSA <- fitted(logist.lis))
logist.dat <- cbind(Tuning = factor("Logistic"), logist.dat)
#Fit the four-parameter logistic model - generates warnings
logis4.lis <- suppressWarnings(nlme::nlsList(SSfpl, logist.grp, na.action = na.pass))
logis4.dat <- within(extra.dat, sPSA <- fitted(logis4.lis))
logis4.dat <- cbind(Tuning = factor("Logis-4par"), logis4.dat)
#Combine the logistic fits
extra.dat <- rbind(logist.dat,logis4.dat)
extra.dat <- cbind(Type = factor("NonLinear"), extra.dat)
#Check computation of median deviations for Control Treatment, Genotype = 120855 and df = 5
tmp <- subset(traits, Treatment.1 == "Control" & Genotype.ID == "120855" & TuneVal == "4")
tmp$PSA.devn <- tmp$PSA - tmp$sPSA
med.vals <- tapply(tmp$PSA.devn, tmp$DAP, median, na.rm = TRUE)
testthat::expect_silent(
med <- plotSmoothsMedianDevns(data = traits,
response = "PSA", times = "DAP",
x.title = "DAP",
trait.types = "response",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = ".",
facet.y = c("Treatment.1", "Genotype.ID"),
propn.types = 0.05,
ggplotFuncs = vline),
printPlot = FALSE))
med.dat <- med$med.devn.dat
med.dat <- subset(med.dat, Treatment.1 == "Control" & Genotype.ID == "120855" & SmoothParams == "df-4")
testthat::expect_true(all(abs(med.dat$PSA.devn - med.vals) < 1e-5))
testthat::expect_silent(
med <- plotSmoothsMedianDevns(data = traits,
response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
trait.types = "response",
x.title = "DAP",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = ".",
facet.y = ".",
propn.types = 0.05,
ggplotFuncs = vline)))
testthat::expect_equal(length(med), 2)
testthat::expect_true(all(names(med) == c("plots", "med.devn.dat")))
testthat::expect_equal(nrow(med$med.devn.dat), 28)
testthat::expect_equal(ncol(med$med.devn.dat), 3)
testthat::expect_equal(length(med$plots), 1)
#Form a smooths.frame with external.smooths for further testing
testthat::expect_warning(
smth.extra <- probeSmooths(data = longi.dat,
response = "PSA", times = "DAP",
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL,
external.smooths = extra.dat),
which.plots = c("medians.dev", "absolute"),
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = ".", facet.y = ".",
propn.types = NULL),
devnboxes.plot.args =
args4devnboxes_plot(plots.by = NULL,
facet.x = "Tuning", facet.y = ".")))
testthat::expect_equal(nrow(smth.extra), 1120)
testthat::expect_equal(ncol(smth.extra), 14)
#Use external.smooths incorporated using probeSmooths
testthat::expect_warning(
med <- plotSmoothsMedianDevns(data = smth.extra,
response = "PSA", times = "DAP",
x.title = "DAP",
meddevn.plot.args =
args4meddevn_plot(plots.by = "Type",
plots.group = "Tuning",
facet.x = ".", facet.y = ".",
propn.types = c(0.02,0.1, 0.2),
ggplotFuncs = vline)))
testthat::expect_equal(length(med), 2)
testthat::expect_true(all(names(med) == c("plots", "med.devn.dat")))
testthat::expect_equal(nrow(med$med.devn.dat), 56)
testthat::expect_equal(ncol(med$med.devn.dat), 6)
testthat::expect_equal(levels(med$med.devn.dat$SmoothParams),
c("df-4","df-7","Logistic","Logis-4par"))
testthat::expect_equal(length(med$plots), 3)
testthat::expect_warning(
t <- plotSmoothsDevnBoxplots(data = smth.extra,
response = "PSA", times = "DAP",
devnboxes.plot.args =
args4devnboxes_plot(plots.by = "Type",
facet.x = "Tuning",
facet.y = ".")))
testthat::expect_equal(length(t), 3)
testthat::expect_true(all(names(t) == c("PSA", "PSA.AGR", "PSA.RGR")))
testthat::expect_equal(names(t[[1]]), "absolute")
testthat::expect_equal(length(t[[1]][["absolute"]]), 2)
testthat::expect_true(all(names(t[[1]][["absolute"]]) == c("NCSS", "NonLinear")))
#Use plots.by different to that in probeSmooths
plts <- plotSmoothsComparison(data = smth.extra,
response = "PSA", times = "DAP",
x.title = "DAP",
profile.plot.args =
args4profile_plot(plots.by = "Type",
facet.x = "Tuning", facet.y = ".",
include.raw = "facet.x",
alpha = 0.2,
ggplotFuncs = vline))
testthat::expect_equal(length(plts), 3)
testthat::expect_true(all(c("PSA","PSA.AGR","PSA.RGR") %in% names(plts)))
testthat::expect_true("profiles" == names(plts$PSA))
testthat::expect_true("profiles" == names(plts$PSA.AGR))
testthat::expect_equal(length(plts$PSA$deviations), 0)
testthat::expect_equal(length(plts$PSA$profiles), 2)
testthat::expect_true(all(c("NCSS", "NonLinear") %in% names(plts$PSA$profiles)))
#Test addMediansWhiskers
plotSmoothsComparison(data = smth.extra, response = "PSA", times = "DAP",
x.title = "DAP",
profile.plot.args =
args4profile_plot(plots.by = NULL,
facet.x = c("Type", "Tuning"), facet.y = ".",
include.raw = "facet.x",
colour.column = "Method",
colour.values = c("olivedrab", "orange"),
alpha = 0.25, addMediansWhiskers = TRUE,
ggplotFuncs = vline))
plts <- plotSmoothsComparison(data = smth.extra, response = "PSA", times = "DAP",
x.title = "DAP",
profile.plot.args =
args4profile_plot(plots.by = "Type",
facet.x = "Tuning", facet.y = ".",
include.raw = "facet.x",
colour = "olivedrab",
alpha = 0.25, addMediansWhiskers = TRUE,
ggplotFuncs = vline))
#Add external smooths and include deviations plots
testthat::expect_warning(
smth.extra <- probeSmooths(data = longi.dat[, 1:25],
response = "PSA", times ="DAP",
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL,
external.smooths = extra.dat),
which.plots = c("medians.dev", "absolute"),
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = c("Type", "Tuning"),
facet.x = ".", facet.y = ".",
propn.types = NULL),
devnboxes.plot.args =
args4devnboxes_plot(plots.by = NULL,
facet.x = c("Type", "Tuning"),
facet.y = ".")))
testthat::expect_equal(nrow(smth.extra), 1120)
testthat::expect_equal(ncol(smth.extra), 14)
testthat::expect_warning(
med <- plotSmoothsMedianDevns(data = smth.extra,
response = "PSA", times = "DAP",
x.title = "DAP",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = c("Type", "Tuning"),
facet.x = ".", facet.y = ".",
propn.types = c(0.02,0.1, 0.2),
ggplotFuncs = vline)))
testthat::expect_equal(length(med), 2)
testthat::expect_true(all(names(med) == c("plots", "med.devn.dat")))
testthat::expect_equal(nrow(med$med.devn.dat), 56)
testthat::expect_equal(ncol(med$med.devn.dat), 5)
testthat::expect_equal(levels(med$med.devn.dat$SmoothParams),
c("NCSS-df-4","NCSS-df-7",
"NonLinear-Logistic","NonLinear-Logis-4par"))
testthat::expect_equal(length(med$plots), 3)
testthat::expect_warning(
med <- plotSmoothsMedianDevns(data = smth.extra,
response = "PSA", times = "DAP",
x.title = "DAP",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = "Type", facet.y = ".",
propn.types = c(0.02,0.1, 0.2),
ggplotFuncs = vline)))
testthat::expect_equal(length(med), 2)
testthat::expect_true(all(names(med) == c("plots", "med.devn.dat")))
testthat::expect_equal(levels(med$med.devn.dat$SmoothParams),
c("df-4","df-7","Logistic","Logis-4par"))
testthat::expect_warning(
med <- plotSmoothsMedianDevns(data = smth.extra,
response = "PSA", times = "DAP",
x.title = "DAP",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = ".", facet.y = "Type",
propn.types = c(0.02,0.1, 0.2),
ggplotFuncs = vline)))
testthat::expect_equal(length(med), 2)
testthat::expect_true(all(names(med) == c("plots", "med.devn.dat")))
testthat::expect_equal(levels(med$med.devn.dat$SmoothParams),
c("df-4","df-7","Logistic","Logis-4par"))
testthat::expect_warning(
med <- plotSmoothsMedianDevns(data = smth.extra,
response = "PSA", times = "DAP",
x.title = "DAP",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = "Type", facet.y = ".",
propn.types = c(0.02,0.1, 0.2),
ggplotFuncs = vline)))
testthat::expect_equal(length(med), 2)
testthat::expect_true(all(names(med) == c("plots", "med.devn.dat")))
testthat::expect_equal(levels(med$med.devn.dat$SmoothParams),
c("df-4","df-7","Logistic","Logis-4par"))
})
cat("#### Test probeSmooths with tomato example\n")
test_that("tomato_growthPheno", {
skip_if_not_installed("growthPheno")
skip_on_cran()
library(dae)
library(growthPheno)
data(tomato.dat)
df.vec <- c(4:6,12)
labelMyc <- as_labeller(function(lev) paste(lev, "AMF"))
labelZn <- as_labeller(function(lev) paste("Zn:", lev, "ppm"))
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]
labels <- labeller(Zn = labelZn, AMF = labelMyc)
#'## Gives error that the Length of propn.types.med is not the same as the number of traits
testthat::expect_warning(
tom <- probeSmooths(data = tomato.dat,
response = "PSA", response.smoothed = "sPSA",
times = "DAP",
get.rates = FALSE,
smoothing.args =
args4smoothing(smoothing.methods = c("dir", "log"),
spline.types = "NCSS",
df = c(4,7), lambdas = NULL),
which.plots = c("profiles", "medians.dev"),
profile.plot.args =
args4profile_plot(plots.by = "Tuning",
facet.x = "Method", facet.y = c("Zn","AMF"),
facet.labeller = labels),
meddevn.plot.args =
args4meddevn_plot(plots.by = "Tuning",
plots.group = "Method",
facet.x = ".", facet.y = c("Zn","AMF"),
facet.labeller = labels)),
regexp = paste0("The calculation of smoothed growth rates have not been specified; ",
"trait.types changed to response and propn.type reduced to its first element"))
testthat::expect_equal(nrow(tom), 4480)
testthat::expect_equal(ncol(tom), 11)
testthat::expect_silent(
med <- plotSmoothsMedianDevns(data = tom,
response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
trait.types = "response",
x.title = "DAP",
y.titles = "PSA deviation (kpixels)",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = c("Method","Tuning"),
facet.x = "Zn", facet.y = "AMF",
propn.types = 0.1,
breaks.spacing.x = 2, angle.x = 90,
facet.labeller = labels)))
testthat::expect_equal(length(med$plots), 1)
testthat::expect_equal(nrow(med$med.devn.dat), 1120)
testthat::expect_equal(ncol(med$med.devn.dat), 5)
#Multiple df, single methods
testthat::expect_warning(
tom <- probeSmooths(data = tomato.dat, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
smoothing.args =
args4smoothing(smoothing.methods = "logarithmic",
spline.types = "NCSS",
df = 4:5, lambdas = NULL),
which.plots = "medians.dev",
meddevn.plot.args =
args4meddevn_plot(plots.by = "Method",
plots.group = "Tuning",
facet.x = ".", facet.y = ".",
propn.types = c(0.02, 0.2, 0.5),
facet.labeller = labels)))
testthat::expect_equal(nrow(tom), 2240)
testthat::expect_equal(ncol(tom), 14)
#'Single `df`, multiple methods and trait.types
testthat::expect_warning(
tomdiff <- probeSmooths(data = tomato.dat, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
smoothing.args =
args4smoothing(smoothing.methods = c("direct","logarithmic"),
spline.types = "N",
df=5, lambdas = NULL),
which.plots = "none"))
testthat::expect_equal(nrow(tomdiff), 2240)
testthat::expect_equal(ncol(tomdiff), 14)
testthat::expect_warning(
med <- plotSmoothsMedianDevns(data = tomdiff, response = "PSA",
response.smoothed = "sPSA",
times = "DAP", x.title = "DAP",
meddevn.plot.args =
args4meddevn_plot(plots.by = "Tuning",
plots.group = "Method",
facet.x = ".", facet.y = ".",
propn.types = c(0.02, 0.2, 0.5))))
testthat::expect_equal(length(med), 2)
testthat::expect_true(all(names(med) == c("plots", "med.devn.dat")))
testthat::expect_equal(nrow(med$med.devn.dat), 70)
testthat::expect_equal(ncol(med$med.devn.dat), 6)
testthat::expect_equal(length(med$plots), 3)
testthat::expect_true(all(names(med$plots) == c("PSA","PSA.AGR","PSA.RGR")))
testthat::expect_warning(print(med$plots$PSA.AGR$`df-5`))
#'Single `df`, single method - plots.by.med = Tuning
testthat::expect_warning(
tom <- probeSmooths(data = tomato.dat, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "N",
df=5, lambdas = NULL),
which.plots = "medians.dev",
meddevn.plot.args =
args4meddevn_plot(plots.by = "Tuning",
plots.group = NULL,
facet.x = ".", facet.y = ".",
colour.values = "blue",
propn.types = c(0.02, 0.2, 0.5))))
testthat::expect_equal(nrow(tom), 1120)
testthat::expect_equal(ncol(tom), 14)
#'Single `df`, single method - plots.group.med = Tuning
testthat::expect_warning(
tom <- probeSmooths(data = tomato.dat, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "N",
df=5, lambdas = NULL),
which.plots = "medians.dev",
meddevn.plot.args =
args4meddevn_plot(plots.by = "Tuning",
plots.group = NULL,
facet.x = ".", facet.y = ".",
propn.types = c(0.02, 0.2, 0.5))))
testthat::expect_equal(nrow(tom), 1120)
testthat::expect_equal(ncol(tom), 14)
#test custom schemes
spar <- args4smoothing(spline.types = c( "N", "NCS", "P"),
df = c( 4, 6, NA),
lambdas = c( NA, NA, 1),
smoothing.methods = c("dir", "log", "log"),
combinations = "parallel")
cols <- scales::brewer_pal("div", "Paired")(6)[c(2,4,6,8,1,3,5,7)]
testthat::expect_warning(
tom <- probeSmooths(data = tomato.dat, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
smoothing.args = spar,
which.plots = "medians.dev",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = c("Type", "Tuning", "Method"),
facet.x = ".", facet.y = ".",
colour.values = cols[1:3],
propn.types = c(0.02, 0.2, 0.5))))
testthat::expect_equal(nrow(tom), 3360)
testthat::expect_equal(ncol(tom), 14)
#Multiple df, two spline.types - uses npspline.segments
testthat::expect_warning(
tom <- probeSmooths(data = tomato.dat, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
which.plots = c("medians.dev", "profiles"),
smoothing.args = args4smoothing(smoothing.methods = "log",
spline.types = c("NCSS", "PS"),
df=5:6, lambdas = c(0.1,1),
npspline.segments = 30),
profile.plot.args =
args4profile_plot(plots.by = NULL,
facet.x = c("Type", "Tuning"), facet.y = ".",
include.raw = "no"),
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = "Type", facet.y = ".",
propn.types = c(0.02, 0.2, 0.5))))
testthat::expect_equal(nrow(tom), 4480)
testthat::expect_equal(ncol(tom), 14)
#probeSmooths without deviations plots for next set of tests
testthat::expect_warning(
tom <- probeSmooths(data = tomato.dat, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
smoothing.args = spar,
which.plots = "none"),
regexp = "NaNs produced")
#test various combinations of plots.by.pf, plots.compare and include.raw.pf alone
testthat::expect_silent(
plts <-
plotSmoothsComparison(data = tom, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
profile.plot.args =
args4profile_plot(
plots.by = c("Type", "Tuning", "Method"),
facet.x = ".", facet.y = ".",
include.raw = "alone",
colour.column = "Method",
colour.values = c("orange", "olivedrab"),
addMediansWhiskers = TRUE)))
testthat::expect_equal(length(plts$PSA$profiles), 4)
testthat::expect_equal(length(plts$PSA$deviations), 0)
#test various combinations of plots.by, facet.y and facet.x, with include.raw set to facet.x
testthat::expect_error(
plotSmoothsComparison(data = tom, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
profile.plot.args =
args4profile_plot(
plots.by = c("Type", "Tuning", "Method"),
facet.x = ".", facet.y = ".",
include.raw = "facet.x",
colour.column = "Method",
colour.values = c("orange", "olivedrab"),
addMediansWhiskers = TRUE)),
regexp = "The argument incl.raw is set to facet.x, but facet.x has not been set to include a variable")
testthat::expect_silent(
plotSmoothsComparison(data = tom, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
profile.plot.args =
args4profile_plot(
plots.by = c("Type", "Tuning", "Method"),
facet.x = ".", facet.y = ".",
include.raw = "no")))
testthat::expect_silent(
plotSmoothsComparison(data = tom, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
profile.plot.args =
args4profile_plot(
plots.by = c("Type", "Tuning"),
facet.x = ".", facet.y = "Method",
include.raw = "facet.y",
alpha = 0.4,
colour.column = "Method",
colour.values = c("orange", "olivedrab"),
addMediansWhiskers = TRUE)))
testthat::expect_silent(
plotSmoothsComparison(data = tom, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
profile.plot.args =
args4profile_plot(
plots.by = NULL,
facet.x = "Tuning", facet.y = ".",
include.raw = "facet.x",
colour = "orange")))
testthat::expect_silent(
plotSmoothsComparison(data = tom, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
profile.plot.args =
args4profile_plot(
plots.by = NULL,
facet.x = c("Type","Tuning","Method"),
facet.y = ".",
include.raw = "no")))
#'Single `df`, multiple methods and trait.types and GRs using deriv
suppressWarnings(
tomdv <- probeSmooths(data = tomato.dat,
response = "PSA", response.smoothed = "sPSA",
times = "DAP",
smoothing.args =
args4smoothing(smoothing.methods = c("direct","logarithmic"),
spline.types = "NCSS", df=5, lambdas = NULL),
rates.method = "deriv",
which.plots = "profiles",
profile.plot.args =
args4profile_plot(
plots.by = NULL,
facet.x = "Method",
facet.y = ".",
include.raw = "facet.x")))
testthat::expect_equal(nrow(tomdv), 2240)
testthat::expect_equal(ncol(tomdv), 14)
testthat::expect_true(all(abs(tomdiff$sPSA-tomdv$sPSA) < 1e-08))
tomspl <- byIndv4Times_SplinesGRs(data = tomato.dat,
response = "PSA", response.smoothed = "sPSA",
times="DAP",
df = 5, rates.method = "deriv",
which.rates = c("AGR", "RGR"),
suffices.rates = c("AGRdv", "RGRdv"))
testthat::expect_true(all(abs(tomspl$sPSA-tomdv$sPSA[1:1120]) < 1e-08))
testthat::expect_true(all(abs(tomspl$sPSA.AGRdv-tomdv$sPSA.AGR[1:1120]) < 1e-08))
testthat::expect_true(all(abs(tomdv$sPSA.AGR[1:4] -
c(4.483901, 4.533483, 4.706856, 5.038068)) < 1e-05))
testthat::expect_true(all(abs(tomspl$sPSA.RGRdv-tomdv$sPSA.RGR[1:1120]) < 1e-08))
testthat::expect_true(all(abs(tomdv$sPSA.RGR[1:4] -
c(17.6807353, 0.9536113, 0.5027707, 0.3542860)) < 1e-05))
#Look at water.use
lambdas <- round(10^c(-0.5, 0, 0.5, 1), digits = 3)
df = c(4:6)
x.axis <- list(theme(axis.text.x = element_text(angle = 90),
panel.grid.minor.x = element_blank()))
vline.DAP.endpts <- list(geom_vline(xintercept=DAP.starts, linetype="longdash",
alpha = 0.5, linewidth=0.75))
theme.profile <- list(vline.DAP.endpts,x.axis)
tom.H2O <- probeSmooths(data = tomato.dat, response = "WU",
response.smoothed = "sWU",
times = "DAP", get.rates = FALSE,
smoothing.args =
args4smoothing(smoothing.methods = "dir",
spline.types = c("NCSS", "PS"),
df=df,
lambdas = list(PS = lambdas)),
which.plots = c("medians.dev", "profiles"),
profile.plot.args =
args4profile_plot(plots.by = "Type",
facet.x = c("Tuning"), facet.y = ".",
include.raw = "facet.x",
ggplotFuncs = theme.profile),
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = "Type", facet.y = ".",
propn.types = NULL))
testthat::expect_equal(nrow(tom.H2O), 7840)
testthat::expect_equal(ncol(tom.H2O), 9)
})
cat("#### Test probeSmooths Rice experiment\n")
test_that("RicePrepped_growthPheno", {
skip_if_not_installed("growthPheno")
skip_on_cran()
library(dae)
library(growthPheno)
data(RicePrepped.dat)
testthat::expect_warning(
smth <- probeSmooths(data = RicePrepped.dat, response = "PSA", response.smoothed = "sPSA",
times = "DAST",
smoothing.args =
args4smoothing(spline.types = c("NCSS", "PS"),
smoothing.methods = "log",
df = c(4,7),
lambdas = c(0.1,1,10)),
keep.columns = c("Smarthouse","Salinity"), #so these are included in the smooths.frame
which.plots = "none"),
regexp = "Need at least 4 distinct x values to fit a spline - all fitted values set to NA")
testthat::expect_equal(nrow(smth), 73920)
testthat::expect_equal(ncol(smth), 16)
#Check that PS smoothing is correct
oneplant <- subset(smth, Snapshot.ID.Tag == "045451-C" & Type == "PS" & TuneVal == "0.1")
fity <- JOPS::psNormal(x = oneplant$DAST, y = log(oneplant$PSA), nseg = 10, lambda = 0.1,
xgrid = oneplant$DAST)
testthat::expect_true(all(abs(oneplant$sPSA-exp(fity$muhat[,1])) < 1e-05))
#Tuning only for PSA
testthat::expect_silent(
t <- plotSmoothsMedianDevns(data = smth, response = "PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL, plots.group = "Tuning",
facet.x = ".", facet.y = c("Smarthouse","Salinity"),
propn.types = 0.025)))
testthat::expect_equal(length(t$plots), 1)
testthat::expect_equal(nrow(t$med.devn.dat), 280)
testthat::expect_equal(ncol(t$med.devn.dat), 5)
testthat::expect_true(all(c("Smarthouse", "Salinity", "SmoothParams", "PSA.devn", "DAST")
%in% names(t$med.devn.dat)))
#Use plots.by.med for Type
testthat::expect_silent(
t <- plotSmoothsMedianDevns(data = smth, response = "PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
meddevn.plot.args =
args4meddevn_plot(plots.by = "Type", plots.group = "Tuning",
facet.x = ".", facet.y = c("Smarthouse","Salinity"),
propn.types = 0.025)))
testthat::expect_equal(length(t$plots), 1)
testthat::expect_equal(nrow(t$med.devn.dat), 280)
testthat::expect_equal(ncol(t$med.devn.dat), 6)
testthat::expect_true(all(c("fac.by","Smarthouse", "Salinity", "SmoothParams", "PSA.devn", "DAST")
%in% names(t$med.devn.dat)))
#Use facet.x for Type, additional to plots.group
testthat::expect_silent(
t <- plotSmoothsMedianDevns(data = smth, response = "PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL, plots.group = "Tuning",
facet.x = "Type",
facet.y = c("Smarthouse","Salinity"),
propn.types = 0.025)))
testthat::expect_equal(length(t$plots), 1)
testthat::expect_equal(nrow(t$med.devn.dat), 280)
testthat::expect_equal(ncol(t$med.devn.dat), 6)
testthat::expect_true(all(c("Type","Smarthouse", "Salinity", "SmoothParams", "PSA.devn", "DAST")
%in% names(t$med.devn.dat)))
#facet.x a mixture of a smoothing-parameter factor and another factor
testthat::expect_silent(
t <- plotSmoothsMedianDevns(data = smth, response = "PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL, plots.group = "Tuning",
facet.x = c("Smarthouse"),
facet.y = c("Salinity","Type"),
propn.types = 0.025)))
testthat::expect_silent(
t <- plotSmoothsMedianDevns(data = smth, response = "PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL, plots.group = "Tuning",
facet.x = c("Salinity","Type"),
facet.y = c("Smarthouse"),
propn.types = FALSE)))
testthat::expect_silent(
t <- plotSmoothsMedianDevns(data = smth, response = "PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL, plots.group = "Tuning",
facet.x = c("Salinity","Type"),
facet.y = c("Smarthouse"),
propn.types = 0.025)))
testthat::expect_equal(length(t$plots), 1)
testthat::expect_equal(nrow(t$med.devn.dat), 280)
testthat::expect_equal(ncol(t$med.devn.dat), 6)
testthat::expect_true(all(c("Type","Smarthouse", "Salinity", "SmoothParams", "PSA.devn", "DAST")
%in% names(t$med.devn.dat)))
#Use plot,by with med
testthat::expect_silent(
t <- plotSmoothsMedianDevns(data = smth, response = "PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
meddevn.plot.args =
args4meddevn_plot(plots.by = c("Method","Type"),
plots.group = "Tuning",
facet.x = ".",
facet.y = c("Smarthouse","Salinity"),
propn.types = 0.025)))
testthat::expect_equal(length(t$plots), 1)
testthat::expect_equal(nrow(t$med.devn.dat), 280)
testthat::expect_equal(ncol(t$med.devn.dat), 6)
testthat::expect_true(all(c("fac.by", "Smarthouse", "Salinity", "SmoothParams", "PSA.devn", "DAST")
%in% names(t$med.devn.dat)))
#Test breaks.spacing.x
testthat::expect_silent(
plotSmoothsComparison(data = smth, response="PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Tuning"),
facet.y = "Salinity",
collapse.facets.x = FALSE,
include.raw = "facet.x",
breaks.spacing.x = -2)))
testthat::expect_silent(
plotSmoothsComparison(data = smth, response="PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Tuning"),
facet.y = "Salinity",
collapse.facets.x = FALSE,
include.raw = "facet.x",
breaks.spacing.x = -3)))
#Remove an extra DAST to have a gap of 2 with no DAST
testthat::expect_silent(
plotSmoothsComparison(data = smth[smth$DAST != 1, ], response="PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Tuning"),
facet.y = "Salinity",
collapse.facets.x = FALSE,
include.raw = "facet.x",
breaks.spacing.x = -3)))
testthat::expect_silent(
plotSmoothsComparison(data = smth[smth$DAST != 1, ], response="PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Tuning"),
facet.y = "Salinity",
collapse.facets.x = FALSE,
include.raw = "facet.x",
breaks.spacing.x = -2)))
testthat::expect_silent(
plotSmoothsComparison(data = smth[smth$DAST != 1, ], response="PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Tuning"),
facet.y = "Salinity",
collapse.facets.x = FALSE,
include.raw = "facet.x",
breaks.spacing.x = -3)))
testthat::expect_warning(
smth <- probeSmooths(data = RicePrepped.dat, response = "PSA", response.smoothed = "sPSA",
times = "DAST",
smoothing.args =
args4smoothing(spline.types = c("NCSS", "PS"),
smoothing.methods = "logarithmic",
df = c(4,7),
lambdas = c(0.1,1,10)),
which.plots = "medians.dev",
meddevn.plot.args =
args4meddevn_plot(plots.by = "Type",
plots.group = "Tuning",
facet.x = ".", facet.y = c("Smarthouse","Salinity"))),
regexp = "Need at least 4 distinct x values to fit a spline - all fitted values set to NA")
testthat::expect_equal(nrow(smth), 73920)
testthat::expect_equal(ncol(smth), 16)
#Test for segmented smoothing
lambdas <- round(10^c(-0.5, 0, 0.5, 1), digits = 3)
df <- 4:5
traits <- c("PSA","PSA.AGR","PSA.RGR")
DAST.segs <- list(c(-1,5),c(6,13))
tmp <- subset(RicePrepped.dat, Smarthouse == "NW")
testthat::expect_warning(
longiseg.smth <- probeSmooths(data = tmp,
response = "PSA", response.smoothed = "sPSA",
times = "DAST",
get.rates = TRUE,
smoothing.args =
args4smoothing(smoothing.methods = "log",
spline.types = c("NCSS","PS"),
df = df,
lambdas = list(PS = lambdas),
smoothing.segments = DAST.segs,
npspline.segments = c(4,6)),
which.plots = "none",
keep.columns = c("Smarthouse", "Salinity")),
regexp = "Need at least 4 distinct x values to fit a spline - all fitted values set to NA")
testthat::expect_equal(nrow(longiseg.smth), 44352)
testthat::expect_equal(ncol(longiseg.smth), 16)
testthat::expect_true(all(unique(longiseg.smth$DAST) == c(-1,1:13)))
testthat::expect_true(all(c("Type", "TunePar", "TuneVal", "Tuning", "Method",
"Snapshot.ID.Tag", "DAST", "Smarthouse", "Salinity",
"PSA", "PSA.AGR", "PSA.RGR", "sPSA", "sPSA.AGR", "sPSA.RGR")
%in% names(longiseg.smth)))
#check sPSA.AGR for first DAST of first segment is always NA,
#but that first DAST of 2nd segment (DAST 6) is has values that are not NA
testthat::expect_true(all(is.na(longiseg.smth$sPSA.AGR[longiseg.smth$DAST == -1])))
testthat::expect_false(all(is.na(longiseg.smth$sPSA.AGR[longiseg.smth$DAST == 6])))
#Recalculate using derivatives
testthat::expect_warning(
longisegder.smth <- probeSmooths(data = tmp,
times = "DAST",
response = "PSA", response.smoothed = "sPSA",
get.rates = TRUE, rates.method = "deriv",
smoothing.args =
args4smoothing(smoothing.methods = "log",
spline.types = c("NCSS","PS"),
df = df,
lambdas = list(PS = lambdas),
smoothing.segments = DAST.segs,
npspline.segments = c(4,6)),
which.plots = "none",
keep.columns = c("Smarthouse", "Salinity")),
regexp = "Need at least 4 distinct x values to fit a spline - all fitted values set to NA")
testthat::expect_equal(nrow(longisegder.smth), 44352)
testthat::expect_equal(ncol(longisegder.smth), 16)
testthat::expect_true(all(unique(longisegder.smth$DAST) == c(-1,1:13)))
testthat::expect_true(all(c("Type", "TunePar", "TuneVal", "Tuning", "Method",
"Snapshot.ID.Tag", "DAST", "Smarthouse", "Salinity",
"PSA", "PSA.AGR", "PSA.RGR", "sPSA", "sPSA.AGR", "sPSA.RGR")
%in% names(longisegder.smth)))
#check that, for sPSA.AGR, the DASTs that are missing for differences are not the same as for derivatives
testthat::expect_true(sum(is.na(longiseg.smth$sPSA.AGR[longiseg.smth$DAST == -1])) !=
sum(is.na(longisegder.smth$sPSA[longisegder.smth$DAST == -1])))
#Check that the DAST at the start of each segment has values that are not NA for derivatives
testthat::expect_true(!all(is.na(longisegder.smth$sPSA.AGR[longisegder.smth$DAST == -1])))
testthat::expect_true(!all(is.na(longisegder.smth$sPSA.AGR[longisegder.smth$DAST == 6])))
#Plot the median deviations
testthat::expect_silent(
t <- plotSmoothsMedianDevns(data = longisegder.smth, response = "PSA",
response.smoothed = "sPSA",
times = "DAST", trait.types = "AGR",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL, plots.group = "Tuning",
facet.x = ".", facet.y = c("Smarthouse","Salinity"),
propn.types = 0.025)))
testthat::expect_equal(length(t$plots), 1)
testthat::expect_equal(nrow(t$med.devn.dat), 144)
testthat::expect_equal(ncol(t$med.devn.dat), 5)
#every first DAST must be NA for deviations because PSA.AGR has to be calculated by differences
testthat::expect_true(all(is.na(t$med.devn.dat$PSA.AGR[t$med.devn.dat$DASTs == -1])))
#every DAST 6, 7 and 13 must be NA for deviations because PSA.AGR has to be calculated
#within segments and by differences with ntimes2span == 3 to centre it properly
testthat::expect_true(all(is.na(t$med.devn.dat$PSA.AGR[t$med.devn.dat$DASTs == 6])))
testthat::expect_true(all(is.na(t$med.devn.dat$PSA.AGR[t$med.devn.dat$DASTs == 7])))
testthat::expect_true(all(is.na(t$med.devn.dat$PSA.AGR[t$med.devn.dat$DASTs == 13])))
testthat::expect_true(all(c("Smarthouse", "Salinity", "SmoothParams", "PSA.AGR.devn", "DAST")
%in% names(t$med.devn.dat)))
#test segmented smooth that is a subset
lambdas <- round(10^c(-0.5, 0, 0.5, 1), digits = 3)
df <- 4:5
traits <- c("PSA","PSA.AGR","PSA.RGR")
DAST.segs <- list(c(-1,5),c(6,11))
tmp <- subset(RicePrepped.dat, Smarthouse == "NW")
testthat::expect_warning(
longiseg.smth <- probeSmooths(data = tmp,
response = "PSA", response.smoothed = "sPSA",
times = "DAST",
get.rates = TRUE,
smoothing.args =
args4smoothing(smoothing.methods = "log",
spline.types = c("NCSS","PS"),
df = df,
lambdas = list(PS = lambdas),
smoothing.segments = DAST.segs,
npspline.segments = c(4,6)),
which.plots = "none",
keep.columns = c("Smarthouse", "Salinity")),
regexp = "Need at least 4 distinct x values to fit a spline - all fitted values set to NA")
testthat::expect_equal(nrow(longiseg.smth), 38016)
testthat::expect_equal(ncol(longiseg.smth), 16)
testthat::expect_true(all(unique(longiseg.smth$DAST) == c(-1,1:11)))
testthat::expect_true(all(c("Type", "TunePar", "TuneVal", "Tuning", "Method",
"Snapshot.ID.Tag", "DAST", "Smarthouse", "Salinity",
"PSA", "PSA.AGR", "PSA.RGR", "sPSA", "sPSA.AGR", "sPSA.RGR")
%in% names(longiseg.smth)))
#check sPSA.AGR for first DAST of first segment is always NA,
#but that first DAST of 2nd segment (DAST 6) is has values that are not NA
testthat::expect_true(all(is.na(longiseg.smth$sPSA.AGR[longiseg.smth$DAST == -1])))
testthat::expect_false(all(is.na(longiseg.smth$sPSA.AGR[longiseg.smth$DAST == 6])))
#Recalculate using derivatives
testthat::expect_warning(
longisegder.smth <- probeSmooths(data = tmp,
times = "DAST",
response = "PSA", response.smoothed = "sPSA",
get.rates = TRUE, rates.method = "deriv",
smoothing.args =
args4smoothing(smoothing.methods = "log",
spline.types = c("NCSS","PS"),
df = df,
lambdas = list(PS = lambdas),
smoothing.segments = DAST.segs,
npspline.segments = c(4,6)),
which.plots = "none",
keep.columns = c("Smarthouse", "Salinity")),
regexp = "Need at least 4 distinct x values to fit a spline - all fitted values set to NA")
testthat::expect_equal(nrow(longisegder.smth), 38016)
testthat::expect_equal(ncol(longisegder.smth), 16)
testthat::expect_true(all(unique(longisegder.smth$DAST) == c(-1,1:11)))
testthat::expect_true(all(c("Type", "TunePar", "TuneVal", "Tuning", "Method",
"Snapshot.ID.Tag", "DAST", "Smarthouse", "Salinity",
"PSA", "PSA.AGR", "PSA.RGR", "sPSA", "sPSA.AGR", "sPSA.RGR")
%in% names(longisegder.smth)))
#check that, for sPSA.AGR, the DASTs that are missing for differences are not the same as for derivatives
testthat::expect_true(sum(is.na(longiseg.smth$sPSA.AGR[longiseg.smth$DAST == -1])) !=
sum(is.na(longisegder.smth$sPSA[longisegder.smth$DAST == -1])))
#every DAST 6, 7 and 13 must be NA for deviations because PSA.AGR has to be calculated
#within segments and by differences with ntimes2span == 3 to centre it properly
testthat::expect_true(!all(is.na(longisegder.smth$sPSA.AGR[longisegder.smth$DAST == -1])))
testthat::expect_true(!all(is.na(longisegder.smth$sPSA.AGR[longisegder.smth$DAST == 6])))
testthat::expect_true(!all(is.na(longisegder.smth$sPSA.AGR[longisegder.smth$DAST == 7])))
testthat::expect_true(!all(is.na(longisegder.smth$sPSA.AGR[longisegder.smth$DAST == 11])))
})
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.
cat("#### Test smooth.frames with a baby example\n")
test_that("smooth.frames_growthPheno", {
skip_if_not_installed("growthPheno")
skip_on_cran()
library(growthPheno)
library(scales)
dat <- read.table(header = TRUE, text = "
Type TunePar TuneVal Tuning Method ID DAP PSA sPSA
NCSS df 4 df-4 direct 045451-C 28 57.446 51.18456
NCSS df 4 df-4 direct 045451-C 30 89.306 87.67343
NCSS df 7 df-7 direct 045451-C 28 57.446 57.01589
NCSS df 7 df-7 direct 045451-C 30 89.306 87.01316
")
dat[1:7] <- lapply(dat[1:6], factor)
dat <- as.smooths.frame(dat, individuals = "ID", times = "DAP")
testthat::expect_true(is.smooths.frame(dat))
testthat::expect_true(validSmoothsFrame(dat))
tmp <- dat[,-c(2,8)]
testthat::expect_true(is.smooths.frame(tmp))
testthat::expect_silent(validsframe <- validSmoothsFrame(tmp))
testthat::expect_equal(validsframe[2],
paste0("\n The followng attributes of a smooths.frame are NULL: ",
"t, nschemes, individuals, times"))
testthat::expect_equal(validsframe[3],
"\n Do not have the following required smoothing-parameters columns in a smooths.frame: TunePar")
testthat::expect_error(as.smooths.frame(tmp),
regexp = paste0("Cannot assign smooths.frame class to supplied data.frame because it does not ",
"contain the following smoothing-parameters columns: TunePar"),
fixed = TRUE)
})
cat("#### Test probeSmooths with Judith Atieno 0278\n")
test_that("chickpea_growthPheno", {
skip_if_not_installed("growthPheno")
skip_on_cran()
library(growthPheno)
library(ggplot2)
data(dat1)
#'## Values of df for which to obtain plots
df <- c(4,7)
#'## Obtain separate plots Tunings
testthat::expect_warning(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = df, lambdas = NULL),
profile.plot.args =
args4profile_plot(breaks.spacing.x = 2,
plots.by = "Tuning",
facet.x = "Treatment.1",
facet.y = "Smarthouse")
),
regexp = "NaNs produced")
testthat::expect_equal(nrow(t), 16960)
testthat::expect_equal(ncol(t), 16)
#'## Obtain separate plots Tunings, when includes NCSS for lambda
testthat::expect_warning(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df=df,
lambdas = list(NCSS = 0.0001)),
profile.plot.args =
args4profile_plot(breaks.spacing.x = 2,
plots.by = "Tuning",
facet.x = "Treatment.1",
facet.y = "Smarthouse",
include.raw = "alone")),
regexp = "NaNs produced")
testthat::expect_equal(nrow(t), 25440)
testthat::expect_equal(ncol(t), 16)
#'## Obtain separate plots Tunings, when includes NCSS & PS for lambda
testthat::expect_error(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df=7,
lambdas = list(NCSS = 0.0001, PS = 1)),
profile.plot.args =
args4profile_plot(breaks.spacing.x = 2,
plots.by = "Tuning",
facet.x = "Treatment.1",
facet.y = "Smarthouse")
),
regexp = "The following names for the components of lambdas are not in the specified spline.types: PS")
#'## Obtain separate plots Tunings, when includes NCSS & PS for lambda
testthat::expect_warning(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = c("NCSS","PS"),
df=7,
lambdas = list(NCSS = 0.0001, PS = 1)),
profile.plot.args =
args4profile_plot(breaks.spacing.x = 2,
plots.by = c("Type","Tuning"),
facet.x = "Treatment.1", facet.y = "Smarthouse",
include.raw = "facet.x")),
regexp = "NaNs produced")
testthat::expect_equal(nrow(t), 25440)
testthat::expect_equal(ncol(t), 16)
#'## Obtain separate plots Tunings, when includes NCSS & PS for lambda and set include.raw to "alone"
testthat::expect_warning(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = c("NCSS","PS"),
df=7,
lambdas = list(NCSS = 0.0001, PS = 1)),
profile.plot.args =
args4profile_plot(breaks.spacing.x = 2,
plots.by = c("Type","Tuning"),
facet.x = "Treatment.1", facet.y = "Smarthouse",
include.raw = "alone")),
regexp = "NaNs produced")
testthat::expect_equal(nrow(t), 25440)
testthat::expect_equal(ncol(t), 16)
#Test various combinations of smoothing and non-smoothing factors in facet.x
testthat::expect_warning(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
get.rates = FALSE,
keep.columns = c("Smarthouse", "Treatment.1"),
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = df, lambdas = NULL),
which.plots = "none"),
repexp = paste0("The calculation of smoothed growth rates have not been specified; ",
"trait.types changed to response and propn.type.med reduced to its first element"))
testthat::expect_equal(nrow(t), 16960)
testthat::expect_equal(ncol(t), 11)
testthat::expect_true(all(c("Smarthouse", "Treatment.1") %in% names(t)))
#test for incorrect trait.types
testthat::expect_error(plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Treatment.1", "Method", "Tuning"),
facet.y = ".",
include.raw = "no")),
regexp = paste0("The following traits are not in the smooths.frame: ShootArea1000.AGR, ",
"ShootArea1000.RGR; perhaps, trait.types needs to be set differently"))
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(plots.by = "Tuning",
facet.x = c("Smarthouse", "Treatment.1"),
facet.y = ".",
include.raw = "no")))
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Treatment.1", "Tuning"),
facet.y = ".",
include.raw = "no")))
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Treatment.1", "Tuning"),
collapse.facets.x = FALSE,
facet.y = ".",
include.raw = "no")))
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Treatment.1", "Tuning"),
facet.y = ".",
include.raw = "facet.x")))
#Don't collapse the facet.x
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Treatment.1", "Tuning"),
facet.y = ".",
include.raw = "no",
collapse.facets.x = FALSE)))
#Inclusion of raw with both smoothing-parameter and other factors in facet.x
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Treatment.1", "Tuning"),
facet.y = ".",
collapse.facets.x = FALSE,
include.raw = "facet.x")))
#Inclusion of raw with both smoothing-parameter and other factors in facet.y
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = ".",
facet.y = c("Method", "Treatment.1", "Tuning"),
collapse.facets.y = FALSE, include.raw = "facet.y")))
#Inclusion of raw in facet.y = "."
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Treatment.1", "Tuning"),
facet.y = ".",
collapse.facets.x = FALSE, include.raw = "facet.y")))
#Inclusion of raw with other factors in facet.x and facet.y
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Tuning"),
facet.y = "Treatment.1",
collapse.facets.x = FALSE,
include.raw = "facet.x")))
#removes Median whiskers
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = ".",
facet.y = c("Method", "Treatment.1", "Tuning"),
collapse.facets.y = FALSE,
include.raw = "facet.y")))
#removes Median whiskers
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Treatment.1", "Tuning"),
facet.y = ".",
include.raw = "no",
addMediansWhiskers = FALSE)))
#Must specify either plots.by or plots.compare
testthat::expect_warning(testthat::expect_error(
t <- probeSmooths(dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = df, lambdas = NULL)),
regexp = paste0("There are no smoothing-parameter factors assigned to the plots and facet ",
"arguments - enough of them need to be assigned so that they uniquely index ",
"the combinations of the smoothing-parameter values in the smooths.frame")),
regexp = "NaNs produced")
#Check breaks.spacing.x = -1
testthat::expect_silent(
plotSmoothsComparison(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = ("response"),
profile.plot.args =
args4profile_plot(breaks.spacing.x = -1,
plots.by = "Smarthouse",
facet.x = c("Method", "Treatment.1", "Tuning"),
facet.y = ".",
collapse.facets.x = FALSE,
include.raw = "facet.x")))
#Plot medians.deviations only with only facet.y.med set
testthat::expect_warning(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types = "response",
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = df, lambdas = NULL),
which.plots = "medians.dev",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = ".",
facet.y = c("Smarthouse", "Treatment.1"),
propn.types = 0.05)))
testthat::expect_equal(nrow(t), 16960)
testthat::expect_equal(ncol(t), 11)
#Plot with plots.by.pf set to Tuning, plots.compare set to NULL and facet.x.pf set to Treatment.1
testthat::expect_silent(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types=c("AGR"),
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = df, lambdas = NULL),
profile.plot.args =
args4profile_plot(breaks.spacing.x = -1,
plots.by = "Tuning",
facet.x = "Treatment.1",
facet.y = "Smarthouse",
include.raw = "alone")))
testthat::expect_equal(nrow(t), 16960)
testthat::expect_equal(ncol(t), 14)
#specify Treatment.1 and Tuning for facet.x.pf
testthat::expect_silent(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types=c("response"), get.rates=FALSE,
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = df, lambdas = NULL),
profile.plot.args =
args4profile_plot(breaks.spacing.x = -1,
plots.by = NULL,
facet.x = c("Treatment.1", "Tuning"),
facet.y = "Smarthouse")))
#include raw plots with compare and no facet.x.pf
testthat::expect_silent(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types=c("response"), get.rates=FALSE,
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = df, lambdas = NULL),
profile.plot.args =
args4profile_plot(breaks.spacing.x = -1,
plots.by = NULL,
facet.x = "Tuning",
facet.y = "Treatment.1",
include.raw = "facet.x")))
testthat::expect_equal(nrow(t), 16960)
testthat::expect_true(all(c("Type", "TunePar", "TuneVal", "Tuning", "Method",
"Snapshot.ID.Tag", "TimeAfterPlanting",
"Treatment.1", "ShootArea1000", "sShootArea1000")
%in% names(t)))
#'## Plots of response and deviations boxplots
testthat::expect_silent(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
x.title = "DAP",
trait.types=c("response"), get.rates=FALSE,
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = df, lambdas = NULL),
which.plots = c("profiles", "absolute"),
profile.plot.args =
args4profile_plot(plots.by = NULL,
facet.x = "Tuning",
facet.y = "Treatment.1"),
devnboxes.plot.args =
args4devnboxes_plot(plots.by = NULL,
facet.x = "Tuning",
facet.y = "Treatment.1")))
testthat::expect_equal(nrow(t), 16960)
testthat::expect_true(all(c("Type", "TunePar", "TuneVal", "Tuning", "Method",
"Snapshot.ID.Tag", "TimeAfterPlanting",
"Treatment.1", "ShootArea1000", "sShootArea1000")
%in% names(t)))
#Check plots.by in plotSmoothsDevnBoxplots
plts <- plotSmoothsDevnBoxplots(data = t, response="ShootArea1000",
times = "TimeAfterPlanting",
x.title = "DAP",
trait.types=c("response"),
devnboxes.plot.args =
args4devnboxes_plot(plots.by = "Tuning",
facet.x = "'Tuning'",
facet.y = "Treatment.1"))
testthat::expect_equal(length(plts), 1)
testthat::expect_equal(names(plts), "ShootArea1000")
testthat::expect_equal(names(plts[[1]]), "absolute")
testthat::expect_equal(length(plts[[1]][["absolute"]]), 2)
testthat::expect_true(all(names(plts[[1]][["absolute"]]) == c("df-4", "df-7")))
#plots.by.pf gives separate plots
testthat::expect_warning(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
trait.types=c("response", "AGR"),
x.title = "DAP",
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = df, lambdas = NULL),
which.plots = c("profiles", "absolute", "relative"),
profile.plot.args =
args4profile_plot(plots.by = NULL,
facet.x = "Tuning",
facet.y = "Treatment.1"),
devnboxes.plot.args =
args4devnboxes_plot(plots.by = NULL,
facet.x = "Tuning",
facet.y = "Treatment.1")))
testthat::expect_equal(nrow(t), 16960)
testthat::expect_lt(max(abs(t[t$TuneVal == "4", "ShootArea1000"] - t[t$TuneVal == "4", "sShootArea1000"]),
na.rm = TRUE) - 5.563407, 1e-07)
testthat::expect_lt(max(abs(t[t$TuneVal == "4", "ShootArea1000"] - t[t$TuneVal == "4", "sShootArea1000"])/
t[t$TuneVal == "4", "sShootArea1000"]) - 370.7951, 1e-04)
testthat::expect_silent(
t <- probeSmooths(data = dat1, response="ShootArea1000",
times = "TimeAfterPlanting",
x.title = "DAP",
trait.types=c("response", "AGR"),
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = df, lambdas = NULL),
profile.plot.args =
args4profile_plot(plots.by = NULL,
facet.x = "Tuning",
facet.y = c("Smarthouse", "Treatment.1"))))
testthat::expect_equal(nrow(t), 16960)
})
cat("#### Test probeSmooths with small example\n")
test_that("exampleData_growthPheno", {
skip_if_not_installed("growthPheno")
skip_on_cran()
library(growthPheno)
data(exampleData)
vline <- list(ggplot2::geom_vline(xintercept=29, linetype="longdash", linewidth=1))
plotDeviationsBoxes(longi.dat, observed = "PSA", smoothed = "sPSA",
x.factor="DAP", df =5)
testthat::expect_warning(
tmp <- probeSmooths(data = longi.dat,
response = "PSA", times = "DAP",
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL),
profile.plot.args =
args4profile_plot(plots.by = NULL,
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_warning(testthat::expect_error(
tmp <- probeSmooths(data = longi.dat,
response = "PSA", times = "DAP",
get.rates = FALSE,
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL),
profile.plot.args =
args4profile_plot(plots.by = NULL,
facet.x = "Method",
facet.y = ".",
ggplotFuncs = vline)),
regexp = paste0("\n The number of different combinations of \\(i\\) the smoothing-parameter values that ",
"are available and \\(ii\\) the levels combination of the following factors nominated ",
"in the facet/plots arguments are not equal: Method")),
regexp = paste0("The calculation of smoothed growth rates have not been specified; ",
"trait.types changed to response and propn.type reduced to its first element"))
testthat::expect_warning(
tmp <- probeSmooths(data = longi.dat,
response = "PSA", times = "DAP",
get.rates = FALSE,
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL),
profile.plot.args =
args4profile_plot(plots.by = NULL,
facet.x = "Tuning",
facet.y = ".",
ggplotFuncs = vline)))
testthat::expect_equal(nrow(tmp), 560)
testthat::expect_equal(ncol(tmp), 9)
testthat::expect_warning(
tmp <- probeSmooths(data = longi.dat,
response = "PSA", times = "DAP",
get.rates = FALSE,
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL),
profile.plot.args =
args4profile_plot(plots.by = NULL,
facet.x = "Tuning",
facet.y = ".",
alpha = 0.6,
ggplotFuncs = vline)),
regexp = paste0("The calculation of smoothed growth rates have not been specified; ",
"trait.types changed to response and propn.type reduced to its first element"))
testthat::expect_equal(nrow(tmp), 560)
testthat::expect_equal(ncol(tmp), 9)
#AGR trait plot only
testthat::expect_warning(
tmp <- probeSmooths(data = longi.dat,
response = "PSA", times = "DAP",
trait.types = "AGR",
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL),
profile.plot.args =
args4profile_plot(plots.by = NULL,
facet.x = "Tuning",
facet.y = ".",
alpha = 0.5,
ggplotFuncs = vline)),
regexp = "Removed 3 rows containing missing values or values outside the scale range \\(\\`geom_vline\\(\\)\\`\\)")
testthat::expect_equal(nrow(tmp), 560)
testthat::expect_equal(ncol(tmp), 12)
#Compare medians and profiles for multiple traits
testthat::expect_warning(
tmp <- probeSmooths(data = longi.dat,
response = "PSA", times = "DAP",
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL),
which.plots = c("profiles", "medians.dev"),
profile.plot.args =
args4profile_plot(plots.by = NULL,
facet.x = "Tuning",
facet.y = ".",
ggplotFuncs = vline),
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = ".",
facet.y = ".",
propn.types = c(0.02,0.1, 0.2))))
testthat::expect_equal(nrow(tmp), 560)
testthat::expect_equal(ncol(tmp), 14)
#Compare medians for multiple traits
testthat::expect_warning(
tmp <- probeSmooths(data = longi.dat,
response = "PSA", times = "DAP",
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL),
which.plots = "medians.dev",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = ".",
facet.y = ".",
propn.types = c(0.02,0.1, 0.2))))
testthat::expect_equal(nrow(tmp), 560)
testthat::expect_equal(ncol(tmp), 14)
testthat::expect_warning(
tmp <- probeSmooths(data = longi.dat,
response = "PSA", times = "DAP",
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL),
profile.plot.args =
args4profile_plot(plots.by = NULL,
facet.x = "Tuning",
facet.y = "Treatment.1",
ggplotFuncs = vline)),
regexp = "Removed 6 rows containing missing values or values outside the scale range \\(\\`geom_vline\\(\\)\\`\\)")
#Test for a single line per plot - caused by plots.by.med
testthat::expect_silent(
med <- plotSmoothsMedianDevns(data = tmp,
response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
trait.types = "response",
x.title = "DAP",
meddevn.plot.args =
args4meddevn_plot(plots.by = "Tuning",
plots.group = NULL,
facet.x = ".",
facet.y = ".",
propn.types = 0.05,
ggplotFuncs = vline)))
testthat::expect_equal(length(med$plots), 1)
testthat::expect_equal(nrow(med$med.devn.dat), 28)
testthat::expect_equal(ncol(med$med.devn.dat), 3)
#Test for a single line per plot - caused by plots.by.med; specification of colour and shape
testthat::expect_silent(
med <- plotSmoothsMedianDevns(data = tmp,
response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
trait.types = "response",
x.title = "DAP",
meddevn.plot.args =
args4meddevn_plot(plots.by = "Tuning",
plots.group = NULL,
facet.x = ".",
facet.y = ".",
propn.types = 0.05,
colour.values = "blue",
shape.values = 17,
ggplotFuncs = vline)))
testthat::expect_equal(length(med$plots), 1)
testthat::expect_equal(nrow(med$med.devn.dat), 28)
testthat::expect_equal(ncol(med$med.devn.dat), 3)
#Compare medians and absolute deviations for multiple traits
testthat::expect_warning(
traits <- probeSmooths(data = longi.dat,
response = "PSA", times = "DAP",
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL),
which.plots = c("medians.dev", "absolute"),
profile.plot.args = NULL,
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = ".",
facet.y = ".",
propn.types = NULL,
ggplotFuncs = vline),
devnboxes.plot.args =
args4devnboxes_plot(plots.by = NULL,
facet.x = "Tuning",
facet.y = ".",
ggplotFuncs = vline)))
testthat::expect_equal(nrow(traits), 560)
testthat::expect_equal(ncol(traits), 14)
#Form and save the data.frame containing the smooths produced by probeSmooths for testing associated functions
testthat::expect_silent(
traits <- probeSmooths(data = longi.dat,
response = "PSA", times = "DAP",
keep.columns = c("Treatment.1", "Genotype.ID"), #so in smooths.frame
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL),
which.plots = "none"))
#Fit simple and four-parameter logistics and obtain the fitted values
library(nlme)
extra.dat <- longi.dat[, -grep("sPSA", names(longi.dat), fixed = TRUE)]
logist.grp <- nlme::groupedData(PSA ~ xDAP | Snapshot.ID.Tag, data = longi.dat)
#Fit the simple logistic model
logist.lis <- nlme::nlsList(SSlogis, logist.grp, na.action = na.pass)
logist.dat <- within(extra.dat, sPSA <- fitted(logist.lis))
logist.dat <- cbind(Tuning = factor("Logistic"), logist.dat)
#Fit the four-parameter logistic model - generates warnings
logis4.lis <- suppressWarnings(nlme::nlsList(SSfpl, logist.grp, na.action = na.pass))
logis4.dat <- within(extra.dat, sPSA <- fitted(logis4.lis))
logis4.dat <- cbind(Tuning = factor("Logis-4par"), logis4.dat)
#Combine the logistic fits
extra.dat <- rbind(logist.dat,logis4.dat)
extra.dat <- cbind(Type = factor("NonLinear"), extra.dat)
#Check computation of median deviations for Control Treatment, Genotype = 120855 and df = 5
tmp <- subset(traits, Treatment.1 == "Control" & Genotype.ID == "120855" & TuneVal == "4")
tmp$PSA.devn <- tmp$PSA - tmp$sPSA
med.vals <- tapply(tmp$PSA.devn, tmp$DAP, median, na.rm = TRUE)
testthat::expect_silent(
med <- plotSmoothsMedianDevns(data = traits,
response = "PSA", times = "DAP",
x.title = "DAP",
trait.types = "response",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = ".",
facet.y = c("Treatment.1", "Genotype.ID"),
propn.types = 0.05,
ggplotFuncs = vline),
printPlot = FALSE))
med.dat <- med$med.devn.dat
med.dat <- subset(med.dat, Treatment.1 == "Control" & Genotype.ID == "120855" & SmoothParams == "df-4")
testthat::expect_true(all(abs(med.dat$PSA.devn - med.vals) < 1e-5))
testthat::expect_silent(
med <- plotSmoothsMedianDevns(data = traits,
response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
trait.types = "response",
x.title = "DAP",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = ".",
facet.y = ".",
propn.types = 0.05,
ggplotFuncs = vline)))
testthat::expect_equal(length(med), 2)
testthat::expect_true(all(names(med) == c("plots", "med.devn.dat")))
testthat::expect_equal(nrow(med$med.devn.dat), 28)
testthat::expect_equal(ncol(med$med.devn.dat), 3)
testthat::expect_equal(length(med$plots), 1)
#Form a smooths.frame with external.smooths for further testing
testthat::expect_warning(
smth.extra <- probeSmooths(data = longi.dat,
response = "PSA", times = "DAP",
smoothing.args = args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL,
external.smooths = extra.dat),
which.plots = c("medians.dev", "absolute"),
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = ".", facet.y = ".",
propn.types = NULL),
devnboxes.plot.args =
args4devnboxes_plot(plots.by = NULL,
facet.x = "Tuning", facet.y = ".")))
testthat::expect_equal(nrow(smth.extra), 1120)
testthat::expect_equal(ncol(smth.extra), 14)
#Use external.smooths incorporated using probeSmooths
testthat::expect_warning(
med <- plotSmoothsMedianDevns(data = smth.extra,
response = "PSA", times = "DAP",
x.title = "DAP",
meddevn.plot.args =
args4meddevn_plot(plots.by = "Type",
plots.group = "Tuning",
facet.x = ".", facet.y = ".",
propn.types = c(0.02,0.1, 0.2),
ggplotFuncs = vline)))
testthat::expect_equal(length(med), 2)
testthat::expect_true(all(names(med) == c("plots", "med.devn.dat")))
testthat::expect_equal(nrow(med$med.devn.dat), 56)
testthat::expect_equal(ncol(med$med.devn.dat), 6)
testthat::expect_equal(levels(med$med.devn.dat$SmoothParams),
c("df-4","df-7","Logistic","Logis-4par"))
testthat::expect_equal(length(med$plots), 3)
testthat::expect_warning(
t <- plotSmoothsDevnBoxplots(data = smth.extra,
response = "PSA", times = "DAP",
devnboxes.plot.args =
args4devnboxes_plot(plots.by = "Type",
facet.x = "Tuning",
facet.y = ".")))
testthat::expect_equal(length(t), 3)
testthat::expect_true(all(names(t) == c("PSA", "PSA.AGR", "PSA.RGR")))
testthat::expect_equal(names(t[[1]]), "absolute")
testthat::expect_equal(length(t[[1]][["absolute"]]), 2)
testthat::expect_true(all(names(t[[1]][["absolute"]]) == c("NCSS", "NonLinear")))
#Use plots.by different to that in probeSmooths
plts <- plotSmoothsComparison(data = smth.extra,
response = "PSA", times = "DAP",
x.title = "DAP",
profile.plot.args =
args4profile_plot(plots.by = "Type",
facet.x = "Tuning", facet.y = ".",
include.raw = "facet.x",
alpha = 0.2,
ggplotFuncs = vline))
testthat::expect_equal(length(plts), 3)
testthat::expect_true(all(c("PSA","PSA.AGR","PSA.RGR") %in% names(plts)))
testthat::expect_true("profiles" == names(plts$PSA))
testthat::expect_true("profiles" == names(plts$PSA.AGR))
testthat::expect_equal(length(plts$PSA$deviations), 0)
testthat::expect_equal(length(plts$PSA$profiles), 2)
testthat::expect_true(all(c("NCSS", "NonLinear") %in% names(plts$PSA$profiles)))
#Test addMediansWhiskers
plotSmoothsComparison(data = smth.extra, response = "PSA", times = "DAP",
x.title = "DAP",
profile.plot.args =
args4profile_plot(plots.by = NULL,
facet.x = c("Type", "Tuning"), facet.y = ".",
include.raw = "facet.x",
colour.column = "Method",
colour.values = c("olivedrab", "orange"),
alpha = 0.25, addMediansWhiskers = TRUE,
ggplotFuncs = vline))
plts <- plotSmoothsComparison(data = smth.extra, response = "PSA", times = "DAP",
x.title = "DAP",
profile.plot.args =
args4profile_plot(plots.by = "Type",
facet.x = "Tuning", facet.y = ".",
include.raw = "facet.x",
colour = "olivedrab",
alpha = 0.25, addMediansWhiskers = TRUE,
ggplotFuncs = vline))
#Add external smooths and include deviations plots
testthat::expect_warning(
smth.extra <- probeSmooths(data = longi.dat[, 1:25],
response = "PSA", times ="DAP",
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "NCSS",
df = c(4,7), lambdas = NULL,
external.smooths = extra.dat),
which.plots = c("medians.dev", "absolute"),
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = c("Type", "Tuning"),
facet.x = ".", facet.y = ".",
propn.types = NULL),
devnboxes.plot.args =
args4devnboxes_plot(plots.by = NULL,
facet.x = c("Type", "Tuning"),
facet.y = ".")))
testthat::expect_equal(nrow(smth.extra), 1120)
testthat::expect_equal(ncol(smth.extra), 14)
testthat::expect_warning(
med <- plotSmoothsMedianDevns(data = smth.extra,
response = "PSA", times = "DAP",
x.title = "DAP",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = c("Type", "Tuning"),
facet.x = ".", facet.y = ".",
propn.types = c(0.02,0.1, 0.2),
ggplotFuncs = vline)))
testthat::expect_equal(length(med), 2)
testthat::expect_true(all(names(med) == c("plots", "med.devn.dat")))
testthat::expect_equal(nrow(med$med.devn.dat), 56)
testthat::expect_equal(ncol(med$med.devn.dat), 5)
testthat::expect_equal(levels(med$med.devn.dat$SmoothParams),
c("NCSS-df-4","NCSS-df-7",
"NonLinear-Logistic","NonLinear-Logis-4par"))
testthat::expect_equal(length(med$plots), 3)
testthat::expect_warning(
med <- plotSmoothsMedianDevns(data = smth.extra,
response = "PSA", times = "DAP",
x.title = "DAP",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = "Type", facet.y = ".",
propn.types = c(0.02,0.1, 0.2),
ggplotFuncs = vline)))
testthat::expect_equal(length(med), 2)
testthat::expect_true(all(names(med) == c("plots", "med.devn.dat")))
testthat::expect_equal(levels(med$med.devn.dat$SmoothParams),
c("df-4","df-7","Logistic","Logis-4par"))
testthat::expect_warning(
med <- plotSmoothsMedianDevns(data = smth.extra,
response = "PSA", times = "DAP",
x.title = "DAP",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = ".", facet.y = "Type",
propn.types = c(0.02,0.1, 0.2),
ggplotFuncs = vline)))
testthat::expect_equal(length(med), 2)
testthat::expect_true(all(names(med) == c("plots", "med.devn.dat")))
testthat::expect_equal(levels(med$med.devn.dat$SmoothParams),
c("df-4","df-7","Logistic","Logis-4par"))
testthat::expect_warning(
med <- plotSmoothsMedianDevns(data = smth.extra,
response = "PSA", times = "DAP",
x.title = "DAP",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = "Type", facet.y = ".",
propn.types = c(0.02,0.1, 0.2),
ggplotFuncs = vline)))
testthat::expect_equal(length(med), 2)
testthat::expect_true(all(names(med) == c("plots", "med.devn.dat")))
testthat::expect_equal(levels(med$med.devn.dat$SmoothParams),
c("df-4","df-7","Logistic","Logis-4par"))
})
cat("#### Test probeSmooths with tomato example\n")
test_that("tomato_growthPheno", {
skip_if_not_installed("growthPheno")
skip_on_cran()
library(dae)
library(growthPheno)
data(tomato.dat)
df.vec <- c(4:6,12)
labelMyc <- as_labeller(function(lev) paste(lev, "AMF"))
labelZn <- as_labeller(function(lev) paste("Zn:", lev, "ppm"))
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]
labels <- labeller(Zn = labelZn, AMF = labelMyc)
#'## Gives error that the Length of propn.types.med is not the same as the number of traits
testthat::expect_warning(
tom <- probeSmooths(data = tomato.dat,
response = "PSA", response.smoothed = "sPSA",
times = "DAP",
get.rates = FALSE,
smoothing.args =
args4smoothing(smoothing.methods = c("dir", "log"),
spline.types = "NCSS",
df = c(4,7), lambdas = NULL),
which.plots = c("profiles", "medians.dev"),
profile.plot.args =
args4profile_plot(plots.by = "Tuning",
facet.x = "Method", facet.y = c("Zn","AMF"),
facet.labeller = labels),
meddevn.plot.args =
args4meddevn_plot(plots.by = "Tuning",
plots.group = "Method",
facet.x = ".", facet.y = c("Zn","AMF"),
facet.labeller = labels)),
regexp = paste0("The calculation of smoothed growth rates have not been specified; ",
"trait.types changed to response and propn.type reduced to its first element"))
testthat::expect_equal(nrow(tom), 4480)
testthat::expect_equal(ncol(tom), 11)
testthat::expect_silent(
med <- plotSmoothsMedianDevns(data = tom,
response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
trait.types = "response",
x.title = "DAP",
y.titles = "PSA deviation (kpixels)",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = c("Method","Tuning"),
facet.x = "Zn", facet.y = "AMF",
propn.types = 0.1,
breaks.spacing.x = 2, angle.x = 90,
facet.labeller = labels)))
testthat::expect_equal(length(med$plots), 1)
testthat::expect_equal(nrow(med$med.devn.dat), 1120)
testthat::expect_equal(ncol(med$med.devn.dat), 5)
#Multiple df, single methods
testthat::expect_warning(
tom <- probeSmooths(data = tomato.dat, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
smoothing.args =
args4smoothing(smoothing.methods = "logarithmic",
spline.types = "NCSS",
df = 4:5, lambdas = NULL),
which.plots = "medians.dev",
meddevn.plot.args =
args4meddevn_plot(plots.by = "Method",
plots.group = "Tuning",
facet.x = ".", facet.y = ".",
propn.types = c(0.02, 0.2, 0.5),
facet.labeller = labels)))
testthat::expect_equal(nrow(tom), 2240)
testthat::expect_equal(ncol(tom), 14)
#'Single `df`, multiple methods and trait.types
testthat::expect_warning(
tomdiff <- probeSmooths(data = tomato.dat, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
smoothing.args =
args4smoothing(smoothing.methods = c("direct","logarithmic"),
spline.types = "N",
df=5, lambdas = NULL),
which.plots = "none"))
testthat::expect_equal(nrow(tomdiff), 2240)
testthat::expect_equal(ncol(tomdiff), 14)
testthat::expect_warning(
med <- plotSmoothsMedianDevns(data = tomdiff, response = "PSA",
response.smoothed = "sPSA",
times = "DAP", x.title = "DAP",
meddevn.plot.args =
args4meddevn_plot(plots.by = "Tuning",
plots.group = "Method",
facet.x = ".", facet.y = ".",
propn.types = c(0.02, 0.2, 0.5))))
testthat::expect_equal(length(med), 2)
testthat::expect_true(all(names(med) == c("plots", "med.devn.dat")))
testthat::expect_equal(nrow(med$med.devn.dat), 70)
testthat::expect_equal(ncol(med$med.devn.dat), 6)
testthat::expect_equal(length(med$plots), 3)
testthat::expect_true(all(names(med$plots) == c("PSA","PSA.AGR","PSA.RGR")))
testthat::expect_warning(print(med$plots$PSA.AGR$`df-5`))
#'Single `df`, single method - plots.by.med = Tuning
testthat::expect_warning(
tom <- probeSmooths(data = tomato.dat, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "N",
df=5, lambdas = NULL),
which.plots = "medians.dev",
meddevn.plot.args =
args4meddevn_plot(plots.by = "Tuning",
plots.group = NULL,
facet.x = ".", facet.y = ".",
colour.values = "blue",
propn.types = c(0.02, 0.2, 0.5))))
testthat::expect_equal(nrow(tom), 1120)
testthat::expect_equal(ncol(tom), 14)
#'Single `df`, single method - plots.group.med = Tuning
testthat::expect_warning(
tom <- probeSmooths(data = tomato.dat, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
smoothing.args =
args4smoothing(smoothing.methods = "direct",
spline.types = "N",
df=5, lambdas = NULL),
which.plots = "medians.dev",
meddevn.plot.args =
args4meddevn_plot(plots.by = "Tuning",
plots.group = NULL,
facet.x = ".", facet.y = ".",
propn.types = c(0.02, 0.2, 0.5))))
testthat::expect_equal(nrow(tom), 1120)
testthat::expect_equal(ncol(tom), 14)
#test custom schemes
spar <- args4smoothing(spline.types = c( "N", "NCS", "P"),
df = c( 4, 6, NA),
lambdas = c( NA, NA, 1),
smoothing.methods = c("dir", "log", "log"),
combinations = "parallel")
cols <- scales::brewer_pal("div", "Paired")(6)[c(2,4,6,8,1,3,5,7)]
testthat::expect_warning(
tom <- probeSmooths(data = tomato.dat, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
smoothing.args = spar,
which.plots = "medians.dev",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = c("Type", "Tuning", "Method"),
facet.x = ".", facet.y = ".",
colour.values = cols[1:3],
propn.types = c(0.02, 0.2, 0.5))))
testthat::expect_equal(nrow(tom), 3360)
testthat::expect_equal(ncol(tom), 14)
#Multiple df, two spline.types - uses npspline.segments
testthat::expect_warning(
tom <- probeSmooths(data = tomato.dat, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
which.plots = c("medians.dev", "profiles"),
smoothing.args = args4smoothing(smoothing.methods = "log",
spline.types = c("NCSS", "PS"),
df=5:6, lambdas = c(0.1,1),
npspline.segments = 30),
profile.plot.args =
args4profile_plot(plots.by = NULL,
facet.x = c("Type", "Tuning"), facet.y = ".",
include.raw = "no"),
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = "Type", facet.y = ".",
propn.types = c(0.02, 0.2, 0.5))))
testthat::expect_equal(nrow(tom), 4480)
testthat::expect_equal(ncol(tom), 14)
#probeSmooths without deviations plots for next set of tests
testthat::expect_warning(
tom <- probeSmooths(data = tomato.dat, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
smoothing.args = spar,
which.plots = "none"),
regexp = "NaNs produced")
#test various combinations of plots.by.pf, plots.compare and include.raw.pf alone
testthat::expect_silent(
plts <-
plotSmoothsComparison(data = tom, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
profile.plot.args =
args4profile_plot(
plots.by = c("Type", "Tuning", "Method"),
facet.x = ".", facet.y = ".",
include.raw = "alone",
colour.column = "Method",
colour.values = c("orange", "olivedrab"),
addMediansWhiskers = TRUE)))
testthat::expect_equal(length(plts$PSA$profiles), 4)
testthat::expect_equal(length(plts$PSA$deviations), 0)
#test various combinations of plots.by, facet.y and facet.x, with include.raw set to facet.x
testthat::expect_error(
plotSmoothsComparison(data = tom, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
profile.plot.args =
args4profile_plot(
plots.by = c("Type", "Tuning", "Method"),
facet.x = ".", facet.y = ".",
include.raw = "facet.x",
colour.column = "Method",
colour.values = c("orange", "olivedrab"),
addMediansWhiskers = TRUE)),
regexp = "The argument incl.raw is set to facet.x, but facet.x has not been set to include a variable")
testthat::expect_silent(
plotSmoothsComparison(data = tom, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
profile.plot.args =
args4profile_plot(
plots.by = c("Type", "Tuning", "Method"),
facet.x = ".", facet.y = ".",
include.raw = "no")))
testthat::expect_silent(
plotSmoothsComparison(data = tom, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
profile.plot.args =
args4profile_plot(
plots.by = c("Type", "Tuning"),
facet.x = ".", facet.y = "Method",
include.raw = "facet.y",
alpha = 0.4,
colour.column = "Method",
colour.values = c("orange", "olivedrab"),
addMediansWhiskers = TRUE)))
testthat::expect_silent(
plotSmoothsComparison(data = tom, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
profile.plot.args =
args4profile_plot(
plots.by = NULL,
facet.x = "Tuning", facet.y = ".",
include.raw = "facet.x",
colour = "orange")))
testthat::expect_silent(
plotSmoothsComparison(data = tom, response = "PSA",
response.smoothed = "sPSA",
times = "DAP",
profile.plot.args =
args4profile_plot(
plots.by = NULL,
facet.x = c("Type","Tuning","Method"),
facet.y = ".",
include.raw = "no")))
#'Single `df`, multiple methods and trait.types and GRs using deriv
suppressWarnings(
tomdv <- probeSmooths(data = tomato.dat,
response = "PSA", response.smoothed = "sPSA",
times = "DAP",
smoothing.args =
args4smoothing(smoothing.methods = c("direct","logarithmic"),
spline.types = "NCSS", df=5, lambdas = NULL),
rates.method = "deriv",
which.plots = "profiles",
profile.plot.args =
args4profile_plot(
plots.by = NULL,
facet.x = "Method",
facet.y = ".",
include.raw = "facet.x")))
testthat::expect_equal(nrow(tomdv), 2240)
testthat::expect_equal(ncol(tomdv), 14)
testthat::expect_true(all(abs(tomdiff$sPSA-tomdv$sPSA) < 1e-08))
tomspl <- byIndv4Times_SplinesGRs(data = tomato.dat,
response = "PSA", response.smoothed = "sPSA",
times="DAP",
df = 5, rates.method = "deriv",
which.rates = c("AGR", "RGR"),
suffices.rates = c("AGRdv", "RGRdv"))
testthat::expect_true(all(abs(tomspl$sPSA-tomdv$sPSA[1:1120]) < 1e-08))
testthat::expect_true(all(abs(tomspl$sPSA.AGRdv-tomdv$sPSA.AGR[1:1120]) < 1e-08))
testthat::expect_true(all(abs(tomdv$sPSA.AGR[1:4] -
c(4.483901, 4.533483, 4.706856, 5.038068)) < 1e-05))
testthat::expect_true(all(abs(tomspl$sPSA.RGRdv-tomdv$sPSA.RGR[1:1120]) < 1e-08))
testthat::expect_true(all(abs(tomdv$sPSA.RGR[1:4] -
c(17.6807353, 0.9536113, 0.5027707, 0.3542860)) < 1e-05))
#Look at water.use
lambdas <- round(10^c(-0.5, 0, 0.5, 1), digits = 3)
df = c(4:6)
x.axis <- list(theme(axis.text.x = element_text(angle = 90),
panel.grid.minor.x = element_blank()))
vline.DAP.endpts <- list(geom_vline(xintercept=DAP.starts, linetype="longdash",
alpha = 0.5, linewidth=0.75))
theme.profile <- list(vline.DAP.endpts,x.axis)
tom.H2O <- probeSmooths(data = tomato.dat, response = "WU",
response.smoothed = "sWU",
times = "DAP", get.rates = FALSE,
smoothing.args =
args4smoothing(smoothing.methods = "dir",
spline.types = c("NCSS", "PS"),
df=df,
lambdas = list(PS = lambdas)),
which.plots = c("medians.dev", "profiles"),
profile.plot.args =
args4profile_plot(plots.by = "Type",
facet.x = c("Tuning"), facet.y = ".",
include.raw = "facet.x",
ggplotFuncs = theme.profile),
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL,
plots.group = "Tuning",
facet.x = "Type", facet.y = ".",
propn.types = NULL))
testthat::expect_equal(nrow(tom.H2O), 7840)
testthat::expect_equal(ncol(tom.H2O), 9)
})
cat("#### Test probeSmooths Rice experiment\n")
test_that("RicePrepped_growthPheno", {
skip_if_not_installed("growthPheno")
skip_on_cran()
library(dae)
library(growthPheno)
data(RicePrepped.dat)
testthat::expect_warning(
smth <- probeSmooths(data = RicePrepped.dat, response = "PSA", response.smoothed = "sPSA",
times = "DAST",
smoothing.args =
args4smoothing(spline.types = c("NCSS", "PS"),
smoothing.methods = "log",
df = c(4,7),
lambdas = c(0.1,1,10)),
keep.columns = c("Smarthouse","Salinity"), #so these are included in the smooths.frame
which.plots = "none"),
regexp = "Need at least 4 distinct x values to fit a spline - all fitted values set to NA")
testthat::expect_equal(nrow(smth), 73920)
testthat::expect_equal(ncol(smth), 16)
#Check that PS smoothing is correct
oneplant <- subset(smth, Snapshot.ID.Tag == "045451-C" & Type == "PS" & TuneVal == "0.1")
fity <- JOPS::psNormal(x = oneplant$DAST, y = log(oneplant$PSA), nseg = 10, lambda = 0.1,
xgrid = oneplant$DAST)
testthat::expect_true(all(abs(oneplant$sPSA-exp(fity$muhat[,1])) < 1e-05))
#Tuning only for PSA
testthat::expect_silent(
t <- plotSmoothsMedianDevns(data = smth, response = "PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL, plots.group = "Tuning",
facet.x = ".", facet.y = c("Smarthouse","Salinity"),
propn.types = 0.025)))
testthat::expect_equal(length(t$plots), 1)
testthat::expect_equal(nrow(t$med.devn.dat), 280)
testthat::expect_equal(ncol(t$med.devn.dat), 5)
testthat::expect_true(all(c("Smarthouse", "Salinity", "SmoothParams", "PSA.devn", "DAST")
%in% names(t$med.devn.dat)))
#Use plots.by.med for Type
testthat::expect_silent(
t <- plotSmoothsMedianDevns(data = smth, response = "PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
meddevn.plot.args =
args4meddevn_plot(plots.by = "Type", plots.group = "Tuning",
facet.x = ".", facet.y = c("Smarthouse","Salinity"),
propn.types = 0.025)))
testthat::expect_equal(length(t$plots), 1)
testthat::expect_equal(nrow(t$med.devn.dat), 280)
testthat::expect_equal(ncol(t$med.devn.dat), 6)
testthat::expect_true(all(c("fac.by","Smarthouse", "Salinity", "SmoothParams", "PSA.devn", "DAST")
%in% names(t$med.devn.dat)))
#Use facet.x for Type, additional to plots.group
testthat::expect_silent(
t <- plotSmoothsMedianDevns(data = smth, response = "PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL, plots.group = "Tuning",
facet.x = "Type",
facet.y = c("Smarthouse","Salinity"),
propn.types = 0.025)))
testthat::expect_equal(length(t$plots), 1)
testthat::expect_equal(nrow(t$med.devn.dat), 280)
testthat::expect_equal(ncol(t$med.devn.dat), 6)
testthat::expect_true(all(c("Type","Smarthouse", "Salinity", "SmoothParams", "PSA.devn", "DAST")
%in% names(t$med.devn.dat)))
#facet.x a mixture of a smoothing-parameter factor and another factor
testthat::expect_silent(
t <- plotSmoothsMedianDevns(data = smth, response = "PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL, plots.group = "Tuning",
facet.x = c("Smarthouse"),
facet.y = c("Salinity","Type"),
propn.types = 0.025)))
testthat::expect_silent(
t <- plotSmoothsMedianDevns(data = smth, response = "PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL, plots.group = "Tuning",
facet.x = c("Salinity","Type"),
facet.y = c("Smarthouse"),
propn.types = FALSE)))
testthat::expect_silent(
t <- plotSmoothsMedianDevns(data = smth, response = "PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL, plots.group = "Tuning",
facet.x = c("Salinity","Type"),
facet.y = c("Smarthouse"),
propn.types = 0.025)))
testthat::expect_equal(length(t$plots), 1)
testthat::expect_equal(nrow(t$med.devn.dat), 280)
testthat::expect_equal(ncol(t$med.devn.dat), 6)
testthat::expect_true(all(c("Type","Smarthouse", "Salinity", "SmoothParams", "PSA.devn", "DAST")
%in% names(t$med.devn.dat)))
#Use plot,by with med
testthat::expect_silent(
t <- plotSmoothsMedianDevns(data = smth, response = "PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
meddevn.plot.args =
args4meddevn_plot(plots.by = c("Method","Type"),
plots.group = "Tuning",
facet.x = ".",
facet.y = c("Smarthouse","Salinity"),
propn.types = 0.025)))
testthat::expect_equal(length(t$plots), 1)
testthat::expect_equal(nrow(t$med.devn.dat), 280)
testthat::expect_equal(ncol(t$med.devn.dat), 6)
testthat::expect_true(all(c("fac.by", "Smarthouse", "Salinity", "SmoothParams", "PSA.devn", "DAST")
%in% names(t$med.devn.dat)))
#Test breaks.spacing.x
testthat::expect_silent(
plotSmoothsComparison(data = smth, response="PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Tuning"),
facet.y = "Salinity",
collapse.facets.x = FALSE,
include.raw = "facet.x",
breaks.spacing.x = -2)))
testthat::expect_silent(
plotSmoothsComparison(data = smth, response="PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Tuning"),
facet.y = "Salinity",
collapse.facets.x = FALSE,
include.raw = "facet.x",
breaks.spacing.x = -3)))
#Remove an extra DAST to have a gap of 2 with no DAST
testthat::expect_silent(
plotSmoothsComparison(data = smth[smth$DAST != 1, ], response="PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Tuning"),
facet.y = "Salinity",
collapse.facets.x = FALSE,
include.raw = "facet.x",
breaks.spacing.x = -3)))
testthat::expect_silent(
plotSmoothsComparison(data = smth[smth$DAST != 1, ], response="PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Tuning"),
facet.y = "Salinity",
collapse.facets.x = FALSE,
include.raw = "facet.x",
breaks.spacing.x = -2)))
testthat::expect_silent(
plotSmoothsComparison(data = smth[smth$DAST != 1, ], response="PSA", response.smoothed = "sPSA",
times = "DAST", trait.types = "response",
profile.plot.args =
args4profile_plot(plots.by = "Smarthouse",
facet.x = c("Method", "Tuning"),
facet.y = "Salinity",
collapse.facets.x = FALSE,
include.raw = "facet.x",
breaks.spacing.x = -3)))
testthat::expect_warning(
smth <- probeSmooths(data = RicePrepped.dat, response = "PSA", response.smoothed = "sPSA",
times = "DAST",
smoothing.args =
args4smoothing(spline.types = c("NCSS", "PS"),
smoothing.methods = "logarithmic",
df = c(4,7),
lambdas = c(0.1,1,10)),
which.plots = "medians.dev",
meddevn.plot.args =
args4meddevn_plot(plots.by = "Type",
plots.group = "Tuning",
facet.x = ".", facet.y = c("Smarthouse","Salinity"))),
regexp = "Need at least 4 distinct x values to fit a spline - all fitted values set to NA")
testthat::expect_equal(nrow(smth), 73920)
testthat::expect_equal(ncol(smth), 16)
#Test for segmented smoothing
lambdas <- round(10^c(-0.5, 0, 0.5, 1), digits = 3)
df <- 4:5
traits <- c("PSA","PSA.AGR","PSA.RGR")
DAST.segs <- list(c(-1,5),c(6,13))
tmp <- subset(RicePrepped.dat, Smarthouse == "NW")
testthat::expect_warning(
longiseg.smth <- probeSmooths(data = tmp,
response = "PSA", response.smoothed = "sPSA",
times = "DAST",
get.rates = TRUE,
smoothing.args =
args4smoothing(smoothing.methods = "log",
spline.types = c("NCSS","PS"),
df = df,
lambdas = list(PS = lambdas),
smoothing.segments = DAST.segs,
npspline.segments = c(4,6)),
which.plots = "none",
keep.columns = c("Smarthouse", "Salinity")),
regexp = "Need at least 4 distinct x values to fit a spline - all fitted values set to NA")
testthat::expect_equal(nrow(longiseg.smth), 44352)
testthat::expect_equal(ncol(longiseg.smth), 16)
testthat::expect_true(all(unique(longiseg.smth$DAST) == c(-1,1:13)))
testthat::expect_true(all(c("Type", "TunePar", "TuneVal", "Tuning", "Method",
"Snapshot.ID.Tag", "DAST", "Smarthouse", "Salinity",
"PSA", "PSA.AGR", "PSA.RGR", "sPSA", "sPSA.AGR", "sPSA.RGR")
%in% names(longiseg.smth)))
#check sPSA.AGR for first DAST of first segment is always NA,
#but that first DAST of 2nd segment (DAST 6) is has values that are not NA
testthat::expect_true(all(is.na(longiseg.smth$sPSA.AGR[longiseg.smth$DAST == -1])))
testthat::expect_false(all(is.na(longiseg.smth$sPSA.AGR[longiseg.smth$DAST == 6])))
#Recalculate using derivatives
testthat::expect_warning(
longisegder.smth <- probeSmooths(data = tmp,
times = "DAST",
response = "PSA", response.smoothed = "sPSA",
get.rates = TRUE, rates.method = "deriv",
smoothing.args =
args4smoothing(smoothing.methods = "log",
spline.types = c("NCSS","PS"),
df = df,
lambdas = list(PS = lambdas),
smoothing.segments = DAST.segs,
npspline.segments = c(4,6)),
which.plots = "none",
keep.columns = c("Smarthouse", "Salinity")),
regexp = "Need at least 4 distinct x values to fit a spline - all fitted values set to NA")
testthat::expect_equal(nrow(longisegder.smth), 44352)
testthat::expect_equal(ncol(longisegder.smth), 16)
testthat::expect_true(all(unique(longisegder.smth$DAST) == c(-1,1:13)))
testthat::expect_true(all(c("Type", "TunePar", "TuneVal", "Tuning", "Method",
"Snapshot.ID.Tag", "DAST", "Smarthouse", "Salinity",
"PSA", "PSA.AGR", "PSA.RGR", "sPSA", "sPSA.AGR", "sPSA.RGR")
%in% names(longisegder.smth)))
#check that, for sPSA.AGR, the DASTs that are missing for differences are not the same as for derivatives
testthat::expect_true(sum(is.na(longiseg.smth$sPSA.AGR[longiseg.smth$DAST == -1])) !=
sum(is.na(longisegder.smth$sPSA[longisegder.smth$DAST == -1])))
#Check that the DAST at the start of each segment has values that are not NA for derivatives
testthat::expect_true(!all(is.na(longisegder.smth$sPSA.AGR[longisegder.smth$DAST == -1])))
testthat::expect_true(!all(is.na(longisegder.smth$sPSA.AGR[longisegder.smth$DAST == 6])))
#Plot the median deviations
testthat::expect_silent(
t <- plotSmoothsMedianDevns(data = longisegder.smth, response = "PSA",
response.smoothed = "sPSA",
times = "DAST", trait.types = "AGR",
meddevn.plot.args =
args4meddevn_plot(plots.by = NULL, plots.group = "Tuning",
facet.x = ".", facet.y = c("Smarthouse","Salinity"),
propn.types = 0.025)))
testthat::expect_equal(length(t$plots), 1)
testthat::expect_equal(nrow(t$med.devn.dat), 144)
testthat::expect_equal(ncol(t$med.devn.dat), 5)
#every first DAST must be NA for deviations because PSA.AGR has to be calculated by differences
testthat::expect_true(all(is.na(t$med.devn.dat$PSA.AGR[t$med.devn.dat$DASTs == -1])))
#every DAST 6, 7 and 13 must be NA for deviations because PSA.AGR has to be calculated
#within segments and by differences with ntimes2span == 3 to centre it properly
testthat::expect_true(all(is.na(t$med.devn.dat$PSA.AGR[t$med.devn.dat$DASTs == 6])))
testthat::expect_true(all(is.na(t$med.devn.dat$PSA.AGR[t$med.devn.dat$DASTs == 7])))
testthat::expect_true(all(is.na(t$med.devn.dat$PSA.AGR[t$med.devn.dat$DASTs == 13])))
testthat::expect_true(all(c("Smarthouse", "Salinity", "SmoothParams", "PSA.AGR.devn", "DAST")
%in% names(t$med.devn.dat)))
#test segmented smooth that is a subset
lambdas <- round(10^c(-0.5, 0, 0.5, 1), digits = 3)
df <- 4:5
traits <- c("PSA","PSA.AGR","PSA.RGR")
DAST.segs <- list(c(-1,5),c(6,11))
tmp <- subset(RicePrepped.dat, Smarthouse == "NW")
testthat::expect_warning(
longiseg.smth <- probeSmooths(data = tmp,
response = "PSA", response.smoothed = "sPSA",
times = "DAST",
get.rates = TRUE,
smoothing.args =
args4smoothing(smoothing.methods = "log",
spline.types = c("NCSS","PS"),
df = df,
lambdas = list(PS = lambdas),
smoothing.segments = DAST.segs,
npspline.segments = c(4,6)),
which.plots = "none",
keep.columns = c("Smarthouse", "Salinity")),
regexp = "Need at least 4 distinct x values to fit a spline - all fitted values set to NA")
testthat::expect_equal(nrow(longiseg.smth), 38016)
testthat::expect_equal(ncol(longiseg.smth), 16)
testthat::expect_true(all(unique(longiseg.smth$DAST) == c(-1,1:11)))
testthat::expect_true(all(c("Type", "TunePar", "TuneVal", "Tuning", "Method",
"Snapshot.ID.Tag", "DAST", "Smarthouse", "Salinity",
"PSA", "PSA.AGR", "PSA.RGR", "sPSA", "sPSA.AGR", "sPSA.RGR")
%in% names(longiseg.smth)))
#check sPSA.AGR for first DAST of first segment is always NA,
#but that first DAST of 2nd segment (DAST 6) is has values that are not NA
testthat::expect_true(all(is.na(longiseg.smth$sPSA.AGR[longiseg.smth$DAST == -1])))
testthat::expect_false(all(is.na(longiseg.smth$sPSA.AGR[longiseg.smth$DAST == 6])))
#Recalculate using derivatives
testthat::expect_warning(
longisegder.smth <- probeSmooths(data = tmp,
times = "DAST",
response = "PSA", response.smoothed = "sPSA",
get.rates = TRUE, rates.method = "deriv",
smoothing.args =
args4smoothing(smoothing.methods = "log",
spline.types = c("NCSS","PS"),
df = df,
lambdas = list(PS = lambdas),
smoothing.segments = DAST.segs,
npspline.segments = c(4,6)),
which.plots = "none",
keep.columns = c("Smarthouse", "Salinity")),
regexp = "Need at least 4 distinct x values to fit a spline - all fitted values set to NA")
testthat::expect_equal(nrow(longisegder.smth), 38016)
testthat::expect_equal(ncol(longisegder.smth), 16)
testthat::expect_true(all(unique(longisegder.smth$DAST) == c(-1,1:11)))
testthat::expect_true(all(c("Type", "TunePar", "TuneVal", "Tuning", "Method",
"Snapshot.ID.Tag", "DAST", "Smarthouse", "Salinity",
"PSA", "PSA.AGR", "PSA.RGR", "sPSA", "sPSA.AGR", "sPSA.RGR")
%in% names(longisegder.smth)))
#check that, for sPSA.AGR, the DASTs that are missing for differences are not the same as for derivatives
testthat::expect_true(sum(is.na(longiseg.smth$sPSA.AGR[longiseg.smth$DAST == -1])) !=
sum(is.na(longisegder.smth$sPSA[longisegder.smth$DAST == -1])))
#every DAST 6, 7 and 13 must be NA for deviations because PSA.AGR has to be calculated
#within segments and by differences with ntimes2span == 3 to centre it properly
testthat::expect_true(!all(is.na(longisegder.smth$sPSA.AGR[longisegder.smth$DAST == -1])))
testthat::expect_true(!all(is.na(longisegder.smth$sPSA.AGR[longisegder.smth$DAST == 6])))
testthat::expect_true(!all(is.na(longisegder.smth$sPSA.AGR[longisegder.smth$DAST == 7])))
testthat::expect_true(!all(is.na(longisegder.smth$sPSA.AGR[longisegder.smth$DAST == 11])))
})
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.