Question

我有一个数据表，我正在尝试创建搜索字段，用户可以在其中输入值来过滤表格。目前我的搜索工作是前两个搜索框（第一个是姓名，帐号或出生日期;第二个是下一个约会日期）。

我想添加第三个搜索框以按其他列过滤，但我无法让它工作。新栏目是＆＃34;符合条件的＆＃34;，并且可以采用值＆＃34; YES＆＃34;或＆＃34;否＆＃34;。请参阅我的代码，这将为您运行，因为我刚刚在我的脚本中创建了一个测试数据帧。

此外，我想在Screen1，Screen2和Screen3中添加第四个字段进行搜索。用户可以输入＆＃34;分子＆＃34;或者＆＃34;分母＆＃34;，并且搜索将返回该人在屏幕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))

Answer 1

您将toupper的结果与小写字符串进行比较：如果您未在{{1}中设置参数ignore.case = FALSE，则无法为真}。

此外，您还要检查输入是否是＆＃34;是＆＃34;只有这样＆＃34;没有＆＃34;不会被选中

我建议您使用

grepl

或

if(grepl("yes|no", input$Eligible, ignore.case = FALSE)){

然后，您需要在与数据进行比较时使用if(grepl("YES|NO", toupper(input$Eligible))){：

toupper()

Answer 2

您的代码中有拼写错误

if(grepl("yes", toupper(input$Eligible))==TRUE){ 应改为if(grepl("yes", tolower(input$Eligible))==TRUE){。

包含第四个搜索输入要求的完整代码：

#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 for Screen1 / Screen2 / Secreen3"),
      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", tolower(input$Eligible))==TRUE){
      outElig <- which(data$Eligible==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))
`

多个文本输入搜索R Shiny

2 个答案: