我的数据框中有一个字段是分隔字符串。我有一个带有可能值的复选框输入。我有一个单选按钮，有两个选择：“任意”和“全部”。
我将复选框中选定项目的列表与分隔字符串中的项目进行比较。
我希望“任意”选项的行为类似于设置交集。如果任何选定项目位于分隔字符串中的任何位置，请保留该行。
我希望“全部”选项的行为类似于设置等效项。仅应保留具有精确的所选项目集的字符串。
library(shiny)
library(data.table)
library(dplyr)
library(DT)
library(shinyWidgets)
library(shinydashboard)
ui <- fluidPage(
# Application title
titlePanel("DT"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
treeInput(
inputId = "spectrumDeployedCheckbox",
label = "Spectrum Deployed" ,
choices = create_tree(
data.frame(
"All" = c("All"),
"Deployed" = c("13","5","2","4","66","77"),
"DeployedVAR" = c("13","5","2","4","66","77")
),
levels = c("All","Deployed"),
levels_id = c("All","DeployedVAR")
),
selected = c("All"),
returnValue = "id" ,
closeDepth = 1
),
radioButtons(
"spectrumDeployedMatchRadioButton",
"Match On",
choiceNames=c("Any","All"),
choiceValues=c("ANY","ALL"),
selected='ANY'
)
),
# Show a plot of the generated distribution
mainPanel(
DT::dataTableOutput("demoTable")# ,
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
OPRBAND <- c("13;5","4;2","4","13","5","13;5;2;4;66;77","44;5")
OPRBAND2 <- c("13;5","4;2","4","13","5","13;5;2;4;66;77","44;5")
data <- data.frame(OPRBAND,OPRBAND2) %>%
rowwise() %>%
mutate(
OPRBAND_LIST = strsplit(OPRBAND,split=";")
) %>%
ungroup()
observe({print(class(list(paste0(unlist(input$spectrumLeftCheckbox ) ) )))})
tableData <- reactive({
return(data %>%
rowwise() %>%
filter(
case_when(
input$spectrumDeployedMatchRadioButton == 'ANY' ~
case_when(
length(input$spectrumDeployedCheckbox) == 0 ~ TRUE ,
TRUE ~ length(intersect(OPRBAND_LIST[[1]],input$spectrumDeployedCheckbox[!input$spectrumDeployedCheckbox == 'All'])) >= 0
),
input$spectrumDeployedMatchRadioButton == 'ALL' ~
case_when(
length(input$spectrumDeployedCheckbox) == 0 ~ FALSE ,
TRUE ~ identical(sort(input$spectrumDeployedCheckbox[!input$spectrumDeployedCheckbox == 'All']) , sort(OPRBAND_LIST[[1]])) == TRUE
)
)
) %>%
ungroup() %>%
as.data.frame()
)
})
output$demoTable <- DT::renderDataTable({
DT::datatable( tableData()
,extension = 'Buttons' ,
filter = list(position = 'top', clear = FALSE),
options = list(
paging = TRUE,
searching = TRUE,
fixedColumns = TRUE,
autoWidth = TRUE,
ordering = TRUE,
dom = 'lftsp' ,
stateSave = TRUE ,
order = list(list(1,'asc'),list(2,'asc'))
#buttons = c('copy', 'csv', 'excel'),
# modify this for full download. github.com/rstudio/DT/issues/267
),
escape = FALSE,
class='display',
rownames = FALSE
)
}, server=FALSE, escape=FALSE)
}
# Run the application
shinyApp(ui = ui, server = server)
我的行为与我认为应该发生的事情非常不一致。例如，如果仅选择了 4，并且选择了“任意”，则我希望保留第 3、4 和 6 行。如果我将收音机切换到“全部”，则仅应保留第 4 行。
你说
例如，如果仅选择 4，并选择“任意”，我希望保留第 3、4 和 6 行
但我在第 2、3 和 6 行中看到
"4"input$spectrumDeployedCheckbox
# [1] "4"
input$spectrumDeployedMatchRadioButton
# [1] "ANY"
anyallfun <- switch(
input$spectrumDeployedMatchRadioButton,
"ANY" = any,
all)
data %>%
filter(
sapply(data$OPRBAND_LIST,
function(z) anyallfun(z %in% input$spectrumDeployedCheckbox))
)
# # A tibble: 3 × 3
# OPRBAND OPRBAND2 OPRBAND_LIST
# <chr> <chr> <list>
# 1 4;2 4;2 <chr [2]>
# 2 4 4 <chr [1]>
# 3 13;5;2;4;66;77 13;5;2;4;66;77 <chr [6]>
或者，如果我们选择了
"ALL"input$spectrumDeployedCheckbox
# [1] "4"
input$spectrumDeployedMatchRadioButton
# [1] "ALL"
anyallfun <- switch(
input$spectrumDeployedMatchRadioButton,
"ANY" = any,
all)
data %>%
filter(
sapply(data$OPRBAND_LIST,
function(z) anyallfun(z %in% input$spectrumDeployedCheckbox))
)
# # A tibble: 1 × 3
# OPRBAND OPRBAND2 OPRBAND_LIST
# <chr> <chr> <list>
# 1 4 4 <chr [1]>
一些仅供参考：
你不需要使用
rowwiseOPRBAND_LISTdata <- data.frame(OPRBAND, OPRBAND2) %>%
mutate(OPRBAND_LIST = strsplit(OPRBAND, ";"))
data
# OPRBAND OPRBAND2 OPRBAND_LIST
# 1 13;5 13;5 13, 5
# 2 4;2 4;2 4, 2
# 3 4 4 4
# 4 13 13 13
# 5 5 5 5
# 6 13;5;2;4;66;77 13;5;2;4;66;77 13, 5, 2, 4, 66, 77
# 7 44;5 44;5 44, 5
同样有效（对我来说在轻度测试中）。
你的反应式中不需要
return(...)return%>%return(..)