Sigma.js Interface for R + Shiny Computing Metrics on Filtered Sub-graph

17 views Asked by At

I am looking to build a .md file using flexdashboard and shiny to plot and filter graph data. In the ui I have a sidepanel for filters and the following static table which computes metrics on the whole graph built in igraph.

result <- rbind(
  format(round(vcount(g)), nsmall = 0),
  format(ecount(g), digits = 3),
  format(edge_density(g), digits = 3),
  format(reciprocity(g), digits = 3),
  format(centr_betw(g)$centralization, digits = 3),
  format(mean_distance(g), digits = 3)
)

rownames(result) <- c("Nodes", "Edges", "Density", "Reciprocity", "Centrality", "Avg Path Length")
colnames(result) <- c("Value")

# Convert to a data frame for htmlTable
result_df <- as.data.frame(result)

styled_table <- result_df %>% 
  htmlTable(.,theme = "scientific", css.table = "width:80%;border: none")

Is it possible to make this interactive and display metrics on the induced subgraph each time this is filtered? Or a step further on the neighborhood of the node that is selected in the sigmajsOutput("sg"), included in the main panel of the ui.

server <- function(input, output, session){

  observeEvent(input$reset,{
    updateSliderInput(session, "filter", value = -1)
  })
  
  output$sg <- renderSigmajs({
    sigmajs() %>%
      sg_from_igraph(g, sd = sd, layout) %>% 
      sg_neighbours() %>% 
      sg_settings(drawLabels = TRUE, 
              hoverFontStyle = "bold", 
              labelColor = "node", 
              labelSizeRatio = 3,
              defaultLabelHoverColor = "node",
              mouseWheelEnabled = TRUE, 
              drawEdgeLabels = FALSE,
              labelThreshold= 100) %>% 
      sg_drag_nodes() %>% 
      sg_layout() %>%
      sg_noverlap()# allows user to drag nodes
      
  })
  
  output$dtNodes <- renderDataTable({
                            DT::datatable(sd, options = my.options,
                container = my.container, 
                style = "bootstrap4", 
                width = "100%",
                selection = "single",
                rownames=FALSE
                )
    }, server=FALSE)
  # Get filtered node IDs

  observeEvent(input$filter, {
    sigmajsProxy("sg") %>% 
      sg_filter_undo_p("sz") %>% # we undo the filter before applying it
      sg_filter_gt_p(input$filter, "outdegree", name = "sz") %>% 
      sg_noverlap_p()
  })
  
    observeEvent(input$parent_smoking, {
    # Apply filter based on selected time
    sigmajsProxy("sg") %>% 
      sg_filter_undo_p("parent_smoking") %>% 
      sg_filter_not_eq_p(input$parent_smoking, "parent_smoking", name = "parent_smoking") %>% 
      sg_noverlap_p()
  })
    
      observeEvent(input$download, {
      sg_export_svg_p(sigmajsProxy("sg"), labels=TRUE)
  })
      observeEvent(input$png, {
      sg_export_img_p(sigmajsProxy("sg"))
  })
}

I have tried sg_get_nodes_p(proxy) but this is not a graph function there is also sg_get_edges_p(proxy) but am not sure how to combine these or what object type these return.

0

There are 0 answers