add parametric model

.github/workflows/rcmdcheck.yml

@@ -71,7 +71,7 @@ jobs:
           reticulate::install_miniconda()
           install.packages('keras')
           keras::install_keras(extra_packages = c('IPython', 'requests', 'certifi', 'urllib3', 'tensorflow-hub', 'tabnet==0.1.4.1'))
-          reticulate::py_install(c('torch', 'pycox'), pip = TRUE)
+          reticulate::py_install(c('torch', 'pycox', 'pandas==1.4.4'), pip = TRUE)
         shell: Rscript {0}
 
       - name: Session info

DESCRIPTION

@@ -1,12 +1,16 @@
 Package: survivalmodels
 Title: Models for Survival Analysis
-Version: 0.1.18
-Authors@R:
-    person(given = "Raphael",
+Version: 0.1.19
+Authors@R: 
+    c(person(given = "Raphael",
            family = "Sonabend",
-           role = c("aut", "cre"),
-           email = "[email protected]",
-           comment = c(ORCID = "0000-0001-9225-4654"))
+           role = c("aut"),
+           comment = c(ORCID = "0000-0001-9225-4654")),
+      person(given = "Yohann",
+           family = "Foucher",
+           role = c("cre"),
+           email = "[email protected]",
+           comment = c(ORCID = "0000-0003-0330-7457")))
 Description: Implementations of classical and machine learning models for survival analysis, including deep neural networks via 'keras' and 'tensorflow'. Each model includes a separated fit and predict interface with consistent prediction types for predicting risk, survival probabilities, or survival distributions with 'distr6' <https://CRAN.R-project.org/package=distr6>. Models are either implemented from 'Python' via 'reticulate' <https://CRAN.R-project.org/package=reticulate>, from code in GitHub packages, or novel implementations using 'Rcpp' <https://CRAN.R-project.org/package=Rcpp>. Novel machine learning survival models wil be included in the package in near-future updates. Neural networks are implemented from the 'Python' package 'pycox' <https://github.com/havakv/pycox> and are detailed by Kvamme et al. (2019) <https://jmlr.org/papers/v20/18-424.html>. The 'Akritas' estimator is defined in Akritas (1994) <doi:10.1214/aos/1176325630>. 'DNNSurv' is defined in Zhao and Feng (2020) <arXiv:1908.02337>.
 License: MIT + file LICENSE
 URL: https://github.com/RaphaelS1/survivalmodels/
@@ -16,8 +20,10 @@ Imports:
 Suggests:
     distr6 (>= 1.6.6),
     keras (>= 2.11.0),
+    param6,
     pseudo,
     reticulate,
+    set6,
     survival,
     testthat
 LinkingTo:

NAMESPACE

@@ -2,6 +2,7 @@
 
 S3method(predict,akritas)
 S3method(predict,dnnsurv)
+S3method(predict,parametric)
 S3method(predict,pycox)
 S3method(print,survivalmodel)
 S3method(summary,survivalmodel)
@@ -22,6 +23,7 @@ export(install_keras)
 export(install_pycox)
 export(install_torch)
 export(loghaz)
+export(parametric)
 export(pchazard)
 export(pycox_prepare_train_data)
 export(requireNamespaces)

NEWS.md

@@ -1,3 +1,8 @@
+# survivalmodels 0.1.19
+
+* Add fully parametric survival models
+* Fix broken CI
+
 # survivalmodels 0.1.18
 
 * Slight speed up in Akritas model by adding parameters to control number of unique time-points

R/clean_data.R

@@ -48,21 +48,25 @@ clean_train_data <- function(formula = NULL, data = NULL, time_variable = NULL,
 }
 
 clean_test_data <- function(object, newdata) {
+
   if (missing(newdata)) {
-    newdata <- object$x
-  } else {
-    newdata <- stats::model.matrix(~., newdata)[, -1, drop = FALSE]
+    newdata <- object$x[, !(colnames(object$x) %in% "(Intercept)")]
+    colnames(newdata) <- gsub("data$x", "", colnames(newdata), fixed = TRUE)
+    return(newdata)
   }
 
-  ord <- match(colnames(newdata), colnames(object$x), nomatch = NULL)
-  newdata <- newdata[, !is.na(ord), drop = FALSE]
+  newdata <- stats::model.matrix(~., newdata)[, -1, drop = FALSE]
+  old_features <- setdiff(colnames(object$x), "(Intercept)")
+  # fix for passing formula as data directly
+  old_features <- gsub("data$x", "", old_features, fixed = TRUE)
+  ord <- match(old_features, colnames(newdata), nomatch = NULL)
   newdata <- newdata[, ord[!is.na(ord)], drop = FALSE]
-  if (!all(suppressWarnings(colnames(newdata) == colnames(object$x)))) {
+  if (!all(suppressWarnings(colnames(newdata) == old_features))) {
     stop(sprintf(
       "Names in newdata should be identical to {%s}.",
       paste0(colnames(object$x), collapse = ", ")
     ))
   }
 
-  return(newdata)
+  newdata
 }

R/coxtime.R

@@ -28,7 +28,7 @@
 #'
 #'
 #' @examples
-#' \donttest{
+#' \dontrun{
 #' if (requireNamespaces("reticulate")) {
 #'   # all defaults
 #'   coxtime(data = simsurvdata(50))

R/helpers_pycox.R

@@ -698,7 +698,7 @@ def init_weights(m):
 #' Currently ignored.
 #'
 #' @examples
-#' \donttest{
+#' \dontrun{
 #' if (requireNamespaces("reticulate")) {
 #'   fit <- coxtime(data = simsurvdata(50))
 #'

R/methods.R

@@ -2,7 +2,12 @@
 print.survivalmodel <- function(x, ...) {
   cat("\n", attr(x, "name"), "\n\n")
   cat("Call:\n ", deparse(x$call))
-  cat("\n\nResponse:\n  Surv(", paste0(colnames(x$y), collapse = ", "), ")\n", sep = "")
+  if (is.null(x[["y"]])) {
+    ynames <- x$ynames
+  } else {
+    ynames <- colnames(x$y)
+  }
+  cat("\n\nResponse:\n  Surv(", paste0(ynames, collapse = ", "), ")\n", sep = "")
   cat("Features:\n ", setcollapse(x$xnames), "\n")
 }