问题描述
我想根据用户提供的输入值过滤 shinytree 中的节点。我有一个初步的尝试,但问题是输入后树不保持状态,例如打开/关闭节点或选定节点。例如,在下面的示例代码中,假设我展开了 1-3a 和 4-6,并选择了值 3 和 5。
如果我将滑块移动到 2,这应该从 1-3a 和 1-3b 中删除 1 个条目,我想保持 1-3a 和 4-6 展开,并检查值 3-6。但是,我每次都是从头开始创建树,因此所有状态都丢失了。
有没有办法在闪亮的树中显示/隐藏节点以保持状态?
library(shiny)
library(shinytree)
library(dplyr)
dat <- tibble(
grp=rep(c("1-3a","1-3b","4-6"),each=3),leaf=c(1:3,1:3,4:6),val=c(1:3,)
#' Recursively walks down the columns of a dataframe making nested groups
listTree <- function(dat) {
if(ncol(dat) > 2) {
x <- dat %>% nest(data=-1)
lst <- as.list(x[[2]])
names(lst) <- x[[1]]
lst %>% map(listTree)
} else if(ncol(dat)==2) {
lst<-as.list(dat[[2]])
names(lst)<-dat[[1]]
return(lst)
} else if(ncol<2) {
stop('ERROR')
}
}
ui <- fluidPage(
p('Filter nodes < selected value'),sliderInput("num","Value",min = 1,max = 6,value = 1),shinytree("tree",checkBox=TRUE)
)
server <- function(input,output,session) {
datr <- reactive({
dat %>% filter(val >= input$num)
})
output$tree <- renderTree({listTree(datr())})
}
shinyApp(ui,server)
解决方法
'jsTreeR' package 类似于 'shinyTree' 包,但它允许更多的可能性。以下是实现您想要的目标的方法:
library(jsTreeR)
library(shiny)
library(htmlwidgets)
library(magrittr)
onrender <- c(
"function(el,x) {"," Shiny.addCustomMessageHandler('hideNodes',function(threshold) {"," var tree = $.jstree.reference(el.id);"," var json = tree.get_json(null,{flat: true});"," for(var i = 0; i < json.length; i++) {"," if(tree.is_leaf(json[i].id) && json[i].text <= threshold) {"," tree.hide_node(json[i].id);"," } else {"," tree.show_node(json[i].id);"," }"," }"," });","}"
)
nodes <- list(
list(
text = "1-3a",children = list(
list(
text = "1"
),list(
text = "2"
),list(
text = "3"
)
)
),list(
text = "1-3b",list(
text = "4-6",children = list(
list(
text = "4"
),list(
text = "5"
),list(
text = "6"
)
)
)
)
ui <- fluidPage(
br(),fluidRow(
column(
3,jstreeOutput("tree")
),column(
9,sliderInput(
"threshold",label = "Threshold",min = 0,max = 10,value = 0,step = 1
)
)
)
)
server <- function(input,output,session){
output[["tree"]] <- renderJstree({
jstree(nodes,checkboxes = TRUE) %>% onRender(onrender)
})
observeEvent(input[["threshold"]],{
session$sendCustomMessage("hideNodes",input[["threshold"]])
})
}
shinyApp(ui,server)