From d32122086bdd516fa2d2857817123e35c2d9a035 Mon Sep 17 00:00:00 2001 From: Quentin Marcou <18257721+qmarcou@users.noreply.github.com> Date: Thu, 30 May 2024 12:34:21 +0200 Subject: [PATCH] fix missing namespace --- R/renewnetTPreg.R | 10 +++---- R/survexp_wrappers.R | 69 +------------------------------------------- 2 files changed, 6 insertions(+), 73 deletions(-) diff --git a/R/renewnetTPreg.R b/R/renewnetTPreg.R index 19b5d51..76ec9b8 100644 --- a/R/renewnetTPreg.R +++ b/R/renewnetTPreg.R @@ -28,7 +28,7 @@ mod.glm.fit.errorwrapper <- response, family, weights, - maxit = glm.control()$maxit, + maxit = stats::glm.control()$maxit, maxmaxit = 1000, warning_str = "", ...) { @@ -41,7 +41,7 @@ mod.glm.fit.errorwrapper <- family = family, weights = weights, start = rep.int(0, times = ncol(X)), - control = glm.control(maxit = maxit) + control = stats::glm.control(maxit = maxit) ) }, warning = function(warn) { @@ -138,7 +138,7 @@ mod.glm.fit.callingwrapper <- response, family, weights, - maxit = glm.control()$maxit, + maxit = stats::glm.control()$maxit, maxmaxit = 1000, warning_str = "", ...) { @@ -591,8 +591,8 @@ estimate_censoring_dist <- get_survival_at <- function(t, survfit_data, safe = TRUE) { # Return the `surv` value for the row with greatest time lower than t using a # step function - if (is(survfit_data, "survfit")) survfit_data <- summary(survfit_data) - if (is(survfit_data, "summary.survfit")) { + if (isa(survfit_data, "survfit")) survfit_data <- summary(survfit_data) + if (isa(survfit_data, "summary.survfit")) { survfit_data <- tibble::tibble( time = survfit_data$time, surv = survfit_data$surv diff --git a/R/survexp_wrappers.R b/R/survexp_wrappers.R index 839693a..e079e24 100644 --- a/R/survexp_wrappers.R +++ b/R/survexp_wrappers.R @@ -236,7 +236,7 @@ dftoRatetable <- function( list(relsurv::transrate( lifetable[ sexe == "M" & dept == dep, - .(agerev, annee, yearsurv = 1 - mua) + list(agerev, annee, yearsurv = 1 - mua) ] %>% tidyr::pivot_wider( id_cols = agerev, @@ -350,70 +350,3 @@ dftoRatetable <- function( } } - - -# nessie function from the relsurv package, under GNU GPL -nessie <- function (formula = formula(data), data = parent.frame(), ratetable = relsurv::slopop, - times, rmap) -{ - call <- match.call() - if (!missing(rmap)) { - rmap <- substitute(rmap) - } - na.action <- NA - rform <- rformulate(formula, data, ratetable, na.action, - rmap) - templab <- attr(rform$Terms, "term.labels") - if (!is.null(attr(rform$Terms, "specials")$ratetable)) - templab <- templab[-length(templab)] - nameslist <- vector("list", length(templab)) - for (it in 1:length(nameslist)) { - valuetab <- table(data[, match(templab[it], names(data))]) - nameslist[[it]] <- paste(templab[it], names(valuetab), - sep = "") - } - names(nameslist) <- templab - data <- rform$data - p <- rform$m - if (p > 0) { - data$Xs <- my.strata(rform$X[, , drop = F], nameslist = nameslist) - } - else data$Xs <- rep(1, nrow(data)) - if (!missing(times)) - tis <- times - else tis <- unique(sort(floor(rform$Y/365.241))) - tis <- unique(c(0, tis)) - tisd <- tis * 365.241 - out <- NULL - out$n <- table(data$Xs) - out$sp <- out$strata <- NULL - for (kt in order(names(table(data$Xs)))) { - inx <- which(data$Xs == names(out$n)[kt]) - temp <- exp.prep(rform$R[inx, , drop = FALSE], rform$Y[inx], - rform$ratetable, rform$status[inx], times = tisd, - fast = FALSE) - out$time <- c(out$time, tisd) - out$sp <- c(out$sp, temp$sis) - out$strata <- c(out$strata, length(tis)) - temp <- exp.prep(rform$R[inx, , drop = FALSE], rform$Y[inx], - rform$ratetable, rform$status[inx], times = (seq(0, - 100, by = 0.5) * 365.241)[-1], fast = FALSE) - out$povp <- c(out$povp, mean(temp$sit/365.241)) - } - names(out$strata) <- names(out$n)[order(names(table(data$Xs)))] - if (p == 0) - out$strata <- NULL - mata <- matrix(out$sp, ncol = length(tis), byrow = TRUE) - mata <- data.frame(mata) - mata <- cbind(mata, out$povp) - row.names(mata) <- names(out$n)[order(names(table(data$Xs)))] - names(mata) <- c(tis, "c.exp.surv") - cat("\n") - print(round(mata, 1)) - cat("\n") - out$mata <- mata - out$n <- as.vector(out$n) - class(out) <- "nessie" - invisible(out) -} -