R/make_crosstab.R

In MHDS-NYSPI-CU/mhdstools:

### CROSS-TAB


library(knitr)
library(kableExtra)

#' make_crosstab
#'
#' @param x
#' @param y
#' @param var_name_row
#' @param var_name_col
#'
#' @return kable html object
#' @importFrom knitr kable
#' @importFrom kableExtra kable_styling add_header_above column_spec
#' @export
#'
#' @examples
make_crosstab <- function(x, y, var_name_row, var_name_col, missing = TRUE){
  if (missing == TRUE){
    x[which(is.na(x))] <- "Missing"
    y[which(is.na(y))] <- "Missing"
  }
  
  x <- as.vector(x)
  y <- as.vector(y)
  
  z <- table(x,y)
  
  row_sums <- rowSums(z)
  col_sums <- colSums(z)
  
  blank_mat <- matrix(data = NA, nrow = nrow(z)+1, ncol = ncol(z) + 2)
  for(i in seq_len(nrow(z))){
    for(j in seq_len(ncol(z))){
      blank_mat[i, j+1] <- paste(z[i,j], round(z[i,j]/row_sums[i],3), round(z[i,j]/col_sums[j],3), round(z[i,j]/sum(z),3), sep = "<br>")
    }
  }
  
  # TITLES
  for(m in seq_len(nrow(z))){
    blank_mat[m,1] <- rownames(z)[m]
  }
  colnames(blank_mat) <- rep("", ncol(z)+2)
  colnames(blank_mat)[1] <- var_name_row
  colnames(blank_mat)[ncol(blank_mat)] <- paste("N", "Row %", "Col %", "Tot %", sep = "<br>")
  for(n in seq_len(ncol(z))){
    colnames(blank_mat)[n+1] <- colnames(z)[n]
  }
  
  #GRAND SUMS
  
  for(k in seq_len(nrow(z))){
    temp_sum_r <- round(row_sums[k]/sum(z),3)
    blank_mat[k, ncol(z) + 2] <- paste(row_sums[k], temp_sum_r, sep = "<br><br>")
    
  }
  for(l in seq_len(ncol(z))){
    temp_sum_c <- round(col_sums[l]/sum(z),3)
    blank_mat[nrow(z)+1, l+1] <- paste(col_sums[l], temp_sum_c, sep = "<br>")
  }
  
  blank_mat[nrow(z) +1, ncol(z) +2] <- sum(z)
  blank_mat[nrow(z) + 1, 1] <- ""
  
  chi_res <- chisq.test(x, y)
  
  #Chi-squared
  blank_mat[nrow(blank_mat),1] <- paste0("Chi-squared = ", round(chi_res$statistic,4), "<br>",
                                         "df = ", chi_res$parameter, " p = ", round(chi_res$p.value, 4))
  
  blank_df <- as.data.frame(blank_mat)
  
  header_vec <- c(" " = 1, "Test" = ncol(z), " " = 1)
  names(header_vec)[2] <- paste(var_name_col)
  
  out <- kable(blank_df,"html", escape = F) %>%
    kable_styling("bordered",full_width = T) %>%
    add_header_above(header_vec) %>%
    column_spec(1, width = "14em", bold = TRUE)
  
  return(out)
  
}

make_crosstab(x,y, "Race", "Employment")