如何在R语言表格中对齐正负值 实现相关矩阵规范排版

1. 对齐效果实现 #

你可以通过修改corstars函数中数值格式化的逻辑实现正负值对齐，核心是在正数前补充与负号等宽的占位空格，修改后的函数代码如下：

corstars <-function(x, method=c("pearson", "spearman"), removeTriangle=c("upper", "lower"),
                     result=c("none", "html", "latex")){
    #Compute correlation matrix
    require(Hmisc)
    x <- as.matrix(x)
    correlation_matrix<-rcorr(x, type=method[1])
    R <- correlation_matrix$r # Matrix of correlation coeficients
    p <- correlation_matrix$P # Matrix of p-value 
    
    ## Define notions for significance levels; spacing is important.
    mystars <- ifelse(p < .001, "*** ", ifelse(p < .01, "**  ", ifelse(p < .05, "*   ", "    ")))
    
    ## 格式化相关系数，正数前自动补空格实现与负值对齐
    R <- apply(R, 2, function(col) {
      formatC(round(col, 2), width = 4, format = "f", digits = 2, flag = " ")
    })
    
    ## build a new matrix that includes the correlations with their apropriate stars
    Rnew <- matrix(paste(R, mystars, sep=""), ncol=ncol(x))
    diag(Rnew) <- paste(diag(R), " ", sep="")
    rownames(Rnew) <- colnames(x)
    colnames(Rnew) <- paste(colnames(x), "", sep="")
    
    ## remove upper triangle of correlation matrix
    if(removeTriangle[1]=="upper"){
      Rnew <- as.matrix(Rnew)
      Rnew[upper.tri(Rnew, diag = TRUE)] <- ""
      Rnew <- as.data.frame(Rnew)
    }
    
    ## remove lower triangle of correlation matrix
    else if(removeTriangle[1]=="lower"){
      Rnew <- as.matrix(Rnew)
      Rnew[lower.tri(Rnew, diag = TRUE)] <- ""
      Rnew <- as.data.frame(Rnew)
    }
    
    ## remove last column and return the correlation matrix
    Rnew <- cbind(Rnew[1:length(Rnew)-1])
    # 适配HTML场景的空格显示，将普通空格替换为非换行空格
    if(result[1] %in% c("html", "none")) {
      Rnew <- as.data.frame(lapply(Rnew, function(col) gsub(" ", "&nbsp;", col)))
    }
    if (result[1]=="none") return(Rnew)
    else{
      if(result[1]=="html") print(xtable(Rnew), type="html")
      else print(xtable(Rnew), type="latex") 
    }
}

调用方式保持不变：

corstars(mtcars)

2. Shiny中使用方法 #

仅通过tableOutput实现效果时，只需在UI端给表格添加等宽字体的CSS样式即可，示例代码如下：

library(shiny)
ui <- fluidPage(
  # 添加CSS指定表格使用等宽字体，保证空格与负号宽度一致
  tags$style(HTML("
    table {
      font-family: 'Consolas', 'Monaco', 'Courier New', monospace;
      border-collapse: collapse;
    }
    td, th {
      padding: 4px 8px;
      text-align: right;
    }
  ")),
  tableOutput("cor_table")
)
server <- function(input, output) {
  output$cor_table <- renderTable({
    corstars(mtcars, result = "none")
  }, rownames = TRUE, escape = FALSE) # escape设为FALSE保证&nbsp;正常解析为空格
}
shinyApp(ui, server)

内容的提问来源于stack exchange，提问作者writer_typer