2 years ago

#75045

test-img

firmo23

Enable DiagrammeR plot output to zoom in when hitting double click on it

I have the shiny app below in which I try to add double-click-to-zoom-in the plot. I think the secret is adapting the js part but I'm not sure about it.

devtools::install_github("stevepowell99/CausalMapFunctions")
library(CausalMapFunctions)

library(shiny)
library(shinyWidgets)
library(DiagrammeR)
library(magrittr)
library(CausalMapFunctions)
#source("C:/Users/steve/Dropbox/Projects/CausalMapFunctions/R/functions.R", encoding = 'UTF-8')

make_print_map <- function(
  graf=NULL
  
){
  
  factors <-
    graf$factors %>%
    mutate(tooltip= ("test"))
  
  links <- graf$links
  
  grv <-
    DiagrammeR::create_graph() %>%
    add_nodes_from_table(factors %>% mutate(id=row_number()),label_col="label") %>%
    add_edges_from_table(links,from_col="from",to_col="to",from_to_map = id_external)
  return(
    grv %>% DiagrammeR::render_graph()
  )
  
}

js <- '
var element = document.getElementById("grr");
var panzoom = Panzoom(element, {
maxScale: 5
});
var z = 1;
$("#zoomout").on("click", function(){
z *= 0.9;
panzoom.zoom(z, { animate: true });
});
$("#zoomin").on("click", function(){
z *= 1.1;
panzoom.zoom(z, { animate: true });
});
$("#reset").on("click", function(){
z = 1;
panzoom.reset();
});
'

ui <- fluidPage(
  tags$head(
    tags$script(src = "https://unpkg.com/@panzoom/panzoom@4.4.3/dist/panzoom.min.js")
  ),
  
  uiOutput("main")
)

server <- function(input, output) {
  
  output$main <- renderUI({
    tagList(
      div(
        grVizOutput("grr", width = "100%", height = "90vh"),
        
        actionGroupButtons(
          inputIds = c("zoomout", "zoomin", "reset"),
          labels = list(icon("minus"), icon("plus"), "Reset"),
          status = "primary"
        )
      ),
      tags$script(HTML(js))
    )
    
  })
  
  output$grr <- renderGrViz({
    make_print_map(example2 %>% pipe_coerce_mapfile())
    #
  })
  
}

shinyApp(ui, server)

r

shiny

zooming

diagrammer

0 Answers

Your Answer

Accepted video resources