tests/testthat/test_sEddyProc.R

In bgctw/REddyProc: Post Processing of (Half-)Hourly Eddy-Covariance Measurements

#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#+++ Unit tests for sEddyProc functions +++
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
# Author: AMM
#require(testthat)
context("sEddyProc-Class")

#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
# Example is accessible if package is installed, otherwise need to load it from
# data directory below package root
if (!exists("Example_DETha98")) load("data/Example_DETha98.RData")
EddyData.F <- Example_DETha98

#Include POSIX time stamp column
EddyDataWithPosix.F <- suppressMessages(fConvertTimeToPosix(
  EddyData.F, 'YDH', Year = 'Year', Day = 'DoY', Hour = 'Hour')) %>%
  filterLongRuns("NEE")
# construct multiyear dataset
EddyData99.F <- EddyData.F
EddyData99.F$Year <- 1999
EddyDataWithPosix2yr.F <- suppressMessages(
  fConvertTimeToPosix(rbind(EddyData.F, EddyData99.F)
                      , 'YDH', Year = 'Year', Day = 'DoY', Hour = 'Hour'))
rm( EddyData99.F )
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

#Check sEddyProc initialization: POSIX time stamp
test_that("POSIX time stamp: correct format",{
  EProc <- sEddyProc$new(
    'DE-Tha', EddyDataWithPosix.F, c('NEE','Rg', 'Tair', 'VPD'))
  expect_that(as.numeric(EProc$sDATA$sDateTime[1]), equals(883613700))
})
test_that("POSIX time stamp: missing column",{
  expect_error(
    EProc <- sEddyProc$new(
      'DE-Tha', EddyData.F, c('NEE','Rg', 'Tair', 'VPD'))
  )
})
test_that("POSIX time stamp: wrong column type",{
  expect_error(
    EProc <- sEddyProc$new(
      'DE-Tha', EddyData.F, c('NEE','Rg', 'Tair', 'VPD'), 'Year')
  )
})

#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

#Check sEddyProc initialization: Time series problems
test_that("Invalid number of daily time steps",{
  expect_error(
    EProc <- sEddyProc$new(
      'DE-Tha', EddyDataWithPosix.F, c('NEE','Rg', 'Tair', 'VPD'), DTS = 12)
  )
})
test_that("Time series not in equidistant steps",{
  expect_error(
    EProc <- sEddyProc$new(
      'DE-Tha', EddyDataWithPosix.F[c(-50,-60),], c('NEE','Rg', 'Tair', 'VPD'))
  )
  expect_error( #Pseudo hourly by [c(F,T),]
    EddyProcH.C <- sEddyProc$new(
      'DE-Tha', EddyDataWithPosix.F[c(F,T),][c(-50,-60),]
      , c('NEE','Rg', 'Tair', 'VPD'), DTS = 24)
  )
})
test_that("Time series not stamped on the (half-)hour",{
  #Shift half-hourly time stamp
  EddyDataShiftedPosix.F <- EddyDataWithPosix.F
  EddyDataShiftedPosix.F$DateTime <- EddyDataShiftedPosix.F$DateTime - (15 * 60)
  expect_error(
    EProc <- sEddyProc$new(
      'DE-Tha', EddyDataShiftedPosix.F, c('NEE','Rg', 'Tair', 'VPD'))
  )
  expect_error(
    EProc <- sEddyProc$new(
      'DE-Tha', EddyDataShiftedPosix.F[c(F,T),]
      , c('NEE','Rg', 'Tair', 'VPD'), DTS = 24)
  )
})
test_that("Time series not in full days and starting at end of first (half-)hour",{
  # (and ending at midnight).
  expect_warning(
    EProc <- sEddyProc$new(
      'DE-Tha', EddyDataWithPosix.F[1:(nrow(EddyDataWithPosix.F) - 1),]
      , c('NEE','Rg', 'Tair', 'VPD'))
  )
  expect_warning(
    EProc <- sEddyProc$new(
      'DE-Tha'
      , EddyDataWithPosix.F[c(F,T),][1:(nrow(EddyDataWithPosix.F[c(F,T),]) - 1),]
      , c('NEE','Rg', 'Tair', 'VPD'), DTS = 24)
  )
  expect_warning(
    EProc <- sEddyProc$new(
      'DE-Tha', EddyDataWithPosix.F[2:(nrow(EddyDataWithPosix.F) - 47),]
      , c('NEE','Rg', 'Tair', 'VPD'))
  )
  expect_warning(
    EProc <- sEddyProc$new(
      'DE-Tha'
      , EddyDataWithPosix.F[c(F,T),][2:(nrow(EddyDataWithPosix.F[c(F,T),]) - 23),]
      , c('NEE','Rg', 'Tair', 'VPD'), DTS = 24)
  )
})
test_that("Time series less than three month of data",{
  expect_error(
    EProc <- sEddyProc$new(
      'DE-Tha', EddyDataWithPosix.F[1:(48*(3*30 - 1)),]
      , c('NEE','Rg', 'Tair', 'VPD'))
  )
  expect_error(
    EProc <- sEddyProc$new(
      'DE-Tha', EddyDataWithPosix.F[c(F,T),][1:(24*(3*30 - 1)),]
      , c('NEE','Rg', 'Tair', 'VPD'), DTS = 24)
  )
})

