Thiết kế website giá rẻ

Question

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%dnα=%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("%snα=%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)
}
)

Thiết kế website giá rẻ

Danh mục

how to save a drag and drop graph in Rshiny after drawing a flowchart with visNetwork