[feature requested] Alternative node label ? (not tooltipHtml).

philibe commented 6 years ago

Hello,

Thank you for your package and for the very good examples. I have seen tooltipHtml which is useful for additional informations. But I have not found or understood information to display a non technical label information.

For example I have many nodes with technical reference id used to build the tree(parent id, child id), but I would like to display simple name in place of technical id.

general examples :

a tree of people with same first name with different id.

my issue: Many different items but with node too much not human readable and category name more readable.

I know that tooltipHtml can make the job, but we have to click on it to see it.

AdeelK93 commented 6 years ago

What do you mean by technical label? Do you mean that your labels are non-unique, as in two of your nodes are distinct but share a name?

philibe commented 6 years ago

Yes : my labels are non uniques.

Here is two example.s (in fact in my real probleme, Id are unique technical Id, and label are non unique human label or category for example)

org <- data.frame(
    ManagerId = c(
        NA, 1, 1,2
    ),
    EmployeeId = c(
        1,2,3,4
    ),
    ManagerLabel = c(
     NA, "Ana", "Ana", "Bill"
    ),
    EmployeeLabel = c(
  "Ana", "Bill", "Larry", "Ana"  # The 2nd Ana is not the same
    )
)

edit An other example would be to display title in the nodes of the tree ( from the original datas of the example of org.)

AdeelK93 commented 6 years ago

If the two Ana's are unique in real life but identical on the chart, how is a user supposed to be able to tell them apart? I'd suggest perhaps prefixing the name with your uid, or coming up with a different way to distinguish between the two Ana's, if they are indeed unique

philibe commented 6 years ago

You have a good suggestion but it's only a workaround :-p

For a better example take her title; or take her gender. For the tree, the technical id is good, but for the human I prefer to see her title or her gender. And if he wants its details, he sees this technical id in the tooltipHtml. But for tree It's more usable to not have technical id but its category.

In my real case, I have unique ids too much technicals to be displayed, and for this reason I would prefer to display its category of production than its id of production.

My feature requested is only to be able to split displayed business informations, and technical informations of the network tree.

Like this. 1) before my request

org$tooltip <-
      paste0(
        ifelse(!is.na(org$EmployeeLabel ) ,paste0("<br>Name of employee:", org$EmployeeLabel ),"")
       )
collapsibleTreeNetwork(
        # 1st col : root    ie ManagerId       
        # 2nd col: children ie EmployeeId 
        df,
        tooltipHtml = "tooltip"
 )

2) my wish

org$tooltip <-
      paste0(
        ifelse(!is.na(org$EmployeeId ) ,paste0("<br>Social Security Number:", org$EmployeeId ),"")
       )
collapsibleTreeNetwork(
        # 1st col : root    ie ManagerId (the same before my wish)      
        # 2nd col: children ie EmployeeId (the same before my wish)     
        df,
        tooltipHtml = "tooltip",
       DisplayedAtNode ="EmployeeLabel" # or the column number of EmployeeLabel
 )

edit 3) my wish closer of my real problem

org$tooltip <-
      paste0(
        ifelse(!is.na(org$Processld ) ,paste0("<br>ProcessId :", org$Processld ),"")
        # example L12345, M645123,X12345. It's not very human readable.
       )
collapsibleTreeNetwork(
        # 1st col : root    ie Processld (the same before my wish)      
        # 2nd col: children ie ProcessChildrenId(the same before my wish)     
        df,
        tooltipHtml = "tooltip",
       DisplayedAtNode ="Process" # or the column number of Process name
       # example : Melting, Gasify, Liquefy
 )

Thank you :)

philibe commented 6 years ago

I've tried to replace 2 secondsname by tooltip in collapsibleTree.js : it's this sort of business displayed datas I wish in other variable than tooltip (in simple text ...or html).

But obviously it's more complex :)

Have a good day :)

lelouar commented 2 years ago

Hi, I have the same request, the goal is to simplify the node names of the tree.

I think we just want an option to use an extra column to display nodes name. Is it possible?

thx

AdeelK93 commented 2 years ago

Honestly I haven't really worked on this in a couple years. You can look at the collapsibleTreeNetwork function, it gives you a bit more control over that sort of stuff.

philibe commented 1 year ago

Here is a collapsibleTreeNetwork() modified after I need recently again to modify my network, and after I read your last comment, and after five years and half :)

I left open this issue because it's a quick solution tested only for my use case and it's not a PR.

quick solution

collapsibleTree::collapsibleTreeNetwork() copy-pasted except some lines :

added : argument node_name_displayed: name of field within the dataframe df
updated rightLabelVector <-node$Get(node_name_displayed, filterFun = function(x) x$level == node$height)
added : AllLabelVector <-node$Get(node_name_displayed)
added after x <- list(data = data, options = options) and before htmlwidgets::createWidget() (with library(rrapply)):

  x$data <- rrapply(x$data, 
                    condition = function(x, .xname) identical(.xname, "name"),  
                    f = function(x) x=AllLabelVector[[x]],
                    classes = "character", 
                    how = "replace"
  )

