R/utils_graphing.R

In dr-consulting/ibi_VizEdit: Open-Source Software for Processing and Editing Heart Rate Data

#' Internal utility for defualt plot message generation
#'
#' \code{ppg_data_check_empty_plot} creates a plot with a user-facing message stating that no data has been loaded.
#' @importFrom ggplot2 ggplot annotate theme_bw

ppg_data_check_empty_plot <- function(){
  df <- data.frame(x=c(-1,0,1), y=c(-1,0,1))
  p <- ggplot(aes_string(x='x', y='y'), data=df) +
    annotate('text', x=0, y=0, label='No Processed Data Provided') +
    theme_bw()

  return(p)
}

#' Internal utility for plot generation
#'
#' \code{generate_ppg_data_check_plot} defines the properties of the plot called on the UI Processing Panel to check
#' that the PPG data loading process was successful. The utility and resulting plot allow a user to visually inspect
#' the imported signal based on settings defined on the UI Data Entry panel
#'
#' @param ppg_data is a \code{data.frame} that contains the processed PPG signal and a time variable.
#' @param ppg_col is of type \code{character} and is the column name in the \code{ppg_data} that contains the PPG signal
#' @param time_col is of type \code{character} and is the column name in the \code{ppg_data} that contains the time
#' variable
#'
#' @export
#' @importFrom ggplot2 ggplot geom_line labs theme_bw aes_string

generate_ppg_data_check_plot <- function(ppg_data = NULL, ppg_col='PPG', time_col='Time'){
  p <- ggplot(data=ppg_data)+
    geom_line(aes_string(x=time_col,
                         y=ppg_col)) +
    labs(x="Time (s)", y="PPG (volts)") +
    theme_bw()
  return(p)
}

#' Internal utility for gui plot generation
#'
#' \code{generate_base_gui_plot} defines the base plot that forms the basis for interactively editing IBIs
#'
#' @param ibi_data is a \code{data.frame} that contains the IBI series being activel edited by the user during the
#' session
#' @param color_map is defined by internal {ibibVizEdit} settings that map point colors to each category
#' @param ibi_col is of type \code{character} and is the column name in the \code{ibi_data} that contains the IBI series
#' @param time_col is of type \code{character} and is the column name in the \code{ppg_data} that contains the time
#' variable
#' @param pnt_type is the default column name for the IBI data being edited that represents the status of the IBI value
#' in terms of whether it was originally detected by the peak detection algorithm and if not what type of edit 
#' generated the final value present in the data set. 
#'
#' @importFrom ggplot2 ggplot geom_point geom_line scale_color_manual labs theme_bw aes_string

generate_base_gui_plot <- function(ibi_data=NULL, color_map=NULL, ibi_col="IBI", time_col='Time', pnt_type="pnt_type"){
  p <- ggplot(data=ibi_data,
              aes_string(x=time_col, y=ibi_col)) +
    geom_point(aes_string(color=pnt_type), show.legend=FALSE, size=2.75) +
    geom_line(color="black") +
    scale_color_manual(values=color_map) +
    labs(x="Time (s)", y="IBI (s)") +
    theme_bw()
  return(p)
}

#' Internal utility for modifying gui plot
#'
#' \code{add_task_v_lines} adds vertical lines that delineate the timing boundaries of tasks/conditions defined in the
#' timing file
#'
#' @param base_plot is a \code{ggplot2} object, typically generated by \code{generate_base_gui_plot}
#' @param timing_data is a \code{data.frame} that contains time stamps for the start and stop of different
#' tasks/conditions
#' @param time_col is of type \code{character} and is the column name in the \code{timing_data} that contains start/stop
#' time stamps
#' @param task_col is of type \code{character} and is the column name in the \code{timing_data} that contains
#' task/condition names
#' @param label_color hexidecimal code for label used in conjunction with the vertical lines. Defaults to the standard
#' "original" color 
#'
#' @importFrom ggplot2 geom_vline geom_text 
#' @importFrom magrittr %>%
#' @importFrom tidyr pivot_longer

add_task_v_lines <- function(base_plot=NULL, timing_data=NULL, time_col='Time', task_col="Task",
                             label_color=IBI_POINT_COLORS["original"]){
  if(!is.null(timing_data) & !is.null(plot)){
    timing_data <- timing_data %>%
      pivot_longer(-task_col, names_to = "labels", values_to = time_col)

    timing_data$labels <- paste(timing_data[[task_col]], timing_data[["labels"]], sep="-")

    p <- base_plot +
      geom_vline(data=timing_data, aes_string(xintercept=time_col), show.legend = FALSE, color=label_color)+
      geom_text(data=timing_data, aes_string(x=time_col, label="labels", y=.20), show.legend=FALSE, angle=60, hjust=0,
                color=label_color)
    return(p)
  }
  else{
    return(base_plot)
  }
}


#' Internal \code{ibiVizEdit} utility that adds PPG to plot
#' 
#' @param base_plot is a \code{ggplot2} object, typically generated by \code{generate_base_gui_plot}
#' @param ppg_data is a \code{data.frame} that contains the processed PPG signal and a time variable.
#' @param show_ppg logical value based on user selection. Status governs the display of underlying PPG signal
#' @param time_col is of type \code{character} and is the column name in the \code{ppg_data} that contains the time
#' variable
#' @param ppg_col is of type \code{character} and is the column name in the \code{ppg_data} that contains the PPG signal
#' 
#' @importFrom ggplot2 geom_line aes_string

