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))

库（闪亮）
库（htmlwidgets）
库（D3TableFilter）
#如果您还没有D3TableFilter，则可能需要：
#安装包（“devtools”）
#devtools:：install_github（“ThomasSiegmund/D3TableFilter”）
#制作测试数据帧
PatientLastName=paste0（“姓氏”，1:20）
PatientFullName=paste0（“LastName”，1:20，，，，，“FirstName”，1:20）
AccountNo=c（54354，“65423-BH”，759441876545592，“42291-BH”，344935484，NA，2439182829，“87626-M”，1442517641，NA，1954128663，NA，2222912442）
PatientDB=paste0（样本（1945:2001,20，replace=TRUE），“-”，样本（10:12,20，replace=TRUE），“-”，样本（10:30,20，replace=TRUE））
NextAppt=paste0（2017年，“-0”，样本（1:2,20，替换=TRUE），“-”，样本（11:12,20，替换=TRUE））
合格=c（“是”、“否”、“是”、“否”、“否”、“是”、“是”、“否”、“是”、“是”、“否”、“是”、“是”、“否”、“是”、“否”、“否”、“否”、“否”、“否”、“否”）
屏幕1=c（NA，NA，NA，“分母”，“分子”，NA，NA，NA，“分子”，“分子”，NA，NA，NA，NA，NA，NA，NA，NA，NA，NA，NA）
屏幕2=c（NA，“分母”，NA，NA，NA，“分母”，NA，NA，NA，“分母”，NA，NA，NA，NA，NA，NA，NA，NA，NA）
屏幕3=c（NA，“分子”，NA，NA，NA，NA，NA，“分子”，“分母”，NA，NA，“分母”，NA，NA，NA，NA，NA，NA，NA，NA，NA）
data=data.frame（PatientFullName、PatientLastName、PatientDB、下一步、AccountNo、合格、屏幕1、屏幕2、屏幕3）
#用户界面
#-----------------------------------------------------
ui您正在将
toupper
的结果与小写字符串进行比较：如果未在
grepl
中设置参数
ignore.case=FALSE
，则这不可能是真的

此外，您正在检查输入是否为“是”，这样就不会选择“否”

我建议你用其中一种

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

或

然后需要使用
toupper（）
与数据进行比较：

  outElig <- which(data$Eligible==toupper(input$Eligible))

outElig您的代码中有一个输入错误

if（grepl（“yes”，toupper（input$qualified））==TRUE）{
应该是
if（grepl（“yes”，tolower（input$qualified））==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))
`

#ui.R
#-----------------------------------------------------
ui在此提出建议：与其为只包含几个预设值的列输入文本，为什么不使用select下拉列表？感谢您的建议--这是一个极好的主意。我将在中使用它，它更有意义！非常感谢您的建议。我已修改了搜索条件（）在我的帖子中，上面是被动的。每个单独的搜索现在都可以工作了！我现在唯一的问题是当我尝试重叠两个搜索时。如果在较高的字段之前搜索较低的字段，则不起作用。但是如果你做相反的操作，则会起作用。此外，当前两个字段中的任何一个涉及到组合的searc时，应用程序会生成错误h、 我知道这与我的intersect（）和if（）的顺序有关语句出现了，但我不太明白。有什么建议吗？再次感谢您。您可以做一件事：检查输入后，您可以将布尔结果存储在几个变量中。然后检查所有输入后，您可以首先搜索不同的AND组合（交点）首先检查布尔变量的值，然后检查各个布尔值，并相应地进行筛选。
#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))
`