Oscar 2017 "Best Picture" - kto wygra?

library(ggplot2)
library(dplyr)
library(rvest)
library(randomForest)

GetBestMoviesList <- function(rok) {
   # czytamy odpowiednią stronę - kolejną edycję Oscarów
   page <- read_html(paste0("http://www.imdb.com/event/ev0000003/", rok))
   
   # proszę zajrzeć w kod HTML strony - potrzebujemy tylko fragmentów
   best_picture <- page %>%
      html_nodes("div.award") %>%
      html_node("blockquote") %>%
      html_node("blockquote")
   
   # "Best Picture" jest w pierwszym bloku
   best_picture <- best_picture[1]

   # pobieramy wszystkie linki z wybranego bloku
   best_picture <- best_picture %>%
      html_nodes("div") %>%
      html_nodes("a") %>%
      html_attr("href") %>%
      unique()
   
   # wykluczenie zbędnych linków
   # interesują nas tylko filmy, a nie link do osoby lub wytwórnia
   # usuwamy to co zbędne
   best_picture <- best_picture[substr(best_picture, 1, 9)!="/company/"]
   best_picture <- best_picture[substr(best_picture, 1, 8)!="/name/nm"]
   
   # wszystkie linki włóżmy w jedną ramkę
   df <- data.frame(Year=rok, MovieLink=best_picture, Won=FALSE)

   # pierwszy film na liście wygrywał - oznaczmy to
   df[1,3] <- TRUE
   return(df)
}

movies_list <- data.frame()
for(y in 2000:2016) {
   movies_list <- rbind(movies_list, GetBestMoviesList(y))
}

for(y in 1929:2016) {
   # w 1930 było 2 razy w roku
   if(y==1930) {
      movies_list <- rbind(movies_list, GetBestMoviesList("1930-1"))
      movies_list <- rbind(movies_list, GetBestMoviesList("1930-2"))
      next
   }
   
   # w 1933 nie było nagród
   if(y==1933) next

   movies_list <- rbind(movies_list, GetBestMoviesList(y))
}

# poprawka dla podwójnych rozdań z 1930 roku
movies_list[movies_list[,1]=="1930-1", 1] <- 1930
movies_list[movies_list[,1]=="1930-2", 1] <- 1930

# zbudowanie pełnego urla
movies_list$MovieLink <- ifelse(substr(movies_list$MovieLink, 1, 7) == "http://",
                                movies_list$MovieLink,
                                paste0("http://www.imdb.com", movies_list$MovieLink))

# filmy nominowane w 2017
movies_list <- rbind(movies_list, data.frame(Year=2017,
                              MovieLink=c("http://www.imdb.com/title/tt2543164/",
                                 "http://www.imdb.com/title/tt3783958/",
                                 "http://www.imdb.com/title/tt2671706/",
                                 "http://www.imdb.com/title/tt3741834/",
                                 "http://www.imdb.com/title/tt2119532/",
                                 "http://www.imdb.com/title/tt4034228/",
                                 "http://www.imdb.com/title/tt4975722/",
                                 "http://www.imdb.com/title/tt2582782/", 
                                 "http://www.imdb.com/title/tt4846340/"),
                              Won=FALSE))

