Fix utils

r/DESCRIPTION

@@ -1,7 +1,7 @@
 Package: bidask
 Type: Package
 Title: Efficient Estimation of Bid-Ask Spreads from Open, High, Low, and Close Prices
-Version: 2.1.1
+Version: 2.1.2
 Authors@R: c(
     person(given = "Emanuele", family = "Guidotti", email = "[email protected]", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-8961-6623")),
     person(given = "David", family = "Ardia", role = c("ctb"), comment = c(ORCID = "0000-0003-2823-782X")),

r/R/utils.R

@@ -2,7 +2,7 @@
 "_PACKAGE"
 .onLoad <- function(libname, pkgname) {
   # CRAN OMP THREAD LIMIT
-  Sys.setenv("OMP_THREAD_LIMIT" = 2)
+  Sys.setenv("OMP_THREAD_LIMIT" = 1)
 }
 
 #' @import data.table
@@ -26,14 +26,18 @@ rfun <- function(froll, x, width, shift, na.rm){
   }
 
   if(nw == 1 && n < 1){
-    if(is.null(nc)) y <- rep(NA, nr)
-    else y <- as.data.frame(matrix(data = NA, nrow = nr, ncol = nc))
-  }
-  else{
-    y <- froll(x, n = n, na.rm = na.rm, adaptive = nw > 1, fill = NA)
-    if(is.list(y)) setDF(y)
+    if(is.null(nc)) return(rep(NA, nr))
+    return(as.data.frame(matrix(data = NA, nrow = nr, ncol = nc)))
   }
 
+  y <- froll(x, n = n, na.rm = na.rm, adaptive = nw > 1, fill = NA)
+  if(is.list(y)) setDF(y)
+
+  if(nw == 1 && width > 1){
+    if(is.data.frame(y)) y[1:(width-1),] <- NA
+    else y[1:(width-1)] <- NA
+  }
+
   return(y)
 
 }

r/tests/testthat/test-edge.R

@@ -112,6 +112,19 @@ test_that("edge-rolling", {
 
 })
 
+test_that("edge-rolling-na", {
+
+  set.seed(123)
+  x <- sim(n = 100)
+
+  s1 <- edge_rolling(x$Open, x$High, x$Low, x$Close, width = nrow(x), na.rm = TRUE)
+  expect_equal(sum(!is.na(s1)), 1)
+
+  s2 <- edge_rolling(x$Open, x$High, x$Low, x$Close, width = c(1, nrow(x)), na.rm = TRUE)
+  expect_equal(s1[!is.na(s1)], s2[!is.na(s2)])
+
+})
+
 test_that("edge-expanding", {
 
   set.seed(123)