Skip to content

Instantly share code, notes, and snippets.

@shv38339
Created May 20, 2017 22:31
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save shv38339/a037739131880b200f0545d890517d1d to your computer and use it in GitHub Desktop.
Save shv38339/a037739131880b200f0545d890517d1d to your computer and use it in GitHub Desktop.
Table Function to output descriptive statistics
# try to do table function in base R
tbl_steele <- function(data, var, ...){
require(descr)
require(htmlTable)
levels_logic <- lapply(data[, var], function(x) levels(x))
levels_logic1 <- lapply(levels_logic, function(x) is.null(x)) # combine these statements in the future
if(sum(unlist(levels_logic1)) < length(var)){
cat("Are all of your variables properly labelled?\n")
cat("When your variables are properly labelled, the table will be easier to read.")
}
a <- lapply(data[, var], function(x) freq(x, plot = F))
b <- do.call(rbind, a)
remove_total <- "Total"
d <- b[!rownames(b) %in% remove_total, ]
e <- suppressWarnings(data.frame(d))
e_percent <- sprintf("%.1f", e$Percent)
f <- cbind(paste0(e$Frequency, " ", "(", e_percent, ")"))
g <- lapply(mtcars[, var], function(x) length(unique(x)))
g1 <- do.call(rbind, g)
h <- htmlTable(f, rnames = rownames(d), rgroup = var, n.rgroup = c(g1), header = "Count (%)", ...)
return(h)
}
# run the function
# use test data set mtcars
# tbl_steele(data = mtcars, var = c("vs", "am"), caption = "Descriptive Statistics Table")
# in order to test the levels/labels, use the following
# mtcars$vs <- factor(mtcars$vs, levels = c(0, 1), labels = c("0. Zero", "1. One"))
# you'll see that the levels for am are 0/1, hopefully prompting the user to label their factor variables
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment