Merge pull request #248 from adibender/issue-247

Issue 247

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: pammtools
 Title: Piece-Wise Exponential Additive Mixed Modeling Tools for Survival Analysis
-Version: 0.5.93
-Date: 2024-02-24
+Version: 0.6.01
+Date: 2025-01-29
 Authors@R: c(
     person("Andreas", "Bender", , "[email protected]", role = c("aut", "cre"), comment=c(ORCID = "0000-0001-5628-8611")),
     person("Fabian", "Scheipl", , "[email protected]", role = c("aut"), comment = c(ORCID = "0000-0001-8172-3603")),
@@ -16,7 +16,7 @@ Description: The Piece-wise exponential (Additive Mixed) Model
     including data simulation, transformation and other functions for data
     preprocessing and model post-processing as well as visualization.
 Depends:
-    R (>= 3.5.0)
+    R (>= 4.1.0)
 Imports:
     mgcv,
     survival (>= 2.39-5),
@@ -45,6 +45,6 @@ License: MIT + file LICENSE
 LazyData: true
 URL: https://adibender.github.io/pammtools/
 BugReports: https://github.com/adibender/pammtools/issues
-RoxygenNote: 7.1.2
+RoxygenNote: 7.3.2
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)

R/add-functions.R

@@ -71,21 +71,31 @@ add_term <- function(
 
 }
 
+#' Create design matrix from a suitable object
+#'
+#' @keywords internal
+#' @param object A suitable object from which a design matrix can be generated.
+#' Often a model object.
 make_X <- function(object, ...) {
 
   UseMethod("make_X", object)
 
 }
 
+#' @rdname make_X
+#' @inherit make_X
+#' @param newdata A data frame from which design matrix will be constructed
 make_X.default <- function(object, newdata, ...) {
 
-  X <- model.matrix(object$formula[-2], data = newdata, ...)
+  model.matrix(object$formula[-2], data = newdata, ...)
 
 }
 
+#' @inherit make_X.default
+#' @rdname make_X
 make_X.gam <- function(object, newdata, ...) {
 
-  X <- predict.gam(object, newdata = newdata, type = "lpmatrix", ...)
+  predict.gam(object, newdata = newdata, type = "lpmatrix", ...)
 
 }
 

R/get-cut-points.R

@@ -41,6 +41,8 @@ get_cut.default <- function(
 }
 
 
+#' @rdname get_cut
+#' @inherit get_cut
 get_cut.list <- function (
   data,
   formula,

R/ggplot-extensions.R

@@ -11,8 +11,6 @@
 #' @seealso
 #'   \code{\link[ggplot2]{geom_ribbon}} \code{geom_stepribbon}
 #'   inherits from \code{geom_ribbon}.
-#' @inheritParams ggplot2:::geom_ribbon
-#' @inheritParams ggplot2:::geom_step
 #' @examples
 #' library(ggplot2)
 #' huron <- data.frame(year = 1875:1972, level = as.vector(LakeHuron))
@@ -23,6 +21,8 @@
 #'     geom_line(aes(y = level))
 #' @rdname geom_stepribbon
 #' @importFrom ggplot2 layer GeomRibbon
+#' @inheritParams ggplot2::geom_step
+#' @inheritParams ggplot2::geom_ribbon
 #' @export
 geom_stepribbon <- function(
   mapping     = NULL,

R/interval-information.R

@@ -39,21 +39,20 @@ int_info.default <- function(
   if (is.unsorted(x)) {
     x <- sort(x)
   }
-  if (min(x != 0)) {
+  if (min(x) != 0) {
     x <- c(0, x)
   }
 
-  intlen <- diff(x)
   tstart <- x[-length(x)]
-  tend   <- tstart + intlen
+  tend   <- x[-1]
 
   tdf <- data.frame(
     tstart = tstart,
     tend   = tend,
-    intlen = intlen) %>%
+    intlen = tend - tstart) %>%
     mutate(
-      intmid = tstart + intlen / 2,
-      interval = paste0("(", tstart, ",", tend, "]"),
+      intmid = .data$tstart + .data$intlen / 2,
+      interval = paste0("(", .data$tstart, ",", .data$tend, "]"),
       interval = factor(.data$interval, levels = unique(.data$interval))
     )
 
@@ -155,7 +154,7 @@ get_intervals.default <- function(
   int_df <- int_info(x)
   int    <- findInterval(
     x                = times,
-    vec              = sort(union(int_df$tstart, int_df$tend)),
+    vec              = c(int_df$tstart[1], int_df$tend),
     left.open        = left.open,
     rightmost.closed = rightmost.closed)
 

R/pammtools.R

@@ -50,6 +50,6 @@
 #'
 #' Bender, Andreas, and Fabian Scheipl. 2018.
 #' “pammtools: Piece-Wise Exponential Additive Mixed Modeling Tools.”
-#' ArXiv:1806.01042 [Stat], June. https://arxiv.org/abs/1806.01042.
-NULL
+#' ArXiv:1806.01042 Stat, June. https://arxiv.org/abs/1806.01042.
+"_PACKAGE"
 NULL

R/warnings.R

@@ -7,23 +7,27 @@ warn_about_new_time_points <- function(object, newdata, ...) {
 
 }
 
-
+#' @inherit warn_about_new_time_points
+#' @keywords internal
 warn_about_new_time_points.glm <- function(object, newdata, time_var, ...) {
 
   is_pam <- inherits(object, "gam")
 
-  if(is_pam & is.null(object$model)){
+  if (is_pam && is.null(object$model)) {
     return(invisible())
   }
 
   original_intervals <- if (is_pam) {
     unique(model.frame(object)[[time_var]])
-  } else levels(model.frame(object)[[time_var]])
+  } else {
+    levels(model.frame(object)[[time_var]])
+  }
   prediction_intervals <- if (is_pam) {
     unique(newdata[[time_var]])
-  } else levels(factor(newdata[[time_var]]))
+  } else {
+    levels(factor(newdata[[time_var]]))
+  }
   new_ints <- which(!(prediction_intervals %in% original_intervals))
-  n_out <- pmin(10, length(new_ints))
   if (length(new_ints)) {
    message <- paste0(
     "Time points/intervals in new data not equivalent to time points/intervals during model fit.",