How to format numeric row outputs when using renderTable in R Shiny?-CodePudding

In the 4-row table rendered when running the below MWE code, I would like the values in the first 2 rows to be rendered with no decimals, and the values in the last 2 rows to be rendered with decimals carried to the hundredths and a % sign. As shown in the image at very bottom, in the case of the default view when first invoking. This formatting would work for both the default table rendered when first invoking the App and when modifying it (adding/deleting rows).

Is there an efficient way to do this? Perhaps, if possible, without adding a function (embedding it in the output$table3 <- renderTable(.. section below)?

MWE code:

library(shiny)
library(shinyMatrix)
library(magrittr)

# Default matrix for initializing
matrix3DefaultRownames <- c("A", "B", "C", "D")
matrix3Default <- data.frame('Series 1' = c(1, 24, 0, 100), row.names = matrix3DefaultRownames) %>% as.matrix()

matrix3Input <- function(inputId, matrix3Default) {
  matrixInput(
    inputId = inputId,
    label = "Input terms:",
    value = matrix3Default,
    rows = list(extend = FALSE, names = TRUE),
    cols = list(extend = TRUE, names = TRUE, editableNames = FALSE, delete = TRUE),
    class = "numeric"
  )
}

ui <- fluidPage(titlePanel("Inputs"), fluidRow(actionButton("modify", "Modify"), tableOutput("table3")))

server <- function(input, output, session) {
  rv <- reactiveValues(
    mat3 = matrix3Input("matrix3", matrix3Default),
    input = matrix3Default,
    colHeader = colnames(input)
  )
  
  observeEvent(input$modify, {
    showModal(modalDialog(rv$mat3))
  })
  
  output$table3 <- renderTable(
    {
      if (isTruthy(input$modify)) {
        req(input$matrix3)
        
        df <- input$matrix3
        rv$mat3 <- matrix3Input("matrix3", df)
        colnames(df) <- paste("Series", 1:ncol(df))
        rownames(df) <- matrix3DefaultRownames
        rv$input <- df
      } else {
        df <- matrix3Default
        colnames(df) <- paste("Series", 1:ncol(df))
        rownames(df) <- matrix3DefaultRownames
      }
      df
    },
    rownames = TRUE,
    colnames = TRUE
  )
}

shinyApp(ui, server)

CodePudding user response：

@Ronak's answer is nice but it changes the values of the table. I would rather user the columnwise option render, which allows to change the display of the values without changing the values.

library(DT)

dat <- data.frame(
  x = c(
    1.2,
    24.3,
    0,
    0.999
  ),
  y = c(
    12.8,
    34.7,
    0.1,
    0.05
  )
)

js <- c(
  "function(data, type, row, meta){",
  "  var rowindex = meta.row;",
  "  if(type === 'display'){",
  "    if(rowindex <= 1){",
  "      return data.toFixed(0);",
  "    }else{",
  "      return (100*data).toFixed(2)   '%';",
  "    }",
  "  }",
  "  return data;",
  "}"
)

datatable(
  dat,
  options = list(
    columnDefs = list(
      list(targets = c(1, 2), render = JS(js))
    )
  )
)

CodePudding user response：

You may perform this formatting with sprintf -

library(shiny)
library(shinyMatrix)
library(magrittr)

# Default matrix for initializing
matrix3DefaultRownames <- c("A", "B", "C", "D")
matrix3Default <- data.frame('Series 1' = c(1, 24, 0, 100), row.names = matrix3DefaultRownames) %>% as.matrix()

matrix3Input <- function(inputId, matrix3Default) {
  matrixInput(
    inputId = inputId,
    label = "Input terms:",
    value = matrix3Default,
    rows = list(extend = FALSE, names = TRUE),
    cols = list(extend = TRUE, names = TRUE, editableNames = FALSE, delete = TRUE),
    class = "numeric"
  )
}

ui <- fluidPage(titlePanel("Inputs"), fluidRow(actionButton("modify", "Modify"), tableOutput("table3")))

server <- function(input, output, session) {
  rv <- reactiveValues(
    mat3 = matrix3Input("matrix3", matrix3Default),
    input = matrix3Default,
    colHeader = colnames(input)
  )
  
  observeEvent(input$modify, {
    showModal(modalDialog(rv$mat3))
  })
  
  output$table3 <- renderTable(
    {
      if (isTruthy(input$modify)) {
        req(input$matrix3)
        
        df <- input$matrix3
        rv$mat3 <- matrix3Input("matrix3", df)
        colnames(df) <- paste("Series", 1:ncol(df))
        rownames(df) <- matrix3DefaultRownames
        rv$input <- df
      } else {
        df <- matrix3Default
        colnames(df) <- paste("Series", 1:ncol(df))
        rownames(df) <- matrix3DefaultRownames
      }
      df[3:4] <- sprintf('%.2f%%', df[3:4])
      #If you don't want to hardcode 3rd and 4th row and select only last2 rows.
      #n <- nrow(df)
      #df[c(n-1, n)] <- sprintf('%.2f%%', df[c(n-1, n)])
      df
    },
    rownames = TRUE,
    colnames = TRUE
  )
}

shinyApp(ui, server)