Wykresy zmiennej ilościowej

dane %>%
  filter(Languages=="Polish") %>%
ggplot(aes(x = IMDb.Score)) +
  geom_histogram(
    aes(fill = Series.or.Movie)
    ,bins = 10
    ,color = 'black'
  ) +
  labs(title = 'Polskie filmy i seriale')

ggplot(dane, aes(x=IMDb.Score, fill=Series.or.Movie)) +
  geom_density(alpha=.25) +
  labs(title = 'Gęstość rozkładu ocen') 

Wykresy zmiennej jakościowej

dane %>%
  filter(Runtime != '') %>%
  ggplot(aes(Runtime)) +
  geom_bar(aes(fill = Runtime))+
  scale_x_discrete(
    limits = c('< 30 minutes'
               ,'30-60 mins'
               ,'1-2 hour'
               ,'> 2 hrs')
    ,labels = function(x) str_wrap(x, width = 8)
  ) +
  theme(
    legend.position = 'none'
    ,axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1)
  ) +
  scale_fill_manual(values = brewer.pal(4, 'Accent'))

Oceny wg Series.or.Movie:

ggplot(dane, aes(x=factor(Series.or.Movie),y=IMDb.Score)) +
  geom_violin(scale="area")

## Warning: Removed 8 rows containing non-finite values (stat_ydensity).

Wykresy dwóch zmiennych ilościowych

ggplot(dane, aes(x = IMDb.Score, y = IMDb.Votes)) +
  geom_point(aes(color = Series.or.Movie)) +
  geom_smooth(
    method = 'lm'
    ,se = FALSE
  ) +
  theme(legend.position = c(0.2, 0.8))

Wykresy dwóch zmiennych jakościowych

dane %>%
  filter(Runtime != '') %>%
  ggplot(aes(x = Series.or.Movie, y = Runtime)) +
  geom_jitter(aes(color = Runtime)) +
  theme(legend.position = 'none') +
  scale_y_discrete(
    limits = c('< 30 minutes'
               ,'30-60 mins'
               ,'1-2 hour'
               ,'> 2 hrs')
  ) +
  labs(x = '', y = '')

Wykresy zmiennej ilościowej vs zmiennej jakościowej

medians = dane %>%
  group_by(Series.or.Movie) %>%
  summarize(m = median(IMDb.Score, na.rm = TRUE))

ggplot(dane, aes(x = Series.or.Movie, y = IMDb.Score)) +
  geom_boxplot(
    aes(fill = Series.or.Movie)
    ,outlier.alpha = 0.25
  ) +
  geom_text(
    data = medians
    ,aes(x = Series.or.Movie, y = m, label = m)
    ,color = 'blue'
    ,hjust = 7
  ) +
  stat_boxplot(geom ='errorbar', position = 'dodge') +
  stat_summary(
    aes(ymax = ..y.., ymin = ..y..)
    ,fun = mean
    ,geom = 'errorbar'
    ,width = .75
    ,linetype = 'solid'
    ,position = 'dodge'
    ,color = 'white'
    ,size = 1
  ) +
  theme(legend.position = 'none')

Wykresy bąbelkowe

gatunki <- dane %>% 
  select(Genre) %>% 
  unlist() %>% 
  strsplit(',') %>%
  unlist() %>% 
  trimws() %>% 
  table() %>% 
  as.data.frame()

gatunki <- data.frame(
  Gatunek = gatunki$.
  ,`Count` = gatunki$Freq
  ,`IMDb Score Average` = NA
  ,`IMDb Votes Average` = NA
)

for (i in 1:nrow(gatunki)) {
  gatunki$IMDb.Score.Average[i] <- dane %>% 
    filter(str_detect(Genre, gatunki$Gatunek[i] %>%
                        as.character() %>% eval())) %>%
    select(IMDb.Score) %>% unlist() %>% mean(na.rm = TRUE)
  
  gatunki$IMDb.Votes.Average[i] <- dane %>% 
    filter(str_detect(Genre, gatunki$Gatunek[i] %>%
                        as.character() %>% eval())) %>%
    select(IMDb.Votes) %>% unlist() %>% mean(na.rm = TRUE)
}

ggplot(gatunki, aes(IMDb.Score.Average, IMDb.Votes.Average, label = Gatunek)) +
  geom_point(aes(color = Gatunek, size = Count)) +
  geom_text_repel() +
  theme(legend.position = 'none')

Kilka wykresów na jednym panelu

dane %>%
  filter(Runtime != '') %>%
  ggplot(aes(x = IMDb.Score)) +
  geom_histogram(
    aes(fill = Series.or.Movie)
    ,bins = 50
    ,color = 'black'
  ) +
  # facet_grid(.~ Series.or.Movie) +
  # facet_grid(Series.or.Movie ~ .) +
  # facet_grid(Runtime ~ Series.or.Movie, scales = 'free') +
  # facet_wrap(vars(Series.or.Movie), ncol = 2) +
  # facet_wrap(vars(Series.or.Movie), nrow = 2) +
  facet_wrap(vars(Series.or.Movie, Runtime), nrow = 2, scales = 'free') +
  theme(legend.position = 'none')

