Podstawowe operacje w R - część 5.

Wizualizacja danych

Wizualizacja danych z biblioteką ggplot2
- Wykresy zmiennej ilościowej
- Wykresy zmiennej jakościowej
- Wykresy dwóch zmiennych ilościowych
- Wykresy dwóch zmiennych jakościowych
- Wykresy zmiennej ilościowej vs zmiennej jakościowej
- Wykresy bąbelkowe (3x Challenge)
- Kilka wykresów na jednym panelu (2x Challenge).

Przydatne materiały:
- ggplot2 cheatsheet
- A. Kassambara - Guide to Create Beautiful Graphics in R. - Hadley Wickham “ggplot2”

Dane pochodzą ze strony https://flixgem.com/ (wersja zbioru danych z dnia 12 marca 2021). Dane zawierają informacje na temat 9425 filmów i seriali dostępnych na Netlix.

Wizualizacja danych z ggplot2

theme_set(theme_bw())

Podstawowe zasady tworzenia wykresów z ggplot2:
- do funkcji ggplot() podajemy ramkę danych oraz opcjonalnie osie x, y i parametry shape, color, fill, group
- dodajemy wykresy za pomocą funkcji zaczynających się geom_ lub stat_
- modyfikujemy wykresy dodając legendy, tytuły, znaczniki na osiach etc.

Do szybkich analiz można skorzystać z funkcji qplot(), która automatycznie dobiera typ wykresu do rodzaju danych.

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'))

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 = 'loess'
    ,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 + przedstaw kilka wykresów na 1 panelu.

data("germancredit")
attach(germancredit)
# http://archive.ics.uci.edu/ml/datasets/Statlog+(German+Credit+Data)

Wykres 1 zmiennej ilościowej -

wysokosc_kredytu <- germancredit$credit.amount
germancredit %>%
  ggplot(aes(x=credit.amount)) +
    geom_histogram(aes(fill=credit.amount), bins=10, color="red") +
  labs(title="Wykres 1 zmiennej ilościowej - wysokość kredytu")

Wykres 2 zmiennej jakościowej “ryzyko”

ryzyko <- germancredit$creditability
germancredit %>%
  ggplot(aes(x=creditability)) +
    geom_bar(aes(fill=creditability), color="green") +
    labs(title="Wykres 2 zmiennej jakościowej - ryzyko")

Wykres 3 zmiennej ilościowej wg jakościowej: wiek wg ryzyka

germancredit %>%
  ggplot(aes(x=age.in.years)) +
  geom_density(aes(fill=creditability))+
  labs(title="Wykres 3 Zmienna ilościowa wg jakościowej - wiek wg ryzyka")

Wykres 4 : wykres 2 ziennych ilościowych: wiek wg wysokości kredytu

germancredit %>%
  ggplot(aes(x=age.in.years, y=credit.amount)) +
  geom_point(aes(color=creditability), method= 'loess',se = FALSE) +
  labs(title="2 zmienne ilościowe - wiek wg wysokości kredytu")

## Warning: Ignoring unknown parameters: method, se

Kilka wykresów na 1 panelu

#Kilka wykresów w 1 panelu
job <- germancredit$job
germancredit %>%
  ggplot(aes(x=credit.amount)) +
  geom_density(aes(fill=job), bins=50) +
  facet_wrap(vars(job, ncol=2, nrow=2))

## Warning: Ignoring unknown parameters: bins

Wykres 5 : wykres bąbelkowy

job <- as.character(germancredit$job)

praca <- germancredit %>% 
  select(job) %>% 
  unlist() %>% 
  trimws() %>% 
  table() %>% 
  as.data.frame()

praca <- data.frame(
  praca = praca$.
  ,`Count` = praca$Freq
  ,`credit.amount.average` = NA
  ,`duration.in.month.average` = NA
)

for (i in 1:nrow(praca)) {
  praca$credit.amount.average[i] <- germancredit %>% 
    filter(str_detect(job, praca$praca[i] %>%
                        as.character() %>% eval())) %>%
    select(credit.amount) %>% unlist() %>% mean(na.rm = TRUE)
  
  praca$duration.in.month.average[i] <- germancredit %>% 
    filter(str_detect(job, praca$praca[i] %>%
                        as.character() %>% eval())) %>%
    select(duration.in.month) %>% unlist() %>% mean(na.rm = TRUE)
}

