rshinydatatabledt

shiny datatable custom numeric styles and ordering

Using datatables in shiny, I came across following problem regarding formatting of numeric columns and ordering of the values.

I want numeric values to be shown according to a given formatting, e.g.

Using some formatting to manipulate the numeric values, the ordering in the table is destroyed, since values are compared as strings instead of numeric values. I found out that given language options of datatable will tell it how to handle columns according to given speicifcations, but this does not seem to work.

Moreover, DT provides the formatRound method that works in the sense that the numbers are formatted and the ordering works, but e.g. a fixed number of digits is always shown, which is confusing for integers. But integers should also be formatted, since they can be big and marks like "," will be good to grasp the number.

Following App illustrates the problem

library(shiny)

markerDecimal <- ","
markerThousand <- "."

df <- data.frame(
  "numCol" = c(1900,2.111,0.9),
  "someStrings" = c("A","BB","CCC")
)

ui <- fluidPage(
  h4("Original: No format, numeric sorting works, but numbers are not displayed like I want them to be displayed"),
  DT::dataTableOutput(outputId = "dtNoFormat"),
  h4("Format using base::prettyNum destroying 'numeric behaviour' because of conversion to string"),
  DT::dataTableOutput(outputId = "dtFormat1"),
  h4("Format using DT::formatRound keeping ordering but showing too much decimals that are not required"),
  DT::dataTableOutput(outputId = "dtFormat2")
)

server <- function(input, output, session) {
  
  .formatNumber <- function(x) {
    base::prettyNum(x = x, 
                    big.mark = markerThousand, big.interval = 3, 
                    decimal.mark = markerDecimal, 
                    small.mark = "", small.interval = 3)
  }
  
  .formatDfNums <- function(df, nams = names(df)) {
    numNames <- names(df)[sapply(df, is.numeric)]
    nams2 <- intersect(numNames, nams)
    if(length(nams2)) df[nams2] <- lapply(df[nams2], .formatNumber)
    return(df)
  }
  
  defaultOps <- list(pageLength = 20, 
                     bPaginate = FALSE, bSearch = FALSE)
  
  output$dtNoFormat <- DT::renderDataTable({
    DT::datatable(df, options = defaultOps)
  }, server = FALSE)
  
  output$dtFormat1 <- DT::renderDataTable({
    DT::datatable(
      df |> .formatDfNums(),
      options = c(defaultOps, 
                  list(language.thousands = markerThousand,
                       language.decimal = markerDecimal,
                       columnDefs = list(list(targets = "numCol", 
                                              type = "num-fmt")))))
  }, server = FALSE)
  
  output$dtFormat2 <- DT::renderDataTable({
    DT::datatable(df, options = defaultOps) |>
      DT::formatRound(
        columns = names(df)[sapply(df, is.numeric)],
        digits = 2,
        interval  = 3,
        mark = markerThousand,
        dec.mark = markerDecimal
      )
  }, server = FALSE)
  
}

shinyApp(ui, server, options = list(launch.browser = TRUE))

In one picture: enter image description here

How can I update the app, such that numbers are displayed using the given formatting, e.g. custom thousands and decimals, and the ordering is preserved as a numeric ordering?

Solution

  • You could use DT::formatSignif which does a better job. However, it may use scientific notation, which you may want to avoid as well.

    Your best bet then is to provide a custom formatter. If you look into the source code of DT::formatSignif you will see that under the hood a custom JavaScript formatting function is called (here's the source code of this formatter).

    I would consider this a hack, but you can piggyback on that and do the following:

    1. Add a custom JS formatter function to DTWidget
    2. Create an R function formatSignif2 which is basically a clone of DT::formatSignif but calls your custom formatter instead of the pre-defined one.
    3. Use formatSignif2 in your rendering.
    library(shiny)
library(jsonlite)
library(htmlwidgets)


markerDecimal <- ","
markerThousand <- "."

js <- HTML("
$(function() {
  DTWidget.formatSignif2 = function (data, digits, interval, mark, decMark, zeroPrint) {
    const value = parseFloat(data);
    if (isNaN(value)) {
      return '';
    }
    if (zeroPrint !== null && value === 0.0) {
      return zeroPrint;
    }
    // Round to significant digits
    let roundedValue = Number(value).toPrecision(digits);
    // Convert scientific notation
    if (roundedValue.includes('e')) {
      const [base, exponent] = roundedValue.split('e').map(Number);
      const mantissa = base * Math.pow(10, exponent);
      const base10 = Math.log10(Math.abs(mantissa));
      roundedValue = mantissa.toFixed(Math.max(0, digits - Math.floor(base10) + 1));
    }
    // Remove trailing zeros by parsing back to a number
    roundedValue = parseFloat(roundedValue).toString();
    // Replace decimal marker with own marker
    let [integerPart, fractionalPart] = roundedValue.split('.');
    // Add thousand separators to the integer part
    const re = new RegExp('\\\\B(?=(\\\\d{' + interval + '})+(?!\\\\d))', 'g');
    integerPart = integerPart.replace(re, mark);
    return fractionalPart ? `${integerPart}${decMark}${fractionalPart}` : integerPart;
  }
})  
")

formatSignif2 <- function(table, columns, digits = 2, interval = 3, mark = ",", 
                          dec.mark = getOption("OutDec"), zero.print = NULL, 
                          rows = NULL) {
  tplSignif2 <- function(digits, interval, mark, dec.mark, zero.print, ...) {
    sprintf("DTWidget.formatSignif2(data, %d, %d, %s, %s, %s);", 
            digits, interval, toJSON(unbox(mark)), 
            toJSON(unbox(dec.mark)), 
            if (is.null(zero.print)) "null" else toJSON(unbox(zero.print)))
  }
  DT:::formatColumns(table, columns, tplSignif2, digits, interval, 
                     mark, dec.mark, zero.print, rows = rows)
}

df <- data.frame(
  "numCol" = c(1900,2.111,0.9),
  "someStrings" = c("A","BB","CCC")
)

ui <- fluidPage(
  tags$head(tags$script(js)),
  h1("Default formatSignif"),
  DT::dataTableOutput(outputId = "dtFormat1"),
  h1("Custom formatSignif"),
  DT::dataTableOutput(outputId = "dtFormat2")
)

server <- function(input, output, session) {
  
  defaultOps <- list(pageLength = 20, 
                     bPaginate = FALSE, bSearch = FALSE)
  
  output$dtFormat1 <- DT::renderDataTable({
    DT::datatable(df, options = defaultOps) |>
      DT::formatSignif(
        columns = names(df)[sapply(df, is.numeric)],
        digits = 2,
        interval  = 3,
        mark = markerThousand,
        dec.mark = markerDecimal
      )
  }, server = FALSE)  
  
  output$dtFormat2 <- DT::renderDataTable({
    DT::datatable(df, options = defaultOps) |>
      formatSignif2(
        columns = names(df)[sapply(df, is.numeric)],
        digits = 2,
        interval  = 3,
        mark = markerThousand,
        dec.mark = markerDecimal
      )
  }, server = FALSE)
  
}

shinyApp(ui, server, options = list(launch.browser = TRUE))

    Both solution maintain the intrinsic order of the numbers and teh custom function avoids scientific notation but uses internal DT functions, which must be used with care.

    You may want to further adapt the custom formatter to your needs (think especially about the amount of digits), but this should get you going.

    Result

    2 DT tables forst one using DT::formatSignif which uses scientific notation and the other table shows the full number