#' Plot Euler and Venn diagrams
#'
#' Plot diagrams fit with [euler()] and [venn()] using [grid::Grid()] graphics.
#' This
#' function sets up all the necessary plot parameters and computes
#' the geometry of the diagram. [plot.eulergram()], meanwhile,
#' does the actual plotting of the diagram. Please see the **Details** section
#' to learn about the individual settings for each argument.
#'
#' The only difference between [plot.euler()] and [plot.venn()] is that
#' `quantities` is set to `TRUE` by default in the latter and `FALSE` in
#' the former.
#'
#' Most of the arguments to this function accept either a logical, a vector, or
#' a list where
#'
#' * logical values set the attribute on or off,
#' * vectors are shortcuts to commonly used options (see the individual
#' parameters), and
#' * lists enable fine-grained control, including graphical
#' parameters as described in [grid::gpar()] and control
#' arguments that are specific to each argument.
#'
#' The various [grid::gpar()] values that are available for each argument
#' are:
#'
#' \tabular{lccccccccc}{
#' \tab fills \tab edges \tab labels \tab quantities \tab strips \tab legend \tab main \cr
#' col \tab \tab x \tab x \tab x \tab x \tab x \tab x \cr
#' fill \tab x \tab \tab \tab \tab \tab \tab \cr
#' alpha \tab x \tab x \tab x \tab x \tab x \tab x \tab x \cr
#' lty \tab \tab x \tab \tab \tab \tab \tab \cr
#' lwd \tab \tab x \tab \tab \tab \tab \tab \cr
#' lex \tab \tab x \tab \tab \tab \tab \tab \cr
#' fontsize \tab \tab \tab x \tab x \tab x \tab x \tab x \cr
#' cex \tab \tab \tab x \tab x \tab x \tab x \tab x \cr
#' fontfamily \tab \tab \tab x \tab x \tab x \tab x \tab x \cr
#' lineheight \tab \tab \tab x \tab x \tab x \tab x \tab x \cr
#' font \tab \tab \tab x \tab x \tab x \tab x \tab x \cr
#' }
#'
#' Defaults for these values, as well as other parameters of the plots, can
#' be set globally using [eulerr_options()].
#'
#' If the diagram has been fit using the `data.frame` or `matrix` methods
#' and using the `by` argument, the plot area will be split into panels for
#' each combination of the one to two factors.
#'
#' For users who are looking to plot their diagram using another package,
#' all the necessary parameters can be collected if the result of this
#' function is assigned to a variable (rather than printed to screen).
#'
#' @param x an object of class `'euler'`, generated from [euler()]
#' @param fills a logical, vector, or list of graphical parameters for the fills
#' in the diagram. Vectors are assumed to be colors for the fills.
#' See [grid::grid.path()].
#' @param edges a logical, vector, or list of graphical parameters for the edges
#' in the diagram. Vectors are assumed to be colors for the edges.
#' See [grid::grid.polyline()].
#' @param legend a logical scalar or list. If a list,
#' the item `side` can be used to set the location of the legend. See
#' [grid::grid.legend()].
#' @param labels a logical, vector, or list. Vectors are assumed to be
#' text for the labels. See [grid::grid.text()].
#' @param quantities a logical, vector, or list. Vectors are assumed to be
#' text for the quantities' labels, which by
#' default are the original values in the input to [euler()]. In addition
#' to arguments that apply to [grid::grid.text()], an argument `type` may
#' also be used which should be a combination of `"counts"` and
#' `"percent"`. The first item will be printed first and the second
#' will be printed thereafter inside brackets. The default is
#' `type = "counts"`.
#' @param strips a list, ignored unless the `'by'` argument
#' was used in [euler()]
#' @param n number of vertices for the `edges` and `fills`
#' @param main a title for the plot in the form of a
#' character, expression, list or something that can be
#' sensibly converted to a label via [grDevices::as.graphicsAnnot()]. A
#' list of length one can be provided, in which case its only element
#' is used as the label. If a list of longer length is provided, an item
#' named `'label'` must be provided (and will be used for the actual text).
#' @param ... parameters to update `fills` and `edges` with and thereby a shortcut
#' to set these parameters
#' [grid::grid.text()].
#' @param adjust_labels a logical. If `TRUE`, adjustment will be made to avoid
#' overlaps or out-of-limits plotting of labels, quantities, and
#' percentages.
#'
#' @seealso [euler()], [plot.eulergram()], [grid::gpar()],
#' [grid::grid.polyline()], [grid::grid.path()],
#' [grid::grid.legend()], [grid::grid.text()]
#'
#' @return Provides an object of class `'eulergram'` , which is a
#' description of the diagram to be drawn. [plot.eulergram()] does the actual
#' drawing of the diagram.
#' @export
#' @examples
#' fit <- euler(c("A" = 10, "B" = 5, "A&B" = 3))
#'
#' # Customize colors, remove borders, bump alpha, color labels white
#' plot(fit,
#' fills = list(fill = c("red", "steelblue4"), alpha = 0.5),
#' labels = list(col = "white", font = 4))
#'
#' # Add quantities to the plot
#' plot(fit, quantities = TRUE)
#'
#' # Add a custom legend and retain quantities
#' plot(fit, quantities = TRUE, legend = list(labels = c("foo", "bar")))
#'
#' # Plot without fills and distinguish sets with border types instead
#' plot(fit, fills = "transparent", lty = 1:2)
#'
#' # Save plot parameters to plot using some other method
#' diagram_description <- plot(fit)
#'
#' # Plots using 'by' argument
#' plot(euler(fruits[, 1:4], by = list(sex)), legend = TRUE)
plot.euler <- function(x,
fills = TRUE,
edges = TRUE,
legend = FALSE,
labels = identical(legend, FALSE),
quantities = FALSE,
strips = NULL,
main = NULL,
n = 200L,
adjust_labels = TRUE,
...) {
if (!missing(adjust_labels)) {
warning("`adjust_labels` is deprecated and no longer has any effect.")
}
# retrieve default options
opar <- eulerr_options()
groups <- attr(x, "groups")
dots <- list(...)
do_custom_legend <- grid::is.grob(legend)
do_fills <- !is_false(fills) && !is.null(fills)
do_edges <- !is_false(edges) && !is.null(edges)
do_labels <- !is_false(labels) && !is.null(labels)
do_quantities <- !is_false(quantities) && !is.null(quantities)
do_legend <- !is_false(legend) && !is.null(legend)
do_groups <- !is.null(groups)
do_strips <- !is_false(strips) && do_groups
do_main <- is.character(main) || is.expression(main) || is.list(main)
ellipses <- if (do_groups) x[[1L]]$ellipses else x$ellipses
n_e <- NROW(ellipses)
n_id <- 2^n_e - 1
id <- bit_indexr(n_e)
setnames <- rownames(ellipses)
if (do_groups) {
res <- lapply(x, function(xi) is.na(xi$ellipses)[, 1L])
empty_sets <- apply(do.call(rbind, res), 2, all)
empty_subsets <- rowSums(id[, empty_sets, drop = FALSE]) > 0
res <- lapply(x, function(xi) {
fitted <- xi$fitted.values[!empty_subsets]
nonzero <- nonzero_fit(fitted)
ifelse(is.na(nonzero), FALSE, nonzero)
})
nonzero <- apply(do.call(rbind, res), 2, any)
} else {
empty_sets <- is.na(x$ellipses[, 1L])
empty_subsets <- rowSums(id[, empty_sets, drop = FALSE]) > 0
fitted <- x$fitted.values[!empty_subsets]
nonzero <- nonzero_fit(fitted)
nonzero <- ifelse(is.na(nonzero), FALSE, nonzero)
}
merged_sets <- rep(FALSE, length(setnames))
if (!do_groups && any(nonzero)) {
n_overlaps <- integer(n_id)
single_mass <- logical(n_e)
for (i in seq_len(n_e)) {
nz <- nonzero_fit(x$fitted.values)
nzi <- nz & id[, i]
if (sum(nzi) == 1) {
n_overlaps[which(nzi)] <- n_overlaps[which(nzi)] + 1
}
single_mass[i] <- sum(nzi) == 1
}
complete_overlaps <- n_overlaps > 1
merge_sets <- id[complete_overlaps, ] & single_mass
if (any(merge_sets)) {
setnames[merge_sets] <- paste(setnames[merge_sets],
collapse = ",")
merged_sets[which(merge_sets)[length(which(merge_sets))]] <- TRUE
}
}
stopifnot(n > 0, is.numeric(n) && length(n) == 1)
# setup fills
if (do_fills) {
fills_out <- replace_list(
list(fill = opar$fills$fill,
alpha = opar$fills$alpha),
if (is.list(fills))
fills
else if (isTRUE(fills))
list()
else
list(fill = fills)
)
fills_out <- replace_list(fills_out, dots)
fills_out$col <- "transparent"
if (is.function(fills_out$fill))
fills_out$fill <- fills_out$fill(n_e)
n_fills <- length(fills_out$fill)
if (n_fills < n_id) {
for (i in (n_fills + 1L):n_id) {
fills_out$fill[i] <- mix_colors(fills_out$fill[which(id[i, ])])
}
}
fills <- list()
fills$gp <- setup_gpar(fills_out, list(), n_id)
} else {
fills <- NULL
}
# setup edges
if (do_edges) {
if (isTRUE(edges))
edges_out <- list()
else if (!is.list(edges))
edges_out <- list(col = edges)
else
edges_out <- edges
edges <- list()
edges$gp <- setup_gpar(list(col = opar$edges$col,
alpha = opar$edges$alpha,
lex = opar$edges$lex,
lwd = opar$edges$lwd,
lty = opar$edges$lty),
update_list(edges_out, dots),
n_e)
} else {
edges <- NULL
}
# setup strips
if (do_groups) {
group_names <- lapply(groups, levels)
n_levels <- sum(lengths(group_names))
}
if (do_strips) {
strips <- list(gp = setup_gpar(opar$strips, strips, n_levels),
groups = groups)
} else {
strips <- NULL
}
# setup labels
if (do_labels) {
if (is.list(labels)) {
labels <- update_list(list(labels = setnames,
rot = opar$labels$rot),
labels)
} else if (isTRUE(labels)) {
labels <- list(labels = setnames,
rot = opar$labels$rot)
} else {
labels <- list(labels = labels,
rot = opar$labels$rot)
}
labels$rot <- rep_len(labels$rot, n_e)
labels$gp <- setup_gpar(list(col = opar$labels$col,
alpha = opar$labels$alpha,
fontsize = opar$labels$fontsize,
cex = opar$labels$cex,
fontfamily = opar$labels$fontfamily,
lineheight = opar$labels$lineheight,
font = opar$labels$font),
labels,
n_e)
} else {
labels <- NULL
}
# setup quantities
if (do_quantities) {
if (is.list(quantities)) {
if (!is.null(quantities$type)) {
if (!all(quantities$type %in% c("counts", "percent")))
stop("'type' must be one or both of 'counts' and 'percent")
quantities_type <- match.arg(quantities$type,
c("counts", "percent"),
several.ok = TRUE)
} else {
quantities_type <- opar$quantities$type
}
quantities <- update_list(list(labels = NULL,
type = quantities_type,
rot = opar$quantities$rot),
quantities)
} else if (isTRUE(quantities)) {
quantities <- list(labels = NULL, rot = opar$quantities$rot)
} else {
quantities <- list(labels = quantities, rot = opar$quantities$rot)
}
quantities$rot <- rep_len(quantities$rot, n_id)
quantities$gp <- setup_gpar(list(col = opar$quantities$col,
alpha = opar$quantities$alpha,
fontsize = opar$quantities$fontsize,
cex = opar$quantities$cex,
fontfamily = opar$quantities$fontfamily,
lineheight = opar$quantities$lineheight,
font = opar$quantities$font),
quantities,
n_id)
} else {
quantities <- NULL
}
# setup legend
if (do_custom_legend) {
legend <- legend
} else if (do_legend) {
# TODO: create a better, custom legend
legend <- update_list(
list(labels = setnames[!empty_sets & !merged_sets],
side = opar$legend$side,
nrow = sum(!empty_sets),
ncol = 1L,
byrow = opar$legend$byrow,
do.lines = opar$legend$do.lines,
lines.first = opar$legend$lines.first,
hgap = opar$legend$hgap,
vgap = opar$legend$vgap,
default.units = opar$legend$default.units,
pch = opar$legend$pch),
legend
)
legend$gp <- setup_gpar(
list(
fill = if (do_fills) fills$gp$fill[!empty_sets & !merged_sets] else "transparent",
alpha = if (do_fills)
fills$gp$alpha[!empty_sets & !merged_sets]
else if (do_edges)
edges$gp$alpha[!empty_sets & !merged_sets]
else
0,
cex = opar$legend$cex,
fontsize =
opar$legend$fontsize/opar$legend$cex,
font = opar$legend$font,
fontfamily = opar$legend$fontfamily,
lwd = if (do_edges) edges$gp$lwd[!empty_sets & !merged_sets] else 0,
lex = if (do_edges) edges$gp$lex[!empty_sets & !merged_sets] else 0,
col = if (do_edges)
edges$gp$col[!empty_sets & !merged_sets]
else "transparent"),
legend,
sum(!empty_sets)
)
} else {
legend <- NULL
}
if (do_main) {
if (is.list(main)) {
if (length(main) == 1 && is.null(names(main)))
label <- main[[1]]
else
label <- main$label
if (is.null(label))
stop("you need to provide a 'label' item if 'main' is a list.")
} else {
label <- main
}
main <- update_list(
list(label = label,
x = opar$main$x,
y = opar$main$y,
just = opar$main$just,
hjust = opar$main$hjust,
vjust = opar$main$vjust,
rot = opar$main$rot,
check.overlap = opar$main$check.overlap,
default.units = opar$main$default.units),
main
)
main$gp <- setup_gpar(
list(
cex = opar$main$cex,
fontsize = opar$main$fontsize,
font = opar$main$font,
fontfamily = opar$main$fontfamily,
col = opar$main$col,
lineheight = opar$main$lineheight,
alpha = opar$main$alpha
),
main,
1
)
} else {
main <- NULL
}
# set up geometry for diagrams
if (do_groups) {
data <- lapply(x,
setup_geometry,
fills = fills,
edges = edges,
labels = labels,
quantities = quantities,
n = n,
id = id,
merged_sets = merged_sets)
} else {
data <- setup_geometry(x,
fills = fills,
edges = edges,
labels = labels,
quantities = quantities,
n = n,
id = id,
merged_sets = merged_sets)
}
# start setting up grobs
if (do_groups) {
n_groups <- length(data)
euler_grob_children <- grid::gList()
for (i in seq_len(n_groups)) {
euler_grob_children[[i]] <- setup_grobs(data[[i]],
fills = fills,
edges = edges,
labels = labels,
quantities = quantities,
number = i,
merged_sets = merged_sets)
}
euler_grob <- grid::gTree(grid::nullGrob(),
name = "canvas.grob",
children = euler_grob_children)
pos <- vapply(groups, as.numeric, numeric(NROW(groups)), USE.NAMES = FALSE)
layout <- lengths(lapply(groups, unique))
if (length(layout) == 1L)
layout <- c(1L, layout)
xlim <- range(unlist(lapply(data, "[[", "xlim")))
ylim <- range(unlist(lapply(data, "[[", "ylim")))
} else {
euler_grob <- setup_grobs(data,
fills = fills,
edges = edges,
labels = labels,
quantities = quantities,
number = 1,
merged_sets = merged_sets)
euler_grob <- grid::grobTree(euler_grob,
name = "canvas.grob")
xlim <- data$xlim
ylim <- data$ylim
pos <- c(1L, 1L)
layout <- c(1L, 1L)
}
xlim <- grDevices::extendrange(xlim, f = 0.01)
ylim <- grDevices::extendrange(ylim, f = 0.01)
xrng <- abs(xlim[1L] - xlim[2L])
yrng <- abs(ylim[1L] - ylim[2L])
if (xrng == 0 || yrng == 0) {
xrng <- yrng <- 1
ylim <- xlim <- c(0, 1)
}
ar <- xrng/yrng
# adjust <- layout[1L]/layout[2]
do_strip_left <- layout[1L] > 1L && do_strips
do_strip_top <- layout[2L] > 1L && do_strips
strip_top_row <- strip_top_col <- strip_left_row <- strip_left_col <- 1
nrow <- ncol <- 1
heights <- grid::unit(1, "null")
widths <- grid::unit(1*ar*layout[2]/layout[1], "null")
diagram_col <- 1
diagram_row <- 1
if (do_main) {
diagram_row <- diagram_row + 2
nrow <- nrow + 2
strip_left_row <- strip_left_row + 2
strip_top_row <- strip_top_row + 2
}
if (do_strip_left) {
diagram_col <- diagram_col + 1
ncol <- ncol + 1
}
if (do_strip_top) {
diagram_row <- diagram_row + 1
nrow <- nrow + 1
}
if (do_strip_left && do_strip_top) {
strip_top_col <- strip_top_col + 1
strip_left_row <- strip_left_row + 1
}
# draw strips
if (do_strip_top) {
strip_top_vp <-
grid::viewport(layout.pos.row = strip_top_row,
layout.pos.col = strip_top_col,
name = "strip.top.vp",
layout = grid::grid.layout(nrow = 1, ncol = layout[2]))
lvls <- levels(strips$groups[[ names(layout)[[2]] ]])
n_lvls <- length(lvls)
step <- 1/n_lvls
strip_top_grob <- grid::textGrob(lvls,
x = step/2 + (seq(0, n_lvls - 1)*step),
name = "strip.top.grob",
gp = do.call(grid::gpar, strips$gp),
vp = strip_top_vp)
heights <- grid::unit.c(grid::unit(2, "grobheight", list(strip_top_grob)),
heights)
}
if (do_strip_left) {
strip_left_vp <-
grid::viewport(layout.pos.row = strip_left_row,
layout.pos.col = strip_left_col,
name = "strip.left.vp",
layout = grid::grid.layout(nrow = layout[1], ncol = 1))
lvls <- rev(levels(strips$groups[[ names(layout)[[1]] ]]))
n_lvls <- length(lvls)
step <- 1/n_lvls
strip_left_grob <- grid::textGrob(lvls,
y = step/2 + (seq(0, n_lvls - 1)*step),
name = "strip.left.grob",
rot = 90,
gp = do.call(grid::gpar, strips$gp),
vp = strip_left_vp)
widths <- grid::unit.c(grid::unit(2, "grobwidth", list(strip_left_grob)),
widths)
}
if (do_legend) {
if (do_custom_legend) {
legend_grob <- legend
legend <- list(side = "right")
} else {
legend_grob <- grid::legendGrob(
labels = legend$labels,
do.lines = legend$do.lines,
ncol = legend$ncol,
nrow = legend$nrow,
hgap = legend$hgap,
vgap = legend$vgap,
default.units = legend$default.units,
pch = legend$pch,
gp = legend$gp
)
}
legend_grob$name <- "legend.grob"
if (do_strip_top)
legend_row <- 2 + 2*do_main
if (legend$side == "right") {
# legend on right (default)
ncol <- ncol + 2L
legend_row <- nrow
legend_col <- ncol
widths <- grid::unit.c(widths, grid::unit(c(1, 1),
c("lines", "grobwidth"),
list(NULL, legend_grob)))
} else if (legend$side == "left") {
# legend on left
ncol <- ncol + 2L
legend_row <- if (do_strip_top) 2L + 2*do_main else 1L + 2*do_main
legend_col <- 1
diagram_col <- diagram_col + 2L
if (do_strip_left)
strip_left_col <- strip_left_col + 2L
if (do_strip_top)
strip_top_col <- strip_top_col + 2L
widths <- grid::unit.c(grid::unit(c(1, 1),
c("grobwidth", "lines"),
list(legend_grob, NULL)), widths)
} else if (legend$side == "top") {
# legend on top
nrow <- nrow + 2L
legend_row <- 1L + do_main*2
legend_col <- if (do_strip_left) 2L else 1L
diagram_row <- diagram_row + 2L
if (do_strip_top)
strip_top_row <- strip_top_row + 2L
if (do_strip_left)
strip_left_row <- strip_left_row + 2L
heights <- grid::unit.c(grid::unit(c(1, 1),
c("grobheight", "lines"),
list(legend_grob, NULL)),
heights)
} else {
# legend on bottom
nrow <- nrow + 2L
legend_row <- nrow
legend_col <- if (do_strip_left) 2L else 1L
heights <- grid::unit.c(heights,
grid::unit(c(1, 1),
c("lines", "grobheight"),
list(NULL, legend_grob)))
}
legend_grob$vp <- grid::viewport(layout.pos.row = legend_row,
layout.pos.col = legend_col,
name = "legend.vp")
}
if (do_main) {
main_grob <- grid::textGrob(label = main$label,
x = main$x,
y = main$y,
just = main$just,
hjust = main$hjust,
vjust = main$vjust,
rot = main$rot,
check.overlap = FALSE,
default.units = main$default.units,
gp = main$gp,
name = "main.grob")
heights <- grid::unit.c(grid::unit(c(1, 1),
c("lines", "grobheight"),
list(NULL, main_grob)),
heights)
main_grob$vp <- grid::viewport(layout.pos.row = 1,
layout.pos.col = diagram_col,
name = "main.vp")
}
canvas_vp <- grid::viewport(
layout.pos.row = diagram_row,
layout.pos.col = diagram_col,
name = "canvas.vp",
layout = grid::grid.layout(nrow = layout[1L],
ncol = layout[2L],
widths = rep(1/ar, layout[1L]),
heights = rep(1, layout[2L]))
)
for (i in seq_along(euler_grob$children)) {
if (NCOL(pos) == 2L) {
j <- pos[i, 1L]
k <- pos[i, 2L]
} else {
j <- 1L
k <- pos[i]
}
euler_grob$children[[i]]$vp <- grid::viewport(
layout.pos.row = j,
layout.pos.col = k,
xscale = if (xlim[1] == -Inf) c(-1, 1) else xlim,
yscale = if (ylim[1] == -Inf) c(-1, 1) else ylim,
name = paste0("panel.vp.", j, ".", k)
)
}
euler_grob$vp <- canvas_vp
# return a gTree object
children <- gList(
if (do_main) main_grob = main_grob,
if (do_strip_top) strip_top_grob = strip_top_grob,
if (do_strip_left) strip_left_grob = strip_left_grob,
if (do_legend) legend_grob = legend_grob,
euler_grob = euler_grob
)
grid::gTree(
data = data,
children = children,
vp = grid::viewport(layout = grid::grid.layout(nrow = nrow,
ncol = ncol,
widths = widths,
heights = heights,
respect = TRUE),
name = "euler.vp"),
cl = "eulergram",
name = "euler.diagram"
)
}
#' Test if two polygons are intersecting or not
#'
#' @param a first polygon
#' @param b second polygon
#'
#' @return `TRUE` if polygon `a` and `b` are intersecting, `FALSE` otherwise.
#' @keywords internal
#' @noRd
test_intersection <- function(a, b) {
length(poly_clip(a, b, "intersection")) > 0
}
locate_centers <- function(p, precision = 1) {
n_p <- length(p)
if (n_p == 1) {
polylabelr::poi(p[[1]]$x, p[[1]]$y, precision = precision)
} else if (n_p > 1) {
intersects <- matrix(TRUE, ncol = n_p, nrow = n_p)
for (i in 1:(n_p - 1)) {
for (j in (i + 1):n_p) {
intersects[i, j] <- test_intersection(p[[i]], p[[j]])
}
}
intersects[lower.tri(intersects)] <- intersects[upper.tri(intersects)]
clusters <- unique(lapply(split(intersects, row(intersects)), which))
res <- lapply(clusters, function(cluster) {
n_c <- length(cluster)
x <- y <- double(0)
for (i in seq_len(n_c)) {
x <- c(x, p[[cluster[i]]]$x)
y <- c(y, p[[cluster[i]]]$y)
if (i < n_c) {
x <- c(x, NA)
y <- c(y, NA)
}
}
polylabelr::poi(x, y, precision = precision)
})
res[[which.max(unlist(lapply(res, "[[", "dist")))]]
} else {
grDevices::xy.coords(NA, NA)
}
}
#' @rdname plot.euler
#' @export
plot.venn <- function(x,
fills = TRUE,
edges = TRUE,
legend = FALSE,
labels = identical(legend, FALSE),
quantities = TRUE,
strips = NULL,
main = NULL,
n = 200L,
adjust_labels = TRUE,
...)
{
if (!missing(adjust_labels)) {
warning("`adjust_labels` is deprecated and no longer has any effect.")
}
NextMethod("plot", ..., quantities = quantities)
}
#' Print (plot) Euler diagram
#'
#' This function is responsible for the actual drawing of
#' `'eulergram'` objects created through [plot.euler()]. [print.eulergram()]
#' is an alias for [plot.eulergram()], which has been provided so that
#' [plot.euler()] gets called automatically.
#'
#' @param x an object of class `'eulergram'`, usually the output of
#' [plot.euler()]
#' @param newpage if `TRUE`, opens a new page via [grid.newpage()] to draw on
#' @param ... ignored
#' @return A plot is drawn on the current device using [grid::Grid()] graphics.
#' @export
plot.eulergram <- function(x, newpage = TRUE, ...) {
if (isTRUE(newpage))
grid::grid.newpage()
grid::grid.draw(x)
}
#' @rdname plot.eulergram
#' @export
print.eulergram <- function(x, ...) {
graphics::plot(x, ...)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.