In rajkar86/shinypipe: R Package for shiny modules to be used as reusable components in building data processing pipelines

rm(list = ls())
library(datasets)
library(data.table)
library(ggplot2)
library(DT)
library(caret)
library(flexdashboard)

library(e1071)
library(kernlab)
#library(earth)

runWithoutInstall <- T
ifelse(runWithoutInstall,
       sapply(list.files(path = "../R/", pattern="*R", full.names = T), source),
       library(shinypipe))

data(mtcars)
mtcars$cyl <- as.factor(mtcars$cyl)
mtcars$vs <- as.factor(mtcars$vs)
rv <- reactiveValues(table=as.data.table(mtcars), testIndices=NULL)


r.data <- reactive(rv$table[rv$testIndices])
r.data.test <- reactive(rv$table[!rv$testIndices])

Sidebar {.sidebar}

ui.fread("file", list(label="Alternative dataset (optional)"), sep = NULL, header=NULL)
r.dataF <- callModule(s.fread, "file", list(sep=",", header=T))
observe({
  dt <- r.dataF()
  if ("Label" %in% names(dt))
    dt$Label <- as.factor(dt$Label)
  rv$table <- dt
})

hr()
sliderInput("testPct", "% of test data", 5, 50, 25)
observeEvent(input$testPct,{
  rv$testIndices <- createDataPartition(1:nrow(rv$table), p=(input$testPct/100), list=F)
})

hr()

renderUI({
  colsY <- list(choices = names(r.data()))
  colsX <- list(choices = names(r.data()), selected = names(r.data())[-1])
  ui.formula("form", colsY, colsX)
})
r.form <- callModule(s.formula, "form")
r.form.y <- callModule(s.formula.y, "form")

actionButton("run", "Train", width = "200px")

hr()
h4("Parameters") 
actionLink("help", "Click here for help")

observeEvent(input$help, showModal(modalDialog(
  "If left blank, a default training grid will be used, which can be used to later get an idea of suitable ranges. Otherwise, each parameter can either be a value or a range specified by any expression that evaluates to be a vector (like 1:4, c(1,2,5), seq(1,40,3) in case of a numeric field).  The tuning grid is shown in the Train tab. Make sure it's correct before you click on Train.",
  title = "Help", easyClose = T)))

renderUI(ui.caretModel("m1", reactive(names(getModelInfo())), 
                       selected = "svmRadial", show.type = F))
r.caretModel <- callModule(s.caretModel, "m1")

r.model <- reactive(r.caretModel()$method)

hr()

r.modelInfo <- reactive(getModelInfo(r.model(), F)[[r.model()]])

Data

Data used

renderDataTable(r.data())

Notes

• In the default cars dataset, cyl and vs columns are factor variables that can be used with classification algorithms.

• Note that not all models may actually train when you click "Run" in the hosted version as not all libraries may be installed. If the document is run locally, packages can be installed as necessary. For the demo, choose functions from e1071, kernlab and earth packages.)

• Click on tabs on the top of the page to navigate to see the tuning grid created as you change the parameters, and control caret::train parameters. Hit run once you have the tuning grid you want.

Model

Selected Model Info

renderDataTable(caretModelInfoTable(F)[Name==r.model()])

Model Browser (this info has been cached and could be out-of-date)

renderDataTable(datatable(caretModelInfoTable(F), filter = "top"))

Train

TuneGrid

r.tuneGrid <- reactive(expand.grid(r.caretModel()$params))
renderDataTable(r.tuneGrid())

List to override train parameters (See ?caret::train) {data-height="130px"}

textAreaInput("trainList", NULL, width = '700px', height = "100px",
              value = "list()")

List to override default train control (See ?caret::trainControl) {data-height="130px"}

textAreaInput("trainControlList", NULL, width = '700px', height = "100px", 
              value = "list(method = 'cv', number = 3)")

r.trainParams <- reactive({
  input$run
  as.list(eval(parse(text = isolate(input$trainList))))
})

r.trainControl <- reactive({
  input$run
  do.call(trainControl, eval(parse(text = isolate(input$trainControlList))))
})

Note: train may not work for all models in the hosted instance. Download locally and install necessary package to run these models.

r.train <- reactive({
  input$run
  params <- isolate(r.trainParams()) 

  params$form <- isolate(r.form())
  params$data <- isolate(r.data())
  params$method <- isolate(r.model())
  params$trControl <- isolate(r.trainControl())

  grid <- isolate(r.tuneGrid())
  if (!is.null(grid) && nrow(grid) > 0)
    params$tuneGrid <- grid

  do.call(caret:::train.formula, params)
})

renderPrint(r.train())

Results

Plot

fillRow(actionButton("renderPlotBtn", "Update"),
        textInput("renderPlotCmd", NULL, "plot(r.train())", width = "100%"),
        flex= c(NA,1), height ="50px")

renderPlot({
  input$renderPlotBtn
  eval(parse(text = isolate(input$renderPlotCmd)))
})

Print

fillRow(actionButton("renderPrintBtn", "Update"),
        textInput("renderPrintCmd", NULL, "r.train()$finalModel", width = "100%"),
        flex= c(NA,1), height ="50px")

renderPrint({
  input$renderPrintBtn
  eval(parse(text = isolate(input$renderPrintCmd)))
})

Test

Column

r.pred <- reactive({
  obs <- r.data.test()[, get(r.form.y())]
  pred <- predict(r.train(), r.data.test())
  data.table(obs = obs, pred = pred)
})

renderDataTable(r.pred())

Column

r.summary <- reactive(defaultSummary(r.pred()))
metric <- function(m, s) ifelse(m %in% names(s), formatC(s[[m]], digits = 4), "-")

RMSE

renderValueBox(metric("RMSE", r.summary()))

Rsquared

renderValueBox(metric("Rsquared", r.summary()))

MAE

renderValueBox(metric("MAE", r.summary()))

Accuracy

renderValueBox(metric("Accuracy", r.summary()))

Kappa

renderValueBox(metric("Kappa", r.summary()))

rajkar86/shinypipe documentation built on Aug. 22, 2021, 9:48 p.m.