tests/testthat/testProbeSmoothing.r

cat("#### Test probeSmoothing 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 plots
  testthat::expect_warning(t <- probeSmoothing(dat1, df=df, xname="TimeAfterPlanting", 
                                               response="ShootArea1000",
                                               facet.x = "Treatment.1", facet.y = "Smarthouse", 
                                               which.plots=c("bothseparately"), 
                                               ggplotFuncs=list(scale_x_continuous(breaks=
                                                                                     seq(30, 50, by=2)))))
  testthat::expect_equal(nrow(t), 8480)
  testthat::expect_equal(ncol(t), 15)
  
  testthat::expect_warning(
    t <- probeSmoothing(dat1, df=df, xname="TimeAfterPlanting", 
                        response="ShootArea1000", 
                        trait.types=c("AGR"),
                        facet.x = "Treatment.1", facet.y = "Smarthouse"))
  testthat::expect_equal(nrow(t), 8480)
  testthat::expect_equal(ncol(t), 12)
  
  testthat::expect_warning(
    t <- probeSmoothing(dat1, df=df, xname="TimeAfterPlanting", 
                        response="ShootArea1000", 
                        trait.types=c("response"), 
                        facet.x = "Treatment.1", facet.y = "Smarthouse", 
                        which.plots="dfcompare", get.rates=FALSE))
  testthat::expect_equal(nrow(t), 8480)
  testthat::expect_true(all(c("Snapshot.ID.Tag", "Days", "TimeAfterPlanting", "ShootArea1000", 
                              "Treatment.1", "Smarthouse",  "ShootArea1000", 
                              "ShootArea1000.smooth.Direct.4", "ShootArea1000.smooth.Direct.7") 
                            %in% names(t)))
  
  #include relative.boxplots
  testthat::expect_warning(
    t <- probeSmoothing(dat1, df=df, xname="TimeAfterPlanting", 
                        response="ShootArea1000", 
                        trait.types=c("response"), 
                        facet.x = "Treatment.1", facet.y = "Smarthouse", 
                        which.plots="dfcompare", deviations.plots = "relat", 
                        get.rates=FALSE))
  testthat::expect_equal(nrow(t), 8480)
  testthat::expect_true(all(c("Snapshot.ID.Tag", "Days", "TimeAfterPlanting", "ShootArea1000", 
                              "Treatment.1", "Smarthouse",  "ShootArea1000", 
                              "ShootArea1000.smooth.Direct.4", "ShootArea1000.smooth.Direct.7") 
                            %in% names(t)))

  #'## Include deviations boxplots
  testthat::expect_error(t <- probeSmoothing(dat1, df=df, xname="TimeAfterPlanting", 
                                             response="ShootArea1000",
                                             x.title = "DAP", 
                                             trait.types=c("response"), get.rates=FALSE,
                                             which.plots="dfcompare", 
                                             deviations.boxplots = "absolute")) 
  #deviations.boxplots deprecated
  testthat::expect_warning(
    t <- probeSmoothing(dat1, df=df, xname="TimeAfterPlanting", 
                        response="ShootArea1000",
                        x.title = "DAP", 
                        trait.types=c("response"), get.rates=FALSE,
                        facet.x = "Treatment.1", facet.y = "Smarthouse", 
                        which.plots="dfcompare", 
                        deviations.plots = "absolute"))
  testthat::expect_equal(nrow(t), 8480)
  testthat::expect_true(all(c("Snapshot.ID.Tag", "Days", "TimeAfterPlanting", "ShootArea1000", 
                              "Treatment.1", "Smarthouse", "ShootArea1000", 
                              "ShootArea1000.smooth.Direct.4", "ShootArea1000.smooth.Direct.7") 
                            %in% names(t)))
  
  testthat::expect_warning(t <- probeSmoothing(dat1, df=df, xname="TimeAfterPlanting", 
                                               response="ShootArea1000",
                                               x.title = "DAP", 
                                               trait.types=c("response", "AGR"), 
                                               facet.x = "Treatment.1", facet.y = "Smarthouse", 
                                               which.plots="methodscompare", 
                                               deviations.plots = c("absolute", "relative")))
  testthat::expect_equal(nrow(t), 8480)
  testthat::expect_true(all(c("Snapshot.ID.Tag", "Days", "TimeAfterPlanting", "ShootArea1000", 
                              "Treatment.1", "Smarthouse", "ShootArea1000", 
                              "Days.diffs", "ShootArea1000.AGR", 
                              "ShootArea1000.smooth.Direct.4", "ShootArea1000.smooth.AGR.Direct.4", 
                              "ShootArea1000.smooth.Direct.7", 
                              "ShootArea1000.smooth.AGR.Direct.7") 
                            %in% names(t)))
  testthat::expect_lt(max(abs(t["ShootArea1000"] - t["ShootArea1000.smooth.Direct.4"]), 
                          na.rm = TRUE) - 5.563407, 1e-07)
  testthat::expect_lt(max(abs(t["ShootArea1000"] - t["ShootArea1000.smooth.Direct.4"])/
                            t["ShootArea1000.smooth.Direct.4"]) - 370.7951, 1e-04)
  
})

