Creating function for Column Headers using KableExtra

61 Views Asked by At

I'm trying to create a vector which I can pass to the add_header_above() function from KableExtra for R for a frequency table with headers above columns.

Eventually my vector should look like this:

c(" ", "I1" = 2, "SI2" = 2, "SI1" = 2, "VS2" = 2, "VS1" = 2, "VVS2" = 2, "VVS1" = 2, "IF" = 2, "Total" = 2)

What am I doing wrong? I want each header to expand over two columns (except for the first empty header), but it takes only one column each time when i pass

my.header.above(indep.var = diamonds$cut, dep.var = diamonds$clarity)

into add_header_above() and instead, " = 2 " is added in the column header next to the clarity label; " 'I1 =' 2 ".


my.header.above <- function(indep.var, dep.var) {
  
  myTable = addmargins(table(indep.var,
                             dep.var))
  colnames(myTable)[dim(myTable)[2]] <- "Total"
  
  Header.above <- character(dim(myTable)[2]) 
  
  for (j in 1:dim(myTable)[2]) {
    
    Header.above[j+1] <- paste0('"',colnames(myTable)[j], '"',' = ', 2)

  }
  
  return(Header.above)
  
}

my.header.above(indep.var = diamonds$cut,
                dep.var = diamonds$clarity)

1

There are 1 best solutions below

1
TarJae On

One possible solution is to pass the headers as named elements of a concatenated list, here the names are headers and elements are the column span.

We can directly assign names like: names(Header.above) <- colnames(myTable), alternatively we can use setNames: Header.above <- setNames(numeric(dim(myTable)[2]) + 2, colnames(myTable)):

library(ggplot2) # diamonds dataset
my.header.above <- function(indep.var, dep.var) {
  
  myTable = addmargins(table(indep.var, dep.var))
  colnames(myTable)[dim(myTable)[2]] <- "Total"
  
  Header.above <- numeric(dim(myTable)[2]) + 2
  names(Header.above) <- colnames(myTable)
  #  Header.above <- setNames(numeric(dim(myTable)[2]) + 2, colnames(myTable))
  
  Header.above = c(" " = 1, Header.above)
  
  return(Header.above)
}

my.header.above(indep.var = diamonds$cut, dep.var = diamonds$clarity)

         I1   SI2   SI1   VS2   VS1  VVS2  VVS1    IF Total 
    1     2     2     2     2     2     2     2     2     2