ggsvg icon indicating copy to clipboard operation
ggsvg copied to clipboard

example with `d3` and `v8`

Open timelyportfolio opened this issue 3 years ago • 3 comments

I am not sure why someone might want to do this, but for fun let's use d3 through v8 to generate an svg.

library(V8)
library(htmltools)
library(ggplot2)
library(ggsvg)
ctx <- v8()
ctx$source("https://unpkg.com/[email protected]/dist/d3.min.js")
# check to make sure we have d3 available
ctx$get("d3")
# use example line from https://observablehq.com/@d3/d3-line
line_d3 <- ctx$eval("d3.line()([[10, 60], [40, 90], [60, 10], [190, 10]])")
line_svg <- paste0(
  '<svg viewBox="0 0 200 100">',
  '<path d="',
  line_d3,
  '" fill = "none" stroke = "black"></path>',
  '</svg>'
)
ggplot(data.frame(x=0,y=0)) +
  geom_point_svg(
    svg = line_svg,
    aes(x,y),
    size = 100
  )

image

timelyportfolio avatar Dec 30 '21 17:12 timelyportfolio

Perhaps this is a more useful application but certainly still not complete.

# now let's draw pie chart
#   based on https://observablehq.com/@d3/pie-settings?collection=@d3/d3-shape
library(V8)
library(htmltools)
library(ggplot2)
library(ggsvg)
ctx2 <- v8()
ctx2$source("https://unpkg.com/[email protected]/dist/d3.min.js")
ctx2$eval('
  const arc = d3
    .arc()
    .innerRadius(10)
    .outerRadius(100)
    .cornerRadius(2)

  const pie = d3.pie().padAngle(0.03);
  
  const data = new Set([10, 11, 22, 30, 50, 80, 130]);
  const colors = d3.schemeCategory10;
  
  const arcs = pie(data);
  
  const paths_d = arcs.map(d => arc(d))
')
slices <- ctx2$get("paths_d")
fills <- ctx2$get("colors")
paths <- mapply(
  function(arc, fill) {
    paste0(
      '<path d="',
      arc,
      '" fill = "',
      fill,
      '"></path>'
    )
  },
  arc = slices,
  fill = fills[1:(length(slices))], 
  USE.NAMES = FALSE,
  SIMPLIFY = FALSE
)
pie_svg <- paste0(
  '<svg viewBox = "-100,-100,200,200">',
  paste0(paths, collapse=""),
  '</svg>',
  collapse = ""
)
browsable(HTML(pie_svg))

ggplot(data.frame(x=1:10,y=1:10)) +
  geom_point_svg(
    aes(x,y),
    svg = pie_svg,
    size = 12
  )

image

timelyportfolio avatar Dec 30 '21 18:12 timelyportfolio

The way standard grobs work (not sure it applies directly to svgparser's ones) one could imagine the SVG being generated at drawing time, e.g. here each pie plot doing something about its local context. That would mean the SVG string becomes but a promise of some aesthetics, e.g "{{fill}}" that is later on introduced in the grob's drawDetails method (or makeContent, I forget where this went).

drawDetails.svgGrob = function(x){
 # some d3 stuff to generate the SVG string, including the promised glue-aesthetics
 # then fed to the svgparser machinery to actually create something to draw
}

baptiste avatar Dec 30 '21 19:12 baptiste

I was playing around with fontr to turn glyphs into polygons, and decided to try the drawDetails thing on a SVG string create at draw time. I think it can work.

Screen Shot 2021-12-31 at 1 41 02 PM
library(grid)
library(svgparser)
library(showtext)
library(fontr)

grrrGrob <- function(x, y, label='grid', size=1, 
                     gp=gpar()){
  grob(x=x, y=y, label=label, size=size, gp=gp, cl = "grrr")
}

drawDetails.grrr <- function(x, recording=FALSE){
  letts <- strsplit(x$label,'')[[1]]
  chl <- purrr::map(letts, glyph_polygon, 
                family = "serif", face = "italic", nseg = 10)
  global_x <- x$x
  global_y <- x$y
  global_size <- x$size
  
  deltax <- sapply(chl, function(k) max(diff(range(k$x, na.rm = T))))
  dx <- cumsum(c(0,rep(max(deltax), length(chl)-1)))
  d <- map2_df(chl, dx, function(d, delta) 
    mutate(d, x = global_size*(x + delta) + global_x, 
           y=global_size*y+global_y), 
          .id='glyph')
  
  fill_flower <- if(runif(1)>0.5) '#eae200' else '#f040c0'
  svg_string <- glue::glue('
<svg viewBox="186.077 71.429 288.067 277.695" width="288.067" height="277.695">
  <path transform="matrix(0.29, 0, 0, -0.29, 185.110443, 351.134216)" fill="{fill_flower}" d="M3.33403,564.614
C3.33403,578.724,5.66108,593.537,10.6816,608.989
C33.1109,678.02,91.5134,705.105,156.304,705.105
C184.896,705.105,214.733,699.83,243.271,690.557
C294.057,674.055,337.639,650.754,373.022,624.77
C359.244,666.45,350.55,715.1,350.55,768.5
C350.55,866.5,395.385,964.5,500,964.5
C604.615,964.5,649.45,866.5,649.45,768.5
C649.45,715.1,640.756,666.45,626.978,624.77
C662.361,650.754,705.943,674.055,756.729,690.557
C785.267,699.83,815.104,705.105,843.697,705.105
C908.487,705.105,966.888,678.019,989.318,608.989
C994.339,593.536,996.667,578.724,996.667,564.614
C996.667,487.871,927.821,431.867,849.094,406.287
C799.118,390.049,750.916,383.238,707.561,383.238
L705.455,383.244
C741.101,357.622,776.729,323.374,808.117,280.173
C838.48,238.382,858.765,189.268,858.765,143.158
C858.765,101.79,842.438,62.8396,802.415,33.761
C776.656,15.0461,750.041,6.93001,723.854,6.93001
C663.998,6.93001,606.373,49.3304,566.302,104.484
C534.914,147.686,513.352,192.154,500,233.972
C486.648,192.154,465.086,147.686,433.698,104.484
C393.627,49.3304,336.002,6.93001,276.146,6.93001
C249.959,6.93001,223.344,15.0461,197.585,33.761
C157.562,62.8396,141.235,101.79,141.235,143.158
C141.235,189.268,161.52,238.382,191.883,280.173
C223.271,323.374,258.899,357.622,294.545,383.244
L292.439,383.238
C249.084,383.238,200.882,390.049,150.906,406.287
C72.1773,431.867,3.33403,487.869,3.33403,564.614Z
M424.05,450
C424.05,408.054,458.054,374.05,500,374.05
C541.946,374.05,575.95,408.054,575.95,450
C575.95,491.946,541.946,525.95,500,525.95
C458.054,525.95,424.05,491.946,424.05,450Z"></path>
</svg>
  ')
  
  grid.polygon(d$x, d$y, id = d$glyph)
  flowr <- svgparser::read_svg(svg_string, scale = 0.1)
  isr <- letts=='i'
  for (x in dx[isr]){
   flowr$vp <- viewport(x = global_size*x + global_x + 0.6,
                        y = global_y + 0.7,
                        default.units = 'npc')
   flowr$name <- Sys.time()
    grid.draw(flowr)
  }
}

grid.newpage()
grid.draw(grrrGrob(0,0.5, size = 0.5))
grid.draw(grrrGrob(0,0.1, size = 0.5))

baptiste avatar Dec 31 '21 12:12 baptiste