inst/shiny-examples/timeplot/app.R

In andrewjpfeiffer/timetrackr: Takes time tracking data and produces a pretty graph

library(shiny)
library(tidyverse)
library(lubridate)
library(timetrackr)

options(shiny.sanitize.errors = FALSE)

# Need this to ensure data isn't munged to UTC.
Sys.setenv(TZ = "Australia/Adelaide")

# Define UI for data upload app ----
ui <- fluidPage(

  # Application title
  titlePanel("Create Time-Tracking Plot"),

  # Sidebar layout with input and output definitions ----
  sidebarLayout(

    # Sidebar panel for inputs ----
    sidebarPanel(

      # Input: Select a file ----
      fileInput("time_data_in", "Choose CSV File",
                multiple = FALSE,
                accept = "text"),

      # Start date ----
      uiOutput("start_date_input"),

      # End date ----
      uiOutput("end_date_input"),

      # Palette
      uiOutput("palette_file_input"),

      # Palette response
      uiOutput("palette_response_input"),

      # Button input ----
      uiOutput("button_input"),

      # Download handler ----
      uiOutput("save_plot_input")
    ),

    # Main panel for displaying outputs ----
    mainPanel(

      # Output: Data file ----
      uiOutput("data_output"),

      # Output: Plot ----
      plotOutput("plot_output", height = "1600px")
    )

  )
)

# Define server logic to read selected file ----
server <- function(input, output) {
  # Read in time data
  time_data_react <- reactive({
    req(input$time_data_in)
    time_1read(input$time_data_in$datapath)
  })

  # Check the time data to ensure rows are ordered correctly
  error_data_react <- reactive(filter(time_data_react(), !ind_row_order))

  error_data_ind_react <- reactive(nrow(error_data_react()) > 0)

  # Get data for date range
  date_range_react <- reactive(
    lubridate::as_date(lubridate::with_tz(lubridate::as_datetime(time_data_react()$start_dttm)))
  )

  # Get date bounds as reactive
  min_date_react <- reactive(min(date_range_react()))

  max_date_react <- reactive(max(date_range_react()))

  # Input the start date based on the date bounds

  output$data_output <- renderUI({
    if (!all(error_data_ind_react())) {
      NULL
    } else {
      list(
        p("The data are not sorted correctly. Problem rows listed below."),
        hr(),
        renderTable(
          error_data_react() %>%
            dplyr::transmute(
              Start    = as.character(format(.data$start_dttm, "%F %R %z")),
              End      = as.character(format(.data$start_dttm, "%F %R %z")),
              Activity = .data$activity,
              Notes    = .data$notes
            )
        )
      )
    }
  })

  output$start_date_input <- renderUI({
    if (all(error_data_ind_react())) {
      NULL
    } else {
      list(hr(),
           dateInput(
             "start_date_in", "Choose a start date",
             value = min_date_react(),
             min = min_date_react(), max = max_date_react()
           )
      )
    }
  })

  start_date_react <- reactive(input$start_date_in)

  # Input the end date based on the end bounds and start date
  output$end_date_input <- renderUI({
    list(
      hr(),
      dateInput(
        "end_date_in", "Choose an end date",
        value = max_date_react(),
        min = start_date_react(), max = max_date_react()
      )
    )
  })


  end_date_react <- reactive(input$end_date_in)

  # Action button
  output$button_input <- renderUI({
    req(input$end_date_in)

    list(hr(), actionButton("button_in", "Create time tracking plot"))
  })

  output$palette_file_input <- renderUI({
    req(input$end_date_in)

    list(hr(),
         strong("Optional: upload two-column CSV with additional colours"),
         p("First column: activities"),
         p("Second column: colours"),
         fileInput("palette_file_in", label = "", multiple = FALSE, accept = "text"))
  })

  # Use the palette file
  df_palette_react <- reactive({
    req(input$palette_file_in)
    read_palette(input$palette_file_in$datapath)
  })

  palette_react <- reactive({
    tryCatch(check_palette(df_palette_react()), error = function(e) NULL)
  })

  output$palette_response_input <- renderUI({
    req(input$palette_file_in)

    if (rlang::is_null(palette_react())) {
      list(hr(), p("Palette data must be a two-column tibble"))
    } else {
      list(
        hr(),
        p("Palette data looks good")
      )
    }
  })

  # Produce timeplot
  time_plot <- eventReactive(input$button_in, {
    time_data_react() %>%
      time_2transform() %>%
      time_3plot(date_start    = start_date_react(),
                 date_end      = end_date_react(),
                 df_palette_in = palette_react())
  })

  # Download plot
  output$download_plot_input <- downloadHandler(
    filename = function() stringr::str_c(start_date_react(), "-to-", end_date_react(), "-time.pdf"),
    content = function(file) ggplot2::ggsave(file, plot = time_plot(), device = "pdf",
                                             width = 420, height = 594, units = "mm")
  )

  # Download button that only appears when the template is selected
  observeEvent(input$button_in, {
    output$plot_output <- renderPlot(time_plot())
    output$save_plot_input <- renderUI({
      list(br(), downloadButton("download_plot_input", "Download plot"))
    })
  })
}

shinyApp(ui, server)