Podstawowe operacje w R - część 5.

Wizualizacja danych

Karolina Rowińska

2022-12-30

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.

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

ggplot(dane, aes(x = IMDb.Score)) +
  geom_histogram(
    aes(fill = Series.or.Movie)
    ,bins = 50
    ,color = 'black'
  ) +
  labs(title = 'Przykładowy histogram')

dane %>%
  filter(Languages=="Polish") %>%
ggplot(aes(x = IMDb.Score)) +
  geom_histogram(
    aes(fill = Series.or.Movie)
    ,bins = 10
    ,color = 'black'
  ) +
  labs(title = 'Przykładowy histogram')

ggplot(dane, aes(x = IMDb.Score)) +
  geom_histogram(
    aes(y = ..density..)
    ,bins = 50
    ,color = 'black'
    ,fill = 'white'
  ) +
  geom_density(
    aes(color = Series.or.Movie)
    ,color = 'blue'
    ,fill = 'lightblue'
    ,alpha = 0.25
    ,size = 1
  ) +
  labs(title = 'Gęstość rozkładu ocen')

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

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

produkcje = 30
aktory = 10
Dane_Aktorow <- dane %>%
  select(c(Title, Actors, IMDb.Votes, IMDb.Score)) %>%
  arrange(-IMDb.Votes) %>%
  head(produkcje)

Podzial_Aktorow <- Dane_Aktorow %>% 
  select(Actors) %>% 
  unlist() %>% 
  strsplit(',') %>%
  unlist() %>% 
  trimws() %>% 
  table() %>% 
  as.data.frame()

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

for (i in 1:nrow(Podzial_Aktorow)) {
  Podzial_Aktorow$IMDb.Score.Average[i] <- Dane_Aktorow %>% 
    filter(str_detect(Actors, Podzial_Aktorow$Actors[i] %>%
                        as.character() %>% eval())) %>%
    select(IMDb.Score) %>% unlist() %>% mean(na.rm = TRUE)
  
  Podzial_Aktorow$IMDb.Votes.Average[i] <- Dane_Aktorow %>% 
    filter(str_detect(Actors, Podzial_Aktorow$Actors[i] %>%
                        as.character() %>% eval())) %>%
    select(IMDb.Votes) %>% unlist() %>% mean(na.rm = TRUE)
}
library(ggrepel)
Podzial_Aktorow%>%
  # arrange(desc(IMDb.Votes.Average))%>%
  arrange(-Count, -IMDb.Votes.Average)%>%
  head(aktory)%>%
  ggplot(aes(IMDb.Score.Average, IMDb.Votes.Average, label = Actors)) +
    geom_point(aes(color = Actors, size = Count)) +
    geom_text_repel() +
    theme(legend.position = 'none') +
    labs(title = 'Top 10 aktorów')

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

dane = dane %>%
  mutate(
    Release.Date = Release.Date %>% as.Date(format = '%m/%d/%Y')
    ,Netflix.Release.Date = Netflix.Release.Date %>% as.Date(format = '%m/%d/%Y')
  )
n=200
dane %>% mutate(Rok = lubridate:: year(Release.Date))%>%
  select(c(Title, Release.Date, IMDb.Votes,Rok)) %>%
  arrange(-IMDb.Votes) %>%
  head(n) %>% count(Rok) %>%
  arrange(Rok)%>%
  rename(Ilosc = n) %>%
  ggplot(aes(x=Rok,y=Ilosc))+
    geom_col(aes(fill=Rok))+
    labs(title = 'Liczba wyprodukowanych produkcji w danym roku dla top 200 filmów') +
  geom_text(aes(label = Ilosc), vjust = 1.5)

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

dane%>% pull(Languages) %>%  paste0(collapse = ', ') %>%
    str_extract_all('[A-Za-z]+') %>% unlist() %>% table() %>%
    as.data.frame()%>% rename(Jezyk = ".", Ilosc = Freq)%>% arrange(-Ilosc)%>%
  head(10)%>% ggplot(aes(x=Jezyk,y=Ilosc))+
    geom_col(aes(fill=Jezyk))+
    labs(title = "Top 10 najpopularniejszych języków")+
    geom_text(aes(label = Ilosc), vjust = 1.4)

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

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

