library(shiny)
library(DiagrammeR)
ui <- fluidPage(
grVizOutput("dg"),
textInput("node_label", "Enter new label"),
actionButton("update_label", "Update label"),
verbatimTextOutput("print")
)
server <- function(input, output, session) {
node_labels <- reactiveVal(list(a = "Start", b = "Step 1", c = "Step 2", d = "Step 3", e = "Step 4", f = "Step 5", g = "Step 6", h = "Step 7", i = "Step 8", j = "Step 9"))
output$dg <- renderGrViz({
grViz(paste0("
digraph a_nice_graph {
# node definitions with substituted label text
node [fontname = Helvetica]
a [label = '", node_labels()$a, "']
b [label = '", node_labels()$b, "']
c [label = '", node_labels()$c, "']
d [label = '", node_labels()$d, "']
e [label = '", node_labels()$e, "']
f [label = '", node_labels()$f, "']
g [label = '", node_labels()$g, "']
h [label = '", node_labels()$h, "']
i [label = '", node_labels()$i, "']
j [label = '", node_labels()$j, "']
# edge definitions with the node IDs
a -> {b c d e f g h i j}
}
"))
})
observeEvent(input$update_label, {
if (!is.null(input$dg_click)) {
node_val <- input$dg_click$nodeValues[[1]]
new_val <- input$node_label
node_labels(node_labels() %>% {.[[node_val]] <- new_val; .})
}
})
txt <- reactive({
req(input$dg_click)
nodeval <- input$dg_click$nodeValues[[1]]
return(paste(nodeval, " is clicked"))
})
output$print <- renderPrint({
txt()
})
}
shinyApp(ui, server)