ps_interpolate_seq to accept multiple value columns

DESCRIPTION

@@ -11,7 +11,7 @@ Authors@R: c(
     )
 Description: Functions to read and write data for Poisson Consulting scripts and packages.
 License: MIT + file LICENSE
-URL: https://github.com/poissonconsulting/poisdata
+URL: https://poissonconsulting.github.io/poisdata
 BugReports: https://github.com/poissonconsulting/poisdata/issues
 Depends: R (>= 4.0.0)
 Imports:
@@ -39,6 +39,6 @@ Remotes: poissonconsulting/poisutils
 SystemRequirements: udunits
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.3.2.9000
 Roxygen: list(markdown = TRUE)
 Config/Needs/website: poissonconsulting/poissontemplate
+Config/roxygen2/version: 8.1.0.9000

NAMESPACE

@@ -21,16 +21,24 @@ export(read_hobo_csv)
 import(chk)
 import(dplyr)
 import(poisutils)
-importFrom(magrittr,"%<>%")
-importFrom(magrittr,"%>%")
+importFrom(magrittr,
+  "%<>%",
+  "%>%"
+)
 importFrom(readr,read_csv)
-importFrom(rlang,.data)
-importFrom(rlang,UQ)
-importFrom(rlang,parse_quo)
-importFrom(stringr,str_c)
-importFrom(stringr,str_detect)
-importFrom(stringr,str_extract)
-importFrom(stringr,str_replace)
-importFrom(units,drop_units)
-importFrom(units,set_units)
+importFrom(rlang,
+  .data,
+  UQ,
+  parse_quo
+)
+importFrom(stringr,
+  str_c,
+  str_detect,
+  str_extract,
+  str_replace
+)
+importFrom(units,
+  drop_units,
+  set_units
+)
 importFrom(yesno,yesno)

R/interpolate-sequence.R

@@ -4,7 +4,7 @@
 #'
 #' @param x The data.frame.
 #' @param sequence A string naming the sequence column.
-#' @param value A character vector of the value column.
+#' @param value A character vector of the value column(s).
 #' @param by A character vector of columns to interpolate by.
 #' @param max_gap A count of the maximum gap to interpolate within.
 #' @param method A string specifying the method (linear or constant).
