crank_beauty.R

# survey of crank beauty
# https://forms.gle/CNqHkmeQa6n1cJxL7

library(tidyverse)
library(data.table)
library(patchwork)

# data  ----
"DA 7400	DA 7700	DA 7800	DA 7900	DA 9000	DA 9100
8	7	6	2	5	4
9	9	1	2	7	8
8	7	6	4	4	2
7	8	5	2	2	9
8	9	4	1	3	2
7	9	6	1	7	9
9	9	3	2	4	1
9	8	3	1	1	1
5	8	7	3	9	7
1	8	8	1	9	6
8	9	6	3	2	1
9	7	1	1	6	1
7	6	8	3	4	2
9	9	3	4	4	2
9	8	7	2	5	1
9	8	5	3	2	8
6	5	4	2	3	1
9	6	1	4	6	7" %>%
  read_tsv -> dat

# munge ----
melted <- dat %>% data.table::melt()
tallied <- melted %>%
  group_by(variable, value) %>%
  tally()
d_mean <- tallied %>%
  group_by(variable) %>%
  summarise(mean = weighted.mean(value, n))

# plot ----
# top scores
top_gg <- names(dat)[apply(dat, 1, which.max)] %>% table %>% as_tibble() %>%
  arrange(`.`) %>%
  ggplot(aes(`.`, n)) +
  geom_col(fill='grey') +
  theme_classic() +
  labs(title='Top Scoring Crank',
       subtitle = paste0('n=', nrow(dat), '. Ties to earliest crank.')) +
  scale_y_continuous(breaks=1:nrow(dat))


# # boxplots
# ggplot(melted, aes(x=variable, y=value)) +
#   geom_boxplot() +
#   theme_classic() +
#   scale_y_continuous(breaks=1:9) +
#   labs(title = 'Distribution of bcc dura ace crank beauty ratings',
#        subtitle = paste0('n=', nrow(dat)),
#        x='era', y='rating')

# points w mean line
set.seed(1)
mean_gg <-
  ggplot(melted, aes(x=variable, y=value)) +
  geom_jitter(width=0, height=0.1, alpha=0.5, shape=21,
              aes(fill='one response')) +
  geom_line(data=d_mean,
            aes(y=mean, color='mean'), group=1) +
  theme_classic() +
  scale_y_continuous(breaks=1:9) +
  labs(title = 'Distribution of bcc dura ace crank beauty ratings',
       subtitle = paste0('n=', nrow(dat)),
       x='era', y='rating', color=NULL, fill=NULL) +
  scale_fill_manual(values='black') +
  scale_color_manual(values='red')

# cor plot
cor_gg <- cor(dat) %>%
  #(function(x) {diag(x) <- NA; x}) %>%
  data.table::melt() %>%
  ggplot(aes(Var1, Var2, fill=value)) +
  geom_tile() +
  geom_text(aes(label=round(value, 2), color=value > .3 | value < -.5)) +
  scico::scale_fill_scico(palette = 'vik', direction = -1) +
  scale_color_manual(values= c('black', 'white'), guide=F) +
  theme_classic() +
  labs(title='How correlated are the ratings for crank x and y?',
       subtitle = paste0('n=',nrow(dat)),
       x=NULL, y=NULL,
       fill = paste0('Correlation\n\n',
                     '1=perfect agreement\n',
                     '0=no relationship\n',
                     '-1=perfect opposite'))

# individual responses
individ_gg <- data.table(id=1:nrow(dat), dat) %>%
  melt(id.var='id') %>%
  ggplot(aes(variable, value, group=id,
             color=factor(id))) +
  geom_line() +
  facet_wrap(~factor(id)) +
  theme_classic() +
  theme(legend.position = 'none',
        axis.text.x = element_text(angle=90)) +
  labs(title='Individual Responses', subtitle=paste0('n=', nrow(dat)),
       color='respondent #', linetype = 'respondent #',
       y='beauty rating', x='era')

# all together
(mean_gg + individ_gg) /
  (cor_gg + top_gg)
ggsave('~/Desktop/crank.pdf', w=11, h=8.5)