tests

R/GDD.R

@@ -31,15 +31,14 @@ GDD <- function(object, day.one = NULL, degree.days = NULL,
 {
 
   # validate parameters
-  if (is.null(day.one)) {
-    stop("day.one is missing with no default \n")
-  }
   if (is.null(degree.days)) {
     stop("degree.days is missing with no default \n")
   }
+
   if (is.null(base)) {
     base <- 10
   }
+
   if (is.null(span)) {
     span <- 150
   }

R/getDataCM.R

@@ -1,8 +1,10 @@
 #' Get ClimMob data
 #'
-#' Fetch the trial data from a ClimMob project using your API key
+#' Fetch the trial data from a ClimMob project using an API key
 #'
 #' @param project a character for the project id
+#' @param tidynames logical, if TRUE suppress ODK strings
+#' @param pivot.wider logical, if TRUE return a wider object, each observer is a row
 #' @param ... additional arguments passed to methods
 #' @inheritParams getProjectsCM
 #' @return A data frame with the project data
@@ -28,7 +30,8 @@
 #' @importFrom tibble as_tibble tibble
 #' @importFrom tidyr gather separate spread
 #' @export
-getDataCM <- function(key = NULL, project = NULL, ...){
+getDataCM <- function(key = NULL, project = NULL, 
+                      tidynames = FALSE, pivot.wider = FALSE, ...){
 
   dots <- list(...)
 
@@ -59,22 +62,20 @@ getDataCM <- function(key = NULL, project = NULL, ...){
   # if not then return a warning message
   if (length(cmdata) < 7) {
     pstring <- paste0("'",project,"'")
-    return(
-      cat(
-        "\nProject", pstring, "was found but has no associated data. \n"
-      )
-    )
+    stop("Project ", pstring, " was found but has no associated data. \n")
   }
 
   if (!raw) {
-    cmdata <- .extractFromjson(data = cmdata, ...)
+    cmdata <- .extractFromjson(data = cmdata, 
+                               tidynames = tidynames,
+                               pivot.wider = pivot.wider, ...)
   }
 
   return(cmdata)
 
 }
 
-.extractFromjson <- function(data, tidynames = TRUE, pivot.wider = FALSE){
+.extractFromjson <- function(data, tidynames, pivot.wider){
 
   # currently the json file is structured with
   # data[[1]] 'specialfields', the assessment questions

R/get_timespan.R

@@ -13,26 +13,6 @@
 # start.date to be included in the timespan
 # @param ... additional arguments passed to \code{\link[nasapower]{get_power}}
 # @return a data frame of environmental data for the chosen period
-# @examples
-# 
-# # Concatenate environmental data from from CHIRPS
-# data("breadwheat_chirps", package = "gosset")
-# data("breadwheat", package = "gosset")
-# 
-# # Get the precipitation that occured in the first 30 days after the planting date
-# get_timespan(breadwheat_chirps,
-#              day.one = breadwheat$planting_date,
-#              span = 30)
-# 
-# ######################################
-# 
-# # Get data from NASA POWER
-# 
-# # select daily precipitation using the argument 'pars'
-# get_timespan(breadwheat[c("lon","lat")],
-#              day.one = breadwheat$planting_date,
-#              span = 30,
-#              pars = "PRECTOT")
 #' @import nasapower
 #' @importFrom raster rasterFromXYZ extract stack
 .get_timespan <- function(object, day.one = NULL,
@@ -44,7 +24,7 @@
   }
 
   if (is.null(span)) {
-    span <- 150
+    stop("argument 'span' is missing with no default \n ")
   }
 
   if (is.null(days.before)) {

R/randomise.R

@@ -47,6 +47,10 @@ randomise <- function(nitems = 3, nobservers = NULL, nvar = NULL,
     stop("itemnames in missing with no default")
   }
 
+  if (nvar != length(itemnames)) {
+    stop("nvar is different than provided itemnames")
+  }
+
   # Varieties indicated by integers
   varieties <- 1:nvar
 

tests/testthat/test-ETo.R

@@ -5,22 +5,56 @@ library("ClimMobTools")
 load("../clim.rda")
 
 
-days <- dimnames(rain)[[2]]
-
-d <- as.Date(rep(days[2:3], each=5), format = "%Y-%m-%d")
-
-e <- c(4.752054,4.897989,4.659525,3.947859,4.535946,4.231035,4.535325,4.390011,4.412367,4.124223)
+e <- c(4.752054,4.897989,4.659525,3.947859,4.535946,
+       4.231035,4.535325,4.390011,4.412367,4.124223)
 
 
 test_that("equal", {
 
-  ev <- ETo(temp,
-            day.one = d, 
-            span = 10,
-            lat = rep(0, 10))
+  ev <- suppressWarnings(
+    ETo(temp,
+        day.one = d, 
+        span = 10,
+        lat = rep(0, 10))
+  )
+
 
   ev <- all.equal(e, ev[[1]])
 
   expect_equal(ev, TRUE)
 })
 
+test_that("error", {
+  expect_error(
+    ETo(temp,
+        day.one = c(1:10), 
+        span = 10,
+        lat = rep(0, 10))
+    )
+})
+
+
+test_that("nasapower works", {
+  r <- suppressWarnings(
+    ETo(object = lonlat, 
+             day.one = d,
+             span = 20,
+             lat = lonlat[,2])
+  )
+
+  r <- !is.null(r)
+
+  expect_equal(r, TRUE)
+})
+
+
+test_that("daytime hours", {
+
+  r <- ETo(temp,
+           day.one = d, 
+           span = 10)
+
+  r <- is.numeric(r[[1]])
+
+  expect_equal(r, TRUE)
+})

tests/testthat/test-GDD.R

@@ -4,12 +4,6 @@ library("ClimMobTools")
 #load("tests/clim.rda")
 load("../clim.rda")
 
-
-days <- dimnames(rain)[[2]]
-
-d <- as.Date(rep(days[2:3], each=5), format = "%Y-%m-%d")
-
-
 g <- c(5,4,5,11,5,7,5,6,6,8)
 
 test_that("equal", {
@@ -26,3 +20,42 @@ test_that("equal", {
   expect_equal(dg, TRUE)
 })
 
+
+test_that("nasapower works", {
+  dg <- suppressWarnings(
+    GDD(object = lonlat,
+        day.one = d, 
+        degree.days = 45, 
+        span = 12)
+  )
+
+  dg <- as.vector(apply(dg, 1, is.na))
+
+  dg <- sum(dg) == 0
+
+  expect_equal(dg, TRUE)
+})
+
+
+test_that("missing day.one", {
+  expect_error(
+    GDD(object = temp)
+  )
+})
+
+
+test_that("missing degree.days", {
+  expect_error(
+    GDD(object = temp, 
+        day.one = d)
+  )
+})
+
+
+test_that("missing span", {
+  expect_error(
+    GDD(object = temp, 
+        day.one = d, 
+        degree.days = 10)
+  )
+})

tests/testthat/test-getDataCM.R

@@ -2,20 +2,45 @@ context("test-getProjectsCM")
 
 library("ClimMobTools")
 
-test_that("error", {
+key <- "d39a3c66-5822-4930-a9d4-50e7da041e77"
+
+p <- getDataCM(key,"colours")
+p <- !is.null(p)
+
+
+test_that("no API key", {
 
   expect_error(getDataCM("1234", "x"))
 
 })
 
+test_that("api call works", {
+
+  expect_equal(p, TRUE)
+
+})
 
-p <- getDataCM("d39a3c66-5822-4930-a9d4-50e7da041e77","colours")
-p <- !is.null(p)
 
-test_that("api call", {
+test_that("pivot.wider", {
 
-  expect_equal(p, TRUE)
+  cm <- getDataCM(key,
+                  "breadwheat",
+                  pivot.wider = TRUE,
+                  tidynames = TRUE)
+
+  wider <- ncol(cm) > 10
 
+  expect_equal(wider, TRUE)
+
 })
 
+test_that("error no data", {
+  expect_error(
+    getDataCM("d39a3c66-5822-4930-a9d4-50e7da041e77",
+              "wageningen")
+  )
+}
+)
+
+
 

tests/testthat/test-rainfall.R

@@ -4,11 +4,6 @@ library("ClimMobTools")
 #load("tests/clim.rda")
 load("../clim.rda")
 
-
-days <- dimnames(rain)[[2]]
-
-d <- as.Date(rep(days[2:3], each=5), format = "%Y-%m-%d")
-
 MLDS <- c(rep(9, 2), rep(10, 8))
 MLWS <- c(rep(1, 2), rep(0, 8))
 
@@ -34,6 +29,35 @@ test_that("moist equal", {
   expect_equal(ws, TRUE)
 })
 
+test_that("nasapower works", {
+
+  r <- suppressWarnings(
+    rainfall(object = lonlat, 
+                day.one = d,
+                span = 25,
+                index = "SDII")
+  )
+
+  r <- as.vector(apply(r, 1, is.na))
+
+  r <- sum(r) == 0
+
+  expect_equal(r, TRUE)
+})
 
 
+test_that("no day.one", {
+  expect_error(
+    rainfall(object = rain,
+             day.one = NULL,
+             span = 10)
+  )
+})
 
+test_that("no span", {
+  expect_error(
+    rainfall(object = rain,
+             day.one = d,
+             span = NULL)
+  )
+})