Zadanie domowe

Korzystając z paczki danych “germancredit” dotyczącą oceny kredytowej (creditability) wybranych klientów pewnego banku wykreśl zmienną ilościową (np. wysokość kredytu); zmienną jakościową (ryzyko); ilościową wg jakościowej (np. wiek wg ryzyka); 2 ilościowe (wiek wg wysokości kredytu) oraz wykres bąbelkowy wg własnego pomysłu.

data(germancredit)

ggplot(germancredit, aes(x = credit.amount)) +
  geom_histogram(bins = 10, color = 'black') +
  labs(title = 'Wysokość kredytu')

ggplot(germancredit, aes(x = credit.history)) +
  geom_bar(aes(fill = credit.history)) +
  theme(axis.text.x = element_blank(), axis.title.x = element_blank()) +
  labs(title = 'Historia kredytowa', fill = 'Stan kredytów')

ggplot(germancredit, aes(x = purpose, y = credit.amount)) +
  geom_boxplot(aes(fill = purpose) ,outlier.alpha = 0.25) +
  theme(axis.text.x = element_blank(), axis.title.x = element_blank()) +
  labs(title = 'Wysokość kredytu według jego celu', fill = 'Cel kredytu')

ggplot(germancredit, aes(x = age.in.years, y = credit.amount)) +
  geom_jitter(aes(color = creditability)) +
  labs(title = 'Wysokość kredytu według wieku', color = 'Zdolność kredytowa')

status <- germancredit %>%
  group_by(personal.status.and.sex) %>%
  summarise(count = length(personal.status.and.sex), `duration.mean` = NA ,`credit.mean` = NA)

for (i in 1:nrow(status)) {
  status$duration.mean[i] <- germancredit %>% 
    filter(str_detect(personal.status.and.sex, status$personal.status.and.sex[i] %>%
                        as.character() %>% eval())) %>%
    select(duration.in.month) %>% unlist() %>% mean(na.rm = TRUE)
  
  status$credit.mean[i] <- germancredit %>% 
    filter(str_detect(personal.status.and.sex, status$personal.status.and.sex[i] %>%
                        as.character() %>% eval())) %>%
    select(credit.amount) %>% unlist() %>% mean(na.rm = TRUE)
}
  
ggplot(status, aes(x = credit.mean, y = duration.mean, label = personal.status.and.sex)) +
  geom_point(aes(color = personal.status.and.sex, size = count)) +
  geom_text_repel() +
  labs(title = 'Średnie długość i wielkość kredytu według statusu i płci', size = 'Liczba', color = 'Status i płeć')

Zadania dodatkowe - dla chętnych:

CHALLENGE 6: Stwórz analogiczny wykres pokazujący aktorów grających w najpopularniejszych produkcjach.

# miejsce na kod

CHALLENGE 7: Stwórz analogiczny wykres pokazujący w jakich latach powstawały najpopularniejsze produkcje

# miejsce na kod

CHALLENGE 8: Jakie są najpopularniejsze języki dostępne na Netflixie? Podpowiedź: wykres kolumnowy.

języki <- dane %>% 
  select(Languages) %>% 
  unlist() %>% 
  strsplit(',') %>%
  unlist() %>% 
  trimws() %>% 
  table() %>% 
  as.data.frame()

colnames(języki) <- c('Język', 'Liczba')

języki <- języki %>%
  arrange(desc(Liczba))

języki_pop <- języki[1:15,]

ggplot(języki_pop, aes(x = reorder(Język, -Liczba), y = Liczba)) +
  geom_col() +
  theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1)) +
  scale_fill_manual(values = brewer.pal(4, 'Accent')) +
  labs(title = 'Najpopularniejsze języki') +
  xlab('Język') +
  ylab('Liczba wystąpień')

ODP: Jak widać, najpopularniejszy język to zdecydowanie angielski, a za nim znajdują się japoński, hiszpański i francuski.

CHALLENGE 9: Dla filmów i seriali stwórz wykresy ocen z poszczególnych portali (Hidden Gem, IMDb, Rotten Tomatoes, Metacritic). Podpowiedź: warto odpiwotować dane do formatu long.

library(gridExtra)
g1 = ggplot(dane, aes(x = IMDb.Score*10, fill = Series.or.Movie)) +
  geom_histogram(bins = 20)

g2 = ggplot(dane, aes(x = Rotten.Tomatoes.Score, fill = Series.or.Movie)) +
  geom_histogram(bins = 20)

g3 = ggplot(dane, aes(x = Metacritic.Score, fill = Series.or.Movie)) +
  geom_histogram(bins = 20)

g4 = ggplot(dane, aes(x = Hidden.Gem.Score*10, fill = Series.or.Movie)) +
  geom_histogram(bins = 20)

grid.arrange(g1, g2, g3, g4, ncol = 2)

