I have been trying to implement a R Shiny app based on DT. More specifically, my idea is to use an external numericInput to filter numerical fields and the search boxes embedded in the datatable for the other fields. What is critical in my exercise is to optionally perform textual search using regex expression for exact match. Also, for such exact search the user is not supposed to see the special expressions. For instance, the user simply types "abc" and in the background the string is handled as "^abc$".
Everything seems to work fine if I first use the external filters and then the embedded one. Vice versa, the regex expression are not activated and I cannot perform the exact match.
This works just fine, with the regex expression correctly handled in the background.
This doesn't work instead, as the 'DT::updateSearch' updates the filter based on the numericInput and the JS script is not execute as that is triggered only when we type on the search box.
Is there a way to trigger a drawCallback, for instance, that can update the behaviour I implemented in the JS function below?
library(shiny)
library(DT)
ui <- fluidPage(
fluidRow(column(3, strong('num'), style='margin-bottom:0px;')),
fluidRow(column(3, numericInput("missing_min", "", NULL, min = 1, max = 100)), column(3, numericInput("missing_max", "", NULL, min = 1, max = 100)), style='margin-top:0px;'),
checkboxInput("regex_check_num", "activate regex search", FALSE),
fluidRow(
dataTableOutput("dataTable")
)
)
# default global search value
if (!exists("default_search")) default_search <- ""
# default column search values
if (!exists("default_search_columns")) default_search_columns <- NULL
server <- function(input, output) {
proxy <- DT::dataTableProxy('dataTable')
observeEvent(c(input$missing_min, input$missing_max),{
isolate({
# update global search and column search strings
default_search <- input$dataTable_search
default_search_columns <- c(input$dataTable_search_columns)
# update integer value
if (is.na(input$missing_min))
default_search_columns[4] <- paste0('...', input$missing_max)
else if (is.na(input$missing_max)){
print('here')
default_search_columns[4] <- paste0(input$missing_min, '...')
}
else
default_search_columns[4] <- paste0(input$missing_min, '...', input$missing_max)
# update the search terms on the proxy table (see below)
proxy %>% DT::updateSearch(keywords =
list(global = default_search, columns = default_search_columns))
})
}, ignoreInit = T)
output$dataTable <- DT::renderDataTable({
dat <- data.frame(
car = c("Mazda", "Mazda RX4", "Mazda RX4 Wag", "Ford", "Mercedes"),
day = Sys.Date() + 0:4,
num = as.integer(c(1,2,3,4,5)),
hidden_num = as.integer(c(1,2,3,4,5))
)
js <- c(
"function(settings){",
" $.fn.dataTable.ext.errMode = 'none';",
" var instance = settings.oInstance;",
" var table = instance.api();",
" var $inputs = instance.parent().find('.form-group input'); console.log('ready')",
" $inputs.off('keyup search input').on('keyup', function(){",
" var index = $inputs.index(this);", # add 1 if rownames column included
" var title = table.column(index).header();",
" title = $(title).html()",
" var val = $(this).val(); console.log(val);",
" if (val!== '' & document.getElementById('regex_check_num').checked){",
" var keyword = '^' + val + '$';", # For exact match
" table.column(index).search(keyword, true, false).draw();",
" }",
"else {table.column(index).search(val).draw(); console.log('done');}});",
"}"
)
datatable(
dat,
filter = list(position="top", plain=F, clear = F),
rownames = FALSE,
options = list(
# drawCallback = JS(js_update), # TODO
searchCols = default_search_columns
, initComplete = JS(js)
, columnDefs = list(
list(targets = c(2), searchable = F),
list(targets = c(3), visible = F)
)
), style = 'bootstrap4', class = 'table-bordered'
)
}, server = T)
}
shinyApp(ui = ui, server = server)
