0

I've been trying to make my first shiny app using data from the World Happiness report. I wanted to make 2 tabs:

  1. Plot using reactive values
  2. Table using reactive values

I almost succeeded except for.. when I run the code there's first an Evaluation error, and it disappears after I click on my action button. I guess I need some kind of default values to use for the plot and the table.

Is there also a way to avoid duplicating the code for the tabs? Can they share same reactive values? I tried it, but the table updated only when I clicked on the button on the 1st tab, but not on the second. I would be grateful if you suggest the better way to handle it.

Here's the code:

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

So you see, my UI is pretty heavy for such a simple app..

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

Here's a link to the app

1 Answers1

0

I suspect the issues lie (lay) when you use eventReactive twice, and observer will fire on change in any one. What we can do is the following:

  1. Get rid of the observe altogether, you dont need it as this is the one that causes the errors as the values initially are null, if you want to handle the error then its best you use with req() function or try-catch
  2. Get rid of the the reactives for the inputs, they aren't really necessary as you already can use the input
  3. Wrap the df1 and df2 in eventReactive around the button click

Code:

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)
Pork Chop
  • 28,528
  • 5
  • 63
  • 77
  • Thank you! Now the error's disappeared but the output is still shown only after clicking the button. Is there a way to set default input values for `df` so that there's an initial plot shown before activating the button? – Aliya Davletshina Feb 21 '19 at 14:54