Kto jest najlepszym aktorem filmowym wszechczasów?
Maciej Wakuliński
2024-06-18
Wydanie: 0.1
Próba oszacowania na podstawie zbioru danych IMDb TOP 1000 Movies Sorted by IMDb Rating.
Źródło: https://www.kaggle.com/datasets/omarhanyy/imdb-top-1000
Kontekst
IMDb (znana również jako Internet Movie Database) to internetowa baza danych informacji związanych z filmami, łącząca opis fabuły filmu, oceny Metastore, oceny i recenzje krytyków i użytkowników, daty premiery i wiele innych aspektów. Większość danych w bazie jest dostarczana przez wolontariuszy.
Zawartość
Zestaw danych zawiera 1000 najlepszych filmów wszech czasów IMDB z atrybutami takimi jak tytuł, certyfikat, czas trwania, gatunek itp. Typowe użycie tego zbioru danych koncenturuje się na analizie dostępnych atrybutów dotyczących samych filmów (gatunek, ograniczenia wiekowe, rok premiery, długość, liczba głosów, IMDB Score, itp.). W niniejszej analizie przedmiotem zainteresowania będą jednak imiona i nazwiska aktorów występujących w każdej z czterech głównych ról dla poszczególnych produkcji.
Import bibliotek
#ładowanie pakietów do sesji
library (rmarkdown)
library (dplyr)
library (ggplot2)
library (ggeasy)
library (knitr)
library (tidyverse)
library (plotly)
Odczyt źródła danych
setwd("C:/Users/Inspe/Documents/dokumenty")
imdb_top_1000 <- read.csv("~/dokumenty/imdb_top_1000.csv")
Czy zakres danych jest reprezentatywny?
# tworzenie wektora z kolumny pliku csv
RokProd <- as.vector(imdb_top_1000$Released_Year)
# określenie daty produkcji najstarszego filmu w zestawieniu
MinRokProd <- min(RokProd)
# konwertowanie tekstu na liczbę
MinRokProd <- as.numeric(MinRokProd)
MinRokProd## [1] 1920# dane uzupełniające
PierwszyRokProd <- 1895
PierwszyRokProd## [1] 1895# określanie liczby lat produkcji filmowych nie ujętych w zestawieniu
ile_lat_NIE <- MinRokProd - PierwszyRokProd
ile_lat_NIE## [1] 25# określanie liczby lat produkcji filmowych objętych zestawieniem
ile_lat_TAK <- 2024 - MinRokProd
ile_lat_TAK## [1] 104# udział procentowy produkcji nieuwzględnionych
Udział_lat_nie <- ile_lat_NIE/(ile_lat_NIE+ile_lat_TAK)
Udział_lat_nie## [1] 0.1937984Wnioski:
- Źródło danych obejmuje filmy, których premiera kinowa odbyła się w roku 1920 i później.
- Pierwszy pokaz filmowy „Wyjście robotników z fabryki Lumière w Lyonie” miał miejsce w 1899 roku.
- Liczba lat produkcji filmowych nieuwzględnionych w zbiorze danych wynosi 25.
- Liczba lat produkcji filmowych uwzględnionych w zbiorze danych wynosi 104,
- Udział procentowy lat pominiętych przez źródło wynosi 19,38%.
# okreeślenie liczebności populacji na koniec okresu pominiętego w źródle danych
populacja1920 <- 1.920
populacja1920## [1] 1.92# określenie liczebności populacji na koniec okresu uwzględnionego
populacja2024 <- 8.116
populacja2024## [1] 8.116# udział procentowy maksymalnej wartości populacji na koniec okresu pominiętego względem okresu uwzględnionego
udział_pop_nie <- populacja1920/(populacja2024)
udział_pop_nie## [1] 0.2365697Wnioski:
- Maksymalna wartość populacji na koniec okresu nieujętego w źródle danych wynosi 1.92 miliarda.
- Maksymalna wartość populacji na koniec okresu uwzględnionego wynosi 8.116 miliarda.
- Udział procentowy liczebności populacji pominiętej do uwzględnionej wynosi 23,66%
# oszacowanie liczby filmów nieuwzględnionych
udział_nie <- Udział_lat_nie * udział_pop_nie
udział_nie## [1] 0.04584685Wnioski:
- Przy założeniu, że udział w populacji ogółem osób “zajmujących się” produkcją filmów jest porównywalny w obydwu okresach - liczba produkowanych filmów pozostaje w korelacji z maksymalną liczebnością populacji w analizowanych okresach.
- Współczynnik skonsolidowany udziału filmów pominiętych stanowi
iloczyn udziałów:
- udziału liczby lat produkcji filmowej nieujętych w zestawieniu, oraz
- udziału liczby osób zajmujących się produkcją filmową wówczas i obecnie, to
- udział filmów niereprezentowanych w badaniu wynosi jedynie 4,58% i próba jest reprezentatywna.
Analiza ilościowa wystąpień aktorów w czterech głównych rolach obsady filmów objętych zestawieniem
# obliczanie częstotliwości
ile_razy1 <- table(imdb_top_1000$Star1, exclude = NULL)
ile_razy2 <- table(imdb_top_1000$Star2, exclude = NULL)
ile_razy3 <- table(imdb_top_1000$Star3, exclude = NULL)
ile_razy4 <- table(imdb_top_1000$Star4, exclude = NULL)# tworzenie ramek danych z tabel
rola1 <- data.frame(ile_razy1)
rola2 <- data.frame(ile_razy2)
rola3 <- data.frame(ile_razy3)
rola4 <- data.frame(ile_razy4)# ograniczanie zestawu danych poprzez filtrowanie pojedyńczych wystąpień
rola01 <- filter(rola1, Freq > 1)
rola02 <- filter(rola2, Freq > 1)
rola03 <- filter(rola3, Freq > 1)
rola04 <- filter(rola3, Freq > 1)
Przypisanie wag istotności poszczególnym rolom (pierwszoplanowa -> drugoplanowa)
# definiowanie wag
waga1 = 1.0
waga2 = 0.9
waga3 = 0.8
waga4 = 0.7# obliczanie iloczynu wagi i częstotliwości wystąpień
rola001 <- mutate(rola01, Index = Freq * waga1)
rola002 <- mutate(rola02, Index = Freq * waga2)
rola003 <- mutate(rola03, Index = Freq * waga3)
rola004 <- mutate(rola04, Index = Freq * waga4)
Dalsze przetworzenia danych
# łączenie ramek danych
merge_a <- full_join(rola001, rola002, by = "Var1")
merge_b <- full_join(rola003, rola004, by = "Var1")
merge_all <- full_join(merge_a, merge_b, by = "Var1")
#zamiana NA na zera
merge_all[is.na(merge_all)] <- 0
Obliczanie indeksu skonsolidowanego (uwzględniającego wagi za wystąpienie w określonej roli)
#obliczenie indeksu skonsolidowanego
result <- mutate(merge_all, CombIndex = Index.x.x + Index.x.y + Index.y.y + Index.y.x,)
#sortowanie degresywne 25 najlepszych wyników
result1 <- result %>% arrange(desc(CombIndex)) %>% head(25)
Prezentacja rankingu
knitr::kable(result1, caption = 'TOP25::Najlepsi aktorzy filmowi wszechczasów - indeks skonsolidowany')| Var1 | Freq.x.x | Index.x.x | Freq.y.x | Index.y.x | Freq.x.y | Index.x.y | Freq.y.y | Index.y.y | CombIndex |
|---|---|---|---|---|---|---|---|---|---|
| Robert De Niro | 11 | 11 | 3 | 2.7 | 3 | 2.4 | 3 | 2.1 | 18.2 |
| Al Pacino | 10 | 10 | 3 | 2.7 | 0 | 0.0 | 0 | 0.0 | 12.7 |
| Tom Hanks | 12 | 12 | 0 | 0.0 | 0 | 0.0 | 0 | 0.0 | 12.0 |
| Clint Eastwood | 10 | 10 | 2 | 1.8 | 0 | 0.0 | 0 | 0.0 | 11.8 |
| Christian Bale | 8 | 8 | 3 | 2.7 | 0 | 0.0 | 0 | 0.0 | 10.7 |
| Brad Pitt | 4 | 4 | 4 | 3.6 | 2 | 1.6 | 2 | 1.4 | 10.6 |
| Ethan Hawke | 5 | 5 | 2 | 1.8 | 2 | 1.6 | 2 | 1.4 | 9.8 |
| Humphrey Bogart | 9 | 9 | 0 | 0.0 | 0 | 0.0 | 0 | 0.0 | 9.0 |
| Leonardo DiCaprio | 9 | 9 | 0 | 0.0 | 0 | 0.0 | 0 | 0.0 | 9.0 |
| Denzel Washington | 7 | 7 | 2 | 1.8 | 0 | 0.0 | 0 | 0.0 | 8.8 |
| Matt Damon | 4 | 4 | 5 | 4.5 | 0 | 0.0 | 0 | 0.0 | 8.5 |
| James Stewart | 8 | 8 | 0 | 0.0 | 0 | 0.0 | 0 | 0.0 | 8.0 |
| Johnny Depp | 8 | 8 | 0 | 0.0 | 0 | 0.0 | 0 | 0.0 | 8.0 |
| Rachel McAdams | 0 | 0 | 2 | 1.8 | 4 | 3.2 | 4 | 2.8 | 7.8 |
| Scarlett Johansson | 0 | 0 | 2 | 1.8 | 4 | 3.2 | 4 | 2.8 | 7.8 |
| Harrison Ford | 5 | 5 | 3 | 2.7 | 0 | 0.0 | 0 | 0.0 | 7.7 |
| Edward Norton | 3 | 3 | 0 | 0.0 | 3 | 2.4 | 3 | 2.1 | 7.5 |
| Rupert Grint | 0 | 0 | 0 | 0.0 | 5 | 4.0 | 5 | 3.5 | 7.5 |
| Aamir Khan | 7 | 7 | 0 | 0.0 | 0 | 0.0 | 0 | 0.0 | 7.0 |
| Toshirô Mifune | 7 | 7 | 0 | 0.0 | 0 | 0.0 | 0 | 0.0 | 7.0 |
| Russell Crowe | 5 | 5 | 2 | 1.8 | 0 | 0.0 | 0 | 0.0 | 6.8 |
| Ed Harris | 0 | 0 | 4 | 3.6 | 2 | 1.6 | 2 | 1.4 | 6.6 |
| Morgan Freeman | 2 | 2 | 0 | 0.0 | 3 | 2.4 | 3 | 2.1 | 6.5 |
| Emma Watson | 0 | 0 | 7 | 6.3 | 0 | 0.0 | 0 | 0.0 | 6.3 |
| Cary Grant | 6 | 6 | 0 | 0.0 | 0 | 0.0 | 0 | 0.0 | 6.0 |
Wizualizacja
#wizualizacja
chart2 <- ggplot(data = result1, aes(x = reorder(Var1, -CombIndex), y = CombIndex, fill = CombIndex))
chart2 <- chart2 + geom_bar( stat = "identity")
chart2 <- chart2 + ggeasy::easy_rotate_labels(which = "x", angle = 90)
chart2 <- chart2 + labs(x="", y="", title = "Najlepsi aktorzy wszechczasów", subtitle = "Próba oszacowania na podstawie analizy występów w TOP 1000 filmów IMDB")
chart2