Merge pull request #212 from adibender/fix-attributes

Fix int_info.pamm
adibender · Jan 3, 2022 · 8c04102 · 8c04102
2 parents 350cbcf + 1bf8b74
commit 8c04102
Show file tree

Hide file tree

Showing 5 changed files with 15 additions and 8 deletions.
diff --git a/R/interval-information.R b/R/interval-information.R
@@ -109,7 +109,7 @@ int_info.ped <- function(x, ...) {
 #' @keywords internal
 int_info.pamm <- function(x, ...) {
 
-  int_info(x[["trafo_args"]][["cut"]])
+  int_info(x[["attr_ped"]][["breaks"]],...)
 
 }
 

diff --git a/R/pammfit.R b/R/pammfit.R
@@ -66,10 +66,10 @@ pamm <- function(
 
   pamm_fit        <- do.call(engine, dots)
   class(pamm_fit) <- c("pamm", class(pamm_fit))
-  pamm_fit        <- append_ped_attr(pamm_fit, data)
+  # pamm_fit        <- append_ped_attr(pamm_fit, data)
   pamm_fit[["trafo_args"]] <- attr(data, "trafo_args")
   ind_attr_keep <- !(names(attributes(data)) %in%
-    c("names", "row.names", "breaks", "trafo_args", "class"))
+    c("names", "row.names", "trafo_args", "class"))
   pamm_fit[["attr_ped"]] <- attributes(data)[ind_attr_keep]
 
   pamm_fit

diff --git a/R/split-data.R b/R/split-data.R
@@ -203,7 +203,7 @@ split_data_recurrent <- function(
   cuts <- get_cut(data_list, formula, cut = cut, max_time = max_time,
     event = event, timescale = timescale)
 
-  ## create argument list to be passed to survSplit
+  ## create argument list to be passed to split_data
   dots <- list(...)
 
   # if id allready in the data set, remove id variable from dots but keep

diff --git a/R/tidyverse-methods.R b/R/tidyverse-methods.R
@@ -34,8 +34,16 @@ reped <- function(.data, ped_classes = "ped") {
 
 }
 
-ped_attr <- function(ped) {
-  attributes(ped)[c("breaks", "id_var", "intvars", "combine", "censor_code", "risks")]
+ped_attr <- function(
+  ped,
+  ped_attributes = c("breaks", "id_var", "intvars", "combine", "censor_code", "risks")
+) {
+
+  attr_ped <- attributes(ped)
+  ped_attr_avail <- intersect(names(attr_ped), ped_attributes)
+
+  attr_ped[ped_attr_avail]
+
 }
 
 unfped <- function(fped) {

diff --git a/R/warnings.R b/R/warnings.R
@@ -38,8 +38,7 @@ warn_about_new_time_points.glm <- function(object, newdata, time_var, ...) {
 warn_about_new_time_points.pamm <- function(object, newdata, ...) {
 
   if (inherits(object, "pamm")) {
-    cut <- object$trafo_args$cut
-    int_original <- int_info(cut)$interval
+    int_original <- int_info(object)
     if ("interval" %in% colnames(newdata)) {
       int_new <- unique(newdata[["interval"]])
       if(!all(int_new %in% int_original)) {