Built in R, assembled with blockbuilder.org
Don’t try this at home. This little bit of code (not robust and specifically hacked to work) takes a base graphics xyplot
as SVG
and then uses d3
and the delightful d3-annotation
to label two of the points.
library(d3r)
library(htmltools)
library(pipeR)
d3_ann <- htmlDependency(
name = "d3-annotation",
version = "1.12.1",
src = c(href = "https://unpkg.com/d3-svg-annotation@1.12.1/"),
script = "d3-annotation.js",
stylesheet = "d3-annotation.css"
)
# now let's try it with svglite
library(svglite)
plot(1:10, type="b")
rp <- recordPlot()
size = dev.size()
plt = par("plt")
usr = par("usr")
s <- svgstring(standalone=FALSE,width = size[1], height=size[2])
replayPlot(rp)
dev.off()
# this is just to make it render in RStudio
library(xml2)
svg_xml <- read_xml(as.character(s()))
cp_rect <- xml_find_first(svg_xml,"*//clipPath/rect")
cp_attr <- lapply(
list(
x = xml_attr(cp_rect,"x"),
y = xml_attr(cp_rect,"y"),
height = xml_attr(cp_rect,"height"),
width = xml_attr(cp_rect,"width")
),
as.numeric
)
# drawing with no knowledge of plot from R
# using example1
tagList(
tags$style(".annotation-note-bg {stroke: none;}"),
HTML(s()),
tags$script(HTML(
sprintf(
'
vb = d3.select("svg").attr("viewBox").split(" ");
var width = +vb[2];
var height = +vb[3];
var svg = d3.select("svg");
var margins = %s;
var usr = %s;
var type = d3.annotationLabel;
var annotations = [
{
note: {
label: "Point with x=3, y=3. Drag my points somewhere else.",
title: "Annotations :)"
},
//can use x, y directly instead of data
data: { x: 3, y: 3 },
dy: -40,
dx: 20
},
{
note: {
label: "x(8), y(8)",
title: "another point"
},
//can use x, y directly instead of data
data: { x: 8, y: 8 },
dy: -40,
dx: 20
}
]
// use clipPath rect for range of plot; multiplying usr * height
// did not work on the y limits
// but only because I did not research enough
// and lazily assume that there will be a clipPath around our plot
// and that it will be the first clipPath in our svg
// RStudio iframe security does not like following
// so I elected to do after commented for this to work
/*
var cp = d3.select("clipPath rect");
//set domains even though skipped in original example
var x = d3.scaleLinear()
//.range([width * margins[0], width*margins[1]])
.range([parseFloat(cp.attr("x")), parseFloat(cp.attr("width")) + parseFloat(cp.attr("x"))])
.domain([usr[0], usr[1]])
var y = d3.scaleLinear()
//.range([height * margins[3], height * margins[2]])
.range([parseFloat(cp.attr("height")) + parseFloat(cp.attr("y")), +cp.attr("y")])
.domain([usr[0], usr[1]])
*/
var cp_attr = %s;
var x = d3.scaleLinear()
.range([cp_attr.x, cp_attr.width + cp_attr.x])
.domain([usr[0], usr[1]])
var y = d3.scaleLinear()
.range([cp_attr.height + cp_attr.y, cp_attr.y])
.domain([usr[0], usr[1]])
var makeAnnotations = d3.annotation()
.editMode(true)
.type(type)
//accessors & accessorsInverse not needed
//if using x, y in annotations JSON
.accessors({
x: function(d) { return x(d.x) },
y: function(d) { return y(d.y) }
})
.accessorsInverse({
x: function(d) { return x.invert(d.x) },
y: function(d) { return y.invert(d.y) }
})
.annotations(annotations)
svg
.append("g")
.attr("class", "annotation-group")
.call(makeAnnotations)
',
jsonlite::toJSON(plt),
jsonlite::toJSON(usr),
jsonlite::toJSON(cp_attr, auto_unbox=TRUE)
)
)),
d3_dep_v4(),
d3_ann
) %>>%
browsable()