In Economic/epitable: Make HTML Tables Compatible with EPI's Website

library(knitr)

opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

# option to print a subset of lines of chunk output
# source: https://stackoverflow.com/a/23147563/1462014
hook_output <- knit_hooks$get("output")
knit_hooks$set(output = function(x, options) {
  lines <- options$output.lines
  if (is.null(lines)) {
    return(hook_output(x, options))  # pass to default hook
  }
  x <- unlist(strsplit(x, "\n"))
  more <- "..."
  if (length(lines)==1) {        # first n lines
    if (length(x) > lines) {
      # truncate the output, but add ....
      x <- c(head(x, lines), more)
    }
  } else {
    x <- c(more, x[lines], more)
  }
  # paste these lines together
  x <- paste(c(x, ""), collapse = "\n")
  hook_output(x, options)
})

Basic example

epitable contains some example data on trade balances:

library(epitable)
tradebalance

Here is the simplest use of epitable:

epitable(tradebalance, rownamesvar = industry)

Note that you must specify the row names, either as a variable in the above, or as vector:

library(dplyr)
myrownames <- paste(c("My row"),seq(1:12))
tradebalance %>% select(-industry) %>% epitable(rownames = myrownames)

Output options

As you've noticed, by default epitable's output shows up in the RStudio viewer. You can also write the table snippet to a file:

epitable(tradebalance, rownamesvar=industry, file = "mytable.html")

That file will only contain the snippet of HTML that is the table. To write a fully self-contained web page, use the selfcontained option:

epitable(tradebalance, rownamesvar=industry, file = "mytable.html", selfcontained=TRUE)

To display the raw HTML of the table snippet in the console, try

print(epitable(tradebalance, rownamesvar=industry), useViewer=FALSE)

Formatting entries

An easy way to format decimal points, percent signs, etc., is to use the scales package, which transforms columns of your dataset into character strings:

library(scales)

tradebalance_fmt <- tradebalance %>%  
  mutate_at(vars(ends_with("level")), ~number(.,accuracy=0.1, big.mark=",")) %>% 
  mutate_at(vars(ends_with("share")), ~percent(.,accuracy=0.1))

epitable(tradebalance_fmt, rownamesvar=industry)

Row indendation

Row name indendation is handled by the rowlevels option:

epitable(tradebalance_fmt, rownamesvar=industry, rowlevels=rep(1:4,3))

Here is an example of how you might do this a little less randomly:

thelevels <- tradebalance_fmt %>%
  mutate(level = 3) %>%
  mutate(level = ifelse(grepl("Total change|Agriculture, forestry|Mining|Manufacturing", .$industry), 1, level)) %>%
  mutate(level = ifelse(grepl("Oil and gas|Minerals and ores|Nondurable goods|Industrial supplies", .$industry), 2, level)) %>% 
  select(level) %>% 
  pull()

epitable(tradebalance_fmt, rownamesvar=industry, rowlevels=thelevels)

Headers

Use more descriptive column names:

epitable(tradebalance_fmt, 
         rownamesvar=industry, 
         rowlevels=thelevels, 
         colnames=c("Import levels", 
                    "Import shares", 
                    "Export levels", 
                    "Export shares", 
                    "Trade balance levels", 
                    "Trade balance shares")
         )

Add column groups:

epitable(tradebalance_fmt, 
         rownamesvar = industry, 
         rowlevels = thelevels,
         colnames = rep(c("Levels (\\$billions)", "Share of total change"), 3),
         colgroups = list(
           names = c("Imports", "Exports", "Trade balance"), 
           pattern = c(2, 2, 2))
         )

Combine tables

epitable_append() combines multiple tables into one. Note also the use of header=FALSE for table2 below:

# add dollar sign to Total change
data1 <- tradebalance_fmt %>% 
  filter(industry == "Total change") %>% 
  mutate_at(vars(ends_with("level")), ~paste0("$",.))
data2 <- tradebalance_fmt %>% filter(industry != "Total change")

table1 <- epitable(data1, 
                   rownamesvar = industry,
                   colnames = rep(c("Levels (\\$billions)", "Share of total change"),3),
                   colgroups = list(
                     names = c("Imports", "Exports", "Trade balance"), 
                     pattern = c(2, 2, 2))
                   )
table2 <- epitable(data2, 
                   rownamesvar=industry, 
                   rowlevels=thelevels[2:length(thelevels)], 
                   header=FALSE
                   )

epitable_append(table1, table2)

Extra rows

epitable allows extra rows to be added to a table. The syntax is somewhat complicated (suggestions to improve it are very welcome!), but let's see how it works with another example dataset educwages provided by the epitable package that contains mean wages by educational group:

epitable(educwages, rownamesvar = year)

The stat=level and stat=change amounts happen to be in dollars and percent, respectively. We can make that more clear in the resulting epitable by adding extra rows. First let's format the data and create legible column names:

educwages_fmt <- educwages %>% 
  mutate_at(
    vars(starts_with("educ")), 
    ~ifelse(
      stat=="level", 
      paste0("$",number(., accuracy = 0.11)), 
      percent(.,accuracy=0.1)
    )
  ) %>% 
  select(year,starts_with("educ"))

educwages_colnames <- c(
  "Less than high school",
  "High school graduate",
  "Some college",
  "College graduate",
  "Advanced degree"
)

Now let's add extra rows. To do this, include an argument called extrarowN that is a list of additional arguments. The extra row will be added before row N of the table.

The simplest example is to define the extrarowN list as the name of the row:

epitable(educwages_fmt, 
         rownamesvar = year,
         colnames = educwages_colnames,
         extrarow1 = list(name = "Levels"),
         extrarow5 = list(name = "Annualized percent changes")
)

You could also use what EPI's website calls "pseudoheader" rows:

epitable(educwages_fmt, 
         rownamesvar = year,
         colnames = educwages_colnames,
         extrarow1 = list(name = "Levels", pseudoheader=TRUE),
         extrarow5 = list(name = "Annualized percent change", pseudoheader=TRUE)
)

Finally, the easiest table to read might be to include additional lists of colgroups in the extrarowX lists. These require a vector of names and a vector of spanning patterns.

epitable(educwages_fmt, 
         rownamesvar = year,
         colnames = educwages_colnames,
         extrarow1 = list(colgroups = list(names = c("Levels"), 
                                           pattern = c(5))),
         extrarow5 = list(colgroups = list(names = c("Annualized percent changes"),
                                           pattern = c(5)))
)