ggplot(praca, aes(duration.in.month.average, credit.amount.average, label=praca)) +
  geom_point(aes(color = praca, size = Count)) +
  geom_text_repel() +
  theme(legend.position = '') +
  labs(title = "Wykres bąbelkowy - wysokość kredytu, długość kredytowania na podstawie statusu zatrudnienia")

Zadania dodatkowe - dla chętnych:

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

aktorzy <- dane %>% 
  select(Actors) %>% 
  top_n(25) %>%
  unlist() %>% 
  strsplit(',') %>%
  unlist() %>% 
  trimws() %>% 
  table() %>% 
  as.data.frame()

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

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

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

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

data <- dane %>% 
  select(Release.Date) %>% 
  top_n(50) %>%
  unlist() %>% 
  strsplit(',') %>%
  unlist() %>% 
  trimws() %>% 
  table() %>% 
  as.data.frame()

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

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

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

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

jezyki <- dane %>% 
  select(Languages) %>% 
  unlist() %>% 
  strsplit(',') %>%
  unlist() %>% 
  trimws() %>% 
  table() %>% 
  as.data.frame() %>%
  arrange(-Freq) %>%
  top_n(5)


jezyki <- data.frame(
  Jezyk = jezyki$.
  ,`Count` = jezyki$Freq
)

ggplot(jezyki, aes(x = Jezyk, y=Count)) + 
  geom_boxplot(aes(fill=Jezyk)) +
  theme(
    axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1)
  ) +
  scale_fill_manual(values = brewer.pal(5, 'Accent'))

CHALLENGE 4: 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.

if(!require('gridExtra')) install.packages('gridExtra')
library(gridExtra)

p1 = ggplot(dane, aes(x = IMDb.Score)) +
  geom_histogram(
    aes(fill = Series.or.Movie)
    ,bins = 50
    ,color = 'black'
  ) +
  labs(title = 'IMDb') +
facet_wrap(vars(Series.or.Movie), ncol = 6) +
facet_wrap(vars(Series.or.Movie), nrow = 6)

p2 = ggplot(dane, aes(x = Hidden.Gem.Score)) +
  geom_histogram(
    aes(fill = Series.or.Movie)
    ,bins = 50
    ,color = 'black'
  ) +
  labs(title = 'Hidden Gem') +
facet_wrap(vars(Series.or.Movie), ncol = 6) +
facet_wrap(vars(Series.or.Movie), nrow = 6)

p3 = ggplot(dane, aes(x = Metacritic.Score)) +
  geom_histogram(
    aes(fill = Series.or.Movie)
    ,bins = 50
    ,color = 'black'
  ) +
  labs(title = 'Metacritic') +
facet_wrap(vars(Series.or.Movie), ncol = 6) +
facet_wrap(vars(Series.or.Movie), nrow = 6)

p4 = ggplot(dane, aes(x = Rotten.Tomatoes.Score)) +
  geom_histogram(
    aes(fill = Series.or.Movie)
    ,bins = 50
    ,color = 'black'
  ) +
  labs(title = 'Rotten Tomatoes') +
facet_wrap(vars(Series.or.Movie), ncol = 6) +
facet_wrap(vars(Series.or.Movie), nrow = 6)

grid.arrange(p1, p2, p3, p4, ncol = 2, nrow = 2)

p1 = ggplot(dane, aes(x = IMDb.Score, y = IMDb.Votes, color = Series.or.Movie)) +
  geom_point() +
  theme(legend.position = c(0.3, 0.8))

p2 = 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')

grid.arrange(p1, p2, ncol = 2)

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

wytwornie <- dane %>% 
  select(Production.House) %>% 
  unlist() %>% 
  strsplit(',') %>%
  unlist() %>% 
  trimws() %>% 
  table() %>% 
  as.data.frame() %>%
  arrange(-Freq) %>%
  top_n(50)
  
wytwornie <- data.frame(
  House = wytwornie$.
  ,`Count` = wytwornie$Freq
)


ggplot(wytwornie, aes(Count, Count, label = House)) +
  geom_point(aes(color = House, size = Count)) +
  geom_text_repel() +
  theme(legend.position = 'none')