From a52b89b22103dd875f35b4ae71aed0e7fda202db Mon Sep 17 00:00:00 2001
From: HannaMeyer <hanna.meyer@uni-muenster.de>
Date: Tue, 12 Mar 2024 16:24:30 +0100
Subject: [PATCH] tests and improved example for geodist with time

---
 R/geodist.R                   |  7 ++++--
 man/geodist.Rd                |  7 ++++--
 tests/testthat/test-geodist.R | 43 +++++++++++++++++++++++++++++++++++
 3 files changed, 53 insertions(+), 4 deletions(-)

diff --git a/R/geodist.R b/R/geodist.R
index beaa2995..4931010b 100644
--- a/R/geodist.R
+++ b/R/geodist.R
@@ -81,8 +81,11 @@
 #' st_crs(dat) <- 26911
 #' trainDat <- dat[dat$altitude==-0.3&year(dat$Date)==2010,]
 #' predictionDat <- dat[dat$altitude==-0.3&year(dat$Date)==2011,]
-#' dist <- geodist(trainDat,preddata = predictionDat,type="time",time_unit="days")
-#' plot(dist)+ scale_x_log10(labels=round)
+#' cvfolds <- CreateSpacetimeFolds(trainDat,timevar = "week")
+#'
+#' dist <- geodist(trainDat,preddata = predictionDat,cvfolds = cvfolds$indexOut,type="time",time_unit="days")
+#' plot(dist)+ xlim(0,10)
+#'
 #'
 #' ############ Example for a random global dataset
 #' ############ (refer to figure in Meyer and Pebesma 2022)
diff --git a/man/geodist.Rd b/man/geodist.Rd
index 390b111f..b00fb81a 100644
--- a/man/geodist.Rd
+++ b/man/geodist.Rd
@@ -118,8 +118,11 @@ dat <- st_as_sf(dat,coords=c("Easting","Northing"))
 st_crs(dat) <- 26911
 trainDat <- dat[dat$altitude==-0.3&year(dat$Date)==2010,]
 predictionDat <- dat[dat$altitude==-0.3&year(dat$Date)==2011,]
-dist <- geodist(trainDat,preddata = predictionDat,type="time",time_unit="days")
-plot(dist)+ scale_x_log10(labels=round)
+cvfolds <- CreateSpacetimeFolds(trainDat,timevar = "week")
+
+dist <- geodist(trainDat,preddata = predictionDat,cvfolds = cvfolds$indexOut,type="time",time_unit="days")
+plot(dist)+ xlim(0,10)
+
 
 ############ Example for a random global dataset
 ############ (refer to figure in Meyer and Pebesma 2022)
diff --git a/tests/testthat/test-geodist.R b/tests/testthat/test-geodist.R
index 2f505179..283a3f95 100644
--- a/tests/testthat/test-geodist.R
+++ b/tests/testthat/test-geodist.R
@@ -215,3 +215,46 @@ test_that("geodist works with points and test data in feature space", {
 
 
 })
+
+
+test_that("geodist works in temporal space", {
+
+dat <- readRDS(system.file("extdata","Cookfarm.RDS",package="CAST"))
+dat <- sf::st_as_sf(dat,coords=c("Easting","Northing"))
+sf::st_crs(dat) <- 26911
+trainDat <- dat[dat$altitude==-0.3&year(dat$Date)==2010,]
+predictionDat <- dat[dat$altitude==-0.3&year(dat$Date)==2011,]
+dist <- CAST::geodist(trainDat,preddata = predictionDat,type="time",time_unit="days")
+
+mean_sample2sample <- round(mean(dist[dist$what=="sample-to-sample","dist"]), 4)
+mean_prediction_to_sample <- round(mean(dist[dist$what=="prediction-to-sample","dist"]), 4)
+
+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)
+
+})
+
+test_that("geodist works in temporal space and with CV", {
+  dat <- readRDS(system.file("extdata","Cookfarm.RDS",package="CAST"))
+  dat <- sf::st_as_sf(dat,coords=c("Easting","Northing"))
+  sf::st_crs(dat) <- 26911
+  trainDat <- dat[dat$altitude==-0.3&lubridate::year(dat$Date)==2010,]
+  predictionDat <- dat[dat$altitude==-0.3&lubridate::year(dat$Date)==2011,]
+  trainDat$week <- lubridate::week(trainDat$Date)
+  set.seed(100)
+  cvfolds <- CreateSpacetimeFolds(trainDat,timevar = "week")
+
+  dist <- CAST::geodist(trainDat,preddata = predictionDat,cvfolds = cvfolds$indexOut,
+                        type="time",time_unit="days")
+
+  mean_cv <- round(mean(dist[dist$what=="CV-distances","dist"]), 4)
+
+    expect_equal(mean_cv,  2.4048)
+}
+)
+
+