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 - Credit.amount

ggplot(germancredit, aes(x=credit.amount)) +
  geom_density(alpha=.10) +
  labs(title = 'Gęstość rozkładu oceny kredytowej')

i pozostałe poniżej :-)

Wykres 1 zmiennej jakościowej - Creditability

germancredit %>%
  filter(creditability != '') %>%
  ggplot(aes(creditability)) +
  geom_bar(aes(fill = creditability))+
  labs(title = 'Creditability')

Wykres zmiennej ilościowej wg jakościowej - Wiek wg ryzyka

ggplot(germancredit, aes(x = credit.amount, y = age.in.years)) +
  geom_point(aes(color = credit.amount)
    ,
  title='credit amount by age')

## Warning in geom_point(aes(color = credit.amount), title = "credit amount by
## age"): Ignoring unknown parameters: `title`

Wykres 2 zmiennych ilościowych - Wiek wg wysokości kredytu

ggplot(germancredit, aes(x = credit.amount, y = age.in.years)) +
  geom_point(aes(color = credit.amount),
    method = 'loess'
    ,se = FALSE
  )

## Warning in geom_point(aes(color = credit.amount), method = "loess", se = FALSE):
## Ignoring unknown parameters: `method` and `se`

Wykres bąbelkowy

options(scipen=999)
cele <- germancredit %>% 
  select(purpose) %>% 
  unlist() %>% 
  strsplit(',') %>%
  unlist() %>% 
  trimws() %>% 
  table() %>% 
  as.data.frame()

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

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

ggplot(cele, aes(duration.in.month.average, credit.amount.average, label = Cel)) +
  geom_point(aes(color = Cel, size = Count)) +
  geom_text_repel() +
  theme(legend.position = 'none')

## Warning: Removed 2 rows containing missing values (`geom_point()`).

## Warning: Removed 2 rows containing missing values (`geom_text_repel()`).

Zadania dodatkowe - dla chętnych:

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

produkcje = 50
aktorzy = 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)
}

Podzial_Aktorow%>%
  
  arrange(-Count, -IMDb.Votes.Average)%>%
  head(aktorzy)%>%
  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 = 'Najpopularniejsi aktorzy')

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

library(lubridate)
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=100
dane %>%
  select(c(Title, Release.Date, IMDb.Votes)) %>%
  arrange(-IMDb.Votes) %>%
  head(n) %>%
  mutate(Dekada = floor(year(Release.Date)/10)*10)%>%
  count(Dekada)%>%
  arrange(Dekada)%>%
  mutate(Dekada = as.character(Dekada))%>%
  rename(Ilosc = n)%>%
  ggplot(aes(x=Dekada,y=Ilosc))+
    geom_col(aes(fill=Dekada))+
    scale_fill_brewer(palette="Dark2")+
    labs(title = 'Ilość produkcji w danej dekadzie dla top 100 filmów')+
  geom_text(aes(label = Ilosc), vjust = 1.5)

CHALLENGE 3: 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(Język = ".", Ilość = Freq)%>% arrange(-Ilość)%>%
  head(10)%>% 
ggplot(aes(x=Język,y=Ilość))+
    geom_col(aes(fill=Język))+ scale_fill_brewer(palette="BuPu")