Add server-side processing support for SearchBuilder

R/searchbuilder.R

@@ -0,0 +1,98 @@
+# server-side processing for the SearchBuilder extension
+# https://datatables.net/extensions/searchbuilder/
+
+sbEvaluateSearch = function(search, data) {
+  # https://datatables.net/reference/option/searchBuilder.preDefined
+  stopifnot(search$logic %in% c('AND', 'OR'))
+  Reduce(
+    switch(search$logic, AND = `&`, OR = `|`),
+    lapply(search$criteria, sbEvaluateCriteria, data)
+  )
+}
+
+sbEvaluateCriteria = function(criteria, data) {
+  # https://datatables.net/reference/option/searchBuilder.preDefined.criteria
+  if ('logic' %in% names(criteria)) {
+    # this is a sub-group
+    sbEvaluateSearch(criteria, data)
+  } else {
+    # this is a criteria
+    cond = criteria$condition
+    type = criteria$type
+    x = data[[criteria$origData %||% criteria$data]]
+    v = sbParseValue(sbExtractValue(criteria), type)
+    sbEvaluateCondition(cond, type, x, v)
+  }
+}
+
+sbExtractValue = function(criteria) {
+  if (criteria$condition %in% c('between', '!between')) {
+    # array values are passed in a funny way to R
+    c(criteria$value1, criteria$value2)
+  } else {
+    criteria$value
+  }
+}
+
+sbParseValue = function(value, type) {
+  # TODO: handle 'moment' and 'luxon' types mentioned in condition reference
+  if (type %in% c('string', 'html')) {
+    as.character(value)
+  } else if (type %in% c('num', 'num-fmt', 'html-num', 'html-num-fmt')) {
+    as.numeric(value)
+  } else if (type %in% c('date')) {
+    as.Date(value)
+  } else {
+    stop(sprintf('unsupported criteria type "%s"', type))
+  }
+}
+
+sbEvaluateCondition = function(condition, type, x, value) {
+  # https://datatables.net/reference/option/searchBuilder.preDefined.criteria.condition
+  if (type %in% c('string', 'html')) {
+    switch(
+      condition,
+      '!=' = x != value,
+      '!null' = !is.na(x) & x != '',
+      '=' = x == value,
+      'contains' = grepl(value, x, fixed = TRUE),
+      '!contains' = !grepl(value, x, fixed = TRUE),
+      'ends' = endsWith(as.character(x), value),
+      '!ends' = !endsWith(as.character(x), value),
+      'null' = is.na(x) | x == '',
+      'starts' = startsWith(as.character(x), value),
+      '!starts' = !startsWith(as.character(x), value),
+      stop(sprintf('unsupported condition "%s" for criteria type "%s"', condition, type))
+    )
+  } else if (type %in% c('num', 'num-fmt', 'html-num', 'html-num-fmt')) {
+    switch(
+      condition,
+      '!=' = x != value,
+      '!null' = !is.na(x),
+      '<' = x < value,
+      '<=' = x <= value,
+      '=' = x == value,
+      '>' = x > value,
+      '>=' = x >= value,
+      'between' = x >= value[1] & x <= value[2],
+      '!between' = x < value[1] | x > value[2],
+      'null' = is.na(x),
+      stop(sprintf('unsupported condition "%s" for criteria type "%s"', condition, type))
+    )
+  } else if (type %in% c('date', 'moment', 'luxon')) {
+    switch(
+      condition,
+      '!=' = x != value,
+      '!null' = !is.na(x),
+      '<' = x < value,
+      '=' = x == value,
+      '>' = x > value,
+      'between' = x >= value[1] & x <= value[2],
+      '!between' = x < value[1] | x > value[2],
+      'null' = is.na(x),
+      stop(sprintf('unsupported condition "%s" for criteria type "%s"', condition, type))
+    )
+  } else {
+    stop(sprintf('unsupported criteria type "%s"', type))
+  }
+}

R/shiny.R

@@ -649,6 +649,11 @@ dataTablesFilter = function(data, params) {
   # start searching with all rows
   i = seq_len(n)
 
+  # apply SearchBuilder query if present
+  if (!is.null(s <- q$searchBuilder)) {
+    i = which(sbEvaluateSearch(s, data))
+  }
+
   # search by columns
   if (length(i)) for (j in names(q$columns)) {
     col = q$columns[[j]]

tests/testit/test-searchbuilder.R

@@ -0,0 +1,53 @@
+library(testit)
+
+assert('SearchBuilder condition evaluation works', {
+  (sbEvaluateCondition('>', 'num', 1:2, 1) == c(FALSE, TRUE))
+  (sbEvaluateCondition('between', 'num', 7, c(2, 4)) == FALSE)
+  (sbEvaluateCondition('starts', 'string', 'foo', 'f') == TRUE)
+  (sbEvaluateCondition('starts', 'string', factor('foo'), 'f') == TRUE)
+})
+
+assert('SearchBuilder logic evaluation works', {
+  res = sbEvaluateSearch(
+    list(
+      logic = 'AND',
+      criteria = list(
+        list(condition = '<=', data = 'a', value = '4', type = 'num'),
+        list(condition = '>=', data = 'a', value = '2', type = 'num')
+      )
+    ),
+    data.frame(a = 1:9)
+  )  
+  (setequal(which(res), 2:4))
+  res = sbEvaluateSearch(
+    list(
+      logic = 'OR',
+      criteria = list(
+        list(condition = '>', data = 'a', value = '4', type = 'num'),
+        list(condition = '<', data = 'a', value = '2', type = 'num')
+      )
+    ),
+    data.frame(a = 1:9)
+  )  
+  (setequal(which(res), c(1, 5:9)))
+})
+
+assert('SearchBuilder complex queries work', {
+  res = sbEvaluateSearch(
+    list(
+      logic = 'OR',
+      criteria = list(
+        list(condition = '=', data = 'a', value = '7', type = 'num'),
+        list(
+          logic = 'AND',
+          criteria = list(
+            list(condition = '<=', data = 'a', value = '4', type = 'num'),
+            list(condition = '>=', data = 'a', value = '2', type = 'num')
+          )
+        )
+      )
+    ),
+    data.frame(a = 1:9)
+  )  
+  (setequal(which(res), c(2:4, 7)))
+})