R Shiny SelectizeInput:从分组选择中传递值不起作用

Posted

技术标签:

【中文标题】R Shiny SelectizeInput:从分组选择中传递值不起作用【英文标题】:R Shiny SelectizeInput: Passing values from grouped choices not working 【发布时间】:2021-01-08 03:45:40 【问题描述】:

按照此链接R shiny selectInput: how to search group name/label 中给出的答案,我创建了一个闪亮的应用程序,示例如下:

编辑 请注意,SQLDF 部分代表实际平台中的 mysql 查询。因此,我通常希望将 input$Search * 的值传递给 MySQL 查询。

  library(shiny)
  library(tidyverse)
  library(sqldf)
  library(DT)
  library(stringr)

       df <- data.frame(empName = c("Jon", "Bill", "Maria", "Dan", "Ken", "Fay"),
             empID = c("J111", "B222", "M333", "D444", "K555", "F666"),
             empAge = c(23, 41, 32, 28, 35, 38),
             empSalary = c(21000, 23400, 26800, 27200, 30500, 32000),
             empGroup = c("Employee", "Employee", "Manager", "Manager", "Director","Director")
   )


     df$empGroup <- as.factor(as.character(df$empGroup))

    x <- as.vector(levels(df$empGroup))

      groups <- function(x)
                      for(i in 1:length(x))
                        if(i == 1)
                        savelist <-c()
                       newlist <- list(list(value = x[i], label=x[i]))
                       savelist <- c(savelist, newlist) 
                      else
                       newlist <- list(list(value = x[i], label=x[i]))
                           savelist <- c(savelist, newlist) 
                        
                          
                     return(savelist)
                       



           shinyApp(

                  ui = fluidPage(  

                         selectizeInput('Search', NULL, NULL, multiple = TRUE, options = list(
                                       placeholder = 'Select name',
                            # predefine all option groups
                           optgroups = lapply(unique(df$empGroup), function(x)
                            list(value = as.character(x), label = as.character(x))
                             ),
  
           # what field to sort according to groupes defined in 'optgroups'
                 optgroupField = 'empGroup',
  
          # you can search the data based on these fields
               searchField = c('empName', 'empGroup', 'empID'),
  
         # the label that will be shown once value is selected
               labelField= 'empName',
  
         # (each item is a row in data), which requires 'value' column (created by cbind at server side)
              render = I("
                     option: function(item, escape) 
                 return '<div>' + escape(item.empName) +'</div>';
                        
                   ")
                 )),
             hr(),
       fluidRow(
            column(6, DT::dataTableOutput("table1")))
            ),

    server = function(input, output, session)   

                 updateSelectizeInput(session, 'Search', choices = cbind(df, value = 
                                                                    seq_len(nrow(df))), 
                     server = TRUE)


         df1 <- reactive ( 
              Selected <-df %>% filter(empName %in% input$Search)%>% select(empID)
                    SelectedID<-sapply(Selected, as.character)
                     N<-stringr::str_c(stringr::str_c("'", SelectedID, "'"), collapse = ',')
                    sqldf(paste0("SELECT  empAge, empSalary  
                   FROM df  WHERE  empID IN (",N,")"))
                    )     

      output$table1 = DT::renderDataTable( 
                    req(input$Search)
               df1(), options = list(dom = 't'))  
           )

应用程序在 stri_c(..., sep = sep, collapse = collapse, ignore_null = TRUE) 中引发警告 警告: 参数不是原子向量;胁迫

但是,如果我不将 selectizeInput 选项分组,它的工作原理如下面的应用程序:

   library(shiny)
   library(tidyverse)
   library(sqldf)
   library(DT)
   library(stringr)

   df <- data.frame(empName = c("Jon", "Bill", "Maria", "Dan", "Ken", "Fay"),
             empID = c("J111", "B222", "M333", "D444", "K555", "F666"),
             empAge = c(23, 41, 32, 28, 35, 38),
             empSalary = c(21000, 23400, 26800, 27200, 30500, 32000)
   )


  shinyApp(

     ui = fluidPage(
               selectizeInput( "Search", label = p("Select name"), choices = NULL,
                options = list(  placeholder = 'Select name', maxOptions = 10,
                                 maxItems = 3,  searchConjunction = 'and' )),
               hr(),
                 fluidRow(
          column(6, DT::dataTableOutput("table1")))
               ),

         server = function(input, output, session) 

                    updateSelectizeInput(session,
                     "Search",
                     server = TRUE,
                     choices = df$`empName`)


          df1 <- reactive ( 
                    Selected <-df %>% filter(empName %in% input$Search)%>% select(empID)
                     SelectedID<-sapply(Selected, as.character)
                    N<-stringr::str_c(stringr::str_c("'", SelectedID, "'"), collapse = ',')
                     sqldf(paste0("SELECT  empAge, empSalary  
                     FROM df  WHERE  empID IN (",N,")"))
                   )     

           output$table1 = DT::renderDataTable( 
                     req(input$Search)
                     df1(), options = list(dom = 't'))  
         )

如何在 selectizeInput 中进行分组的第一种情况下实现相同的输出?

【问题讨论】:

【参考方案1】:

以下内容是否符合您的要求?

library(shiny)
library(tidyverse)
library(DT)

df <- data.frame(
    empName = c("Jon", "Bill", "Maria", "Dan", "Ken", "Fay"),
    empID = c("J111", "B222", "M333", "D444", "K555", "F666"),
    empAge = c(23, 41, 32, 28, 35, 38),
    empSalary = c(21000, 23400, 26800, 27200, 30500, 32000),
    empGroup = c("Employee", "Employee", "Manager", "Manager", "Director","Director"))
df$empGroup <- as.factor(as.character(df$empGroup))

ui <- fluidPage(
    selectizeInput(
        inputId = 'Search',
        label = NULL,
        choices = NULL,
        multiple = TRUE,
        options = list(
            placeholder = 'Select name',
            # predefine all option groups
            optgroups = lapply(unique(df$empGroup), function(x) 
                list(value = as.character(x), label = as.character(x))
            ),
            # what field to sort according to groupes defined in 'optgroups'
            optgroupField = 'empGroup',
            # you can search the data based on these fields
            searchField = c('empName', 'empGroup', 'empID'),
            # the label that will be shown once value is selected
            labelField= 'empName',
            # (each item is a row in data), which requires 'value' column (created by cbind at server side)
             render = I("
                    option: function(item, escape) 
                return '<div>' + escape(item.empName) +'</div>';
                       
                  ")
        )
    ),
    hr(),
    fluidRow(
        column(6, DT::dataTableOutput("table1"))))

server <- function(input, output, session) 
    updateSelectizeInput(
        session = session,
        inputId = 'Search',
        choices = cbind(df, value = seq_len(nrow(df))),
        server = TRUE)

    df1 <- reactive(
        df %>%
            rowid_to_column("idx") %>%
            filter(idx %in% input$Search) %>%
            select(empAge, empSalary)
        )

    output$table1 = DT::renderDataTable(
        req(input$Search)
        df1()
    , options = list(dom = 't'))


shinyApp(server = server, ui = ui)

PS。

我已经稍微清理了你的代码,因为我发现很难理解/消化你在做什么。例如,我没有看到同时使用sqldf tidyverse 的意义;如果您已经加载了完整的tidyverse,您不妨使用dplyr 进行所有数据操作/过滤(而不是添加另一个依赖项)。稍微注意一下,当您加载 tidyverse 时,stringr 会自动加载,因此不需要显式的 library(stringr) 调用。我删除了您在此最小代码示例中未使用的定义 xgroup 的行。我还建议根据流行且公开可用的 R 样式指南之一使用一致的缩进和空格使用。这将有助于(您和其他人)提高可读性。


更新

要在sqldf 中执行reactive 数据过滤,您可以将上面的df1 &lt;- reactive() 块替换为

library(sqldf)

...

df1 <- reactive(
    data <- transform(df, idx = 1:nrow(df))
    sqldf(sprintf(
        "select empAge, empSalary from data where idx in (%s)",
        toString(input$Search)))
)

【讨论】:

谢谢@Maurits Evers ...我使用 sqldf 的原因是因为在我的实际应用程序中我使用 MySQL 来查询大型数据库。因此,我无法使用应用程序加载整个数据。感谢您指出缩进。组功能与我遵循的示例中一样 @Rnoob 我明白了。我进行了编辑以展示如何在reactive 表达式中使用sqldf(而不是dplyr)进行过滤。请看一下。

以上是关于R Shiny SelectizeInput:从分组选择中传递值不起作用的主要内容,如果未能解决你的问题,请参考以下文章

R Shiny(selectizeInput):找不到对象“选择”

在我选择并删除一个条目之前,R Shiny 中的 selectizeInput() 不允许输入

R Shiny SelectizeInput:从分组选择中传递值不起作用

Shiny:根据选择更新 selectizeInput 选择

Shiny - Selectizeinput 更新

Shiny:基于 selectizeInput 的 conditionalPanel 问题