如何设置默认值以在闪亮中构建 ggplot？

Question

我一直在尝试使用世界幸福报告中的数据制作我的第一个闪亮应用。我想制作 2 个标签：

1. 使用反应值绘图
2. 使用反应值的表

我几乎成功了，除了......当我运行代码时，首先出现了一个评估错误，在我点击我的操作按钮后它消失了。 我想我需要某种默认值来用于绘图和表格。

还有没有办法避免重复标签的代码？它们可以共享相同的反应值吗？我试过了，但只有当我点击第一个选项卡上的按钮时，表格才会更新，而不是第二个。如果您提出更好的处理方法，我将不胜感激。

代码如下：

`ui <- fluidPage(
       titlePanel(tags$h3("Happiness")), 
       tabsetPanel(
         tabPanel("Plot", "tab1", 
           sidebarLayout(
             sidebarPanel(
               selectInput("factor1", "Choose a value:", choices = c("GDPpc", "Family","Life.Expectancy","Freedom", "Generosity", "Trust"), selected = "Family"), 
               sliderInput(inputId = "happiness1", label = "Choose level of happiness", 
                         min = 0, max = 8, value = 7, step = 0.1), 
               actionButton("button1", "Update")
             ),
             mainPanel(
             # tags$img(height = , width = )
             plotlyOutput("plot1")
             )
           )
           ),
         tabPanel("Table", "tab2", 
           sidebarLayout(
             sidebarPanel(
               selectInput("factor2", "Choose a value:", choices = c("GDPpc", "Family","Life.Expectancy", 
                                                                   "Freedom", "Generosity", "Trust"), selected = "Family"), 
               sliderInput(inputId = "happiness2", label = "Choose level of happiness", 
                         min = 0, max = 8, value = 7, step = 0.1), 
               actionButton("button2", "Update")
             ),
             mainPanel(
               tableOutput("table1")
               )
             )
             )
        )
        )`

所以你看，我的 UI 对于这样一个简单的应用程序来说是相当沉重的......

`server <- function(input, output) {
inputFactor1 <- eventReactive(input$button1, {
  inputFactor1 <-  input$factor1
  })

inputHappiness1 <- eventReactive(input$button1, {
  inputHappiness1 <- input$happiness1
  })

df1 <- reactive({
report %>%
  filter(Happiness.Score >= inputHappiness1()) %>%
  dplyr:: select( "Country", "Continent", "Happiness.Score", inputFactor1(), "GDPpc")
})

observe({
output$plot1 <- renderPlotly({
  p <- ggplot(df1(), aes(x = df1()[,4], y = Happiness.Score))
  p <- p + geom_point(size = 2, aes(text = paste("Country:", df1()[,1]), color = Continent,  alpha = 0.85)) + 
    labs(title = "How happy is the country?", x = names(df1())[4], y = "Happiness Score") + 
    theme_light(base_size = 12) + ylim(2,8) 
  ggplotly(p, tooltip = c("text", "y"))
})
})

inputFactor2 <- eventReactive(input$button2, {
  inputFactor2 <-  input$factor2
  })

inputHappiness2 <- eventReactive(input$button2, {
  inputHappiness2 <- input$happiness2
  })

df2 <- reactive({
report %>%
  filter(Happiness.Score >= inputHappiness2()) %>%
  dplyr:: select( "Country", "Continent", "Happiness.Score", inputFactor2(), "GDPpc")
 })

output$table1 <- renderTable({
head(df2())
})
}

shinyApp(ui = ui, server = server)`

这是link to the app

Answer 1

我怀疑当您使用eventReactive 两次时问题就出在（lay）上，并且观察者会在任何一次更改时触发。我们可以做的是：

1. 完全摆脱observe，你不需要它，因为这是导致错误的原因，因为最初的值是null，如果你想处理错误，那么最好使用req()函数或try-catch
2. 去掉输入的反应，它们不是真正必要的，因为你已经可以使用input
3. 将df1 和df2 包裹在eventReactive 中点击按钮

代码：

library(shiny)
library(plotly)

ui <- fluidPage(
  HTML('<script> document.title = "Happiness"; </script>'),
  titlePanel(tags$h3("Happiness")), 
  tabsetPanel(
    tabPanel("Plot", "tab1", 
             sidebarLayout(
               sidebarPanel(
                 selectInput("factor1", "Choose a value:", choices = c("GDPpc", "Family","Life.Expectancy","Freedom", "Generosity", "Trust"), selected = "Family"), 
                 sliderInput(inputId = "happiness1", label = "Choose level of happiness", 
                             min = 0, max = 8, value = 7, step = 0.1), 
                 actionButton("button1", "Update")
               ),
               mainPanel(
                 plotlyOutput("plot1")
               )
             )
    ),
    tabPanel("Table", "tab2", 
             sidebarLayout(
               sidebarPanel(
                 selectInput("factor2", "Choose a value:", choices = c("GDPpc", "Family","Life.Expectancy", 
                                                                       "Freedom", "Generosity", "Trust"), selected = "Family"), 
                 sliderInput(inputId = "happiness2", label = "Choose level of happiness", 
                             min = 0, max = 8, value = 7, step = 0.1), 
                 actionButton("button2", "Update")
               ),
               mainPanel(
                 tableOutput("table1")
               )
             )
    )
  )
)

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

  df1 <- eventReactive(input$button1,{
    report %>%
      filter(Happiness.Score >= input$happiness1) %>%
      dplyr:: select( "Country", "Continent", "Happiness.Score", input$factor1, "GDPpc")
  })

  output$plot1 <- renderPlotly({
    req(df1())
    p <- ggplot(df1(), aes(x = df1()[,4], y = Happiness.Score))
    p <- p + geom_point(size = 2, aes(text = paste("Country:", df1()[,1]), color = Continent,  alpha = 0.85)) + 
      labs(title = "How happy is the country?", x = names(df1())[4], y = "Happiness Score") + 
      theme_light(base_size = 12) + ylim(2,8) 
    ggplotly(p, tooltip = c("text", "y"))
  })

  df2 <- eventReactive(input$button2,{
    report %>%
      filter(Happiness.Score >= input$happiness2) %>%
      dplyr:: select( "Country", "Continent", "Happiness.Score", input$factor2, "GDPpc")
  })

  output$table1 <- renderTable({
    req(df2())
    head(df2())
  })
}

shinyApp(ui = ui, server = server)