tests/testthat/test-rict-classify.R
In aquaMetrics/rict: River Invertebrate Classification Tool (RICT)
context("test rict_classify")
test_that("Outputs match azure single-year outputs", {
data <- utils::read.csv(
system.file("extdat",
"validation-input-single-year.csv",
package = "rict"
),
check.names = FALSE, stringsAsFactors = FALSE
)
data <- data[1, ] # only one year required
test_validation_func <- rict:::rict_validate(data)
predictions <- rict_predict(data)
classification <- rict_classify(predictions, year_type = "single")
expect_equal(class(classification), "data.frame")
azure_classification <- utils::read.csv(system.file("extdat",
"validation-class-single-year.csv",
package = "rict"
))
classification$mintawhpt_spr_aut_mostProb <-
as.character(classification$mintawhpt_spr_aut_mostProb)
azure_classification$mintawhpt_spr_aut_mostProb <-
as.character(azure_classification$mintawhpt_spr_aut_mostProb)
equal <- all.equal(
classification$mintawhpt_spr_aut_mostProb,
azure_classification$mintawhpt_spr_aut_mostProb[1]
)
expect_true(equal == TRUE)
equal <- all.equal(
round(classification$NTAXA_eqr_av_spr, 2),
round(azure_classification$NTAXA_eqr_av_spr[1], 2)
)
expect_true(equal == TRUE)
})
### ---------------------------------------------------------------------------------------
test_that("Outputs match azure NI single-year outputs", {
data <- demo_ni_observed_values # only one year required
test_validation_func <- rict:::rict_validate(data, crs = 29903)
predictions <- rict_predict(data, crs = 29903)
classification <- rict_classify(predictions,
year_type = "single"
)
expect_equal(class(classification), "data.frame")
azure_classification <- utils::read.csv(
system.file("extdat",
"validation-classification-ni-single-year.csv",
package = "rict"
),
check.names = FALSE, stringsAsFactors = FALSE
)
classification$mintawhpt_spr_aut_mostProb <-
as.character(classification$mintawhpt_spr_aut_mostProb)
azure_classification$mintawhpt_spr_aut_mostProb <-
as.character(azure_classification$mintawhpt_spr_aut_mostProb)
# status are the same
equal <- all.equal(
classification$mintawhpt_spr_aut_mostProb,
azure_classification$mintawhpt_spr_aut_mostProb
)
expect_true(equal == TRUE)
# Check spr NTAXA equal
equal <- all.equal(
as.character(classification$mostProb_NTAXA_spr),
as.character(azure_classification$mostProb_NTAXA_spr)
)
expect_true(equal == TRUE)
# Check spr ASPT -----
equal <- all.equal(
as.character(classification$mostProb_ASPT_spr),
as.character(azure_classification$mostProb_ASPT_spr)
)
expect_true(equal == TRUE)
# check a confidence of class
max_diff <- max(as.numeric(classification$H_ASPT_aut) -
as.numeric(azure_classification$H_ASPT_aut))
min_diff <- min(as.numeric(classification$H_ASPT_aut) -
as.numeric(azure_classification$H_ASPT_aut))
expect_true(max_diff < 2 && min_diff < 2)
})
### -----------------------------------------------------------------------------------------
test_that("Outputs match azure multi-year outputs", {
# skip("currently failing because change to set.seed code")
predictions <- rict_predict(demo_observed_values)
classification <- rict_classify(predictions)
expect_equal(class(classification), "data.frame")
# compare results downloaded from azure with package (Results on azure were manually user tested).
validation_classification <- utils::read.csv(system.file("extdat",
"validation-class-multi-year.csv",
package = "rict"
))
classification <- classification[, names(classification) %in% names(validation_classification)]
# match up class between azure results and package:
classification$WATERBODY <- as.character(classification$WATERBODY)
validation_classification$WATERBODY <- as.character(validation_classification$WATERBODY)
classification$H_NTAXA_spr_aut <- as.character(classification$H_NTAXA_spr_aut)
classification$H_NTAXA_spr_aut <- as.numeric(classification$H_NTAXA_spr_aut)
classification$G_NTAXA_spr_aut <- as.character(classification$G_NTAXA_spr_aut)
classification$G_NTAXA_spr_aut <- as.numeric(classification$G_NTAXA_spr_aut)
classification$M_NTAXA_spr_aut <- as.character(classification$M_NTAXA_spr_aut)
classification$M_NTAXA_spr_aut <- as.numeric(classification$M_NTAXA_spr_aut)
classification$P_NTAXA_spr_aut <- as.character(classification$P_NTAXA_spr_aut)
classification$P_NTAXA_spr_aut <- as.numeric(classification$P_NTAXA_spr_aut)
classification$B_NTAXA_spr_aut <- as.character(classification$B_NTAXA_spr_aut)
classification$B_NTAXA_spr_aut <- as.numeric(classification$B_NTAXA_spr_aut)
classification$mostProb_NTAXA_spr_aut <- as.character(classification$mostProb_NTAXA_spr_aut)
validation_classification$mostProb_NTAXA_spr_aut <- as.character(validation_classification$mostProb_NTAXA_spr_aut)
classification$H_ASPT_spr_aut <- as.character(classification$H_ASPT_spr_aut)
classification$H_ASPT_spr_aut <- as.numeric(classification$H_ASPT_spr_aut)
classification$G_ASPT_spr_aut <- as.character(classification$G_ASPT_spr_aut)
classification$G_ASPT_spr_aut <- as.numeric(classification$G_ASPT_spr_aut)
classification$M_ASPT_spr_aut <- as.character(classification$M_ASPT_spr_aut)
classification$M_ASPT_spr_aut <- as.numeric(classification$M_ASPT_spr_aut)
classification$P_ASPT_spr_aut <- as.character(classification$P_ASPT_spr_aut)
classification$P_ASPT_spr_aut <- as.numeric(classification$P_ASPT_spr_aut)
classification$B_ASPT_spr_aut <- as.character(classification$B_ASPT_spr_aut)
classification$B_ASPT_spr_aut <- as.numeric(classification$B_ASPT_spr_aut)
classification$mostProb_ASPT_spr_aut <- as.character(classification$mostProb_ASPT_spr_aut)
validation_classification$mostProb_ASPT_spr_aut <- as.character(validation_classification$mostProb_ASPT_spr_aut)
classification$mintawhpt_spr_aut_H_MINTA_ <- as.character(classification$mintawhpt_spr_aut_H_MINTA_)
classification$mintawhpt_spr_aut_H_MINTA_ <- as.numeric(classification$mintawhpt_spr_aut_H_MINTA_)
classification$mintawhpt_spr_aut_G_MINTA_ <- as.character(classification$mintawhpt_spr_aut_G_MINTA_)
classification$mintawhpt_spr_aut_G_MINTA_ <- as.numeric(classification$mintawhpt_spr_aut_G_MINTA_)
classification$mintawhpt_spr_aut_M_MINTA_ <- as.character(classification$mintawhpt_spr_aut_M_MINTA_)
classification$mintawhpt_spr_aut_M_MINTA_ <- as.numeric(classification$mintawhpt_spr_aut_M_MINTA_)
classification$mintawhpt_spr_aut_P_MINTA_ <- as.character(classification$mintawhpt_spr_aut_P_MINTA_)
classification$mintawhpt_spr_aut_P_MINTA_ <- as.numeric(classification$mintawhpt_spr_aut_P_MINTA_)
classification$mintawhpt_spr_aut_B_MINTA_ <- as.character(classification$mintawhpt_spr_aut_B_MINTA_)
classification$mintawhpt_spr_aut_B_MINTA_ <- as.numeric(classification$mintawhpt_spr_aut_B_MINTA_)
classification$mintawhpt_spr_aut_mostProb_MINTA_ <- as.character(classification$mintawhpt_spr_aut_mostProb_MINTA_)
validation_classification$mintawhpt_spr_aut_mostProb_MINTA_ <- as.character(
validation_classification$mintawhpt_spr_aut_mostProb_MINTA_
)
# Remove row.names - not required for comparison
row.names(classification) <- NULL
row.names(validation_classification) <- NULL
# Test azure and package results match:
equal <- all.equal(
classification[, c(1, 3:23)], # ignore YEAR - this is wrong in Azure - duplicate SITE + YEAR rows
validation_classification[, c(1, 3:23)]
)
### No longer exactly match because change in set.seed / randonness to help reproducibility------------------------
equal_test <- c(
"Component “H_NTAXA_spr_aut”: Mean relative difference: 0.05576704",
"Component “G_NTAXA_spr_aut”: Mean relative difference: 0.3010624",
"Component “M_NTAXA_spr_aut”: Mean relative difference: 0.5757634",
"Component “P_NTAXA_spr_aut”: Mean relative difference: 0.2964701",
"Component “B_NTAXA_spr_aut”: Mean relative difference: 0.1002725",
"Component “NTAXA_aver_spr_aut”: Mean relative difference: 0.002509596",
"Component “H_ASPT_spr_aut”: Mean relative difference: 0.1108501",
"Component “G_ASPT_spr_aut”: Mean relative difference: 0.2924333",
"Component “M_ASPT_spr_aut”: Mean relative difference: 0.4349747",
"Component “P_ASPT_spr_aut”: Mean relative difference: 0.4931039",
"Component “B_ASPT_spr_aut”: Mean relative difference: 0.2088626",
"Component “ASPT_aver_spr_aut”: Mean relative difference: 0.004446158",
"Component “mintawhpt_spr_aut_H_MINTA_”: Mean relative difference: 0.1059381",
"Component “mintawhpt_spr_aut_G_MINTA_”: Mean relative difference: 0.2748555",
"Component “mintawhpt_spr_aut_M_MINTA_”: Mean relative difference: 0.4639946",
"Component “mintawhpt_spr_aut_P_MINTA_”: Mean relative difference: 0.4413525",
"Component “mintawhpt_spr_aut_B_MINTA_”: Mean relative difference: 0.1077103"
)
expect_equal(cat(equal), cat(equal_test))
})
### -------------------------------------------------------------------------------------------------
test_that("Outputs on SEPA system", {
skip("internal sepa test only")
library(sepaTools)
ecology_results <- getEcologyResults(
locations = 122480,
startDate = "01-JAN-2013",
endDate = "17-NOV-2017"
)
observed_values <- transformRict(ecology_results)
predictions <- rict::rict_predict(observed_values)
})
### --------------------------------------------------------------------------------------------
test_that("GIS variables classification against Ralph's output", {
library(dplyr)
library(tidyr)
data("demo_gis_values_log")
demo_gis_values_log$WATERBODY <- demo_gis_values_log$SITE
predictions <- rict_predict(demo_gis_values_log)
results <- rict_classify(predictions, year_type = "single", seed = FALSE)
results_two <- rict(demo_gis_values_log, year_type = "single", seed = FALSE)
# test that creating predictions then classifying works the same as going straight to
# classifying
equal <- all.equal(
results,
results_two
)
expect_true(equal == TRUE)
# remove non-required predictions variables
predictions <- select(predictions, -starts_with("p"))
# need both predictions and classificatoin outputs to fully check classification
output <- inner_join(predictions, results, by = c("SITE" = "SITE"))
# tidy data so it matches test data format
output <- as.data.frame(t(output))
output$SITE <- row.names(output)
names(output)[1:24] <- c(as.matrix(filter(output, SITE == "SITE")))[1:24]
# read in test data to check against
test_data <- utils::read.csv(
system.file("extdat",
"test-sites-gb-model-44-classification-draft.csv",
package = "rict"
),
check.names = FALSE, stringsAsFactors = FALSE
)
# filter only things that match
output <- filter(output, SITE %in% test_data$SITE)
test_data <- filter(test_data, SITE %in% output$SITE)
# select columns in same order
output <- select(output, SITE, everything())
output <- arrange(output, SITE)
test_data <- arrange(test_data, SITE)
output <- output %>% pivot_longer(-SITE, names_to = "SITES", values_to = "count")
output <- output %>% pivot_wider(names_from = SITE, values_from = "count")
test_data <- test_data %>% pivot_longer(-SITE, names_to = "SITES", values_to = "count")
test_data <- test_data %>% pivot_wider(names_from = SITE, values_from = "count")
# check differences!
test_data <- type.convert(test_data, as.is = TRUE)
output <- type.convert(output, as.is = TRUE)
test <- data.frame(select_if(test_data, is.numeric))
test2 <- data.frame(select_if(output, is.numeric))
test3 <- 100 / (test + 1) * (test2 + 1) - 100
# check end groups don't differ on average more than 1.5% - (Sampling error?)
# this is not a very good test as it takes the mean! but Ralph happy that results match
# expect_true(mean(t(test3)) < 0.686)
# changes to set.seed created higher difference:
expect_true(mean(t(test3)) < 10.82496)
# write.csv(test_data, file = "testing-data-from-ralph.csv")
# write.csv(output, file = "r-output.csv")
# write.csv(results, file = "r-output-standard.csv")
})
### --------------------------------------------------------------------------------------------
test_that("Single year: Only return results for seasons provided", {
# Remove specific seasons completely:
remove_cols <- grep("Sum_TL2|Spr_TL2", names(demo_observed_values))
demo_observed_values[, remove_cols] <- NA
test <- rict(demo_observed_values, year_type = "single", seed = FALSE)
expect_equal(all(is.na(test$M_NTAXA_spr)), TRUE)
expect_equal(all(is.na(test$M_NTAXA_sum)), TRUE)
expect_equal(all(is.na(test$M_NTAXA_aut)), FALSE)
# Remove seasons in certain rows:
demo_observed_values <- rict::demo_observed_values
remove_cols <- grep("Sum_TL2|Spr_TL2", names(demo_observed_values))
demo_observed_values[1:2, remove_cols] <- NA
remove_cols <- grep("Sum_TL2", names(demo_observed_values))
demo_observed_values[5:7, remove_cols] <- NA
test <- rict(demo_observed_values, year_type = "single", seed = FALSE)
expect_equal(all(is.na(test$M_NTAXA_spr[1])), TRUE)
expect_equal(all(is.na(test$M_NTAXA_spr[3])), FALSE)
expect_equal(all(is.na(test$M_NTAXA_sum[5])), TRUE)
expect_equal(all(is.na(test$M_NTAXA_sum[8])), FALSE)
# Remove summer from GIS:
demo_gis_values_log <- rict::demo_gis_values_log
remove_cols <- grep("Sum_TL2_", names(demo_gis_values_log))
demo_gis_values_log[1:2, remove_cols] <- NA
remove_cols <- grep("Sum_Season_ID|Sum_Ntaxa_Bias", names(demo_gis_values_log))
demo_gis_values_log[1:2, remove_cols] <- NA
prediction <- rict_predict(demo_gis_values_log)
test <- rict(demo_gis_values_log, year_type = "single", seed = FALSE)
# Only summer from GIS:
demo_gis_values_log <- rict::demo_gis_values_log
remove_cols <- grep("Spr_TL2_|Aut_TL2_", names(demo_gis_values_log))
demo_gis_values_log[1:2, remove_cols] <- NA
remove_cols <- grep("Aut_Season_ID|Aut_Ntaxa_Bias|Spr_Season_ID|Spr_Ntaxa_Bias", names(demo_gis_values_log))
demo_gis_values_log[1:2, remove_cols] <- NA
test <- rict(demo_gis_values_log, year_type = "single", seed = FALSE)
test <- rict(demo_gis_values_log[1, ], year_type = "single", seed = FALSE)
})
test_that("Single year: Summer only", {
data <- utils::read.csv(system.file("extdat",
"input-file-single-year-gb.csv",
package = "rict"
), check.names = FALSE)
classification <- rict(data, year_type = "single", seed = TRUE)
verfied_classification <- utils::read.csv(system.file("extdat",
"rict-summer-single-year-gb.csv",
package = "rict"
), check.names = FALSE)
expect_equal(
sum(as.numeric(as.character(classification$H_NTAXA_sum))) -
sum(verfied_classification$H_NTAXA_sum),
1.26
)
# changed from -133.48(beta RICT3) or -138.52 (azure) due to set.seed changes
# and error in using spring instead of summer predictions
expect_equal(
as.character(classification$mintawhpt_sum_mostProb),
as.character(verfied_classification$mostProb_MINTA)
)
})
### --------------------------------------------------------------------------------------------
test_that("Test single row of multi-year input works", {
# Data contains single year / single row sites at start and end of input file
single_row_test <- utils::read.csv(system.file("extdat",
"test-data-single-site-multi-year.csv",
package = "rict"
), check.names = FALSE)
# Run data through multi-year classification and check output is created for all sites
sites <- unique(single_row_test$SITE)
check <- rict(single_row_test, seed = FALSE)
expect_equal(sort(as.character(unique(check$SITE))), sort(as.character(sites)))
# Test a single row input also works
check <- rict(single_row_test[1, ], seed = FALSE)
# Quick test to see it return a value
expect_gte(as.numeric(as.character(check$H_NTAXA_spr_aut)), 0)
})
test_that("NI classification", {
classification <- rict(demo_ni_observed_values,
year_type = "single",
crs = 29903, seed = FALSE
)
verfied_classification <- utils::read.csv(system.file("extdat",
"validation-classification-ni-single-year.csv",
package = "rict"
), check.names = FALSE)
classification <- classification[, names(classification) %in% names(verfied_classification)]
verfied_classification <- verfied_classification[, names(verfied_classification) %in% names(classification)]
classification <- type.convert(classification, as.is = TRUE)
verfied_classification <- type.convert(verfied_classification, as.is = TRUE)
# Not exact match because of difference in randomness due to global set.seed implementation
# the single-year classification loops through all seasons in the package (including summer)
# which means the set.seed is slightly different after looping through summer etc
# if you remove summer from the loop it gives the same answer.
# however these status classes do still match for spring:
expect_equal(classification$mostProb_NTAXA_spr, verfied_classification$mostProb_NTAXA_spr)
})
test_that("test reproducibility", {
# Are results the same no matter what order etc
test <- demo_observed_values[1:3, ]
test <- rbind(demo_observed_values[4:6, ], test)
# Change the order - switch first and second site/multi-year around
test1 <- rict(demo_observed_values[1:3, ], seed = FALSE)
test2 <- rict(test, seed = FALSE)
# First results from test1 should match second result from test2
expect_equal(as.numeric(as.character(test1$H_NTAXA_spr_aut)), as.numeric(as.character(test2$H_NTAXA_spr_aut[2])))
})
test_that("missing observations in multi-year return NA", {
test <- demo_observed_values
test$`Aut_TL2_WHPT_ASPT (AbW,DistFam)` <- NA
test$`Aut_TL2_WHPT_NTaxa (AbW,DistFam)` <- NA
test <- rict(test, seed = FALSE)
expect_equal(length(test[is.na(test)]), 200)
})
test_that("NI summer", {
classification <- rict(demo_ni_observed_values,
year_type = "single",
crs = 29903,
seed = FALSE
)
azure_classification <- utils::read.csv(
system.file("extdat",
"validation-classification-ni-single-year-summer.csv",
package = "rict"
),
check.names = FALSE, stringsAsFactors = FALSE
)
expect_equal(
classification$mostProb_NTAXA_sum[c(1:15, 17:20, 22:24)],
azure_classification$mostProb_NTAXA_sum[c(1:15, 17:20, 22:24)]
)
expect_equal(sum(classification$eqr_av_sum_aspt -
azure_classification$eqr_av_sum_aspt), -0.09886847)
})
test_that("IoM classify", {
# test one site for speed
test <- rict(demo_iom_observed_values[1, ], seed = FALSE)
# compare to output 2023-02-26
valid <- data.frame(
"SITE" = "TEST-01-R",
"YEAR" = 2016,
"WATERBODY" = "Waterbody name",
"E_NTAXA_spr_aut" = "100",
"G_NTAXA_spr_aut" = "0",
"M_NTAXA_spr_aut" = "0",
"P_NTAXA_spr_aut" = "0",
"B_NTAXA_spr_aut" = "0",
"mostProb_NTAXA_spr_aut" = "Excellent",
"NTAXA_aver_spr_aut" = 1.338453,
"E_ASPT_spr_aut" = "86.02",
"G_ASPT_spr_aut" = "13.41",
"M_ASPT_spr_aut" = "0.57",
"P_ASPT_spr_aut" = "0",
"B_ASPT_spr_aut" = "0",
"mostProb_ASPT_spr_aut" = "Excellent",
"ASPT_aver_spr_aut" = 1.037458,
"mintawhpt_spr_aut_E_MINTA_" = "86.02",
"mintawhpt_spr_aut_G_MINTA_" = "13.41",
"mintawhpt_spr_aut_M_MINTA_" = "0.57",
"mintawhpt_spr_aut_P_MINTA_" = "0",
"mintawhpt_spr_aut_B_MINTA_" = "0",
"mintawhpt_spr_aut_mostProb_MINTA_" = "Excellent"
)
test$NTAXA_aver_spr_aut <- round(test$NTAXA_aver_spr_aut, 6)
test$ASPT_aver_spr_aut <- round(test$ASPT_aver_spr_aut, 6)
row.names(valid) <- NULL
row.names(test) <- NULL
expect_equal(test[1, 1:23], valid)
})
test_that("IoM classify all seasons", {
# Input file used for fortran version
iom_fortran_input <- utils::read.csv(
system.file("extdat",
"input-file-to-test-iom-against-fortran-outputs.csv",
package = "rict"
), check.names = FALSE)
# Test results file from fortran version
iom_test_results <- utils::read.csv(
system.file("extdat",
"test-all-seasons-iom-090723.csv",
package = "rict"
), check.names = FALSE)
test <- rict(iom_fortran_input[1:5, ], seed = TRUE, year_type = "multi")
# Test against expected values from fortran outputs
# Slight rounding error in compared to iom_test_results, replace 0.94 with 0.95
# due to spreadsheet rounding rules.
testthat::expect_equal(
round(test$all_seasons_ntaxa_EQR, 2),
c(0.95, round(as.numeric(iom_test_results[108, 3:6]), 2))
)
# Test probability of class
# Expect slight difference due to random noise
testthat::expect_equal(
sum(round(as.numeric(test$all_seasons_ntaxa_E[1:5]), 0)) -
sum(c(round(as.numeric(iom_test_results[109, 2:6]), 0))),
1
)
# Test summer and autumn seasons work
sum_autumn_input <- dplyr::select(iom_fortran_input, -starts_with("Spr"))
sum_autumn_test <- rict(sum_autumn_input[1:5, ],
seed = TRUE,
year_type = "multi")
# Test against expected values from fortran ntaxa outputs
testthat::expect_equal(
round(sum_autumn_test$all_seasons_ntaxa_EQR, 2),
c(round(as.numeric(iom_test_results[92, 2:6]), 2))
)
# Test against expected values from fortran aspt outputs
# Slight rounding error in compared to iom_test_results, replace 0.90 with 0.89
# due to spreadsheet rounding rules.
testthat::expect_equal(
round(sum_autumn_test$all_seasons_aspt_EQR, 2),
c(0.89, round(as.numeric(iom_test_results[92, 30:33]), 2))
)
# Test single-year classification
single_year_test <- rict(iom_fortran_input[1:5, ],
seed = TRUE,
year_type = "single")
# Test against expected values from fortran outputs
# Slight rounding error in compared to iom_test_results, replace 0.94 with 0.95
# due to spreadsheet rounding rules.
testthat::expect_equal(
round(single_year_test$all_seasons_ntaxa_EQR, 2),
c(0.95, round(as.numeric(iom_test_results[108, 3:6]), 2)))
})
aquaMetrics/rict documentation built on March 1, 2025, 1:31 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
context("test rict_classify")
test_that("Outputs match azure single-year outputs", {
data <- utils::read.csv(
system.file("extdat",
"validation-input-single-year.csv",
package = "rict"
),
check.names = FALSE, stringsAsFactors = FALSE
)
data <- data[1, ] # only one year required
test_validation_func <- rict:::rict_validate(data)
predictions <- rict_predict(data)
classification <- rict_classify(predictions, year_type = "single")
expect_equal(class(classification), "data.frame")
azure_classification <- utils::read.csv(system.file("extdat",
"validation-class-single-year.csv",
package = "rict"
))
classification$mintawhpt_spr_aut_mostProb <-
as.character(classification$mintawhpt_spr_aut_mostProb)
azure_classification$mintawhpt_spr_aut_mostProb <-
as.character(azure_classification$mintawhpt_spr_aut_mostProb)
equal <- all.equal(
classification$mintawhpt_spr_aut_mostProb,
azure_classification$mintawhpt_spr_aut_mostProb[1]
)
expect_true(equal == TRUE)
equal <- all.equal(
round(classification$NTAXA_eqr_av_spr, 2),
round(azure_classification$NTAXA_eqr_av_spr[1], 2)
)
expect_true(equal == TRUE)
})
### ---------------------------------------------------------------------------------------
test_that("Outputs match azure NI single-year outputs", {
data <- demo_ni_observed_values # only one year required
test_validation_func <- rict:::rict_validate(data, crs = 29903)
predictions <- rict_predict(data, crs = 29903)
classification <- rict_classify(predictions,
year_type = "single"
)
expect_equal(class(classification), "data.frame")
azure_classification <- utils::read.csv(
system.file("extdat",
"validation-classification-ni-single-year.csv",
package = "rict"
),
check.names = FALSE, stringsAsFactors = FALSE
)
classification$mintawhpt_spr_aut_mostProb <-
as.character(classification$mintawhpt_spr_aut_mostProb)
azure_classification$mintawhpt_spr_aut_mostProb <-
as.character(azure_classification$mintawhpt_spr_aut_mostProb)
# status are the same
equal <- all.equal(
classification$mintawhpt_spr_aut_mostProb,
azure_classification$mintawhpt_spr_aut_mostProb
)
expect_true(equal == TRUE)
# Check spr NTAXA equal
equal <- all.equal(
as.character(classification$mostProb_NTAXA_spr),
as.character(azure_classification$mostProb_NTAXA_spr)
)
expect_true(equal == TRUE)
# Check spr ASPT -----
equal <- all.equal(
as.character(classification$mostProb_ASPT_spr),
as.character(azure_classification$mostProb_ASPT_spr)
)
expect_true(equal == TRUE)
# check a confidence of class
max_diff <- max(as.numeric(classification$H_ASPT_aut) -
as.numeric(azure_classification$H_ASPT_aut))
min_diff <- min(as.numeric(classification$H_ASPT_aut) -
as.numeric(azure_classification$H_ASPT_aut))
expect_true(max_diff < 2 && min_diff < 2)
})
### -----------------------------------------------------------------------------------------
test_that("Outputs match azure multi-year outputs", {
# skip("currently failing because change to set.seed code")
predictions <- rict_predict(demo_observed_values)
classification <- rict_classify(predictions)
expect_equal(class(classification), "data.frame")
# compare results downloaded from azure with package (Results on azure were manually user tested).
validation_classification <- utils::read.csv(system.file("extdat",
"validation-class-multi-year.csv",
package = "rict"
))
classification <- classification[, names(classification) %in% names(validation_classification)]
# match up class between azure results and package:
classification$WATERBODY <- as.character(classification$WATERBODY)
validation_classification$WATERBODY <- as.character(validation_classification$WATERBODY)
classification$H_NTAXA_spr_aut <- as.character(classification$H_NTAXA_spr_aut)
classification$H_NTAXA_spr_aut <- as.numeric(classification$H_NTAXA_spr_aut)
classification$G_NTAXA_spr_aut <- as.character(classification$G_NTAXA_spr_aut)
classification$G_NTAXA_spr_aut <- as.numeric(classification$G_NTAXA_spr_aut)
classification$M_NTAXA_spr_aut <- as.character(classification$M_NTAXA_spr_aut)
classification$M_NTAXA_spr_aut <- as.numeric(classification$M_NTAXA_spr_aut)
classification$P_NTAXA_spr_aut <- as.character(classification$P_NTAXA_spr_aut)
classification$P_NTAXA_spr_aut <- as.numeric(classification$P_NTAXA_spr_aut)
classification$B_NTAXA_spr_aut <- as.character(classification$B_NTAXA_spr_aut)
classification$B_NTAXA_spr_aut <- as.numeric(classification$B_NTAXA_spr_aut)
classification$mostProb_NTAXA_spr_aut <- as.character(classification$mostProb_NTAXA_spr_aut)
validation_classification$mostProb_NTAXA_spr_aut <- as.character(validation_classification$mostProb_NTAXA_spr_aut)
classification$H_ASPT_spr_aut <- as.character(classification$H_ASPT_spr_aut)
classification$H_ASPT_spr_aut <- as.numeric(classification$H_ASPT_spr_aut)
classification$G_ASPT_spr_aut <- as.character(classification$G_ASPT_spr_aut)
classification$G_ASPT_spr_aut <- as.numeric(classification$G_ASPT_spr_aut)
classification$M_ASPT_spr_aut <- as.character(classification$M_ASPT_spr_aut)
classification$M_ASPT_spr_aut <- as.numeric(classification$M_ASPT_spr_aut)
classification$P_ASPT_spr_aut <- as.character(classification$P_ASPT_spr_aut)
classification$P_ASPT_spr_aut <- as.numeric(classification$P_ASPT_spr_aut)
classification$B_ASPT_spr_aut <- as.character(classification$B_ASPT_spr_aut)
classification$B_ASPT_spr_aut <- as.numeric(classification$B_ASPT_spr_aut)
classification$mostProb_ASPT_spr_aut <- as.character(classification$mostProb_ASPT_spr_aut)
validation_classification$mostProb_ASPT_spr_aut <- as.character(validation_classification$mostProb_ASPT_spr_aut)
classification$mintawhpt_spr_aut_H_MINTA_ <- as.character(classification$mintawhpt_spr_aut_H_MINTA_)
classification$mintawhpt_spr_aut_H_MINTA_ <- as.numeric(classification$mintawhpt_spr_aut_H_MINTA_)
classification$mintawhpt_spr_aut_G_MINTA_ <- as.character(classification$mintawhpt_spr_aut_G_MINTA_)
classification$mintawhpt_spr_aut_G_MINTA_ <- as.numeric(classification$mintawhpt_spr_aut_G_MINTA_)
classification$mintawhpt_spr_aut_M_MINTA_ <- as.character(classification$mintawhpt_spr_aut_M_MINTA_)
classification$mintawhpt_spr_aut_M_MINTA_ <- as.numeric(classification$mintawhpt_spr_aut_M_MINTA_)
classification$mintawhpt_spr_aut_P_MINTA_ <- as.character(classification$mintawhpt_spr_aut_P_MINTA_)
classification$mintawhpt_spr_aut_P_MINTA_ <- as.numeric(classification$mintawhpt_spr_aut_P_MINTA_)
classification$mintawhpt_spr_aut_B_MINTA_ <- as.character(classification$mintawhpt_spr_aut_B_MINTA_)
classification$mintawhpt_spr_aut_B_MINTA_ <- as.numeric(classification$mintawhpt_spr_aut_B_MINTA_)
classification$mintawhpt_spr_aut_mostProb_MINTA_ <- as.character(classification$mintawhpt_spr_aut_mostProb_MINTA_)
validation_classification$mintawhpt_spr_aut_mostProb_MINTA_ <- as.character(
validation_classification$mintawhpt_spr_aut_mostProb_MINTA_
)
# Remove row.names - not required for comparison
row.names(classification) <- NULL
row.names(validation_classification) <- NULL
# Test azure and package results match:
equal <- all.equal(
classification[, c(1, 3:23)], # ignore YEAR - this is wrong in Azure - duplicate SITE + YEAR rows
validation_classification[, c(1, 3:23)]
)
### No longer exactly match because change in set.seed / randonness to help reproducibility------------------------
equal_test <- c(
"Component “H_NTAXA_spr_aut”: Mean relative difference: 0.05576704",
"Component “G_NTAXA_spr_aut”: Mean relative difference: 0.3010624",
"Component “M_NTAXA_spr_aut”: Mean relative difference: 0.5757634",
"Component “P_NTAXA_spr_aut”: Mean relative difference: 0.2964701",
"Component “B_NTAXA_spr_aut”: Mean relative difference: 0.1002725",
"Component “NTAXA_aver_spr_aut”: Mean relative difference: 0.002509596",
"Component “H_ASPT_spr_aut”: Mean relative difference: 0.1108501",
"Component “G_ASPT_spr_aut”: Mean relative difference: 0.2924333",
"Component “M_ASPT_spr_aut”: Mean relative difference: 0.4349747",
"Component “P_ASPT_spr_aut”: Mean relative difference: 0.4931039",
"Component “B_ASPT_spr_aut”: Mean relative difference: 0.2088626",
"Component “ASPT_aver_spr_aut”: Mean relative difference: 0.004446158",
"Component “mintawhpt_spr_aut_H_MINTA_”: Mean relative difference: 0.1059381",
"Component “mintawhpt_spr_aut_G_MINTA_”: Mean relative difference: 0.2748555",
"Component “mintawhpt_spr_aut_M_MINTA_”: Mean relative difference: 0.4639946",
"Component “mintawhpt_spr_aut_P_MINTA_”: Mean relative difference: 0.4413525",
"Component “mintawhpt_spr_aut_B_MINTA_”: Mean relative difference: 0.1077103"
)
expect_equal(cat(equal), cat(equal_test))
})
### -------------------------------------------------------------------------------------------------
test_that("Outputs on SEPA system", {
skip("internal sepa test only")
library(sepaTools)
ecology_results <- getEcologyResults(
locations = 122480,
startDate = "01-JAN-2013",
endDate = "17-NOV-2017"
)
observed_values <- transformRict(ecology_results)
predictions <- rict::rict_predict(observed_values)
})
### --------------------------------------------------------------------------------------------
test_that("GIS variables classification against Ralph's output", {
library(dplyr)
library(tidyr)
data("demo_gis_values_log")
demo_gis_values_log$WATERBODY <- demo_gis_values_log$SITE
predictions <- rict_predict(demo_gis_values_log)
results <- rict_classify(predictions, year_type = "single", seed = FALSE)
results_two <- rict(demo_gis_values_log, year_type = "single", seed = FALSE)
# test that creating predictions then classifying works the same as going straight to
# classifying
equal <- all.equal(
results,
results_two
)
expect_true(equal == TRUE)
# remove non-required predictions variables
predictions <- select(predictions, -starts_with("p"))
# need both predictions and classificatoin outputs to fully check classification
output <- inner_join(predictions, results, by = c("SITE" = "SITE"))
# tidy data so it matches test data format
output <- as.data.frame(t(output))
output$SITE <- row.names(output)
names(output)[1:24] <- c(as.matrix(filter(output, SITE == "SITE")))[1:24]
# read in test data to check against
test_data <- utils::read.csv(
system.file("extdat",
"test-sites-gb-model-44-classification-draft.csv",
package = "rict"
),
check.names = FALSE, stringsAsFactors = FALSE
)
# filter only things that match
output <- filter(output, SITE %in% test_data$SITE)
test_data <- filter(test_data, SITE %in% output$SITE)
# select columns in same order
output <- select(output, SITE, everything())
output <- arrange(output, SITE)
test_data <- arrange(test_data, SITE)
output <- output %>% pivot_longer(-SITE, names_to = "SITES", values_to = "count")
output <- output %>% pivot_wider(names_from = SITE, values_from = "count")
test_data <- test_data %>% pivot_longer(-SITE, names_to = "SITES", values_to = "count")
test_data <- test_data %>% pivot_wider(names_from = SITE, values_from = "count")
# check differences!
test_data <- type.convert(test_data, as.is = TRUE)
output <- type.convert(output, as.is = TRUE)
test <- data.frame(select_if(test_data, is.numeric))
test2 <- data.frame(select_if(output, is.numeric))
test3 <- 100 / (test + 1) * (test2 + 1) - 100
# check end groups don't differ on average more than 1.5% - (Sampling error?)
# this is not a very good test as it takes the mean! but Ralph happy that results match
# expect_true(mean(t(test3)) < 0.686)
# changes to set.seed created higher difference:
expect_true(mean(t(test3)) < 10.82496)
# write.csv(test_data, file = "testing-data-from-ralph.csv")
# write.csv(output, file = "r-output.csv")
# write.csv(results, file = "r-output-standard.csv")
})
### --------------------------------------------------------------------------------------------
test_that("Single year: Only return results for seasons provided", {
# Remove specific seasons completely:
remove_cols <- grep("Sum_TL2|Spr_TL2", names(demo_observed_values))
demo_observed_values[, remove_cols] <- NA
test <- rict(demo_observed_values, year_type = "single", seed = FALSE)
expect_equal(all(is.na(test$M_NTAXA_spr)), TRUE)
expect_equal(all(is.na(test$M_NTAXA_sum)), TRUE)
expect_equal(all(is.na(test$M_NTAXA_aut)), FALSE)
# Remove seasons in certain rows:
demo_observed_values <- rict::demo_observed_values
remove_cols <- grep("Sum_TL2|Spr_TL2", names(demo_observed_values))
demo_observed_values[1:2, remove_cols] <- NA
remove_cols <- grep("Sum_TL2", names(demo_observed_values))
demo_observed_values[5:7, remove_cols] <- NA
test <- rict(demo_observed_values, year_type = "single", seed = FALSE)
expect_equal(all(is.na(test$M_NTAXA_spr[1])), TRUE)
expect_equal(all(is.na(test$M_NTAXA_spr[3])), FALSE)
expect_equal(all(is.na(test$M_NTAXA_sum[5])), TRUE)
expect_equal(all(is.na(test$M_NTAXA_sum[8])), FALSE)
# Remove summer from GIS:
demo_gis_values_log <- rict::demo_gis_values_log
remove_cols <- grep("Sum_TL2_", names(demo_gis_values_log))
demo_gis_values_log[1:2, remove_cols] <- NA
remove_cols <- grep("Sum_Season_ID|Sum_Ntaxa_Bias", names(demo_gis_values_log))
demo_gis_values_log[1:2, remove_cols] <- NA
prediction <- rict_predict(demo_gis_values_log)
test <- rict(demo_gis_values_log, year_type = "single", seed = FALSE)
# Only summer from GIS:
demo_gis_values_log <- rict::demo_gis_values_log
remove_cols <- grep("Spr_TL2_|Aut_TL2_", names(demo_gis_values_log))
demo_gis_values_log[1:2, remove_cols] <- NA
remove_cols <- grep("Aut_Season_ID|Aut_Ntaxa_Bias|Spr_Season_ID|Spr_Ntaxa_Bias", names(demo_gis_values_log))
demo_gis_values_log[1:2, remove_cols] <- NA
test <- rict(demo_gis_values_log, year_type = "single", seed = FALSE)
test <- rict(demo_gis_values_log[1, ], year_type = "single", seed = FALSE)
})
test_that("Single year: Summer only", {
data <- utils::read.csv(system.file("extdat",
"input-file-single-year-gb.csv",
package = "rict"
), check.names = FALSE)
classification <- rict(data, year_type = "single", seed = TRUE)
verfied_classification <- utils::read.csv(system.file("extdat",
"rict-summer-single-year-gb.csv",
package = "rict"
), check.names = FALSE)
expect_equal(
sum(as.numeric(as.character(classification$H_NTAXA_sum))) -
sum(verfied_classification$H_NTAXA_sum),
1.26
)
# changed from -133.48(beta RICT3) or -138.52 (azure) due to set.seed changes
# and error in using spring instead of summer predictions
expect_equal(
as.character(classification$mintawhpt_sum_mostProb),
as.character(verfied_classification$mostProb_MINTA)
)
})
### --------------------------------------------------------------------------------------------
test_that("Test single row of multi-year input works", {
# Data contains single year / single row sites at start and end of input file
single_row_test <- utils::read.csv(system.file("extdat",
"test-data-single-site-multi-year.csv",
package = "rict"
), check.names = FALSE)
# Run data through multi-year classification and check output is created for all sites
sites <- unique(single_row_test$SITE)
check <- rict(single_row_test, seed = FALSE)
expect_equal(sort(as.character(unique(check$SITE))), sort(as.character(sites)))
# Test a single row input also works
check <- rict(single_row_test[1, ], seed = FALSE)
# Quick test to see it return a value
expect_gte(as.numeric(as.character(check$H_NTAXA_spr_aut)), 0)
})
test_that("NI classification", {
classification <- rict(demo_ni_observed_values,
year_type = "single",
crs = 29903, seed = FALSE
)
verfied_classification <- utils::read.csv(system.file("extdat",
"validation-classification-ni-single-year.csv",
package = "rict"
), check.names = FALSE)
classification <- classification[, names(classification) %in% names(verfied_classification)]
verfied_classification <- verfied_classification[, names(verfied_classification) %in% names(classification)]
classification <- type.convert(classification, as.is = TRUE)
verfied_classification <- type.convert(verfied_classification, as.is = TRUE)
# Not exact match because of difference in randomness due to global set.seed implementation
# the single-year classification loops through all seasons in the package (including summer)
# which means the set.seed is slightly different after looping through summer etc
# if you remove summer from the loop it gives the same answer.
# however these status classes do still match for spring:
expect_equal(classification$mostProb_NTAXA_spr, verfied_classification$mostProb_NTAXA_spr)
})
test_that("test reproducibility", {
# Are results the same no matter what order etc
test <- demo_observed_values[1:3, ]
test <- rbind(demo_observed_values[4:6, ], test)
# Change the order - switch first and second site/multi-year around
test1 <- rict(demo_observed_values[1:3, ], seed = FALSE)
test2 <- rict(test, seed = FALSE)
# First results from test1 should match second result from test2
expect_equal(as.numeric(as.character(test1$H_NTAXA_spr_aut)), as.numeric(as.character(test2$H_NTAXA_spr_aut[2])))
})
test_that("missing observations in multi-year return NA", {
test <- demo_observed_values
test$`Aut_TL2_WHPT_ASPT (AbW,DistFam)` <- NA
test$`Aut_TL2_WHPT_NTaxa (AbW,DistFam)` <- NA
test <- rict(test, seed = FALSE)
expect_equal(length(test[is.na(test)]), 200)
})
test_that("NI summer", {
classification <- rict(demo_ni_observed_values,
year_type = "single",
crs = 29903,
seed = FALSE
)
azure_classification <- utils::read.csv(
system.file("extdat",
"validation-classification-ni-single-year-summer.csv",
package = "rict"
),
check.names = FALSE, stringsAsFactors = FALSE
)
expect_equal(
classification$mostProb_NTAXA_sum[c(1:15, 17:20, 22:24)],
azure_classification$mostProb_NTAXA_sum[c(1:15, 17:20, 22:24)]
)
expect_equal(sum(classification$eqr_av_sum_aspt -
azure_classification$eqr_av_sum_aspt), -0.09886847)
})
test_that("IoM classify", {
# test one site for speed
test <- rict(demo_iom_observed_values[1, ], seed = FALSE)
# compare to output 2023-02-26
valid <- data.frame(
"SITE" = "TEST-01-R",
"YEAR" = 2016,
"WATERBODY" = "Waterbody name",
"E_NTAXA_spr_aut" = "100",
"G_NTAXA_spr_aut" = "0",
"M_NTAXA_spr_aut" = "0",
"P_NTAXA_spr_aut" = "0",
"B_NTAXA_spr_aut" = "0",
"mostProb_NTAXA_spr_aut" = "Excellent",
"NTAXA_aver_spr_aut" = 1.338453,
"E_ASPT_spr_aut" = "86.02",
"G_ASPT_spr_aut" = "13.41",
"M_ASPT_spr_aut" = "0.57",
"P_ASPT_spr_aut" = "0",
"B_ASPT_spr_aut" = "0",
"mostProb_ASPT_spr_aut" = "Excellent",
"ASPT_aver_spr_aut" = 1.037458,
"mintawhpt_spr_aut_E_MINTA_" = "86.02",
"mintawhpt_spr_aut_G_MINTA_" = "13.41",
"mintawhpt_spr_aut_M_MINTA_" = "0.57",
"mintawhpt_spr_aut_P_MINTA_" = "0",
"mintawhpt_spr_aut_B_MINTA_" = "0",
"mintawhpt_spr_aut_mostProb_MINTA_" = "Excellent"
)
test$NTAXA_aver_spr_aut <- round(test$NTAXA_aver_spr_aut, 6)
test$ASPT_aver_spr_aut <- round(test$ASPT_aver_spr_aut, 6)
row.names(valid) <- NULL
row.names(test) <- NULL
expect_equal(test[1, 1:23], valid)
})
test_that("IoM classify all seasons", {
# Input file used for fortran version
iom_fortran_input <- utils::read.csv(
system.file("extdat",
"input-file-to-test-iom-against-fortran-outputs.csv",
package = "rict"
), check.names = FALSE)
# Test results file from fortran version
iom_test_results <- utils::read.csv(
system.file("extdat",
"test-all-seasons-iom-090723.csv",
package = "rict"
), check.names = FALSE)
test <- rict(iom_fortran_input[1:5, ], seed = TRUE, year_type = "multi")
# Test against expected values from fortran outputs
# Slight rounding error in compared to iom_test_results, replace 0.94 with 0.95
# due to spreadsheet rounding rules.
testthat::expect_equal(
round(test$all_seasons_ntaxa_EQR, 2),
c(0.95, round(as.numeric(iom_test_results[108, 3:6]), 2))
)
# Test probability of class
# Expect slight difference due to random noise
testthat::expect_equal(
sum(round(as.numeric(test$all_seasons_ntaxa_E[1:5]), 0)) -
sum(c(round(as.numeric(iom_test_results[109, 2:6]), 0))),
1
)
# Test summer and autumn seasons work
sum_autumn_input <- dplyr::select(iom_fortran_input, -starts_with("Spr"))
sum_autumn_test <- rict(sum_autumn_input[1:5, ],
seed = TRUE,
year_type = "multi")
# Test against expected values from fortran ntaxa outputs
testthat::expect_equal(
round(sum_autumn_test$all_seasons_ntaxa_EQR, 2),
c(round(as.numeric(iom_test_results[92, 2:6]), 2))
)
# Test against expected values from fortran aspt outputs
# Slight rounding error in compared to iom_test_results, replace 0.90 with 0.89
# due to spreadsheet rounding rules.
testthat::expect_equal(
round(sum_autumn_test$all_seasons_aspt_EQR, 2),
c(0.89, round(as.numeric(iom_test_results[92, 30:33]), 2))
)
# Test single-year classification
single_year_test <- rict(iom_fortran_input[1:5, ],
seed = TRUE,
year_type = "single")
# Test against expected values from fortran outputs
# Slight rounding error in compared to iom_test_results, replace 0.94 with 0.95
# due to spreadsheet rounding rules.
testthat::expect_equal(
round(single_year_test$all_seasons_ntaxa_EQR, 2),
c(0.95, round(as.numeric(iom_test_results[108, 3:6]), 2)))
})
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.