knitr::opts_chunk$set(echo = TRUE)

Libs

library(dplyr)
library(ggplot2)
library(plotly)
library(ggtext)
library(ggthemes)
library(glue)
library(stringr)
library(kableExtra)
library(formattable)

Resources

Data

beer_full_df <- read.csv("../data-raw/beer_umap_full.csv")
beer_nn <- read.csv("../data-raw/beer_nn.csv")

UMAP Nearest Neighbors

#Logic that can be moved to helpers.R
colors <- c(
  "#f6c101",
  "#c96e12"
)
selection <- c("Miller Lite")
selection_abv <- beer_full_df %>%
  filter(Brand == selection) %>%
  pull(ABV)

idxs <- beer_nn %>% filter(Brand %in% selection, Neighbor_Rk <= 5) %>% pull(Neighbor_Idx)
neighbor_points <- beer_full_df %>%
  filter(Brand != selection) %>%
  slice(idxs) %>%
  pull(Brand)

neighbor_points_abv <- beer_full_df %>%
  filter(Brand != selection) %>%
  slice(idxs) %>%
  pull(ABV)

beer_full_df$Selected <- if_else(beer_full_df$Brand %in% neighbor_points,"Y","N")

gg_umap <- ggplot(data = beer_full_df,aes(x = UMAP_X,
                                          y = UMAP_Y,
                                          fill = Selected,
                                          color = Selected,
                                          size = Selected,
                                          text = paste0(Brand,"<br>",Brand_Style,"<br>","ABV: ",ABV))) +
  geom_jitter(width = 1,
              height = 1,
              alpha = .7,
              show.legend = FALSE) +
  labs(title = "UMAP Respresentation of Beer Data") +
  scale_fill_manual(values = colors) +
  scale_color_manual(values = colors) +
  scale_size_manual(values = c(1.75,2.75)) +
  theme(plot.title = element_markdown(size = 14),
        plot.subtitle = element_markdown(size = 10),
        plot.caption = element_markdown(),
        legend.position = "none",
        axis.title = element_blank(),
        axis.ticks = element_blank(),
        axis.text = element_blank(),
        panel.background = element_rect(fill = "white", colour = "white"),
        panel.grid.major = element_line(colour = "#d9d9d9",size = .5))

ggplotly(gg_umap, tooltip = "text") %>%
            config(displayModeBar = F) %>%
            layout(title = list(text = paste0("BEER ME Nearest Neighbors",
                                                     "<br>",
                                                     "<sup>",
                                                     "UMAP 2-D representation of beer ingreidents",
                                                     "</sup>")))

Zoomed in Neighbor Selection

zoom_neighbor_data <- tibble(
  x = c(0,.72,.72,-.72,-.72,0),
  y = c(0,.72,-.72,-.72,.72,1.2),
  center_x = c(0,0,0,0,0,0),
  center_y = c(0,0,0,0,0,0),
  beer = c(selection,neighbor_points),
  abv = c(selection_abv,neighbor_points_abv)
)
# format label
zoom_neighbor_data$abv = str_c(zoom_neighbor_data$abv,rep(c("%"),6),sep = "")
zoom_neighbor_data$label = str_c(zoom_neighbor_data$beer,zoom_neighbor_data$abv,sep = "\nABV: ")

neighbor_zoom <- ggplot(data = zoom_neighbor_data) +
  geom_segment(aes(x = x, y = y, xend = center_x, yend = center_y),
               colour = colors[2]) +
  geom_point(aes(x = x, y = y),
             size = 5,
             colour = colors[2]) +
  geom_label(aes(x = x, y = y,label = label),
             fill = colors[2],
             color = "white",
             label.padding = unit(0.45, "lines"),
             size = 3) +
  xlim(-1.5,1.5) +
  ylim(-1.5,1.5) +
  labs(title = glue("If you like ","<b style='color:#c96e12'>",selection,"</b> you might<br>also enjoy these ","<b style='color:#c96e12'>similar beers</b>"),
       caption = "For detailed ingredients on each beer, go to the Beer Data tab") +
  theme(plot.title = element_markdown(size = 14, hjust = .5, vjust = .1),
        plot.subtitle = element_markdown(size = 10),
        plot.caption = element_markdown(hjust = .5),
        legend.position = "none",
        axis.title = element_blank(),
        axis.ticks = element_blank(),
        axis.text = element_blank(),
        panel.background = element_rect(fill = "white", colour = "white"),
        panel.grid = element_blank())
neighbor_zoom

KableExtra Table

colors <- c(
  "#f6c101",
  "#c96e12"
)
selection <- c("Miller Lite")

https://cran.r-project.org/web/packages/kableExtra/vignettes/use_kable_in_shiny.html

idxs <- beer_nn %>% filter(Brand %in% selection, Neighbor_Rk <= 5) %>% pull(Neighbor_Idx)
neighbor_points <- beer_full_df %>%
  filter(Brand != selection) %>%
  slice(idxs) %>%
  select(Brand, Brand_Style, ABV, Calories)
neighbor_points <- neighbor_points %>%
  mutate(ABV = color_tile("white","#df8d03")(ABV),
         Calories = color_bar("#fae96f")(Calories))
kable(neighbor_points, escape = F) %>% 
  kable_styling(full_width = FALSE, position = "left",
                bootstrap_options = c("hover")) %>% 
  row_spec(1:nrow(neighbor_points), color = "black") %>%
  column_spec(3:4,width = "1cm") %>% 
  add_header_above(c(" "= 2, "Nutrition" = 2))

Beer Data Table




spelk24/BeerRecommonderApp documentation built on July 13, 2020, 3:23 a.m.