Chocolate bar ratings

Author

Lee Olney

Published

November 15, 2022

This Quarto document contains a table built in R using {gt} and {gtExtras} packages for the R Studio 2022 Table Contest submission. The table was created for #TidyTuesday week 3 Chocolate Bar ratings, shared on Twitter and Github on Jan 18, 2022.

The table summarizes plain dark chocolate bars’ ratings (between 1 to 5) by twenty two manufacturers with more than fifteen reviews, data from Flavors of Cacao credits to Georgios Karamanis and Kelsey E Gonzalez. The table uses an inline box plot function by Thomas Mock in the blog post Embedding custom HTML in gt tables.

Code

library(tidyverse)
library(gt)
library(gtExtras)
library(kableExtra)

Code

choco<- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2022/2022-01-18/chocolate.csv')

Code

# Get company_manufacturer with more than 15 reviews
df1 = choco %>% count(company_manufacturer, sort=T) %>% filter(n>15)

# Table data
df2 = choco %>% 
  filter(company_manufacturer %in% df1$company_manufacturer)  %>% 
  group_by(company_manufacturer) %>%
  mutate(avg=mean(rating)) %>%
  ungroup() %>%
  mutate(rank = dense_rank(desc(avg))) %>%
  arrange(rank)

rate_list <- split(df2$rating, df2$rank)
rate_rng <- range(df2$rating)

Code

# Citation: Mock (2020, Oct. 31). The Mockup Blog: Embedding custom HTML in gt tables. Retrieved from https://themockup.blog/posts/2020-10-31-embedding-custom-features-in-gt-tables/
gt_plot <- function(table_data, column, plot_data, plot_fun, ...){
  text_transform(
    table_data,
    # note the use of {{}} here - this is tidy eval
    # that allows you to indicate specific columns
    locations = cells_body(columns = vars({{column}})),
    fn = function(x){
      plot <- map(plot_data, plot_fun, width = 300, height = 70, same_lim = TRUE, ...)
      plot_svg <- map(plot, "svg_text")
      map(plot_svg, gt::html)
    }
  )
}

Code

# replaced gt_sparkline() with gt_plt_dist() in gtExtras version 0.4.4.9000
# replaced colors with palette in gt_merge_stack in gtExtras version 0.4.4.9000
df2 %>%
  mutate(company_manufacturer==case_when(company_manufacturer=="Smooth Chocolator, The" ~ "The Smooth Chocolator", 
                                         TRUE~company_manufacturer)) %>%
  group_by(company_location,company_manufacturer) %>%
  summarise(n=n(),
            average = round(mean(rating),2),
            min=min(rating),
            median = round(median(rating),2),
            max=max(rating),
            range= max-min,
            histogram=list(rating),
            .groups="drop") %>%
  arrange(desc(average)) %>%
  mutate(boxplot ="",
         n2 = n) %>%
  select(company_location, company_manufacturer, n, n2, average, histogram, min, median, max, range, boxplot) %>%
  gt() %>%
  gt_theme_538() %>%
  gt_plt_dist(histogram, 
              type = "histogram", 
              line_color = "#66462c", 
              fill_color = "#66462c", 
              bw = .25, 
              same_limit = TRUE) %>%
  gt_plot(
    column = boxplot,  # column to create plot in 
    plot_data = rate_list, # external data to reference
    plot_fun = spec_boxplot,  # which plot fun
    lim = rate_rng, # range applied
    ) %>%
  gt_plt_bar(column=n2, 
             color="#82a6b1",
             width=30) %>%
  gt_merge_stack(company_manufacturer, company_location, palette=c("#38160d","grey")) %>%
  gt_color_rows(columns = c("average","range"),
                palette = "ggsci::brown_material") %>%
  cols_align(columns = c("histogram", "boxplot", "median"),
             align="center") %>%
  cols_label(company_manufacturer = html("Manufacturer"),
             n=html(""),
             n2=html("N reviewed")) %>%
  tab_spanner(label="Rating", 
              columns=c(average:boxplot)) %>%
  tab_header(title=md("<span style='color:#411d13'>Ratings of Plain Dark Chocolate Bars</span>"),
             subtitle=md("Summary table of ratings (between 1 to 5) of by 22 manufacturers with more than 15 reviews, according to *Flavors of Cacao*.")) %>%
  tab_source_note(source_note = gt::html("<br>#TidyTuesday Week 3  |  Data source: Flavors of Cacao, by way of Georgios and Kelsey  |  Inline boxplot function from Thomas Mock")) %>%
  # Adjust sub-title font
  tab_style(
    style = list(
      cell_text(
        weight="lighter"
      )
    ),
    locations = list(
      cells_title(groups = "subtitle")
    )
  )

Manufacturer		N reviewed	Rating
Ratings of Plain Dark Chocolate Bars
Summary table of ratings (between 1 to 5) of by 22 manufacturers with more than 15 reviews, according to Flavors of Cacao.
Manufacturer		N reviewed	average	histogram	min	median	max	range	boxplot
Soma Canada	56		3.59		2.75	3.50	4.00	1.25
Arete U.S.A.	32		3.53		2.75	3.50	4.00	1.25
Smooth Chocolator, The Australia	17		3.51		2.75	3.50	4.00	1.25
Domori Italy	23		3.50		3.00	3.50	4.00	1.00
Dick Taylor U.S.A.	19		3.49		2.75	3.50	4.00	1.25
Bonnat France	30		3.47		1.50	3.50	4.00	2.50
Duffy's U.K.	17		3.44		2.50	3.50	4.00	1.50
A. Morin France	26		3.42		2.75	3.50	4.00	1.25
Fresco U.S.A.	39		3.42		2.75	3.50	4.00	1.25
Rogue U.S.A.	16		3.42		2.75	3.50	4.00	1.25
Pierre Marcolini Belgium	17		3.40		3.00	3.25	4.00	1.00
Castronovo U.S.A.	19		3.38		2.50	3.50	4.00	1.50
Zotter Austria	21		3.32		2.75	3.25	3.75	1.00
Valrhona France	22		3.32		1.50	3.50	4.00	2.50
Dandelion U.S.A.	25		3.30		2.75	3.25	4.00	1.25
Scharffen Berger U.S.A.	17		3.22		2.00	3.50	4.00	2.00
Pralus France	25		3.18		2.00	3.25	4.00	2.00
Guittard U.S.A.	22		3.17		2.50	3.12	3.75	1.25
Coppeneur Germany	19		3.16		1.50	3.25	3.75	2.25
Mast Brothers U.S.A.	18		3.12		2.50	3.00	3.75	1.25
Artisan du Chocolat U.K.	16		3.08		1.75	3.25	4.00	2.25
Hotel Chocolat (Coppeneur) U.K.	19		2.97		2.50	3.00	3.50	1.00
#TidyTuesday Week 3 \| Data source: Flavors of Cacao, by way of Georgios and Kelsey \| Inline boxplot function from Thomas Mock