Odp: Z wykresów dowiadujemy się np. że seriale oceniane są głownie na IMDB oraz Hidden gem. Widzimy też, że Metacritic i Rotten Tomatoes posiadają sporo mniej ocen niz pozostałe portale.

CHALLENGE 10: Jakie wytwórnie filmowe produkują najwięcej i jak się to zmieniało na przestrzeni ostatnich lat?

dane_lata <- dane %>%
  mutate(Release = Release.Date %>% as.Date(format = '%m/%d/%Y')) %>%
  mutate(release_year = format(Release, format = "%Y"))

wytwórnie2020 <- dane_lata %>%
  filter(release_year == 2020) %>%
  select(Production.House) %>%
  unlist() %>%
  strsplit(',') %>%
  unlist() %>%
  trimws() %>%
  table() %>%
  as.data.frame()

colnames(wytwórnie2020) <- c('Wytwórnia', 'Liczba')

wytwórnie2020 <- wytwórnie2020 %>%
  arrange(desc(Liczba))

wywórnie_pop20 <- wytwórnie2020[1:5,]

wytwórnie2019 <- dane_lata %>%
  filter(release_year == 2019) %>%
  select(Production.House) %>%
  unlist() %>%
  strsplit(',') %>%
  unlist() %>%
  trimws() %>%
  table() %>%
  as.data.frame()

colnames(wytwórnie2019) <- c('Wytwórnia', 'Liczba')

wytwórnie2019 <- wytwórnie2019 %>%
  arrange(desc(Liczba))

wywórnie_pop19 <- wytwórnie2019[1:5,]

wytwórnie2018 <- dane_lata %>%
  filter(release_year == 2018) %>%
  select(Production.House) %>%
  unlist() %>%
  strsplit(',') %>%
  unlist() %>%
  trimws() %>%
  table() %>%
  as.data.frame()

colnames(wytwórnie2018) <- c('Wytwórnia', 'Liczba')

wytwórnie2018 <- wytwórnie2018 %>%
  arrange(desc(Liczba))

wywórnie_pop18 <- wytwórnie2018[1:5,]

wytwórnie2017 <- dane_lata %>%
  filter(release_year == 2017) %>%
  select(Production.House) %>%
  unlist() %>%
  strsplit(',') %>%
  unlist() %>%
  trimws() %>%
  table() %>%
  as.data.frame()

colnames(wytwórnie2017) <- c('Wytwórnia', 'Liczba')

wytwórnie2017 <- wytwórnie2017 %>%
  arrange(desc(Liczba))

wywórnie_pop17 <- wytwórnie2017[1:5,]

wytwórnie2016 <- dane_lata %>%
  filter(release_year == 2016) %>%
  select(Production.House) %>%
  unlist() %>%
  strsplit(',') %>%
  unlist() %>%
  trimws() %>%
  table() %>%
  as.data.frame()

colnames(wytwórnie2016) <- c('Wytwórnia', 'Liczba')

wytwórnie2016 <- wytwórnie2016 %>%
  arrange(desc(Liczba))

wywórnie_pop16 <- wytwórnie2016[1:5,]

w1 <- ggplot(wywórnie_pop20, aes(x = reorder(Wytwórnia, -Liczba), y = Liczba)) +
  geom_col() +
  theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1)) +
  scale_fill_manual(values = brewer.pal(4, 'Accent')) +
  labs(title = 'Popular in 2020') +
  xlab('Wytwórnia') +
  ylab('Liczba filmów')

w2 <- ggplot(wywórnie_pop19, aes(x = reorder(Wytwórnia, -Liczba), y = Liczba)) +
  geom_col() +
  theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1)) +
  scale_fill_manual(values = brewer.pal(4, 'Accent')) +
  labs(title = 'Popular in 20219') +
  xlab('Wytwórnia') +
  ylab('Liczba filmów')

w3 <- ggplot(wywórnie_pop18, aes(x = reorder(Wytwórnia, -Liczba), y = Liczba)) +
  geom_col() +
  theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1)) +
  scale_fill_manual(values = brewer.pal(4, 'Accent')) +
  labs(title = 'Popoular in 2018') +
  xlab('Wytwórnia') +
  ylab('Liczba filmów')

w4 <- ggplot(wywórnie_pop17, aes(x = reorder(Wytwórnia, -Liczba), y = Liczba)) +
  geom_col() +
  theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1)) +
  scale_fill_manual(values = brewer.pal(4, 'Accent')) +
  labs(title = 'Popular in 2017') +
  xlab('Wytwórnia') +
  ylab('Liczba filmów')

w5 <- ggplot(wywórnie_pop16, aes(x = reorder(Wytwórnia, -Liczba), y = Liczba)) +
  geom_col() +
  theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1)) +
  scale_fill_manual(values = brewer.pal(4, 'Accent')) +
  labs(title = 'Popular in 2016') +
  xlab('Wytwórnia') +
  ylab('Liczba filmów')

grid.arrange(w1, w2, w3, w4, w5, ncol = 3)