如何在闪亮的应用程序中更改 data.tree 的节点形状和标签

Question

首先 post 希望我记得包括所有内容并使用了正确的术语！

不久前，我使用 data.tree 创建了一个图表，显示了畜群中动物之间的关系。该图包括动物名称以外的信息，例如它在牛群中的排名。这是输出示例。

我现在正尝试将它变成一个闪亮的应用程序，这样您就可以 select 下拉列表中的动物来显示它的家庭。我已经成功地完成了这项工作，但是，这棵树缺少有关该动物的样式和其他信息。这是一个与上一个示例进行比较的示例，没有任何样式。

这是生成所需格式的原始 R 脚本的代码。

library(data.tree)
library(dplyr)

#data to generate the tree
TreeInfo <- tribble(~Animal, ~pathString, ~BW, ~Current, ~Sex,
"CLQG-04-7","CLQG-04-7",                                               148,"No", "F",
"JTGD-08-106","CLQG-04-7/JTGD-08-106",                                 166,"Yes","F",
"JTGD-10-73", "CLQG-04-7/JTGD-10-73",                                  147,"No", "F",
"DLCQ-13-150","CLQG-04-7/JTGD-10-73/DLCQ-13-150",                      211,"Yes","F",
"DLCQ-13-150","CLQG-04-7/JTGD-10-73/DLCQ-13-150",                      211,"Yes","F",
"DLCQ-14-48", "CLQG-04-7/JTGD-10-73/DLCQ-14-48",                       167,"No", "F",
"DLCQ-14-48", "CLQG-04-7/JTGD-10-73/DLCQ-14-48",                       167,"No", "F",
"DLCQ-15-168","CLQG-04-7/JTGD-08-106/DLCQ-15-168",                     134,"Yes","F",
"DLCQ-15-168","CLQG-04-7/JTGD-08-106/DLCQ-15-168",                     134,"Yes","F",
"DLCQ-15-153","CLQG-04-7/JTGD-10-73/DLCQ-15-153",                      148,"Yes","F",
"DLCQ-15-153","CLQG-04-7/JTGD-10-73/DLCQ-15-153",                      148,"Yes","F",
"DLCQ-17-117","CLQG-04-7/JTGD-10-73/DLCQ-14-48/DLCQ-17-117",           216,"No", "F",
"DLCQ-17-94", "CLQG-04-7/JTGD-10-73/DLCQ-13-150/DLCQ-17-94",           215,"No", "F",
"DLCQ-18-126","CLQG-04-7/JTGD-10-73/DLCQ-15-153/DLCQ-18-126",          194,"Yes","F",
"DLCQ-18-126","CLQG-04-7/JTGD-10-73/DLCQ-15-153/DLCQ-18-126",          194,"Yes","F",
"DLCQ-19-170","CLQG-04-7/JTGD-08-106/DLCQ-19-170",                     213,"Yes","F",
"DLCQ-19-170","CLQG-04-7/JTGD-08-106/DLCQ-19-170",                     213,"Yes","F",
"DLCQ-19-62", "CLQG-04-7/JTGD-10-73/DLCQ-13-150/DLCQ-17-94/DLCQ-19-62",246,"Yes","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,"\n BW ",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, fontname = 'helvetica', label = GetNodeLabel, shape = GetNodeShape, fontcolor = "blue",  inherit = FALSE), 
             filterFun = function(TreeInfo2)  is.null(TreeInfo2$BW) == FALSE &&  TreeInfo2$BW < 200)
TreeInfo2$Do(function(TreeInfo2) SetNodeStyle(TreeInfo2, fontname = 'helvetica', label = TreeInfo2$Animal, shape = GetNodeShape, fontcolor = "blue",  inherit = FALSE), 
             filterFun = function(TreeInfo2)  is.null(TreeInfo2$BW) == TRUE)
SetGraphStyle(TreeInfo2, rankdir = "LR")

plot(TreeInfo2)

在闪亮的应用程序中，TreeInfo 和 TreeInfo2 是反应性的（由下拉列表中的动物 select 决定，大约 3000 只动物）所以我知道我需要将它们更改为 TreeInfo2()。但是，它不会让我在代码的函数部分输入这个，即 function(TreeInfo2()) 给出一个错误，说它需要 RPAREN。除此之外，我尝试了下面代码的许多不同组合，但我真的不确定 reactive({}) 位以外的位置 - 我只知道它需要它们，否则它不需要运行。

  TreeInfo2 <- reactive({as.Node(TreeInfo())})
  
  reactive({GetNodeShape <- function(TreeInfo2) {switch(TreeInfo2()$Sex, `F` = "box", `M` = "oval")}})
  reactive({GetNodeLabel <- function(TreeInfo2) {switch(TreeInfo2()$Current, No = paste0("*",TreeInfo2()$Animal,"\n BW " ,TreeInfo2()$BW), Yes = paste0(TreeInfo2()$Animal,"\n BW ",TreeInfo2()$BW) )}})
  reactive({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)})
  reactive({TreeInfo2()$Do(function(TreeInfo2) SetNodeStyle(TreeInfo2(), fontname = 'helvetica', label = GetNodeLabel, shape = GetNodeShape, fontcolor = "blue",  inherit = FALSE), 
               filterFun = function(TreeInfo2)  is.null(TreeInfo2()$BW) == FALSE &&  TreeInfo2()$BW < 200)})
  reactive({TreeInfo2()$Do(function(TreeInfo2) SetNodeStyle(TreeInfo2(), fontname = 'helvetica', label = TreeInfo2()$Animal, shape = GetNodeShape, fontcolor = "blue",  inherit = FALSE), 
               filterFun = function(TreeInfo2)  is.null(TreeInfo2()$BW) == TRUE)})
  reactive({SetGraphStyle(TreeInfo2(), rankdir = "LR")})

即使将它简化到最后 SetGraphStyle 一步，从垂直变为水平似乎也没有效果，这让我想知道我是否在正确的位置得到了这个块并且也许 'styling' 代码应该放在其他地方，例如在 Shiny 服务器的输出部分，目前是这样的：

output$Tree <- renderGrViz({grViz(DiagrammeR::generate_dot(ToDiagrammeRGraph(TreeInfo2())))})}

如有任何帮助，我们将不胜感激。谢谢！

Answer 1

如果以后对任何人有帮助，这里有一个可行的解决方案。将代码的格式化部分移至 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,"\n BW ",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, fontname = 'helvetica', label = GetNodeLabel, shape = GetNodeShape, fontcolor = "blue",  inherit = FALSE), 
                   filterFun = function(TreeInfo2)  is.null(TreeInfo2$BW) == FALSE &&  TreeInfo2$BW < 200)
    TreeInfo2()$Do(function(TreeInfo2) SetNodeStyle(TreeInfo2, fontname = 'helvetica', label = TreeInfo2$Animal, shape = GetNodeShape, fontcolor = "blue",  inherit = FALSE), 
                   filterFun = function(TreeInfo2)  is.null(TreeInfo2$BW) == TRUE)
    SetGraphStyle(TreeInfo2(), rankdir = "HR")
    
    
    grViz(DiagrammeR::generate_dot(ToDiagrammeRGraph(TreeInfo2())))})}

如何在闪亮的应用程序中更改 data.tree 的节点形状和标签

How to change node shapes and labels of a data.tree in a shiny app

r

shiny

diagrammer

data.tree