R/export2xls.R

In compareGroups: Descriptive Analysis by Groups

export2xls<-function(x, file, which.table="descr", nmax=TRUE, header.labels=c()){

    if (!inherits(x, "createTable")) 
        stop("x must be of class 'createTable'")
    if (inherits(x, "cbind.createTable")) 
        stop("x cannot be of class 'cbind.createTable'")
    ww <- charmatch(which.table, c("descr", "avail", "both"))
    if (is.na(ww)) 
        stop(" argument 'which.table' must be either 'descr', 'avail' or 'both'")
    if (ww %in% c(1, 3)) {
        pp <- prepare(x, nmax = nmax, header.labels)
        table1 <- prepare(x, nmax = nmax, header.labels)[[1]]
        cc <- unlist(attr(pp, "cc"))
        ii <- ifelse(rownames(table1)[2] == "", 2, 1)
        table1 <- cbind(rownames(table1), table1)
        if (!is.null(attr(x, "caption"))) 
            table1[, 1] <- paste("    ", table1[, 1])
        aux <- NULL
        for (i in (ii + 1):nrow(table1)) {
            if (!is.null(cc) && cc[i - ii] != "") {
                aux <- rbind(aux, c(cc[i - ii], rep("", ncol(table1) - 1)))
                aux <- rbind(aux, table1[i, ])
            }
            else {
                aux <- rbind(aux, table1[i, ])
            }
        }
        table1 <- rbind(table1[1:ii, ], aux)
        if (nrow(table1) > 1 && length(grep("^N=", trim(table1[2, 2])))) {
            wn <- grep("^N=", trim(table1[2, ]))
            nn <- paste(trim(table1[1, wn]), " ", trim(table1[2, wn]))
            table1[1, wn] <- nn
            table1 <- table1[-2, ]
        }
        table1[1, 1] <- " "
        colnames(table1) <- table1[1, ]
        table1 <- table1[-1, ,drop=FALSE]
        table1 <- rbind(colnames(table1),table1)
        cn <- colnames(table1)
        table1 <- as.data.frame(table1)
        names(table1) <- c(" ",cn[-1])
    }
    if (ww %in% c(2, 3)) {
        table2 <- prepare(x, nmax = nmax, c())[[2]]
        table2 <- cbind(rownames(table2), table2)
          if (!is.null(attr(x, "caption"))) {
            cc <- unlist(attr(x, "caption"))
            table2[, 1] <- paste("    ", table2[, 1])
        }
        aux <- NULL
        for (i in 2:nrow(table2)) {
            if (!is.null(attr(x, "caption")) && !is.null(cc) && cc[i - 1] != "") {
                aux <- rbind(aux, c(cc[i - 1], rep("", ncol(table2) - 
                  1)))
                aux <- rbind(aux, table2[i, ])
            }
            else {
                aux <- rbind(aux, table2[i, ])
            }
        }
        table2 <- rbind(table2[1, ], aux)
        table2[1, 1] <- " "
        colnames(table2) <- table2[1, ]
        table2 <- table2[-1, ,drop=FALSE]
        table2 <- rbind(colnames(table2),table2)
        cn <- colnames(table2)
        table2 <- as.data.frame(table2)
        names(table2) <- c(" ",cn[-1])        
    }
    if (ww==1)
      write_xlsx(list("Descr"=table1), path = file, col_names = FALSE)
    if (ww==2)
      write_xlsx(list("Avail"=table2), path = file, col_names = FALSE)
    if (ww==3)
      write_xlsx(list("Descr"=table1, "Avail"=table2), path = file, col_names = FALSE)
}