R Shiny SelectizeInput:从分组选择中传递值不起作用
R Shiny SelectizeInput: Passing values from grouped choices not working
根据本 link 中给出的答案,我创建了一个闪亮的应用程序,如下所示:
编辑
请注意 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 中有分组的第一个场景中,如何实现相同的输出?
以下是否符合您的要求?
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.
我已经稍微清理了你的代码,因为我发现很难 understand/digest 你在做什么。例如,我没有看到同时使用 sqldf
和 tidyverse
的意义;如果您已经加载了完整的 tidyverse
,您还不如使用 dplyr
加载所有数据 manipulations/filtering(而不是添加另一个依赖项)。需要注意的一点是,当您加载 tidyverse
时,stringr
会自动加载,因此无需显式调用 library(stringr)
。我删除了您定义 x
和 group
的行,您在这个最小代码示例中没有使用它们。我还建议根据流行和公开可用的 R 风格指南之一使用一致的缩进和空格用法。这将有助于(您和其他人)提高可读性。
更新
要在 sqldf
中执行 reactive
数据过滤,您可以将上面的 df1 <- 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)))
})
根据本 link
编辑 请注意 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 中有分组的第一个场景中,如何实现相同的输出?
以下是否符合您的要求?
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.
我已经稍微清理了你的代码,因为我发现很难 understand/digest 你在做什么。例如,我没有看到同时使用 sqldf
和 tidyverse
的意义;如果您已经加载了完整的 tidyverse
,您还不如使用 dplyr
加载所有数据 manipulations/filtering(而不是添加另一个依赖项)。需要注意的一点是,当您加载 tidyverse
时,stringr
会自动加载,因此无需显式调用 library(stringr)
。我删除了您定义 x
和 group
的行,您在这个最小代码示例中没有使用它们。我还建议根据流行和公开可用的 R 风格指南之一使用一致的缩进和空格用法。这将有助于(您和其他人)提高可读性。
更新
要在 sqldf
中执行 reactive
数据过滤,您可以将上面的 df1 <- 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)))
})