Render text from other column with styling in DT

Question

I have a table with values and their associated delta and would like to present both info in a single column.

Below is a reproducible example where a,b are current values and their deltas are a.delta,b.delta. Instead of just showing the values in a and b, if for example a=12 and a.delta=7, I would like to show '(+7) 12' and style the delta value (red if negative, green if positive) but keep the column sorting on a's value.

library(tibble)
library(dplyr)
library(DT)

# data
set.seed(99)
df <- tibble::tibble(
  a = runif(10, min = 0, max = 20),
  b = runif(10, min = 0, max = 20),
  a.prev = runif(10, min = 0, max = 20),
  b.prev = runif(10, min = 0, max = 20)
) %>%
  dplyr::mutate(a.delta = a - a.prev, b.delta = b - b.prev) %>%
  dplyr::mutate(dplyr::across(dplyr::everything(), ~ round(.x, 0))) %>%
  dplyr::select(!dplyr::ends_with(".prev"))

# table with all data
DT::datatable(
  df,
  class = "display compact nowrap",
  options = list(dom = "t", paging = FALSE, searching = FALSE)
)

I have tried to use HTML and escape=FALSE but sorting does not work anymore and styling becomes harder. Would this be possible to do with a JS callback? Unfortunately I don't know much about JS but from other examples I suspect it may be possible to do.

Answer 1

Here is one possible option which uses a custom JS render function. To make this work requires some additional data wrangling, i.e. we have to nest both the value and the delta in a list which under the hood will be converted to a JS object:

library(dplyr, warn = FALSE)
library(DT)

set.seed(99)

df <- tibble(
  a = runif(10, min = 0, max = 20),
  b = runif(10, min = 0, max = 20),
  a.prev = runif(10, min = 0, max = 20),
  b.prev = runif(10, min = 0, max = 20)
) %>%
  mutate(a.delta = a - a.prev, b.delta = b - b.prev) %>%
  mutate(across(everything(), ~ round(.x, 0))) %>%
  select(!ends_with(".prev")) |>
  mutate(row = row_number()) |>
  tidyr::nest(.by = row, a = starts_with("a"), b = starts_with("b")) |>
  select(-row) |>
  mutate(
    across(c(a, b), ~ lapply(.x, \(x) {
      x <- as.list(x)
      names(x) <- c("value", "delta")
      x
    }))
  )


DT::datatable(
  df,
  options = list(
    paging = FALSE,
    searching = FALSE,
    columnDefs =
      list(
        list(
          targets = 1:2,
          render = JS(
              "
              function ( data, type, row ) {
                if ( type === 'display' ) { // Data to display
                  let color = 'red';
                  if (data.delta > 0) color = 'green';
                  return '(<span style=\"color: ' + color + ';\">' + 
                    data.delta + '</span>) ' + 
                    data.value;
                }
                return data.value;
              }
              "
          )
        )
      )
  )
)