我的愿景是拥有一个选择器,用户可以单击该组以选择该组中的所有项目。例如,请参阅this
当您单击输入框X2或X4时,我希望用户可以单击“西部”以选择加利福尼亚和华盛顿。
理想情况下,我希望用户能够选择多个区域,并能够自定义他们的选择(例如,选择“西部”区域并查看一些数据。然后取消选择“华盛顿”以专注于“加利福尼亚”,并查看更多数据。
我在想,如果不可能以一种简单的方式做到这一点,那么我应该只将区域作为选择,并在用户选择区域后使用updateSelectInput()更新所选值。
谢谢您的帮助。
答案 0 :(得分:2)
使用selectizeInput
的Afaik,您将不得不依赖多个输入的嵌套/相关选择来获得与预期行为类似的东西。
一旦走向分层选择,我真的很喜欢将库(d3Tree)作为替代方法。 这是d3Tree示例之一的稍作修改的版本(适应您的状态链接):
library(reshape2)
library(shiny)
library(stringr)
library(DT)
library(plyr)
library(dplyr)
library(d3Tree)
library(datasets)
us.states <- data.frame(state.region, state.division, state.name, state.area)
m=us.states%>%mutate(NEWCOL=NA)%>%distinct
ui <- fluidPage(
fluidRow(
column(7,
uiOutput("Hierarchy"),
verbatimTextOutput("results"),
tableOutput("clickView"),
d3treeOutput(outputId="d3",width = '1200px',height = '800px')
),
column(5,
tableOutput('table')
)
)
)
server <- function(input, output, session) {
#SearchTree----
output$Hierarchy <- renderUI({
Hierarchy=names(m)
Hierarchy=head(Hierarchy,-1)
selectizeInput("Hierarchy","Tree Hierarchy",
choices = Hierarchy,multiple=T,selected = Hierarchy,
options=list(plugins=list('drag_drop','remove_button')))
})
network <- reactiveValues()
observeEvent(input$d3_update,{
network$nodes <- unlist(input$d3_update$.nodesData)
activeNode<-input$d3_update$.activeNode
if(!is.null(activeNode)) network$click <- jsonlite::fromJSON(activeNode)
})
observeEvent(network$click,{
output$clickView<-renderTable({
as.data.frame(network$click)
},caption='Last Clicked Node',caption.placement='top')
})
TreeStruct=eventReactive(network$nodes,{
df=m
if(is.null(network$nodes)){
df=m
}else{
x.filter=tree.filter(network$nodes,m)
df=ddply(x.filter,.(ID),function(a.x){m%>%filter_(.dots = list(a.x$FILTER))%>%distinct})
}
df
})
observeEvent(input$Hierarchy,{
output$d3 <- renderD3tree({
if(is.null(input$Hierarchy)){
p=m
}else{
p=m%>%select(one_of(c(input$Hierarchy,"NEWCOL")))%>%unique
}
d3tree(data = list(root = df2tree(struct = p,rootname = 'us.states'), layout = 'collapse'),activeReturn = c('name','value','depth','id'),height = 18)
})
})
observeEvent(network$nodes,{
output$results <- renderPrint({
str.out=''
if(!is.null(network$nodes)) str.out=tree.filter(network$nodes,m)
return(str.out)
})
})
output$table <- renderTable(expr = {
TreeStruct()%>%select(-NEWCOL)
})
}
shinyApp(ui = ui, server = server)
结果: