# [整洁星期二]2019-05-28

By vincent507cpu at 2019-05-30 • 1人收藏 • 605人看过

For #tidytuesday this week, I explored the sweet deal metric (points:price ratio) across all wine types by country, for the 15 countries with the most observations in the dataset. Yeah Chilean wine

https://github.com/allisonhorst/allison-tidy-tuesdays

```#######
# Tidy Tuesday 5/28/2019
# Wine ratings
#######

# Attach packages
library(tidyverse)
library(extrafont)
library(ggdark)

# Get the data:

# A bunch of wrangling (much unnecessary) + exploration station:

# Find the points-to-price ratios:
wine_deal <- wine_ratings %>%
select(points, price, title) %>% # Only keep these columns
mutate(pp_ratio = points/price) %>% # Find the points:price ratio
arrange(-pp_ratio) # Arrange by high-to-low ratio

# Checking counts for each wine type (don't really care):
wine_counts <- wine_ratings %>%
group_by(title) %>%
tally() %>%
arrange(-n)

# Find the top 15 countries with them most reviews:
country_counts <- wine_ratings %>%
group_by(country) %>%
tally() %>%
arrange(-n) %>%
select(country)

# Find the median point:price ratio for those 15 countries:
# Note: something is effed here. (not reproducible right now)
country_medians <- wine_deal %>%
inner_join(wine_ratings) %>%
inner_join(country_counts) %>%
group_by(country) %>%
summarize(
med_ratio = median(pp_ratio, na.rm = TRUE)
) %>%
arrange(-med_ratio)

# Join to have prices, number, ratio in single table, relevel by medians:
wine_all <- wine_deal %>%
inner_join(wine_ratings) %>%
inner_join(wine_counts) %>%
inner_join(country_counts) %>%
select(title, pp_ratio, country, variety,n) %>%
drop_na(country) %>%
mutate(country = as.factor(country)) %>% # Not necessary?
mutate(country = fct_relevel(country, country_medians\$country))

# Violin plot of points:price ratios by country
ggplot(wine_all, aes(x = reorder(country, desc(country)), y = pp_ratio)) +
geom_violin(aes(color = country, fill = country), width = 1.0) +
geom_boxplot(fill = NA, color = "white", width = 0.4, size = 0.3, outlier.color = NA) +
labs(x = "Country\n",y = "\nPoints-per-price ratio (higher = better)", title = "Wine points:price ratio (sweet deal metric) by country", subtitle = "*For the 15 countries with the highest number of reviews in Kaggle dataset") +
dark_mode(theme_minimal()) +
theme(legend.position = "NA",
text = element_text(family = "Muli"),
plot.subtitle = element_text(size = 8, face = "italic")) +
coord_flip()

ggsave("2019-05-28/wine_deals.png", width = 5, height = 4)``` My #TidyTuesday contribution for the week - showing the relationship between score and price for wines, and highlighting 5 key wines (best <\$100 [x2], worst >\$100, most expemsive 100-pointer [x2]) #Rstats Code and notes available at griffinevo.github.io

```library('tidyverse')

ggplot(data = wine_ratings %>%
filter(country == c('US', 'France', 'Italy', 'Spain', 'Portugal', 'Chile'))) +
# Facet plots
facet_wrap(~ country, nrow = 2) +
# Main data
geom_point(
mapping = aes(x = points, y = price),
alpha = 0.3, color = rgb(140/255, 40/255, 50/255)) +
# Highlight 5 key wines -
#   most expensive 100-pointers
#   best wines under \$100
#   worst wine over \$100
geom_point(data = filter(wine_ratings,
price > 900 & points == 100| price < 100 & points == 100| price > 100 & points < 82),
mapping = aes(x = points, y = price), color = 'black') +
# Label the winery and province
geom_text(data = filter(wine_ratings,
price > 900 & points == 100| price < 100 & points == 100| price > 100 & points < 82),
mapping = aes(x = points, y = price, label = paste0(winery, ', ', province)), size = 2.9,
check_overlap = T, nudge_x = c(5,-9,-9,-8,-8), nudge_y = c(100, -100, -220, 300, 420)) +  # Base theme
theme_linedraw() +
# Axis titles
labs(x = 'Wine Enthusiast Rating (out of 100)', y = 'Price (\$)') +
# Styling
theme(    # Facet strip color
strip.background = element_rect(fill = rgb(140/255, 40/255, 50/255)),
strip.text = element_text(size = 12),    # Grid lines color
panel.grid.major = element_line('grey60'),
panel.grid.minor = element_line('grey69'),    # Titles further from axes
axis.title.x = element_text(margin = margin(t = 15)),
axis.title.y = element_text(margin = margin(r = 15)),
# Axes title and label size
axis.title = element_text(size = 12),
axis.text  = element_text(size = 12)
) +
# Grid spacings
scale_x_continuous(minor_breaks = seq(80, 100, 1)) +
scale_y_continuous(limits = c(0, 1500), minor_breaks = seq(0, 1500, 100))``` My #tidytuesday 22|2019 contribution: Analyzing words of 129,971 wine descriptions (and their pairwise correlation) #rstats #ggraph

