#' 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)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.