From 600768c8eba6d3018384296bb3f5e30c2152c980 Mon Sep 17 00:00:00 2001
From: mitchellmanware <memanware@gmail.com>
Date: Thu, 2 Nov 2023 08:10:16 -0400
Subject: [PATCH] tests for time range

---
 tests/testdata/test_nc_output.nc        | Bin 16792 -> 17788 bytes
 tests/testthat/test-time-range-points.R |  30 ++++++++++++++++++++++++
 tests/testthat/test-time-range-raster.R |  30 ++++++++++++++++++++++++
 3 files changed, 60 insertions(+)
 create mode 100644 tests/testthat/test-time-range-points.R
 create mode 100644 tests/testthat/test-time-range-raster.R

diff --git a/tests/testdata/test_nc_output.nc b/tests/testdata/test_nc_output.nc
index 0b264f61ca9fd08ba147198c5af0bd97a807bcc1..b810cc5457d18337785c480efa052c529db3655d 100644
GIT binary patch
delta 4637
zcmc&$OK%%h6t+#`5~m|Y#Zi+M$N&uuh$Qzpj|hoIjoMA27A>$$t=Lj4@>1idEGikq
z4zXx^H*Apl16V|a1!9Hz3$p5x#|nM|LM-^s%-nnJ%Ctm^8&`2hXU;v3?|kRG{^rZ_
zKVOw6F0NcEm-0^y|GjX3;*)aSG+vy3X{Fg|uWmFyTfK9u)wxM7wfi?e?QUM*ZHHIa
zIw6xGOO~Wuk}MQV$ffY|%JP-);_WsL&V`E~Z>{fcw09Oanwxi;x7!=-#ScEbKEK?U
ze}AjhUSI6AcRD-ScdOZHW)G{IYpYwko$cMu!sgmL;ljc~_*PchIKJucRHtnok4)}g
zE&p1n1bc>!JgNpi;Kii5H!^90(QhlkkLJ74?<=SNG&ib$pc6JeGgc{;PX1LYO--5Y
z6TehuC(z#CmA5bKUm2^ED~sFvjas!_RSywo&NRkm%@^apSJDGG=ODn24}xT$iut-a
zGhVxNtG(U|2_y4Ub$N6odzu(OYi3T&m1{O_^=_&3UTME|@@}pE(Y4Fh=A{-|B`l5^
z7x;T{y57z0k<c*25s#!~Jhv&qm4L6348GPT8QHW{+S?+|V3RRd&W13QM<qReQZe!q
zsSwUDP+X>D<Q#F$!RdOd$fOVu6-kZ!HoHnP8`AiS@LrK0<Gv!Td4!-mMM8U4!-Z^!
z$hdhpTepzFg<9g0b9ymVH{ndZkyoLGKqtT}MXVx{7LsY$r0`Yr<7&^w8CF0H8G*G;
zC>eDTYbGKj+@7{W(5Qe@V5t-nMG(oefk|Xz(%J;7LB(1ot|%$sfB`b?V9>yhAOw;Q
zLRhkfFoeYA2o#DT3>8hwTsUJZiiiP}iDR^Jo;^a>z$+t)%?=wmM3}3~G>B4>h!h4B
zNf6D&lbn%_bLnUy1569;B#g<3X)|%wRs_0GgcySXczH!iD9jYNMcNZk=nPAZQoWxB
zN8qPHIeS(~j1w4XUpY|71|$+Bw|;>_cR0*a;-mS^SEQNFO65Hh5>y_Xu>&>&DyCv$
z;tq?7Ne-k^OoS%P9hO+mj0GSsI9i+yP#+BfGv-W~y_YRU;1MIzN)X9&hBJx^6J8Y&
z;OA_qvkl^)w<+(JpY5#(1a?MYK7XaBq709W#h%$DIaH;`NRloUwn2VAdp>aqcW=w&
z3OPVfixJj`K+lZQG+wRGx%&NHS?|7GGe3vUS*27yNFp3@WIsc}2htRh4x3@%Y@d+d
zx~s+`EP65zTB4)LY;L^n1*une4xPQ|0ZRkmAu0;H-7m1%MS8)32q%Qhz1JKwc#6&;
zV<gs=+3=(7f#kXUgTRtXrz-Uq3T&81!k~g)2XVpCjziOX&L$AMIF+2F-!cP7$x%~4
zL1+{gkCs>p1Y{BR*?JFF=Dc6rg*|?Xy3qnl>C`%t0i+>)Aavc(V~sXbk&<K^_J+fR
zRuoZ0)T8Apg}B8DE@iI@hzLv)4n=bnpnSp!7nV~~trc-SfdF}o@d!Cf5yEvD1-L`$
zFic4D;G8WeVhN^$f)annMl8jcC;%3$fC;w`X=H+1-wh;!tP7l#DetwRGjvYZfIEx+
zC^w=yTYxig#20>HaC303ZnodFgNgt@{v|-hK@y=v*if2}OlJWn6dBF2V*I_fqJsb4
zt9Oe-gLyfCZ%<OoO}tNyKm}^2czImu&EEMl`;X2)p6&u2aDnks>6uR$dEs|-Pu)E6
z(FHtYyzUTsI!p;&hV6M8tYCQo`cR&_+1!T``hP|44z;^ym(V5AdkVl%`Qq(xp1QPl
z5b`3)^LV0PjyXl~1pa3r^%<X|t$SRFi@c<N$5}$5e}hWE%~=e>KjA7bY)ACu^>08x
P`jwEU8`{$tv!VY5PawCI

delta 3367
zcmdT`&ubl36n<~8uk|H`CqzwR+D;pPLQU@PI}=<)8tg_f(3URS5`z`>rS!dk3l{-*
zx=DLoxG0jPAVTo1g>Kxbbm_uH`~!rn#f9IQA9v>7rv*V52HH&K-1D7tzVn@P=Z{aj
zUwqOXT-tb}+bMtg_?6rnT<<R4`~3Y|*WcP1rf+YJQzlZb)}&cuJQYmHwe<4F>u;u)
z?rz^2Z@-+bUK?%S9j%UbhVQ;7RyTIGc0b%6jz_EG?a}zgaO=j-?)c8`cxAYCF<n_%
zNnfE@Gx*n^eAN9tNoL=1gOks?&z|@?nZ50fPt3c`6JI8?AK>xZ-ct{7aLFCaJng>g
z{nYKaz1ef8lTK&wOQ-Y953ns1wjWP^-+SpR{JC8G`OT?clZ!u3_Mc3;J#h-JUo2nu
ze@kpOc`(!OCa>L|9G?ET--8i9?$N?r{kT5w9|zCPt(6C^UAcVaRjCA5f?2C1vy6up
z$;hIm(zV6y&(B>A4oS%}a?hGW6|hu{!6I@YYWK>bxXj7IIq*v~cN7CFD=o7|YGfAX
zrLw}J7>_f?Sw%jKHyN{qxirXF!;a`2&^55zTMiFt#wa(-CFjkdhS0sU(Rm?2gtaW^
zxj(<T<XJ~Af+V!C1-D?hNdjF84@pLaTFr#<py{FqJzff1sU=s`3n>L>vR$*r8)BSm
znR%o;i(xA@s3yiie8f237uBJa8504pLUzQsYTEA}M!<#?M$tJ(ciQd-9R$sW0@itz
z8i9ol8%W0|<DlI@d`1{$$lY-K3V<bNWZ_&!;*)4UXEtL@8m3DhcQXQpKnd7t(J)_+
zi-K&xvC+_9JERgCS|OiiklbMmtfYWWjM7b6^-$=d*&;(;A+Q1q0A_hJ3HO&mCcwTf
zs^U|v7gPhhp^Ok0#Zj)7p&n)`CZO4XVhEK+ihAe!P$mpZp*GA>)H{tDsH;#DujS$n
zVqkdD#7GJJNUWSuNEmRSO)&)CSn?`kOhK42Mwa>jcg0lXPMV^SamMiRmP+7m{mc|_
z!DKOB;S@-Yc`krsj@y<Rcz+tW)RY8DoN=+75fXzE)zVlh`rOf($1H>?_jpyfhv)oi
zVbOm3tEqto>-z=k(?6c|kKz8S547$gw61>Jij65x+ok>|vG1Svq5qXE2C2uJzDuwf
zFn)q#^sC8sxIpUCZ>EvXcn$$$Puu1$sYg!IR<qdV(T>mvfsxBq-rB>5X(R`sVa34n
zc&lMzvDs}ddFxJm<eLhzf{tj3F+_&UVB6FcfyU?%4F$@^_k%yQIfYa#CS=|0Ez)6x
zWHrjpMXsC6^5A^LTJZscaHcs_v8HnDYMbFp$MauV5EZOt+_uU-j)AqJJ(poy`m4Qm
z&*=*%2a2bmw4gh*TB(mdq+7obW^7o71|#FF`C6&nbGjt}j2RE^0)vH$kQqL=nu~lt
z21Xar=UmXW7`cN9$_wzZC8K))|8Z||M;E+E)8|7i8CrOhNDeWCF;EXIsGy1N*mCGj
zQP6o@P2eeT|3}jve93AQ^|#Y8C4Bcdd6%EW#n!ENYimJ)i$I_MkCdx*Ga0;ayznQ@
C#4;BE

diff --git a/tests/testthat/test-time-range-points.R b/tests/testthat/test-time-range-points.R
new file mode 100644
index 00000000..de1bdab4
--- /dev/null
+++ b/tests/testthat/test-time-range-points.R
@@ -0,0 +1,30 @@
+#' @author Mitchell Manware
+#' @description
+#' unit test for model output is within desired temporal range
+#' (2018 - 2022 inclusive).
+#' assumes `test_nc_output.nc` is point data.
+test_that("Output times are within temporal range", {
+  # 1. import model output
+  path_results <- "./testdata/test_nc_output.nc"
+  model_results <- terra::vect(path_results)
+  # 2. function
+  check_temporal_range <- function(
+    model_output = model_results,
+    start_range = "2018-01-01",
+    end_range = "2022-12-31"
+  ) {
+    # change character inputs to dates
+    start_date <- lubridate::as_datetime(start_range)
+    end_date <- lubridate::as_datetime(end_range)
+    # create sequence of dates
+    range <- seq(start_date, end_date, 86400)
+    # assign date values to variable
+    dates <- lubridate::as_datetime(model_results$Date)
+    # check that dates are within range
+    checked <- as.vector(dates %in% range)
+    return(checked)
+  }
+  iswithin <- check_temporal_range()
+  # expect all elements == TRUE
+  expect_equal(any(iswithin), TRUE)
+})
diff --git a/tests/testthat/test-time-range-raster.R b/tests/testthat/test-time-range-raster.R
new file mode 100644
index 00000000..ca20b1e3
--- /dev/null
+++ b/tests/testthat/test-time-range-raster.R
@@ -0,0 +1,30 @@
+#' @author Mitchell Manware
+#' @description
+#' unit test for model output is within desired temporal range
+#' (2018 - 2022 inclusive).
+#' assumes `test_nc_output.nc` is raster data.
+test_that("Output times are within temporal range", {
+  # 1. import model output
+  path_results <- "./testdata/test_nc_output.nc"
+  model_results <- terra::rast(path_results)
+  # 2. function
+  check_temporal_range <- function(
+    model_output = model_results,
+    start_range = "2018-01-01",
+    end_range = "2022-12-31"
+  ) {
+    # change character inputs to dates
+    start_date <- lubridate::as_datetime(start_range)
+    end_date <- lubridate::as_datetime(end_range)
+    # create sequence of dates
+    range <- seq(start_date, end_date, 86400)
+    # assign date values to variable
+    dates <- lubridate::as_datetime(model_output@ptr$time)
+    # check that dates are within range
+    checked <- as.vector(dates %in% range)
+    return(checked)
+  }
+  iswithin <- check_temporal_range()
+  # expect all elements == TRUE
+  expect_equal(any(iswithin), TRUE)
+})