Skip to content

Commit

Permalink
- Require at least 184 non-missing values.
Browse files Browse the repository at this point in the history
  • Loading branch information
@joethorley
joethorley committed Feb 3, 2024
1 parent 3088c86 commit e358186
Show file tree
Hide file tree
Showing 4 changed files with 33 additions and 28 deletions.
6 changes: 3 additions & 3 deletions R/gsdd-cf.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@
#' during the growing season based on the mean daily water temperature values.
#'
#' The GSDD is calculated across the longest consecutive sequence of non-missing
#' values which must be at least 180 elements in length otherwise a
#' values which must be at least 184 elements in length otherwise a
#' missing value is returned.
#' If the time series includes missing values it is recommended that they are
#' replaced by estimates of the actual values using linear
Expand Down Expand Up @@ -105,13 +105,13 @@ gsdd_cf <- function(x,
c("biggest", "smallest", "longest", "shortest", "first", "last", "all"))
chk_flag(quiet)

if(length(x) < 180) {
if(length(x) < 184) {
return(NA_real_)
}
if(anyNA(x)) {
x <- trim_na(x)
}
if(length(x) < 180 || anyNA(x)) {
if(length(x) < 184 || anyNA(x)) {
return(NA_real_)
}
# create rolling mean vector from x and window width
Expand Down
2 changes: 1 addition & 1 deletion man/gsdd_cf.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

28 changes: 14 additions & 14 deletions tests/testthat/_snaps/gsdd-cf.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
Code
tibble::tibble(index = 1:length(x), x = x, ma = ma)
Output
# A tibble: 180 x 3
# A tibble: 184 x 3
index x ma
<int> <dbl> <dbl>
1 1 -5 NA
Expand All @@ -16,14 +16,14 @@
8 8 2 2
9 9 3 3
10 10 4 4
# i 170 more rows
# i 174 more rows

# Gets asymmetric triangle

Code
tibble::tibble(index = 1:length(x), x = x, ma = ma)
Output
# A tibble: 180 x 3
# A tibble: 184 x 3
index x ma
<int> <dbl> <dbl>
1 1 -5 NA
Expand All @@ -36,14 +36,14 @@
8 8 2 2
9 9 3 3
10 10 4 4
# i 170 more rows
# i 174 more rows

# 2 asymetric triangles, first one longer but lower, second should be chosen.

Code
tibble::tibble(index = 1:length(x), x = x, ma = ma)
Output
# A tibble: 180 x 3
# A tibble: 184 x 3
index x ma
<int> <dbl> <dbl>
1 1 0 NA
Expand All @@ -56,14 +56,14 @@
8 8 2 2
9 9 2.5 2.5
10 10 3 3
# i 170 more rows
# i 174 more rows

# 2 asymetric triangles, first one longer but lower, second should be chosen unless longest.

Code
tibble::tibble(index = 1:length(x), x = x, ma = ma)
Output
# A tibble: 180 x 3
# A tibble: 184 x 3
index x ma
<int> <dbl> <dbl>
1 1 0 NA
Expand All @@ -76,14 +76,14 @@
8 8 2 2
9 9 2.5 2.5
10 10 3 3
# i 170 more rows
# i 174 more rows

# 2 asymetric triangles, second one longer but lower, first one should be chosen.

Code
tibble::tibble(index = 1:length(x), x = x, ma = ma)
Output
# A tibble: 180 x 3
# A tibble: 184 x 3
index x ma
<int> <dbl> <dbl>
1 1 0 NA
Expand All @@ -96,14 +96,14 @@
8 8 10 10
9 9 12 12
10 10 14 14
# i 170 more rows
# i 174 more rows

# Right truncated triangle

Code
tibble::tibble(index = 1:length(x), x = x, ma = ma)
Output
# A tibble: 180 x 3
# A tibble: 184 x 3
index x ma
<int> <dbl> <dbl>
1 1 0 NA
Expand All @@ -116,14 +116,14 @@
8 8 0 0
9 9 0 0
10 10 0 0
# i 170 more rows
# i 174 more rows

# Left truncated triangle

Code
tibble::tibble(index = 1:length(x), x = x, ma = ma)
Output
# A tibble: 180 x 3
# A tibble: 184 x 3
index x ma
<int> <dbl> <dbl>
1 1 6 NA
Expand All @@ -136,5 +136,5 @@
8 8 20 19.9
9 9 22 21.1
10 10 24 21.9
# i 170 more rows
# i 174 more rows

25 changes: 15 additions & 10 deletions tests/testthat/test-gsdd-cf.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -217,7 +217,7 @@ test_that("Gets with two weeks and 3 day window and smaller", {
})

test_that("Gets triangle", {
x <- c(seq(-5, 9), 10, seq(9, -5), rep(-1, 149))
x <- c(seq(-5, 9), 10, seq(9, -5), rep(-1, 153))
ma <- zoo::rollmean(x, k = 7, align = "center", na.pad = TRUE)

testthat::expect_snapshot({
Expand All @@ -228,7 +228,7 @@ test_that("Gets triangle", {
})

test_that("Gets asymmetric triangle", {
x <- c(seq(-5, 9), 10, seq(9.5, -5.5), rep(-6, 148))
x <- c(seq(-5, 9), 10, seq(9.5, -5.5), rep(-6, 152))
ma <- zoo::rollmean(x, k = 7, align = "center", na.pad = TRUE)

testthat::expect_snapshot({
Expand All @@ -246,7 +246,7 @@ test_that("2 asymetric triangles, first one longer but lower, second should be c
seq(10, 2, by = -0.5),
seq(2, 25, by = 2),
seq(21, 0, by = -5),
rep(0, 122)
rep(0, 126)
)
ma <- zoo::rollmean(x, k = 7, align = "center", na.pad = TRUE)

Expand All @@ -264,7 +264,7 @@ test_that("2 asymetric triangles, first one longer but lower, second should be c
seq(10, 2, by = -0.5),
seq(2, 25, by = 2),
seq(21, 0, by = -5),
rep(0, 122)
rep(0, 126)
)
ma <- zoo::rollmean(x, k = 7, align = "center", na.pad = TRUE)

Expand All @@ -282,7 +282,7 @@ test_that("2 asymetric triangles, second one longer but lower, first one should
seq(21, 0, by = -5),
seq(0, 10, by = 0.5),
seq(10, 0, by = -0.5),
rep(0, 118)
rep(0, 122)
)
ma <- zoo::rollmean(x, k = 7, align = "center", na.pad = TRUE)
testthat::expect_snapshot({
Expand All @@ -294,7 +294,7 @@ test_that("2 asymetric triangles, second one longer but lower, first one should

test_that("Right truncated triangle", {
x <- c(
rep(0, 159),
rep(0, 163),
seq(2, 25, by = 2),
seq(21, 5, by = -2)
)
Expand All @@ -312,7 +312,7 @@ test_that("Left truncated triangle", {
x <- c(
seq(6, 25, by = 2),
seq(25, 0, by = -2),
rep(0,157)
rep(0,161)
)
ma <- zoo::rollmean(x, k = 7, align = "center", na.pad = TRUE)

Expand All @@ -324,9 +324,14 @@ test_that("Left truncated triangle", {
expect_equal(gsdd_cf(x, ignore_truncation = "start", quiet = TRUE), sum(x[0:25]))
})

test_that("NA if less than 180 values after trimming trailing NAs", {
x <- c(rep(1,179), rep(NA,100))
test_that("NA if less than 184 values after trimming trailing NAs", {
x <- c(rep(1,183), rep(NA,100))
expect_identical(gsdd_cf(x),NA_real_)
x <- c(rep(1,180), rep(NA,100))
x <- c(rep(1,184), rep(NA,100))
expect_identical(gsdd_cf(x),0)
})

test_that("extracts longest non-missing sequence (not just trim tails)", {
x <- c(NA,1,NA,rep(1,184),NA)
expect_identical(gsdd_cf(x),NA_real_) # should be 0
})

0 comments on commit e358186

Please sign in to comment.