knitr::opts_chunk$set(echo = TRUE)
library(dplyr) library(ggplot2) library(plotly) library(ggtext) library(ggthemes) library(glue) library(stringr) library(kableExtra) library(formattable)
beer_full_df <- read.csv("../data-raw/beer_umap_full.csv") beer_nn <- read.csv("../data-raw/beer_nn.csv")
#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>")))
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
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))
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.