FormatSum <- function(sumReverse, round.proportion=0, round.numeric=1){ ## Version 1.1 5/4/2015 # sumReverse is summary with method='reverse'. sum.cat <- function(outStats, round.proportion, round.numeric, var.name, pv, group.names){ # Categorical # outStats is sumReverse$stats[[i]] o <- outStats nm <- dimnames(outStats)[[2]] l <- length(group.names) if( ncol(outStats) != l){ o <- matrix(0, ncol=l, nrow=nrow(outStats)) row.names(o) <- row.names(outStats) for(k in 1:ncol(outStats)){ o[, which(group.names == nm[k]) ] <- outStats[,k] } } pt <- prop.table(o, margin=2) pp <- ifelse( any(pt>0.999, na.rm=TRUE), 3, 2) pp <- ifelse( round.proportion==0, pp, pp+1+round.proportion) P <- formatC( 100*c(pt), digits=round.proportion, width=pp, format='f') nn <- max(nchar(c(o))) N <- formatC( c(o), width=nn) o <- matrix(paste(N, ' (', P, '%)', sep=''), nrow=nrow(o)) o[, !group.names %in% nm] <- rep('', nrow(o)) o <- cbind(var.name, row.names(outStats), o, pv) if(nrow(o) == 2) o <- o[2,] if(!is.null(nrow(o))){ o[,1] <- c( var.name, rep('', nrow(o)-1)) o[,ncol(o)] <- c(pv, rep('', nrow(o)-1)) } o } sum.num <- function(outStats, quant, round.numeric, var.name, pv, group.names){ # Numerical # outStats is sumReverse$stats[[i]] # quant is sumReverse$quant o <- outStats l <- length(group.names) if( nrow(outStats) != l){ o <- matrix(0, ncol=ncol(outStats), nrow=l) row.names(o) <- group.names for(k in 1:nrow(outStats)){ o[ which(row.names(o) == row.names(outStats)[k]),] <- outStats[k,] } } med <- prettyNum( as.numeric( o[, quant==0.5 ]) )#, digits=round.numeric, format='f')#, width=wdt) loq <- prettyNum( as.numeric( o[, quant==0.25]) )#, digits=round.numeric, format='f')#, width=wdt) upq <- prettyNum( as.numeric( o[, quant==0.75]) )#, digits=round.numeric, format='f')#, width=wdt) num <- paste(med, ' (', loq, ', ', upq, ')', sep='') num[! row.names(o) %in% row.names(outStats) ] <- '' c(var.name, '', num, pv) } args2 <- list(round.proportion, sumReverse$quant) num.dig <- c(round.proportion, round.numeric) group.names <- names(sumReverse$group.freq) if(!is.null(sumReverse$testresults)){ pv <- sapply(sumReverse$testresults, function(x) x$P) pval <- paste('P=', formatC(pv, format='f', digits=3), sep='') pval[ pv<0.001 ] <- 'P<0.001' } else { pval <- rep(' ', length(sumReverse$stats) ) } ta <- NULL for(i in 1:length(sumReverse$stats)){ this.type <- sumReverse$type[i] this.fun <- list(sum.cat, sum.num)[[this.type]] ta0 <- this.fun(sumReverse$stats[[i]], args2[[this.type]], num.dig[this.type], sumReverse$labels[i], pval[i], group.names) ta <- rbind(ta, ta0) } ta <- rbind( c('', '', paste('(N=', as.numeric(sumReverse$group.freq), ')', sep=''), ''), ta) tad <- data.frame(ta, row.names=NULL) names(tad) <- c(' ', ' ', names(sumReverse$group.freq), 'P.value') tad }