R/utils.paste.proportions.R

In feranpre/feR: Basic functions that I use all the time

n <- attr(c,"n")
rows <- attr(c,"prop.row")
cols <- attr(c,"prop.col")

# feR:::.paste.proportions(n,rows,rows)
.paste.proportions <- function(n,rows=NULL,cols=NULL,
                               # format="%N (%R,%C)",
                               format.prefix = "(",
                               format.sufix = ")",
                               format.sep =", ",
                               format.n="%n",
                               format.row="R:%r",
                               format.col="C:%c",
                               digits = 4,
                               as.percentage = TRUE,
                               DEBUG = FALSE
                               ) {



  has.rows = !is.null(rows)
  has.cols = !is.null(cols)
  if (is.null(rows)) {
    has.rows = FALSE
    rows = n
    rows[] = NA
  }
  if (is.null(cols))  {
    has.cols = FALSE
    cols <- n
    cols[] = NA
  }

  result <- n
  max.col <- ncol(n)
  max.row <- nrow(n)
  for (r in 1:max.row) {
    for (c in 1:max.col) {

      if (DEBUG) cat("r:",r,"  c:",c,"\n")
      valor_n <- gsub("%n",n[r,c],format.n)
      if (has.rows) valor_r <- gsub("%r",ifelse(as.percentage,paste0(round(rows[r,c], digits = digits)*100,"%"),
                                                                  round(rows[r,c], digits = digits)),format.row)


      if (has.cols)  valor_c <- gsub("%c",ifelse(as.percentage,paste0(round(cols[r,c], digits = digits)*100,"%"),
                                                                round(cols[r,c], digits = digits)),format.col)


      if (has.rows & has.cols){
         if ((r == max.row) & (c == max.col)) result[r,c] = ""
         else if (r == max.row) result[r,c] = result[r,c] <- paste0(valor_n,format.prefix,valor_c,format.sufix)
         else if (c == max.col) result[r,c] = result[r,c] <- paste0(valor_n,format.prefix,valor_r,format.sufix)
         else result[r,c] <- paste0(valor_n,format.prefix,valor_r,format.sep,valor_c,format.sufix)
      } else if (has.rows & !has.cols) {
        if (c == max.col) result[r,c] = result[r,c] <- paste0(valor_n,format.prefix,valor_r,format.sufix)
        else result[r,c] <- paste0(valor_n,format.prefix,valor_r,format.sufix)
      } else if (has.cols & !has.rows) {
        if (r == max.row) result[r,c] = result[r,c] <- paste0(valor_n,format.prefix,valor_c,format.sufix)
        else result[r,c] <- paste0(valor_n,format.prefix,valor_c,format.sufix)
      }


    }
  }

  if(has.rows) names(result) <- names(rows)
  else names(result) <- names(n)

  rownames(result) <- rownames(cols)
  if(has.cols) rownames(result)[nrow(result)] <- "total.column"
  return(result)
}