n_top = 3
p_movies<-dane %>%
  select(Title, Series.or.Movie, Hidden.Gem.Score, IMDb.Score, Rotten.Tomatoes.Score, Metacritic.Score)%>% filter(Series.or.Movie == "Movie")%>% drop_na()%>% mutate(Rotten.Tomatoes.Score=Rotten.Tomatoes.Score/10, Metacritic.Score=Metacritic.Score/10, SredniaOcena = (Hidden.Gem.Score + IMDb.Score + Rotten.Tomatoes.Score + Metacritic.Score)/4)%>% arrange(-SredniaOcena) %>% head(n_top)%>% pivot_longer(Hidden.Gem.Score:Metacritic.Score)%>% rename(Ocena = value, Witryna = name )%>%
  ggplot(aes(x=Title, y = Ocena, fill=Witryna))+
  geom_bar(stat="identity", position="dodge")+
  labs(title = sprintf("Oceny filmów z różnych witryn dla 3 najlepszych filmów", n_top))+
  theme(axis.text.x = element_text(angle = 90, vjust = 0.8))+
  scale_x_discrete(labels = function(x) str_wrap(x, width = 10))

p_series<-dane %>%
  select(Title, Series.or.Movie, Hidden.Gem.Score, IMDb.Score, Rotten.Tomatoes.Score, Metacritic.Score)%>%
  filter(Series.or.Movie == "Series")%>%
  drop_na()%>%
  mutate(Rotten.Tomatoes.Score=Rotten.Tomatoes.Score/10, Metacritic.Score=Metacritic.Score/10, SredniaOcena = (Hidden.Gem.Score + IMDb.Score + Rotten.Tomatoes.Score + Metacritic.Score)/4)%>%
  arrange(-SredniaOcena)%>%
  head(n_top)%>%
  pivot_longer(Hidden.Gem.Score:Metacritic.Score)%>%
  rename(Ocena = value, Witryna = name )%>%
  ggplot(aes(x=Title, y = Ocena, fill=Witryna))+
    geom_bar(stat="identity", position="dodge")+
    labs(title = sprintf("Oceny seriali z różnych witryn dla 3 najlepszych seriali", n_top))+
  theme(axis.text.x = element_text(angle = 90, vjust = 0.8))+
  scale_x_discrete(labels = function(x) str_wrap(x, width = 10))