#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

test_that("Test sGetData",{
  EProc <- sEddyProc$new(
    'DE-Tha', EddyDataWithPosix.F, c('NEE','Rg', 'Tair', 'VPD'))
  Data.F <- EProc$sGetData()
  expect_that(Data.F[,1], equals(EProc$sDATA[,1]))
})

#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

# see .profileGapFill in develop/profile/profile.R

test_that("Test sMDSGapFillAfterUStar default case",{
  skip_on_cran()
  EProc <- sEddyProc$new(
    'DE-Tha', EddyDataWithPosix.F, c('NEE','Rg','Tair','VPD', 'Ustar'))
  uStarTh <- EProc$sEstUstarThold()
  uStar98 <- subset(
    uStarTh, aggregationMode == "year" & seasonYear == 1998, "uStar" )[1,1]
  #EProc$trace("sMDSGapFillAfterUstar", recover)
  #EProc$untrace("sMDSGapFillAfterUstar")
  EProc$sMDSGapFillAfterUstar(
    'NEE', FillAll = FALSE, uStarTh	= uStar98)
  expect_equal(
    uStar98, min(EProc$sDATA$Ustar[
      EProc$sTEMP$NEE_uStar_fqc == 0 &
        (EProc$sDATA$Rg < 10)], na.rm = TRUE), tolerance = 0.05  )
})

test_that("Test sMDSGapFillAfterUStar single value",{
  skip_on_cran()
  EProc <- sEddyProc$new(
    'DE-Tha', EddyDataWithPosix.F, c('NEE','Rg','Tair','VPD', 'Ustar'))
  uStarFixed <- 0.46
  EProc$sMDSGapFillAfterUstar(
    'NEE', FillAll = FALSE, uStarTh = uStarFixed)
  expect_equal( uStarFixed, min(EProc$sDATA$Ustar[
    EProc$sTEMP$NEE_uStar_fqc == 0 & (EProc$sDATA$Rg < 10)]
    , na.rm = TRUE), tolerance = 0.05  )
})

test_that("Test sMDSGapFillAfterUStar error on season mismatch",{
  EProc <- sEddyProc$new(
    'DE-Tha', EddyDataWithPosix.F, c('NEE','Rg','Tair','VPD', 'Ustar'))
  uStarTh <- EProc$sEstUstarThold()
  uStarTh <- usGetAnnualSeasonUStarMap(uStarTh)[-1, ,drop = FALSE]
  expect_error(
    EProc$sMDSGapFillAfterUstar(
      'NEE', uStarTh = uStarTh, FillAll.b = FALSE)
  )
})

test_that("Test sMDSGapFillAfterUStar error on na-values",{
  EProc <- sEddyProc$new(
    'DE-Tha', EddyDataWithPosix.F, c('NEE','Rg','Tair','VPD', 'Ustar'))
  uStarTh <- EProc$sEstUstarThold()
  uStarTh <- usGetAnnualSeasonUStarMap(uStarTh)
  uStarTh[1,2] <- NA
  expect_error(
    EProc$sMDSGapFillAfterUstar(
      'NEE', uStarTh = uStarTh, FillAll.b = FALSE)
  )
})

