Shiny - How to dynamicly change input widgets based on datatype

I'm currently working on a machine learning application where an algorithm gets trained on a dataset and the user can create an obsevation by interacting with the shiny widgets. After the user have defined the obsevation, he can click on a submit button which will cause the algorithm to make a prediction.

The idea is to make this process work on new/different datasets. To keep things simple, lets only focus on the input widgets for now, and lets also assume that the response variable is always located in column 1.

I want to be able to make a dynamic UI where the input widgets changes based on the datatype of the variables in the dataset. For example, if column 2 is a factor variable, then the UI should show the "selectInput" widget but if column 2 is a numeric variable instead, then the UI should show a "sliderInput" widget.

Is this even possible in shiny?
I appriciate any help I can get.

Heres a book chapter for you

1 Like

Thanks for the reply!

I have been looking through the chapter and it gives a good indication on how to dynamicly change the specifications inside the input-widgets functions, but unfortunatly not the function itself.

I want the app to detect the datatype of the variable and then select the appropriate input-function that fits. So if the variable is numeric, then the input widget should be "sliderInput()" since "selectInput" wont work on that datatype.

What specific elements are you lacking ?
You can test a vectors properties with functions like is.numeric in base R

Yes, I am able to identify the datatype of all the variables by the use of is.numeric() and is.factor(), however, I run into a problem when I try to create the dynamic input widgets.

So far i have mainly tried to use the ifelse() function to create a sliderinput() if is.numeric()=TRUE on the given column, otherwise it should create a selectInput() function.
I am giving them unique ID's, but it doesn't seem to matter.


library(shiny)
library(tidyverse)
ui <- fluidPage(
      selectInput(inputId = "varpick",
                  label = "pick a variable",
                  choices = names(iris)),
      uiOutput("secondpick"),
      tableOutput("tout")
)

server <- function(input, output, session) {
  
 
  output$secondpick <- renderUI({
    vp <- req(input$varpick)

    if(is.numeric(iris[[vp]])){
      tg <- numericInput("numimp",label="n",
                         value = 5,
                         min = 0,
                         max=6,
                         step =0.1)
    } else {
      tg <- selectInput("facimp",label="f",
                        choices=unique(iris[[vp]]))
    }
      tagList(tg)
  })
  
  rdat <- reactive({
    
    vp <- (input$varpick)
    local_ <- iris
 
    if(is.numeric(iris[[vp]])){
    if(isTruthy(input$numimp)){
      local_ <- filter(local_,
                       !!sym(vp) == input$numimp)
    }} else  if(isTruthy(input$facimp)){
      local_ <- filter(local_,
                       !!sym(vp) == input$facimp)
    }
    local_
  })
  
  output$tout <- renderTable(
    req(rdat())
  )
}

shinyApp(ui, server)

Hi nirgrahamuk,

Again, thanks for the reply!
I think I wasn't clear enough in my explination of what I'm trying to do, so I found a example of a machine learning application (credit to Data Professor on Youtube), take a look at the code below.

I am trying to make it easier to update the ML algorithm AND user interface when new data becomes available. In the example below, we are trying to predict if a person would go golfing given the state of four different variables. Imagine that I have now gathered a 5th variable, which I would like to include in the prediction (and therefore the application). I want to be able to include this 5th variable without having to hardcode the variable into the application, but simply by uploading a new dataset which includes all the previous varaibles as well as the new one.

Is it possible to do this without having to hard code any variables?

# Import libraries
library(shiny)
library(shinythemes)
library(data.table)
library(RCurl)
library(randomForest)

# Read data
DATA <- read.csv(text = getURL("https://raw.githubusercontent.com/dataprofessor/data/master/weather-weka.csv"))

# Clean data
DATA <- as.data.frame(unclass(DATA), stringsAsFactors = TRUE)

# Build model
model <- randomForest(play ~ ., data = DATA, ntree = 500, mtry = 4, importance = TRUE)


####################################
# User interface                   #
####################################

ui <- fluidPage(theme = shinytheme("united"),
  
  # Page header
  headerPanel('Play Golf?'),
  
  # Input values
  sidebarPanel(
    HTML("<h3>Input parameters</h3>"),
    
    selectInput("outlook", label = "Outlook:", 
                choices = levels(DATA[,1]), 
                selected = levels(DATA[,1][1])),
    sliderInput("temperature", "Temperature:",
                min = 64, max = 86,
                value = 70),
    sliderInput("humidity", "Humidity:",
                min = 65, max = 96,
                value = 90),
    selectInput("windy", label = "Windy:", 
                choices = list("Yes" = "TRUE", "No" = "FALSE"), 
                selected = "TRUE"),
    
    actionButton("submitbutton", "Submit", class = "btn btn-primary")
  ),
  
  mainPanel(
    "Will a person play golf given these circumstances?",
    verbatimTextOutput('contents'),
    tableOutput('tabledata') # Prediction results table
    
  )
)

####################################
# Server                           #
####################################

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

  # Input Data
  datasetInput <- reactive({  
    
  # outlook,temperature,humidity,windy,play
  df <- data.frame(
    Name = c("outlook",
             "temperature",
             "humidity",
             "windy"),
    Value = as.character(c(input$outlook,
                           input$temperature,
                           input$humidity,
                           input$windy)),
    stringsAsFactors = FALSE)
  
  input <- transpose(rbind(df, "play"))
  
  write.table(input,"input.csv", sep=",", quote = FALSE, row.names = FALSE, col.names = FALSE)
  test <- read.csv(paste("input", ".csv", sep=""), header = TRUE)
  
  test$outlook <- factor(test$outlook, levels = levels(DATA[,1]))
  
  Output <- data.frame(Prediction=predict(model,test), round(predict(model,test,type="prob"), 3))
  print(Output)
  
  })
  
  
  # Prediction results table
  output$tabledata <- renderTable({
    if (input$submitbutton>0) { 
      isolate(datasetInput()) 
    } 
  })
  
}

####################################
# Create the shiny app             #
####################################
shinyApp(ui = ui, server = server)

start like this ?


library(shiny)
library(tidyverse)
ui <- fluidPage(
  selectInput("dset_choice",
    label = "choose a dataset",
    choices = c("iris", "mpg"),
    selected = "iris"
  ),
  uiOutput("pickers"),
  tableOutput("tout")
)

server <- function(input, output, session) {
  dset <- reactive({
    head(get(req(input$dset_choice)))
  })

  output$pickers <- renderUI({
    df <- req(dset())
    tagList(map(
      names(df),
      ~ ifelse(is.numeric(df[[.]]),
                            yes = tagList(numericInput(
                              inputId = paste0("sel_", .),
                              label = "n",
                              value = mean(df[[.]], na.rm = TRUE),
                              min = min(df[[.]], na.rm = TRUE),
                              max(df[[.]], na.rm = TRUE)
                            )),
                            no = tagList(selectInput(
                              inputId = paste0("sel_", .),
                              label = "f",
                              choices = unique(df[[.]]),
                              selected = head(unique(df[[.]]), 1)
                            ))
      )
    ))
  })

 
  output$tout <- renderTable(
    req(dset())
  )
}

shinyApp(ui, server)
1 Like

Yes! That will work.
Thank you very much for your time, I appreciate it.

Is it possible to label the input-widgets according to the corresponding variable names? So each numeric variable doesn't have the same name ("n") and likewise with the factor variables.

I have tried multiple things, but can't get it to work.
Why doesn't this work for example?:

label = names(df[[.]]),
inputId = paste0("sel_", .),
label = . ,
1 Like

Welp, that was way eaiser than I expected. Thanks.

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.