Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

example with d3 and v8 #2

Open
timelyportfolio opened this issue Dec 30, 2021 · 3 comments
Open

example with d3 and v8 #2

timelyportfolio opened this issue Dec 30, 2021 · 3 comments

Comments

@timelyportfolio
Copy link

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/d3@7.2.1/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
Copy link
Author

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/d3@7.2.1/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

@baptiste
Copy link

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
Copy link

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))

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

2 participants