From b080ff160ff66bdc6dc160322ffdb3bee6dfd80f Mon Sep 17 00:00:00 2001 From: Andrew Bruce Date: Sun, 17 Nov 2024 23:18:45 -0800 Subject: [PATCH] added interpolate function --- DESCRIPTION | 2 +- NAMESPACE | 1 + R/generated-globals.R | 66 +++++++++++++++++++++++++++++++++++++++++++ R/programming.R | 49 ++++++++++++++++++++++++++++++++ R/regex_hcpcs.R | 8 ++++++ man/interpolate.Rd | 45 +++++++++++++++++++++++++++++ 6 files changed, 170 insertions(+), 1 deletion(-) create mode 100644 man/interpolate.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 077f9ff..174228b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -26,6 +26,7 @@ Imports: pins, purrr, rlang, + stats, strex, stringfish, stringi, @@ -46,7 +47,6 @@ Suggests: prettycode, roxyglobals, scales, - stats, testthat (>= 3.0.0), timeplyr, wakefield diff --git a/NAMESPACE b/NAMESPACE index a6ea60e..8af7914 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -45,6 +45,7 @@ export(gluestick) export(gt_marks) export(histo) export(histogram) +export(interpolate) export(invert_named) export(is_valid_npi) export(list_pins) diff --git a/R/generated-globals.R b/R/generated-globals.R index 51e739c..55350bb 100644 --- a/R/generated-globals.R +++ b/R/generated-globals.R @@ -8,6 +8,30 @@ utils::globalVariables(c( # # ":=", + # + # + # + # + "a1", + # + # + # + # + "a2", + # + # + # + "a3", + # + # + "a4", + # + "a5", + # + # + # + # + "code", # "combined", # @@ -22,10 +46,43 @@ utils::globalVariables(c( "date_of_submission", # "dates", + # + "families", + # + # + # + # + "g", # "group", + # + # + # + # + "group_id", # "group_size", + # + "groups", + # + # + # + # + "i1", + # + # + # + # + "i2", + # + # + # + "i3", + # + # + "i4", + # + "i5", # "interval", # @@ -42,7 +99,16 @@ utils::globalVariables(c( # # # + # + # + # + # "n", + # + # + # + # + "n1", # "nuniq", # diff --git a/R/programming.R b/R/programming.R index bc55dd7..b17808e 100644 --- a/R/programming.R +++ b/R/programming.R @@ -176,3 +176,52 @@ srchcol <- function(df, ) ) } + +#' Linearly interpolate the values between two points +#' +#' [SO Link](https://stackoverflow.com/questions/27920690/linear-interpolation-using-dplyr/31845035#31845035) +#' +#' @param x,y `` vectors giving the coordinates of the points to be +#' interpolated +#' +#' @param method `` interpolation method, default is `"approx"` +#' +#' @returns `` vector of interpolated values +#' +#' @examples +#' interpolate(1:5, c(10, NA, NA, NA, 100), "spline") +#' +#' df <- dplyr::tibble( +#' seq = 1:5, +#' v1 = c(1, NA, 3, NA, 5), +#' v2 = c(40, NA, 60, NA, 70), +#' v3 = c(10, NA, NA, NA, 100)) +#' +#' df +#' +#' df |> +#' dplyr::mutate( +#' dplyr::across( +#' .cols = dplyr::starts_with("v"), +#' .fns = ~ interpolate(seq, .x), +#' .names = "{.col}_est")) +#' +#' df |> +#' dplyr::mutate( +#' dplyr::across( +#' dplyr::starts_with("v"), +#' ~ interpolate(seq, .x))) +#' +#' @autoglobal +#' +#' @export +interpolate <- function(x, y, method = c("approx", "spline")) { + + method <- match.arg(method) + + switch ( + method, + approx = stats::approx(x, y, n = length(x))$y, + spline = stats::spline(x, y, n = length(x))$y + ) +} diff --git a/R/regex_hcpcs.R b/R/regex_hcpcs.R index 0d7df1b..ef9eed5 100644 --- a/R/regex_hcpcs.R +++ b/R/regex_hcpcs.R @@ -176,6 +176,7 @@ group_split_length <- function(x) { } #' @noRd +#' @autoglobal group_hcpcs_1 <- function(x) { if (!rlang::has_name(x, "x1")) return(NULL) @@ -185,6 +186,7 @@ group_hcpcs_1 <- function(x) { } #' @noRd +#' @autoglobal group_hcpcs_2 <- function(x) { if (!rlang::has_name(x, "x2")) return(NULL) @@ -227,7 +229,9 @@ group_hcpcs_2 <- function(x) { ) grouped[collapse::radixorderv(collapse::vlengths(grouped), sort = TRUE)] } + #' @noRd +#' @autoglobal group_hcpcs_3 <- function(x) { if (!rlang::has_name(x, "x3")) return(NULL) @@ -273,6 +277,7 @@ group_hcpcs_3 <- function(x) { grouped[collapse::radixorderv(collapse::vlengths(grouped), sort = TRUE)] } #' @noRd +#' @autoglobal group_hcpcs_4 <- function(x) { if (!rlang::has_name(x, "x4")) return(NULL) @@ -320,6 +325,7 @@ group_hcpcs_4 <- function(x) { grouped[collapse::radixorderv(collapse::vlengths(grouped), sort = TRUE)] } #' @noRd +#' @autoglobal group_hcpcs_5 <- function(x) { if (!rlang::has_name(x, "x5")) return(NULL) @@ -372,6 +378,7 @@ group_hcpcs_5 <- function(x) { } #' @noRd +#' @autoglobal process_groups <- function(x) { list( g1 = group_hcpcs_1(groups), @@ -473,6 +480,7 @@ process_hcpcs_2 <- function(x) { fuimus::collapser(to_vec) } #' @noRd +#' @autoglobal process_families <- function(x) { x <- list( diff --git a/man/interpolate.Rd b/man/interpolate.Rd new file mode 100644 index 0000000..d7dfe8f --- /dev/null +++ b/man/interpolate.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/programming.R +\name{interpolate} +\alias{interpolate} +\title{Linearly interpolate the values between two points} +\usage{ +interpolate(x, y, method = c("approx", "spline")) +} +\arguments{ +\item{x, y}{\verb{} vectors giving the coordinates of the points to be +interpolated} + +\item{method}{\verb{} interpolation method, default is \code{"approx"}} +} +\value{ +\verb{} vector of interpolated values +} +\description{ +\href{https://stackoverflow.com/questions/27920690/linear-interpolation-using-dplyr/31845035#31845035}{SO Link} +} +\examples{ +interpolate(1:5, c(10, NA, NA, NA, 100), "spline") + +df <- dplyr::tibble( + seq = 1:5, + v1 = c(1, NA, 3, NA, 5), + v2 = c(40, NA, 60, NA, 70), + v3 = c(10, NA, NA, NA, 100)) + +df + +df |> + dplyr::mutate( + dplyr::across( + .cols = dplyr::starts_with("v"), + .fns = ~ interpolate(seq, .x), + .names = "{.col}_est")) + +df |> +dplyr::mutate( +dplyr::across( +dplyr::starts_with("v"), +~ interpolate(seq, .x))) + +}