Rshiny not producing plots after user's input change-CodePudding

Roman history fan here, so I have a dataframe with the name of two legions (fifth and tirteenth), their casualties (numerical value), and the morale of the troops (high, medium, low).

I want to know (boxplot) the relationship between morale (x axis) and casualties (y axis), and also subset by legion.

Please notice that this is a toy example. In the real data (no romans) we have several variables for each of the axis, so we ask the user to load the data, and then select which variables he wants to use for each axis.

Here you have a RepEx:

Legion <- c("Fifth", "Fifth", "Fifth","Fifth","Fifth","Tirteenth","Tirteenth", "Tirteenth", "Tirteenth","Tirteenth")
Casualties <- c(13, 34,23,123,0,234,3,67,87,4)
Morale <- c("High", "Medium", "Low","High", "Medium", "Low","High", "Medium", "Low", "High")
romans <- data.frame(Legion, Casualties, Morale)



# Shiny
library(shiny)
library(shinyWidgets)
# Data
library(readxl)
library(dplyr)
# Data
library(effsize)



# Objects and functions
not_sel <- "Not Selected"


main_page <- tabPanel(
  title = "Romans",
  titlePanel("Romans"),
  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)),
      selectInput("factor", "Select factor", choices = c(not_sel)), uiOutput("leg"), # This group will be the main against the one we will perform the statistics
      br(),
      actionButton("run_button", "Run Analysis", icon = icon("play"))
    ),
    mainPanel(
      tabsetPanel(
        tabPanel(
          title = "Plot",
          plotOutput("plot_1")
        )
      )
    )
  )
)


# Function for printing the plots with two different options
# When there is not a selection of the biomarker (we will take into account var_1 and var_2)
# And when there is a selection of the biomarker (we will take into account the three of them)
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 & biomarker == not_sel){
    ggplot(data = data_input, aes(x = .data[[num_var_1]], y = .data[[num_var_2]]))  
      geom_boxplot()   
      theme_bw()
  }
  
  else if(num_var_1 != not_sel & num_var_2 != not_sel & biomarker != not_sel){
    ggplot(data = data_input, aes(x = .data[[num_var_1]], y = .data[[num_var_2]]))  
      geom_boxplot()   
      theme_bw()
  }
}



################# --------------------------------------------------------------
# User interface
################# --------------------------------------------------------------

ui <- navbarPage(
  main_page
)




################# --------------------------------------------------------------
# Server
################# --------------------------------------------------------------
server <- function(input, output){
  
    data_input <- reactive({
    #req(input$xlsx_input)
    #inFile <- input$xlsx_input
    #read_excel(inFile$datapath, 1)
    romans
  })
  
  # 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)
    updateSelectInput(inputId = "factor", choices = choices)
  })
  
  # Allow user to select the legion
  output$leg <- renderUI({
    req(input$factor, data_input())
    if (input$factor != not_sel) {
      b <- unique(data_input()[[input$factor]])
      pickerInput(inputId = 'selected_factors',
                  label = 'Select factors',
                  choices = c(b[1:length(b)]), selected=b[1], multiple = TRUE,
                  # choices = c("NONE",b[1:length(b)]), selected="NONE", If we want "NONE" to appear as the first option
                  # multiple = TRUE,  ##  if you wish to select multiple factor values; then deselect NONE
                  options = list(`actions-box` = TRUE)) #options = list(`style` = "btn-warning"))
      
    }
  })
  
  num_var_1 <- eventReactive(input$run_button, input$num_var_1)
  num_var_2 <- eventReactive(input$run_button, input$num_var_2)
  factor <- eventReactive(input$run_button, input$factor)
  
  
  ## Plot
  plot_1 <- eventReactive(input$run_button,{
    #print(input$selected_factors)
    req(input$factor, data_input())
    if (!is.null(input$selected_factors)) df <- data_input()[data_input()[[input$factor]] %in% input$selected_factors,]
    else df <- data_input()
    draw_boxplot(df, num_var_1(), num_var_2(), factor())
  })
 
  output$plot_1 <- renderPlot(plot_1())
   
}

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

This code works fine at the beginning. However, there is a major inconvenience. As you can see, the user can choose three different panels. In the image attached we would be getting the plot for the morale over the casualties, filtering only for the fifth legion. enter image description here

However, if after filtering by legion, we deselect this box, then we will be getting an empty plot, as I show in the image. enter image description here

I don't really know where the issue may be comming from. I thought it may be in 'pickerInput', but that doesn't make much sense. I'm not getting any hints by R either. It is probably here:

req(input$factor, data_input())
    if (!is.null(input$selected_factors)) df <- data_input()[data_input()[[input$factor]] %in% input$selected_factors,]
    else df <- data_input()

Any help would be appreciated.

CodePudding user response：

You correctly pinned down which part of the code was causing issues. What happens is that first you render the input$selected_factors by selecting an input$factor. The legion that you have selected in this input is now in memory (meaning not NULL) for the first time. Next you change the input$factor to "Not Selected" which hides the input$selected_factors UI, however it doesn't erase it's memory. Even if your UI is hidden your input$selected_factors will remain "fifth" which triggers your if condition. However data_input()[["Not Selected"]] will return an empty table.

My recommendation would be to change the if condition like so:

if (input$factor != "Not Selected") df <- data_input()[data_input()[[input$factor]] %in% input$selected_factors,]
    else df <- data_input()