grid.arrange(p_movies, p_series, 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 10: Jakie wytwórnie filmowe produkują najwięcej i jak się to zmieniało na przestrzeni ostatnich lat?

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

Wyt.2k20<- LATA %>%
  filter(release_year == 2020) %>%
  select(Production.House) %>%
  unlist() %>%
  strsplit(',') %>%
  unlist() %>%
  trimws() %>%
  table() %>%
  as.data.frame()

colnames(Wyt.2k20) <- c('Wytwórnia', 'Liczba')

Wyt.2k20<- Wyt.2k20%>%
  arrange(desc(Liczba))

POP_2020 <- Wyt.2k20[1:5,]

Wyt.2k19 <- LATA %>%
  filter(release_year == 2019) %>%
  select(Production.House) %>%
  unlist() %>%
  strsplit(',') %>%
  unlist() %>%
  trimws() %>%
  table() %>%
  as.data.frame()

colnames(Wyt.2k19) <- c('Wytwórnia', 'Liczba')

Wyt.2k19 <- Wyt.2k19 %>%
  arrange(desc(Liczba))

POP_2019 <- Wyt.2k19[1:5,]

Wyt.2k18 <- LATA %>%
  filter(release_year == 2018) %>%
  select(Production.House) %>%
  unlist() %>%
  strsplit(',') %>%
  unlist() %>%
  trimws() %>%
  table() %>%
  as.data.frame()

colnames(Wyt.2k18) <- c('Wytwórnia', 'Liczba')

Wyt.2k18 <- Wyt.2k18 %>%
  arrange(desc(Liczba))

POP_2018 <- Wyt.2k18[1:5,]

Wyt.2k17 <- LATA %>%
  filter(release_year == 2017) %>%
  select(Production.House) %>%
  unlist() %>%
  strsplit(',') %>%
  unlist() %>%
  trimws() %>%
  table() %>%
  as.data.frame()

colnames(Wyt.2k17) <- c('Wytwórnia', 'Liczba')

Wyt.2k17 <- Wyt.2k17 %>%
  arrange(desc(Liczba))

POP_2017 <- Wyt.2k17[1:5,]

Wyt.2k16 <- LATA %>%
  filter(release_year == 2016) %>%
  select(Production.House) %>%
  unlist() %>%
  strsplit(',') %>%
  unlist() %>%
  trimws() %>%
  table() %>%
  as.data.frame()

colnames(Wyt.2k16) <- c('Wytwórnia', 'Liczba')

Wyt.2k16 <- Wyt.2k16 %>%
  arrange(desc(Liczba))

POP_2016 <- Wyt.2k16[1:5,]

Wyt.2k15 <- LATA %>%
  filter(release_year == 2015) %>%
  select(Production.House) %>%
  unlist() %>%
  strsplit(',') %>%
  unlist() %>%
  trimws() %>%
  table() %>%
  as.data.frame()

colnames(Wyt.2k15) <- c('Wytwórnia', 'Liczba')

Wyt.2k15 <- Wyt.2k15 %>%
  arrange(desc(Liczba))

POP_2015 <- Wyt.2k15[1:5,]

Wyt.2k14 <- LATA %>%
  filter(release_year == 2014) %>%
  select(Production.House) %>%
  unlist() %>%
  strsplit(',') %>%
  unlist() %>%
  trimws() %>%
  table() %>%
  as.data.frame()

colnames(Wyt.2k14) <- c('Wytwórnia', 'Liczba')

Wyt.2k14 <- Wyt.2k14 %>%
  arrange(desc(Liczba))

POP_2014 <- Wyt.2k14[1:5,]

Wyt.2k13 <- LATA %>%
  filter(release_year == 2013) %>%
  select(Production.House) %>%
  unlist() %>%
  strsplit(',') %>%
  unlist() %>%
  trimws() %>%
  table() %>%
  as.data.frame()

colnames(Wyt.2k13) <- c('Wytwórnia', 'Liczba')

Wyt.2k13 <- Wyt.2k13 %>%
  arrange(desc(Liczba))

POP_2013 <- Wyt.2k13[1:5,]

library("RColorBrewer")

w1 <- ggplot(POP_2020, 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, 'Dark2')) +
  labs(title = 'Top 2020') +
  xlab('Wytwórnia') +
  ylab('Liczba filmów')

w2 <- ggplot(POP_2019, 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, 'Dark2')) +
  labs(title = 'Top 2019') +
  xlab('Wytwórnia') +
  ylab('Liczba filmów')

w3 <- ggplot(POP_2018, 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, 'Dark2')) +
  labs(title = 'Top 2018') +
  xlab('Wytwórnia') +
  ylab('Liczba filmów')

w4 <- ggplot(POP_2017, 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, 'Dark2')) +
  labs(title = 'Top 2017') +
  xlab('Wytwórnia') +
  ylab('Liczba filmów')

w5 <- ggplot(POP_2016, 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, 'Dark2')) +
  labs(title = 'Top 2016') +
  xlab('Wytwórnia') +
  ylab('Liczba filmów')

w6 <- ggplot(POP_2015, 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, 'Dark2')) +
  labs(title = 'Top 2015') +
  xlab('Wytwórnia') +
  ylab('Liczba filmów')

w7 <- ggplot(POP_2014, 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, 'Dark2')) +
  labs(title = 'Top 2014') +
  xlab('Wytwórnia') +
  ylab('Liczba filmów')

w8 <- ggplot(POP_2013, 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, 'Dark2')) +
  labs(title = 'Top 2013') +
  xlab('Wytwórnia') +
  ylab('Liczba filmów')

grid.arrange(w1, w2, w3, w4, w5, w6, w7, w8, ncol = 4, nrow = 2)