我想改进已经出现在这个论坛中的Shiny应用程序。我希望达到这样的效果,例如,通过选择Category1“a”,还显示了类别“a,b”。类似地,当选择“c”类别1时,包含“c”的所有其他类别应该是可见的,在这种情况下是“c,b”。
library(shiny)
data.input <- data.frame(
Category1 = rep(sample(c("a,b","a","c,b","b", "c"), 45, replace = T)),
Info = paste("Text info", 1:45),
Category2 = sample(letters[15:20], 45, replace = T),
Size = sample(1:100, 45),
MoreStuff = paste("More Stuff", 1:45)
)
ui <- fluidPage(titlePanel("Test Explorer"),
sidebarLayout(
sidebarPanel(
selectizeInput(
"show_vars",
"Columns to show:",
choices = colnames(data.input), # edit
multiple = TRUE,
selected = c("Category1", "Info", "Category2")
),
actionButton("button", "An action button"),
uiOutput("category1"),
uiOutput("category2"),
uiOutput("sizeslider")
),
mainPanel(tableOutput("table"))
))
server <- function(input, output, session) {
data.react <- eventReactive(input$button, {
data.input[, input$show_vars]
})
observeEvent(input$button, {
output$category1 <- renderUI({
data.sel <- data.react()
selectizeInput('cat1',
'Choose Cat 1',
choices = c("All", sort(as.character(
unique(data.sel$Category1)
))),
selected = "All")
})
df_subset <- eventReactive(input$cat1, {
data.sel <- data.react()
if (input$cat1 == "All") {
data.sel
}
else{
data.sel[data.sel$Category1 == input$cat1,]
}
})
output$category2 <- renderUI({
selectizeInput(
'cat2',
'Choose Cat 2 (optional):',
choices = sort(as.character(unique(
df_subset()$Category2
))),
multiple = TRUE,
options = NULL
)
})
df_subset1 <- reactive({
if (is.null(input$cat2)) {
df_subset()
} else {
df_subset()[df_subset()$Category2 %in% input$cat2,]
}
})
output$sizeslider <- renderUI({
sliderInput(
"size",
label = "Size Range",
min = min(data.input$Size),
max = max(data.input$Size),
value = c(min(data.input$Size), max(data.input$Size))
)
})
df_subset2 <- reactive({
if (is.null(input$size)) {
df_subset1()
} else {
df_subset1()[data.input$Size >= input$size[1] &
data.input$Size <= input$size[2],]
}
})
output$table <- renderTable({
df_subset2()
})
})
}
shinyApp(ui, server)
我希望abc不要出现在公元前。
一种方法是使用grepl
和sapply
。你可以使用:
qazxsw poi所以你会得到类别1中包含字符串的所有行。
在你的代码中它将是这样的:
slt <- sapply(X = data.sel$Category1, FUN = grepl, pattern = input$cat1 )
通过此修改,您的输出将看起来像thisserver <- function(input, output, session) {
data.react <- eventReactive(input$button, {
data.input[, input$show_vars]
})
observeEvent(input$button, {
output$category1 <- renderUI({
data.sel <- data.react()
selectizeInput('cat1',
'Choose Cat 1',
choices = c("All", sort(as.character(
unique(data.sel$Category1)
))),
selected = "All")
})
df_subset <- eventReactive(input$cat1, {
data.sel <- data.react()
if (input$cat1 == "All") {
data.sel
}
else{
###########################This part has been added#######################
slt <- sapply(X = data.sel$Category1, FUN = grepl, pattern = input$cat1 )
data.sel[slt,]
##################################################################
# data.sel[data.sel$Category1 == input$cat1,]
}
})
output$category2 <- renderUI({
selectizeInput(
'cat2',
'Choose Cat 2 (optional):',
choices = sort(as.character(unique(
df_subset()$Category2
))),
multiple = TRUE,
options = NULL
)
})
df_subset1 <- reactive({
if (is.null(input$cat2)) {
df_subset()
} else {
df_subset()[df_subset()$Category2 %in% input$cat2,]
}
})
output$sizeslider <- renderUI({
sliderInput(
"size",
label = "Size Range",
min = min(data.input$Size),
max = max(data.input$Size),
value = c(min(data.input$Size), max(data.input$Size))
)
})
df_subset2 <- reactive({
if (is.null(input$size)) {
df_subset1()
} else {
df_subset1()[data.input$Size >= input$size[1] &
data.input$Size <= input$size[2],]
}
})
output$table <- renderTable({
df_subset2()
})
})
}
希望能帮助到你!
EDIT1
由于逗号分隔的单词是你真的想要我猜这种方法可能会帮助你。
EDIT2:这是完整的代码:
slt <- sapply(X= data.sel$Category1, FUN = function(x, y){
ele1 <- unique(unlist(strsplit(as.character(x), split = ",")))
ele2 <- unique(unlist(strsplit(y, split = ",")))
if(any(ele1 == ele2))
return(TRUE)
else
return(FALSE)
},y=input$cat1
)