R/plot_highchart.R

In shosaco/vistime: Pretty Timelines in R

#' Plot the prepared data into Highcharts.js plot
#'
#' @param data the data frame to be plotted (ranges + events), e.g. generated by `visime_data()`
#' @param title the title for the plot
#' @param show_labels boolean, show labels on events or not
#'
#' @return a plot object generated by `highchart`
#' @keywords internal
#' @noRd
#' @examples
#' \dontrun{
#' plot_highchart(data.frame(
#'     event = 1:2, start = as.POSIXct(c("2019-01-01", "2019-01-10")),
#'     end = as.POSIXct(c("2019-01-10", "2019-01-25")),
#'     group = "", tooltip = "", col = "green", fontcol = "black",
#'     subplot = 1, y = 1:2, label = 1:2
#'   ), title = "A title", show_labels = TRUE
#' )
#' }
plot_highchart <- function(data, title, show_labels){

  # let an event be 1/50th of total timeline range
  data$end <- with(data, ifelse(start != end, end, end + diff(range(c(start, end)))/50))

  data$low <- 1000 * as.double(data$start)
  data$high <- 1000 * as.double(data$end)
  data$x <- max(data$y) - data$y + 1
  data$color = data$col

  cats <- round(tapply(data$y, data$group, mean))
  y_vals <- names(sort(c(cats, setdiff(seq_len(max(data$y)), cats)), decreasing=TRUE))

  highcharter::hc_chart(
    highcharter::hc_title(
      highcharter::hc_legend(
        highcharter::hc_tooltip(
          highcharter::hc_xAxis(
            highcharter::hc_yAxis(
              highcharter::hc_add_series(
                highcharter::hc_chart(highcharter::highchart(), inverted =TRUE),
                data, "columnrange",
                dataLabels = list(enabled = show_labels, inside=T,
                                  formatter = highcharter::JS("function () {return (this.y === this.point.low ? this.point.event : \"\")}"))),
              type = "datetime"),
            categories = c("", y_vals)),
          crosshairs = TRUE, formatter = highcharter::JS("function () {return this.point.tooltip}")) ,
        enabled=F),
      text = title),
    zoomType = "xy")
}