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

Question

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

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

的子集

请注意，这是一个玩具示例。在真实数据（没有罗马人）中，每个轴都有几个变量，因此我们要求用户加载数据，然后 select 他想为每个轴使用哪些变量。

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

但是，如果在按 legion 过滤后，我们取消select 这个框，那么我们将得到一个空图，如图中所示。 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"]] 将 return 一个空 table.

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

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

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

Rshiny not producing plots after user's input change

plot

r

shiny