cat("#### Test probeSmoothing 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=20, linetype="longdash", size=1),
                ggplot2::scale_x_continuous(breaks=seq(12, 36, by=2)))
  
  plotDeviationsBoxes(longi.dat, observed = "PSA", smoothed = "sPSA",
                    x.factor="DAP", facet.x = ".", facet.y= ".", df =5)
  
  testthat::expect_warning(
    tmp <- probeSmoothing(data = longi.dat, response = "PSA", 
                          df = c(4,7), xname="xDAP", times.factor = "DAP", 
                          ggplotFuncs=vline))
  testthat::expect_equal(nrow(tmp), 280)
  testthat::expect_equal(ncol(tmp), 15)
  
  testthat::expect_warning(tmp <- probeSmoothing(data = longi.dat, response = "PSA", 
                                                 xname = "xDAP", times.factor = "DAP", 
                                                 df = c(4,7), 
                                                 which.plots = "methodsc", 
                                                 facet.y = ".",
                                                 get.rates = FALSE,
                                                 ggplotFuncs=vline))
  testthat::expect_equal(nrow(tmp), 280)
  testthat::expect_equal(ncol(tmp), 7)
  testthat::expect_warning(tmp <- probeSmoothing(data = longi.dat, response = "PSA", 
                                                 xname = "xDAP", times.factor = "DAP", 
                                                 df = c(4,7), 
                                                 which.plots = "dfcompare", 
                                                 facet.y = ".",
                                                 get.rates = FALSE,
                                                 ggplotFuncs=vline))
  testthat::expect_equal(nrow(tmp), 280)
  testthat::expect_equal(ncol(tmp), 7)
  
  testthat::expect_warning(tmp <- probeSmoothing(data = longi.dat, response = "PSA", 
                                                 xname = "xDAP", times.factor = "DAP", 
                                                 df = c(4:7), 
                                                 which.plots = "dfcompare", 
                                                 facet.y = ".",
                                                 alpha = 0.6, get.rates = FALSE,
                                                 ggplotFuncs=vline))
  testthat::expect_equal(nrow(tmp), 280)
  testthat::expect_equal(ncol(tmp), 9)
  
  testthat::expect_warning(
    tmp <- probeSmoothing(data = longi.dat, response = "PSA", 
                          xname = "xDAP", times.factor = "DAP", 
                          df = c(4:7), 
                          which.plots = "dfcompare", facet.y = ".",
                          alpha = 0.5, trait.types = "AGR",
                          ggplotFuncs=vline))
  testthat::expect_equal(nrow(tmp), 280)
  testthat::expect_equal(ncol(tmp), 15)
  
  testthat::expect_warning(tmp <- probeSmoothing(data = longi.dat, response = "PSA", 
                                                 xname = "xDAP", times.factor = "DAP", 
                                                 df = c(4:7), 
                                                 facet.y = ".", 
                                                 deviations.plots = "compare",
                                                 propn.types = c(0.025,0.2, 0.25),
                                                 ggplotFuncs=vline))
  testthat::expect_equal(nrow(tmp), 280)
  testthat::expect_equal(ncol(tmp), 20)
  
  testthat::expect_warning(tmp <- probeSmoothing(data = longi.dat, response = "PSA", 
                                                 xname = "xDAP", times.factor = "DAP", 
                                                 df = c(4:7), 
                                                 facet.x = ".", facet.y = ".",
                                                 which.plots = "none",
                                                 deviations.plots = "compare", 
                                                 propn.types = NULL, 
                                                 ggplotFuncs=vline))
  testthat::expect_equal(nrow(tmp), 280)
  testthat::expect_equal(ncol(tmp), 19)
  
  testthat::expect_warning(
    traits <- probeSmoothing(data = longi.dat, 
                             response = "PSA", response.smoothed = "sPSA", 
                             xname = "xDAP", times.factor = "DAP", 
                             df = c(4:7), 
                             facet.x = ".", facet.y = ".",
                             which.plots = "none",
                             deviations.plots = "none", 
                             propn.types = NULL))
  testthat::expect_silent(med <- plotMedianDeviations(data = traits, 
                                                      response = "PSA", 
                                                      response.smoothed = "sPSA", 
                                                      x="xDAP", xname = "xDAP", 
                                                      df = c(4,7), x.title = "DAP", 
                                                      facet.x = ".", facet.y = ".",
                                                      trait.types = "response", 
                                                      propn.types = 0.05,
                                                      ggplotFuncsMedDevn = 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), 6)
  testthat::expect_equal(length(med$plots), 1)
  testthat::expect_warning(traits <- probeSmoothing(data = longi.dat, response = "PSA", 
                                                    xname = "xDAP", times.factor = "DAP", 
                                                    df = c(4:7), 
                                                    facet.x = ".", facet.y = ".",
                                                    which.plots = "none",
                                                    deviations.plots = c("compare", 
                                                                         "absolute"),
                                                    propn.types = NULL))
  testthat::expect_equal(nrow(traits), 280)
  testthat::expect_equal(ncol(traits), 19)
  testthat::expect_warning(traits <- probeSmoothing(data = longi.dat, response = "PSA", 
                                                    xname = "xDAP", times.factor = "DAP", 
                                                    df = c(4:7), 
                                                   facet.x = ".", facet.y = ".",
                                                   which.plots = "methodsc",
                                                   deviations.plots = c("compare", 
                                                                        "absolute"),
                                                   propn.types = NULL))
  testthat::expect_equal(nrow(traits), 280)
  testthat::expect_equal(ncol(traits), 19)
  
})


