From 094fb5489efb14b3d65bf5f9252cdcee3b5bc3ec Mon Sep 17 00:00:00 2001 From: Joel Therrien Date: Tue, 23 Jul 2019 11:19:25 -0700 Subject: [PATCH] Add better error checking for the extract___ functions. --- DESCRIPTION | 2 +- R/cr_predictions.R | 16 ++++++++++++++++ 2 files changed, 17 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 20d8762..e6081f2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: largeRCRF Type: Package Title: Large Random Competing Risks Forests -Version: 1.0.3 +Version: 1.0.3.1 Authors@R: c( person("Joel", "Therrien", email = "joel_therrien@sfu.ca", role = c("aut", "cre", "cph")), person("Jiguo", "Cao", email = "jiguo_cao@sfu.ca", role = c("aut", "dgs")) diff --git a/R/cr_predictions.R b/R/cr_predictions.R index 8c515f0..a2a982f 100644 --- a/R/cr_predictions.R +++ b/R/cr_predictions.R @@ -48,6 +48,10 @@ extractCIF <- function (x, event) { #' @export extractCIF.CompetingRiskFunctions <- function(x, event){ + if(is.null(event) | anyNA(event)){ + stop("event must be specified") + } + fun <- stats::stepfun(x$time.interest, c(0, x$cif[,event])) class(fun) <- "function" @@ -57,6 +61,10 @@ extractCIF.CompetingRiskFunctions <- function(x, event){ #' @export extractCIF.CompetingRiskFunctions.List <- function(x, event){ + if(is.null(event) | anyNA(event)){ + stop("event must be specified") + } + return(lapply(x, extractCIF.CompetingRiskFunctions, event)) } @@ -70,6 +78,10 @@ extractCHF <- function (x, event) { #' @export extractCHF.CompetingRiskFunctions <- function(x, event){ + if(is.null(event) | anyNA(event)){ + stop("event must be specified") + } + fun <- stats::stepfun(x$time.interest, c(0, x$chf[,event])) class(fun) <- "function" @@ -79,6 +91,10 @@ extractCHF.CompetingRiskFunctions <- function(x, event){ #' @export extractCHF.CompetingRiskFunctions.List <- function(x, event){ + if(is.null(event) | anyNA(event)){ + stop("event must be specified") + } + return(lapply(x, extractCHF.CompetingRiskFunctions, event)) }