2015-05-31 21:09:04 +02:00
|
|
|
# VT.TREE.CLASS -----------------------------------------------------------
|
|
|
|
|
2015-06-11 09:32:10 +02:00
|
|
|
#' Classification tree to find subgroups
|
|
|
|
#'
|
|
|
|
#' See \code{\link{VT.tree}}
|
2015-06-01 23:22:49 +02:00
|
|
|
#'
|
|
|
|
#' @include tree.R
|
2015-06-10 14:38:36 +02:00
|
|
|
#'
|
2015-06-11 09:32:10 +02:00
|
|
|
#' @name VT.tree.class
|
|
|
|
#'
|
2015-06-11 13:34:55 +02:00
|
|
|
#' @export VT.tree.class
|
|
|
|
#'
|
2016-10-09 02:44:17 +02:00
|
|
|
#' @import methods
|
2018-02-03 13:18:19 +01:00
|
|
|
#'
|
2015-05-31 21:09:04 +02:00
|
|
|
VT.tree.class <- setRefClass(
|
|
|
|
Class = "VT.tree.class",
|
|
|
|
|
|
|
|
contains = "VT.tree",
|
|
|
|
|
|
|
|
methods = list(
|
|
|
|
initialize = function(vt.difft, threshold = 0.05, sens = ">", screening = NULL){
|
|
|
|
callSuper(vt.difft, threshold, sens, screening)
|
|
|
|
|
|
|
|
.self$name <- .self$computeNameOfTree("class")
|
|
|
|
|
|
|
|
if(.self$sens == ">"){
|
|
|
|
.self$outcome <- ifelse(.self$vt.difft$difft >= .self$threshold, 1, 0)
|
|
|
|
} else {
|
|
|
|
.self$outcome <- ifelse(.self$vt.difft$difft <= .self$threshold, 1, 0)
|
|
|
|
}
|
|
|
|
},
|
|
|
|
|
|
|
|
run = function(...){
|
2015-06-11 09:32:10 +02:00
|
|
|
"VT.tree.class:run(...) Compute classification tree with rpart parameters"
|
2015-05-31 21:09:04 +02:00
|
|
|
callSuper()
|
|
|
|
|
|
|
|
data <- .self$getData()
|
|
|
|
if(sum(data[,1]) != 0){
|
2015-06-01 23:22:49 +02:00
|
|
|
.self$tree <- rpart::rpart(as.formula(paste(.self$name, ".", sep = "~")), data = data, method = "class", ...)
|
2015-05-31 21:09:04 +02:00
|
|
|
.self$Ahat <- as.numeric(predict(.self$tree, data, type = "class")) - 1
|
|
|
|
}else{
|
|
|
|
.self$Ahat <- .self$outcome
|
|
|
|
}
|
|
|
|
|
|
|
|
return(invisible(tree))
|
|
|
|
},
|
|
|
|
|
|
|
|
sumup = function(){
|
|
|
|
cat("Classification Tree")
|
|
|
|
callSuper()
|
|
|
|
}
|
|
|
|
)
|
|
|
|
)
|
|
|
|
|
|
|
|
VT.tree.class$lock("threshold", "vt.difft")
|