cat("#### Test probeSmoothing with tomato example\n")
test_that("tomato_growthPheno", {
  skip_if_not_installed("growthPheno")
  skip_on_cran()
  library(dae)
  library(growthPheno)
  
  data(tomato.dat)
  tomato.dat <- within(tomato.dat, xDAP <- as.numfac(DAP))
  
  df.vec        <- c(4:6,12)
  labelMyc <- as_labeller(function(lev) paste(lev, "AMF"))
  labelZn <- as_labeller(function(lev) paste("Zn:", lev, "ppm"))
  
  #'## Gives error that the Length of propn.types is not the same as the number of traits
  testthat::expect_warning(testthat::expect_error(
    tmp <- probeSmoothing(data = tomato.dat, 
                          response = "PSA", response.smoothed = "sPSA", 
                          times.factor = "DAP", xname = "xDAP", 
                          smoothing.methods = c("dir", "log"), 
                          facet.x = "Zn", facet.y = "AMF",
                          df = c(4,7), x="xDAP", get.rates = FALSE,
                          which.plots = "methodsc", 
                          deviations.plots = "compare",
                          labeller = labeller(Zn = labelZn, 
                                              AMF = labelMyc)),
    regexp = "Length of propn.types is not the same as the number of trait.types"), 
    regexp = "get.rates is FALSE and so trait.types changed to response")
  testthat::expect_warning(
    tom <- probeSmoothing(data = tomato.dat, 
                          response = "PSA", 
                          response.smoothed = "sPSA", 
                          times.factor = "DAP", xname = "xDAP", 
                          smoothing.methods = c("dir", "log"), 
                          facet.x = "Zn", facet.y = "AMF",
                          df = c(4,7), x="xDAP", get.rates = FALSE,
                          propn.types = 0.1,
                          which.plots = "methodsc", 
                          deviations.plots = "compare",
                          labeller = labeller(Zn = labelZn, 
                                              AMF = labelMyc)), 
    regexp = "get.rates is FALSE and so trait.types changed to response")
  testthat::expect_equal(nrow(tom), 1120)
  testthat::expect_equal(ncol(tom), 10)
  
  testthat::expect_silent(med <- plotMedianDeviations(data = tom, 
                                                      response = "PSA", 
                                                      response.smoothed = "sPSA", 
                                                      xname = "xDAP", 
                                                      smoothing.methods = c("dir", "log"), 
                                                      df = c(4,7), x.title = "DAP", 
                                                      y.titles = "PSA deviation (kpixels)",
                                                      facet.x = "Zn", facet.y = "AMF",
                                                      trait.types = "response", 
                                                      propn.types = 0.1,
                                                      labeller = labeller(Zn = labelZn, 
                                                                          AMF = labelMyc)))
  
  testthat::expect_equal(length(med$plots), 1)
  testthat::expect_equal(nrow(med$med.devn.dat), 1120)
  testthat::expect_equal(ncol(med$med.devn.dat), 8)
  
  #Multiple df, single methods
  testthat::expect_warning(tom <- probeSmoothing(data = tomato.dat, response = "PSA",
                                                 response.smoothed = "sPSA", 
                                                 times.factor = "DAP", xname="xDAP", df=5:6,
                                                 smoothing.methods = c("logarithmic"),
                                                 facet.x = ".", facet.y = ".",
                                                 which.plots = "none",
                                                 propn.types = c(0.02, 0.2, 0.5),
                                                 deviations.plots = "compare.medians"))
  testthat::expect_equal(nrow(tom), 1120)
  testthat::expect_equal(ncol(tom), 13)
  
  #'Single `df`, multiple methods and trait.types
  testthat::expect_warning(tom <- probeSmoothing(data = tomato.dat, response = "PSA", 
                                                 response.smoothed = "sPSA", 
                                                 times.factor = "DAP", xname="xDAP", df=5,
                                                 smoothing.methods = c("direct","logarithmic"),
                                                 facet.x = ".", facet.y = ".",
                                                 which.plots = "none",
                                                 deviations.plots = "none"))
  testthat::expect_equal(nrow(tom), 1120)
  testthat::expect_equal(ncol(tom), 13)
  testthat::expect_warning(med <- plotMedianDeviations(data = tom, response = "PSA", 
                                                       response.smoothed = "sPSA", 
                                                       xname = "xDAP", 
                                                       smoothing.methods = c("dir", "log"), 
                                                       df = 5, x.title = "DAP", 
                                                       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), 8)
  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))
  
  #'Single `df`, single method
  testthat::expect_warning(tom <- probeSmoothing(data = tomato.dat, response = "PSA", 
                                                 response.smoothed = "sPSA", 
                                                 times.factor = "DAP", xname="xDAP", df=5,
                                                 smoothing.methods = c("direct"),
                                                 facet.x = ".", facet.y = ".",
                                                 which.plots = "none",
                                                 propn.types = c(0.02, 0.2, 0.5),
                                                 deviations.plots = "compare.medians"))
  testthat::expect_equal(nrow(tom), 1120)
  testthat::expect_equal(ncol(tom), 10)

})

Try the growthPheno package in your browser

Any scripts or data that you put into this service are public.

growthPheno documentation built on Oct. 24, 2023, 5:08 p.m.