问题描述
不久前,我使用 data.tree 创建了一个图表,显示了动物群中动物之间的关系。除了动物名称之外,该图表还包括信息,例如它在畜群中的排名。这是输出的示例。
我现在正在尝试将其转变为 Shiny 应用程序,以便您可以从下拉列表中选择一种动物以显示其家族。我已经成功地完成了这项工作,但是,这棵树缺少有关该动物的样式和其他信息。这是一个与前一个比较的示例,没有任何样式。
library(data.tree)
library(dplyr)
#data to generate the tree
TreeInfo <- tribble(~Animal,~pathString,~BW,~Current,~Sex,"CLQG-04-7",148,"No","F","JTGD-08-106","CLQG-04-7/JTGD-08-106",166,"Yes","JTGD-10-73","CLQG-04-7/JTGD-10-73",147,"DLCQ-13-150","CLQG-04-7/JTGD-10-73/DLCQ-13-150",211,"DLCQ-14-48","CLQG-04-7/JTGD-10-73/DLCQ-14-48",167,"DLCQ-15-168","CLQG-04-7/JTGD-08-106/DLCQ-15-168",134,"DLCQ-15-153","CLQG-04-7/JTGD-10-73/DLCQ-15-153","DLCQ-17-117","CLQG-04-7/JTGD-10-73/DLCQ-14-48/DLCQ-17-117",216,"DLCQ-17-94","CLQG-04-7/JTGD-10-73/DLCQ-13-150/DLCQ-17-94",215,"DLCQ-18-126","CLQG-04-7/JTGD-10-73/DLCQ-15-153/DLCQ-18-126",194,"DLCQ-19-170","CLQG-04-7/JTGD-08-106/DLCQ-19-170",213,"DLCQ-19-62","CLQG-04-7/JTGD-10-73/DLCQ-13-150/DLCQ-17-94/DLCQ-19-62",246,"F")
TreeInfo2 <- as.Node(TreeInfo)
#Formatting the tree
GetNodeShape <- function(TreeInfo2) {switch(TreeInfo2$Sex,`F` = "Box",`M` = "oval")}
GetNodeLabel <- function(TreeInfo2) {switch(TreeInfo2$Current,No = paste0("*",TreeInfo2$Animal,"\n BW ",TreeInfo2$BW),Yes = paste0(TreeInfo2$Animal,TreeInfo2$BW) )}
TreeInfo2$Do(function(TreeInfo2) SetNodeStyle(TreeInfo2,fontname = 'helvetica',label = GetNodeLabel,shape = GetNodeShape,fontcolor = "brown4",inherit = FALSE),filterFun = function(TreeInfo2) is.null(TreeInfo2$BW) == FALSE && TreeInfo2$BW >= 200)
TreeInfo2$Do(function(TreeInfo2) SetNodeStyle(TreeInfo2,fontcolor = "blue",filterFun = function(TreeInfo2) is.null(TreeInfo2$BW) == FALSE && TreeInfo2$BW < 200)
TreeInfo2$Do(function(TreeInfo2) SetNodeStyle(TreeInfo2,label = TreeInfo2$Animal,filterFun = function(TreeInfo2) is.null(TreeInfo2$BW) == TRUE)
SetGraphStyle(TreeInfo2,rankdir = "LR")
plot(TreeInfo2)
在 Shiny 应用程序中,TreeInfo 和 TreeInfo2 是反应性的(由从下拉列表中选择的动物决定,大约 3000 只动物)所以我知道我需要将它们更改为 TreeInfo2()。但是,它不会让我在代码的函数部分输入它,即 function(TreeInfo2()) 给出一个错误,说它期望 RPAREN。除此之外,我已经尝试了以下代码的多种不同组合,但我不确定在哪里,但 reactive({})
位 - 我只知道它需要它们,否则它不会运行。
TreeInfo2 <- reactive({as.Node(TreeInfo())})
reactive({GetNodeShape <- function(TreeInfo2) {switch(TreeInfo2()$Sex,`M` = "oval")}})
reactive({GetNodeLabel <- function(TreeInfo2) {switch(TreeInfo2()$Current,TreeInfo2()$Animal,TreeInfo2()$BW),Yes = paste0(TreeInfo2()$Animal,TreeInfo2()$BW) )}})
reactive({TreeInfo2()$Do(function(TreeInfo2) SetNodeStyle(TreeInfo2(),filterFun = function(TreeInfo2) is.null(TreeInfo2()$BW) == FALSE && TreeInfo2()$BW >= 200)})
reactive({TreeInfo2()$Do(function(TreeInfo2) SetNodeStyle(TreeInfo2(),filterFun = function(TreeInfo2) is.null(TreeInfo2()$BW) == FALSE && TreeInfo2()$BW < 200)})
reactive({TreeInfo2()$Do(function(TreeInfo2) SetNodeStyle(TreeInfo2(),label = TreeInfo2()$Animal,filterFun = function(TreeInfo2) is.null(TreeInfo2()$BW) == TRUE)})
reactive({SetGraphStyle(TreeInfo2(),rankdir = "LR")})
即使将它简化到最后一个 SetGraphStyle
步骤以从垂直变为水平似乎也没有效果,这让我想知道我是否将这个块放在正确的位置,也许“样式”代码应该放在其他地方,例如在 Shiny 服务器的输出部分,目前是这样的:
output$Tree <- renderGrViz({grViz(DiagrammeR::generate_dot(ToDiagrammergraph(TreeInfo2())))})}
任何帮助将不胜感激。谢谢!
解决方法
如果它以后对任何人有帮助,这里有一个有效的解决方案。将代码的格式化部分移至 output$Tree 步骤。这修复了格式,但随后破坏了每个框中出现的名称。这是通过一步包装反应部分来解决的。
TreeInfo2 <- reactive({
###code here to select the animal to display
TreeInfo2 <- as.Node(TreeInfo)
return(TreeInfo2)})
output$Tree <- renderGrViz({
GetNodeShape <- function(TreeInfo2) {switch(TreeInfo2$Sex,`F` = "box",`M` = "oval")}
GetNodeLabel <- function(TreeInfo2) {switch(TreeInfo2$Current,No = paste0("*",TreeInfo2$Animal,"\n BW ",TreeInfo2$BW),Yes = paste0(TreeInfo2$Animal,TreeInfo2$BW) )}
TreeInfo2()$Do(function(TreeInfo2) SetNodeStyle(TreeInfo2,fontname = 'helvetica',label = GetNodeLabel,shape = GetNodeShape,fontcolor = "brown4",inherit = FALSE),filterFun = function(TreeInfo2) is.null(TreeInfo2$BW) == FALSE && TreeInfo2$BW >= 200)
TreeInfo2()$Do(function(TreeInfo2) SetNodeStyle(TreeInfo2,fontcolor = "blue",filterFun = function(TreeInfo2) is.null(TreeInfo2$BW) == FALSE && TreeInfo2$BW < 200)
TreeInfo2()$Do(function(TreeInfo2) SetNodeStyle(TreeInfo2,label = TreeInfo2$Animal,filterFun = function(TreeInfo2) is.null(TreeInfo2$BW) == TRUE)
SetGraphStyle(TreeInfo2(),rankdir = "HR")
grViz(DiagrammeR::generate_dot(ToDiagrammeRGraph(TreeInfo2())))})}