CO2 data with years, validity checks, and unit tests for swCarbon

- slot `CO2ppm` of class `swCarbon` is now 2-column data.frame with columns "Year" and "CO2ppm" (close #75) - class `swCarbon` has now validity checking - replacement functions check now validity (replacement functions for entire carbon class slot in "swInputData" or for CO2-concentration data) - added unit tests for methods related to class 'swCarbon' (close #42) > Testing rSOILWAT2 > Carbon dioxide class: ....................
DrylandEcology · Nov 16, 2017 · 12b1261 · 12b1261
1 parent 099fab5
commit 12b1261
Show file tree

Hide file tree

Showing 3 changed files with 112 additions and 22 deletions.
diff --git a/R/D_swCarbon.R b/R/D_swCarbon.R
@@ -19,25 +19,52 @@
 
 #############################CARBON DATA#########################################
 #' @export
-setClass("swCarbon", 
-
-  representation(CarbonUseBio='integer', CarbonUseWUE='integer', Scenario='character', DeltaYear='integer', CO2ppm='vector'),
-  
-  prototype=prototype(
+setClass("swCarbon",
+  representation(CarbonUseBio = 'integer', CarbonUseWUE = 'integer',
+    Scenario = 'character', DeltaYear = 'integer', CO2ppm = 'data.frame'),
+
+  prototype = prototype(
     CarbonUseBio = as.integer(0),
     CarbonUseWUE = as.integer(0),
     Scenario = as.character("Default"),  # This is not used in rSOILWAT2, but it's useful to see what scenario was used in the input object
     DeltaYear = as.integer(0),
-    CO2ppm = c(rep(360.0, 2500))  # Index of value represents the year; we make the implicit assumption that the input biomass is at 360 ppm
-  ))
-
-setMethod(f="swClear",
-          signature="swCarbon",
-          definition=function(object) {
-            object@CarbonUseBio = as.integer(0)
-            object@CarbonUseWUE = as.integer(0)
-            object@Scenario = as.character("Default")
-            object@DeltaYear = as.integer(0)
-            object@CO2ppm = c(rep(360.0, 2500))
-            return(object)
-          })
+    CO2ppm = data.frame(Year = as.integer(1979:2010), CO2ppm = rep(360.0, 32))
+  )
+)
+
+setMethod(f = "swClear", signature = "swCarbon", definition = function(object) {
+  object@CarbonUseBio = as.integer(0)
+  object@CarbonUseWUE = as.integer(0)
+  object@Scenario = as.character("Default")
+  object@DeltaYear = as.integer(0)
+  object@CO2ppm = data.frame(Year = as.integer(1979:2010), CO2ppm = rep(360.0, 32))
+
+  object
+})
+
+
+setValidity("swCarbon", function(object) {
+  val <- TRUE
+
+  if (!all(c("Year", "CO2ppm") %in% colnames(object@CO2ppm)) ||
+    length(colnames(object@CO2ppm)) != 2) {
+    msg <- "@CO2ppm: column names must be 'Year' and 'CO2ppm'"
+    val <- if (isTRUE(val)) msg else c(val, msg)
+
+  } else {
+    is_bad <- any(is.na(object@CO2ppm[, "Year"])) || !is.integer(object@CO2ppm[, "Year"])
+    if (is_bad) {
+      msg <- "@CO2ppm: has missing and/or non-integer years"
+      val <- if (isTRUE(val)) msg else c(val, msg)
+    }
+
+    ids_bad <- is.na(object@CO2ppm[, "CO2ppm"]) | object@CO2ppm[, "CO2ppm"] < 0
+    if (any(ids_bad)) {
+      msg <- "@CO2ppm: has missing and/or negative CO2-concentration values"
+      val <- if (isTRUE(val)) msg else c(val, msg)
+    }
+  }
+
+  val
+})
+
diff --git a/R/K_swContainer.R b/R/K_swContainer.R
@@ -327,19 +327,28 @@ setReplaceMethod(f="swSWC_HistoricData",signature=c(object="swInputData", value=
 		})
 
 ##
-setMethod("get_swCarbon", "swInputData", definition=function(object) {return(object@carbon)})
+setMethod("get_swCarbon", "swInputData", function(object) {return(object@carbon)})
 setMethod("swCarbon_Use_Bio","swInputData",function(object) {return(object@carbon@CarbonUseBio)})
 setMethod("swCarbon_Use_WUE","swInputData",function(object) {return(object@carbon@CarbonUseWUE)})
 setMethod("swCarbon_Scenario","swInputData",function(object) {return(object@carbon@Scenario)})
 setMethod("swCarbon_DeltaYear","swInputData",function(object) {return(object@carbon@DeltaYear)})
-setMethod("swCarbon_CO2ppm","swInputData",function(object) {return(object@carbon@CO2ppm)})
+setMethod("swCarbon_CO2ppm", "swInputData", function(object) {return(object@carbon@CO2ppm)})
 
-setReplaceMethod(f="set_swCarbon", signature="swInputData", definition=function(object,value) {object@carbon <- value; return(object)})
+setReplaceMethod(f = "set_swCarbon", signature = "swInputData", function(object,value) {
+    slot(object, "carbon") <- value
+    validObject(slot(object, "carbon"))
+    return(object)
+  })
 setReplaceMethod(f="swCarbon_Use_Bio",signature=c(object="swInputData", value="integer"),function(object, value) {object@carbon@CarbonUseBio <- value; return(object)})
 setReplaceMethod(f="swCarbon_Use_WUE",signature=c(object="swInputData", value="integer"),function(object, value) {object@carbon@CarbonUseWUE <- value; return(object)})
 setReplaceMethod(f="swCarbon_Scenario",signature=c(object="swInputData", value="character"),function(object, value) {object@carbon@Scenario <- value; return(object)})
 setReplaceMethod(f="swCarbon_DeltaYear",signature=c(object="swInputData", value="integer"),function(object, value) {object@carbon@DeltaYear <- value; return(object)})
-setReplaceMethod(f="swCarbon_CO2ppm",signature=c(object="swInputData", value="numeric"),function(object, value) {object@carbon@CO2ppm <- value; return(object)})
+setReplaceMethod(f = "swCarbon_CO2ppm",
+  signature = c(object = "swInputData", value = "list"), function(object, value) {
+    slot(slot(object, "carbon"), "CO2ppm") <- value
+    validObject(slot(object, "carbon"))
+    return(object)
+  })
 ##
 
 ##

diff --git a/tests/testthat/test_class_swCarbon.R b/tests/testthat/test_class_swCarbon.R
@@ -0,0 +1,54 @@
+context("Carbon dioxide class")
+
+#---TESTS
+test_that("Manipulate swCarbon", {
+  x <- new("swCarbon")
+  expect_s4_class(x, "swCarbon")
+  expect_equal(x, swClear(x))
+
+  # We currently don't have querry/replacement functions with signature 'swCarbon'
+  # All these methods operate on the 'swCarbon' slot of signature 'swInputData'
+  xinput <- xinput2 <- new("swInputData")
+  expect_s4_class(get_swCarbon(xinput), "swCarbon")
+
+  # Set/querry flags
+  swCarbon_Use_Bio(xinput2) <- 1L
+  expect_equal(swCarbon_Use_Bio(xinput2), 1L)
+  swCarbon_Use_Bio(xinput2) <- swCarbon_Use_Bio(xinput)
+  expect_equal(swCarbon_Use_Bio(xinput2), swCarbon_Use_Bio(xinput))
+  expect_error(swCarbon_Use_Bio(xinput2) <- 0.5)
+
+  swCarbon_Use_WUE(xinput2) <- 1L
+  expect_equal(swCarbon_Use_WUE(xinput2), 1L)
+  swCarbon_Use_WUE(xinput2) <- swCarbon_Use_WUE(xinput)
+  expect_equal(swCarbon_Use_WUE(xinput2), swCarbon_Use_WUE(xinput))
+  expect_error(swCarbon_Use_WUE(xinput2) <- 0.5)
+
+  # Set/querry scenario name
+  swCarbon_Scenario(xinput2) <- "test_scenario"
+  expect_equal(swCarbon_Scenario(xinput2), "test_scenario")
+  swCarbon_Scenario(xinput2) <- swCarbon_Scenario(xinput)
+  expect_equal(swCarbon_Scenario(xinput2), swCarbon_Scenario(xinput))
+  expect_error(swCarbon_Scenario(xinput2) <- 0.5)
+
+  # Set/querry delta year value
+  swCarbon_DeltaYear(xinput2) <- 1950L
+  expect_equal(swCarbon_DeltaYear(xinput2), 1950L)
+  swCarbon_DeltaYear(xinput2) <- swCarbon_DeltaYear(xinput)
+  expect_equal(swCarbon_DeltaYear(xinput2), swCarbon_DeltaYear(xinput))
+  expect_error(swCarbon_DeltaYear(xinput2) <- 0.5)
+
+  # Set/querry CO2 concentration
+  co2 <- data.frame(Year = as.integer(1951:2000), CO2ppm = 360 + seq_len(50) / 2)
+  swCarbon_CO2ppm(xinput2) <- co2
+  expect_equal(swCarbon_CO2ppm(xinput2), co2)
+  swCarbon_CO2ppm(xinput2) <- swCarbon_CO2ppm(xinput)
+  expect_equal(swCarbon_CO2ppm(xinput2), swCarbon_CO2ppm(xinput))
+  expect_error(swCarbon_CO2ppm(xinput2) <- 0.5)
+  # Fail validity
+  co2[10, ] <- NA
+  co2[20, "CO2ppm"] <- -5
+  expect_error(swCarbon_CO2ppm(xinput2) <- co2)
+  colnames(co2) <- c("year", "co2")
+  expect_error(swCarbon_CO2ppm(xinput2) <- co2)
+})