1
我有一個數據表，我試圖創建搜索字段，用戶可以輸入一個值來過濾表格。目前我的搜索框中有兩個搜索框（第一個是姓名，帳號或出生日期;第二個是下一個預約日期）。多個文本輸入搜索R閃亮
我想添加第三個搜索框來過濾另一列，但我一直沒有得到它的工作。新列爲「合格」，可以取值爲「是」或「否」。請參閱我的代碼，由於我剛剛在腳本中創建了一個測試數據框，因此它將爲您運行。
此外，我想添加第四個字段來搜索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))
這裏製作一個建議：對於只包含少數預先設定值的列，而不是文字輸入，爲什麼不使用選擇下拉菜單？ –
謝謝你的建議 - 這是一個好主意。我會努力工作，這更有意義！ – tsouchlarakis