我想根据用户提供的输入值来过滤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,1:3,4:6),
)
#' 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)
发布于 2021-01-16 08:48:36
'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",
children = list(
list(
text = "1"
),
list(
text = "2"
),
list(
text = "3"
)
)
),
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)
https://stackoverflow.com/questions/65740083
复制相似问题