I have two problems to solve:
- 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.
- For the report summary, when I click to download the report, the word document will be generated, and the flow chart can be attached.
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 <- function(input, num_endpoints, results, analysis_results) {
nodes_data <- data.frame(id = numeric(), label = character(), shape = character(), color = character(), shadow = logical())
edges_data <- data.frame(from = integer(), to = integer())
colors <- c("lightskyblue","paleturquoise","lightblue","lightsteelblue")
# 添加总一类错误节点
nodes_data <- rbind(nodes_data, data.frame(
id = 0,
label = sprintf("总一类错误nα=%s", safeFormatC(input$totalAlpha)),
shape = "box", color = colors[1], shadow = TRUE
))
endpoint_index <- 1
analysis_node_id <- 1000
for (i in 1:num_endpoints) {
endpoint_alpha <- sum(results[results$终点 == i, "分配的Alpha"], na.rm = TRUE)
endpoint_node_id <- endpoint_index
nodes_data <- rbind(nodes_data, data.frame(
id = endpoint_node_id,
label = sprintf("终点 %dnα=%s", i, safeFormatC(endpoint_alpha)),
shape = "ellipse", color = colors[2], shadow = TRUE
))
edges_data <- rbind(edges_data, data.frame(from = 0, to = endpoint_node_id))
if (input[[paste0("subgroup", i)]]) {
subgroups <- unique(results[results$终点 == i, "亚组"])
for (j in subgroups) {
subgroup_alpha <- sum(results[results$终点 == i & results$亚组 == j, "分配的Alpha"], na.rm = TRUE)
subgroup_node_id <- endpoint_index + 1
nodes_data <- rbind(nodes_data, data.frame(
id = subgroup_node_id,
label = sprintf("亚组 %dnα=%s", j, safeFormatC(subgroup_alpha)),
shape = "box", color = colors[3], shadow = TRUE
))
edges_data <- rbind(edges_data, data.frame(from = endpoint_node_id, to = subgroup_node_id))
subgroup_analyses <- analysis_results[analysis_results$Endpoint == i & analysis_results$Subgroup == j, ]
if (nrow(subgroup_analyses) > 0) {
for (k in 1:nrow(subgroup_analyses)) {
analysis_node_id <- analysis_node_id + 1
nodes_data <- rbind(nodes_data, data.frame(
id = analysis_node_id,
label = sprintf("分析 %dnα=%s", k, safeFormatC(subgroup_analyses[k, "Spend"])),
shape = "ellipse", color = colors[4], shadow = TRUE
))
edges_data <- rbind(edges_data, data.frame(from = subgroup_node_id, to = analysis_node_id))
}
}
endpoint_index <- subgroup_node_id + 1
}
} else {
endpoint_analyses <- analysis_results[analysis_results$Endpoint == i & is.na(analysis_results$Subgroup), ]
if (nrow(endpoint_analyses) > 0) {
for (k in 1:nrow(endpoint_analyses)) {
analysis_node_id <- analysis_node_id + 1
nodes_data <- rbind(nodes_data, data.frame(
id = analysis_node_id,
label = sprintf("分析 %dnα=%s", k, safeFormatC(endpoint_analyses[k, "Spend"])),
shape = "ellipse", color = colors[4], shadow = TRUE
))
edges_data <- rbind(edges_data, data.frame(from = endpoint_node_id, to = analysis_node_id))
}
}
}
endpoint_index <- endpoint_index + 1
}
visNetwork(nodes_data, edges_data) %>%
visEdges(arrows = 'to', smooth = FALSE) %>%
visInteraction(dragNodes = TRUE) %>%
visOptions(highlightNearest = TRUE, nodesIdSelection = FALSE) %>%
visPhysics(enabled = FALSE) %>%
visInteraction(zoomView = FALSE) %>%
visHierarchicalLayout(direction = "LR") %>%
visLayout(randomSeed = 123)
}
observeEvent(input$renameNodes, {
nodes_data <- create_flow_chart_nodes(input, ne$num_endpoints, ne$results)
# 初始化 updated_node_labels
updated_node_labels$names <- nodes_data$name
updated_node_labels$alphas <- nodes_data$alpha
# 对alpha列的数值保留5位小数
nodes_data$alpha <- round(nodes_data$alpha, 5)
output$renameTable <- renderDT({
datatable(nodes_data[, c( "name", "alpha")], editable = TRUE, options = list(dom = 't'))
})
})
observeEvent(input$renameTable_cell_edit, {
info <- input$renameTable_cell_edit
nodes_data <- create_flow_chart_nodes(input, ne$num_endpoints, ne$results)
if (info$col == 1) { # 名称列
updated_node_labels$names[info$row] <- info$value
} else if (info$col == 2) { # Alpha列
updated_node_labels$alphas[info$row] <- as.numeric(info$value)
}
for (i in 1:nrow(nodes_data)) {
nodes_data$name[i] <- updated_node_labels$names[i]
nodes_data$alpha[i] <- updated_node_labels$alphas[i]
nodes_data$label[i] <- paste(nodes_data$name[i], "nα=", formatC(nodes_data$alpha[i], format = "g"))
}
output$flowChart <- renderVisNetwork({
create_flow_chart_custom(nodes_data, ne$results)
})
})
create_flow_chart_nodes <- function(input, num_endpoints, results) {
nodes_data <- data.frame(id = numeric(), name = character(), alpha = numeric(), shape = character(), color = character(), endpoint_id = numeric())
colors <- c( "lightskyblue","paleturquoise","lightblue","lightsteelblue")
# 添加“总一类错误”节点
nodes_data <- rbind(nodes_data, data.frame(id = 0, name = "总一类错误", alpha = input$totalAlpha, shape = "box",
color = colors[1], endpoint_id = NA, shadow = TRUE))
# 添加“终点”节点和“亚组”节点
subgroup_id <- num_endpoints + 1
analysis_id <- subgroup_id
for (i in 1:num_endpoints) {
endpoint_alpha <- sum(results[results$终点 == i, "分配的Alpha"])
nodes_data <- rbind(nodes_data, data.frame(id = i, name = paste("终点", i), alpha = endpoint_alpha, shape = "ellipse",
color = colors[2], endpoint_id = NA, shadow = TRUE))
if (input[[paste0("subgroup", i)]]) {
num_subgroups <- input[[paste0("numSubgroups", i)]]
for (j in 1:num_subgroups) {
subgroup_alpha <- sum(results[results$终点 == i & results$亚组 == j, "分配的Alpha"])
nodes_data <- rbind(nodes_data, data.frame(id = subgroup_id, name = paste("亚组", i, "-", j),
alpha = subgroup_alpha, shape = "box",
color = colors[3], endpoint_id = i, shadow = TRUE))
# 检查并添加期中分析节点
subgroup_analysis_info <- results[results$终点 == i & results$亚组 == j & !is.na(results$分析次数), ]
for (analysis in unique(subgroup_analysis_info$分析次数)) {
analysis_alpha <- sum(subgroup_analysis_info[subgroup_analysis_info$分析次数 == analysis, "分配的Alpha"])
analysis_node_name <- paste("亚组", i, "-", j, "分析", analysis)
analysis_id <- analysis_id + 1
nodes_data <- rbind(nodes_data, data.frame(id = analysis_id, name = analysis_node_name,
alpha = analysis_alpha, shape = "ellipse",
color = colors[4], endpoint_id = subgroup_id, shadow = TRUE))
}
subgroup_id <- subgroup_id + 1
}
} else {
endpoint_analysis_info <- results[results$终点 == i & is.na(results$亚组) & !is.na(results$分析次数), ]
for (analysis in unique(endpoint_analysis_info$分析次数)) {
analysis_alpha <- sum(endpoint_analysis_info[endpoint_analysis_info$分析次数 == analysis, "分配的Alpha"])
analysis_node_name <- paste("终点", i, "分析", analysis)
analysis_id <- analysis_id + 1
nodes_data <- rbind(nodes_data, data.frame(id = analysis_id, name = analysis_node_name, alpha = analysis_alpha,
shape = "ellipse", color = colors[4], endpoint_id = i, shadow = TRUE))
}
}
}
return(nodes_data)
}
create_flow_chart_custom <- function(nodes_data, results) {
for (i in 1:nrow(nodes_data)) {
nodes_data$label[i] <- sprintf("%snα=%s", nodes_data$name[i], formatC(nodes_data$alpha[i], format = "g"))
}
edges_data <- data.frame(from = integer(), to = integer())
# 为每个节点添加边
for (i in 1:nrow(nodes_data)) {
if (nodes_data$shape[i] == "ellipse" && nodes_data$id[i] != 0 && is.na(nodes_data$endpoint_id[i])) {
edges_data <- rbind(edges_data, data.frame(from = 0, to = nodes_data$id[i]))
}
else if (nodes_data$shape[i] == "box" && nodes_data$color[i] == "lightblue") {
endpoint_id <- nodes_data$endpoint_id[i]
edges_data <- rbind(edges_data, data.frame(from = endpoint_id, to = nodes_data$id[i]))
}
else if (nodes_data$shape[i] == "ellipse" && nodes_data$color[i] == "lightsteelblue") {
parent_id <- nodes_data$endpoint_id[i]
if (!is.na(parent_id)) {
edges_data <- rbind(edges_data, data.frame(from = parent_id, to = nodes_data$id[i]))
}
}
}
visNetwork(nodes_data, edges_data) %>%
visEdges(arrows = 'to', smooth = FALSE) %>%
visInteraction(dragNodes = TRUE) %>%
visOptions(highlightNearest = TRUE, nodesIdSelection = FALSE) %>%
visPhysics(enabled = FALSE) %>%
visInteraction(zoomView = FALSE) %>%
visLayout(randomSeed = 123)
}
###传递流程图生成函数代码：#####
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()
# 现有逻辑处理非 Fixed-sequence 法
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)
# 获取 alphaTable 中的数据
initial_alpha_values <- alpha_table_data()[, "分配的Alpha"]
# 检查每行的总和是否超过 1
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, {
# 确保 alpha_table_data 是可用的并且已经被计算
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"]
# 更新名称或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)
}
# 对于传递流程图：当点击下载按钮时，生成并保存流程图
output$downloadFlowChart <- downloadHandler(
filename = function() {
paste("weight_flow_chart_", Sys.Date(), ".png", sep = "")
},
content = function(file) {
# 确保有有效的位置信息
#req(rv$positions)
# 获取最新的节点数据，包括可能编辑过的名称和α值
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)
# 将流程图保存到临时HTML文件
temp_html_file <- tempfile(fileext = ".html")
visNetwork::visSave(weight_flow_chart, temp_html_file)
# 使用webshot将HTML转换为PNG图片
webshot(temp_html_file, file = file, vwidth = 800, vheight = 600)
# 清理，删除临时HTML文件
unlink(temp_html_file)
}
)
visibility_state_renameTable <- reactiveVal(FALSE)
visibility_state_renameTable1 <- reactiveVal(FALSE)
# 监听第一个重命名按钮
observeEvent(input$renameNodes, {
visibility_state_renameTable(!visibility_state_renameTable()) # 切换第一个表格的状态
if (visibility_state_renameTable()) {
shinyjs::show("renameTable") # 显示第一个表格
} else {
shinyjs::hide("renameTable") # 隐藏第一个表格
}
})
# 监听第二个重命名按钮
observeEvent(input$renameNodes1, {
visibility_state_renameTable1(!visibility_state_renameTable1()) # 切换第二个表格的状态
if (visibility_state_renameTable1()) {
shinyjs::show("renameTable1") # 显示第二个表格
} else {
shinyjs::hide("renameTable1") # 隐藏第二个表格
}
})
# 初始隐藏两个表格
shinyjs::hide(id = "renameTable")
shinyjs::hide(id = "renameTable1")
generate_multitest_description <- function(alpha_table_data, weight_data) {
weight_data <- rv$data
transfer_description <- ""
for (i in 1:nrow(weight_data)) {
transfers <- c()
for (j in 1:ncol(weight_data)) {
if (!is.na(weight_data[i, j]) && weight_data[i, j] > 0) {
transfers <- c(transfers, sprintf("%s的α传递给H%d", if (weight_data[i, j] == 1) "全部" else paste0(formatC(weight_data[i, j] * 100, format = "f", digits = 2), "%"), j))
}
}
if (length(transfers) > 0) {
transfer_description <- paste0(transfer_description, "对H", i, "进行检验，若拒绝该假设，则将相应", paste(transfers, collapse = "，"), "。")
}
}
transfer_description
}
calculate_possible_alpha_values <- function(initial_alpha_values, weight_data) {
initial_alpha_values <- alpha_table_data()[, "分配的Alpha"]
# 初始化每个假设的可能alpha值列表
possible_alpha_values <- lapply(1:length(initial_alpha_values), function(i) {
c(initial_alpha_values[i]) # 每个假设的初始alpha值作为其可能alpha值的起始点
})
# 遍历权重表来更新alpha值
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) {
# 当Hi假设的alpha值部分或全部传递给Hj
transferred_alpha <- initial_alpha_values[i] * weight_data[i, j] + initial_alpha_values[j]
# 更新Hj的可能alpha值列表
possible_alpha_values[[j]] <- unique(c(possible_alpha_values[[j]], transferred_alpha))
}
}
}
# 合并每个假设的初始alpha值和传递后的alpha值
possible_alpha_values <- lapply(possible_alpha_values, function(alpha_list) {
unique(sort(alpha_list))
})
return(possible_alpha_values)
}
#### 报告总结下载word ######
output$downloadReport <- downloadHandler(
filename = function() {
paste("clinical-report-", Sys.Date(), ".docx", sep="")
},
content = function(file) {
# 创建一个新的Word文档
doc <- read_docx()
# 生成报告内容，此处使用函数来逐部分添加内容到文档
withProgress(message = '生成报告中...', value = 0, {
incProgress(1/6)
# 添加分配总结
doc <- body_add_par(doc, "分配总结：", style = "heading 1")
doc <- body_add_par(doc, paste("在总一类错误为", input$totalAlpha, "的情况下，该试验有", ne$num_endpoints, "个终点。"), style = "Normal")
# 遍历每个终点
lapply(1:ne$num_endpoints, function(i) {
endpoint_alpha <- input[[paste0("endpointAlpha", i)]]
# 终点描述
endpoint_info <- paste("终点", i, "的alpha值为：", format(endpoint_alpha, scientific = FALSE), ".")
if(input[[paste0("midtermAnalysis", i)]]) {
num_analyses <- input[[paste0("midtermCount", i)]]
analysis_method <- input[[paste0("midtermMethod", i)]]
endpoint_info <- paste(endpoint_info, "该终点共进行了", num_analyses, "次分析，", num_analyses - 1, "次期中分析和 1 次最终分析，使用的方法为“", analysis_method, "”。")
}
doc <- body_add_par(doc, endpoint_info, style = "Normal")
if(input[[paste0("subgroup", i)]]) {
num_subgroups <- input[[paste0("numSubgroups", i)]]
doc <- body_add_par(doc, paste("共有", num_subgroups, "个亚组。"), style = "Normal")
lapply(1:num_subgroups, function(j) {
subgroup_alpha <- ne$results$分配的Alpha[ne$results$终点 == i & ne$results$亚组 == j & is.na(ne$results$分析次数)]
subgroup_info <- paste("亚组", j, "的alpha值为：", format(subgroup_alpha, scientific = FALSE))
if(input[[paste0("midtermAnalysis", i, "_", j)]]) {
num_analyses <- input[[paste0("midtermCount", i, "_", j)]]
analysis_method <- input[[paste0("midtermMethod", i, "_", j)]]
subgroup_info <- paste(subgroup_info, "该亚组共进行了", num_analyses, "次分析，", num_analyses - 1, "次期中分析和 1 次最终分析，使用的方法为“", analysis_method, "”。")
}
doc <- body_add_par(doc, subgroup_info, style = "Normal")
})
}
})
# Generate and insert the flowChart image
flowChart <- create_flow_chart(input, ne$num_endpoints, ne$results, ne$analysis_results) # Assuming this returns a visNetwork object
flowChartPath <- tempfile(fileext = ".html")
saveWidget(flowChart, flowChartPath, selfcontained = TRUE)
flowChartImg <- tempfile(fileext = ".png")
webshot(flowChartPath, file = flowChartImg, delay = 2) # Adding delay to ensure the chart is fully rendered
doc <- body_add_img(doc, src = flowChartImg, width = 5.5, height = 3.25)
unlink(c(flowChartPath, flowChartImg)) # Clean up temporary files
incProgress(1/6)
# 添加传递总结
doc <- body_add_par(doc, "传递总结：", style = "heading 1")
transfer_summary <- generate_multitest_description(alpha_table_data, weight_data)
doc <- body_add_par(doc, transfer_summary, style = "Normal")
# Generate and insert the weightBasedFlowChart image
weightBasedFlowChart <- create_flow_chart_with_weights(rv$data, rv$initial_alpha_values) # Assuming this returns a visNetwork object
weightBasedFlowChartPath <- tempfile(fileext = ".html")
saveWidget(weightBasedFlowChart, weightBasedFlowChartPath, selfcontained = TRUE)
weightBasedFlowChartImg <- tempfile(fileext = ".png")
webshot(weightBasedFlowChartPath, file = weightBasedFlowChartImg, delay = 2)
doc <- body_add_img(doc, src = weightBasedFlowChartImg, width = 5.5, height = 3.25)
unlink(c(weightBasedFlowChartPath, weightBasedFlowChartImg)) # Clean up temporary files
incProgress(1/6)
# 添加组合总结
doc <- body_add_par(doc, "组合总结：", style = "heading 1")
alpha_values_list <- calculate_possible_alpha_values(rv$initial_alpha_values, rv$data)
lapply(1:length(alpha_values_list), function(i) {
alpha_values_str <- paste(lapply(alpha_values_list[[i]], function(x) format(x, scientific = FALSE)), collapse = "、")
hypothesis_info <- paste("假设H", i, "的可能alpha值有：", alpha_values_str)
doc <- body_add_par(doc, hypothesis_info, style = "Normal")
})
incProgress(1/6)
# 保存Word文档
print(doc, target = file)
})
}
)