用户输入更改后，R Shiny 不生成绘图

Question

这里是罗马历史迷，所以我有一个数据框，名称为两个legions（fifth 和tirteenth），它们的casualties（数值）和部队的morale（@ 987654328@, medium, low)。

我想知道（箱线图）morale（x 轴）和casualties（y 轴）之间的关系，以及legion 的子集。

请注意，这是一个玩具示例。在真实数据（没有罗马字）中，每个轴都有几个变量，所以我们要求用户加载数据，然后为每个轴选择他想要使用的变量。

这里有一个 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)

此代码在开始时运行良好。但是，有一个很大的不便。 如您所见，用户可以选择三个不同的面板。在所附图片中，我们将得到关于伤亡士气的情节，仅过滤第五军团。 enter image description here

但是，如果在按军团过滤后，我们取消选择此框，那么我们将得到一个空图，如图所示。 enter image description here

我真的不知道问题出在哪里。我认为它可能在“pickerInput”中，但这没有多大意义。我也没有得到 R 的任何提示。大概就在这里：

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()

任何帮助将不胜感激。

Answer 1

您正确确定了导致问​​题的代码部分。发生的情况是，首先您通过选择input$factor 呈现input$selected_factors。您在此输入中选择的军团现在第一次在内存中（意思是非 NULL）。接下来，您将input$factor 更改为“未选择”，这将隐藏input$selected_factors UI，但它不会删除它的内存。即使您的 UI 被隐藏，您的 input$selected_factors 仍将保持“第五”，这会触发您的 if 条件。但是data_input()[["Not Selected"]] 将返回一个空表。

我的建议是像这样更改 if 条件：

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