mirror of
https://github.com/prise6/aVirtualTwins.git
synced 2024-04-24 18:50:28 +02:00
Fix some bug and documentation
This commit is contained in:
parent
241e4cf467
commit
31e16ab68d
28
R/tools.R
28
R/tools.R
|
@ -1,7 +1,7 @@
|
|||
|
||||
#' Visualize subgroups
|
||||
#'
|
||||
#' Function which uses \code{\link{VT.tree}} intern functions. Package
|
||||
#' Function which uses \code{\link{VT.tree}} intern functions. Package
|
||||
#' rpart.plot must be loaded. See \code{\link{VT.tree}} for details.
|
||||
#'
|
||||
#' @param vt.trees \code{\link{VT.tree}} object. Or return of
|
||||
|
@ -12,19 +12,21 @@
|
|||
#' @param tables set to TRUE if tables of incidence must be shown. FALSE is
|
||||
#' default.
|
||||
#' @param verbose print infos during computation. FALSE is default.
|
||||
#' @param compete print competitors rules thanks to competitors computation of
|
||||
#' the tree
|
||||
#'
|
||||
#' @return data.frame of rules
|
||||
#'
|
||||
#' @examples
|
||||
#' \dontrun{
|
||||
#' # data(sepsis)
|
||||
#' vt.o <- vt.data(sepsis, "survival", "THERAPY", T)
|
||||
#' # inside model :
|
||||
#' vt.f <- vt.forest("one", vt.o)
|
||||
#' # use classification tree
|
||||
#' vt.tr <- vt.tree("class", vt.f, threshold = c(0.01, 0.05))
|
||||
#' # show subgroups
|
||||
#' vt.subgroups(vt.tr)
|
||||
#' \dontrun{
|
||||
#' # data(sepsis)
|
||||
#' vt.o <- vt.data(sepsis, "survival", "THERAPY", T)
|
||||
#' # inside model :
|
||||
#' vt.f <- vt.forest("one", vt.o)
|
||||
#' # use classification tree
|
||||
#' vt.tr <- vt.tree("class", vt.f, threshold = c(0.01, 0.05))
|
||||
#' # show subgroups
|
||||
#' vt.subgroups(vt.tr)
|
||||
#' # change options you'll be surprised !
|
||||
#' vt.subgroups(vt.tr, verbose = T, tables = T)
|
||||
#' }
|
||||
|
@ -32,16 +34,16 @@
|
|||
#' @export vt.subgroups
|
||||
#'
|
||||
#' @name vt.subgroups
|
||||
#'
|
||||
#'
|
||||
|
||||
vt.subgroups <- function(vt.trees, only.leaf = T, only.fav = T, tables = F, verbose = F){
|
||||
|
||||
if(is.list(vt.trees)){
|
||||
subgroups <- lapply(vt.trees, function(x)x$getRules(only.leaf = only.leaf, only.fav = only.fav, tables = tables, verbose = verbose))
|
||||
subgroups <- lapply(vt.trees, function(x)x$getRules(only.leaf = only.leaf, only.fav = only.fav, tables = tables, verbose = verbose, compete = F))
|
||||
unique(do.call(rbind, subgroups))
|
||||
}
|
||||
else{
|
||||
subgroups <- vt.tree$getRules(only.leaf = only.leaf, only.fav = only.fav, tables = tables, verbose = verbose)
|
||||
subgroups <- vt.tree$getRules(only.leaf = only.leaf, only.fav = only.fav, tables = tables, verbose = verbose, compete = compete)
|
||||
}
|
||||
}
|
||||
|
||||
|
|
2
R/tree.R
2
R/tree.R
|
@ -168,7 +168,7 @@ VT.tree <- setRefClass(
|
|||
warning("VT.tree : no rules"); return(invisible(NULL));
|
||||
}
|
||||
|
||||
pth <- path.rpart(.self$tree, nodes = row.names(frm), print.it = F)
|
||||
pth <- rpart::path.rpart(.self$tree, nodes = row.names(frm), print.it = F)
|
||||
# Delete 'root' node des règles
|
||||
pth <- lapply(pth, FUN = function(d) return(d[-1]))
|
||||
|
||||
|
|
Loading…
Reference in a new issue