Reputation: 1619

Multiple Text Inputs Search R Shiny

I have a table of data, and I am trying to create search fields where the user can enter a value to filter the table by. Currently I have searches working for my first two search boxes (first one is Name, Account Number, or Date of Birth; second one is by Next Appointment date).

I'd like to add a third search box to filter by another column, but I have not been able to get it to work. The new column is "Eligible", and can take values "YES" or "NO". Please see my code, this will run for you since I have just created a test dataframe in my script.

Additionally, I would like to add a fourth field to search in Screen1, Screen2 and Screen3. The user would enter either "numerator" or "denominator", and the search would return all rows where that person had at least one numerator/denominator in Screens 1, 2 and 3. But I'm just trying to deal with one field at a time.

Thank you very much in advance.

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

Upvotes: 1

Answers (2)

Sandipan Dey

Reputation: 23109

You have a typo in your code

if(grepl("yes", toupper(input$Eligible))==TRUE){ should be if(grepl("yes", tolower(input$Eligible))==TRUE){ instead.

The complete code with your fourth search input requirement:

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

Upvotes: 1

HubertL

Reputation: 19544

You're comparing the result of toupper to a lowercase string : this can't be TRUE if you don't set the parameter ignore.case = FALSE in grepl.

Also you're checking that the input is "yes" only so "no" would not be selected

I suggest you use either

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

if(grepl("YES|NO", toupper(input$Eligible))){

Then you need to use toupper() in the comparison to your data:

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

Upvotes: 1

Multiple Text Inputs Search R Shiny

Answers (2)

Related Questions