Question

我一直在尝试使用《世界幸福》报告中的数据制作我的第一个闪亮应用程序。我想制作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时，问题出在（躺下），并且观察者会因任何变化而触发。我们可以做的是以下事情：

完全摆脱observe，因为它是导致错误的原因，因为最初的值是null，所以您完全不需要它，如果要处理该错误，则最好使用req()功能或try-catch
摆脱输入的反应式，因为您已经可以使用input
将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)

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

1 个答案: