formattables.R

library(reshape2)

formattedtable <- function(x, block, group, value) {
    # Form a dataframe with the mean values and get a logical matrix of the max values
    mean <- setNames(aggregate(x[, value], list(x[, block], x[, group]), mean), c(block, group, "mean"))

    # To get the max values need in wide format
    mean.wide <- dcast(mean, get(block) ~ get(group), value.var="mean")  # get() comes from reshape2, gets string values from variables
    colnames(mean.wide)[1] <- block

    # Now can get logical matrix of maximum values
    # NB: This is taken from xtable_printbold.R
    boldmatrix <- matrix(FALSE, ncol = ncol(mean.wide), nrow = nrow(mean.wide))
    max <- TRUE
    max <- rep(max, length = nrow(mean.wide))
    for (i in 1:nrow(mean.wide)) {
        mean.widei <- mean.wide[i,]
        ok <- sapply(mean.widei, is.numeric)
        if (!any(ok)) next
        if (is.na(mean.wide[i])) next
        imax <- max(unlist(mean.widei[ok]), na.rm = TRUE)
        if (!max[i])
            imax <- min(unlist(mean.widei[ok]), na.rm = TRUE)
        whichmax <- sapply(mean.widei, identical, imax)
        boldmatrix[i, whichmax] <- TRUE
    }

    # Calculate standard deviation and combine with mean into new data frame
    sd <- setNames(aggregate(x[, value], list(x[, block], x[, group]), sd), c(block, group, "sd"))
    overall <- merge(mean, sd, by=c(block, group))

    # Make a new column with mean +- sd and drop original mean and sd
    overall$mean_sd <- sprintf("%.3f $\\pm$%.3f", overall$mean, overall$sd)
    overall <- subset(overall, select=-c(mean,sd))

    # Cast into wide format
    overall.wide <- dcast(overall, get(block) ~ get(group), value.var="mean_sd")
    colnames(overall.wide)[1] <- block

    # Finally iterate over the boldmatrix and set TRUE values in new dataframe to bold
    for (row in 1:nrow(boldmatrix)) {
        # Starting at second column as first is blocking factor name
        for (col in 2:ncol(boldmatrix)) {
            if (isTRUE(boldmatrix[row, col])) {
                overall.wide[row,col] <- sprintf("\\textbf{%s}", overall.wide[row,col])
            }
        }
    }

    return(overall.wide)
}