Use proven elements to teach machine learning algorithm in a brilliant application

Question

For training purposes, I would like to make a Shiny application where you can check the column names and use them to teach an arbitrary forest algorithm.

My Shiny Application looks like this:

library(shiny)
library(DT)
library(titanic)
library(randomForest)

ui <- fluidPage(

  DT::dataTableOutput("mytable"),
  checkboxInput("checkbox" , label = "Pclass", value = FALSE),
  checkboxInput("checkbox" , label = "Sex", value = FALSE),
  checkboxInput("checkbox" , label = "Age", value = FALSE),
  actionButton("runRF", "Predict"),
  plotOutput("plotRF")
)

server <- function(input, output, session) {

  output$mytable = DT::renderDataTable({
    titanic_train
  })

  observeEvent(input$runRF, {

    var = c("Pclass")

    fit <- randomForest(as.factor(Survived) ~ var, data = titanic_train, importance = TRUE, ntree=2000)
    prediction <- as.numeric(predict(fit, titanic_test))
    titanic_test$predicted <- prediction  

    output$plotRF <- renderPlot({
      hist(prediction)
    })
  })
}

shinyApp(ui, server)

Basically the code above works when I do something like:

fit <- randomForest(as.factor(Survived) ~ Age, data = titanic_train, importance = TRUE, ntree=2000)

Or

fit <- randomForest(as.factor(Survived) ~ Pclass + Age, data = titanic_train, importance = TRUE, ntree=2000)

However, I would like to make a workout dependent variable or fields that you are checking. Therefore, if you check Age + Pclass, it should be:

fit <- randomForest(as.factor(Survived) ~ Pclass + Age, data = titanic_train, importance = TRUE, ntree=2000)

If you noted age:

    fit <- randomForest(as.factor(Survived) ~ Age, data = titanic_train, importance = TRUE, ntree=2000)

I assume that I need to make a list where I store the "checked values", for example:

var = c(checkElement1)

However, this gives me the following erorr:

Warning: Error in model.frame.default: variable lengths differ (found for 'var')
Stack trace (innermost first):
    74: model.frame.default
    73: model.frame
    72: eval
    71: eval
    70: randomForest.formula
    69: randomForest
    68: observeEventHandler [#11]
     4: <Anonymous>
     3: do.call
     2: print.shiny.appobj
     1: <Promise>

Any thoughts where this is going wrong?

Answer 1

. x y, randomForest :

randomForest(x = titanic_train[,input$myselection,drop=FALSE], 
                          y = as.factor(titanic_train$Survived), 
                          importance = TRUE, 
                          ntree=2000)

drop=FALSE , - data.frame , , input$myselection - . checkBox, checkboxGroupInput, , .

, . . . Val my_prediction, .

, . , , . , , , . OCD, , :)

, !

library(shiny)
library(DT)
library(titanic)
library(randomForest)

# Replace NA and replace String with Factor columns
# There may be nicer ways to do this though.
titanic_train[is.na(titanic_train)] <- 0
titanic_test[is.na(titanic_test)] <- 0
titanic_train[sapply(titanic_train, is.character)] <- lapply(titanic_train[sapply(titanic_train, is.character)], 
                                                             as.factor)
titanic_test[sapply(titanic_test, is.character)] <- lapply(titanic_test[sapply(titanic_test, is.character)], 
                                                           as.factor)

# drop columns with too many factor levels
to_drop=sapply(colnames(titanic_train)[sapply(titanic_train,class)=='factor'],function(x) {length(levels(titanic_train[,x]))>52})
if(sum(to_drop)>0){
titanic_train <- titanic_train[,-which(names(titanic_train) %in% names(to_drop)[to_drop])]
titanic_test <- titanic_test[,-which(names(titanic_test) %in% names(to_drop)[to_drop])]
}


ui <- fluidPage(
  DT::dataTableOutput("mytable"),
  checkboxGroupInput('myselection','Select columns:',
                     choices=setdiff(colnames(titanic_train),c('PassengerId','Survived','Name')),
                     inline=T),
  actionButton("runRF", "Predict"),
  plotOutput("plotRF")
)

server <- function(input, output, session) {

  output$mytable = DT::renderDataTable({
    titanic_train
  })

  observeEvent(input$runRF, {
    if(is.null(input$myselection))
    {
      my_prediction(NULL)
      showModal(modalDialog(
        title = "Error!",
        "No variables selected!"
      ))
    }
    else
    {
      fit <- randomForest(x = titanic_train[,input$myselection,drop=FALSE], 
                          y = as.factor(titanic_train$Survived), 
                          importance = TRUE, 
                          ntree=2000)
      prediction <- as.numeric(predict(fit, titanic_test[,input$myselection,drop=FALSE]))
      titanic_test$predicted <- prediction  
      my_prediction(titanic_test) # store our test set with predicted valus in reactiveVal

    }
  })

  # A reactiveVal to store titanic_test with its predictions.
  my_prediction <- reactiveVal()
  output$plotRF <- renderPlot({
    req(my_prediction())
    hist(my_prediction()$predicted)
  })
}

shinyApp(ui, server)

Answer 2

formula paste

var = "Pclass"

form <- formula(paste('as.factor(Survived)', var, sep=' ~ '))
fit <- randomForest(form, data = titanic_train, importance = TRUE, ntree=2000)

-

library(shiny)
library(DT)
library(titanic)
library(randomForest)

ui <- fluidPage(

  DT::dataTableOutput("mytable"),
  checkboxInput("checkbox" , label = "Pclass", value = FALSE),
  checkboxInput("checkbox" , label = "Sex", value = FALSE),
  checkboxInput("checkbox" , label = "Age", value = FALSE),
  actionButton("runRF", "Predict"),
  plotOutput("plotRF")
)

server <- function(input, output, session) {

  output$mytable = DT::renderDataTable({
    titanic_train
  })

  observeEvent(input$runRF, {

    var = "Pclass"

    form <- formula(paste('as.factor(Survived)', var, sep=' ~ '))
    fit <- randomForest(form, data = titanic_train, importance = TRUE, ntree=2000)
    prediction <- as.numeric(predict(fit, titanic_test))
    titanic_test$predicted <- prediction  

    output$plotRF <- renderPlot({
      hist(prediction)
    })
  })
}

shinyApp(ui, server)

-output