```library(tidyverse)
library(tidytext)
library(widyr)
library(igraph)
library(ggraph)
library(viridis)

path <-
paste0(
'https://raw.githubusercontent.com/rfordatascience/tidytuesday/',
'master/data/2019/2019-05-28/'
)

rename(id = X1)

# common words to describe wine: https://www.words-to-use.com/words/wine/

theme_options <- theme(
legend.title = element_text(
size = 9, margin = margin(b = 5), face = 'bold'
),
legend.text = element_text(size = 7),
legend.margin = margin(t = 15, b = 15),
legend.key.width = unit(10, 'points'),
plot.title = element_text(
margin = margin(b = 12), color = '#32b37f', size = 14, hjust = 0.5,
face = 'bold'
),
plot.subtitle = element_text(
margin = margin(b = 15), size = 11, hjust = 0.5, face = 'bold'
),
plot.margin = margin(t = 40, r = 20, b = 20, l = 20)
)

wine_words <- wine_ratings %>%
unnest_tokens('word', description) %>%
select(id, country, points, price, variety, word)

top_wine_words <- wine_words %>%
group_by(word) %>%
summarize(total = n()) %>%
arrange(desc(total)) %>%

threshold <- 0.02

wine_word_correlations <- wine_words %>%
filter(word %in% top_wine_words\$word) %>%
pairwise_cor(word, id, sort = TRUE) %>%
filter(correlation > threshold) %>%
arrange(desc(correlation))

wine_averages_per_word <- wine_words %>%
filter(word %in% top_wine_words\$word) %>%
group_by(word) %>%
summarize(
total = n(),
avg_points = mean(points, na.rm = TRUE),
avg_price = mean(price, na.rm = TRUE)
) %>%
rename(name = word) %>%
arrange(desc(total))

graph <- wine_word_correlations %>%
rename(weight = correlation) %>%
mutate(alpha = cut(weight, c(threshold, 0.05, 1))) %>%
graph_from_data_frame(vertices = wine_averages_per_word)

ggraph(graph, layout = 'fr', niter = 15000) +
geom_edge_link(aes(edge_alpha = alpha), edge_width = 0.2) +
geom_node_point(aes(size = total, color = avg_points)) +
geom_node_text(
aes(label = name), size = 3, repel = TRUE
) +
scale_color_viridis(
limits = c(84, 91.5),
breaks = c(85.0, 87.5, 90.0, 92.5)
) +
scale_size_area(
breaks = c(250, 1000, 2500, 5000, 10000, 25000),
labels = function(n) { format(n, big.mark = ',') }
) +
scale_edge_alpha_manual(
values = c(0.03, 0.4), labels = c('weak', 'strong')
) +
labs(
title = paste(
'Words in',
format(nrow(wine_ratings), big.mark = ','),
'Wine Descriptions I.'
),
subtitle = paste(
'120 common words to describe wine and their correlation',
'#tidytuesday 22 | 2019',
sep = '   •   '
),
color = 'Average Rating',
size = 'Word Count',
edge_alpha = 'Correlation'
) +
theme_void() +
theme_options +
guides(
edge_alpha = guide_legend(order = 1),
size = guide_legend(order = 2)
)

ggsave(
'images/tidytuesday_201922_wine_ratings_most_common_words.png',
width = 10, height = 8.5, dpi = 300
)

################################################################################

wine_words <- wine_ratings %>%
unnest_tokens('word', description) %>%
anti_join(stop_words, by = 'word') %>%
filter(
!str_detect(word, '^\\d+\$'),
!word %in% c('alongside', 'offers', 'feels')
) %>%
select(id, country, points, price, variety, word)

top_wine_words <- wine_words %>%
count(word, sort = TRUE) %>%

wine_word_correlations <- wine_words %>%
filter(word %in% top_wine_words\$word) %>%
pairwise_cor(word, id, sort = TRUE) %>%
filter(correlation > 0.0) %>%
arrange(desc(correlation))

wine_averages_per_word <- wine_words %>%
filter(word %in% top_wine_words\$word) %>%
group_by(word) %>%
summarize(
total = n(),
avg_points = mean(points, na.rm = TRUE),
avg_price = mean(price, na.rm = TRUE)
) %>%
rename(name = word) %>%
arrange(desc(total))

threshold <- 0.065

graph <- wine_word_correlations %>%
filter(correlation > threshold) %>%
rename(weight = correlation) %>%
mutate(alpha = cut(weight, c(0, threshold, 0.13, 1))) %>%
graph_from_data_frame(vertices = wine_averages_per_word)

ggraph(graph, layout = 'fr', niter = 15000) +
geom_edge_link(aes(edge_alpha = alpha), edge_width = 0.2) +
geom_node_point(aes(size = total, color = avg_points)) +
geom_node_text(
aes(label = name), size = 3, repel = TRUE
) +
scale_color_viridis(
limits = c(86, 90), breaks = c(86.0, 87.0, 88.0, 89.0, 90.0)
) +
scale_size_area(
breaks = c(5000, 10000, 25000, 50000),
labels = function(n) { format(n, big.mark = ',') }
) +
scale_edge_alpha_manual(
values = c(0.03, 0.4), labels = c('weak', 'strong')
) +
labs(
title = paste(
'Words in',
format(nrow(wine_ratings), big.mark = ','),
'Wine Descriptions II.'
),
subtitle = paste(
'150 most frequent words and their correlation',
'#tidytuesday 22 | 2019',
sep = '   •   '
),
color = 'Average Rating',
size = 'Word Count',
edge_alpha = 'Correlation'
) +
theme_void() +
theme_options +
guides(
edge_alpha = guide_legend(order = 1),
size = guide_legend(order = 2)
)

ggsave(
'images/tidytuesday_201922_wine_ratings_most_frequent_words.png',
width = 10, height = 8.5, dpi = 300
)```  Happy #TidyTuesday ! Today's theme is

1 个回复 | 最后更新于 2019-05-30
2019-05-30   #1