####**********************************************************************
####**********************************************************************
####
#### RANDOM FORESTS FOR SURVIVAL, REGRESSION, AND CLASSIFICATION (RF-SRC)
#### Version 2.4.1 (_PROJECT_BUILD_ID_)
####
#### Copyright 2016, University of Miami
####
#### This program is free software; you can redistribute it and/or
#### modify it under the terms of the GNU General Public License
#### as published by the Free Software Foundation; either version 3
#### of the License, or (at your option) any later version.
####
#### This program is distributed in the hope that it will be useful,
#### but WITHOUT ANY WARRANTY; without even the implied warranty of
#### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
#### GNU General Public License for more details.
####
#### You should have received a copy of the GNU General Public
#### License along with this program; if not, write to the Free
#### Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
#### Boston, MA 02110-1301, USA.
####
#### ----------------------------------------------------------------
#### Project Partially Funded By:
#### ----------------------------------------------------------------
#### Dr. Ishwaran's work was funded in part by DMS grant 1148991 from the
#### National Science Foundation and grant R01 CA163739 from the National
#### Cancer Institute.
####
#### Dr. Kogalur's work was funded in part by grant R01 CA163739 from the
#### National Cancer Institute.
#### ----------------------------------------------------------------
#### Written by:
#### ----------------------------------------------------------------
#### Hemant Ishwaran, Ph.D.
#### Director of Statistical Methodology
#### Professor, Division of Biostatistics
#### Clinical Research Building, Room 1058
#### 1120 NW 14th Street
#### University of Miami, Miami FL 33136
####
#### email: hemant.ishwaran@gmail.com
#### URL: http://web.ccs.miami.edu/~hishwaran
#### --------------------------------------------------------------
#### Udaya B. Kogalur, Ph.D.
#### Adjunct Staff
#### Department of Quantitative Health Sciences
#### Cleveland Clinic Foundation
####
#### Kogalur & Company, Inc.
#### 5425 Nestleway Drive, Suite L1
#### Clemmons, NC 27012
####
#### email: ubk@kogalur.com
#### URL: http://www.kogalur.com
#### --------------------------------------------------------------
####
####**********************************************************************
####**********************************************************************
vimp.rfsrc <- function(object,
xvar.names,
outcome.target = NULL,
importance = c("permute", "random", "anti", "permute.ensemble", "random.ensemble", "anti.ensemble"),
joint = FALSE,
subset,
seed = NULL,
do.trace = FALSE,
...)
{
if (missing(object)) {
stop("object is missing")
}
if (object$family == "unsupv") {
stop("vimp does not apply to unsupervised forests: consider using max.subtree and var.select")
}
if (sum(inherits(object, c("rfsrc", "grow"), TRUE) == c(1, 2)) != 2 &
sum(inherits(object, c("rfsrc", "forest"), TRUE) == c(1, 2)) != 2)
stop("This function only works for objects of class `(rfsrc, grow)' or '(rfsrc, forest)'.")
if (!is.logical(joint)) {
stop("joint must be a logical value")
}
importance <- importance[1]
if (joint & importance != "none") {
i.str <- unlist(strsplit(importance, "\\."))
if (length(i.str) == 1) {
importance <- paste(i.str[1], ".joint", sep = "")
}
else if (length(i.str) == 2) {
importance <- paste(i.str[1], ".joint.", i.str[2], sep = "")
}
}
importance <- match.arg(importance, c(FALSE, TRUE,
"none", "permute", "random", "anti",
"permute.ensemble", "random.ensemble", "anti.ensemble",
"permute.joint", "random.joint", "anti.joint",
"permute.joint.ensemble", "random.joint.ensemble", "anti.joint.ensemble"))
if (sum(inherits(object, c("rfsrc", "grow"), TRUE) == c(1, 2)) == 2) {
if (is.null(object$forest)) {
stop("The forest is empty. Re-run rfsrc (grow) call with forest=TRUE")
}
else {
bootstrap <- object$forest$bootstrap
}
}
else {
bootstrap <- object$bootstrap
}
if (bootstrap != "by.root") {
stop("grow objects under non-standard bootstrapping are devoid of performance values")
}
if (missing(subset)) {
subset <- NULL
}
else {
if (is.logical(subset)) {
subset <- which(subset)
}
subset <- unique(subset[subset >= 1 & subset <= nrow(object$xvar)])
if (length(subset) == 0) {
stop("'subset' not set properly")
}
}
result <- generic.predict.rfsrc(object,
outcome.target = outcome.target,
importance = importance,
importance.xvar = xvar.names,
seed = seed,
do.trace = do.trace,
membership = FALSE,
subset = subset,
...)
return(result)
}
vimp <- vimp.rfsrc
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.