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")
    )
  )  
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 Rating
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