R/shiny-fn.R

In rsangole/tslabeler: Labeling Tool For Time Series Data

#' Time Series Labeler
#' 
#' Launches a shiny app for labeling time-series data
#' 
#' 
#' @export
#' @examples
#' \dontrun{
#' label_ts()
#' }
label_ts <- function() {
  suppressPackageStartupMessages(
    shiny::runApp(system.file(package = "tslabeler"),
      launch.browser = TRUE
    )
  )
}

#' ts plotter for labeler tab
#'
#' (Internal function)
#' 
#' @param dat selected/zoomed dataframe
#' @param plotopts plot options like grp and anomaly legends 
#' @param colors tag colors
#' @param col_list column list
#' @param grp_unique_list unique group list
#'
#' @return plot object
#' @importFrom graphics axis legend lines plot points
ts_plotter <- function(dat, col_list, plotopts, colors, grp_unique_list) {
  
  if(!is.na(grp_unique_list)) {
    grp_filtered <- dat[, unique(get(col_list$grpcol))]
    tag_filtered <- dat[get(col_list$anomalycol) == 1, unique(get(col_list$tagcol))]
    
    plot(
      dat[get(col_list$grpcol) == grp_filtered[1], get(col_list$datecol)],
      dat[get(col_list$grpcol) == grp_filtered[1], get(col_list$valuecol)],
      type = "l",
      ylim = c(
        min(dat[[col_list$valuecol]], na.rm = T),
        max(dat[[col_list$valuecol]], na.rm = T)
      ),
      xlab = "",
      ylab = "",
      yaxt = "n"
    )
    y_at <- pretty(dat[[col_list$valuecol]])
    y_label <- scales::label_number_si()(y_at)
    axis(2, at = y_at, labels = y_label)
    for (i in 2:length(grp_filtered)) {
      lines(
        x = dat[get(col_list$grpcol) == grp_filtered[i], get(col_list$datecol)],
        y = dat[get(col_list$grpcol) == grp_filtered[i], get(col_list$valuecol)],
        type = "l",
        col = i,
        lty = 1,
        lwd = 1.5
      )
    }
    if ("Show Anomalies" %in% plotopts) {
      for (i in 1:length(grp_filtered)) {
        subdat <- dat[get(col_list$grpcol) == grp_filtered[i] & get(col_list$anomalycol) == 1]
        points(subdat[, get(col_list$datecol)],
               subdat[, get(col_list$valuecol)],
               col = colors[subdat[,get(col_list$tagcol)]],
               pch = 19
        )
      }
      if (length(tag_filtered) > 0) {
        legend(
          "topright",
          legend = tag_filtered,
          col = colors[tag_filtered],
          bg = "white",
          pch = 19,
          lwd = 0
        )
      }
    }
    if ("Show Legend" %in% plotopts) {
      legend(
        "topleft",
        legend = grp_filtered,
        col = 1:length(grp_filtered),
        bg = "white",
        lwd = 2
      )
    }
  } else {
    tag_filtered <- dat[get(col_list$anomalycol) == 1, unique(get(col_list$tagcol))]
    return({
      plot(
        dat[, get(col_list$datecol)],
        dat[, get(col_list$valuecol)],
        type = "l",
        ylim = c(
          min(dat[[col_list$valuecol]], na.rm = T),
          max(dat[[col_list$valuecol]], na.rm = T)
        ),
        xlab = "",
        ylab = "",
        yaxt = "n"
      )
      y_at <- pretty(dat[[col_list$valuecol]])
      y_label <- scales::label_number_si()(y_at)
      axis(2, at = y_at, labels = y_label)
      if ("Show Anomalies" %in% plotopts) {
        subdat <- dat[get(col_list$anomalycol) == 1]
        points(subdat[, get(col_list$datecol)],
               subdat[, get(col_list$valuecol)],
               col = colors[subdat[,get(col_list$tagcol)]],
               pch = 19
        )
        if (length(tag_filtered) > 0) {
          legend(
            "topright",
            legend = tag_filtered,
            col = colors[tag_filtered],
            bg = "white",
            pch = 19,
            lwd = 0
          )
        }
      }
    })
  }
}