谱系图展示品种信息

library(visNetwork)library(shiny)# 创建树形数据create_tree_data<-function(){nodes<- data.frame(id=1:10, label=paste0("品种", LETTERS[1:10]), title=paste0("品种", LETTERS[1:10],"<br>","点击查看详细信息"), group=sample(c("本地","引进","杂交"),10, replace=TRUE), value=1:10)edges<- data.frame(from=c(1,1,2,2,3,3,4,4,5), to=c(2,3,4,5,6,7,8,9,10), label=c("父本","母本","父本","母本","父本","母本","父本","母本","父本"))return(list(nodes=nodes, edges=edges, root=1))}ui<- fluidPage(titlePanel("品种谱系树形图 - 可自由拖拽"), sidebarLayout(sidebarPanel(width=3, selectInput("layout","布局方式:", choices=c("自由布局"="free","树形布局"="hierarchical","力导向布局"="force"), selected="free"), conditionalPanel(condition="input.layout == 'hierarchical'", selectInput("direction","树图方向:", choices=c("上下"="UD","左右"="LR"), selected="UD")), checkboxInput("physics","启用物理引擎", TRUE), checkboxInput("dragNodes","允许拖拽节点", TRUE), actionButton("reset","重置位置"), hr(), h5("操作提示:"), tags$ul(tags$li("鼠标拖动: 移动节点"), tags$li("鼠标滚轮: 缩放"), tags$li("双击空白处: 重置视图"), tags$li("Ctrl+拖拽: 框选多个节点"))), mainPanel(width=9, visNetworkOutput("tree_plot", height="700px"))), fluidRow(column(12, h4("节点详细信息"), uiOutput("variety_info"), verbatimTextOutput("tree_structure"))))server<- function(input, output, session){tree_data<- reactiveVal(create_tree_data())output$tree_plot<- renderVisNetwork({data<- tree_data()# 根据选择的布局方式配置vis_obj<- visNetwork(data$nodes, data$edges)%>% visOptions(highlightNearest=list(enabled=TRUE, degree=1, hover=TRUE), nodesIdSelection=TRUE, manipulation=list(enabled=TRUE, addNode=FALSE, addEdge=FALSE, editNode=FALSE, editEdge=FALSE, deleteNode=FALSE, deleteEdge=FALSE))%>% visInteraction(dragNodes=input$dragNodes, dragView=TRUE, zoomView=TRUE, navigationButtons=TRUE)%>% visPhysics(enabled=input$physics, stabilization=TRUE)%>% visEvents(select="function(nodes) { Shiny.onInputChange('selected_node', nodes.nodes[0]); }", dragEnd="function(params) { if(params.nodes.length > 0) { Shiny.onInputChange('node_moved', {node: params.nodes[0], timestamp: new Date().getTime()}); } }")# 根据布局选择应用不同的布局配置if(input$layout=="hierarchical"){vis_obj<- vis_obj %>% visHierarchicalLayout(direction=input$direction, sortMethod="directed", nodeSpacing=120, levelSeparation=200, shakeTowards="roots")}elseif(input$layout=="force"){vis_obj<- vis_obj %>% visLayout(randomSeed=123)%>% visIgraphLayout(layout="layout_with_kk",type="full")}else{# 自由布局vis_obj<- vis_obj %>% visLayout(improvedLayout=FALSE, randomSeed=NULL)%>% visPhysics(solver="repulsion", repulsion=list(nodeDistance=200, centralGravity=0.1, springLength=200, springConstant=0.05, damping=0.09))}vis_obj})# 重置视图observeEvent(input$reset,{# 重新生成数据，这样节点位置会重置tree_data(create_tree_data())})# 节点移动事件observeEvent(input$node_moved,{req(input$node_moved)message(paste("节点移动:", input$node_moved$node))})output$tree_structure<- renderPrint({data<- tree_data()cat("谱系树结构:\n")cat("===========\n")cat("根节点: 品种A (ID: 1)\n")cat("节点总数:", nrow(data$nodes),"\n")cat("边总数:", nrow(data$edges),"\n\n")# 构建树形文本edges_df<- data$edges# 按父节点分组edges_by_parent<- split(edges_df$to, edges_df$from)# 递归打印树结构print_tree<- function(node_id, prefix=""){node_label<- data$nodes$label[data$nodes$id==node_id]children<- edges_by_parent[[as.character(node_id)]]if(is.null(children)){cat(prefix,"└─ ", node_label," (ID: ", node_id,")\n", sep="")}else{if(node_id==1){cat(prefix, node_label," (ID: ", node_id,", 根节点)\n", sep="")}else{cat(prefix,"├─ ", node_label," (ID: ", node_id,")\n", sep="")}for(iinseq_along(children)){child<- children[i]is_last<- i==length(children)new_prefix<- ifelse(node_id==1,"", paste0(prefix,"│ "))child_prefix<- ifelse(is_last,"└─ ","├─ ")print_tree(child, paste0(new_prefix, child_prefix))}}}print_tree(1)})output$variety_info<- renderUI({req(input$selected_node)node_id<- as.numeric(input$selected_node)node_data<- tree_data()$nodes[tree_data()$nodes$id==node_id,]# 获取父节点和子节点信息edges<- tree_data()$edges# 父节点parents<- edges$from[edges$to==node_id]parent_labels<-if(length(parents)>0){sapply(parents, function(p)tree_data()$nodes$label[tree_data()$nodes$id==p])}else{"无"}# 子节点children<- edges$to[edges$from==node_id]child_labels<-if(length(children)>0){sapply(children, function(c)tree_data()$nodes$label[tree_data()$nodes$id==c])}else{"无"}tagList(h3(node_data$label), hr(), h4("基本信息:"), tags$table(class="table table-bordered", tags$tr(tags$td(strong("ID:")), tags$td(node_id)), tags$tr(tags$td(strong("类型:")), tags$td(node_data$group)), tags$tr(tags$td(strong("父本:")), tags$td(paste(parent_labels, collapse=", "))), tags$tr(tags$td(strong("子代:")), tags$td(paste(child_labels, collapse=", ")))), h4("品种特性:"), tags$ul(tags$li(paste("类别:", node_data$group)), tags$li("来源: 中国农科院"), tags$li("培育年份: 2018"), tags$li("平均产量: 4500 kg/ha"), tags$li("抗病性: 高抗白叶枯病")))})}shinyApp(ui=ui, server=server)