Question

我有一个闪亮的R应用程序，我使用＆＃34; renderTable＆＃34;用于呈现动态创建的表的函数。该表在一种情况下可以有3个字符列和4个数字列，在另一种情况下有2个字符列和2个数字列。 ui.R的renderTable代码是：

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

     })

这适用于除了justify之外指定的所有格式选项。所有数字列在输出中左对齐。

任何人都可以阐明原因吗？

Answer 1

您可以使用tableOutput（a.k.a。uiOutput）包裹htmlOutput，以便在数据发生变化时更改align参数。这是一个例子。

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

如果列数始终相同，则可以使用align renderTable参数，例如：

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))

请注意，您还指定了行名称的对齐方式。

Answer 3

如果列数不同但所需的对齐方式相同，则可以使用align ='r'

Answer 4

要改进Gregor's answer，您可以使用align函数来计算compute_align()向量：

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-所有列的默认值，"l"，"c"或"r"之一
except-命名列表，其中名称是align的有效值，每个元素的字符向量包含将进行该对齐的列的名称
rownames-如果rownames = TRUE中的renderTable()，则可以指定行名的对齐方式。接受与align相同的值。

同一示例，使用此功能实现。该功能也可能更普遍地适用于xtable()。

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))

闪亮的R renderTable右对齐

4 个答案: