Interactive set selector

euler_d3.R

library(htmltools)
library(d3r)
library(eulerr)

ui <- list(
  attachDependencies(
    tagList(),
    d3_dep_v5()
  ),
  titlePanel("Interactive Set Selector"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("groupA", "group A:", min = 1, max = 100, value = 50),
      sliderInput("groupB", "group B:", min = 1, max = 100, value = 70),
      sliderInput("overlap", "overlap:", min = 0, max = 100, value = 20)
    ),
    mainPanel(
      uiOutput("svgout"),
      verbatimTextOutput("selected")
    )
  )

)

server <- function(input, output, session){
  output$svgout <- renderUI({
    ep <- plot(
      eulerr::euler(c(a = input$groupA, b = input$groupB, "a&b" = input$overlap)),
      fills = c("yellow", "blue", "green")
    )

    my_js_code <- "
 var svg = d3.select('svg')
 svg.selectAll('path').each( function(d) {
    d3.select(this).datum({color: d3.select(this).style('fill')})
 })

 var legendcolors = d3.set()
 svg.selectAll('path').each(function(d){legendcolors.add(d3.select(this).style('fill'))})

 legendcolors.values().forEach(function(color) {
   var g = svg.insert('g','svg>path').classed('legend-color',true).datum({color: color})
   svg.selectAll('path')
     .filter(function(d) {return d3.select(this).style('fill') === color})
     .each(function(d) {
       g.node().appendChild(this)
     })
 })

  svg.selectAll('g.legend-color').on('click', function(d) {
    svg.selectAll('path').filter(pathd => pathd.color !== d.color).style('fill', 'white')
    svg.selectAll('path').filter(pathd => pathd.color === d.color).style('fill', 'steelblue')
    console.log(this);
    Shiny.setInputValue('selected', this);
  })
"
    svgfile <- tempfile(fileext = ".svg")

    devoutsvg::svgout(
      filename     = svgfile,
      js_url       = "https://d3js.org/d3.v5.min.js",
      js_code      = my_js_code
    )

    print(ep)
    invisible(dev.off())

    htmltools::includeHTML(svgfile)
  })

  output$selected <- renderPrint(list(
    selected = input$selected
  ))

}

# Run the application
shinyApp(ui = ui, server = server)