#' Create an igraph tree from a sentence
#'
#' @description
#' Create an igraph tree from a token_index (\link{as_tokenindex}) or a data.frame that can be coerced to a tokenindex.
#'
#' By default, all columns in the data are included as labels. This can be changes by using the ... argument.
#'
#' @param tokens A tokenIndex data.table, or any data.frame coercible with \link{as_tokenindex}. Can also be a corpustools tCorpus.
#' @param ... Optionally, select which columns to include as labels and how to present them. Can be quoted or unquoted names and expressions, using columns in the tokenIndex. For example, plot_tree(tokens, token, pos) will use the $token and $pos columns in tokens. You can also use expressions for easy controll of visulizations. For example: plot_tree(tokens, tolower(token), abbreviate(pos,1)). (note that abbreviate() is really usefull here)
#' @param sentence_i By default, plot_tree uses the first sentence (sentence_i = 1) in the data. sentence_i can be changed to select other sentences by position (the i-th unique sentence in the data). Note that sentence_i does not refer to the values in the sentence column (for this use the sentence argument together with doc_id)
#' @param doc_id Optionally, the document id can be specified. If so, sentence_i refers to the i-th sentence within the given document.
#' @param sentence Optionally, the sentence id can be specified (note that sentence_i refers to the position). If sentence is given, doc_id has to be given as well.
#' @param annotation Optionally, a column with an rsyntax annotation, to add boxes around the annotated nodes.
#' @param only_annotation If annotation is given, only_annotation = TRUE will print only the nodes with annotations.
#' @param pdf_file Directly save the plot as a pdf file
#' @param allign_text If TRUE (default) allign text (the columns specified in ...) in a single horizontal line at the bottom, instead of following the different levels in the tree
#' @param ignore_rel Optionally, a character vector with relation names that will not be shown in the tree
#' @param all_lower If TRUE, make all text lowercase
#' @param all_abbrev If an integer, abbreviate all text, with the number being the target number of characters.
#' @param textsize A number to manually change the textsize. The function tries to set a suitable textsize for the plotting device, but if this goes wrong and now everything is broken and sad, you can multiply the textsize with the given number.
#' @param spacing A number for scaling the distance between words (between 0 and infinity)
#' @param use_color If true, use colors
#' @param max_curve A number for controlling the allowed amount of curve in the edges.
#' @param palette A function for creating a vector of n contiguous colors. See ?terrain.colors for standard functions and documentation
#' @param rel_on_edge If TRUE, print relation label on edge instead of above the node
#' @param pdf_viewer If TRUE, view the plot as a pdf. If no pdf_file is specified, the pdf will be saved to the temp folder
#' @param viewer_mode By default, the plot is saved as a PNG embedded in a HTML and opened in the viewer. This hack makes it independent of the
#' size of the plotting device and enables scrolling. By setting viewer_mode to False, the current plotting device is used.
#' @param viewer_size A vector of length 2, that multiplies the width (first value) and height (second value) of the viewer_mode PNG
#'
#' @return plots a dependency tree.
#' @export
#' @examples
#' tokens = tokens_spacy[tokens_spacy$doc_id == 'text3',]
#'
#' \donttest{
#' if (interactive()) plot_tree(tokens, token, pos)
#'
#' ## plot with annotations
#' direct = tquery(label = 'verb', pos = 'VERB', fill=FALSE,
#' children(label = 'subject', relation = 'nsubj'),
#' children(label = 'object', relation = 'dobj'))
#' passive = tquery(label = 'verb', pos = 'VERB', fill=FALSE,
#' children(label = 'subject', relation = 'agent'),
#' children(label = 'object', relation = 'nsubjpass'))
#'
#' if (interactive()) {
#' tokens %>%
#' annotate_tqueries('clause', pas=passive, dir=direct) %>%
#' plot_tree(token, pos, annotation='clause')
#' }
#' }
plot_tree <-function(tokens, ..., sentence_i=1, doc_id=NULL, sentence=NULL, annotation=NULL, only_annotation=FALSE, pdf_file=NULL, allign_text=TRUE, ignore_rel=NULL, all_lower=FALSE, all_abbrev=NULL, textsize=1, spacing=1, use_color=TRUE, max_curve=0.3, palette=grDevices::terrain.colors, rel_on_edge=F, pdf_viewer=FALSE, viewer_mode=TRUE, viewer_size=c(100,100)) {
if (methods::is(tokens, 'tCorpus')) tokens = tokens$tokens
if (pdf_viewer && is.null(pdf_file)) pdf_file = tempfile('plot_tree', fileext = '.pdf')
if (!is.null(pdf_file)) if (!grepl('\\.pdf$', pdf_file)) stop('pdf_file needs to have extension ".pdf"')
if (!is.null(pdf_file)) viewer_mode = FALSE
plots_window = is.null(pdf_file) && !viewer_mode ## will the regular plotting device be used?
if (!is.null(pdf_file) || !viewer_mode) {
graphics::plot.new()
} else {
if (require_plot_new()) graphics::plot.new()
}
tokens = as_tokenindex(tokens)
if (!is.null(annotation) && only_annotation) {
tokens = tokens[!is.na(tokens[[annotation]]),]
}
nodes = get_sentence(tokens, doc_id, sentence, sentence_i)
nodes$rel_label = if (!is.null(all_abbrev)) abbreviate(nodes[['relation']], all_abbrev) else nodes[['relation']]
nodes$label = nodes$token_id
nodes = split_adjacent(nodes)
sentmes = sprintf('Document: %s\nSentence: %s', unique(nodes$doc_id), unique(nodes$sentence))
annotations = gsub('\\_.*', '', grep('\\_fill', colnames(nodes), value=TRUE))
text_cols = get_text_cols(tokens, nodes, tidyselect::quos(...), annotations)
edges = nodes[!is.na(nodes[['parent']]), c('parent', 'token_id', 'relation'), with=FALSE]
edges = edges[edges$parent %in% nodes$token_id,]
text = NULL
for (tc in text_cols) {
textval = if (!is.null(all_abbrev)) abbreviate(tc, minlength = all_abbrev) else tc
textval = ifelse(is.na(textval), '', gsub('\n|\t', '', as.character(textval)))
text = if (is.null(text)) textval else paste(text, textval, sep='\n')
}
if (!is.null(ignore_rel)) nodes$label[nodes$label %in% ignore_rel] = ''
if (all_lower) {
text = tolower(text)
nodes$label = tolower(nodes$label)
}
g = igraph::graph.data.frame(edges, vertices=nodes, directed = TRUE)
igraph::V(g)$id = as.numeric(igraph::V(g)$name)
if (all_lower) igraph::E(g)$relation = tolower(igraph::E(g)$relation)
if (!is.null(all_abbrev)) igraph::E(g)$relation = abbreviate(igraph::E(g)$relation, all_abbrev)
## order nodes, split by roots
comps = igraph::decompose(g)
if (length(comps) > 1) {
reorder_list = sapply(comps, function(x) sort(igraph::V(x)$id), simplify = FALSE)
reorder = unlist(reorder_list)
g = igraph::permute(g, match(as.numeric(igraph::V(g)$id), as.numeric(reorder)))
reorder_i = match(as.numeric(reorder), as.numeric(nodes$token_id))
text = text[reorder_i]
nodes = nodes[reorder_i,]
tree_boundaries = sapply(reorder_list, length)
} else tree_boundaries = NULL
root = find_roots(g)
g$layout = igraph::layout_as_tree(g, root = root)
if (!is.null(ignore_rel)) g = igraph::delete.edges(g, which(igraph::get.edge.attribute(g, 'relation') %in% ignore_rel))
co = g$layout
e = igraph::get.edges(g, igraph::E(g))
co[,1] = arrange_horizontal(g, text, tree_boundaries)
g = format_edges(g, max_curve, e, rel_on_edge)
nlevels = max(co[,2]) - min(co[,2]) ## remember for png mode
co[,2] = arrange_vertical(co, text_cols)
## make empty plot to get positions in current plot device
if (!is.null(pdf_file)) {
height = 7
width = height * (grDevices::dev.size()[1] / grDevices::dev.size()[2])
grDevices::pdf(pdf_file, height = height, width=width)
}
if (viewer_mode) {
png_file = tempfile(fileext = '.png')
height = max(c(400, (nlevels/2) * viewer_size[1]))
width = max(400,sum(graphics::strwidth(text, units='inches')*1.25) * viewer_size[2])
grDevices::png(png_file, height = height, width=width)
}
oldpar = graphics::par(no.readonly = TRUE)
on.exit(graphics::par(oldpar))
graphics::par(mar=c(0,0,0,0))
suppressWarnings(par(new=TRUE))
ylim = c(min(co[,2])-0.2, max(co[,2]) + 0.2)
if (!plots_window) ylim = grDevices::extendrange(c(-1, 1)) ## in this case it will crop whitespace anyway
graphics::plot(0, type="n", ann=FALSE, axes=FALSE, xlim=grDevices::extendrange(co[,1]), ylim=ylim)
text = stringi::stri_trans_general(text,"any-latin")
text = stringi::stri_trans_general(text,"latin-ascii")
cex = calc_cex(g, co, text, tree_boundaries, spacing, textsize)
g = set_graph_attr(g, e, cex, ignore_rel, palette, use_color)
graphics::plot(g, layout=co, rescale=FALSE, add=TRUE)
if (!rel_on_edge) graphics::text(co[,1], co[,2]+(0.02*cex), labels=igraph::V(g)$rel_label,
col = 'black', cex=cex*0.9, pos=3, font = 3)
## add text and lines
## non-integers are added. highlight these in red for clarity
added = as.numeric(igraph::V(g)$name)
added = (round(added) - added) != 0
if (any(added)) {
col = ifelse(added, ifelse(use_color, 'red', 'darkgrey'),'black')
} else col = 'black'
if (allign_text) {
texty = min(co[,2])
} else {
texty = co[,2]
}
graphics::text(co[,1], texty-graphics::strheight('string')*1.5, labels=text, col = col, cex=cex, adj=c(0.5,1))
add_annotation(co, annotation, nodes, cex, plots_window)
message(sentmes)
drop = if (is.null(ignore_rel)) rep(FALSE, igraph::vcount(g)) else igraph::V(g)$relation %in% ignore_rel
if (allign_text && length(text_cols) > 0) graphics::segments(co[,1], min(co[,2]), co[,1], co[,2]-0.05, lwd = ifelse(drop, NA, 0.5), lty=2, col='grey')
if (!plots_window) grDevices::dev.off()
if (pdf_viewer) {
viewer = getOption('viewer')
if (!is.null(viewer))
viewer(pdf_file)
else
utils::browseURL(pdf_file)
}
if (viewer_mode) {
png_in_viewer(png_file)
}
invisible(tokens)
}
get_text_cols <- function(tokens, nodes, l, annotations) {
text_cols = list()
if (length(l) > 0) {
for (i in seq_along(l)) {
e = rlang::quo_get_expr(l[[i]])
if (is.character(i)) i = parse(text=i)
text_cols[[names(l)[[i]]]] = eval(e, nodes)
}
} else {
cols = setdiff(colnames(tokens), c('doc_id','sentence','token_id','parent','relation'))
ann_cols = unlist(sapply(annotations, paste0, c('','_id','_fill'), simplify=FALSE))
cols = setdiff(cols, ann_cols)
for (col in cols) {
text_cols[[col]] = nodes[[col]]
}
}
text_cols
}
get_sentence <- function(tokens, .DOC_ID=NULL, .SENTENCE=NULL, sentence_i=1) {
if (!length(sentence_i) == 1) stop('Can only select one sentence_i')
if (!is.null(.DOC_ID)) {
if (!length(.DOC_ID) == 1) stop('Can only select one doc_id')
sent = tokens[list(.DOC_ID), on='doc_id', nomatch=0]
if (nrow(sent) == 0) return(sent)
if (is.null(.SENTENCE)) {
sentences = unique(sent[['sentence']])
if (length(sentences) < sentence_i) stop(sprintf('Cannot select sentence_i = %s, only %s sentences available', sentence_i, length(sentences)))
.SENTENCE = sentences[sentence_i]
}
if (!length(.SENTENCE) == 1) stop('Can only select one sentence')
sent = sent[list(.SENTENCE), on='sentence', nomatch=0]
} else {
if (!is.null(.SENTENCE)) stop('Cannot specificy "sentence" without specifying "doc_id"')
.DOC_SENT = unique(subset(tokens, select = c('doc_id','sentence')))
if (nrow(.DOC_SENT) < sentence_i) stop(sprintf('Cannot select sentence_i = %s, only %s sentences available', sentence_i, nrow(.DOC_SENT)))
.DOC_SENT = .DOC_SENT[sentence_i,]
sent = tokens[.DOC_SENT, on=c('doc_id','sentence'), nomatch=0]
}
data.table::setcolorder(sent, union('token_id', colnames(sent))) ## set token_id first for matching with edges
sent
}
width_boundaries <- function(width, tree_boundaries) {
if (!is.null(tree_boundaries)) {
## add space between isolated trees
tree_boundaries = tree_boundaries[-length(tree_boundaries)] ## don't add space after last tree
tree_boundaries = cumsum(tree_boundaries)
width[tree_boundaries] = width[tree_boundaries] * 1.5
}
width
}
centered_width <- function(width) (width / 2) + data.table::shift(width / 2, type = 'lead', fill=0)
format_edges <- function(g, max_curve, e, label) {
## format edges
vdist = (e[,2] - e[,1])
maxcurve = 1 / (1 + exp(-max(abs(vdist))*0.05))
maxcurve = min(maxcurve, max_curve) # max_curve, with underscore, is a parameter
curve = rescale_var(abs(vdist)^2, 0, maxcurve) * sign(vdist)
#curve = maxcurve * sign(vdist)
igraph::E(g)$curved = curve
igraph::E(g)$width = 2
igraph::E(g)$color = 'darkgrey'
if (label) {
igraph::E(g)$label = igraph::E(g)$relation
igraph::E(g)$label.dist = 0
igraph::E(g)$label.degree = 3*pi
igraph::E(g)$label.color = 'black'
igraph::E(g)$label.font = 3
}
g
}
calc_cex <- function(g, co, text, tree_boundaries, spacing, textsize) {
width_label = graphics::strwidth(igraph::V(g)$label, units='inches')
width_label = centered_width(width_label)
width_label2 = graphics::strwidth(igraph::V(g)$rel_label, units='inches')
width_label2 = centered_width(width_label2)
width_label = ifelse(width_label > width_label2, width_label, width_label2)
width_text = graphics::strwidth(text, units='inches')
need_width = ifelse(width_label > width_text, width_label, width_text)
need_width = width_boundaries(need_width, tree_boundaries)
need_width = sum(need_width)
need_width = need_width + (graphics::strwidth(' ', units='inches') * (spacing+0.1) * igraph::vcount(g))
max_width = grDevices::dev.size(units = 'in')[1]
max_width = max_width * (1 - min(co[,1])) / 2
cex = if (max_width < need_width) max_width / need_width else 1
textsize * cex
}
set_graph_attr <- function(g, e, cex, ignore_rel, palette, use_color) {
width = (graphics::strwidth(igraph::V(g)$label, cex=cex) + graphics::strwidth(' ', cex=cex*0.5)) * 100
width2 = (graphics::strwidth(igraph::V(g)$rel_label, cex=cex) + graphics::strwidth(' ', cex=cex*0.5)) * 100
width = ifelse(width > width2, width, width2)
height = (max(graphics::strheight(igraph::V(g)$label, cex=cex), graphics::strheight('I', cex=cex)) + graphics::strheight('I',cex=cex)*0.25) * 100
igraph::V(g)$label.cex = cex
igraph::V(g)$label.color = 'black'
igraph::V(g)$shape = 'rectangle'
igraph::V(g)$size = width
igraph::V(g)$size2 = height
igraph::V(g)$color = 'white'
igraph::V(g)$border.color = 'white'
igraph::V(g)$frame.color = 'white'
igraph::V(g)$label.font=2
drop = if (is.null(ignore_rel)) rep(FALSE, igraph::vcount(g)) else igraph::V(g)$relation %in% ignore_rel
igraph::V(g)$size[drop] = 0
igraph::V(g)$size2[drop] = 0
igraph::V(g)$label[drop] = ''
if ('.REL_LEVEL' %in% igraph::vertex_attr_names(g)) {
hl = !is.na(igraph::V(g)$.REL_LEVEL)
} else hl = rep(FALSE, igraph::vcount(g))
if ('.IS_SPLIT' %in% igraph::vertex_attr_names(g)) {
is_split = igraph::V(g)$.IS_SPLIT
} else is_split = rep(FALSE, igraph::vcount(g))
if (use_color) {
igraph::V(g)$color = festival(igraph::V(g)$label, palette)
igraph::E(g)$color = igraph::V(g)$color[e[,2]]
igraph::E(g)$color[is_split[e[,2]]] = 'red'
igraph::V(g)$frame.color[hl] = 'red'
igraph::E(g)$lty = ifelse(hl[e[,2]] | is_split[e[,2]], 2, 1)
} else {
igraph::V(g)$color = 'lightgrey'
igraph::V(g)$frame.color = 'darkgrey'
igraph::V(g)$frame.color[hl] = 'black'
igraph::E(g)$lty = ifelse(hl[e[,2]] | is_split[e[,2]], 2, 1)
}
igraph::E(g)$arrow.mode=2
igraph::E(g)$arrow.size=0.4
g
}
festival <- function(labels, palette=palette){
pal = palette(4097) #(16^3 + 1 for indexing)
color = NA
for (label in labels) {
if (is.na(label)) next
if (label == '') next
hash = digest::digest(label, 'xxhash32')
hash = digest::digest(hash, 'xxhash32') ## somehow first hash doesn't seem random enough (I know)
labelint = strtoi(substr(hash, 2,4), 16) + 1
color[labels == label] = pal[labelint]
}
color
}
find_roots <- function(g) {
comps = igraph::decompose(g)
roots = c()
for (i in 1:length(comps)) {
comp = comps[[i]]
root = names(which.min(igraph::degree(comp, mode = 'in')))
if (length(root) > 1) {
out = igraph::degree(comp, mode='out')
out = out[match(root, names(out))]
root = names(out)[which.max(out)]
}
if (length(root) > 1) {
root = root[1]
}
roots = union(roots, root)
}
roots
}
split_adjacent <- function(nodes) {
nodes$.IS_SPLIT = FALSE
is_dup = duplicated(data.table(token_id=round(nodes$token_id), parent=nodes$parent))
is_dup = is_dup &! is.na(nodes$parent)
if (any(is_dup)) {
tolast_ids = nodes$token_id[which(is_dup)]
for (tolast_id in rev(tolast_ids)) {
tolast_i = which(nodes$token_id == tolast_id)
nodes$.IS_SPLIT[tolast_i] = TRUE
tolast_i = get_children_i(nodes, tolast_i)
tolast_i = sort(tolast_i)
nodes = rbind(nodes[-tolast_i,], nodes[tolast_i,])
}
}
nodes
}
arrange_horizontal <- function(g, text, tree_boundaries) {
width = get_width(g, text, tree_boundaries)
right_allign = cumsum(width)
left_allign = c(0,right_allign[-length(right_allign)])
rescale_var(left_allign, new_min = -1, new_max = 1, x_min = 0, x_max=max(right_allign))
}
arrange_vertical <- function(co, text_cols) {
levels = max(co[,2]) - min(co[,2])
bottom_offset = length(text_cols)
if (bottom_offset < 5) bottom_offset = 5
if (bottom_offset > 10) bottom_offset = 10
bottom_offset = -(1 - bottom_offset / 10)
maxheight = if (levels > 10) 1 else bottom_offset + levels*0.15
rescale_var(co[,2], new_min = bottom_offset, new_max = maxheight)
}
require_plot_new <- function() {
## this is a ridiculous function to trigger plot.new if necessary
trigger = tryCatch(graphics::strwidth('banana'), error=function(e) 0)
trigger == 0
}
get_width <- function(g, text, tree_boundaries){
textwidth = graphics::strwidth(text)
textwidth = centered_width(textwidth)
relwidth = graphics::strwidth(igraph::V(g)$label)
relwidth2 = graphics::strwidth(igraph::V(g)$rel_label)
relwidth = ifelse(relwidth > relwidth2, relwidth, relwidth2)
relwidth = centered_width(relwidth) ## relwidth is annoying, because nodes are centered. Therefore, use halved length of current node and next
width = ifelse(textwidth > relwidth, textwidth, relwidth)
width_boundaries(width, tree_boundaries)
}
rescale_var <- function(x, new_min=0, new_max=1, x_min=min(x), x_max=max(x)){
if (x_min == x_max) return(x)
x = (x - x_min) / (x_max - x_min) # normalize
x = x * (new_max-new_min)
return(x + new_min)
}
add_annotation <- function(co, annotation, nodes, cex, plots_window) {
## draw boxes for the annotations
draw_box_f = if (plots_window) draw_box_alternative else draw_box
if (!is.null(annotation)) {
vdist = co[,2]
vdist = max(vdist) - max(vdist[vdist < max(vdist)])
id_start = 1
role_start = 1
ann_id = paste0(annotation, '_id')
for (i in 1:nrow(nodes)) {
role_done = !nodes[[annotation]][role_start] == nodes[[annotation]][i]
id_done = !nodes[[ann_id]][id_start] == nodes[[ann_id]][i]
if (is.na(role_done)) {
if (role_start == i) {
role_done = FALSE
role_start = i
} else role_done = TRUE
}
if (is.na(id_done)) {
if (id_start == i) {
id_done = FALSE
id_start = i
} else id_done = TRUE
}
if (role_done || id_done) {
value = nodes[[annotation]][role_start]
if (!is.na(value)) draw_box_f(co, role_start, i-1, label=value, is_outer = FALSE, vdist, cex=cex)
role_start = i
}
if (id_done) {
value = nodes[[ann_id]][id_start]
if (!is.na(value)) draw_box_f(co, id_start, i-1, label=value, is_outer=TRUE, vdist, cex=cex)
id_start = i
}
}
if (role_start <= i) {
value = nodes[[annotation]][role_start]
if (!is.na(value)) draw_box_f(co, role_start, nrow(nodes), label=value, is_outer=FALSE, vdist, cex=cex)
}
if (id_start <= i) {
value = nodes[[ann_id]][id_start]
if (!is.na(value)) draw_box_f(co, id_start, nrow(nodes), label=value, is_outer=TRUE, vdist, cex=cex)
}
}
}
draw_box <- function(co, start, end, vdist, label, is_outer=FALSE, hexp=1, vexp=1, cex=1, ...) {
vexp = if (is_outer) 1.2 else 1
hexp = if (is_outer) 1.05 else 1
ldist = if (start == 1) abs(co[2,1] - co[1,1]) else co[start,1] - co[start-1,1]
rdist = if (end == nrow(co)) co[nrow(co),1] - co[end-1,1] else abs(co[end,1] - co[end+1,1])
xl = co[start,1] - ((ldist/2.1)*hexp)
xr = co[end,1] + ((rdist/2.1)*hexp)
yt = max(co[start:end,2]) + (vdist*vexp)
if (is_outer) yt = yt + vdist
yb = min(co[start:end,2]) - (vdist/2)*vexp
if (yb < -0.5) yb = -0.5 - (0.05*cex)
graphics::rect(xl,yb,xr,yt, lty=if(is_outer) 1 else 2, border=if(is_outer) 'black' else 'darkgrey', ...)
labelx = mean(c(xl,xr))
labely = yt + (vdist/2)
if (is_outer) {
graphics::text(labelx, labely, label, cex=cex*0.8, font= 2)
} else {
graphics::text(labelx, labely, label, cex=cex*0.8, font= 4)
}
}
draw_box_alternative <- function(co, start, end, vdist, label, is_outer=FALSE, hexp=1, vexp=1, cex=1, ...) {
## if the plotting device is used (instead of pdf or png), use different settings, because the
## y-axis will not be 'compressed' afterwards
labelheight = graphics::strheight(label)
vexp = if (is_outer) 1.2 else 1
hexp = if (is_outer) 1 else 0.95
ldist = if (start == 1) abs(co[2,1] - co[1,1]) else co[start,1] - co[start-1,1]
rdist = if (end == nrow(co)) co[nrow(co),1] - co[end-1,1] else abs(co[end,1] - co[end+1,1])
xl = co[start,1] - ((ldist/2.1)*hexp)
xr = co[end,1] + ((rdist/2.1)*hexp)
yt = max(co[start:end,2]) + (vdist*0.5)
if (is_outer) yt = yt + labelheight*2
yb = min(co[start:end,2]) - (vdist/2)*vexp
if (yb < -0.5) yb = -0.5 - (0.05*cex)
graphics::rect(xl,yb,xr,yt, lty=if(is_outer) 1 else 2, border=if(is_outer) 'black' else 'darkgrey', ...)
labelx = mean(c(xl,xr))
labely = yt + labelheight * 0.6
if (is_outer) {
graphics::text(labelx, labely, label, cex=cex*0.8, font= 2)
} else {
graphics::text(labelx, labely, label, cex=cex*0.8, font= 4)
}
}
crop_png <- function(png_file, new_file=tempfile(), margins=c(20,20)) {
m = png::readPNG(png_file)
margin_x = margins[1]
white_x = colMeans(m[,,1]) == 1
white_x = c(which(!white_x)[1], length(white_x) - which(!rev(white_x))[1])
white_x = c(max(white_x[1] - margin_x, 0), min(white_x[2] + margin_x, ncol(m)))
margin_y = margins[2]
white_y = rowMeans(m[,,1]) == 1
white_y = c(which(!white_y)[1], length(white_y) - which(!rev(white_y))[1])
white_y = c(max(white_y[1] - margin_y, 0), min(white_y[2] + margin_y, nrow(m)))
png::writePNG(m[white_y[1]:white_y[2],
white_x[1]:white_x[2],],
new_file)
new_file
}
png_in_viewer <- function(png_file) {
png_file = crop_png(png_file)
png = paste0('data:image/png;base64,', base64enc::base64encode(png_file))
tf = tempfile(fileext = '.html')
html = sprintf('<!DOCTYPE html><html>
<body><div>
<img src="%s" alt="Could not display (viewer_mode not working)">
</div></body></html>', png)
writeLines(html , tf)
v = getOption('viewer')
if (!is.null(v))
v(tf)
else
utils::browseURL(tf)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.