AdeelK93
[feature requested] Alternative node label ? (not tooltipHtml).
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.
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?
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.)
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
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.
- 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"
)
- 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 :)
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 :)
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
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.
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 dataframedf - 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 beforehtmlwidgets::createWidget()(withlibrary(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)