resolve failing check

HannaMeyer · Mar 12, 2024 · 2ac4f11 · 2ac4f11
1 parent ac77608
commit 2ac4f11
Show file tree

Hide file tree

Showing 3 changed files with 33 additions and 20 deletions.
diff --git a/R/geodist.R b/R/geodist.R
@@ -188,7 +188,7 @@ geodist <- function(x,
     }
   }
   if (type=="time" & is.null(timevar)){
-    timevar <- names(which(sapply(x, is.Date)))
+    timevar <- names(which(sapply(x, lubridate::is.Date)))
     message("time variable that has been selected: ",timevar)
   }
   if (type=="time"&time_unit=="auto"){
@@ -391,10 +391,6 @@ sample2test <- function(x, testdata, type,variables,time_unit,timevar){
                              what = "test-to-sample",
                              dist_type = "feature")
   }else if (type=="time"){
-    if (is.null(timevar)){
-      timevar <- names(which(sapply(testdata, is.Date)))
-    }
-
     min_d0 <- c()
     for (i in 1:nrow(testdata)){
       min_d0[i] <- min(abs(difftime(sf::st_drop_geometry(testdata)[i,timevar],

diff --git a/tests/testthat/test-geodist.R b/tests/testthat/test-geodist.R
@@ -233,8 +233,8 @@ expect_equal(mean_sample2sample, 0.02)
 expect_equal(mean_prediction_to_sample, 194.7656)
 
 dist <- CAST::geodist(trainDat,preddata = predictionDat,type="time",time_unit="hours")
-mean_prediction_to_sample <- round(mean(dist[dist$what=="prediction-to-sample","dist"]), 4)
-expect_equal(mean_prediction_to_sample, 4674.375)
+mean_prediction_to_sample <- round(mean(dist[dist$what=="prediction-to-sample","dist"]), 2)
+expect_equal(mean_prediction_to_sample, 4674.37)
 
 })
 

diff --git a/vignettes/cast02-AOA-tutorial.R b/vignettes/cast02-AOA-tutorial.R
@@ -91,17 +91,18 @@ truediff <- abs(prediction-response)
 plot(rast(list(prediction,response)),main=c("prediction","reference"))
 
 ## ----message = FALSE, warning=FALSE-------------------------------------------
-AOA <- aoa(predictors, model)
+AOA <- aoa(predictors, model, LPD = TRUE, verbose = FALSE)
 class(AOA)
 names(AOA)
 print(AOA)
 
 ## ----message = FALSE, warning=FALSE-------------------------------------------
 plot(AOA)
 
-## ----message = FALSE, warning=FALSE,  fig.show="hold", out.width="30%"--------
+## ----message = FALSE, warning=FALSE,  fig.show="hold", out.width="50%"--------
 plot(truediff,col=viridis(100),main="true prediction error")
 plot(AOA$DI,col=viridis(100),main="DI")
+plot(AOA$LPD,col=viridis(100),main="LPD")
 plot(prediction, col=viridis(100),main="prediction for AOA")
 plot(AOA$AOA,col=c("grey","transparent"),add=T,plg=list(x="topleft",box.col="black",bty="o",title="AOA"))
 
@@ -144,20 +145,21 @@ model <- train(trainDat[,names(predictors)],
 prediction <- predict(predictors,model,na.rm=TRUE)
 
 ## ----message = FALSE, warning=FALSE-------------------------------------------
-AOA_spatial <- aoa(predictors, model)
+AOA_spatial <- aoa(predictors, model, LPD = TRUE, verbose = FALSE)
 
-AOA_random <- aoa(predictors, model_random)
+AOA_random <- aoa(predictors, model_random, LPD = TRUE, verbose = FALSE)
 
 ## ----message = FALSE, warning=FALSE,  fig.show="hold", out.width="50%"--------
 plot(AOA_spatial$DI,col=viridis(100),main="DI")
+plot(AOA_spatial$LPD,col=viridis(100),main="LPD")
 plot(prediction, col=viridis(100),main="prediction for AOA \n(spatial CV error applies)")
 plot(AOA_spatial$AOA,col=c("grey","transparent"),add=TRUE,plg=list(x="topleft",box.col="black",bty="o",title="AOA"))
 plot(prediction_random, col=viridis(100),main="prediction for AOA \n(random CV error applies)")
 plot(AOA_random$AOA,col=c("grey","transparent"),add=TRUE,plg=list(x="topleft",box.col="black",bty="o",title="AOA"))
 
 ## ----message = FALSE, warning=FALSE-------------------------------------------
-grid.arrange(plot(AOA_spatial) + ggplot2::ggtitle("Spatial CV"),
-             plot(AOA_random) + ggplot2::ggtitle("Random CV"), ncol = 2)
+grid.arrange(plot(AOA_spatial, variable = "DI") + ggplot2::ggtitle("Spatial CV"),
+             plot(AOA_random, variable = "DI") + ggplot2::ggtitle("Random CV"), ncol = 2)
 
 ## ----message = FALSE, warning=FALSE-------------------------------------------
 ###for the spatial CV:
@@ -176,17 +178,29 @@ model_random$results
 
 ## ----message = FALSE, warning=FALSE-------------------------------------------
 DI_RMSE_relation <- errorProfiles(model, AOA_spatial$parameters, multiCV=TRUE,
-                                    window.size = 5, length.out = 5)
+                                    window.size = 5, length.out = 5, variable = "DI")
 plot(DI_RMSE_relation)
 
-expected_RMSE = terra::predict(AOA_spatial$DI, DI_RMSE_relation)
+LPD_RMSE_relation <- errorProfiles(model, AOA_spatial$parameters, multiCV=TRUE,
+                                    window.size = 5, length.out = 5, variable = "LPD")
+plot(LPD_RMSE_relation)
+
+DI_expected_RMSE = terra::predict(AOA_spatial$DI, DI_RMSE_relation)
+LPD_expected_RMSE = terra::predict(AOA_spatial$LPD, LPD_RMSE_relation)
 
 # account for multiCV changing the DI threshold
-updated_AOA = AOA_spatial$DI > attr(DI_RMSE_relation, "AOA_threshold")
+DI_updated_AOA = AOA_spatial$DI > attr(DI_RMSE_relation, "AOA_threshold")
+
+# account for multiCV changing the DI threshold
+LPD_updated_AOA = AOA_spatial$DI > attr(LPD_RMSE_relation, "AOA_threshold")
+
 
 
-plot(expected_RMSE,col=viridis(100),main="expected RMSE")
-plot(updated_AOA, col=c("grey","transparent"),add=TRUE,plg=list(x="topleft",box.col="black",bty="o",title="AOA"))
+plot(DI_expected_RMSE,col=viridis(100),main="DI expected RMSE")
+plot(DI_updated_AOA, col=c("grey","transparent"),add=TRUE,plg=list(x="topleft",box.col="black",bty="o",title="AOA"))
+
+plot(LPD_expected_RMSE,col=viridis(100),main="LPD expected RMSE")
+plot(LPD_updated_AOA, col=c("grey","transparent"),add=TRUE,plg=list(x="topleft",box.col="black",bty="o",title="AOA"))
 
 ## ----message = FALSE, warning=FALSE-------------------------------------------
 dat <- readRDS(system.file("extdata","Cookfarm.RDS",package="CAST"))
@@ -220,13 +234,16 @@ plot(stretch(studyArea[[predictors]]))
 #prediction:
 prediction <- predict(studyArea,model,na.rm=TRUE)
 
-## ----message = FALSE, warning=FALSE,  fig.show="hold", out.width="50%"--------
-AOA <- aoa(studyArea,model)
+## ----message = FALSE, warning=FALSE,  fig.show="hold", out.width="30%"--------
+AOA <- aoa(studyArea, model, LPD = TRUE, verbose = FALSE)
 
 #### Plot results:
 plot(AOA$DI,col=viridis(100),main="DI with sampling locations (red)")
 plot(pts,zcol="ID",col="red",add=TRUE)
 
+plot(AOA$LPD,col=viridis(100),main="LPD with sampling locations (red)")
+plot(pts,zcol="ID",col="red",add=TRUE)
+
 plot(prediction, col=viridis(100),main="prediction for AOA \n(LOOCV error applies)")
 plot(AOA$AOA,col=c("grey","transparent"),add=TRUE,plg=list(x="topleft",box.col="black",bty="o",title="AOA"))