From 8f2f3d603df29a5a191600b9faac38f1d2381e26 Mon Sep 17 00:00:00 2001 From: fab-scm Date: Mon, 11 Mar 2024 12:01:22 +0100 Subject: [PATCH] test for 'aoa' and 'trainLPD' --- tests/testthat/test-aoa.R | 81 +++++++++++++++++++++++++++++++++++ tests/testthat/test_trainDI.R | 56 ++++++++++++++++++++++++ 2 files changed, 137 insertions(+) diff --git a/tests/testthat/test-aoa.R b/tests/testthat/test-aoa.R index 206982e1..4ce51728 100644 --- a/tests/testthat/test-aoa.R +++ b/tests/testthat/test-aoa.R @@ -1,3 +1,32 @@ +loaddata <- function() { + # prepare sample data: + dat <- readRDS(system.file("extdata","Cookfarm.RDS",package="CAST")) + dat <- aggregate(dat[,c("VW","Easting","Northing")],by=list(as.character(dat$SOURCEID)),mean) + pts <- sf::st_as_sf(dat,coords=c("Easting","Northing")) + pts$ID <- 1:nrow(pts) + set.seed(100) + pts <- pts[1:30,] + studyArea <- terra::rast(system.file("extdata","predictors_2012-03-25.tif",package="CAST"))[[1:8]] + trainDat <- terra::extract(studyArea,pts,na.rm=FALSE) + trainDat <- merge(trainDat,pts,by.x="ID",by.y="ID") + + # train a model: + set.seed(100) + variables <- c("DEM","NDRE.Sd","TWI") + model <- train(trainDat[,which(names(trainDat)%in%variables)], + trainDat$VW, method="rf", importance=TRUE, tuneLength=1, + trControl=trainControl(method="cv",number=5,savePredictions=T)) + + + data <- list( + studyArea = studyArea, + trainDat = trainDat, + variables = variables, + model = model + ) + + return(data) +} test_that("AOA works in default: used with raster data and a trained model", { @@ -9,6 +38,13 @@ test_that("AOA works in default: used with raster data and a trained model", { expect_equal(as.numeric(round(AOA$parameters$threshold,5)), 0.38986) #test number of pixels within AOA: expect_equal(sum(values(AOA$AOA)==1,na.rm=TRUE), 2936) + # test trainDI + expect_equal(AOA$parameters$trainDI, c(0.09043580, 0.14046341, 0.16584582, 0.57617177, 0.26840303, + 0.14353894, 0.19768329, 0.24022059, 0.06832037, 0.29150668, + 0.18471625, 0.57617177, 0.12344463, 0.09043580, 0.14353894, + 0.26896008, 0.22713731, 0.24022059, 0.20388725, 0.06832037, + 0.23604264, 0.20388725, 0.91513568, 0.09558666, 0.14046341, + 0.16214832, 0.37107762, 0.16214832, 0.18471625, 0.12344463)) # test summary statistics of the DI expect_equal(as.vector(summary(values(AOA$DI))), c("Min. :0.0000 ", "1st Qu.:0.1329 ", "Median :0.2052 ", @@ -32,3 +68,48 @@ test_that("AOA works without a trained model", { "Max. :2.6631 ", "NA's :1993 ")) }) +test_that("AOA (including LPD) works with raster data and a trained model", { + dat <- loaddata() + # calculate the AOA of the trained model for the study area: + AOA <- aoa(dat$studyArea, dat$model, LPD = TRUE, maxLPD = 1) + + #test threshold: + expect_equal(as.numeric(round(AOA$parameters$threshold,5)), 0.38986) + #test number of pixels within AOA: + expect_equal(sum(values(AOA$AOA)==1,na.rm=TRUE), 2936) + #test trainLPD + expect_equal(AOA$parameters$trainLPD, c(3, 4, 6, 0, 7, + 6, 2, 1, 5, 3, + 4, 0, 1, 2, 6, + 5, 4, 4, 5, 7, + 3, 4, 0, 2, 3, + 6, 1, 7, 3, 2)) + # test summary statistics of the DI + expect_equal(as.vector(summary(values(AOA$DI))), + c("Min. :0.0000 ", "1st Qu.:0.1329 ", "Median :0.2052 ", + "Mean :0.2858 ", "3rd Qu.:0.3815 ", + "Max. :4.4485 ", "NA's :1993 ")) +}) + + +test_that("AOA (inluding LPD) works without a trained model", { + dat <- loaddata() + AOA <- aoa(dat$studyArea,train=dat$trainDat,variables=dat$variables, LPD = TRUE, maxLPD = 1) + + #test threshold: + expect_equal(as.numeric(round(AOA$parameters$threshold,5)), 0.52872) + #test number of pixels within AOA: + expect_equal(sum(values(AOA$AOA)==1,na.rm=TRUE), 3377) + # test trainLPD + expect_equal(AOA$parameters$trainLPD, c(7, 9, 12, 1, 12, + 12, 4, 2, 8, 10, + 6, 1, 3,4, 11, + 9, 9, 7, 5, 5, + 6, 5, 0, 5, 9, + 8, 4, 11, 3,2)) + # test summary statistics of the DI + expect_equal(as.vector(summary(values(AOA$DI))), + c("Min. :0.0000 ", "1st Qu.:0.1759 ", "Median :0.2642 ", + "Mean :0.3109 ", "3rd Qu.:0.4051 ", + "Max. :2.6631 ", "NA's :1993 ")) +}) diff --git a/tests/testthat/test_trainDI.R b/tests/testthat/test_trainDI.R index 92735a94..8a50b0c9 100644 --- a/tests/testthat/test_trainDI.R +++ b/tests/testthat/test_trainDI.R @@ -1,3 +1,33 @@ +loaddata <- function() { + # prepare sample data: + dat <- readRDS(system.file("extdata","Cookfarm.RDS",package="CAST")) + dat <- aggregate(dat[,c("VW","Easting","Northing")],by=list(as.character(dat$SOURCEID)),mean) + pts <- sf::st_as_sf(dat,coords=c("Easting","Northing")) + pts$ID <- 1:nrow(pts) + set.seed(100) + pts <- pts[1:30,] + studyArea <- terra::rast(system.file("extdata","predictors_2012-03-25.tif",package="CAST"))[[1:8]] + trainDat <- terra::extract(studyArea,pts,na.rm=FALSE) + trainDat <- merge(trainDat,pts,by.x="ID",by.y="ID") + + # train a model: + set.seed(100) + variables <- c("DEM","NDRE.Sd","TWI") + model <- train(trainDat[,which(names(trainDat)%in%variables)], + trainDat$VW, method="rf", importance=TRUE, tuneLength=1, + trControl=trainControl(method="cv",number=5,savePredictions=T)) + + + data <- list( + studyArea = studyArea, + trainDat = trainDat, + variables = variables, + model = model + ) + + return(data) +} + test_that("trainDI works in default for a trained model", { dat <- loaddata() #...then calculate the DI of the trained model: @@ -5,7 +35,33 @@ DI <- trainDI(model=dat$model) #test threshold: expect_equal(as.numeric(round(DI$threshold,5)), 0.38986) +# test trainDI +expect_equal(DI$trainDI, c(0.09043580, 0.14046341, 0.16584582, 0.57617177, 0.26840303, + 0.14353894, 0.19768329, 0.24022059, 0.06832037, 0.29150668, + 0.18471625, 0.57617177, 0.12344463, 0.09043580, 0.14353894, + 0.26896008, 0.22713731, 0.24022059, 0.20388725, 0.06832037, + 0.23604264, 0.20388725, 0.91513568, 0.09558666, 0.14046341, + 0.16214832, 0.37107762, 0.16214832, 0.18471625, 0.12344463)) # test summary statistics of the DI expect_equal(as.numeric(colMeans(DI$train)), c(795.4426351,4.0277978,0.2577245)) }) + +test_that("trainDI (with LPD = TRUE) works in default for a trained model", { + dat <- loaddata() + #...then calculate the DI of the trained model: + DI <- trainDI(model=dat$model, LPD = TRUE) + + #test threshold: + expect_equal(as.numeric(round(DI$threshold,5)), 0.38986) + #test trainLPD + expect_identical(DI$trainLPD, as.integer(c(3, 4, 6, 0, 7, + 6, 2, 1, 5, 3, + 4, 0, 1, 2, 6, + 5, 4, 4, 5, 7, + 3, 4, 0, 2, 3, + 6, 1, 7, 3, 2))) + # test summary statistics of the DI + expect_equal(as.numeric(colMeans(DI$train)), + c(795.4426351,4.0277978,0.2577245)) +})