Change boxplots display based on users input - shiny (cannot coerce type "closure" to vector of type character-)

Viewed 51

For the iris dataset, I want to create a boxplot to visualize the differences for different continous variables sepal-lentgh, sepal-width, etc, for the different types of flowers (Species).

More precisely, I want the user to be able to change the order of the boxes in the boxplot. For this, I will be using the orderInput function. (Please note that this is a toy example, with the real data the user will be able to select for different variables as X and Y axis in the plots).

The idea is simple:

First, create a reactive levels in the UI interface, and update it based on the factors of the first variable.

uiOutput("levels"), 

----

output$levels<- renderUI({
    req(data_input())
    d <- unique(data_input()[[input$num_var_1]])
    orderInput(inputId = "levels", label = "Factor level order",
               items = c(d[1:length(d)]))
  })

Then, create another dataframe, that will change it's columns order based on the users selection of the order of the factors:

data_plot <- reactive({
    mutate(data_input(), num_var_1 = num_var_1 %>% factor(levels = input$levels))
  })

And lastly, plot this data

  plot_1 <- eventReactive(input$run_button,{
    #print(input$selected_factors)
    req(data_plot())
    draw_boxplot(data_plot(), num_var_1(), num_var_2())
  })

Here you have the RepEx:


# Shiny
library(shiny)
library(shinyWidgets)
library(shinyjqui)

# Data
library(readxl)
library(dplyr)

# Plots
library(ggplot2)

# Stats cohen.d wilcox.test
library(effsize)



not_sel <- "Not Selected"

# main page display in the shiny app where user will input variables and plots will be displayed
main_page <- tabPanel(
  title = "Plotter",
  titlePanel("Plotter"),
  sidebarLayout(
    sidebarPanel(
      title = "Inputs",
      fileInput("xlsx_input", "Select XLSX file to import", accept = c(".xlsx")),
      selectInput("num_var_1", "Variable X axis", choices = c(not_sel)),
      selectInput("num_var_2", "Variable Y axis", choices = c(not_sel)),
      br(),
      actionButton("run_button", "Run Analysis", icon = icon("play"))
    ),
    mainPanel(
      tabsetPanel(
        tabPanel(
          title = "Plot",
          br(),
          uiOutput("levels"),  
          br(),
          plotOutput("plot_1")
        ),
      )
    )
  )
)





draw_boxplot <- function(data_input, num_var_1, num_var_2, biomarker){
  print(num_var_1)
  
  if(num_var_1 != not_sel & num_var_2 != not_sel){
    ggplot(data = data_input, aes(x = .data[[num_var_1]], y = .data[[num_var_2]])) +
      geom_boxplot() + 
      theme_bw()
  }
}



ui <- navbarPage(
  main_page
)


server <- function(input, output){
  
  # Dynamic selection of the data. We allow the user to input the data that they want 
  data_input <- reactive({
    #req(input$xlsx_input)
    #inFile <- input$xlsx_input
    #read_excel(inFile$datapath, 1)
    iris
  })
  
  # We update the choices available for each of the variables
  observeEvent(data_input(),{
    choices <- c(not_sel, names(data_input()))
    updateSelectInput(inputId = "num_var_1", choices = choices)
    updateSelectInput(inputId = "num_var_2", choices = choices)
  })
  
  #Create buttons corresponding to each of the num_var_1 factors
  output$levels<- renderUI({
    req(data_input())
    d <- unique(data_input()[[input$num_var_1]])
    orderInput(inputId = "levels", label = "Factor level order",
               items = c(d[1:length(d)]))
  })
  
  
  num_var_1 <- eventReactive(input$run_button, input$num_var_1)
  num_var_2 <- eventReactive(input$run_button, input$num_var_2)
  
  # Create a new dataframe (data_plot) for the dynamic bar plots
  data_plot <- reactive({
    # data_input()$num_var_1 <- as.vector(as.factor(data_input()$num_var_1))
    mutate(data_input(), num_var_1 = num_var_1 %>% factor(levels = input$levels))
  })
  
  # Create plot function that can is displayed according to the order of the factors in the dataframe
  plot_1 <- eventReactive(input$run_button,{
    #print(input$selected_factors)
    req(data_plot())
    draw_boxplot(data_plot(), num_var_1(), num_var_2())
  })
  
  output$plot_1 <- renderPlot(plot_1())
  
}


