# Mastering Shiny — 4.8 Exercise 1: Next and Back Button

Below is the 4th exercise in book Mastering Shiny, Chapter 4: Case study: ER injuries.

“Provide a way to step through every narrative systematically with forward and backward buttons.Advanced: Make the list of narratives “circular” so that advancing forward from the last narrative takes you to the first.”

Collin Berke provided a solution, where the `%%` was used for the circular purpose. However, employing `%% `is a little tricky in this exercise. Thus, I use `if else` in both Next and Previous arrows. Here is the code.

``````library(shiny)
library(ggplot2)
library(vroom)
library(tidyverse)

setwd('../../../data')

injuries <- vroom::vroom("neiss/injuries.tsv.gz")

population <- vroom::vroom("neiss/population.tsv")

products <- vroom::vroom("neiss/products.tsv")

prod_codes <- setNames(products\$prod_code, products\$title)

count_top <- function(df, var, n = 5) {
df %>%
mutate({{ var }} := fct_lump(fct_infreq({{ var }}), n = n)) %>%
group_by({{ var }}) %>%
summarise(n = as.integer(sum(weight)))
}

ui <- fluidPage(
fluidRow(
column(8,
selectInput("code", "Product",
choices = setNames(products\$prod_code, products\$title),
width = "100%"
)
),
column(2, selectInput("y", "Y axis", c("rate", "count"))),
column(2, numericInput("num_row", "Number of rows", 5, min = 1, max = 15))
),
fluidRow(
column(4, tableOutput("diag")),
column(4, tableOutput("body_part")),
column(4, tableOutput("location"))
),
fluidRow(
column(12, plotOutput("age_sex")),

),
fluidRow(
column(2, span("Narrative Display:", style = "font-weight: bold")),
column(1, actionButton(inputId ="Previous", label = icon("arrow-left"))),
column(1, actionButton(inputId ="Next", label = icon("arrow-right"))),
column(8, textOutput("narrative"))
)

)

server <- function(input, output, session) {

# use the last 6 records to test narrative
selected <- reactive(injuries %>% filter(prod_code == input\$code) %>% slice_tail(n=6))

n_row <- reactive(input\$num_row) # number of rows displayed in tables

output\$diag <- renderTable(count_top(selected(), diag, n = n_row()), width = "100%")
output\$body_part <- renderTable(count_top(selected(), body_part, n = n_row()), width = "100%")
output\$location <- renderTable(count_top(selected(), location, n = n_row()), width = "100%")

summary <- reactive({
selected() %>%
count(age, sex, wt = weight) %>%
left_join(population, by = c("age", "sex")) %>%
mutate(rate = n / population * 1e4)
})

output\$age_sex <- renderPlot({
if (input\$y == "count") {
summary() %>%
ggplot(aes(age, n, colour = sex)) +
geom_line() +
labs(y = "Estimated number of injuries")
} else {
summary() %>%
ggplot(aes(age, rate, colour = sex)) +
geom_line(na.rm = TRUE) +
labs(y = "Injuries per 10,000 people")
}
}, res = 96)

### narrative
num_narr <- reactive(
length(selected()\$narrative)
)

# a reactive value that can be easily changed later (in events)
# ref: https://stackoverflow.com/questions/42183161/r-shiny-how-to-change-values-in-a-reactivevalues-object
i <- reactiveValues(tmp=1)

# reset i to 1 if code is changed by user
# ref: https://www.collinberke.com/post/shiny-series-implementing-a-next-and-back-button/
observeEvent(input\$code, {
i\$tmp <- 1
})

output\$narrative <- renderText({
selected()\$narrative
})

observeEvent(input\$Next, {

i\$tmp <- i\$tmp + 1

if(i\$tmp <= num_narr()){
output\$narrative <- renderText({
selected()\$narrative[i\$tmp]
})
} else{
i\$tmp <- 1
output\$narrative <- renderText({
selected()\$narrative
})
}
})

observeEvent(input\$Previous, {
i\$tmp <- i\$tmp - 1

if(i\$tmp > 0){
output\$narrative <- renderText({
selected()\$narrative[i\$tmp]
})
} else{
i\$tmp <- num_narr()
output\$narrative <- renderText({
selected()\$narrative[num_narr()]
})
}
})

}

shinyApp(ui, server)``````