RXR-2948: Clean up package

.Rbuildignore

@@ -2,3 +2,9 @@
 ^\.Rproj\.user$
 ^\.github$
 ^docker$
+^_pkgdown\.yml$
+^docs$
+^pkgdown$
+^codecov\.yml$
+^README\.Rmd$
+^LICENSE\.md$

.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

.gitignore

@@ -3,3 +3,4 @@
 .Rhistory
 .RData
 .Ruserdata
+docs

DESCRIPTION

@@ -3,17 +3,19 @@ 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 <ron@insight-rx.com>
 Description: Small generic functions for e.g. string and object manipulations, 
     datetime parsing, etc.
 Imports:
+    lubridate
 Suggests:
-    testthat (>= 3.2.0)
-License: file LICENSE
+    testthat (>= 3.2.0),
+    withr
+License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.3
 Config/testthat/edition: 3
+URL: https://insightrx.github.io/irxutils/

LICENSE

@@ -1 +1,2 @@
-Copyright 2023 InsightRX. All rights reserved.
+YEAR: 2026
+COPYRIGHT HOLDER: InsightRX

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.

NEWS.md

@@ -0,0 +1,3 @@
+# irxutils (development version)
+
+* Initial CRAN submission.

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")
 }

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
-}
+}

R/grapes-greater-than-equals-grapes.R

@@ -1,13 +1,37 @@
-#' 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) {
     return(logical(0))
   }
   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)
+}

R/invert_list.R

@@ -1,12 +1,19 @@
 #' 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) {
+  # 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 # 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
 }

R/irxutils-package.R

@@ -0,0 +1,6 @@
+#' @keywords internal
+"_PACKAGE"
+
+## usethis namespace: start
+## usethis namespace: end
+NULL

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)
 }

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="")
 }

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)