1
私はデータテーブルを持っており、ユーザがテーブルをフィルタリングするために値を入力できる検索フィールドを作成しようとしています。現在、最初の2つの検索ボックス（最初は名前、アカウント番号、生年月日、2番目は次回の予定日）で検索しています。複数のテキスト入力検索R Shiny
別の列でフィルタリングするために3番目の検索ボックスを追加したいのですが、それを動作させることができませんでした。新しい列は「適格」であり、「はい」または「いいえ」の値を取ることができます。私のコードを見てください。これは私のスクリプトでテストデータフレームを作成してから実行されます。
また、Screen1、Screen2、Screen3で検索するために4番目のフィールドを追加したいと思います。ユーザーは "numerator"または "denominator"のいずれかを入力します。検索では、画面1、2、3に少なくとも1つの分子/分母があるすべての行が返されます。しかし、私はただ1つのフィールドを処理しようとしています時間。
ありがとうございます。
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