From ed7f8f739fbe82c93f248238da8edb42cec18d8e Mon Sep 17 00:00:00 2001 From: Michael McCarthy <51542091+mccarthy-m-g@users.noreply.github.com> Date: Thu, 18 Dec 2025 10:04:55 -0800 Subject: [PATCH 01/16] auto-append newlines --- irxutils.Rproj | 2 ++ 1 file changed, 2 insertions(+) diff --git a/irxutils.Rproj b/irxutils.Rproj index 4f5a9fc..6eb7455 100644 --- a/irxutils.Rproj +++ b/irxutils.Rproj @@ -13,6 +13,8 @@ Encoding: UTF-8 RnwWeave: knitr LaTeX: XeLaTeX +AutoAppendNewline: Yes + BuildType: Package PackageUseDevtools: Yes PackageInstallArgs: --no-multiarch --with-keep.source From 76ca47d8ef8a3d638f7512aadcc5e1f1f2c4631b Mon Sep 17 00:00:00 2001 From: Michael McCarthy <51542091+mccarthy-m-g@users.noreply.github.com> Date: Thu, 18 Dec 2025 10:05:30 -0800 Subject: [PATCH 02/16] use README Rmd --- README.Rmd | 57 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ README.md | 56 +++++++++++++++++++++++++++++++++++++++++++++++------ 2 files changed, 107 insertions(+), 6 deletions(-) create mode 100644 README.Rmd diff --git a/README.Rmd b/README.Rmd new file mode 100644 index 0000000..de4f67c --- /dev/null +++ b/README.Rmd @@ -0,0 +1,57 @@ +--- +output: github_document +--- + + + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + fig.path = "man/figures/README-", + out.width = "100%" +) +``` + +# irxutils + + +[![R-CMD-check](https://github.com/InsightRX/irxutils/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/InsightRX/irxutils/actions/workflows/R-CMD-check.yaml) +[![Codecov test coverage](https://codecov.io/gh/InsightRX/irxutils/graph/badge.svg)](https://app.codecov.io/gh/InsightRX/irxutils) + + +The goal of irxutils is to provide miscellaneous generic functions, mostly low-level, for use in InsightRX packages. + +## Installation + +You can install the development version of irxutils from [GitHub](https://github.com/) with: + +``` r +# install.packages("pak") +pak::pak("InsightRX/irxutils") +``` + +## Example + +This is a basic example which shows you how to solve a common problem: + +```{r example} +library(irxutils) +## basic example code +``` + +What is special about using `README.Rmd` instead of just `README.md`? You can include R chunks like so: + +```{r cars} +summary(cars) +``` + +You'll still need to render `README.Rmd` regularly, to keep `README.md` up-to-date. `devtools::build_readme()` is handy for this. + +You can also embed plots, for example: + +```{r pressure, echo = FALSE} +plot(pressure) +``` + +In that case, don't forget to commit and push the resulting figure files, so they display on GitHub and CRAN. diff --git a/README.md b/README.md index aee8e4b..a34b6ab 100644 --- a/README.md +++ b/README.md @@ -1,13 +1,57 @@ + + + +# irxutils + + [![R-CMD-check](https://github.com/InsightRX/irxutils/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/InsightRX/irxutils/actions/workflows/R-CMD-check.yaml) - +[![Codecov test +coverage](https://codecov.io/gh/InsightRX/irxutils/graph/badge.svg)](https://app.codecov.io/gh/InsightRX/irxutils) + -# irxutils +The goal of irxutils is to provide miscellaneous generic functions, +mostly low-level, for use in InsightRX packages. -Miscellaneuous generic functions, mostly low-level for use in packages. +## Installation -Manual installation: +You can install the development version of irxutils from +[GitHub](https://github.com/) with: -```r -remotes::install_github("InsightRX/irxutils") +``` r +# install.packages("pak") +pak::pak("InsightRX/irxutils") ``` + +## Example + +This is a basic example which shows you how to solve a common problem: + +``` r +library(irxutils) +## basic example code +``` + +What is special about using `README.Rmd` instead of just `README.md`? +You can include R chunks like so: + +``` r +summary(cars) +#> speed dist +#> Min. : 4.0 Min. : 2.00 +#> 1st Qu.:12.0 1st Qu.: 26.00 +#> Median :15.0 Median : 36.00 +#> Mean :15.4 Mean : 42.98 +#> 3rd Qu.:19.0 3rd Qu.: 56.00 +#> Max. :25.0 Max. :120.00 +``` + +You’ll still need to render `README.Rmd` regularly, to keep `README.md` +up-to-date. `devtools::build_readme()` is handy for this. + +You can also embed plots, for example: + + + +In that case, don’t forget to commit and push the resulting figure +files, so they display on GitHub and CRAN. From a539ce46f7c66283cc90ee5226d8a2cc2eb70f48 Mon Sep 17 00:00:00 2001 From: Michael McCarthy <51542091+mccarthy-m-g@users.noreply.github.com> Date: Thu, 18 Dec 2025 10:06:08 -0800 Subject: [PATCH 03/16] use codecov --- .github/workflows/test-coverage.yaml | 62 ++++++++++++++++++++++++++++ codecov.yml | 14 +++++++ 2 files changed, 76 insertions(+) create mode 100644 .github/workflows/test-coverage.yaml create mode 100644 codecov.yml diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml new file mode 100644 index 0000000..0ab748d --- /dev/null +++ b/.github/workflows/test-coverage.yaml @@ -0,0 +1,62 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, master] + pull_request: + +name: test-coverage.yaml + +permissions: read-all + +jobs: + test-coverage: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::covr, any::xml2 + needs: coverage + + - name: Test coverage + run: | + cov <- covr::package_coverage( + quiet = FALSE, + clean = FALSE, + install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") + ) + print(cov) + covr::to_cobertura(cov) + shell: Rscript {0} + + - uses: codecov/codecov-action@v5 + with: + # Fail if error if not on PR, or if on PR and token is given + fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }} + files: ./cobertura.xml + plugins: noop + disable_search: true + token: ${{ secrets.CODECOV_TOKEN }} + + - name: Show testthat output + if: always() + run: | + ## -------------------------------------------------------------------- + find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true + shell: bash + + - name: Upload test results + if: failure() + uses: actions/upload-artifact@v4 + with: + name: coverage-test-failures + path: ${{ runner.temp }}/package diff --git a/codecov.yml b/codecov.yml new file mode 100644 index 0000000..04c5585 --- /dev/null +++ b/codecov.yml @@ -0,0 +1,14 @@ +comment: false + +coverage: + status: + project: + default: + target: auto + threshold: 1% + informational: true + patch: + default: + target: auto + threshold: 1% + informational: true From 9dd3980a7e0e120341a88084cbba18d4f0a25306 Mon Sep 17 00:00:00 2001 From: Michael McCarthy <51542091+mccarthy-m-g@users.noreply.github.com> Date: Thu, 18 Dec 2025 10:06:25 -0800 Subject: [PATCH 04/16] use pkgdown --- _pkgdown.yml | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 _pkgdown.yml diff --git a/_pkgdown.yml b/_pkgdown.yml new file mode 100644 index 0000000..7e97580 --- /dev/null +++ b/_pkgdown.yml @@ -0,0 +1,3 @@ +url: https://insightrx.github.io/irxutils/ +template: + bootstrap: 5 From 99de516f7adf20659a354b8aae9b19566a520eab Mon Sep 17 00:00:00 2001 From: Michael McCarthy <51542091+mccarthy-m-g@users.noreply.github.com> Date: Thu, 18 Dec 2025 10:06:55 -0800 Subject: [PATCH 05/16] update .gitignore and .Rbuildignore --- .Rbuildignore | 5 +++++ .gitignore | 1 + 2 files changed, 6 insertions(+) diff --git a/.Rbuildignore b/.Rbuildignore index 9db10e0..3d11058 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -2,3 +2,8 @@ ^\.Rproj\.user$ ^\.github$ ^docker$ +^_pkgdown\.yml$ +^docs$ +^pkgdown$ +^codecov\.yml$ +^README\.Rmd$ diff --git a/.gitignore b/.gitignore index 1141bfd..ceb852e 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,4 @@ .Rhistory .RData .Ruserdata +docs From 999632a91c24d9bbc8a95dc8d15361e870150f4d Mon Sep 17 00:00:00 2001 From: Michael McCarthy <51542091+mccarthy-m-g@users.noreply.github.com> Date: Thu, 18 Dec 2025 10:07:07 -0800 Subject: [PATCH 06/16] update DESCRIPTION --- DESCRIPTION | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1468df2..710ab15 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -3,15 +3,16 @@ Title: Generic utils Version: 0.0.0.9000 Authors@R: c( person("Ron", "Keizer", email = "ron@insight-rx.com", role = c("cre", "aut")), + person("Michael", "McCarthy", email = "michael.mccarthy@insight-rx.com", role = "ctb"), person("InsightRX", role = "cph") ) -Author: Ron Keizer -Maintainer: Ron Keizer Description: Small generic functions for e.g. string and object manipulations, datetime parsing, etc. Imports: + lubridate Suggests: - testthat (>= 3.2.0) + testthat (>= 3.2.0), + withr License: file LICENSE Encoding: UTF-8 Roxygen: list(markdown = TRUE) From b6c516db67d2f19b73a7bd146c602757eb1ffcbe Mon Sep 17 00:00:00 2001 From: Michael McCarthy <51542091+mccarthy-m-g@users.noreply.github.com> Date: Thu, 18 Dec 2025 10:07:23 -0800 Subject: [PATCH 07/16] add package doc --- R/irxutils-package.R | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 R/irxutils-package.R diff --git a/R/irxutils-package.R b/R/irxutils-package.R new file mode 100644 index 0000000..a65cf64 --- /dev/null +++ b/R/irxutils-package.R @@ -0,0 +1,6 @@ +#' @keywords internal +"_PACKAGE" + +## usethis namespace: start +## usethis namespace: end +NULL From 3561de7735cbdd1248e00b1af655d1c71358285a Mon Sep 17 00:00:00 2001 From: Michael McCarthy <51542091+mccarthy-m-g@users.noreply.github.com> Date: Thu, 18 Dec 2025 10:37:45 -0800 Subject: [PATCH 08/16] clean up functions and documentation --- R/get_datetime_string.R | 17 +++++++++--- R/get_na_between_non_na.R | 22 +++++++++------ R/grapes-greater-than-equals-grapes.R | 34 ++++++++++++++++++++---- R/grapes-less-than-equals-grapes.R | 13 --------- R/invert_list.R | 10 +++++-- R/random_string.R | 8 +++++- R/underscores_to_dots.R | 15 ++++++++--- man/dots_to_underscores.Rd | 11 -------- man/get_datetime_string.Rd | 18 ++++++++++--- man/get_na_between_non_na.Rd | 18 +++++++++---- man/grapes-greater-than-equals-grapes.Rd | 19 ------------- man/grapes-less-than-equals-grapes.Rd | 19 ------------- man/invert_list.Rd | 7 +++++ man/irxutils-package.Rd | 21 +++++++++++++++ man/random_string.Rd | 7 +++++ man/safe-comparison.Rd | 32 ++++++++++++++++++++++ man/underscores_to_dots.Rd | 20 ++++++++++++-- 17 files changed, 197 insertions(+), 94 deletions(-) delete mode 100644 R/grapes-less-than-equals-grapes.R delete mode 100644 man/dots_to_underscores.Rd delete mode 100644 man/grapes-greater-than-equals-grapes.Rd delete mode 100644 man/grapes-less-than-equals-grapes.Rd create mode 100644 man/irxutils-package.Rd create mode 100644 man/safe-comparison.Rd diff --git a/R/get_datetime_string.R b/R/get_datetime_string.R index b05cde4..831169d 100644 --- a/R/get_datetime_string.R +++ b/R/get_datetime_string.R @@ -1,6 +1,17 @@ -#' Get datetime as a string, e.g. 202405070550 +#' Get datetime as a string +#' +#' Get datetime as a string in the form `"%Y%m%d%H%M"`. Defaults to returning +#' the current datetime. +#' +#' @param x A vector of [POSIXt], numeric, or character objects. Defaults to the +#' current time. +#' +#' @returns The datetime as a string in the form `"%Y%m%d%H%M"`. +#' +#' @examples +#' get_datetime_string() #' #' @export -get_datetime_string <- function() { - gsub("[a-zA-Z \\:\\-]", "", substr(as.character(lubridate::now()), 1, 16)) +get_datetime_string <- function(x = lubridate::now()) { + format(x, "%Y%m%d%H%M") } diff --git a/R/get_na_between_non_na.R b/R/get_na_between_non_na.R index 465b252..90603cd 100644 --- a/R/get_na_between_non_na.R +++ b/R/get_na_between_non_na.R @@ -1,18 +1,24 @@ -#' Check if a vector of values has an NA in between at least two non-NA +#' Get NA values between non-NA values +#' +#' Check if a vector of values has any NAs between at least two non-NA #' values. If so, it will return a vector of indices of NA values for which -#' this is the case. If none are found, it will return an empty vector. +#' this is the case. If none are found, it will return `NULL`. +#' +#' @param x A vector of values. #' +#' @details #' This can e.g. conveniently be used to test whether there are any BLQ #' samples in-between two numeric (above LOQ) values. Within a single PK #' curve this is not likely to occur and the individual or data point should be -#' flagged as an outlier. +#' flagged as an outlier. #' -#' @param x vector of samples -#' -#' @returns vector of indices (numeric) +#' @returns A vector of numeric indices of NA values that are between at least +#' two non-NA values. Returns an `NULL` if none are found. +#' +#' @examples +#' get_na_between_non_na(c(NA, 1, 2, NA, 4, NA, 6, NA, NA, 9, NA)) #' #' @export -#' get_na_between_non_na <- function(x) { idx <- (1:(length(x)))[is.na(x)] na_idx <- c() @@ -24,4 +30,4 @@ get_na_between_non_na <- function(x) { } } na_idx -} \ No newline at end of file +} diff --git a/R/grapes-greater-than-equals-grapes.R b/R/grapes-greater-than-equals-grapes.R index 96d09df..84525a7 100644 --- a/R/grapes-greater-than-equals-grapes.R +++ b/R/grapes-greater-than-equals-grapes.R @@ -1,9 +1,24 @@ -#' Greater-than-or-equal-to with a little room for floating point precision -#' issues +#' Safe relational operators +#' +#' Binary operators which allow the comparison of values in atomic vectors, with +#' a little room for floating point precision issues. #' -#' @keywords internal -#' @param x Numeric vector -#' @param y Numeric vector +#' @param x,y Numeric vectors. +#' +#' @details +#' These binary comparison operators make the base relational operators +#' ([base::Comparison]) safer by adding a little room for floating point precision +#' issues. `%>=%` is the counterpart to `>=`, and `%<=%` is the counterpart to +#' `<=`. +#' +#' @returns +#' A logical vector indicating the result of the element by element comparison. +#' +#' @examples +#' (0.7 - 0.4) >= 0.3 +#' (0.7 - 0.4) %>=% 0.3 +#' +#' @rdname safe-comparison #' @export `%>=%` <- function(x, y) { if (length(x) == 0 | length(y) == 0) { @@ -11,3 +26,12 @@ } x > y | mapply(function(x, y) isTRUE(all.equal(x, y)), x, y) } + +#' @rdname safe-comparison +#' @export +`%<=%` <- function(x, y) { + if (length(x) == 0 | length(y) == 0) { + return(logical(0)) + } + x < y | mapply(function(x, y) isTRUE(all.equal(x, y)), x, y) +} diff --git a/R/grapes-less-than-equals-grapes.R b/R/grapes-less-than-equals-grapes.R deleted file mode 100644 index 24d142b..0000000 --- a/R/grapes-less-than-equals-grapes.R +++ /dev/null @@ -1,13 +0,0 @@ -#' Less-than-or-equal-to with a little room for floating point precision -#' issues -#' -#' @keywords internal -#' @param x Numeric vector -#' @param y Numeric vector -#' @export -`%<=%` <- function(x, y) { - if (length(x) == 0 | length(y) == 0) { - return(logical(0)) - } - x < y | mapply(function(x, y) isTRUE(all.equal(x, y)), x, y) -} diff --git a/R/invert_list.R b/R/invert_list.R index e956539..5887a8c 100644 --- a/R/invert_list.R +++ b/R/invert_list.R @@ -1,12 +1,18 @@ #' Invert a character list #' #' @param obj list object +#' +#' @returns +#' The list object, with values and names inverted. +#' +#' @examples +#' invert_list(list(a = "b")) #' #' @export invert_list <- function(obj) { new_obj <- list() for(key in names(obj)) { - new_obj[[as.character(obj[[key]])]] <- key # legacay! remove once all covariates have been moved to md + new_obj[[as.character(obj[[key]])]] <- key # legacy! remove once all covariates have been moved to md } - return(new_obj) + new_obj } diff --git a/R/random_string.R b/R/random_string.R index 05c188a..24e62c0 100644 --- a/R/random_string.R +++ b/R/random_string.R @@ -2,7 +2,13 @@ #' #' @param n number of characters for random string #' +#' @returns +#' A string of random letters with `n` characters. +#' +#' @examples +#' random_string(3) +#' #' @export random_string <- function(n = 5) { - paste(letters[floor(runif(n, 0, 26)) + 1], collapse="") + paste(letters[floor(stats::runif(n, 0, 26)) + 1], collapse="") } diff --git a/R/underscores_to_dots.R b/R/underscores_to_dots.R index 98a6faa..0becd09 100644 --- a/R/underscores_to_dots.R +++ b/R/underscores_to_dots.R @@ -1,9 +1,18 @@ -#' Convert underscores to dots +#' Convert underscores to dots (and vice versa) +#' +#' @param x A character vector. +#' +#' @returns The character vector `x`, with all underscores converted to dots for +#' `underscores_to_dots()` and all dots converted to underscores for +#' `dots_to_underscores()`. +#' +#' @examples +#' underscores_to_dots(c("a_b_c", "d_e_f")) +#' dots_to_underscores(c("a.b.c", "d.e.f")) #' #' @export underscores_to_dots <- function(x) gsub("_", "\\.", x) -#' Convert dots to underscores -#' +#' @rdname underscores_to_dots #' @export dots_to_underscores <- function(x) gsub("\\.", "_", x) diff --git a/man/dots_to_underscores.Rd b/man/dots_to_underscores.Rd deleted file mode 100644 index 2cbc2d8..0000000 --- a/man/dots_to_underscores.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/underscores_to_dots.R -\name{dots_to_underscores} -\alias{dots_to_underscores} -\title{Convert dots to underscores} -\usage{ -dots_to_underscores(x) -} -\description{ -Convert dots to underscores -} diff --git a/man/get_datetime_string.Rd b/man/get_datetime_string.Rd index 10dca6c..d84cc7a 100644 --- a/man/get_datetime_string.Rd +++ b/man/get_datetime_string.Rd @@ -2,10 +2,22 @@ % Please edit documentation in R/get_datetime_string.R \name{get_datetime_string} \alias{get_datetime_string} -\title{Get datetime as a string, e.g. 202405070550} +\title{Get datetime as a string} \usage{ -get_datetime_string() +get_datetime_string(x = lubridate::now()) +} +\arguments{ +\item{x}{A vector of \link{POSIXt}, numeric, or character objects. Defaults to the +current time.} +} +\value{ +The datetime as a string in the form \code{"\%Y\%m\%d\%H\%M"}. } \description{ -Get datetime as a string, e.g. 202405070550 +Get datetime as a string in the form \code{"\%Y\%m\%d\%H\%M"}. Defaults to returning +the current datetime. +} +\examples{ +get_datetime_string() + } diff --git a/man/get_na_between_non_na.Rd b/man/get_na_between_non_na.Rd index ac757db..dc0fd5d 100644 --- a/man/get_na_between_non_na.Rd +++ b/man/get_na_between_non_na.Rd @@ -2,21 +2,29 @@ % Please edit documentation in R/get_na_between_non_na.R \name{get_na_between_non_na} \alias{get_na_between_non_na} -\title{Check if a vector of values has an NA in between at least two non-NA -values. If so, it will return a vector of indices of NA values for which -this is the case. If none are found, it will return an empty vector.} +\title{Get NA values between non-NA values} \usage{ get_na_between_non_na(x) } \arguments{ -\item{x}{vector of samples} +\item{x}{A vector of values.} } \value{ -vector of indices (numeric) +A vector of numeric indices of NA values that are between at least +two non-NA values. Returns an \code{NULL} if none are found. } \description{ +Check if a vector of values has any NAs between at least two non-NA +values. If so, it will return a vector of indices of NA values for which +this is the case. If none are found, it will return \code{NULL}. +} +\details{ This can e.g. conveniently be used to test whether there are any BLQ samples in-between two numeric (above LOQ) values. Within a single PK curve this is not likely to occur and the individual or data point should be flagged as an outlier. } +\examples{ +get_na_between_non_na(c(NA, 1, 2, NA, 4, NA, 6, NA, NA, 9, NA)) + +} diff --git a/man/grapes-greater-than-equals-grapes.Rd b/man/grapes-greater-than-equals-grapes.Rd deleted file mode 100644 index 4a5ca60..0000000 --- a/man/grapes-greater-than-equals-grapes.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/grapes-greater-than-equals-grapes.R -\name{\%>=\%} -\alias{\%>=\%} -\title{Greater-than-or-equal-to with a little room for floating point precision -issues} -\usage{ -x \%>=\% y -} -\arguments{ -\item{x}{Numeric vector} - -\item{y}{Numeric vector} -} -\description{ -Greater-than-or-equal-to with a little room for floating point precision -issues -} -\keyword{internal} diff --git a/man/grapes-less-than-equals-grapes.Rd b/man/grapes-less-than-equals-grapes.Rd deleted file mode 100644 index a443f2d..0000000 --- a/man/grapes-less-than-equals-grapes.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/grapes-less-than-equals-grapes.R -\name{\%<=\%} -\alias{\%<=\%} -\title{Less-than-or-equal-to with a little room for floating point precision -issues} -\usage{ -x \%<=\% y -} -\arguments{ -\item{x}{Numeric vector} - -\item{y}{Numeric vector} -} -\description{ -Less-than-or-equal-to with a little room for floating point precision -issues -} -\keyword{internal} diff --git a/man/invert_list.Rd b/man/invert_list.Rd index 5ccd27e..ff876c4 100644 --- a/man/invert_list.Rd +++ b/man/invert_list.Rd @@ -9,6 +9,13 @@ invert_list(obj) \arguments{ \item{obj}{list object} } +\value{ +The list object, with values and names inverted. +} \description{ Invert a character list } +\examples{ +invert_list(list(a = "b")) + +} diff --git a/man/irxutils-package.Rd b/man/irxutils-package.Rd new file mode 100644 index 0000000..4b7cb75 --- /dev/null +++ b/man/irxutils-package.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/irxutils-package.R +\docType{package} +\name{irxutils-package} +\alias{irxutils} +\alias{irxutils-package} +\title{irxutils: Generic utils} +\description{ +Small generic functions for e.g. string and object manipulations, datetime parsing, etc. +} +\author{ +\strong{Maintainer}: Ron Keizer \email{ron@insight-rx.com} + +Other contributors: +\itemize{ + \item Michael McCarthy \email{michael.mccarthy@insight-rx.com} [contributor] + \item InsightRX [copyright holder] +} + +} +\keyword{internal} diff --git a/man/random_string.Rd b/man/random_string.Rd index 9308192..ce15be2 100644 --- a/man/random_string.Rd +++ b/man/random_string.Rd @@ -9,6 +9,13 @@ random_string(n = 5) \arguments{ \item{n}{number of characters for random string} } +\value{ +A string of random letters with \code{n} characters. +} \description{ Random string } +\examples{ +random_string(3) + +} diff --git a/man/safe-comparison.Rd b/man/safe-comparison.Rd new file mode 100644 index 0000000..38af645 --- /dev/null +++ b/man/safe-comparison.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/grapes-greater-than-equals-grapes.R +\name{\%>=\%} +\alias{\%>=\%} +\alias{\%<=\%} +\title{Safe relational operators} +\usage{ +x \%>=\% y + +x \%<=\% y +} +\arguments{ +\item{x, y}{Numeric vectors.} +} +\value{ +A logical vector indicating the result of the element by element comparison. +} +\description{ +Binary operators which allow the comparison of values in atomic vectors, with +a little room for floating point precision issues. +} +\details{ +These binary comparison operators make the base relational operators +(\link[base:Comparison]{base::Comparison}) safer by adding a little room for floating point precision +issues. \verb{\%>=\%} is the counterpart to \code{>=}, and \verb{\%<=\%} is the counterpart to +\code{<=}. +} +\examples{ +(0.7 - 0.4) >= 0.3 +(0.7 - 0.4) \%>=\% 0.3 + +} diff --git a/man/underscores_to_dots.Rd b/man/underscores_to_dots.Rd index 03ae051..ba1b063 100644 --- a/man/underscores_to_dots.Rd +++ b/man/underscores_to_dots.Rd @@ -2,10 +2,26 @@ % Please edit documentation in R/underscores_to_dots.R \name{underscores_to_dots} \alias{underscores_to_dots} -\title{Convert underscores to dots} +\alias{dots_to_underscores} +\title{Convert underscores to dots (and vice versa)} \usage{ underscores_to_dots(x) + +dots_to_underscores(x) +} +\arguments{ +\item{x}{A character vector.} +} +\value{ +The character vector \code{x}, with all underscores converted to dots for +\code{underscores_to_dots()} and all dots converted to underscores for +\code{dots_to_underscores()}. } \description{ -Convert underscores to dots +Convert underscores to dots (and vice versa) +} +\examples{ +underscores_to_dots(c("a_b_c", "d_e_f")) +dots_to_underscores(c("a.b.c", "d.e.f")) + } From 6571cbe74000e22f5e2ae5a7dd19a0b037397d9d Mon Sep 17 00:00:00 2001 From: Michael McCarthy <51542091+mccarthy-m-g@users.noreply.github.com> Date: Thu, 18 Dec 2025 10:39:09 -0800 Subject: [PATCH 09/16] add tests --- tests/testthat/test-get_datetime_string.R | 28 ++++++++ tests/testthat/test-get_na_between_non_na.R | 64 +++++++++++++++++++ .../test-grapes-greater-than-equals-grapes.R | 61 ++++++++++++++++++ .../test-grapes-less-than-equals-grapes.R | 6 -- tests/testthat/test-invert_list.R | 33 ++++++++++ tests/testthat/test-random_string.R | 26 ++++++++ tests/testthat/test-underscores_to_dots.R | 38 +++++++++++ tests/testthat/test_get_na_between_non_na.R | 14 ---- 8 files changed, 250 insertions(+), 20 deletions(-) create mode 100644 tests/testthat/test-get_datetime_string.R create mode 100644 tests/testthat/test-get_na_between_non_na.R delete mode 100644 tests/testthat/test-grapes-less-than-equals-grapes.R create mode 100644 tests/testthat/test-invert_list.R create mode 100644 tests/testthat/test-random_string.R create mode 100644 tests/testthat/test-underscores_to_dots.R delete mode 100644 tests/testthat/test_get_na_between_non_na.R diff --git a/tests/testthat/test-get_datetime_string.R b/tests/testthat/test-get_datetime_string.R new file mode 100644 index 0000000..3225472 --- /dev/null +++ b/tests/testthat/test-get_datetime_string.R @@ -0,0 +1,28 @@ +test_that("get_datetime_string() returns a character string", { + out <- get_datetime_string() + expect_type(out, "character") + expect_length(out, 1) +}) + +test_that("get_datetime_string() uses ymdhm format", { + out <- get_datetime_string() + expect_match(out, "^\\d{12}$") # exactly 12 digits: YYYYMMDDHHMM +}) + +test_that("get_datetime_string() matches current time to the minute", { + withr::local_timezone("UTC") + expected <- format(lubridate::now(), "%Y%m%d%H%M") + out <- get_datetime_string() + expect_equal(out, expected) +}) + +test_that("get_datetime_string() returns numeric-only output", { + out <- get_datetime_string() + expect_false(grepl("[^0-9]", out)) +}) + +test_that("get_datetime_string() formats a supplied datetime correctly", { + x <- lubridate::ymd_hms("2024-05-07 05:50:42", tz = "UTC") + out <- get_datetime_string(x) + expect_equal(out, "202405070550") +}) diff --git a/tests/testthat/test-get_na_between_non_na.R b/tests/testthat/test-get_na_between_non_na.R new file mode 100644 index 0000000..cbcbbb5 --- /dev/null +++ b/tests/testthat/test-get_na_between_non_na.R @@ -0,0 +1,64 @@ +test_that("returns numeric indices", { + x <- c(1, NA, 2) + expect_type(get_na_between_non_na(x), "integer") +}) + +test_that("returns index of single NA between two non-NA values", { + x <- c(1, NA, 2) + expect_equal(get_na_between_non_na(x), 2) +}) + +test_that("returns indices of NA values between two non-NA values", { + x <- c(NA, 2, 3, NA, 5, NA, 7, NA, NA, 10, NA) + expect_equal(get_na_between_non_na(x), c(4, 6, 8, 9)) +}) + +test_that("returns indices of multiple consecutive NAs between non-NA values", { + x <- c(1, NA, NA, NA, 2) + expect_equal(get_na_between_non_na(x), c(2, 3, 4)) +}) + +test_that("returns NULL when there are no NAs", { + x <- c(1, 2, 3, 4, 5) + expect_null(get_na_between_non_na(x)) +}) + +test_that("returns NULL when all values are NA", { + x <- c(NA, NA, NA) + expect_null(get_na_between_non_na(x)) +}) + +test_that("returns NULL when only leading NAs before first non-NA value", { + x <- c(NA, NA, 1, 2, 3) + expect_null(get_na_between_non_na(x)) +}) + +test_that("returns NULL when only trailing NAs after last non-NA value", { + x <- c(1, 2, 3, NA, NA) + expect_null(get_na_between_non_na(x)) +}) + +test_that("works with non-numeric vectors", { + x <- c("a", NA, "b", NA, NA, "c") + expect_equal(get_na_between_non_na(x), c(2, 4, 5)) +}) + +test_that("handles vectors of length one correctly", { + expect_null(get_na_between_non_na(NA)) + expect_null(get_na_between_non_na(1)) +}) + +test_that("return correct TRUE/FALSE", { + x1 <- c(NA, 1, 2, 3, NA, 4) # 5 + x2 <- c(NA, 1, 2, 3, NA, NA) # null + x3 <- c(NA, 1, NA, 3, NA, NA) # 3 + x4 <- c(1, NA, 3, NA, NA) # 2 + x5 <- c(1, NA, 3, NA, 9, NA) # 2, 4 + x6 <- c(1, NA, NA, NA, NA) # null + expect_equal(get_na_between_non_na(x1), 5) + expect_null(get_na_between_non_na(x2)) + expect_equal(get_na_between_non_na(x3), 3) + expect_equal(get_na_between_non_na(x4), 2) + expect_equal(get_na_between_non_na(x5), c(2, 4)) + expect_null(get_na_between_non_na(x6)) +}) diff --git a/tests/testthat/test-grapes-greater-than-equals-grapes.R b/tests/testthat/test-grapes-greater-than-equals-grapes.R index dd16ccc..2914615 100644 --- a/tests/testthat/test-grapes-greater-than-equals-grapes.R +++ b/tests/testthat/test-grapes-greater-than-equals-grapes.R @@ -1,6 +1,67 @@ +test_that("%>=% behaves like >= for exact comparisons", { + expect_equal(1 %>=% 1, 1 >= 1) + expect_equal(2 %>=% 1, 2 >= 1) + expect_equal(1 %>=% 2, 1 >= 2) + expect_equal(c(1, 2, 3) %>=% c(1, 1, 3), c(1, 2, 3) >= c(1, 1, 3)) +}) + +test_that("%<=% behaves like <= for exact comparisons", { + expect_equal(1 %<=% 1, 1 <= 1) + expect_equal(1 %<=% 2, 1 <= 2) + expect_equal(2 %<=% 1, 2 <= 1) + expect_equal(c(1, 2, 3) %<=% c(1, 3, 3), c(1, 2, 3) <= c(1, 3, 3)) +}) + +test_that("%>=% tolerates floating point error where >= fails", { + x <- 0.7 - 0.4 + y <- 0.3 + expect_false(x >= y) + expect_true(x %>=% y) +}) + +test_that("%<=% tolerates floating point error where <= fails", { + x <- 0.3 + y <- 0.7 - 0.4 + expect_false(x <= y) + expect_true(x %<=% y) +}) + +test_that("%>=% gives expected result", { + expect_true((1 - 0.8) %>=% ((4 - 2) / 10)) + expect_equal(1:4 %>=% 3, c(FALSE, FALSE, TRUE, TRUE)) + expect_equal(1 %>=% NA, NA) + expect_equal(1:2 %>=% NA, c(NA, NA)) +}) + test_that("%<=% gives expected result", { expect_true(((4 - 2) / 10) %<=% (1 - 0.8)) expect_equal(1:4 %<=% 3, c(TRUE, TRUE, TRUE, FALSE)) expect_equal(1 %<=% NA, NA) expect_equal(1:2 %<=% NA, c(NA, NA)) }) + +test_that("safe operators work element-wise for vectors", { + x <- c(0.7 - 0.4, 1.0, 2.0) + y <- c(0.3, 1.0, 2.1) + expect_equal(x %>=% y, c(TRUE, TRUE, FALSE)) + expect_equal(x %<=% y, c(TRUE, TRUE, TRUE)) +}) + +test_that("safe operators return logical(0) if either input is empty", { + expect_equal(numeric(0) %>=% 1, logical(0)) + expect_equal(1 %>=% numeric(0), logical(0)) + expect_equal(numeric(0) %<=% numeric(0), logical(0)) +}) + +test_that("safe operators respect vector recycling behavior", { + x <- c(1, 2, 3) + y <- 2 + expect_equal(x %>=% y, c(FALSE, TRUE, TRUE)) + expect_equal(x %<=% y, c(TRUE, TRUE, FALSE)) +}) + +test_that("safe operators handle NA values consistently", { + expect_equal(NA %>=% 1, NA) + expect_equal(1 %<=% NA, NA) + expect_equal(c(1, NA, 3) %>=% c(1, 2, NA), c(TRUE, NA, NA)) +}) diff --git a/tests/testthat/test-grapes-less-than-equals-grapes.R b/tests/testthat/test-grapes-less-than-equals-grapes.R deleted file mode 100644 index e87bcd8..0000000 --- a/tests/testthat/test-grapes-less-than-equals-grapes.R +++ /dev/null @@ -1,6 +0,0 @@ -test_that("%>=% gives expected result", { - expect_true((1-0.8) %>=% ((4-2)/10)) - expect_equal(1:4 %>=% 3, c(FALSE, FALSE, TRUE, TRUE)) - expect_equal(1 %>=% NA, NA) - expect_equal(1:2 %>=% NA, c(NA, NA)) -}) diff --git a/tests/testthat/test-invert_list.R b/tests/testthat/test-invert_list.R new file mode 100644 index 0000000..0b1f0c1 --- /dev/null +++ b/tests/testthat/test-invert_list.R @@ -0,0 +1,33 @@ +test_that("invert_list() inverts names and values for a simple list", { + out <- invert_list(list(a = "b")) + expect_equal(out, list(b = "a")) +}) + +test_that("invert_list() works with multiple elements", { + out <- invert_list(list(a = "b", c = "d")) + expect_equal(out, list(b = "a", d = "c")) +}) + +test_that("invert_list() casts values to character for names", { + out <- invert_list(list(a = 1, b = 2)) + expect_named(out, c("1", "2")) +}) + +test_that("invert_list() overwrites values when names collide", { + out <- invert_list(list(loser = "b", winner = "b")) + expect_equal(out, list(b = "winner")) # last assignment wins +}) + +test_that("invert_list() returns an empty list when input is empty", { + out <- invert_list(list()) + expect_equal(out, list()) +}) + +# TODO: fix test and/or revise behaviour +test_that("invert_list errors or behaves unexpectedly for non-length-1 values", { + x <- list(a = c("b", "c")) + + expect_error( + invert_list(x) + ) +}) diff --git a/tests/testthat/test-random_string.R b/tests/testthat/test-random_string.R new file mode 100644 index 0000000..930ed94 --- /dev/null +++ b/tests/testthat/test-random_string.R @@ -0,0 +1,26 @@ +test_that("returns a character scalar", { + x <- random_string() + expect_type(x, "character") + expect_length(x, 1) +}) + +test_that("returns correct length", { + expect_equal(nchar(random_string(1)), 1) + expect_equal(nchar(random_string(5)), 5) + expect_equal(nchar(random_string(10)), 10) +}) + +test_that("contains only lowercase letters", { + x <- random_string(100) + expect_true(grepl("^[a-z]+$", x)) +}) + +test_that("returns empty string with n = 0", { + expect_equal(random_string(0), "") +}) + +test_that("is reproducible with set.seed()", { + x1 <- withr::with_seed(123, random_string(n = 6)) + x2 <- withr::with_seed(123, random_string(n = 6)) + expect_identical(x1, x2) +}) diff --git a/tests/testthat/test-underscores_to_dots.R b/tests/testthat/test-underscores_to_dots.R new file mode 100644 index 0000000..6e156a4 --- /dev/null +++ b/tests/testthat/test-underscores_to_dots.R @@ -0,0 +1,38 @@ +test_that("underscores_to_dots() converts underscores to dots", { + expect_equal(underscores_to_dots(c("a_b_c", "d_e_f")), c("a.b.c", "d.e.f")) +}) + +test_that("dots_to_underscores() converts dots to underscores", { + expect_equal(dots_to_underscores(c("a.b.c", "d.e.f")), c("a_b_c", "d_e_f")) +}) + +test_that("functions are vectorized", { + x <- c("a_b", "c_d", "e_f") + y <- c("a.b", "c.d", "e.f") + expect_length(underscores_to_dots(x), length(x)) + expect_length(dots_to_underscores(y), length(y)) +}) + +test_that("strings without target characters are unchanged", { + expect_equal(underscores_to_dots("abc"), "abc") + expect_equal(dots_to_underscores("abc"), "abc") +}) + +test_that("empty strings are handled correctly", { + expect_equal(underscores_to_dots(""), "") + expect_equal(dots_to_underscores(""), "") +}) + +test_that("NA values are preserved", { + x <- c("a_b", NA_character_) + y <- c("a.b", NA_character_) + expect_equal(underscores_to_dots(x), y) + expect_equal(dots_to_underscores(y), x) +}) + +test_that("round-trip conversion works when all underscores or dots", { + x <- c("a_b_c", "d_e_f") + y <- c("a.b.c", "d.e.f") + expect_equal(dots_to_underscores(underscores_to_dots(x)), x) + expect_equal(underscores_to_dots(dots_to_underscores(y)), y) +}) diff --git a/tests/testthat/test_get_na_between_non_na.R b/tests/testthat/test_get_na_between_non_na.R deleted file mode 100644 index adc6454..0000000 --- a/tests/testthat/test_get_na_between_non_na.R +++ /dev/null @@ -1,14 +0,0 @@ -test_that("return correct TRUE/FALSE", { - x1 <- c(NA, 1, 2, 3, NA, 4) # 5 - x2 <- c(NA, 1, 2, 3, NA, NA) # null - x3 <- c(NA, 1, NA, 3, NA, NA) # 3 - x4 <- c(1, NA, 3, NA, NA) # 2 - x5 <- c(1, NA, 3, NA, 9, NA) # 2, 4 - x6 <- c(1, NA, NA, NA, NA) # null - expect_equal(get_na_between_non_na(x1), 5) - expect_null(get_na_between_non_na(x2)) - expect_equal(get_na_between_non_na(x3), 3) - expect_equal(get_na_between_non_na(x4), 2) - expect_equal(get_na_between_non_na(x5), c(2, 4)) - expect_null(get_na_between_non_na(x6)) -}) From 3ffc724812ff259b7955ecec6713d5c21192084d Mon Sep 17 00:00:00 2001 From: Michael McCarthy <51542091+mccarthy-m-g@users.noreply.github.com> Date: Thu, 18 Dec 2025 10:40:05 -0800 Subject: [PATCH 10/16] add NEWS --- NEWS.md | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 NEWS.md diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 0000000..f722f54 --- /dev/null +++ b/NEWS.md @@ -0,0 +1,3 @@ +# irxutils (development version) + +* Initial CRAN submission. From cd0bc07af9c154f9eeac2835f971b13a4e506a5a Mon Sep 17 00:00:00 2001 From: Michael McCarthy <51542091+mccarthy-m-g@users.noreply.github.com> Date: Thu, 18 Dec 2025 10:53:26 -0800 Subject: [PATCH 11/16] revise README and pkgdown --- README.Rmd | 27 +++++---------------------- README.md | 39 ++++++++------------------------------- _pkgdown.yml | 4 ++++ 3 files changed, 17 insertions(+), 53 deletions(-) diff --git a/README.Rmd b/README.Rmd index de4f67c..95c3ecc 100644 --- a/README.Rmd +++ b/README.Rmd @@ -24,34 +24,17 @@ The goal of irxutils is to provide miscellaneous generic functions, mostly low-l ## Installation -You can install the development version of irxutils from [GitHub](https://github.com/) with: +Install the development version from [GitHub](https://github.com/InsightRX/irxutils) with: ``` r # install.packages("pak") pak::pak("InsightRX/irxutils") ``` -## Example +## Documentation -This is a basic example which shows you how to solve a common problem: +See at [`https://insightrx.github.io/irxutils/`](https://insightrx.github.io/irxutils/reference/index.html) and also in the installed package: `help(package = "irxutils")`. -```{r example} -library(irxutils) -## basic example code -``` - -What is special about using `README.Rmd` instead of just `README.md`? You can include R chunks like so: - -```{r cars} -summary(cars) -``` - -You'll still need to render `README.Rmd` regularly, to keep `README.md` up-to-date. `devtools::build_readme()` is handy for this. - -You can also embed plots, for example: - -```{r pressure, echo = FALSE} -plot(pressure) -``` +## License -In that case, don't forget to commit and push the resulting figure files, so they display on GitHub and CRAN. +© InsightRX diff --git a/README.md b/README.md index a34b6ab..f715187 100644 --- a/README.md +++ b/README.md @@ -15,43 +15,20 @@ mostly low-level, for use in InsightRX packages. ## Installation -You can install the development version of irxutils from -[GitHub](https://github.com/) with: +Install the development version from +[GitHub](https://github.com/InsightRX/irxutils) with: ``` r # install.packages("pak") pak::pak("InsightRX/irxutils") ``` -## Example +## Documentation -This is a basic example which shows you how to solve a common problem: +See at +[`https://insightrx.github.io/irxutils/`](https://insightrx.github.io/irxutils/reference/index.html) +and also in the installed package: `help(package = "irxutils")`. -``` r -library(irxutils) -## basic example code -``` - -What is special about using `README.Rmd` instead of just `README.md`? -You can include R chunks like so: - -``` r -summary(cars) -#> speed dist -#> Min. : 4.0 Min. : 2.00 -#> 1st Qu.:12.0 1st Qu.: 26.00 -#> Median :15.0 Median : 36.00 -#> Mean :15.4 Mean : 42.98 -#> 3rd Qu.:19.0 3rd Qu.: 56.00 -#> Max. :25.0 Max. :120.00 -``` - -You’ll still need to render `README.Rmd` regularly, to keep `README.md` -up-to-date. `devtools::build_readme()` is handy for this. - -You can also embed plots, for example: - - +## License -In that case, don’t forget to commit and push the resulting figure -files, so they display on GitHub and CRAN. +© InsightRX diff --git a/_pkgdown.yml b/_pkgdown.yml index 7e97580..0420314 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -1,3 +1,7 @@ url: https://insightrx.github.io/irxutils/ + +development: + mode: auto + template: bootstrap: 5 From d3dda908200d7e961b4f77726c6ad8b0abdb4257 Mon Sep 17 00:00:00 2001 From: Michael McCarthy <51542091+mccarthy-m-g@users.noreply.github.com> Date: Thu, 15 Jan 2026 09:44:24 -0800 Subject: [PATCH 12/16] add TODOs and tests for `is_continuous()` --- R/is_continuous.R | 44 +++++++++++++---- man/is_continuous.Rd | 21 ++++++-- tests/testthat/test-is_continuous.R | 75 +++++++++++++++++++++++++++++ 3 files changed, 128 insertions(+), 12 deletions(-) create mode 100644 tests/testthat/test-is_continuous.R diff --git a/R/is_continuous.R b/R/is_continuous.R index 3285895..9ced9c9 100644 --- a/R/is_continuous.R +++ b/R/is_continuous.R @@ -1,22 +1,48 @@ #' Test if a vector of values is likely to be continuous or categorical #' #' The function will try to convert all values to numeric. If a certain fraction -#' of values is able to convert succesfully, it will assume the vector is -#' continuous. Default treshold is 0.8. +#' of values is able to convert successfully, it will assume the vector is +#' continuous. Default threshold is 0.8. #' #' @param x vector of values -#' @param cutoff cutoff value for deciding between continuous/categorical +#' @param cutoff A cutoff value between 0 and 1 for deciding between +#' continuous/categorical. Default threshold is 0.8. +#' +#' @details +#' The function will try to convert all values to numeric. If a certain fraction +#' of values is able to convert successfully, it will assume the vector is +#' continuous. +#' +#' @returns +#' `TRUE` if the vector of values is likely to be continuous, otherwise `FALSE`. +#' +#' @examples +#' is_continuous(1:3) +#' is_continuous(c(1, 3, 5)) +#' is_continuous(c("a", 1)) #' #' @export is_continuous <- function(x, cutoff = 0.8) { - if (cutoff > 1) { + # TODO: should better define the meaning of continuous and categorical here, + # what type of input `x` accepts (character, logical vectors, 0s and 1s, etc.), + # expected outputs with different inputs. + + # TODO: Want function to behave like this description: Pharmacometric datasets + # are most often stored just as CSV, so we don’t have info on whether a column + # in the dataset is numeric or factor. Sometimes we have a data dictionary, + # sometimes we don’t. If we don’t, we need to figure out whether a columns is + # likely to be continuous (i.e. double or numeric in progrmaming lingo, like + # TIME or DV in NONMEM dataset), or categorical (e.g. SEX in NONMEM datasets). + # That’s all this function is supposed to figure out. + + if (cutoff > 1) { warning("Can't have a cutoff greater than 1; setting value to 1 instead") cutoff <- 1 } - suppressWarnings( - tmp <- as.numeric(as.character(x)) - ) - - # Are number of *new* NAs/total number of values <= 1 - cutoff + if (is.logical(x)) { + x <- as.numeric(x) + } + tmp <- suppressWarnings(as.numeric(as.character(x))) + # Are number of *new* NAs/total number of values <= 1 - cutoff? ((sum(is.na(tmp)) - sum(is.na(x))) / length(tmp)) %<=% (1 - cutoff) } diff --git a/man/is_continuous.Rd b/man/is_continuous.Rd index c57a2a5..2afd9c8 100644 --- a/man/is_continuous.Rd +++ b/man/is_continuous.Rd @@ -9,10 +9,25 @@ is_continuous(x, cutoff = 0.8) \arguments{ \item{x}{vector of values} -\item{cutoff}{cutoff value for deciding between continuous/categorical} +\item{cutoff}{A cutoff value between 0 and 1 for deciding between +continuous/categorical. Default threshold is 0.8.} +} +\value{ +\code{TRUE} if the vector of values is likely to be continuous, otherwise \code{FALSE}. } \description{ The function will try to convert all values to numeric. If a certain fraction -of values is able to convert succesfully, it will assume the vector is -continuous. Default treshold is 0.8. +of values is able to convert successfully, it will assume the vector is +continuous. Default threshold is 0.8. +} +\details{ +The function will try to convert all values to numeric. If a certain fraction +of values is able to convert successfully, it will assume the vector is +continuous. +} +\examples{ +is_continuous(1:3) +is_continuous(c(1, 3, 5)) +is_continuous(c("a", 1)) + } diff --git a/tests/testthat/test-is_continuous.R b/tests/testthat/test-is_continuous.R new file mode 100644 index 0000000..660022e --- /dev/null +++ b/tests/testthat/test-is_continuous.R @@ -0,0 +1,75 @@ +# TODO: review tests, see if expectations are concordant with what we want +# is_continuous() to do. Update if needed, these aren't sacred yet. + +test_that("numeric vectors are classified as continuous", { + expect_true(is_continuous(1:10)) + expect_true(is_continuous(c(1, 3, 5, 7))) + expect_true(is_continuous(runif(10))) +}) + +test_that("character vectors that are numeric are classified as continuous", { + x <- c("1", "2", "3.5", "4") + expect_true(is_continuous(x)) +}) + +test_that("mixed character and numeric values respect the cutoff", { + x <- c("1", "2", "a", "3", "4") + expect_true(is_continuous(x, cutoff = 0.8)) + expect_false(is_continuous(x, cutoff = 0.9)) +}) + +test_that("clearly categorical vectors are classified as not continuous", { + x <- c("a", "b", "c", "d") + expect_false(is_continuous(x)) +}) + +test_that("existing NA values are not counted toward cutoff", { + x1 <- c("1", "2", NA, "3") + x2 <- c(1:10, rep(NA, 5)) + x3 <- c(1:8, LETTERS[1:2]) + x4 <- c(1:4, rep(NA, 4), LETTERS[1:2]) + expect_true(is_continuous(x1)) + expect_true(is_continuous(x2)) + expect_true(is_continuous(x3)) + expect_true(is_continuous(x4)) + expect_false(is_continuous(x4, cutoff = 0.9)) +}) + +test_that("new NAs introduced by coercion are counted correctly", { + x <- c("1", "2", "a", NA) + + # One new NA from coercion out of 4 total values + expect_true(is_continuous(x, cutoff = 0.7)) + expect_false(is_continuous(x, cutoff = 0.9)) +}) + +test_that("cutoff greater than 1 is reset to 1 with a warning", { + x <- c("1", "2", "a") + expect_warning(out <- is_continuous(x, cutoff = 1.5), "cutoff greater than 1") + # With cutoff forced to 1, no new NAs are allowed + expect_false(out) +}) + +test_that("cutoff of exactly 1 requires all values to be numeric", { + expect_true(is_continuous(c("1", "2", "3"), cutoff = 1)) + expect_false(is_continuous(c("1", "2", "a"), cutoff = 1)) +}) + +# TODO: probably expect FALSE here, should be treated as categorical. Should also +# add a test for 0s and 1s. +test_that("logical vectors are treated as numeric", { + x <- c(TRUE, FALSE, TRUE) + expect_true(is_continuous(x)) +}) + +# TODO: +# test_that("empty vectors return FALSE", { +# expect_false(is_continuous(character())) +# }) + +test_that("is_continuous gives expected results", { + expect_true(is_continuous(1:10)) + expect_false(is_continuous(LETTERS)) + expect_true(is_continuous(c("a", 1:9), cutoff = 0.8)) + expect_false(is_continuous(c("a", 1:9), cutoff = 1)) +}) From 4e362ef852773f5d07d195922f32382f20793f3c Mon Sep 17 00:00:00 2001 From: Michael McCarthy <51542091+mccarthy-m-g@users.noreply.github.com> Date: Thu, 15 Jan 2026 09:44:32 -0800 Subject: [PATCH 13/16] add TODO --- R/invert_list.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/invert_list.R b/R/invert_list.R index 5887a8c..7bb445f 100644 --- a/R/invert_list.R +++ b/R/invert_list.R @@ -10,6 +10,7 @@ #' #' @export invert_list <- function(obj) { + # TODO: this only works for lists where the value is of length 1. Should probably add a test or something new_obj <- list() for(key in names(obj)) { new_obj[[as.character(obj[[key]])]] <- key # legacy! remove once all covariates have been moved to md From 946a03c7c942de69f8ea8925a031d15461e7ce8c Mon Sep 17 00:00:00 2001 From: Michael McCarthy <51542091+mccarthy-m-g@users.noreply.github.com> Date: Thu, 15 Jan 2026 09:45:35 -0800 Subject: [PATCH 14/16] use MIT --- .Rbuildignore | 1 + DESCRIPTION | 2 +- LICENSE | 3 ++- LICENSE.md | 21 +++++++++++++++++++++ 4 files changed, 25 insertions(+), 2 deletions(-) create mode 100644 LICENSE.md diff --git a/.Rbuildignore b/.Rbuildignore index 3d11058..787c741 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -7,3 +7,4 @@ ^pkgdown$ ^codecov\.yml$ ^README\.Rmd$ +^LICENSE\.md$ diff --git a/DESCRIPTION b/DESCRIPTION index 710ab15..880b347 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,7 +13,7 @@ Imports: Suggests: testthat (>= 3.2.0), withr -License: file LICENSE +License: MIT + file LICENSE Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.3 diff --git a/LICENSE b/LICENSE index ffea2c3..5214c3e 100644 --- a/LICENSE +++ b/LICENSE @@ -1 +1,2 @@ -Copyright 2023 InsightRX. All rights reserved. +YEAR: 2026 +COPYRIGHT HOLDER: InsightRX diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 index 0000000..a1726da --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,21 @@ +# MIT License + +Copyright (c) 2026 InsightRX + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. From 8d324cdf221e08b06628510b9e65602b64c0edc2 Mon Sep 17 00:00:00 2001 From: Michael McCarthy <51542091+mccarthy-m-g@users.noreply.github.com> Date: Fri, 16 Jan 2026 09:26:37 -0800 Subject: [PATCH 15/16] add pkgdown URL --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index 880b347..db4eaaa 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -18,3 +18,4 @@ Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.3 Config/testthat/edition: 3 +URL: https://insightrx.github.io/irxutils/ From a3449a256905528af5d4cf119d9c4bdf0ee87afe Mon Sep 17 00:00:00 2001 From: Michael McCarthy <51542091+mccarthy-m-g@users.noreply.github.com> Date: Fri, 16 Jan 2026 09:56:30 -0800 Subject: [PATCH 16/16] update README --- README.Rmd | 2 +- README.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/README.Rmd b/README.Rmd index 95c3ecc..6e3b5a6 100644 --- a/README.Rmd +++ b/README.Rmd @@ -37,4 +37,4 @@ See at [`https://insightrx.github.io/irxutils/`](https://insightrx.github.io/irx ## License -© InsightRX +MIT © InsightRX diff --git a/README.md b/README.md index f715187..2cdfec9 100644 --- a/README.md +++ b/README.md @@ -31,4 +31,4 @@ and also in the installed package: `help(package = "irxutils")`. ## License -© InsightRX +MIT © InsightRX