[sankey] add interactive sankey explorer (#20)

CITATION.cff

@@ -326,6 +326,44 @@ references:
     given-names: Amir Masoud
     email: [email protected]
   year: '2023'
+- type: software
+  title: shiny
+  abstract: 'shiny: Web Application Framework for R'
+  notes: Suggests
+  url: https://shiny.posit.co/
+  repository: https://CRAN.R-project.org/package=shiny
+  authors:
+  - family-names: Chang
+    given-names: Winston
+    email: [email protected]
+    orcid: https://orcid.org/0000-0002-1576-2126
+  - family-names: Cheng
+    given-names: Joe
+    email: [email protected]
+  - family-names: Allaire
+    given-names: JJ
+    email: [email protected]
+  - family-names: Sievert
+    given-names: Carson
+    email: [email protected]
+    orcid: https://orcid.org/0000-0002-4958-2844
+  - family-names: Schloerke
+    given-names: Barret
+    email: [email protected]
+    orcid: https://orcid.org/0000-0001-9986-114X
+  - family-names: Xie
+    given-names: Yihui
+    email: [email protected]
+  - family-names: Allen
+    given-names: Jeff
+  - family-names: McPherson
+    given-names: Jonathan
+    email: [email protected]
+  - family-names: Dipert
+    given-names: Alan
+  - family-names: Borges
+    given-names: Barbara
+  year: '2023'
 - type: software
   title: testthat
   abstract: 'testthat: Unit Testing for R'

DESCRIPTION

@@ -33,6 +33,7 @@ Suggests:
     pak,
     pkgdown,
     preferably,
+    shiny,
     testthat (>= 3.0.0),
     tibble,
     tidygraph

R/sankey_explorer.R

@@ -0,0 +1,98 @@
+sankey_explorer <- function(data) {
+  if (!requireNamespace("shiny", quietly = TRUE)) {
+    stop("You must have {shiny} installed to use `sankey_explorer()`")
+  }
+
+  data <- as_sankey_data(data)
+
+  ui <- shiny::fluidPage(
+    shiny::inputPanel(
+      shiny::selectInput(
+        inputId = "nodeId",
+        label = "nodeId:",
+        choices = c(`(default) "id"` = "id", names(data$nodes)),
+        selected = '(default) "id"'
+      ),
+      shiny::selectInput(
+        inputId = "nodeGroup",
+        label = "nodeGroup:",
+        choices = c(`(default) "group"` = "group", names(data$nodes)),
+        selected = '(default) "group"'
+      ),
+      shiny::selectInput(
+        inputId = "nodeLabel",
+        label = "nodeLabel:",
+        choices = c(`(default) "id"` = "id", names(data$nodes)),
+        selected = '(default) "id"'
+      ),
+      shiny::textInput(
+        inputId = "nodeLabelFontFamily",
+        label = "nodeLabelFontFamily:",
+        value = "sans-serif",
+        placeholder = '(default) "sans-serif"'
+      ),
+      shiny::numericInput(
+        inputId = "nodeLabelFontSize",
+        label = "nodeLabelFontSize:",
+        value = 10,
+        min = 1,
+        max = 84,
+        step = 1
+      ),
+      shiny::selectInput(
+        inputId = "linkPath",
+        label = "linkPath:",
+        choices = c(`(default) "path"` = "path", names(data$links)),
+        selected = "path"
+      ),
+      shiny::selectInput(
+        inputId = "linkColor",
+        label = "linkColor:",
+        choices = c("source", "target", "source-target", "path"),
+        selected = ""
+      ),
+      shiny::selectInput(
+        inputId = "colorScheme",
+        label = "colorScheme:",
+        choices = c("schemeCategory10", "schemeAccent", "schemeDark2", "schemePaired", "schemePastel1", "schemePastel2", "schemeSet1", "schemeSet2", "schemeSet3", "schemeTableau10"),
+        selected = ""
+      ),
+      shiny::sliderInput("iterations", label = "iterations:",
+                  min = 0, max = 100, value = 6, step = 1),
+      shiny::selectInput(
+        inputId = "nodeAlign",
+        label = "nodeAlign:",
+        choices = c("sankeyJustify", "sankeyLeft", "sankeyRight", "sankeyCenter"),
+        selected = "sankeyJustify"
+      ),
+      shiny::textInput(
+        inputId = "tooltipLinkText",
+        label = "tooltipLinkText:",
+        value = 'd.source[nodeLabel] + " \u2192 " + d.target[nodeLabel] + "<br/>" + format(d.value)',
+        placeholder = '(default) "d.source[nodeLabel] + " \u2192 " + d.target[nodeLabel] + "<br/>" + format(d.value)"'
+      )
+    ),
+    r2d3::d3Output("d3")
+  )
+
+  server <- function(input, output) {
+    output$d3 <- r2d3::renderD3({
+      sankey_network(
+        data = data,
+        nodeId = input$nodeId,
+        nodeGroup = input$nodeGroup,
+        nodeLabel = input$nodeLabel,
+        nodeLabelFontFamily = input$nodeLabelFontFamily,
+        nodeLabelFontSize = input$nodeLabelFontSize,
+        linkPath = input$linkPath,
+        linkColor = input$linkColor,
+        colorScheme = input$colorScheme,
+        iterations = input$iterations,
+        nodeAlign = input$nodeAlign,
+        tooltipLinkText = input$tooltipLinkText
+      )
+    })
+  }
+
+  shiny::shinyApp(ui = ui, server = server)
+}