GetMovieDetalis <- function(movie_url) {
   # wczytajmy stronę z filmem
   page <- read_html(movie_url)
   
   # tytuł - interesuje nas tytuł oryginalny
   title <- page %>%
      html_node("div.title_wrapper") %>%
      html_node("div.originalTitle") %>%
      html_text()
   
   # jeśli nie ma tytułu oryginalnego w stosownym polu - weźmy tytuł "główny"
   # IMDb.com w tytule podaje tytuł zlokalizowany - w Polsce zobaczymy polskie tytuły
   # dodatkowo w nawiasach po tytule jest np. rok produkcji filmu - usuwamy to
   if(is.na(title)) {
      title <- page %>%
         html_node("div.title_wrapper") %>%
         html_node("h1") %>%
         html_text()
      sub <- page %>%
         html_node("div.title_wrapper") %>%
         html_node("h1") %>%
         html_node("span") %>%
         html_text()
   } else {
      sub <- page %>%
         html_node("div.title_wrapper") %>%
         html_node("div.originalTitle") %>%
         html_node("span") %>%
         html_text()
   }
   title <- gsub(sub, "", title,  fixed = TRUE)
   title <- trimws(title)

   # ocena użytkowników
   rating <- page %>%
      html_node("div.imdbRating") %>%
      html_nodes("span") %>%
      html_text()
   # liczba głosóW
   votes <- as.integer(gsub(",", "", rating[4]))
   # ocena
   rating <- as.numeric(rating[1])

   # czas trwania filmu
   duration <- page %>%
      html_node("div.title_wrapper") %>%
      html_node("div.subtext") %>%
      html_node("time") %>%
      html_attr("datetime")
   duration <- gsub("PT", "", duration)
   duration <- as.integer(gsub("M", "", duration))

   # kategoria wiekowa
   pgrating <- page %>%
      html_node("div.title_wrapper") %>%
      html_node("div.subtext") %>%
      html_node("meta") %>%
      html_attr("content")

   # gatunki - pobieramy wszystko, na końcu wykorzystamy tylko pierwszy wskazany
   genres <- page %>%
      html_node("div.title_wrapper") %>%
      html_node("div.subtext") %>%
      html_nodes("a") %>%
      html_text()
   genres <- genres[1:(length(genres)-1)]

   # credits
   credits <- page %>% html_nodes("div.credit_summary_item")
   director <- credits[1] %>% html_nodes("span.itemprop") %>% html_text()
   writers <- credits[2] %>% html_nodes("span.itemprop") %>% html_text()
   stars <- credits[3] %>% html_nodes("span.itemprop") %>% html_text()
   
   # metascore
   metascore <- page %>% html_node("div.metacriticScore")
   # dla starszych filmów nie ma tej wartości
   # aby funkcja zadziałała dla filmów z Oscarów 1929 robimy obejście :)
   if(!is.na(metascore)) {
      metascore <- metascore %>% html_node("span") %>% html_text() %>% as.integer()
   } else {
      metascore <- NA
   }
   
   # budżet
   movie_details <- page %>%
      html_node("div#titleDetails") %>%
      html_nodes("div.txt-block") %>%
      html_text()
   movie_details <- trimws(gsub("\\n", "", movie_details))
   movie_details <- gsub(" +", " ", movie_details)
   
   budget <- movie_details[substr(movie_details, 1, 8)=="Budget: "]
   if(length(budget)>0) {
      budget <- substr(budget, 9, nchar(budget))
      budget <- strsplit(budget, " ")[[1]][1]
      budget <- gsub(",", "", budget)
      # niektóre wartości są w funtach
      # przeliczmy to na dolary według stałego kursu
      # 1 GBP = 1.5 USD
      budget <- ifelse(substr(budget, 1, 1)=="$",
                       as.integer(substr(budget, 2, nchar(budget))),
                       1.5*as.integer(substr(budget, 2, nchar(budget))))
   } else {
      # czasem nie ma informacji o budżecie - obejście
      budget <- NA
   }
   
   # przychód w weekend otwarcia
   # plus obejście dla brakujących danych
   opening <- movie_details[substr(movie_details, 1, 17)=="Opening Weekend: "]
   if(length(opening)>0) {
      opening <- substr(opening, 18, nchar(opening))
      opening <- strsplit(opening, " ")[[1]][1]
      opening <- gsub(",", "", opening)
      opening <- ifelse(substr(opening, 1, 1)=="$",
                        as.integer(substr(opening, 2, nchar(opening))),
                        1.5*as.integer(substr(opening, 2, nchar(opening))))
   } else {
      opening <- NA
   }
   
   
   # całkowity przychód
   gross <- movie_details[substr(movie_details, 1, 7)=="Gross: "]
   if(length(gross)>0) {
      gross <- substr(gross, 8, nchar(gross))
      gross <- strsplit(gross, " ")[[1]][1]
      gross <- gsub(",", "", gross)
      gross <- ifelse(substr(gross, 1, 1)=="$",
                      as.integer(substr(gross, 2, nchar(gross))),
                      1.5*as.integer(substr(gross, 2, nchar(gross))))
   } else {
      gross <- NA
   }

   # łączymy wszystkie dane w jedną ramkę, a właciwie jeden wiersz   
   df <- data.frame(Title=title,
                    Rating=rating,
                    Votes=votes,
                    Duration=duration,
                    PG=pgrating,
                    Genres=genres[1],
                    Director=director[1],
                    Writers=writers[1],
                    StarA=stars[1],
                    StarB=stars[2],
                    MetaScore=metascore,
                    Budget=budget,
                    Openning=opening,
                    Gross=gross)
   
   return(df)
}

# pobranie danych do jednej ramki
movies_dets <- data.frame()
len <- nrow(movies_list)

for(i in 1:len) {
   db <- data.frame(movies_list[i,])
   mdet <- GetMovieDetalis(movies_list[i,2])
   db <- cbind(db, mdet)
   movies_dets <- rbind(movies_dets, db)   
}

