test_that("outright fails stop process and create error message", {
# No data provided
expect_error(())
# Not dataframe
expect_error(("test"))
# Wrong variable names
expect_error((("test" = 1:10)))
# Data provided for more than two model i.e. gis and physical
expect_error(((, , 14:17])))
# Some shared columns (site, year etc) but nothing to suggest which model
expect_error((, 1:3]))
# Data from GB and NI in input dataset
test_data <-
test_data$NGR <- (test_data$NGR)
test_data$NGR[1] <- "S"
expect_error((test_data))
# All variables present
test_data <-
test_data$SITE <-
expect_error((test_data))
# Test data types are correct
test_data <-
test_data$Alkalinity <- "test"
expect_error(
(test_data),
"You provided column 'ALKALINITY' with class 'character', we expect class 'numeric'."
)
# Test optional columns where one or the other column must be provided
test_data <- ::
test_data$Velocity <-
test_data$Discharge <-
expect_error((test_data))
# Velocity over limits
test_data <-
test_data$Velocity <- 6
test_data$Velocity[1] <- 0
test_data$Discharge <-
expect_error((test_data))
# Empty ALKALINITY, HARDNESS, CONDUCT and CALCIUM values
test_data <-
test_data$Alkalinity <-
expect_error((test_data))
# Test NAs in NGR will fail
test_data <-
test_data$NGR[1] <-
expect_error((test_data), "You provided data with one or more NGR values missing,
Hint: Check your NGR variable has letters. ")
# Test if all NGR values NA will fail
test_data <-
test_data$NGR <-
expect_error((test_data), "You provided data with all NGR values missing,
Hint: Check your NGR variable has letters. ")
# NGR must all be less than three letters long
# This stops process because NGR are processed in a batch (not individually for each site)
# Therefore one wrong NGR in column stops whole process
test_data <-
test_data$NGR <- (test_data$NGR)
test_data$NGR[1] <- "BIG"
expect_error((test_data))
# Even a single missing Northing and Easting required
test_data <-
test_data$Northing[1] <-
expect_error((test_data))
test_data <-
test_data$Easting[1] <-
expect_error((test_data))
# Test if all values in column fail
test_data <-
test_data$Discharge <- 14
expect_error((test_data))
# Test fail if all substrate missing
test_data <-
test_data$Sand <-
test_data$Silt_Clay <-
test_data$Boulder_Cobbles <-
test_data$Pebbles_Gravel <-
expect_error((test_data))
# Missing WHPT scores
test_data <-
test_data, ("DistFam", (test_data))] <-
test <- (test_data)
# Missing SX or SY for GIS
test_data <-
test_data$SX <-
test_data$SY <-
expect_error((test_data))
})
# ---------------------------------------------------------------------
test_that("fails on some rows create fail messages (but process continues of validate data)", {
# check if stop_if_all_fail = FALSE works (produces empty validate dataframe)
<-
$Altitude <- 2000
test <- (, stop_if_all_fail = )
expect_equal((test$), 0)
# Check NA caught
test_data <-
test_data$Alkalinity[1] <-
test_data$SITE[1] <-
test <- (test_data)
expect_equal((test[2]], 1]), 2)
# Test missing substrate
test_data <-
test_data$Sand[1] <-
test_data$Boulder_Cobbles[1] <-
test_data$Pebbles_Gravel[1] <-
test_data$Silt_Clay[1] <-
expect_equal(((test_data)), "list")
# test fail values
test_data <- ::
test_data$Discharge[1] <- 11
test_data$Discharge[2] <- 0
test_data$Velocity[3] <- 6
test_data$Discharge[3] <-
test_data$Pebbles_Gravel[1] <- 90
test <- (test_data)
expect_equal((test[2]], 1]), 4)
# test temperature fails if outside temperature grid
test_data <-
test_data$NGR <- (test_data$NGR)
test_data$NGR[1] <- "NZ"
test_data$Easting[1] <- "57900"
test_data$Northing[1] <- "59000"
test <- (test_data)
test <- test$checks
expect_equal((test$FAIL[test$FAIL != "---"]), 2)
# Test optional columns where one or the other column must be provided
test_data <-
test_data$Velocity[1] <-
test_data$Discharge[1] <-
test <- (test_data)
test <- test$checks
expect_equal((test$FAIL[test$FAIL != "---"]), 5)
# Test GIS values also value
test_data <- ::
test_data$disch_cat[1] <-
test_data$disch_cat[2] <- 0
test_data$disch_cat[3] <- 11
test_data$Altitude[1] <- -2
test <- (test_data)
test <- test$checks
expect_equal((test$FAIL[test$FAIL != "---"]), 5)
})
# ---------------------------------------------------------------------
test_that("warnings work", {
test_data <-
test_data$Slope[1] <- 1500
test_data$Slope[2] <- 0
test_data$Slope[3] <- 0.1
test_data$Year[1] <- 1989
test_data$Velocity[2] <- 6 # Stored in velo_dummy column??!!
test_data$Discharge[2] <-
test_data$Discharge[1] <- 10
test <- (test_data)
expect_equal((test[2]], 1]), 5)
test_data <-
test_data$Discharge[1] <- 9
test <- (test_data[1, ])
expect_equal((test[2]], 1]), 1)
# Test user supplied temperatures override calculate temperatures
test_data <-
test_data$MEAN.AIR.TEMP <- 15
test_data$AIR.TEMP.RANGE <- 36
<- (test_data)
expect_equal((("checks"]]$WARNING)), )
# Warning if both discharge and velocity have values
test_data <-
test_data$Velocity <- 1
expect_warning((test_data))
# GIS model warnings work
test_data <- ::
test_data$disch_cat[1] <- 10
test_data$d_f_source[1] <- 246000
test <- (test_data)
test <- test$checks
expect_equal((test$FAIL[test$WARN != "---"]), 2)
})
# ---------------------------------------------------------------------
test_that("replacement values work if value is less than the ‘overall’ minimum value (to avoid dividing by zero)", {
test_data <-
test_data$Altitude[1] <- 0
test_data$Dist_from_Source[1] <- 0.01
test_data$Mean_Width[1] <- 0.01
test_data$Mean_Depth[1] <- 0.1
test_data$Alkalinity[1] <- 0.001
test_data$Slope[1] <- 0
test <- (test_data)
expect_equal((test[2]], 1]), 6)
expect_equal(test[1]][1, ("ALTITUDE")], 1)
expect_equal(test[1]][1, ("DIST_FROM_SOURCE")], 0.1)
expect_equal(test[1]][1, ("MEAN_WIDTH")], 0.1)
expect_equal(test[1]][1, ("MEAN_DEPTH")], 1)
expect_equal(test[1]][1, ("ALKALINITY")], 0.1)
expect_equal(test[1]][1, ("SLOPE")], 0.1)
test_data <-
test_data$Altitude[1] <- 0
test_data$d_f_source[1] <- 90
test_data$Alkalinity[1] <- 0.1
test_data$slope[1] <- 0
test <- (test_data)
expect_equal((test[2]], 1]), 4)
expect_equal(test[1]][1, ("ALTITUDE")], 1)
expect_equal(test[1]][1, ("D_F_SOURCE")], 0.1) # Now converted to Km from metres
expect_equal(test[1]][1, ("ALKALINITY")], 0.1)
expect_equal(test[1]][1, ("SLOPE")], 0.1)
})
# ---------------------------------------------------------------------
test_that("alkalinity, hardness, conductivity and calcium calculations work", {
test_data <- [1:3, ]
test_data$Alkalinity[1:3] <-
test_data$Hardness[1] <- 50
test_data$Calcium[2] <- 50
test_data$Conductivity[3] <- 50
test <- (test_data)
expect_equal((test[2]], 1]), 0)
# Also works for GIS input:
test_data <- [1:4, ]
test_data$Alkalinity[1:3] <-
test_data$hardness[4] <- 50
# Hardness, calcium, conductivity is order of preference
test_data$hardness[1] <- 50 # hardness preferred
test_data$calcium[1] <- 50
test_data$Conductivity[1] <- 50
test_data$calcium[2] <- 50 # calcium preferred
test_data$Conductivity[2] <- 50
test_data$Conductivity[3] <- 50 # conductivity preferred (only option)
test <- (test_data)
messages <- capture_messages((test_data))
expect_equal(
messages[2],
"Using Hardness value to calculate Alkalinity at TST-GB-01-R - 2019. \n"
)
expect_equal(
messages[3],
"Using Calcium value to calculate Alkalinity at TST-GB-02-R - 2019. \n"
)
expect_equal(
messages[4],
"Using Conductivity value to calculate Alkalinity at TST-GB-03-R - 2019. \n"
)
expect_equal((test[2]], 1]), 0)
expect_equal(test$$ALKALINITY, (36.6420, 102.5820, 7.9457, 164.0000))
# Alkalinity value used by default over hardness etc
test_data <- [1:3, ]
test_data$Hardness[1] <- 50
test_data$Calcium[2] <- 50
test_data$Conductivity[3] <- 50
test <- (test_data)
test_data <- [1:3, ]
expect <- (test_data)
expect_equal(expect$$ALKALINITY, test$$ALKALINITY)
})
# ---------------------------------------------------------------------
test_that("velocity calculation work", {
test_data <- ::
test_data$Velocity[1:5] <- 5
test <- (test_data)
expect_equal((test[2]], 1]), 0)
# Test discharge_value of exactly 0.31 returns discharge value of 2. The
# discharge_value is calculated in `get_discharge` function.
test_data <- ::[1, ]
test_data$Mean_Width <- 6.2
test_data$Mean_Depth <- 100
test_data$Velocity <- 1
test_data$Discharge <-
test <- (test_data)
expect_equal(test$$DISCHARGE, 2)
# Test discharge_value of less than 0.31 returns discharge value of 2. The
# discharge_value is calculated in `get_discharge` function.
test_data <- ::[1, ]
test_data$Mean_Width <- 6
test_data$Mean_Depth <- 100
test_data$Velocity <- 1
test_data$Discharge <-
test <- (test_data)
expect_equal(test$$DISCHARGE, 1)
# Test discharge_value of less than 80 returns discharge value of 9. The
# discharge_value is calculated in `get_discharge` function. NOTE- cannot get
# discharge_value to return exactly 80 part have manually tested that value of
# 80 returns 9 and greater than 80 returns 10.
test_data <- ::[1, ]
test_data$Mean_Width <- 53.333333
test_data$Mean_Depth <- 100
test_data$Velocity <- 5
test_data$Discharge <-
test <- (test_data)
expect_equal(test$$DISCHARGE, 9)
# Test discharge_value of greater than 80 returns discharge value of 10. The
# discharge_value is calculated in `get_discharge` function.
test_data <- ::[1, ]
test_data$Mean_Width <- 53.34
test_data$Mean_Depth <- 100
test_data$Velocity <- 5
test_data$Discharge <-
test <- (test_data)
expect_equal(test$$DISCHARGE, 10)
})
# ---------------------------------------------------------------------
test_that("changes/formatting that shouldn't impact calculations", {
# Test adding NGR column in demo_gis_values_log doesn't interfere
# (SX/SY columns provide location for GIS/model 44 data)
test_data <-
# Doesn't matter if GIS has NGR or not - not used in calculations:
test_data$NGR <- "S"
expect_equal(((test_data)"checks"]]), 0)
# Doesn't matter if NI has optional leading 'I' or not
test_data <-
test_data$NGR <- ("I", test_data$NGR)
expect_equal((test_data)"area"]], "ni")
# Test lower case NGR work - regex was not detecting lower case - fixed now.
test_data <-
test_data$NGR <- (test_data$NGR)
test_data$NGR[1] <- "se"
no_error <- (test_data)
# Site ID treated as character even if numeric
test_data <-
test_data$SITE <- (24)
no_error <- (test_data)
# Short NGR - add leading zeros (because of issue with Excel cropping them)
test_data <-
test_data$Easting <- "354"
test_data$Northing <- "9200"
test <- (test_data)[1]]
expect_equal(((test$EASTING)), "00354")
expect_equal(((test$NORTHING)), "09200")
# test row = TRUE (used to match checks to input data)
<- ::
$Slope[2] <- 151
$Altitude[2] <- 700
$Slope[8] <- 151
$Altitude[8] <- 700
$ROW <- (())
test <- (, = )
checks_data <- (, test$checks, by.x = "ROW", by.y = "ROW")
expect_equal((checks_data), 4)
# data is tibble (if using readr package etc)
<- ::
<- tibble::tibble()
<- [1, ]
test <- ()
expect_equal((test), 4)
# iom area & model detection
test <- ()
expect_equal(test$area, "iom")
expect_equal(test$model[1]], "physical")
# iom NGR change to GB instead
<- [1,]
$Easting <- 55001
$Northing <- 10001
expect_error(())
# iom NGR change to GB instead
<- [4,]
$Easting <- 55001
$Northing <- 99999
expect_error(())
# Additional columns added to IOM data will be ignored
<-
$silt <- 1
$Discharge <-
$Velocity <-
test <- ()
expect_equal(test$area, "iom")
})
