Найти и визуализировать лучшие и худшие предметы с помощью boxplot - PullRequest
Новая
       159

Найти и визуализировать лучшие и худшие предметы с помощью boxplot

0 голосов
/ 18 февраля 2019

Я набор данных шуток Набор данных 2 ( jester_dataset_2.zip ) из проекта Jester , и я хотел бы разделить шутки на группы шуток с аналогичным рейтингом и визуализироватьрезультаты соответственно.

Данные выглядят следующим образом 

> str(tabulka)
'data.frame':   1761439 obs. of  3 variables:
 $ User  : int  1 1 1 1 1 1 1 1 1 1 ...
 $ Joke  : int  5 7 8 13 15 16 17 18 19 20 ...
 $ Rating: num  0.219 -9.281 -9.281 -6.781 0.875 ...

Вот подмножество Набор данных 2 . 

> head(tabulka)
  User Joke Rating
1    1    5  0.219
2    1    7 -9.281
3    1    8 -9.281
4    1   13 -6.781
5    1   15  0.875
6    1   16 -9.656

Я обнаружил, что яне может использовать ANOVA, так как однородность не то же самое.Поэтому я использую метод Крускала-Уоллиса из пакета Agricola в R. 

KWtest <- with ( tabulka , kruskal ( Rating , Joke ))

Вот группы. 

> head(KWtest$groups)
  trt   means  M
1  53 1085099  a
2 105 1083264  a
3  89 1077435 ab
4 129 1072706  b
5  35 1070016 bc
6  32 1062102  c

Дело в том, что я не знаю, как визуализировать шуткугруппы соответственно.Я использую boxplot, чтобы показать доверительные интервалы для каждой шутки. 

barvy <- c ("yellow", "grey")
boxplot (Rating ~ Joke, data = tabulka,
         col = barvy,
         xlab = "Joke",
         ylab = "Rating",
         ylim=c(-7,7))

Было бы неплохо как-то покрасить каждую коробку (каждую шутку) соответствующим цветом в соответствии с цветом, заданным тестом KW.

Как я мог это сделать?Или есть какой-то лучший способ найти лучшие и худшие шутки в наборе данных?

1 Ответ

0 голосов
/ 18 февраля 2019

Интересный вопрос как таковой .Каждый столбик легко раскрасить в соответствии с группой, к которой принадлежит шутка.Тем не менее, я думаю, что это всего лишь промежуточное решение, должна быть лучшая визуализация для этих данных.Так что, конечно, не самый лучший, но есть моя версия: 

library(tidyverse)

# download data (jokes, part 1) to temporaty file, and unzip
tmp <- tempfile()
download.file("http://eigentaste.berkeley.edu/dataset/jester_dataset_1_1.zip", tmp)
tmp <- unzip(tmp)

# read data from temp
vtipy <- readxl::read_excel(tmp, col_names = F, na = '99')

# clean data
vtipy <- vtipy %>%
  mutate(user = 1:n()) %>%
  gather(key = 'joke', value = 'rating', -c('..1', 'user')) %>%
  rename(n = '..1', ) %>%
  filter(!is.na(rating)) %>%
  mutate(joke = as.character(as.numeric(gsub('\\.+', '', joke)) - 1)) %>%
  select(user, n, joke, rating)

# your code
KWtest <- with(vtipy, agricolae::kruskal(rating, joke))

# join groups from KWtest to original data, clean and plot
KWtest$groups %>%
  rownames_to_column('joke') %>%
  select(joke, groups) %>%
  right_join(vtipy, by = 'joke') %>% 
  mutate(joke = stringi::stri_pad_left(joke, 3, '0')) %>%
  ggplot(aes(x = joke, y = rating, fill = groups)) +
  geom_boxplot(show.legend = F) +
  scale_x_discrete(breaks = stringi::stri_pad_left(c(1, seq(5, 100, by = 5)), 3, '0')) +
  ggthemes::theme_tufte() +
  labs(x = 'Joke', y = 'Rating')

jokes

...