prise6/aVirtualTwins
1
0
Fork 0
mirror of https://github.com/prise6/aVirtualTwins.git synced 2024-05-04 20:13:11 +02:00
Code Issues Releases Wiki Activity

Fix some bug and documentation

Browse source
This commit is contained in:
prise6 2015-07-31 17:21:28 +02:00
parent 241e4cf467
commit 31e16ab68d
2 changed files with 16 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
R/tools.R
View file

@ -1,7 +1,7 @@
#' Visualize subgroups #' 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. #' rpart.plot must be loaded. See \code{\link{VT.tree}} for details.
#' #'
#' @param vt.trees \code{\link{VT.tree}} object. Or return of #' @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 #' @param tables set to TRUE if tables of incidence must be shown. FALSE is
#' default. #' default.
#' @param verbose print infos during computation. 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 #' @return data.frame of rules
#' #'
#' @examples #' @examples
#' \dontrun{ #' \dontrun{
#' # data(sepsis) #' # data(sepsis)
#' vt.o <- vt.data(sepsis, "survival", "THERAPY", T) #' vt.o <- vt.data(sepsis, "survival", "THERAPY", T)
#' # inside model : #' # inside model :
#' vt.f <- vt.forest("one", vt.o) #' vt.f <- vt.forest("one", vt.o)
#' # use classification tree #' # use classification tree
#' vt.tr <- vt.tree("class", vt.f, threshold = c(0.01, 0.05)) #' vt.tr <- vt.tree("class", vt.f, threshold = c(0.01, 0.05))
#' # show subgroups #' # show subgroups
#' vt.subgroups(vt.tr) #' vt.subgroups(vt.tr)
#' # change options you'll be surprised ! #' # change options you'll be surprised !
#' vt.subgroups(vt.tr, verbose = T, tables = T) #' vt.subgroups(vt.tr, verbose = T, tables = T)
#' } #' }
@ -32,16 +34,16 @@
#' @export vt.subgroups #' @export vt.subgroups
#' #'
#' @name vt.subgroups #' @name vt.subgroups
#' #'
vt.subgroups <- function(vt.trees, only.leaf = T, only.fav = T, tables = F, verbose = F){ vt.subgroups <- function(vt.trees, only.leaf = T, only.fav = T, tables = F, verbose = F){
if(is.list(vt.trees)){ 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)) unique(do.call(rbind, subgroups))
} }
else{ 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
View file

@ -168,7 +168,7 @@ VT.tree <- setRefClass(
warning("VT.tree : no rules"); return(invisible(NULL)); 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 # Delete 'root' node des règles
pth <- lapply(pth, FUN = function(d) return(d[-1])) pth <- lapply(pth, FUN = function(d) return(d[-1]))