WebDev4R: Shiny Explained

library(shiny)
library(bslib)
library(ggplot2)

df_pizza <- gt::pizzaplace |>
  dplyr::mutate(date_sold = readr::parse_date(date)) |>
  dplyr::select(-c(date, time))


plot_revenue_by_timeframe <- function(
  df,
  timeframe,
  primary_color="#007bc2"
) {
  if (!(timeframe %in% c('month', 'quarter', 'week'))) {
    cli::cli_abort('Unsupported timeframe')
  }
  if (timeframe == 'month') {
    fn_aggregate <- lubridate::month
  }
  if (timeframe == 'quarter') {
    fn_aggregate <- lubridate::quarter
  }
  if (timeframe == 'week') {
    fn_aggregate <- lubridate::week
  }

  df |>
    dplyr::mutate(timeframe = fn_aggregate(date_sold)) |>
    dplyr::summarize(
      price = sum(price),
      .by = timeframe
    ) |>
    ggplot(aes(x = timeframe, y = price)) +
    geom_col(fill = primary_color) +
    labs(x = element_blank(), y = element_blank()) +
    scale_y_continuous(labels = scales::label_dollar()) +
    theme_minimal(base_size = 24, base_family = 'Source Sans Pro') +
    theme(
      panel.grid.major.x = element_blank(),
      panel.grid.minor = element_blank(),
    )
}

ui <- page_navbar(
  title="My {bslib} App",
  nav_panel(
    'Stats',
    page_sidebar(
      shinyWidgets::useSweetAlert(),
      sidebar = sidebar(
        sliderInput(
          'slider_timepoint',
          'Timeframe',
          min = min(df_pizza$date_sold),
          max = max(df_pizza$date_sold),
          value = range(df_pizza$date_sold),
          width = 225
        ),
        width = 300
      ),
      layout_column_wrap(
        value_box(
          'Pizzas sold',
          value = textOutput('nmbr_pizzas_sold', inline = TRUE),
          showcase = shiny::icon('pizza-slice')
        ),
        value_box(
          'Revenue generated',
          value = textOutput('nmbr_revenue_genrated', inline = TRUE),
          showcase = shiny::icon('sack-dollar')
        ),
        fill = FALSE,
        width="300px",
        min_height="100px"
      ),
      card(
        card_header(
          'Revenue by month'
        ),
        card_body(
          plotOutput('plot_by_month')
        ),
        full_screen = TRUE
      ),
      navset_card_tab(
        nav_panel(
          'Revenue by week',
          card(
            card_body(plotOutput('plot_by_week')),
            full_screen = TRUE
          )
        ),
        nav_panel(
          'Revenue by quarter',
          card(
            card_body(plotOutput('plot_by_quarter')),
            full_screen = TRUE
          )
        ),
        nav_spacer(),
        nav_item(
          actionLink(
            'btn_settings',
            label="Settings",
            icon = shiny::icon('gear')
          )
        )
      )
    )
  ),
  nav_panel(
    'Other Stuff',
    'Here is where your content could live.'
  )
)

server <- function(input, output, session) {
  df_filtered_pizza <- reactive({
    df_pizza |>
      dplyr::filter(
        date_sold >= input$slider_timepoint[1],
        date_sold <= input$slider_timepoint[2],
      )
  })

  output$nmbr_pizzas_sold <- renderText({
    df_filtered_pizza() |>
      dplyr::pull(price) |>
      length() |>
      scales::number(big.mark = ',')
  })
  output$nmbr_revenue_genrated <- renderText({
    df_filtered_pizza() |>
      dplyr::pull(price) |>
      sum() |>
      scales::dollar()
  })

  output$plot_by_month <- renderPlot({
    req(df_filtered_pizza)
    plt <- df_filtered_pizza() |>
      plot_revenue_by_timeframe(timeframe="month")
    plt + scale_x_continuous(breaks = 1:12)
  })

  output$plot_by_week <- renderPlot({
    req(df_filtered_pizza)
    plt <- df_filtered_pizza() |>
      plot_revenue_by_timeframe(timeframe="week")
    plt + scale_x_continuous(breaks = 1:53)
  })

  output$plot_by_quarter <- renderPlot({
    req(df_filtered_pizza)
    plt <- df_filtered_pizza() |>
      plot_revenue_by_timeframe(timeframe="quarter")
    plt + scale_x_continuous(breaks = 1:4)
  })

  observe({
    shinyWidgets::show_alert(
      title="Hooraay!",
      text="You clicked something",
      type="success"
    )
  }) |>
    bindEvent(input$btn_settings)
}

shinyApp(ui, server) |> print()