r - 如何设置默认值以在闪亮中构建 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")
               )
             )
             )
        )
        )`

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

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

这是应用程序的链接

Answer 1

我怀疑当你使用两次时问题就出在（lay）eventReactive上，并且观察者会在任何一次发生变化时触发。我们能做的有以下几点：

1. 完全摆脱observe它，您不需要它，因为这是导致错误的原因，因为最初的值是null，如果您想处理错误，那么最好使用req()函数或try-catch
2. 摆脱输入的反应，它们并不是真正必要的，因为你已经可以使用input
3. df1将and包裹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)