Search code examples
rfor-loopdplyrgt

Loop one column and apply gt function to generate multiple plots using R


Given a data sample as follows:

df <- structure(list(category = c("food", "food", "food", "food", "electronic product", 
"electronic product", "electronic product", "electronic product"
), type = c("vegetable", "vegetable", "fruit", "fruit", "computer", 
"computer", "other", "other"), variable = c("cabbage", "radish", 
"apple", "pear", "monitor", "mouse", "camera", "calculator"), 
    price = c(6, 5, 3, 2.9, 2000, 10, 600, 35), quantity = c(2L, 
    4L, 5L, 10L, 1L, 3L, NA, 1L)), class = "data.frame", row.names = c(NA, 
-8L))

I'm able to draw a table plot with code below:

library(gt)
library(magrittr)

dt <- df %>% 
  group_by(category) %>%
  gt() %>% 
  tab_header(
    title = md("Category name")
  )%>%
     tab_style(
     locations = cells_column_labels(columns = everything()),
     style     = list(
       #Give a thick border below
       cell_borders(sides = "bottom", weight = px(3)),
       #Make text bold
       cell_text(weight = "bold")
     )
   ) %>%
     tab_style(
     locations = cells_row_groups(groups = everything()),
     style     = list(
       cell_text(weight = "bold")
     )
   ) %>%
  cols_align(align = "center", columns = everything())
dt
gt::gtsave(dt, file = file.path("./Category_name.png"))

Out:

enter image description here

Now I hope to loop category and group_by(type) to generate multiple plots for each category. At same time, I also need to rename each plot with name of category by modifying gtsave(dt, file = file.path("./Category_name.png")) and tab_header(title = md("Category name"))%>% dynamically.

How could I acheive that with R and gt package? Thanks.

EDIT: to plot for food category

food <- df %>% 
  filter(category=='food') %>% 
  group_by(type) %>%
  gt() %>% 
  tab_header(
    title = md("Food")
  )%>%
  fmt_missing(
    columns = where(is.numeric),
    missing_text = "-"
  ) %>%
     tab_style(
     locations = cells_column_labels(columns = everything()),
     style     = list(
       #Give a thick border below
       cell_borders(sides = "bottom", weight = px(3)),
       #Make text bold
       cell_text(weight = "bold")
     )
   ) %>%
     tab_style(
     locations = cells_row_groups(groups = everything()),
     style     = list(
       cell_text(weight = "bold")
     )
   ) %>%
  cols_align(align = "center", columns = where(is.character)) %>%
  cols_align(align = "right", columns = where(is.numeric))
gt::gtsave(food, file = file.path("./food.png"))

Solution

  • I would turn your code into a function, then put each category into their own dataframe in a list, then apply the function with purrr::map.

    library(tidyverse)
    library(gt)
    
    plot_category <- function(x) {
      p <- x %>%
        dplyr::select(-category) %>% 
        dplyr::group_by(type) %>%
        gt() %>%
        tab_header(title = md(str_to_title(x$category[1]))) %>%
        fmt_missing(columns = where(is.numeric),
                    missing_text = "-") %>%
        tab_style(
          locations = cells_column_labels(columns = everything()),
          style     = list(
            #Give a thick border below
            cell_borders(sides = "bottom", weight = px(3)),
            #Make text bold
            cell_text(weight = "bold")
          )
        ) %>%
        tab_style(locations = cells_row_groups(groups = everything()),
                  style     = list(cell_text(weight = "bold"))) %>%
        cols_align(align = "center", columns = where(is.character)) %>%
        cols_align(align = "right", columns = where(is.numeric))
      
      gt::gtsave(p, file = file.path(paste0("./", x$category[1], ".png")))
      
    }
    
    df %>%
      dplyr::group_split(category) %>%
      purrr::map(plot_category)
    

    Output

    enter image description here