-
-
Save gvelasq/a39348f59f4353a9478704a28f86ed69 to your computer and use it in GitHub Desktop.
Create Stata-like ASCII tables in R
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
############################################################ | |
# # | |
# statascii # | |
# Create Stata-like ASCII tables in R # | |
# # | |
############################################################ | |
library(dplyr) | |
library(stringr) | |
statascii <- function(df, flavor = "oneway", padding = "stata", pad = 1L, ...) { | |
## error checking | |
stopifnot(is.data.frame(df)) | |
if (ncol(df) <= 2L & flavor == "twoway") { | |
stop("data.frame must have at least three columns for 'twoway' flavor", | |
call. = FALSE) | |
} | |
if (ncol(df) <= 1L) { | |
stop("data.frame must have at least two columns", call. = FALSE) | |
} | |
## internal functions | |
df <- as.matrix(sapply(format(df, digits = 3L, scientific = FALSE), as.character)) | |
if (ncol(df) == 1L) { | |
df <- t(df) | |
} | |
if (padding == "stata") { | |
colnames(df) <- str_pad(colnames(df), 9L, pad = " ") | |
} | |
else if (padding == "none") { | |
} | |
SepLine <- function(n, pad = 1L) { | |
tmp <- lapply(n, function(x, pad) | |
paste0(rep("\xe2\x94\x80", x + (2L * pad)), | |
collapse = ""), | |
pad = pad) | |
paste0("\xe2\x94\x80", paste(tmp, collapse = "\xe2\x94\xbc")) | |
} | |
Row1 <- function(x, n, pad = 1L) { | |
foo <- function(i, x, n) { | |
fmt <- paste0("%", n[i], "s") | |
sprintf(fmt, as.character(x[i])) | |
} | |
rowc <- sapply(seq_along(x), foo, x = x, n = n) | |
paste0(" ", | |
paste(paste0(rep(" ", pad), rowc[1], rep(" ", pad)), collapse = ""), | |
"\xe2\x94\x82", | |
paste(paste0(rep(" ", pad), rowc[-1], rep(" ", pad)), collapse = " ") | |
) | |
} | |
Row2 <- function(x, n, pad = 1L) { | |
foo <- function(i, x, n) { | |
fmt <- paste0("%", n[i], "s") | |
sprintf(fmt, as.character(x[i])) | |
} | |
rowc <- sapply(seq_along(x), foo, x = x, n = n) | |
paste0( | |
paste(paste0(rep(" ", pad), rowc[1], rep(" ", pad)), collapse = ""), | |
"\xe2\x94\x82", | |
paste(paste0(rep(" ", pad), rowc[2:(length(rowc) - 1)], rep(" ", pad)), collapse = ""), | |
"\xe2\x94\x82", | |
paste(paste0(rep(" ", pad), rowc[length(rowc)], rep(" ", pad)), collapse = " ") | |
) | |
} | |
## convert everything to characters | |
## nchar in data | |
mdf <- apply(df, 2, function(x) max(nchar(x))) | |
## nchar in names | |
cnames <- nchar(colnames(df)) | |
## max nchar of name+data per elements | |
M <- pmax(mdf, cnames) | |
M1 <- as.integer(c(M[1], | |
sum(M[2:(length(M))]) + (3L * ncol(df)) - 6L)) | |
M2 <- as.integer(c(M[1] - 1L, | |
sum(M[2:(length(M) - 1L)], | |
(2L * ncol(df)) - 6L), | |
M[length(M)] - 1L)) | |
if (flavor == "oneway") { | |
## write the header | |
sep <- SepLine(M1, pad = pad) | |
writeLines(Row1(colnames(df), M, pad = pad)) | |
writeLines(sep) | |
## write the rows | |
totalLine <- nrow(df) - 1L | |
for (i in seq_len(nrow(df))) { | |
## write a row | |
writeLines(Row1(df[i, ], M, pad = pad)) | |
## write separator | |
if (i == totalLine) { | |
writeLines(sep) | |
} | |
} | |
} | |
else if (flavor == "twoway") { | |
## write the header | |
sep <- SepLine(M2, pad = pad) | |
writeLines(Row2(colnames(df), M, pad = pad)) | |
writeLines(sep) | |
## write the rows | |
totalLine <- nrow(df) - 1L | |
for (i in seq_len(nrow(df))) { | |
## write a row | |
writeLines(Row2(df[i, ], M, pad = pad)) | |
## write separator | |
if (i == totalLine) { | |
writeLines(sep) | |
} | |
} | |
} | |
else if (flavor == "summary") { | |
## write the header | |
sep <- SepLine(M1, pad = pad) | |
writeLines(Row1(colnames(df), M, pad = pad)) | |
writeLines(sep) | |
## write the rows | |
for (i in seq_len(nrow(df))) { | |
## write a row | |
writeLines(Row1(df[i, ], M, pad = pad)) | |
} | |
} | |
invisible(df) | |
} | |
## Examples | |
# Setup | |
library(dplyr) | |
library(stringr) | |
# Demonstrate 'oneway' flavor for one-way tables of frequencies | |
a <- mtcars %>% count(gear) %>% rename(Freq. = n) | |
a <- a %>% add_row(gear = "Total", Freq. = sum(a[,2])) | |
statascii(a, flavor = "oneway") | |
# Demonstrate 'oneway' flavor with no Stata-like padding | |
a <- mtcars %>% count(gear) %>% rename(Freq. = n) | |
a <- a %>% add_row(gear = "Total", Freq. = sum(a[,2])) | |
statascii(a, flavor = "oneway", padding = "none") | |
# Demonstrate 'twoway' flavor for n-way tables of frequencies | |
b <- mtcars %>% count(gear, carb, am) %>% rename(Freq. = n) | |
b <- b %>% ungroup() %>% add_row(gear = "Total", carb = "", am = "", Freq. = sum(b[,4])) | |
statascii(b, flavor = "twoway") | |
# Demonstrate 'summary' flavor for summary statistics | |
c <- mtcars %>% group_by(gear) %>% summarize( | |
Obs = n(), | |
Mean = mean(gear), | |
"Std. Dev." = sd(gear), | |
Min = min(gear), | |
Max = max(gear) | |
) | |
statascii(c, flavor = "summary") | |
## Reference | |
# `statascii()` borrows heavily from `asciify()`. | |
# The `asciify()` function was written by @gavinsimpson in StackOverflow (https://stackoverflow.com/questions/13011383) and GitHub Gist (https://gist.github.com/gavinsimpson). | |
# The `statascii()' function was written by @gvelasq2 in Github Gist (https://gist.github.com/gvelasq2). |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment