闪亮:使用selectizeInput选择组

时间:2018-12-19 19:59:17

标签: r shiny shiny-reactivity

我的愿景是拥有一个选择器,用户可以单击该组以选择该组中的所有项目。例如,请参阅this

当您单击输入框X2或X4时,我希望用户可以单击“西部”以选择加利福尼亚和华盛顿。

理想情况下,我希望用户能够选择多个区域,并能够自定义他们的选择(例如,选择“西部”区域并查看一些数据。然后取消选择“华盛顿”以专注于“加利福尼亚”,并查看更多数据。

我在想,如果不可能以一种简单的方式做到这一点,那么我应该只将区域作为选择,并在用户选择区域后使用updateSelectInput()更新所选值。

谢谢您的帮助。

1 个答案:

答案 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)

结果:

enter image description here