Does anyone know how to save a drag and drop graph in Rshiny after drawing a flowchart with visNetwork #467
Description
I want to implement it on the shiny platform to remember the shape of the flow chart after I modify it. When I rename a node each time, its shape will not reset, and I can drag it to my favorite shape and click download to save it to the local png format.
Has anyone dealt with this issue before? If so, could you share how you managed to save and reload the network with the nodes in their new positions? Thank you in advance for your help!
create_flow_chart_with_weights <- function(weight_data, initial_alpha_values) {
nodes <- data.frame(id = 1:nrow(weight_data),
label = sapply(1:nrow(weight_data), function(i) {
sprintf("H%d\nα=%s", i, formatC(initial_alpha_values[i], format = "g"))
}),
color = "lightblue",
shape = "ellipse",
shadow = TRUE)
edges <- data.frame()
added_edges <- matrix(FALSE, nrow = nrow(weight_data), ncol = ncol(weight_data))
for (i in 1:nrow(weight_data)) {
for (j in 1:ncol(weight_data)) {
if (!is.na(weight_data[i, j]) && weight_data[i, j] > 0) {
if (i != j && !is.na(weight_data[j, i]) && weight_data[j, i] > 0 && !added_edges[j, i]) {
added_edges[i, j] <- TRUE
added_edges[j, i] <- TRUE
edges <- rbind(edges, data.frame(from = i, to = j, label = formatC(weight_data[i, j], format = "g"), arrows = "to"))
edges <- rbind(edges, data.frame(from = j, to = i, label = formatC(weight_data[j, i], format = "g"), arrows = "to"))
} else if (!added_edges[i, j]) {
added_edges[i, j] <- TRUE
edges <- rbind(edges, data.frame(from = i, to = j, label = formatC(weight_data[i, j], format = "g"), arrows = "to"))
}
}
}
}
edges$smooth <- mapply(function(from, to) {
if (added_edges[from, to] && added_edges[to, from]) {
list(enabled = TRUE, type = "curved", roundness = 0.5)
} else {
FALSE
}
}, edges$from, edges$to, SIMPLIFY = FALSE)
visNetwork(nodes, edges) %>%
visEdges(arrows = 'to', font = list(background = 'white')) %>%
visInteraction(dragNodes = TRUE) %>%
visPhysics(enabled = FALSE,solver = "forceAtlas2Based", forceAtlas2Based = list(springLength = 250, gravitationalConstant = -300, springConstant = 1.0)) %>%
visOptions(highlightNearest = TRUE, nodesIdSelection = FALSE) %>%
visInteraction(zoomView = FALSE) %>%
visLayout(randomSeed = 123)
}
observe({
visNetworkProxy("weightBasedFlowChart") %>%
visStorePositions()
})
proxy <- dataTableProxy('weightTable')
observeEvent(input$weightTable_cell_edit, {
info <- input$weightTable_cell_edit
rv$data[info$row, info$col] <- as.numeric(info$value)
initial_alpha_values <- alpha_table_data()[, "分配的Alpha"]
for (i in 1:nrow(rv$data)) {
rowSum <- sum(rv$data[i, ], na.rm = TRUE)
if (rowSum > 1) {
showModal(modalDialog(
title = "错误",
paste0("第 ", i, " 行的数值总和不能超过 1。您当前的和为: ", rowSum),
easyClose = TRUE,
footer = NULL
))
rv$data[i, info$col] <- NA_real_ # Reset the value
break
}
}
output$weightBasedFlowChart <- renderVisNetwork({
create_flow_chart_with_weights(rv$data, initial_alpha_values)
})
})
observeEvent(input$renameNodes1, {
if (!is.null(alpha_table_data()) && "分配的Alpha" %in% names(alpha_table_data())) {
initial_alpha_values <- alpha_table_data()[, "分配的Alpha"]
nodes_data <- create_nodes_data_for_weight_based_chart(rv$data, initial_alpha_values)
nodes_info$names <- nodes_data$name
output$renameTable1 <- renderDT({
datatable(nodes_data[, c("name", "alpha")], editable = 'cell', options = list(dom = 't'))
})
}
})
observeEvent(input$renameTable1_cell_edit, {
info <- input$renameTable1_cell_edit
if (!is.null(alpha_table_data()) && "分配的Alpha" %in% names(alpha_table_data())) {
initial_alpha_values <- alpha_table_data()[, "分配的Alpha"]
if (info$col == 1) { # “name”列
nodes_info$names[info$row] <- info$value
} else if (info$col == 2) { # “alpha”列
initial_alpha_values[info$row] <- as.numeric(info$value)
}
output$weightBasedFlowChart <- renderVisNetwork({
nodes_data <- create_nodes_data_for_weight_based_chart(rv$data, initial_alpha_values)
for (i in seq_along(nodes_info$names)) {
nodes_data$name[i] <- nodes_info$names[i]
nodes_data$alpha[i] <- initial_alpha_values[i]
}
create_flow_chart_with_weights_custom(nodes_data, rv$data)
})
}
})
create_nodes_data_for_weight_based_chart <- function(weight_data, initial_alpha_values) {
nodes_data <- data.frame(
id = 1:nrow(weight_data),
name = sapply(1:nrow(weight_data), function(i) sprintf("H%d", i)),
alpha = initial_alpha_values
)
return(nodes_data)
}
create_flow_chart_with_weights_custom <- function(nodes_data, weight_data) {
nodes <- data.frame(
id = nodes_data$id,
label = sapply(1:nrow(nodes_data), function(i) {
sprintf("%s\nα=%s", nodes_data$name[i], formatC(nodes_data$alpha[i], format = "g"))
}),
color = "lightblue",
shape = "ellipse",
shadow = TRUE
)
edges <- data.frame()
added_edges <- matrix(FALSE, nrow = nrow(weight_data), ncol = ncol(weight_data))
for (i in 1:nrow(weight_data)) {
for (j in 1:ncol(weight_data)) {
if (!is.na(weight_data[i, j]) && weight_data[i, j] > 0) {
if (i != j && !is.na(weight_data[j, i]) && weight_data[j, i] > 0 && !added_edges[j, i]) {
added_edges[i, j] <- TRUE
added_edges[j, i] <- TRUE
edges <- rbind(edges, data.frame(from = i, to = j, label = formatC(weight_data[i, j], format = "g"), arrows = "to"))
edges <- rbind(edges, data.frame(from = j, to = i, label = formatC(weight_data[j, i], format = "g"), arrows = "to"))
} else if (!added_edges[i, j]) {
added_edges[i, j] <- TRUE
edges <- rbind(edges, data.frame(from = i, to = j, label = formatC(weight_data[i, j], format = "g"), arrows = "to"))
}
}
}
}
edges$smooth <- mapply(function(from, to) {
if (added_edges[from, to] && added_edges[to, from]) {
list(enabled = TRUE, type = "curved", roundness = 0.5)
} else {
FALSE
}
}, edges$from, edges$to, SIMPLIFY = FALSE)
visNetwork(nodes, edges) %>%
visEdges(arrows = 'to', font = list(background = 'white')) %>%
visInteraction(dragNodes = TRUE) %>%
visPhysics(enabled = FALSE,solver = "forceAtlas2Based", forceAtlas2Based = list(springLength = 250, gravitationalConstant = -300, springConstant = 1.0)) %>%
visOptions(highlightNearest = TRUE, nodesIdSelection = FALSE) %>%
visInteraction(zoomView = FALSE) %>%
visLayout(randomSeed = 123)
}
observeEvent(input$savePositions, {
visNetworkProxy("weightBasedFlowChart") %>% visGetPositions()
})
nodePositions <- reactive({
positions <- input$weightBasedFlowChart_positions
if(!is.null(positions)){
nodePositions <- do.call("rbind", lapply(positions, function(x){ data.frame(x = x$x, y = x$y)}))
nodePositions$id <- names(positions)
nodePositions
} else {
NULL
}
})
output$downloadFlowChart <- downloadHandler(
filename = function() {
paste("weight_flow_chart_", Sys.Date(), ".png", sep = "")
},
content = function(file) {
updated_alpha_values <- rv$initial_alpha_values
if (!is.null(alpha_table_data()) && "分配的Alpha" %in% names(alpha_table_data())) {
updated_alpha_values <- alpha_table_data()[, "分配的Alpha"]
}
updated_node_data <- create_nodes_data_for_weight_based_chart(rv$data, updated_alpha_values)
if (!is.null(nodes_info$names)) {
updated_node_data$name <- nodes_info$names
}
if (!is.null(input$nodePositions)) {
for (id in names(input$nodePositions$x)) {
if (id %in% updated_node_data$id) {
updated_node_data$x[updated_node_data$id == id] <- input$nodePositions$x[id]
updated_node_data$y[updated_node_data$id == id] <- input$nodePositions$y[id]
}
}
}
weight_flow_chart <- create_flow_chart_with_weights_custom(updated_node_data, rv$data)
temp_html_file <- tempfile(fileext = ".html")
visNetwork::visSave(weight_flow_chart, temp_html_file)
webshot(temp_html_file, file = file, vwidth = 800, vheight = 600)
unlink(temp_html_file)
}
)`