- Extracts longest run instead of just trimming tails.

poissonconsulting · Feb 3, 2024 · abdf19b · abdf19b
1 parent e358186
commit abdf19b
Show file tree

Hide file tree

Showing 3 changed files with 14 additions and 12 deletions.
diff --git a/R/gsdd-cf.R b/R/gsdd-cf.R
@@ -108,9 +108,7 @@ gsdd_cf <- function(x,
   if(length(x) < 184) {
     return(NA_real_)
   }
-  if(anyNA(x)) {
-    x <- trim_na(x)
-  }
+  x <- longest_run(x)
   if(length(x) < 184 || anyNA(x)) {
     return(NA_real_)
   }

diff --git a/R/utils.R b/R/utils.R
@@ -1,11 +1,13 @@
-trim_na <- function(x) {
-  indices <- which(!is.na(x))
-  if(!length(indices)) {
-    return(x[0])
+longest_run <- function(x) {
+  rle <- rle(is.na(x))
+  wch <- which.max(rle$length)
+  if(rle$length[wch] < 184 | rle$values[wch]) {
+    return(NA_real_)
   }
-  first <- indices[1]
-  last <- indices[length(indices)]
-  x[first:last]
+  cumsum <- cumsum(rle$lengths)
+  to <- cumsum[wch]
+  from <- if(wch == 1) 1L else cumsum[wch-1] + 1L
+  x[from:to]
 }
 
 sum_vector <- function(from, to, ..vector) {

diff --git a/tests/testthat/test-gsdd-cf.R b/tests/testthat/test-gsdd-cf.R
@@ -332,6 +332,8 @@ test_that("NA if less than 184 values after trimming trailing NAs", {
 })
 
 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
+  x <- c(NA,1,NA,rep(1,183),NA,1,NA)
+  expect_identical(gsdd_cf(x),NA_real_) 
+  x <- c(NA,1,NA,rep(1,184),NA,1,NA)
+  expect_identical(gsdd_cf(x),0) 
 })