我想构建一个闪亮的应用程序,允许用户选择一些列来过滤data.table.
我的实际数据有~110列,列是数字,字符,因子,整数
我希望在侧边栏面板中有一个预先选择的过滤器,但也有一个按钮,允许用户根据列创建自定义过滤器.我不知道这是否可以在闪亮或不闪亮,我已阅读有关insertUI和removeUI但我不知道这是否适用于这种情况.用户创建的过滤器也应该连续应用,即,如果用户创建了三个过滤器,则应该应用filter1,然后应用filter2,然后应用filter3.
我有一个小示例应用程序,其中有一个基于Person的初始过滤器使用textAreaInput(我的最终用户希望在框中粘贴一些名称来过滤掉表)但我想添加一些其他过滤器,例如sliderInput用于投票或下拉菜单的字母.
library(shinydashboard)
library(dplyr)
library(shiny)
library(DT)
header <- dashboardHeader(title="Analysis and database")
sidebar <- dashboardSidebar(
sidebarMenu(
# Setting id makes input$tabs give the tabName of currently-selected tab
id = "sidebarmenu",
menuItem("Database", tabName="db"),
menuItem("Search by Name", tabName = "Filt_table"),
textAreaInput("name_", "Name")
)
)
body <- dashboardBody(
tabItems(
tabItem("db","table content",
fluidRow(DT::dataTableOutput('tabla'))),
tabItem("Filt_table","Filtered table content",
fluidRow(DT::dataTableOutput('tablafilt')))
)
)
ui <- dashboardPage(header, sidebar, body)
### SERVER SIDE
server = function(input, output, session) {
my_data <- data.frame(Person=c("Anne", "Pete", "Rose", "Julian", "Tristan", "Hugh"),
Votes=c(10,25,56,89.36,78,1500),
Stuff=c("test|3457678", "exterm|4567sdf", "1001(hom);4.3.4|3456", "xdfrtg", "1234|trsef|456(het)", "hyggas|tertasga"),
letters=replicate(6, paste(sample(LETTERS,6, replace=T), collapse="")))
output$tabla <- DT::renderDataTable({
DT::datatable(my_data)
})
filtered <- reactive({
if(is.null(input$name_))
return()
glist <- isolate(input$name_)
filter(my_data, Person %in% glist)
})
output$tablafilt <- DT::renderDataTable({
if(is.null(input$name_))
return()
DT::datatable(filtered (),
filter = 'top',
extensions = 'Buttons',
options = list(
dom = 'Blftip',
buttons =
list('colvis', list(
extend = 'collection',
buttons = list(list(extend='csv',
filename = 'results'),
list(extend='excel',
filename = 'results'),
list(extend='pdf',
filename= 'results')),
text = 'Download'
)),
scrollX = TRUE,
pageLength = 5,
lengthMenu = list(c(5, 15, -1), list('5', '15', 'All'))
), rownames = FALSE
)
})
}
shinyApp(ui, server)
最佳答案 您可以首先为所有变量创建一个selectInput()以及添加和删除按钮：
output$potentialFilter <- renderUI({
tagList(
selectInput("createFilter", "Create Filter", names(my_data)),
actionButton("remove", "remove"),
actionButton("add", "add")
)
})
然后,您可以为所选变量创建输入.
注意：由于您不想在添加新UI时重置插入的UI,因此应使用insertUI()而不是renderUI().
insertUI(selector = "#add", where = "afterEnd",
ui = selectizeInput(toBeIncluded, toBeIncluded, my_data[[toBeIncluded]],
selected = my_data[[toBeIncluded]], multiple = TRUE)
)
完整的例子如下：
library(shinydashboard)
library(dplyr)
library(shiny)
library(DT)
header <- dashboardHeader(title="Analysis and database")
sidebar <- dashboardSidebar(
sidebarMenu(
# Setting id makes input$tabs give the tabName of currently-selected tab
id = "sidebarmenu",
menuItem("Database", tabName="db"),
menuItem("Search by Name", tabName = "Filt_table"),
uiOutput("potentialFilter"),
uiOutput("rendFilter")
)
)
body <- dashboardBody(
tabItems(
tabItem("db","table content",
fluidRow(DT::dataTableOutput('tabla'))),
tabItem("Filt_table","Filtered table content",
fluidRow(DT::dataTableOutput('tablafilt')))
)
)
ui <- dashboardPage(header, sidebar, body)
### SERVER SIDE
server = function(input, output, session) {
my_data <- data.frame(Person=c("Anne", "Pete", "Rose", "Julian", "Tristan", "Hugh"),
Votes=c(10,25,56,89.36,78,1500),
Stuff=c("test|3457678", "exterm|4567sdf", "1001(hom);4.3.4|3456", "xdfrtg", "1234|trsef|456(het)", "hyggas|tertasga"),
letters=replicate(6, paste(sample(LETTERS,6, replace=T), collapse="")),
stringsAsFactors = FALSE)
global <- reactiveValues(filter = c(), filteredData = my_data, tagList = tagList())
output$potentialFilter <- renderUI({
tagList(
selectInput("createFilter", "Create Filter", names(my_data)),
actionButton("remove", "remove"),
actionButton("add", "add")
)
})
observeEvent(input$add, {
global$filter <- c(global$filter, input$createFilter)
toBeIncluded <- input$createFilter
data <- my_data[[toBeIncluded]]
if(typeof(data) == "double"){
ui <- numericInput(toBeIncluded, toBeIncluded, ceiling(min(data)), min = min(data), max = max(data))
}else if(typeof(data) == "character"){
ui <- textAreaInput(toBeIncluded, toBeIncluded, data[1], width = "200px")
}
insertUI(selector = "#add", where = "afterEnd", ui = ui)
})
observeEvent(input$remove, {
global$filter <- setdiff(global$filter, input$createFilter)
removeUI(selector = paste0("div:has(> #", input$createFilter, ")"))
})
output$tabla <- DT::renderDataTable({
DT::datatable(filtered())
})
filtered <- reactive({
if(length(global$filter)){
for(filterName in global$filter){
if(is.character(input[[filterName]])){
names <- unlist(strsplit(input[[filterName]], ";"))
my_data <- my_data[my_data[[filterName]] %in% names, ]
}else if(is.numeric(input[[filterName]])){
my_data <- my_data[my_data[[filterName]] >= input[[filterName]], ]
}
}
}
return(my_data)
})
output$tablafilt <- DT::renderDataTable({
DT::datatable(filtered(),
filter = 'top',
extensions = 'Buttons',
options = list(
dom = 'Blftip',
buttons =
list('colvis', list(
extend = 'collection',
buttons = list(list(extend='csv',
filename = 'results'),
list(extend='excel',
filename = 'results'),
list(extend='pdf',
filename= 'results')),
text = 'Download'
)),
scrollX = TRUE,
pageLength = 5,
lengthMenu = list(c(5, 15, -1), list('5', '15', 'All'))
), rownames = FALSE
)
})
}
shinyApp(ui, server)
(我不确定你应用过滤器的顺序会有所不同,如果我弄错的话,也许你可以对此进行详细说明).
