APA Style Table for GT Package

apa_style_gt.R

# Provides APA 7th Styling to a table ####
# Only works using the global-font-options branch of the gt package
#Requires
library(gt)
library(tidyverse)

# APA style ####
apa_style <- function(data) {
  data %>%
    opt_table_lines(extent = "none") %>%
    tab_options(
      heading.border.bottom.width = 2,
      heading.border.bottom.color = "black",
      heading.border.bottom.style = "solid",
      table.border.top.color = "white",
      table_body.hlines.color = "white",
      table_body.border.top.color = "black",
      table_body.border.top.style = "solid",
      table_body.border.top.width = 1,
      heading.title.font.size = 12,
      table.font.size = 12,
      heading.subtitle.font.size = 12,
      table_body.border.bottom.color = "black",
      table_body.border.bottom.width = 1,
      table_body.border.bottom.style = "solid",
      column_labels.border.bottom.color = "black",
      column_labels.border.bottom.style = "solid",
      column_labels.border.bottom.width = 1
    ) %>%
      opt_table_font(font = "times")
}

# Fun Example with Sparkline
#Sparklines
iris %>%
  filter(Species == "setosa") %>%
  ggplot(aes(y=Sepal.Length)) + 
  geom_density(size = 3) +
  coord_flip() +
  ggthemes::theme_tufte(base_size = 15) +
  theme(axis.title=element_blank(),
        axis.text.y = element_blank(), 
        axis.ticks = element_blank(),
        strip.text = element_blank(),
        axis.text.x = element_blank()) -> setosa

iris %>%
  filter(Species == "versicolor") %>%
  ggplot(aes(y=Sepal.Length)) + 
  geom_density(size = 3) +
  coord_flip() +
  ggthemes::theme_tufte(base_size = 15) +
  theme(axis.title=element_blank(),
        axis.text.y = element_blank(), 
        axis.ticks = element_blank(),
        strip.text = element_blank(),
        axis.text.x = element_blank()) -> versicolor

iris %>%
  filter(Species == "virginica") %>%
  ggplot(aes(y=Sepal.Length)) + 
  geom_density(size = 3) +
  coord_flip() +
  ggthemes::theme_tufte(base_size = 15) +
  theme(axis.title=element_blank(),
        axis.text.y = element_blank(), 
        axis.ticks = element_blank(),
        strip.text = element_blank(),
        axis.text.x = element_blank()) -> virginica
# Table
#(iris %>%
#  select(Species, everything()) %>%
#  group_by(Species) %>%
#  summarise_if(is.numeric, mean) %>%
#  ungroup() %>%
#  mutate(Sparkline = NA) %>%
#  gt() %>%
#  tab_header(
#    title = "Table 1",
#    subtitle = md("_Table Title_")
#  ) %>%
#  opt_align_table_header(align = "left") %>%
#  tab_spanner(
#    label = "Sepal",
#    columns = vars(
#      Sepal.Length, Sepal.Width
#      ) 
#  ) %>%
#  tab_spanner(
#    label = "Petal",
#    columns = vars(
#      Petal.Length, Petal.Width
#    ) 
#  ) %>%
#  cols_label(
#    Sepal.Length = "Length",
#    Sepal.Width = "Width",
#    Petal.Length = "Length",
#    Petal.Width = "Width",
#    #Sparkline = "Sepal Length Distribution"
#  ) %>% 
#  cols_align(
#    align = "center"
#    ) %>%
#  cols_align(
#    align = "left",
#    columns = vars(Species)
#  )  %>%
#  tab_footnote(
#    footnote = "Example note.",
#    locations = cells_body(
#      columns = vars(Sepal.Length),
#      rows = 2
#    )
#  ) %>%
#  tab_source_note(
#    source_note = md("_Notes._ This is a note")
#  ) %>%
#  apa_style %>%
#  text_transform(
#    locations = cells_body(
#      columns = vars(Sparkline),
#      rows = 1),
#    fn = function(x) {
#      setosa %>%
#        ggplot_image(height = px(20))
#    }
#  )  %>%
#  text_transform(
#    locations = cells_body(
#      columns = vars(Sparkline),
#      rows = 2),
#    fn = function(x) {
#      versicolor %>%
#        ggplot_image(height = px(20))
#    }
#  )  %>%
#  text_transform(
#    locations = cells_body(
#      columns = vars(Sparkline),
#      rows = 3),
#    fn = function(x) {
#      virginica %>%
#        ggplot_image(height = px(20))
#    }
#  ) -> table)

# Save as image for IPPE google docs workflow
#gtsave(data = table, path = "~", filename = "table1.png")