add_ppg_waveform <- function(base_plot=NULL, ppg_data=NULL, show_ppg=FALSE, time_col="Time", ppg_col="PPG"){
  if(show_ppg & !is.null(ppg_data)){
    p <- base_plot +
      geom_line(data=ppg_data,
                aes_string(x=time_col,
                           y=ppg_col,
                           color="pnt_type"),
                alpha=.75,
                color="grey")
    return(p)
  }
  else{
    return(base_plot)
  }
}

#' Internal \code{ibiVizEdit} utility that enables dynamic color selection based on selected points
#'
#' @param base_plot is a \code{ggplot2} object, typically generated by \code{generate_base_gui_plot}
#' @param selected_points values returned from user either by clicking or using a "brush" to identify a set of IBIs for
#' editing
#' @param time_col is of type \code{character} and is the column name in the \code{ppg_data} that contains the time
#' @param ibi_col is of type \code{character} and is the column name in the \code{ibi_data} that contains the IBI series
#' 
#' @importFrom ggplot2 geom_point aes_string

highlight_ibis <- function(base_plot=NULL, selected_points=NULL, time_col="Time", ibi_col="IBI"){
  if(!is.null(selected_points)){
    p <- base_plot +
      geom_point(data=selected_points,
                 aes_string(x=time_col,
                            y=ibi_col),
                 color="#8fff00")
    return(p)
  }
  else{
    return(base_plot)
  }
}


#' Internal utility for generating dynamic text label corresponding to ibi value
#' 
#' @param base_plot is a \code{ggplot2} object, typically generated by \code{generate_base_gui_plot}
#' @param hover_point value based on user hovering behavior - can be used to inspect specific IBI value to assist 
#' with editing. 
#' @param time_col is of type \code{character} and is the column name in the \code{ppg_data} that contains the time
#' @param ibi_col is of type \code{character} and is the column name in the \code{ibi_data} that contains the IBI series
#'
#' @importFrom ggplot2 geom_label

ibi_value_label <- function(base_plot=NULL, hover_point=NULL, time_col="Time", ibi_col="IBI"){
  if(!is.null(hover_point)){
    label_value <- paste("IBI:", round(hover_point[[ibi_col]], digits = 3))
    p <- base_plot +
      geom_label(data = hover_point, label=label_value, nudge_y = .15)
    return(p)
  }
  else{
    return(base_plot)
  }
}


#' Server side function to acquire hover points
#' 
#' @param input,hover_id {shiny} internal and the name of the relevant hover function id

hover_point_selection <- function(input, hover_id){
  observeEvent(input[[hover_id]], {

    if(!is.null(input[[hover_id]])){
      tmp_point <- nearPoints(DYNAMIC_DATA[["edited_ibi"]], coordinfo = input[[hover_id]], maxpoints = 1)

      if(nrow(tmp_point) == 1){
        DYNAMIC_DATA[["hover_point"]] <- tmp_point
      }

      else{
        DYNAMIC_DATA[["hover_point"]] <- NULL
      }
    }
  }, ignoreNULL = FALSE)
}


#' Server side function that takes and saves screenshot in a screenshots folder for easy sharing with colleagues
#'
#' @param input {shiny} internal
#' @param data data used to create the plot
#' @param time_brush brush that defines the time window displayed in the ui for the user to edit
#' @param button_id id value for the button that is intended to "trigger" the creation of the plot
#' @param ibi_or_ppg PLACEHOLDER
#'
#' @return saves version of the plot currently being displayed. The intent is to make it easier to share out with 
#' teammates when editing difficult sections of data and to document pre and post processing efforts
#' @importFrom glue glue
#' @importFrom ggplot2 labs ggsave

save_screenshot <- function(input, data, time_brush, button_id, ibi_or_ppg=NULL){
  # Getting time min and max for labeling purposes
  observeEvent(input[[button_id]], {
    time_min <- ifelse(!is.null(input[[time_brush]]), round(input[[time_brush]]$xmin, 2),
                       round(min(DYNAMIC_DATA[["edited_ibi"]][["Time"]]), 2))
    time_max <- ifelse(!is.null(input[[time_brush]]), round(input[[time_brush]]$xmax, 2),
                       round(max(DYNAMIC_DATA[["edited_ibi"]][["Time"]]), 2))

    file_name <- glue("{STATIC_DATA[['case_id']]}_{STATIC_DATA[['optional_id']]}_{time_min}_to_{time_max}")
    file_path <- glue("{FILE_SETTINGS[['screenshot_out_dir']]}/{file_name}.png")

    if(ibi_or_ppg == "ibi"){
      ibi_plot <- ibi_editing_plot(ibi_data=data, brush_in = input[[time_brush]])
      main_title <- glue("{STATIC_DATA[['case_id']]}_{STATIC_DATA[['optional_id']]}: IBI Series from {time_min} to {time_max}")
      return_plot <- ibi_plot +
        labs(title = main_title)
    }

    else if(ibi_or_ppg == "ppg"){
      # Still needs work
    }

    ggsave(file_path, return_plot, device = "png", width = 9, height = 6, units = "in")
  })
}