#' treeki the widget for tree predictive algorithms
#' treeki the widget for tree predictive algorithms
#' @param data The data to work with.
#' @param viewer Specify where the gadget should be displayed–viewer pane,
#' dialog window, or external browse. For example use
#' \code{viewer = shiny::browserViewer()}.
#' @param ... Additional parameters.
#' @examples
#'
#' \dontrun{
#'
#' # example 1
#' data <- subset(airquality, !is.na(Ozone) & complete.cases(airquality))
#' treeki(data)
#'
#' # example 2
#' data(BBBClub, package = "evtree")
#' require(shiny) # for browserViewer()
#' treeki(BBBClub, viewer = browserViewer())
#'
#' }
#'
#' @importFrom shiny fillPage
#' @importFrom shinythemes shinytheme
#' @importFrom graphics plot
#' @importFrom stats as.formula
#' @importFrom miniUI miniPage gadgetTitleBar
#' @importFrom shiny paneViewer stopApp selectInput sliderInput
#' plotOutput observeEvent renderPlot runGadget shinyApp
#' reactive dialogViewer tags column fluidRow icon
#' @importFrom partykit ctree ctree_control as.party
#' @importFrom rpart rpart rpart.control
#' @importFrom evtree evtree evtree.control
#' @export
treeki <- function(data, viewer = dialogViewer("treeki", 1200, 900), ...) {
# library(shiny); library(shinythemes); library(miniUI); library(partykit); library(rpart); library(evtree)
# viewer = dialogViewer("treeki", 1200, 900)
# data <- subset(airquality, !is.na(Ozone) & complete.cases(airquality))
# input <- list(package = "ctree", var = vars[1], vars = vars[-1], depth = 3, minbucket = 20,
# fontsize = 12, abbr = FALSE, showid = FALSE)
vars <- names(data)
mainpanel <- tabPanel(
NULL,
icon = icon("tachometer"),
fluidRow(
column(
12,
tags$form(
class = "well",
selectInput("package", "Algorithm (package)",
c("Conditional Inference Trees" = "ctree",
"Recursive Partitioning and Regression Trees" = "rpart",
"Evolutionary Learning of Globally Optimal Trees" = "evtree")
),
#----------------------------
selectInput("var", "Variable to predict", vars, vars[1]),
selectInput("vars", "Predictors", vars, vars, multiple = TRUE),
#----------------------------
sliderInput("depth", "Max Depth", min = 1, max = 10, value = 5),
sliderInput("minbucket", "Min Bucket (% of rows)", min = 0, max = 30, post = " %", value = 10)
)
)
)
)
optspanel <- tabPanel(
NULL,
icon = icon("eye"),
fluidRow(
column(
12,
tags$form(
class = "well",
sliderInput("fontsize", "Font size", 5, 20, 12),
checkboxInput("abbr", "Abbreviate"),
checkboxInput("showid", "Show node id")
)
)
)
)
panel <- tabsetPanel(
mainpanel,
optspanel
)
ui <- miniPage(
theme = shinytheme("paper"),
gadgetTitleBar("Treeki"),
fluidRow(
column(3, panel),
column(9, plotOutput("treeplot"))
)
)
server <- function(input, output, session) {
observeEvent(input$done, { stopApp(tree()) })
tree <- reactive({
package <- input$package
modfun = switch(
package,
ctree = ctree,
rpart = rpart,
evtree = evtree
)
ctrfun <- switch(
package,
ctree = ctree_control,
rpart = rpart.control,
evtree = evtree.control
)
mb <- round(input$minbucket / 100 * nrow(data))
ctr <- ctrfun(maxdepth = input$depth, minbucket = mb)
f <- paste0(input$var, " ~ ", paste0(input$vars, collapse = " + "))
tree <- suppressWarnings(
modfun(as.formula(f), data = data, control = ctr)
)
tree
})
output$treeplot <- renderPlot({
tree <- tree()
package <- input$package
plotfun <- switch(
package,
ctree = plot,
rpart = function(x) plot(as.party(x)),
evtree = plot
)
plotfun(
tree,
gp = gpar(fontsize = input$fontsize),
inner_panel=node_inner,
ip_args = list(
abbreviate = input$abbr,
id = input$showid
)
)
})
}
runGadget(shinyApp(ui, server), viewer = viewer)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.