shiny R renderTable right alignment

Question

I have a shiny R application in which I'm using "renderTable" function to render the table that is dynamically created. The table may have 3 character columns and 4 numeric columns in one case and has 2 character columns and 2 numeric columns in another case. The renderTable code from ui.R is :

     output$table1 <- renderTable({
                d1<-data()
             print(format(d1, big.mark=",", scientific=FALSE,justify="right", nsmall=0))

     })

This is working for all format options specified except for justify. All numeric columns are left justified in the output.

Can anyone shed some light on why?

Answer 1

You could wrap your tableOutput with an uiOutput (a.k.a. htmlOutput) in order to change the align parameter whenever the data changes. Here is an Example.

library(shiny)

server <- function(input, output, session) {
  output$table_wrapped = renderUI({
    # this table can be reactive since it is inside a render function
    reactiveTable = data.frame(
      name=sapply(1:input$nrows, function(x) paste(
        rep(letters[x], x), 
        collapse=''))
    )
    for( i in 1:input$ncols )
      reactiveTable[letters[i]] = seq(100, 100*input$nrows, by = 100)

    # calculate alignment vector (something like "lrrrrr")
    align = paste(rep('l', ncol(reactiveTable)))
    numeric_columns = which(as.logical(lapply(reactiveTable, is.numeric)))
    align[numeric_columns] = "r"
    align = paste(align, collapse ="")

    # create tableoutput. Since this is inside a render Function, 
    # the alignment changes with the inputs
    output$table <- renderTable({reactiveTable}, align = align)

    # return the tableOutput
    tableOutput('table')
  })
}

ui <- fluidPage(
  inputPanel(
    sliderInput("ncols", "Number of numeric columns", 4, 10, 4),
    sliderInput("nrows", "Number of rows", 4, 10, 4)
  ),
  uiOutput('table_wrapped')
)

runApp(list(ui=ui, server=server))

Answer 2

If the number of columns is always the same, you can use the align argument to renderTable, e.g.:

library(shiny)

server <- function(input, output, session) {
    output$tab <- renderTable({
        data.frame(a=seq(100, 1000, by=100), b=sapply(1:10, function(x) paste(rep(letters[x], x), collapse='')))
    }, align='rrr')

}

ui <- fluidPage(
    tableOutput('tab')
)

runApp(list(ui=ui, server=server))

Note that you have specify the alignment for the row names as well.

Answer 3

if the number of columns varies but the desired alignment is the same you can use align = 'r'

Answer 4

To improve upon Gregor's answer, you can compute the align vector using the compute_align() function:

compute_align <- function(x, align = "l", except = NULL, rownames = NULL){
    align_vec <- rep(align, ncol(x))
    if(!is.null(except)){
        for(i in 1:length(except)){
            align_vec[ names(x) %in% except[[i]] ] <- names(except[i])
        }
    }
    if(!is.null(rownames)) align_vec <- c(rownames, align_vec)
    paste(align_vec, collapse = "")
}

• align - the default for all columns, one of "l", "c" or "r"
• except - a named list, where the name is a valid value for align and the character vector for each element contains the names of the columns that will take that alignment
• rownames - if rownames = TRUE in renderTable(), this allows to specify the alignment of the row names. Accepts the same values as align.

Same example, implemented with this function. The function is probably applicable more generally to xtable() too.

library(shiny)

server <- function(input, output, session) {
    output$table_wrapped = renderUI({
        # this table can be reactive since it is inside a render function
        reactiveTable = data.frame(
            name=sapply(1:input$nrows, function(x) paste(
                rep(letters[x], x), 
                collapse=''))
        )
        for( i in 1:input$ncols )
            reactiveTable[letters[i]] = seq(100, 100*input$nrows, by = 100)

        # calculate alignment vector (something like "lrrrrr")
        # create tableoutput. Since this is inside a render Function, 
        # the alignment changes with the inputs
        output$table <- renderTable({reactiveTable}, 
                                    align = compute_align(reactiveTable, align = "r", 
                                                          except = list(l=c("name"))))

        # return the tableOutput
        tableOutput('table')
    })
}

ui <- fluidPage(
    inputPanel(
        sliderInput("ncols", "Number of numeric columns", 4, 10, 4),
        sliderInput("nrows", "Number of rows", 4, 10, 4)
    ),
    uiOutput('table_wrapped')
)

runApp(list(ui=ui, server=server))