4.7 Narrative

Now we want a button to sample an accident story related to the currently chosen product and display it.

We add the following ui elements:

ui <- fluidPage(
  ...
  fluidRow(
    column(
      width = 2,
      actionButton(inputId = "story", label = "Tell me a story")
    ),
    column(width = 10, textOutput(outputId = "narrative"))
  )
)

In the backend we need an eventReactive that triggers, when the button is clicked or the selected data changes:

server <- function(input, output, session) {
  ...
  
  narrative_sample <- eventReactive(
    eventExpr = list(input$story, selected()),
    valueExpr = selected() %>%
      pull(narrative) %>%
      sample(1)
  )
  
  output$narrative <- renderText(narrative_sample())
}

The resulting version of the app is available at https://hadley.shinyapps.io/ms-prototype/.