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 = 100)
  ) +
  theme(
    legend.position = 'none'
    ,axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1)
  ) +
  scale_fill_manual(values = brewer.pal(100, '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

germancredit %>%
ggplot(aes(x = credit.amount)) +
  geom_histogram(
    aes(fill = housing)
    ,bins = 15
    ,color = 'blue'
  ) +
  labs(title = 'Kwoty kredytu posiadaczy domu')

Wykres 1 zmiennej jakościowej

germancredit %>%
  ggplot(aes(creditability)) +
  geom_bar(aes(fill = creditability))+
  theme(legend.position = 'none',axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1)) +
  scale_fill_manual(values = brewer.pal(100, 'Accent'))

## Warning in brewer.pal(100, "Accent"): n too large, allowed maximum for palette Accent is 8
## Returning the palette you asked for with that many colors

Wykres ilościowej wg jakościowej

ggplot(germancredit, aes(x = creditability, y = age.in.years)) +
  geom_boxplot(
    aes(fill = creditability)
    ,outlier.alpha = 0.25
  ) +
  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')

Wykres 2 zmiennych ilościowych

ggplot(germancredit, aes(x = credit.amount, y = age.in.years)) +
  geom_point(aes(color = creditability)) +
  geom_smooth(
    method = 'loess'
    ,se = FALSE
  ) +
  theme(legend.position = c(0.2, 0.8))

## `geom_smooth()` using formula = 'y ~ x'

Wykres bąbelkowy

germancredit %>%
  group_by(job) %>%
  summarise(average_duration=mean(duration.in.month), average_amount=mean(credit.amount), count=n()) %>%
  ggplot( aes(average_duration, average_amount, label = job)) +
  geom_point(aes(color = job, size = count)) +
  geom_text_repel() +
  theme(legend.position = 'none')  

Kilka wykresów na jednym

germancredit %>%
  ggplot(aes(x = credit.amount)) +
  geom_histogram(
    aes(fill = foreign.worker)
    ,bins = 50
    ,color = 'black') +
   facet_wrap(vars(foreign.worker, housing), nrow = 2, scales = 'free') +
  theme(legend.position = 'none')

Zadania dodatkowe - dla chętnych:

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

# Przykładowo pokażę top 10 aktorów wg liczby głosów oddanych na filmy z ich udziałem na IMDB

dane_rozdzielone <- dane %>%
  separate_rows(Actors, sep = ", ") %>%
  mutate(Actors = trimws(Actors))

suma_glosow <- dane_rozdzielone %>%
  group_by(Actors) %>%
  summarise(TotalVotes = sum(IMDb.Votes)) %>%
  arrange(desc(TotalVotes)) 

top_10_aktorow <- suma_glosow %>%
  top_n(10, TotalVotes)

ggplot(top_10_aktorow, aes(x = reorder(Actors, TotalVotes), y = TotalVotes)) +
  geom_bar(stat = "identity", fill = "skyblue") +
  labs(x = "Aktorzy", y = "Liczba głosów", title = "Top 10 aktorów z największą liczbą głosów") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

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

# Średnia liczba głosów przypadająca na film w danym roku
library(lubridate)

dane %>%
  mutate(rok_produkcji = year(mdy(Release.Date))) %>%
  group_by(rok_produkcji) %>%
  summarise(avg_votes = mean(IMDb.Votes)) %>%
  arrange(desc(avg_votes)) %>%
  ggplot( aes(x = factor(rok_produkcji), y = avg_votes)) +
  geom_point(color = "red", size = 3) +
  labs(x = "Rok produkcji", y = "Średnia liczba głosów", title = "Popularność produkcji filmowych w latach") +
  #theme(axis.text.x = element_text(angle = 45, hjust = 1))
  theme(axis.text.x = element_blank()) +  # Usunięcie etykiet osi X
  geom_text(aes(label = rok_produkcji), vjust = -0.9, size = 3)

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

# Wykres przedstawiający top 10 języków najczęściej dostępnych na Netflix
dane_rozdzielone2 <- dane %>%
  separate_rows(Languages, sep = ", ") %>%
  mutate(Languages = trimws(Languages)) # usuwanie spacji

langs_count <- dane_rozdzielone2 %>%
  count(Languages, sort = TRUE)

top_10_langs <- head(langs_count, 10)

ggplot(top_10_langs, aes(x = reorder(Languages, n), y = n)) +
  geom_bar(stat = "identity", fill = "skyblue") +
  labs(x = "Języki", y = "Liczba wystąpień", title = "Top 10 najpopularniejszych języków na Netflixie") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

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.

# miejsce na kod

dane_przekształcone3 <- dane %>%
  pivot_longer(cols = ends_with(".Score"), names_to = "Portal", values_to = "Ocena")%>%
  mutate(Ocena = ifelse(Portal %in% c("Rotten.Tomatoes.Score","Metacritic.Score"), Ocena/10, Ocena))

ggplot(dane_przekształcone3, aes(x = Ocena, fill = Portal)) +
  geom_histogram(binwidth = 1, position = "dodge", color = "black") +
  labs(x = "Ocena", y = "Liczba filmów", title = "Histogramy ocen z różnych portali") +
  scale_fill_brewer(palette = "Set3") +
  facet_wrap(~ Portal, nrow = 2) +
  theme_minimal()

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

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

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?

# Wykresy top 5 wytwórni dla każdego przedziału lat (co 20 lat)

dane_rozdzielone4 <- dane %>%
  mutate(rok_produkcji = year(mdy(Release.Date))) %>%
  separate_rows(Production.House, sep = ", ") %>%
  mutate(Production.House = trimws(Production.House))%>%
  mutate(years_by20 = cut(rok_produkcji, breaks = seq(1930, 2030, by = 20),
                          labels = c("1930-1950","1950-1970","1970-1990","1990-2010","2010-2030"))) %>% 
 filter(!is.na(years_by20)) %>%
  filter(Production.House!="")


dane_top <- dane_rozdzielone4 %>%
  group_by(years_by20, Production.House) %>%
  summarise(Liczba_filmow = n()) %>%
  ungroup() %>%
  group_by(years_by20) %>%
  top_n(6, Liczba_filmow) 


ggplot(dane_top, aes(x=reorder(Production.House,Liczba_filmow),y=Liczba_filmow, fill=years_by20)) + 
         geom_bar(stat = "identity", fill = "skyblue") +
         labs(x = "Wytwórnie", y = "Liczba filmów", title = "Wytwórnie z największą liczbą filmów")+
facet_wrap(vars(years_by20), nrow = 1, scales = 'free') +
  theme(legend.position = 'none') +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))