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/.