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

Question

First post so hopefully I've remembered to include everything and have used the right terminology!

A while ago I used data.tree to create a diagram showing the relationships between animals in a herd. The diagram includes info in addition to the animal name, such as it's ranking in the herd. Here is an example of the output.

I am now trying to turn this into a Shiny app so you can select an animal from a dropdown list to display its family. I've got this to work successfully, however, the tree is missing the styling and additional info about the animal. Here's an example to compare to the previous one, absent of any styling.

This is the the code from the original R script that produces the desired formatting.

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)

In the Shiny app TreeInfo and TreeInfo2 are reactive (determined by the animal selected from the dropdown list, approx 3000 animals) so I known I need to change these to TreeInfo2(). However, it won't let me enter this in the function part of the code, ie function(TreeInfo2()) gives an error saying it expected RPAREN. Apart from that I have tried lots of different combinations of the code below but I'm not really sure where to but the reactive({}) bits - I just know it needs them, otherwise it doesn't run.

  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")})

Even simplifying it right down to just the last SetGraphStyle step to change from vertical to horizontal doesn't seem to have an effect, which makes me wonder if I have got this chunk in the right place and perhaps the 'styling' code should go elsewhere, for example in the output part of the Shiny server, which currently is this:

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

Any help would be greatly appreciated. Thanks!

Answer 1

In case it helps anyone later, here is a solution that works. Move the formatting part of the code to the output$Tree step. This fixed the formatting but it then broke the names appearing in each box. This was fixed by wrapping the reactive section in one step.

 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())))})}