collapsibleTreeNetworkWithAnOtherName<-function (df, inputId = NULL, attribute = "leafCount", aggFun = sum, 
                                                 fill = "lightsteelblue", linkLength = NULL, fontSize = 10, 
                                                 tooltip = TRUE, tooltipHtml = NULL, nodeSize = NULL, collapsed = TRUE, 
                                                 zoomable = TRUE, width = NULL, height = NULL,
                                                 # added node_name_displayed : name of field within df
                                                 node_name_displayed
) 
{
  nodeAttr <- c("leafCount", "count")
  if (!is.data.frame(df)) 
    stop("df must be a data frame")
  if (sum(is.na(df[, 1])) != 1) 
    stop("there must be 1 NA for root in the first column")
  if (!is.character(fill)) 
    stop("fill must be a either a color or column name")
  if (!(attribute %in% c(colnames(df), nodeAttr))) 
    stop("attribute column name is incorrect")
  if (!is.null(tooltipHtml)) 
    if (!(tooltipHtml %in% colnames(df))) 
      stop("tooltipHtml column name is incorrect")
  if (!is.null(nodeSize)) 
    if (!(nodeSize %in% c(colnames(df), nodeAttr))) 
      stop("nodeSize column name is incorrect")
  root <- df[is.na(df[, 1]), ]
  tree <- df[!is.na(df[, 1]), ]
  if (nrow(df) == 1) {
    root[1, 1] <- "Fake"
    node <- data.tree::FromDataFrameNetwork(root)
    node <- node$children[[1]]
    collapsed <- FALSE
  }
  else {
    node <- data.tree::FromDataFrameNetwork(tree)
  }
  rootAttr <- root[-(1:2)]
  Map(function(value, name) node[[name]] <- value, rootAttr, 
      names(rootAttr))
  leftMargin <- nchar(node$name)

  # was:  rightLabelVector <- node$Get("name", filterFun = function(x) x$level ==  node$height)
  rightLabelVector <-node$Get(node_name_displayed, filterFun = function(x) x$level == node$height)
  #  added
  AllLabelVector  <-node$Get(node_name_displayed)

  if (is.null(rightLabelVector)) 
    rightLabelVector <- ""
  rightMargin <- max(sapply(rightLabelVector, nchar))
  options <- list(hierarchy = 1:node$height, input = inputId, 
                  attribute = attribute, linkLength = linkLength, fontSize = fontSize, 
                  tooltip = tooltip, collapsed = collapsed, zoomable = zoomable, 
                  margin = list(top = 20, bottom = 20, left = (leftMargin * 
                                                                 fontSize/2) + 25, right = (rightMargin * fontSize/2) + 
                                  25))
  jsonFields <- NULL
  if (fill %in% colnames(df)) {
    node$Do(function(x) x$fill <- x[[fill]])
    jsonFields <- c(jsonFields, "fill")
  }
  else {
    options$fill <- fill
  }
  if (tooltip & is.null(tooltipHtml)) {
    if (is.numeric(df[[attribute]]) & substitute(aggFun) != 
        "identity") {
      t <- data.tree::Traverse(node, "pre-order")
      data.tree::Do(t, function(x) {
        x$WeightOfNode <- data.tree::Aggregate(x, attribute, 
                                               aggFun)
        x$WeightOfNode <- prettyNum(x$WeightOfNode, big.mark = ",", 
                                    digits = 3, scientific = FALSE)
      })
    }
    else {
      node$Do(function(x) x$WeightOfNode <- x[[attribute]])
    }
    jsonFields <- c(jsonFields, "WeightOfNode")
  }
  if (tooltip & !is.null(tooltipHtml)) {
    node$Do(function(x) x$tooltip <- x[[tooltipHtml]])
    jsonFields <- c(jsonFields, "tooltip")
  }
  if (!is.null(nodeSize)) {
    scaleFactor <- 10/data.tree::Aggregate(node, nodeSize, 
                                           stats::median)
    t <- data.tree::Traverse(node, "pre-order")
    data.tree::Do(t, function(x) {
      x$SizeOfNode <- data.tree::Aggregate(x, nodeSize, 
                                           sum)
      x$SizeOfNode <- round(sqrt(x$SizeOfNode * scaleFactor) * 
                              pi, 2)
    })
    options$margin$left <- options$margin$left + node$SizeOfNode - 
      10
    jsonFields <- c(jsonFields, "SizeOfNode")
  }
  if (is.null(jsonFields)) 
    jsonFields <- NA
  data <- data.tree::ToListExplicit(node, unname = TRUE, keepOnly = jsonFields)
  x <- list(data = data, options = options)
  # added
  x$data <- rrapply(x$data, 
                    condition = function(x, .xname) identical(.xname, "name"),  
                    f = function(x) x=AllLabelVector[[x]],
                    classes = "character", 
                    how = "replace"
  )

  htmlwidgets::createWidget("collapsibleTree", x, width = width, 
                            height = height, htmlwidgets::sizingPolicy(viewer.padding = 0))
}

example

Example from the doc with collapsibleTreeNetworkWithAnOtherName():

org <- data.frame(
    Manager = c(
        NA, "Ana", "Ana", "Bill", "Bill", "Bill", "Claudette", "Claudette", "Danny",
        "Fred", "Fred", "Grace", "Larry", "Larry", "Nicholas", "Nicholas"
    ),
    Employee = c(
        "Ana", "Bill", "Larry", "Claudette", "Danny", "Erika", "Fred", "Grace",
        "Henri", "Ida", "Joaquin", "Kate", "Mindy", "Nicholas", "Odette", "Peter"
    ),
    Title = c(
        "President", "VP Operations", "VP Finance", "Director", "Director", "Scientist",
        "Manager", "Manager", "Jr Scientist", "Operator", "Operator", "Associate",
        "Analyst", "Director", "Accountant", "Accountant"
    )
)

Modified from the doc to use node_name_displayed argument in collapsibleTreeNetworkWithAnOtherName():

org <- org %>% mutate (mylabel = paste0(Employee,"-",Title))

collapsibleTreeNetworkWithAnOtherName(org, node_name_displayed="mylabel", collapsed = FALSE)

collapsibleTreeNetworkWithAnOtherName

AdeelK93 / collapsibleTree

[feature requested] Alternative node label ? (not tooltipHtml). #31

quick solution

example