R/processServerSide.R

In mgencare/RBigPivot: Manages large datasets to be used in a web application data table.

#' Server-side Processing
#' 
#' Processes the data object using R and sends back the data that is needed
#' @export
processServerSide <- function(data, req) {
  
  q <- req;

  n <- nrow(data);
 # ci <- q$search[['caseInsensitive']] == TRUE; Shiny uses this, but not sure where it comes from.

#functions used by server
  grep2 = function(pattern, x, ignore.case = FALSE, fixed = FALSE, ...) {
    if (fixed && ignore.case) {
      pattern = tolower(pattern)
      x = tolower(x)
      ignore.case = FALSE
    }
    # when the user types in the search box, the regular expression may not be
    # complete before it is sent to the server, in which case we do not search
    # if (!fixed && inherits(try(grep(pattern, ''), silent = TRUE), 'try-error'))
    #   return(seq_along(x))
    grep(pattern, x, ignore.case = ignore.case, fixed = fixed, ...)
  }
  
  commaToRange <- function(string) {
    if (!grepl(',', string)) return()
    r = strsplit(string, ',')[[1]]
    if (length(r) > 2) return()
    if (length(r) == 1) r = c(r, '')  # lower,
    r = as.numeric(r)
    if (is.na(r[1])) r[1] = -Inf
    if (is.na(r[2])) r[2] = Inf
    r
  }
  
# global searching
  i = seq_len(n);
  if (q$search[['value']] != '') {
    i0 <- apply(data, 2, function(x) {
      #grep2(q$search[['value']], as.character(x), fixed = q$search[['regex']] == FALSE, ignore.case = ci)
      grep2(q$search[['value']], as.character(x), fixed = q$search[['regex']] == FALSE)
    })
    i = intersect(i, unique(unlist(i0)))
  }
  
# search by columns
# NOT AVAILABLE YET
#
#   if (length(i)) for (j in 1:nrow(q$columns)) {
#     col = q$columns[j,]
#     # if the j-th column is not searchable or the search string is "", skip it
#     if (col[['searchable']] != TRUE && col[['searchable']] != 'true') next
#     if ((k <- col[['search']][['value']]) == '') next
#     j = as.integer(j)
#     dj = data[, j + 1]
#     ij = if (is.numeric(dj) || is.Date(dj)) {
#       r = commaToRange(k)
#       if (length(r) != 2)
#         stop('The range of a numeric / date / time column must be of length 2')
#       if (is.Date(dj)) {
#         # r is milliseconds
#         r = as.POSIXct(r / 1000, origin = '1970-01-01')
#         if (inherits(dj, 'Date')) r = as.Date(r)
#       }
#       which(dj >= r[1] & dj <= r[2])
#     } else if (is.factor(dj)) {
#       which(dj %in% jsonlite::fromJSON(k))
#     } else {
#       grep(k, as.character(dj), fixed = (col[['search']][['regex']] == FALSE),
#             ignore.case = ci)
#     }
#     i = intersect(ij, i)
#     if (length(i) == 0) break
#   }
    if (length(i) != n) data = data[i, , drop = FALSE]
  
# sorting
  oList = list()
  for (ord in 1:nrow(q$order)) {
    k = q$order[ord,'column']  # which column to sort
    d = q$order[ord,'dir']     # direction asc/desc
    if (k > 0 && q$columns[k,][['orderable']] != TRUE) next
    col = data[, as.integer(k) + 1]
    oList[[length(oList) + 1]] = (if (d == 'asc') identity else `-`)(
      if (is.numeric(col)) col else xtfrm(col)
    )
  }
  if (length(oList)) {
    i = do.call(order, oList)
    data = data[i, , drop = FALSE]
  }

# paging
  if (q$length != '-1') {
    i = seq(as.integer(q$start) + 1L, length.out = as.integer(q$length))
    i = i[i <= nrow(data)]
    fdata = data[i, , drop = FALSE]  # filtered data
  } else fdata = data
  
  fdata = unname(as.matrix(fdata))
  
  res <- list(
    draw = as.integer(q$draw),
    recordsTotal = n,
    recordsFiltered = nrow(data),
    data = fdata
  );
  res
  
}