joel/largeRCRF
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Add better error checking for the extract___ functions.

Browse source
This commit is contained in:
Joel Therrien 2019-07-23 11:19:25 -07:00
parent 0662c9dfc3
commit 094fb5489e
2 changed files with 17 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
DESCRIPTION
View file

@ -1,7 +1,7 @@
Package: largeRCRF Package: largeRCRF
Type: Package Type: Package
Title: Large Random Competing Risks Forests Title: Large Random Competing Risks Forests
Version: 1.0.3 Version: 1.0.3.1
Authors@R: c( Authors@R: c(
person("Joel", "Therrien", email = "joel_therrien@sfu.ca", role = c("aut", "cre", "cph")), 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")) person("Jiguo", "Cao", email = "jiguo_cao@sfu.ca", role = c("aut", "dgs"))

16
R/cr_predictions.R
View file

@ -48,6 +48,10 @@ extractCIF <- function (x, event) {
#' @export #' @export
extractCIF.CompetingRiskFunctions <- function(x, event){ 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])) fun <- stats::stepfun(x$time.interest, c(0, x$cif[,event]))
class(fun) <- "function" class(fun) <- "function"
@ -57,6 +61,10 @@ extractCIF.CompetingRiskFunctions <- function(x, event){
#' @export #' @export
extractCIF.CompetingRiskFunctions.List <- function(x, event){ extractCIF.CompetingRiskFunctions.List <- function(x, event){
if(is.null(event) | anyNA(event)){
stop("event must be specified")
}
return(lapply(x, extractCIF.CompetingRiskFunctions, event)) return(lapply(x, extractCIF.CompetingRiskFunctions, event))
} }
@ -70,6 +78,10 @@ extractCHF <- function (x, event) {
#' @export #' @export
extractCHF.CompetingRiskFunctions <- function(x, event){ 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])) fun <- stats::stepfun(x$time.interest, c(0, x$chf[,event]))
class(fun) <- "function" class(fun) <- "function"
@ -79,6 +91,10 @@ extractCHF.CompetingRiskFunctions <- function(x, event){
#' @export #' @export
extractCHF.CompetingRiskFunctions.List <- function(x, event){ extractCHF.CompetingRiskFunctions.List <- function(x, event){
if(is.null(event) | anyNA(event)){
stop("event must be specified")
}
return(lapply(x, extractCHF.CompetingRiskFunctions, event)) return(lapply(x, extractCHF.CompetingRiskFunctions, event))
} }