# Connection for the shinyApp
shinyApp(ui = ui, server = server)

ShinnyApp:

enter image description here

As you can see, shiny gives an error in the mutate() function, apparently because our data is not a vector.

I've try using this:

data_input()$num_var_1 <- as.vector(as.factor(data_input()$num_var_1))

But creates null data.

1 Answers

You needed some req(), and list() in orderInput() items. Try this

# Shiny
library(shiny)
library(shinyWidgets)
library(shinyjqui)
library(readxl)
library(dplyr)
library(ggplot2)

# Stats cohen.d wilcox.test
library(effsize)

not_sel <- "Not Selected"

# main page display in the shiny app where user will input variables and plots will be displayed
main_page <- tabPanel(
  title = "Plotter",
  titlePanel("Plotter"),
  sidebarLayout(
    sidebarPanel(
      title = "Inputs",
      fileInput("xlsx_input", "Select XLSX file to import", accept = c(".xlsx")),
      selectInput("num_var_1", "Variable X axis", choices = c(not_sel)),
      selectInput("num_var_2", "Variable Y axis", choices = c(not_sel)),
      br(),
      actionButton("run_button", "Run Analysis", icon = icon("play"))
    ),
    mainPanel(
      tabsetPanel(
        tabPanel(
          title = "Plot",
          br(),
          uiOutput("levels"),
          br(),
          plotOutput("plot_1")
        ),
      )
    )
  )
)

draw_boxplot <- function(data_input, num_var_1, num_var_2, biomarker){
  print(num_var_1)

  if(num_var_1 != not_sel & num_var_2 != not_sel){
    ggplot(data = data_input, aes(x = .data[[num_var_1]], y = .data[[num_var_2]])) +
      geom_boxplot() +
      theme_bw()
  }
}

ui <- navbarPage(
  main_page
)

server <- function(input, output){

  # Dynamic selection of the data. We allow the user to input the data that they want
  data_input <- reactive({
    #req(input$xlsx_input)
    #inFile <- input$xlsx_input
    #read_excel(inFile$datapath, 1)
    iris
  })

  # We update the choices available for each of the variables
  observeEvent(data_input(),{
    choices <- c(not_sel, names(data_input()))
    updateSelectInput(inputId = "num_var_1", choices = choices)
    updateSelectInput(inputId = "num_var_2", choices = choices)
  })

  #Create buttons corresponding to each of the num_var_1 factors
  output$levels<- renderUI({
    req(data_input(),input$num_var_1)
    d <- unique(data_input()[[input$num_var_1]])
    orderInput(inputId = "levels", label = "Factor level order", items = list(d))
  })
  observe({print(input$levels)})

  num_var_1 <- eventReactive(input$run_button, input$num_var_1)
  num_var_2 <- eventReactive(input$run_button, input$num_var_2)

  # Create a new dataframe (data_plot) for the dynamic bar plots
  data_plot <- reactive({
    req(data_input(),input$levels,input$num_var_1)
    
    df <- data_input()  
    df[[input$num_var_1]] <- factor(df[[input$num_var_1]], levels = input$levels)
    
    df
  })

  # Create plot function that can is displayed according to the order of the factors in the dataframe
  plot_1 <- eventReactive(input$run_button,{
    req(data_plot())
    draw_boxplot(data_plot(), num_var_1(), num_var_2())
  })

  output$plot_1 <- renderPlot(plot_1())

}

# Connection for the shinyApp
shinyApp(ui = ui, server = server)

output

Related