Nothing
#' Plot the prepared data into Plotly plot
#'
#' @param data the data frame to be plotted (ranges + events), e.g. generated by `visime_data`
#' @param linewidth the width in pixel for the range lines
#' @param title the title for the plot
#' @param show_labels boolean, show labels on events or not
#' @param background_lines number of grey background lines to draw (can be NULL)
#' @importFrom plotly plot_ly
#' @importFrom plotly layout
#' @importFrom plotly add_trace
#' @importFrom plotly add_text
#' @importFrom plotly add_markers
#' @importFrom plotly toRGB
#'
#' @return a plot object generated by `plot_ly`
#' @keywords internal
#' @noRd
#' @examples
#' \dontrun{
#' plot_plotly(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
#' ), linewidth = 10, title = "A title", show_labels = TRUE, background_lines = 10
#' )
#' }
plot_plotly <- function(data, linewidth, title, show_labels, background_lines) {
# 1. Prepare basic plot
p <- plot_ly(type = "scatter", mode = "lines")
y_ticks <- tapply(data$y, data$subplot, mean)
# 2. Divide subplots with horizontal lines
hline <- function(y = 0) list(type = "line", x0 = 0, x1 = 1, xref = "paper", y0 = y, y1 = y, line = list(color = "grey65", width = 0.5))
vline <- function(x = 0) list(type = "line", y0 = 0, y1 = 1, yref = "paper", x0 = x, x1 = x, line = list(color = "grey90", width = 0.1))
horizontal_lines <- lapply(setdiff(seq_len(max(data$y)), data$y), hline)
# 3. Add vertical lines
if(!is.null(background_lines)){
day_breaks <- as.POSIXct(seq(min(c(data$start, data$end)), max(c(data$start, data$end)),
length.out = round(background_lines) + 2), origin = "1970-01-01")
vertical_lines <- lapply(day_breaks, vline)
}else{
vertical_lines <- list()
}
p <- layout(p,
hovermode = "closest",
plot_bgcolor = "#FCFCFC",
title = title,
shapes = append(vertical_lines, horizontal_lines),
# Axis options:
xaxis = list(linewidth = 1, mirror = TRUE,
showgrid = is.null(background_lines),
gridcolor = "grey90", title = ""),
yaxis = list(
linewidth = 1, mirror = TRUE,
range = c(0, max(data$y) + 1),
showgrid = F, title = "",
tickmode = "array",
tickvals = y_ticks,
ticktext = as.character(unique(data$group))
)
)
# 4. plot ranges
range_dat <- data[data$start != data$end, ]
lw <- ifelse(is.null(linewidth), min(100, 300/max(data$y)), linewidth) # 1-> 100, 2->100, 3->100, 4->70
if(nrow(range_dat) > 0){
# draw ranges piecewise
for (i in seq_len(nrow(range_dat))) {
toAdd <- range_dat[i, ]
p <- add_trace(p,
x = c(toAdd$start, toAdd$end), # von, bis
y = toAdd$y,
line = list(color = toAdd$col, width = lw),
showlegend = F,
hoverinfo = "text",
text = toAdd$tooltip
)
# add annotations or not
if (show_labels) {
p <- add_text(p,
x = toAdd$start + (toAdd$end - toAdd$start) / 2, # in der Mitte
y = toAdd$y,
textfont = list(family = "Arial", size = 14, color = toRGB(toAdd$fontcol)),
textposition = "center",
showlegend = F,
text = toAdd$label,
hoverinfo = "none"
)
}
}
}
# 5. plot events
event_dat <- data[data$start == data$end, ]
if(nrow(event_dat) > 0){
# alternate y positions for event labels
event_dat$labelY <- event_dat$y + 0.5 * rep_len(c(1, -1), nrow(event_dat))
# add all the markers for this Category
p <- add_markers(p,
x = event_dat$start, y = event_dat$y,
marker = list(
color = event_dat$col, size = 0.7 * lw, symbol = "circle",
line = list(color = "black", width = 1)
),
showlegend = F, hoverinfo = "text", text = event_dat$tooltip
)
# add annotations or not
if (show_labels) {
p <- add_text(p,
x = event_dat$start, y = event_dat$labelY, textfont = list(family = "Arial", size = 14,
color = toRGB(event_dat$fontcol)),
textposition ="center", showlegend = F, text = event_dat$label, hoverinfo = "none"
)
}
}
return(p)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.