@@ -22,7 +22,10 @@ ps_interpolate_sequence <- function(
   step = 0.5
 ) {
   chk_string(sequence)
-  chk_string(value)
+  chk_character(value)
+  chk_not_empty(value)
+  chk_unique(value)
+  chk_not_any_na(value)
   chk_whole_number(max_gap)
   max_gap <- as.integer(max_gap)
   chk_gte(max_gap)
@@ -42,17 +45,21 @@ ps_interpolate_sequence <- function(
   check_names(x, sequence)
   check_names(x, value)
 
-  if (sequence == value) {
-    ps_error("value column '", value, "' must not be the same as sequence")
+  if (sequence %in% value) {
+    ps_error("value columns must not include sequence column '", sequence, "'")
   }
 
   if (length(by)) {
     check_names(x, by)
     if (sequence %in% by) {
       ps_error("sequence column '", sequence, "' must not also be in by")
     }
-    if (value %in% by) {
-      ps_error("value column '", value, "' must not also be in by")
+    if (any(value %in% by)) {
+      ps_error(
+        "value columns ",
+        cc(value[value %in% by], " and "),
+        " must not also be in by"
+      )
     }
   }
 
@@ -70,14 +77,16 @@ ps_interpolate_sequence <- function(
         "sequence must be unique and complete (try ps_add_missing_sequence)"
       )
     }
-    gap <- size_gaps(is.na(x[[value]]))
-    x[[value]] <- stats::approx(
-      x[[value]],
-      xout = seq_along(x[[value]]),
-      method = method,
-      f = step
-    )$y
-    is.na(x[[value]][gap > max_gap]) <- TRUE
+    for (v in value) {
+      gap <- size_gaps(is.na(x[[v]]))
+      x[[v]] <- stats::approx(
+        x[[v]],
+        xout = seq_along(x[[v]]),
+        method = method,
+        f = step
+      )$y
+      is.na(x[[v]][gap > max_gap]) <- TRUE
+    }
     return(x)
   }
 

README.md

@@ -1,4 +1,6 @@
+
 <!-- README.md is generated from README.Rmd. Please edit that file -->
+
 <!-- badges: start -->
 
 [![Lifecycle:
@@ -7,7 +9,7 @@ experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](h
 coverage](https://codecov.io/gh/poissonconsulting/poisdata/branch/master/graph/badge.svg)](https://codecov.io/gh/poissonconsulting/poisdata?branch=master)
 [![R-CMD-check](https://github.com/poissonconsulting/poisdata/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/poissonconsulting/poisdata/actions/workflows/R-CMD-check.yaml)
 [![License:
-MIT](https://img.shields.io/badge/License-MIT-blue.svg)](https://opensource.org/licenses/MIT)
+MIT](https://img.shields.io/badge/License-MIT-blue.svg)](https://opensource.org/license/mit/)
 <!-- badges: end -->
 
 # poisdata
@@ -16,38 +18,40 @@ An R package to read, write and manipulate data frames.
 
 ## Demonstration
 
-    library(poisdata)
-    datetime <- as.POSIXct("2001-01-02 03:04:06") + c(2, 1, 4, 7)
-    data <- data.frame(DateTime = datetime, Value = c(5, 1, 3, 4))
-    print(data)
-    #>              DateTime Value
-    #> 1 2001-01-02 03:04:08     5
-    #> 2 2001-01-02 03:04:07     1
-    #> 3 2001-01-02 03:04:10     3
-    #> 4 2001-01-02 03:04:13     4
-    data <- ps_add_missing_sequence(data)
-    print(data)
-    #> # A tibble: 7 × 2
-    #>   DateTime            Value
-    #>   <dttm>              <dbl>
-    #> 1 2001-01-02 03:04:07     1
-    #> 2 2001-01-02 03:04:08     5
-    #> 3 2001-01-02 03:04:09    NA
-    #> 4 2001-01-02 03:04:10     3
-    #> 5 2001-01-02 03:04:11    NA
-    #> 6 2001-01-02 03:04:12    NA
-    #> 7 2001-01-02 03:04:13     4
-    ps_interpolate_sequence(data)
-    #> # A tibble: 7 × 2
-    #>   DateTime            Value
-    #>   <dttm>              <dbl>
-    #> 1 2001-01-02 03:04:07  1   
-    #> 2 2001-01-02 03:04:08  5   
-    #> 3 2001-01-02 03:04:09  4   
-    #> 4 2001-01-02 03:04:10  3   
-    #> 5 2001-01-02 03:04:11  3.33
-    #> 6 2001-01-02 03:04:12  3.67
-    #> 7 2001-01-02 03:04:13  4
+``` r
+library(poisdata)
+datetime <- as.POSIXct("2001-01-02 03:04:06") + c(2, 1, 4, 7)
+data <- data.frame(DateTime = datetime, Value = c(5, 1, 3, 4))
+print(data)
+#>              DateTime Value
+#> 1 2001-01-02 03:04:08     5
+#> 2 2001-01-02 03:04:07     1
+#> 3 2001-01-02 03:04:10     3
+#> 4 2001-01-02 03:04:13     4
+data <- ps_add_missing_sequence(data)
+print(data)
+#> # A tibble: 7 × 2
+#>   DateTime            Value
+#>   <dttm>              <dbl>
+#> 1 2001-01-02 03:04:07     1
+#> 2 2001-01-02 03:04:08     5
+#> 3 2001-01-02 03:04:09    NA
+#> 4 2001-01-02 03:04:10     3
+#> 5 2001-01-02 03:04:11    NA
+#> 6 2001-01-02 03:04:12    NA
+#> 7 2001-01-02 03:04:13     4
+ps_interpolate_sequence(data)
+#> # A tibble: 7 × 2
+#>   DateTime            Value
+#>   <dttm>              <dbl>
+#> 1 2001-01-02 03:04:07  1   
+#> 2 2001-01-02 03:04:08  5   
+#> 3 2001-01-02 03:04:09  4   
+#> 4 2001-01-02 03:04:10  3   
+#> 5 2001-01-02 03:04:11  3.33
+#> 6 2001-01-02 03:04:12  3.67
+#> 7 2001-01-02 03:04:13  4
+```
 
 ## Installation
 

scripts/build.R

@@ -1,11 +1,34 @@
-roxygen2md::roxygen2md()
-styler::style_pkg(filetype = c("R", "Rmd"))
-lintr::lint_package()
+system2("air", c("format", "."))
+styler::style_pkg(filetype = c("Rmd")) # Air currently doesn't format .Rmd files
+lintr::lint_package(
+  linters = lintr::linters_with_defaults(
+    line_length_linter = lintr::line_length_linter(1000),
+    object_name_linter = lintr::object_name_linter(regexes = ".*")
+  )
+)
 
-devtools::test()
+roxygen2md::roxygen2md()
 devtools::document()
 
-rmarkdown::render("README.Rmd", output_format = "md_document")
+devtools::build_readme()
+
+# Note: Only use pkgdown to build a documentation website for public facing packages
+pkgdown::build_home()
+pkgdown::build_reference()
 pkgdown::build_site()
+browseURL("docs/index.html")
 
+devtools::test()
 devtools::check()
+
+# Test files that have less then 100% coverage
+covr:::tally_coverage(covr::package_coverage()) |>
+  dplyr::summarize(
+    percent_coverage = mean(value > 0) * 100,
+    .by = filename
+  ) |>
+  dplyr::filter(percent_coverage < 100) |>
+  dplyr::arrange(percent_coverage)
+
+# Report for all test files
+covr::report(covr::package_coverage())

tests/testthat/test-interpolate-sequence.R

@@ -35,3 +35,62 @@ test_that("interpolate-sequence", {
     tolerance = 0.00001
   )
 })
+
+test_that("interpolate-sequence multiple value columns", {
+  datetime <- as.POSIXct("2001-01-02 03:04:06") + c(1:10)
+
+  data <- data.frame(
+    DateTime = datetime,
+    Value = c(1, NA, 3, NA, NA, 3, NA, NA, NA, 7),
+    Value2 = c(NA, NA, 3, NA, NA, 3, NA, NA, 4, NA)
+  )
+
+  x <- ps_interpolate_sequence(data, value = c("Value", "Value2"))
+  expect_identical(colnames(x), c("DateTime", "Value", "Value2"))
+  expect_identical(x$Value, c(1, 2, 3, 3, 3, 3, 4, 5, 6, 7))
+  expect_equal(
+    x$Value2,
+    c(NA, NA, 3, 3, 3, 3, 3.33333, 3.66666, 4, NA),
+    tolerance = 0.00001
+  )
+
+  x <- ps_interpolate_sequence(data, value = c("Value", "Value2"), max_gap = 2)
+  expect_identical(x$Value, c(1, 2, 3, 3, 3, 3, NA, NA, NA, 7))
+  expect_equal(
+    x$Value2,
+    c(NA, NA, 3, 3, 3, 3, 3.33333, 3.66666, 4, NA),
+    tolerance = 0.00001
+  )
+
+  data <- data.frame(
+    Group = rep(c("a", "b"), each = 5),
+    DateTime = rep(datetime[1:5], 2),
+    Value = c(1, NA, 3, NA, 5, 2, NA, NA, NA, 6),
+    Value2 = c(10, NA, NA, NA, 30, NA, 4, NA, 8, NA)
+  )
+  x <- ps_interpolate_sequence(
+    data,
+    value = c("Value", "Value2"),
+    by = "Group"
+  )
+  expect_identical(x$Value, c(1, 2, 3, 4, 5, 2, 3, 4, 5, 6))
+  expect_identical(x$Value2, c(10, 15, 20, 25, 30, NA, 4, 6, 8, NA))
+
+  expect_error(
+    ps_interpolate_sequence(data, value = c("Value", "DateTime")),
+    "^value columns must not include sequence column 'DateTime'$"
+  )
+  expect_error(
+    ps_interpolate_sequence(data, value = c("Value", "Group"), by = "Group"),
+    "^value columns 'Group' must not also be in by$"
+  )
+  data$Site <- "s"
+  expect_error(
+    ps_interpolate_sequence(
+      data,
+      value = c("Value", "Group", "Site"),
+      by = c("Group", "Site")
+    ),
+    "^value columns 'Group' and 'Site' must not also be in by$"
+  )
+})