R/displayVCD.R

In wamserma/VCD2R: Parsing and Basic Operations on Value Change Dumps

#' the high level plotting function, vurrently provides plotting through ggplot2, dygraphs and plotly. The former being the fastes one, the others providing some degree of interactivity.
#' @param vcd A vcd object containg a hierarchy, VCD file information,...
#' @param parse Parsed toggle events as generated by \link{parseToggles}
#' @param top The signal for which the toggle counts shall be plotted
#' @param weights Optional weights when toggles should be weighted, e.g. toggles to 0 should generate a smaller amplitude than toggles to 1-
#' @param type The type of plot, currently one of `c("ggplot2","dygraphs", "plotly")` with `ggplot2` being default.
#' @param toggle_hold_time Stretch a toggle event this amount of units into the future for better visibility. This is effectively the width of a toggle count in the plot; should match at most half a clock cycle, `vcd$timescale`` is a good referece value. Set to `NA`` to turn this feature off.
#' @param ... other parameters that are forwarded to ploty or dygraph or a named vector of timestamps called events; these are printed as labels (currently in dygraphs only)
#'
#' @importFrom magrittr %>%
#' @importFrom magrittr %<>%
#' @export

plotToggles <-
  function(vcd,
           parse,
           top = NA,
           weights = list(
             "0" = -1,
             "1" = 1,
             "z" = 0,
             "x" = 1
           ),
           type = c("ggplot2","dygraphs", "plotly"),
           toggle_hold_time = 1, #
           ...) {

    #sanitize options
    if (is.na(top)) top <- vcd$hierarchy$name
    if (length(type) > 1) type <- type[1]

    if (!any(type == c("ggplot2","dygraphs", "plotly")))
        stop("Plot type not supported.")

    if (!requireNamespace(type, quietly = TRUE))
        stop("Could not load ",type,". Is this package installed?") # nocovr

    #check whether top is part of the hierarchy
    if (is.null(FindNodeGeneric(parse$hierarchy,top))) {
      stop(top, " is not in the parsed hierarchy.")
    }

    if (is.null(parse$counts[[top]]) ||
        all(sapply(parse$counts[[top]], function(x)
          length(x) < 1))) {
      parse$counts <- accumulate(top, parse)
    }

    ys <- parse$counts[[top]]

    for (val in names(ys)) {
      if ( (length(ys[[val]]) == 0) || (weights[[val]] == 0) ){
        ys[[val]] <- NULL # drop signal that have no count or weight zero
      } else{
        ys[[val]] <- sapply(noNA(ys[[val]]), function(x)
          weights[[val]] * x)
      }
    }

    ys[["sum"]] <-
      rowSums(sapply(1:length(ys), function(x)
        ys[[x]][parse$timestamps]), na.rm = T)

    timestamps<-parse$timestamps


    # restrict toggle width in plot
    if (!is.na(toggle_hold_time)) {
      ts2<-as.character(as.numeric(parse$timestamps)+toggle_hold_time)
      zeroes<-rep(0,length(ts2))
      names(zeroes)<-ts2
      for (i in names(ys)) ys[[i]]<-c(ys[[i]],zeroes)
      timestamps<-sorttimestamps(c(timestamps,ts2))
    }

    p <- NULL

    dotargs<-list(...)

    if (type == "ggplot2"){
      if (!requireNamespace("reshape2", quietly = TRUE))
        stop("Could not load ",type,". Is this package installed?") # nocovr

      # make a data frame; not the most efficient way, but works
      plotdat<-data.frame(time=timestamps)

      for (i in names(ys)){
        plotdat<-cbind(plotdat,i=NA)
      }
      colnames(plotdat)<-c("time",names(ys))

      for (i in names(ys)){
        for (j in plotdat$time){
          val<-ys[[i]][j]
          if (!is.na(val))
          plotdat[plotdat$time==j,i]<-as.numeric(val)
        }
      }

      plotdat.m<-reshape2::melt(plotdat,id.vars=c("time"),na.rm=T)
      plotdat.m[,1]<-as.numeric(as.character(plotdat.m[,1]))
      colnames(plotdat.m)[2]<-"type"

      p <- ggplot2::ggplot(plotdat.m, ggplot2::aes_(~time,~value,group=~type,colour=~type)) +
        ggplot2::geom_step() +
        ggplot2::scale_x_continuous(expand = c(0, toggle_hold_time)) +
        ggplot2::xlab(paste0(c("Time in ",vcd$timescale),collapse = "")) +
        ggplot2::ylab("Toggle Count")
    }

    if (type == "dygraphs"){
      events <- vector("list",0L)
      if (!is.null(dotargs$events)) {
        events<-dotargs$events
      }
      p <- plotToggles.dygraph(timestamps, ys, vcd$timescale, events)
    }

    if (type == "plotly"){
      p <- plotToggles.plotly(timestamps, ys, vcd$timescale,...)
    }
    invisible(list(plot=p,counts=parse$counts))
  }

plotToggles.dygraph <-
  function(timestamps, ys, timescale,events=vector("list",0L)) {
    df<-cbind(as.numeric(timestamps),as.data.frame(sapply(ys, function(y) noNA(y[timestamps])),row.names=timestamps))
    p<-dygraphs::dygraph(df, main = "Toggle Counts vs. Runtime",
                         ylab = "toggle events",
                         xlab = gettextf("time in steps of %s %s",timescale["scale"],timescale["unit"])) %>%
      # set dySeries Labels here
      dygraphs::dyOptions(stackedGraph = FALSE, stepPlot=T) %>%
      dygraphs::dyRangeSelector()

    if (length(events) > 0) {
      for (e in 1:length(events)) {
        e.name <- names(events)[[e]]
        e.times <- events[[e]]
        for (ts in e.times) {
          p %<>% dygraphs::dyEvent(ts, label = e.name, labelLoc = "top")
        }
      }
    }

    #TODO make annotations for certain values like in presAnnotation example
    invisible(p)
  }

plotToggles.plotly <-
  function(timestamps, ys, timescale,...) {
    p <- plotly::plot_ly(...,type = "scatter", mode = "lines") %>%
      plotly::layout(xaxis = list(title = timescale["unit"]),
                     yaxis = list(title = "toggles"))

    for (val in names(ys)) {
      if (val != "sum") {
        ytmp<-ys[[val]][timestamps]
        names(ytmp)<-timestamps
        p <-
          plotly::add_trace(
            p,
            x = as.numeric(timestamps),
            y = noNA(as.numeric(ytmp)),
            fill = "tozeroy",
            name = paste0("toggles to", val, collapse = " "),
            line = list(shape = "hv")
          )
      }
    }
      ytmp<-ys[["sum"]][timestamps]
      names(ytmp)<-timestamps

    p <-
      plotly::add_trace(
        p,
        x = as.numeric(timestamps),
        y = ytmp,
        name = "weighted sum",
        line = list(shape = "hv")
      )
    invisible(p)
  }