【发布时间】：2017-02-25 05:32:44
【问题描述】：
我有一个数据表，我正在尝试创建搜索字段，用户可以在其中输入一个值来过滤表。目前，我的前两个搜索框正在搜索（第一个是姓名、帐号或出生日期；第二个是下一个约会日期）。
我想添加第三个搜索框以按另一列进行过滤，但我无法让它工作。新列是“Eligible”，可以取值“YES”或“NO”。请看我的代码，因为我刚刚在我的脚本中创建了一个测试数据框，这将为你运行。
此外，我想添加第四个字段以在 Screen1、Screen2 和 Screen3 中进行搜索。用户将输入“分子”或“分母”，搜索将返回该人在屏幕 1、2 和 3 中至少有一个分子/分母的所有行。但我只是想处理一个字段一次。
非常感谢您。
library(shiny)
library(htmlwidgets)
library(D3TableFilter)
#you may need this, if you don't have D3TableFilter already:
#install.packages("devtools")
#devtools::install_github("ThomasSiegmund/D3TableFilter")
#make test data frame
PatientLastName = paste0("LastName", 1:20)
PatientFullName = paste0("LastName", 1:20, ", ", "FirstName", 1:20)
AccountNo = c(54354, "65423-BH", 75944, 18765, 45592, "42291-BH", 34493, 55484, NA, 24391, 82829, "87626-M", 14425, 17641, NA, 19541, 28663, NA, 22229, 12442)
PatientDOB = paste0(sample(1945:2001, 20, replace = TRUE), "-", sample(10:12, 20, replace = TRUE), "-", sample(10:30, 20, replace = TRUE))
NextAppt = paste0(2017, "-0", sample(1:2, 20, replace = TRUE), "-", sample(11:12, 20, replace = TRUE))
Eligible = c("YES", "NO", "YES", "NO", 'NO', "YES", "YES", 'NO', 'YES', 'YES', 'NO', 'YES', 'NO', 'NO', 'NO', 'NO', 'NO', 'NO', 'YES', 'NO')
Screen1 = c(NA, NA, NA, "denominator", "numerator", NA, NA, NA, "numerator", "numerator", NA, NA, NA, NA, NA, NA, NA, NA, NA, NA)
Screen2 = c(NA, "denominator", NA, NA, NA, "denominator", NA, NA, NA, "denominator", NA, NA, NA, NA, NA, NA, NA, NA, NA, NA)
Screen3 = c(NA, "numerator", NA, NA, NA, NA, NA, "numerator", "denominator", NA, NA, "denominator", NA, NA, NA, NA, NA, NA, NA, NA)
data = data.frame(PatientFullName, PatientLastName, PatientDOB, NextAppt, AccountNo, Eligible, Screen1, Screen2, Screen3)
#ui.R
#-----------------------------------------------------
ui <- fluidPage(
# Application title
titlePanel("Patient Search"),
sidebarLayout(
sidebarPanel(
textInput(inputId = "Id", label = "Search by Account Number, Date of Birth (YYYY-MM-DD), Last Name or Full Name"),
textInput(inputId = "NextAppt", label = "Search by Next Appointment (YYYY-MM-DD)"),
textInput(inputId = "Eligible", label = "Enter Yes/No for Eligible"),
textInput(inputId = "Screen", label = "Enter numerator/denominator"),
submitButton(text = "Go!"),
br(),
h2("How to Search:"),
h5("A 5-digit number, '-BH' or '-bh' searches for Account Number"),
h5("Any input with a comma will search for PatientFullName (normally paste this from spreadsheet)"),
h5("Date of Birth and Next Appointment must be in YYYY-MM-DD Format"),
h5("'Denominator' or 'Numerator' will return all patients who have ANY denominator. You can then use the filters on the tops of columns to choose which denominator"),
h5("'N/A' will bring up anyone who does not have an account number")
#actionButton("gobutton", "Go!")
),
mainPanel(
title = 'Patient Search with D3 Table Filter in Shiny',
fluidRow(
column(width = 12, d3tfOutput('data'))
)
)
)
)
#server.R
#-----------------------------------------------------
server <- shinyServer(function(input, output, session) {
#define search criteria
search.criteria <- reactive({
out <- c()
outAppt <- c()
outElig <- c()
if(grepl("\\d{4}\\-\\d{2}\\-\\d{2}", input$Id)==TRUE){
out <- which(data$PatientDOB==input$Id)
print(out)
} else if(grepl("\\d{5}", input$Id)==TRUE){
out <- which(data$AccountNo == input$Id)
} else if (grepl("\\-[BH]", input$Id)==TRUE || grepl("\\-[bh]", input$Id)==TRUE){
out <- grep('-BH', data$AccountNo)
} else if(grepl("\\,", input$Id)==TRUE){
out <- which(data$PatientFullName==input$Id)
} else if(grepl("N/A", input$Id, fixed = TRUE)==TRUE) {
#out <- which(is.na(data$AccountNo)==TRUE)
out <- which(is.na(data$AccountNo)==TRUE)
} else{
out <- which(data$PatientLastName==input$Id)
}
# filter for appointment
if(grepl("\\d{4}\\-\\d{2}\\-\\d{2}", input$NextAppt)==TRUE){
outAppt <- which(data$NextAppt==input$NextAppt)
if(length(out)){
out <- intersect(out, outAppt)
} else{
out <- outAppt
}
}
if(grepl("yes|no", tolower(input$Eligible))){
outElig <- which(data$Eligible==toupper(input$Eligible))
if(length(out) && length(outAppt)){
out <- intersect(out, outAppt, outElig)
} else{
out <- outElig
}
}
if(grepl("numerator|denominator", tolower(input$Screen))==TRUE){
outScreen <- which(data$Screen1==input$Screen | data$Screen2==input$Screen | data$Screen3==input$Screen)
if(length(out) && length(outAppt) && length(outAppt)){
out <- intersect(out, outAppt, outScreen)
} else{
out <- outScreen
}
}
out
})
#make the output table
output$data <- renderD3tf({
#define table properties
tableProps <- list(
btn_reset = TRUE,
btn_reset_text = "Clear",
filters_row_index = 1, #this puts options "Clear", "1, "2", ... at the top of each col to filter by
mark_active_columns = TRUE,
rows_counter = TRUE,
rows_counter_text = "Rows: ",
# behavior
on_change = TRUE,
btn = FALSE,
enter_key = TRUE,
on_keyup = TRUE,
on_keyup_delay = 1500,
remember_grid_values = TRUE,
remember_page_number = TRUE,
remember_page_length = TRUE,
highlight_keywords = TRUE,
loader = TRUE,
loader_text = "Filtering data...",
# sorting
col_types = c("String", rep("Number", 11)),
#column visibility
showHide_cols_text = 'Hide columns:',
showHide_enable_tick_all = TRUE,
# filters
refresh_filters = FALSE
)
#render specific rows or all rows
if(length(search.criteria())!=0){
d3tf(data[search.criteria(),],
tableProps = tableProps,
showRowNames = TRUE,
tableStyle = "table table-bordered",
edit = c("col_1", "col_2", "col_3")
)
} else{ #render all rows
d3tf(data,
tableProps = tableProps,
showRowNames = TRUE,
tableStyle = "table table-bordered",
edit = c("col_1", "col_2", "col_3")
)
}
})
})
runApp(list(ui = ui, server = server))
【问题讨论】：
-
在这里提出建议：为什么不使用选择下拉菜单而不是只包含几个预设值的列的文本输入？
-
感谢您的建议——这是个好主意。我会努力的，这更有意义！