# minimalna i maksymalna ocena - do skalowania wykresów
ymin <- floor(min(movies_dets$Rating))
ymax <- ceiling(max(movies_dets$Rating))

movies_dets %>%
   filter(Year != 2017) %>%
   ggplot() +
   theme_bw() +
   geom_point(aes(Year, Rating, col=Won), size=5) +
   geom_smooth(aes(Year, Rating, col=Won), se=FALSE, method = "loess") +
   ylim(ymin, ymax) +
   labs(title="Ocena IMDb.com a Oscar")

movies_dets %>%
   filter(Year != 2017) %>%
   ggplot() +
   theme_bw() +
   geom_point(aes(Year, Budget, col=Won), size=5) +
   geom_smooth(aes(Year, Budget, col=Won), se=FALSE, method = "loess") +
   labs(title="Budżet a Oscar - produkcja")

movies_dets %>%
   filter(Year != 2017) %>%
   ggplot() +
   theme_bw() +
   geom_point(aes(Year, Openning, col=Won), size=5) +
   geom_smooth(aes(Year, Openning, col=Won), se=FALSE, method = "loess") +
   labs(title="Budżet a Oscar - weekend otwarcia")

movies_dets %>%
   filter(Year != 2017) %>%
   ggplot() +
   theme_bw() +
   geom_point(aes(Year, Gross, col=Won), size=5) +
   geom_smooth(aes(Year, Gross, col=Won), se=FALSE, method = "loess") +
   labs(title="Budżet a Oscar - całkowity przychód")

movies_dets %>%
   filter(Year != 2017) %>%
   ggplot() +
   theme_bw() +
   geom_point(aes(Year, MetaScore, col=Won), size=5) +
   geom_smooth(aes(Year, MetaScore, col=Won), se=FALSE, method = "loess") +
   labs(title="MetaScore a Oscar")

# wybieramy tylko potrzebne kolumny
movies_train <- movies_dets[, c(1,3,4,5,6,7,8,9, 14,15,16,17)]

# test - 2017 rok
movies_test <- movies_train[movies_train$Year == 2017, -2]

# trening - wszystko pozostałe
movies_train <- movies_train[movies_train$Year != 2017, -3]
movies_train$Won <- ifelse(movies_train$Won, 1, 0)

# dane treningowe to tylko filmy, które mają wszystkie informacje
movies_train <- na.omit(movies_train)

# randomForest
model_rf <- randomForest(Won ~ ., movies_train, importance=TRUE)

varImpPlot(model_rf)

pred_rf <- predict(model_rf, newdata = movies_test[,-2])

# złączenie przewidywań z danymi
movies_test_rf <- cbind(movies_test, pred_rf)

# posortujmy od razu tabelę po predykcji
# jednocześnie przeliczając wartości otrzymane z modelu na procenty
movies_rf_list <- movies_test_rf %>%
   mutate(Probability=round(100*pred_rf/sum(pred_rf), 1)) %>%
   arrange(desc(pred_rf)) %>%
   select(Title, Rating, Votes, Genres, MetaScore, Probability)

print(movies_rf_list)

# z danych zgromadzonych na początek wycinamy to co nam potrzebne
# i usuwamy 2017 rok
movies_train <- movies_dets[, c(1,3,4,5,6,7,8,9, 14,15,16,17)]
movies_train <- movies_train[movies_train$Year != 2017, ]
movies_train <- na.omit(movies_train)

# tutaj zbierzemy sobie wyniki z kolejnych lat
wyniki_rf <- data.frame()

# teraz typujemy zwycięzcę dla kolejnych lat
for(rok in 2000:2016) {
   # próbka testowa na określonym roku
   movies_test_year <- movies_train[movies_train$Year == rok, ]
   
   # próbka treningowa na latach pozostałych
   movies_train_year <- movies_train[movies_train$Year != rok, -3]
   movies_train_year$Won <- ifelse(movies_train_year$Won, 1, 0)

   # model randomForest i predykcja
   model_rf <- randomForest(Won ~ ., movies_train_year)
   pred_rf <- predict(model_rf, newdata = movies_test_year)
   movies_test_year_rf <- cbind(movies_test_year, pred_rf)

   # interesuje nas tylko pierwsze miejsce według predykcji
   wyniki_rf <- rbind(wyniki_rf,
                      movies_test_year_rf[order(-movies_test_year_rf$pred_rf)[1], c(1,3,2)])
   
}

wynik <- table(wyniki_rf$Won)
wynik["TRUE"]/sum(wynik)

##      TRUE 
## 0.3529412

print(wyniki_rf)

movies_train %>%
   filter(Won) %>%
   select(Year, Title)