R/time_3plot.R

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

#' Check if a vector of strings matches colours
#'
#' @param str_in strings

is_colour <- function(str_in) {
  purrr::map_lgl(str_in, ~tryCatch(is.matrix(grDevices::col2rgb(.x)), error = function(e) FALSE))
}

#' Read CSV file containing colour palette information
#'
#' @param file_in filename
#' @export

read_palette <- function(file_in) {
  readr::read_csv(file_in, col_names = c("activity", "fill"))
}

#' Check CSV file containing colour palette information
#'
#' @param df_palette_in colour palette information
#' @export

check_palette <- function(df_palette_in) {
  # Check palette data
  if (!tibble::is_tibble(df_palette_in))
    rlang::abort("Palette data must be a tibble")

  if (ncol(df_palette_in) != 2)
    rlang::abort("Palette data must have two columns")

  df_palette_in
}

#' Plot TimetrackIO Report
#'
#' Plots data in the TimeTrackIO Report
#'
#' @param df_trans_in data to plot
#' @param date_start start date for plot - defaults to minimum date
#' @param date_end end date for plot - defaults to maximum date
#' @param df_palette_in palette data - if NULL, default ggplot2 colours used
#' @importFrom magrittr %>%
#' @importFrom rlang .data
#' @export

time_3plot <- function(df_trans_in, date_start = NULL, date_end = NULL, df_palette_in = NULL){
  # Date vectors
  date_vec <- df_trans_in$date_to_plot
  max_date <- max(date_vec)
  min_date <- min(date_vec)

  # Get minimum and maximum dates as defaults
  if (rlang::is_null(date_start)) {
    date_start <- min_date
  }

  if (rlang::is_null(date_end)) {
    date_end <- max_date
  }

  # Convert to date
  date_start <- lubridate::as_date(date_start)
  date_end <- lubridate::as_date(date_end)

  # Throw error if dates
  if (date_start > date_end)
    stop("Start date needs to be before end date")

  if (!dplyr::between(date_start, min_date, max_date) |
        !dplyr::between(date_end, min_date, max_date))
    stop("Start and end date need to be between min and max date")

  # Get title
  my_title <- stringr::str_c("Time data: ", format(date_start, "%d %b %Y"),
                             " to ", format(date_end, "%d %b %Y"))

  # If the palette is NULL, order the activity in alphabetical order, and use default colours
  if (rlang::is_null(df_palette_in)) {
    df_activity <- df_trans_in %>%
      dplyr::mutate_at("activity", as.ordered)

    activities <- levels(df_activity$activity)

    palette <- stats::setNames(scales::hue_pal()(length(activities)), activities)
  } else {
    # Otherwise, use WHITE for any colours not in the palette, and any misspecified colours
    df_activity <- df_trans_in %>%
      dplyr::mutate_at("activity", as.ordered) %>%
      dplyr::mutate_at("activity", forcats::fct_relevel, df_palette_in$activity)

    df_palette_plot <- tibble::tibble(activity = levels(df_activity$activity)) %>%
      dplyr::left_join(df_palette_in, by = "activity") %>%
      dplyr::mutate_at("fill", ~dplyr::if_else(is_colour(.x), .x, NA_character_)) %>%
      tidyr::replace_na(list(fill = "white"))

    palette <- stats::setNames(df_palette_plot$fill, df_palette_plot$activity)
  }

  # Based on http://bc.bojanorama.pl/2013/04/r-color-reference-sheet/
  palette_text <- ifelse(apply(grDevices::col2rgb(palette), 2, mean) < 70, "white", "black")

  # Get filtered data
  df_to_plot <- df_activity %>%
    # Workaround - convert to numeric.
    # This shouldn't be necessary due to the example at:
    # https://stackoverflow.com/questions/45367319/ggplot2-scale-time-formats-incorrectly
    # which works if tibble::tibble is replaced with data.frame
    # See https://stackoverflow.com/questions/48087358/tibbles-reject-lubridates-duration-and-period-objects
    # for more details.
    dplyr::filter(dplyr::between(.data$date_to_plot, date_start, date_end))

  # Plot data
  df_to_plot %>%
    # dplyr::mutate(start_duration_plot = as.numeric(.data$start_duration_plot),
    #               mid_duration_plot   = as.numeric(.data$mid_duration_plot),
    #               end_duration_plot   = as.numeric(.data$end_duration_plot)) %>%
    ggplot2::ggplot() +
    # Rectangles form the basis of the plot
    # Use colour and size outside of ggplot2::aes_ for the border
    ggplot2::geom_rect(
      ggplot2::aes(
        xmin = .data$date_to_plot - 0.4, xmax = .data$date_to_plot + 0.4,
        ymin = as.numeric(.data$start_duration_plot),
        ymax = as.numeric(.data$end_duration_plot),
        fill = .data$activity
      ),
      colour = "black", size = 0.1
    ) +
    # Fill them with the colour picker defined above
    ggplot2::scale_fill_manual(name = "Category", drop = FALSE,
                               values = palette) +
    # Add ,labels = colour_labels to get rid of numbers in legend
    # Label the x-axis by day
    ggplot2::scale_x_date(breaks = scales::date_breaks("1 day"),
                          date_labels = "%a %d %b", name = "",
                          sec.axis = ggplot2::dup_axis()) +
    # Label the y-axis using times.
    # For some reason I need to set the time zone to "UTC" here to format correctly.
    ggplot2::scale_y_time(
      "",
      labels = scales::time_format("%H:%M"),
      breaks = 3600 * 0:24,
      minor_breaks = 3600 * seq(0, 24, 0.25),
      expand = c(0.01, 0.01),
      position = "left",
      #sec.axis = ggplot2::dup_axis() # This doesn't work
    ) +
    # Plot text for any entries with duration at least 15 minutes
    # Use the midpoint to align. Note that the midpoint may be off,
    # as it was calculated using a duration, not a period.
    ggplot2::geom_text(
      ggplot2::aes(label = .data$plot_text, x = .data$date_to_plot, y = .data$mid_duration_plot,
                   colour = .data$activity),
      size = 2, show.legend = FALSE
    ) +
    ggplot2::scale_colour_manual(values = palette_text) +
    # Title
    ggplot2::ggtitle(my_title) +
    # Themes
    ggplot2::theme(
      panel.grid.minor.x = ggplot2::element_blank(),
      panel.grid.major.x = ggplot2::element_blank(),
      panel.background = ggplot2::element_rect(fill = "black"),
      plot.title = ggplot2::element_text(hjust = 0.5)
    )
}