test_that("Test sMDSGapFillAfterUStarDistr standard and colnames in FluxPartitioning",{
  skip_on_cran()
  EProc <- sEddyProc$new(
    'DE-Tha', EddyDataWithPosix.F, c('NEE','Rg','Tair','VPD','Ustar'))
  .tmp.debug <- function(){
    EddySetups.C <- sEddyProc$new(
      'DE-Tha', EddyDataWithPosix.F
      , c('NEE','Rg','Tair','VPD','Ustar'))$import(EddySetups.C)
  }
  # Note that for each period a distribution of estimates is obtained,
  # and quantiles are reported
  #EddySetups.C <- EddySetups.C$sEstUstarThresholdDistribution( nSample = 3L )
  #(uStarRes <- EddySetups.C$sGetEstimatedUstarThresholdDistribution())
  (uStarRes <- EProc$sEstUstarThresholdDistribution( nSample = 3L ))
  (uStarTh <- usGetAnnualSeasonUStarMap(uStarRes))
  #expUStarScen <- usGetAnnualSeasonUStarMap(uStarRes)
  #expect_equal( EddySetups.C$sUSTAR_SCEN, expUStarScen)
  EProc$sSetUstarScenarios(uStarTh)
  EProc$sMDSGapFillUStarScens('NEE', FillAll = FALSE)
  # Note the columns with differnt suffixes for different uStar
  # estimates (uStar, U05, U50, U95)
  cNames <- grep("U50", colnames(EProc$sExportResults()), value = TRUE)
  expect_true( all(c(
    "Ustar_U50_Thres", "Ustar_U50_fqc", "NEE_U50_orig", "NEE_U50_f",
    "NEE_U50_fqc", "NEE_U50_fall", "NEE_U50_fall_qc", "NEE_U50_fnum",
    "NEE_U50_fsd", "NEE_U50_fmeth", "NEE_U50_fwin")
    %in% cNames) )
  #
  EProc$sMDSGapFill('Tair', FillAll = FALSE)
  EProc$sSetLocationInfo(
    LatDeg = 51.0, LongDeg = 13.6, TimeZoneHour = 1)
  # EddySetups.C <- sEddyProc$new(
  #   'DE-Tha', EddyDataWithPosix.F, c('NEE','Rg','Tair','VPD','Ustar'))$import(
  #     EddySetups.C
  #   )
  for (suffix in c('U05', 'U50')) {
    EProc$sMRFluxPartition(suffix = suffix)
  }
  cNames2 <- grep("U50", colnames(EProc$sExportResults()), value = TRUE)
  expect_true( all(			c("PotRad_U50",	"FP_NEEnight_U50", "FP_Temp_U50"
                        , "E_0_U50", "R_ref_U50", "Reco_U50",
                        "GPP_U50_f", "GPP_U50_fqc")
                      %in% cNames2) )
})

test_that("Test sMDSGapFillAfterUStarDistr single quantile",{
  skip_on_cran()
  eddyC <- sEddyProc$new(
    'DE-Tha', EddyDataWithPosix.F, c('NEE','Rg','Tair','VPD','Ustar'))
  uStarRes <- eddyC$sEstUstarThresholdDistribution(
    nSample = 2L, probs = 0.5
    #,ctrlUstarEst = usControlUstarEst(isUsingCPTSeveralT = TRUE)
    )
  expect_true( all(c("uStar","50%") %in% names(uStarRes)))
  expect_true( all(is.finite(uStarRes$uStar)))
  expect_true( all(is.finite(uStarRes$"50%")))
})


test_that("Test sMDSGapFillAfterUStarDistr single row",{
  skip_on_cran()
  EProc <- sEddyProc$new(
    'DE-Tha', EddyDataWithPosix.F, c('NEE','Rg','Tair','VPD','Ustar'))
  # Note that for each period a distribution of estimates is obtained,
  # and quantiles are reported
  (uStarRes <- EProc$sEstUstarThresholdDistribution( nSample = 3L ))
  # take only the first row, would throw an error in test on season mismatch,
  # but with one row applied for all
  (uStarTh <- usGetAnnualSeasonUStarMap(uStarRes)[1, c(1,3,4),drop = FALSE])
  EProc$sSetUstarScenarios(uStarTh)
  EProc$sMDSGapFillUStarScens('NEE', FillAll = FALSE)
  # Note the columns with differnt suffixes for different uStar
  # estimates (uStar, U05, U50, U95)
  cNames <- grep("U50", colnames(EProc$sExportResults()), value = TRUE)
  expect_true( all(c(
    "Ustar_U50_Thres", "Ustar_U50_fqc", "NEE_U50_orig", "NEE_U50_f",
    "NEE_U50_fqc", "NEE_U50_fall", "NEE_U50_fall_qc", "NEE_U50_fnum",
    "NEE_U50_fsd", "NEE_U50_fmeth", "NEE_U50_fwin")
    %in% cNames) )
})