Загрузить файл

Набор данных о фильмах, описание которых содержится в интернет-базе IMDB, находится по ссылке kaggle.com. Если вы заинтересованы в исследовании кинофильмов, тогда перейдите по ссылке и загрузите файл "movie_metadata.csv" . После этого необходимо считать файл в R, используя следующий код:

movie <- read.csv('movie_metadata.csv',header=T,stringsAsFactors = F)

Таблица данных "Movie" (Кинофильмы)

Что внутри?

Применение names() позволит посмотреть наименования столбцов созданной таблицы под названием "movie":

Чтобы узнать размерность таблицы, следует ввести dim():

или

str(movie)

Когда код будет выполнен, консоль программы (Console) покажет структуру таблицы данных.

Итак, таблица данных (data frame) состоит из 5043 строк и 28 столбцов.

Кроме того, с помощью summary() можно получить немного больше информации о переменных в таблице:

Визуализация

Функция qplot() позволяет получить распределение кинофильмов по годам, как показано ниже на рисунке:

> qplot(data=movie, x=title_year, bins=101)
Warning message:
Removed 108 rows containing non-finite values (stat_bin).

С помощью графиков можно визуально предположить о зависимости между переменными. Рассмотрим график зависимости "imdb_score" от "movie_facebook_likes". Для его построения выполняется функция plot()

> plot(movie$movie_facebook_likes, movie$imdb_score, pch=2, col='red')

Рассматриваемая таблица данных имеет переменную "cast_total_facebook_likes", которая рассчитывается путем суммирования действий на Facebook (facebook popularity) относительно актерского состава. Добавим ее значения к предыдущему графику посредством такой записи, как:

> points(movie$cast_total_facebook_likes, movie$imdb_score, pch=1, col='blue')

Получаем новый график (scatter plot), где "cast_total_facebook_likes" отмечены синими кругами.

При желании посмотреть связи между разными переменными, можно воспользоваться следующей функцией:

> pairs(~actor_1_facebook_likes+num_critic_for_reviews+
 num_user_for_reviews+num_voted_users+
 cast_total_facebook_likes, data=movie, main="Basic Scatter Plot Matrix")

В итоге программа выдает набор графиков

Пузырьковая диаграмма (Bubble plot)

Этот параграф статьи посвящен построению пузырьковой диаграммы, которая указывает на то, сколько пользователей проголосовало, и сколько из них просмотрело и предоставило отзыв на фильмы. При этом размер пузырьков пропорционален число отметок "нравится" на Facebook. Чтобы создать данную диаграмму, нужно ввести код R

symbols(movie$num_voted_users, movie$num_user_for_reviews, 
  circle=movie$movie_facebook_likes, inches=0.30,
 fg="white", bg="blue",
 main="Bubble Plot with point size\nproportional to movie_facebook_likes")

Бюджет и доход. Сотовая диаграмма

Рассмотрим, как могут быть сгруппированы фильмы по размеру бюджета (budget) и доходу (gross). Графически представим расположение этих групп с помощью "сотовой диаграммы". В ней наблюдения распределяются по гексагональным ячейкам. Ячейки могут отличаются оттенком, по умолчанию, серого или же другого цвета, который ставится в соответствие числу наблюдений в каждой из этих ячеек.

Функция summary() показывает, что наименьшим значением для budget является 218, а наибольшим 12215500000. Минимальное значение gross равняется 162, а максимальное - 760505847. В ходе построения диаграммы будут выбраны только те фильмы, которые имеют больше 10 млн. долл. и меньше 500 млн. долл. бюджета и дохода, а также перейдем к "млн. дол." в качестве единицы измерения данных величин.

library(hexbin)
mbg_s<-movie[movie$budget>10000000 & movie$budget<500000000 & movie$gross>10000000 & movie$gross<500000000, ]
with(mbg_s, {
 budget_n<-mbg_s$budget/1000000
 gross_n<-mbg_s$gross/1000000
 bin <- hexbin(budget_n, gross_n, xbins=30, shape=1)
 plot(bin, main="Hexagonal Binning")
})

Чтобы получить цветную диаграмму, в функции plot() вносятся дополнительные аргументы

with(mbg_s, {
 budget_n<-mbg_s$budget/1000000
 gross_n<-mbg_s$gross/1000000
 bin <- hexbin(budget_n, gross_n, xbins=30, shape=1)
 plot(bin, style="colorscale", colramp = function(n) {rev(heat.colors(n))},
 main="Hexagonal Binning")
})

Ниже изображена цветная диаграмма

Можно выбрать альтернативную запись для Color Ramps on Perceptually Linear Scales:

colramp = function(n) {BTC(n, beg=1, end=256)}
colramp = function(n) {LinOCS (n, beg=20, end=250)}
colramp = function(n) {magent (n, beg=240, end=10)}
colramp = function(n) {plinrain(n, beg=240, end=25)}

а также альтернативы цветовых палитр (Color Palettes), используемых для создания вектора n смежных цветов

colramp = function(n) {rainbow(n, s = 1, v = 1, start = 0, end = max(1, n - 1)/n, alpha = 1))}
colramp = function(n) {terrain.colors(n, alpha = 1)}
colramp = function(n) {topo.colors(n, alpha = 1)}
colramp = function(n) {cm.colors(n, alpha = 1)}

Для построения сотовой диаграммы, такой как и на предыдущем рисунке, можно применять функцию hexbinplot():

hexbinplot(gross_n~budget_n, mbg_s, aspect = 1,
 colramp = function(n) {rev(heat.colors(n))})

Чтобы отобразить кинофильмы точками на графике в зависимости от их бюджета и дохода, используя при этом прозрачные маркеры, следует записать:

col_bg <- adjustcolor("darkblue", alpha.f = 0.2)
plot(budget_n, gross_n, 
 main = "Budget and Gross of Movies,\n transparent markers", 
 pch = 19, cex = 1.25, xlab = "Budget", ylab = "Gross", 
 col = col_bg)

Тогда график имеет вид

Еще один способ создания такого графика заключается в изображении через цвет плотности их распределения

​library(RColorBrewer)
ramp_col <- colorRampPalette(brewer.pal(9,"YlGn")[-1])
col_density <- densCols(budget_n, gross_n, colramp = ramp_ylgn)
plot(budget_n, gross_n, 
 col = col_density, 
 pch = 19, cex = 0.6, 
 main = 'Financial values,\ncolour reflects density')

В конечном итоге получим график

Очистка данных

Недостающие данные (NA)

При необходимости работы только с заполненными экземплярами (complete cases), прежде всего, нужно выявить, отсутствуют ли данные (missing data), т.е. проверить наличие значений NA в "movie":

и / или

> colSums(is.na(movie))
 color director_name num_critic_for_reviews 
 0 0 50 
 duration director_facebook_likes actor_3_facebook_likes 
 15 104 23 
 actor_2_name actor_1_facebook_likes gross 
 0 7 884 
 genres actor_1_name movie_title 
 0 0 0 
 num_voted_users cast_total_facebook_likes actor_3_name 
 0 0 0 
 facenumber_in_poster plot_keywords movie_imdb_link 
 13 0 0 
 num_user_for_reviews language country 
 21 0 0 
 content_rating budget title_year 
 0 492 108 
 actor_2_facebook_likes imdb_score aspect_ratio 
 13 0 329 
 movie_facebook_likes 
 0 

и / или

и / или

Действительно, в "movie" имеются значения NA. Поэтому создадим на основе имеющейся таблицы данных новую с именем "imdbdf".

Новая таблица данных имеет ту же шапку и размерность, что и предыдущая.

Далее нужно исключить из таблицы записи, в которых по крайней мере есть одно значение NA.

Получили очищенную таблицу с тем же именем "imdbdf", но уже с меньшим числом строк, равным 3801:

Более того, имеет смысл проверить таблицу на наличие дублирующих экземпляров и исключить их:

> imdbdf <- imdbdf[!duplicated(imdbdf),]; dim(imdbdf)

[1] 3768   28

Таким образом таблица данных сократилась до 3768 строк.

Выбор переменных

В случае, если не требуется работа со всеми переменными (столбцами), а только с некоторыми из них, то можно указать нужные:

Проверим, сколько строк и столбцов насчитывается в модифицированной таблице:

> dim(imdbdf)
[1] 3768 5

Ранжирование

Определим рейтинг каждого актера по оценке (score) IMDb. Для этого подключим пакет "plyr" и применим его функцию "ddply", что позволит рассчитать среднее значение рейтинга и его стандартную ошибку (SE) по каждому актеру.

"ddply" разбивает "imdbdf" на меньшие таблицы по переменной "actor_1_name". После этого вычисляет среднюю оценку (IMDB score), стандартную ошибку SE и число наблюдений N по каждой таблице, содержащей данные об отдельном актере.

Следует отметить, что

• summarise - функция;
• na.rm - аргумент, который устраняет отсутствующие значения (missing values);
• sd - стандартное отклонение по средней;
• sqrt - корень квадратный.

В итоге, функция "ddply" сводит меньшие таблицы и полученные вычисления по ним в новую таблицу данных (data frame) "ratingdat", которая уже состоит из 1457 строк и 4 столбцов. Но, если просмотреть вновь созданную таблицу, то видны NA. Так, используя head(ratingdat) или ratingdat[1:50, ], обнаруживаем, что NA присутствуют в столбце "SE" напротив N = 1. Исходя из требований к вычислениям статистических характеристик и намерением выделить популярных актеров с высоким рейтингом, осуществим выбор тех экземпляров, в которых N>=15.

> ratings<-ratingdat[which(ratingdat$N>=15),]
> ratings
 actor_1_name M SE N
78 Angelina Jolie Pitt 6.606667 0.1722309 15
91 Anthony Hopkins 6.822222 0.2062037 18
141 Bill Murray 6.879167 0.1607252 24
162 Brad Pitt 7.152941 0.1983605 17
184 Bruce Willis 6.644828 0.1716758 29
222 Channing Tatum 6.429412 0.1769357 17
254 Christian Bale 7.209091 0.1897719 22
357 Denzel Washington 7.083333 0.1077549 30
390 Dwayne Johnson 6.216667 0.1079367 18
489 Gerard Butler 6.510526 0.2178973 19
514 Harrison Ford 7.164000 0.2150876 25
536 Hugh Jackman 6.800000 0.1904289 20
563 J.K. Simmons 6.674194 0.1351198 31
605 Jason Statham 6.512500 0.1832983 24
614 Jeff Bridges 6.725000 0.1742843 16
696 Johnny Depp 6.794737 0.1388813 38
714 Joseph Gordon-Levitt 6.856250 0.1650679 16
728 Julia Roberts 6.268750 0.1675109 16
763 Keanu Reeves 6.700000 0.1719454 23
783 Kevin Spacey 7.150000 0.1542683 22
835 Leonardo DiCaprio 7.495238 0.1610200 21
845 Liam Neeson 6.503846 0.1572339 26
924 Matt Damon 6.964286 0.1187695 28
932 Matthew McConaughey 6.730000 0.2116477 20
1009 Morgan Freeman 6.845455 0.2085538 22
1019 Naomi Watts 6.793333 0.1972349 15
1022 Natalie Portman 6.793750 0.1840445 16
1038 Nicolas Cage 6.266667 0.1775525 30
1088 Paul Walker 6.406667 0.1705640 15
1109 Philip Seymour Hoffman 7.233333 0.1338226 18
1158 Robert De Niro 6.709524 0.1661482 42
1159 Robert Downey Jr. 6.815385 0.1766955 26
1169 Robin Williams 6.576000 0.1662608 25
1195 Ryan Gosling 7.062500 0.1772181 16
1199 Ryan Reynolds 6.593333 0.1730584 15
1228 Scarlett Johansson 6.873684 0.2068763 19
1295 Steve Buscemi 6.479167 0.1652818 24
1310 Sylvester Stallone 6.113333 0.2850007 15
1362 Tom Cruise 7.120833 0.1091766 24
1364 Tom Hanks 7.425000 0.1550187 24
1425 Will Ferrell 6.195000 0.1605050 20
1428 Will Smith 6.731579 0.1825826 19

Упорядочим актеров по среднему рейтингу (ordered factor)

> ratings$actor_1_name <- factor(ratings$actor_1_name)
> ratings$actor_1_name <- reorder(ratings$actor_1_name, ratings$M)

Следующим шагом является создание графика главных актеров, упорядоченных по показателю среднего рейтинга. Но прежде, чем сделать это, нужно подключить такие add-onn пакеты, как

> library(ggplot2)
> library(ggthemes)

Теперь к построению графика с помощью следующей записи команд:

> ggplot(ratings, aes(x = M, xmin = M-SE, xmax = M+SE, y = actor_1_name )) +
+ geom_point() + 
+ geom_segment( aes(x = M-SE, xend = M+SE,
+ y = actor_1_name, yend=actor_1_name)) +
+ theme(axis.text=element_text(size=8)) +
+ xlab("Mean rating") + ylab("First Actor")

Получаем график упорядоченных рейтингов актеров

Новая таблица - data frame

Создание "imdbdf2"

Новая таблица данных основывается на "movie":

> imdbdf2<-as.data.frame(movie)
> imdbdf2 <- na.omit(imdbdf2); dim(imdbdf2)
> imdbdf2 <- imdbdf2[, c("actor_1_name","movie_title", "title_year", 
 "gross", "imdb_score", "plot_keywords")]
> imdbdf2 <- imdbdf2[!duplicated(imdbdf2),]
> dim(imdbdf2)
[1] 3701 6

Как видно, созданная таблица данных «imdbdf2» не содержит повторы в строках и экземпляры с отсутствующими значениями (NA). Последнее было обеспечено за счет реализации функции na.omit(). Вся таблица состоит из 3701 строки и 6 столбцов: «actor_1_name», «movie_title», «title_year», «gross», «imdb_score», «plot_keywords».

Рейтинги фильмов по годам

На представленном ниже рисунке изображено распределение рейтингов фильмов (IMDb scores) по годам.

Построение данного графика достигается посредством выполнения следующего кода:

> ggplot(imdbdf2,aes(x=title_year,y=imdb_score)) +
+ geom_jitter(alpha=0.5, shape=1, size=1, color="red") +
+ theme_minimal()

Топ-10 актеров по числу главных ролей

Выбор топ-10

Определим, в скольких кинофильмах, собранных в таблице "imdbdf2", каждый из актеров сыграл главную роль. Полученные значения перенесем в отдельную таблицу "actors", а ее столбцам присвоим названия "Actor" и "No_movies", т.е. имя актера и число фильмов, в которых он сыграл главную роль:

> actors<-count(imdbdf2, "actor_1_name")
> names(actors)<-c("Actor", "No_movies")

Созданная таблица состоит из 1457 строк, а сумма по 2-му столбцу, которая показывает количество всех кинофильмов, равняется 3701, что соответствует числу строк в "imdbdf2":

> dim(actors); sum(actors$No_movies)
[1] 1457    2
[1] 3701

Упорядочим актеров в "actors" по количеству кинофильмов с их участием по убыванию:

> actors_y<-actors[order(actors$No_movies, actors$Actor, decreasing = T), ]

Отберем 10 актеров с наибольшим числом сыгранных главных ролей. Обозначим эту выборку через "actorsTop10":

> actorsTop10<-data.frame(actors_y[1:10, ])

Шапка "actorsTop10" для первых трех строк имеет вид:

              Actor No_movies
1158 Robert De Niro        42
696     Johnny Depp        34
1037   Nicolas Cage        30

Первая десятка актеров насчитывает 294 кинофильма, что составляет 7,9 % от общего количества кинофильмов в "imdbdf2":

> sum(actorsTop10$No_movies)
> sum(actorsTop10$No_movies)/sum(actors$No_movies)
[1] 294
[1] 0.07943799

Сравнение по 2 первым актерам

Далее осуществим выборку записей из "imdbdf2", в которых по столбцу "actor_1_name" присутствуют актеры из "actorsTop10", например, Роберт Де Ниро и Джонни Депп:

> temp1<-subset(imdbdf2, imdbdf2$actor_1_name=='Robert De Niro' | imdbdf2$actor_1_name=='Johnny Depp')
## or
> temp2<-imdbdf2[imdbdf2[,1]=='Robert De Niro' | imdbdf2[,1]=='Johnny Depp', ]
## or
> temp3<-imdbdf2[which(imdbdf2$actor_1_name=='Robert De Niro' | imdbdf2$actor_1_name=='Johnny Depp'), ]

Полученные таким образом таблицы состоят из 80 строк и 6 столбцов.

На основе графика сравним указанных актеров по динамике дохода кинофильмов с их участием:

> qplot(x=title_year, y=gross, data=temp1, col=factor(actor_1_name))

Чтобы посмотреть динамику рейтинговой оценки IMDb кинофильмов, главную роль в которых сыграл Роберт де Ниро или Джонни Депп, выполним:

> qplot(x=title_year, y=imdb_score, data=temp1, col=factor(actor_1_name))

Чтобы получить больше сведений, к примеру, о Роберте Де Ниро, достаточно ввести:

> summary(imdbdf2[imdbdf2$actor_1_name=='Robert De Niro',])
> sum(imdbdf2[imdbdf2$actor_1_name=='Robert De Niro', 'gross'])

В таблице ниже содержатся сведения о Роберте Де Ниро и Джонни Деппе, занимающих 1-ю и 2-ю позицию в Топ-10 по числу сыгранных главных ролей. Из таблицы видно, что Роберт Де Ниро сыграл в 42 фильмах, тогда как Джонни Депп в 34. Фильм с максимальной оценкой, равной 9, относится к Де Ниро. По показателям дохода преимущество у группы кинофильмов с Дж. Депп. Так, средний доход фильмов, в которых снялся Де Ниро, составляет чуть более 50 млн. долл. От проката фильмов с участием Деппа в среднем получено почти 94,4 млн.

Таблица. Характеристика кинофильмов с Р. Де Ниро и Дж. Деппом в главной роли

Анализ топ-10

Сформируем выборку кинофильмов по всем актерам, вошедшим в десятку лучших по числу сыгранных главных ролей:

> proba<-data.frame()
> for (i in 1:nrow(actorsTop10)) {
+   chek<-actorsTop10$Actor[i]
+   for (j in 1:nrow(imdbdf2)) {
+   pp1<-imdbdf2[which(imdbdf2$actor_1_name==chek), ]
+   }
+   proba<-rbind(proba,pp1)
+ }

Проверим, имеет ли "proba" повторяющиеся экземпляры, и исключим их из данной таблицы:

> proba <- proba[!duplicated(proba),]; dim(proba)
[1] 294   6

Таким образом, в окончательном варианте новая таблица содержит 294 строки.

Чтобы посмотреть, в каком году снялся в главной роли каждый из данных актеров, введем:

> ggplot(proba, aes(x = title_year, y = actor_1_name )) +
+   geom_point() +
+   theme(axis.text=element_text(size=10)) +
+   xlab("Year") + ylab("Actor")+
+   ggtitle("Top-10 Actors")

Построим график оценок по годам для десяти актеров:

> qplot(x=title_year, y=imdb_score, data=proba, col=factor(actor_1_name))

или

> p2 <- ggplot(proba, aes(x = title_year, y = imdb_score, col= factor(actor_1_name))) +
+   geom_point() +
+   ggtitle("Top-10 Actor IMDb score by year"); p2

Динамика рейтингов фильмов по годам и отдельно по каждому актеру задается посредством команд:

p3 <- p2 + facet_wrap(~ proba$actor_1_name, nrow = 3) +
  geom_line() +
  theme(legend.position="none")

p4<-p3 + stat_smooth(method="lm", se=FALSE, size=0.1)
p4 + theme_hc() + theme(legend.position="none")

Возможно, будет полезным изучить суммарный рейтинг отобранных кинофильмов по годам с учетом вклада каждого из актеров, вошедших в десятку:

> ggplot(proba, aes(x = title_year, fill = actor_1_name)) +
+   geom_bar() +
+   scale_fill_ptol() +
+   theme_minimal()

Вывод: кто же лучший?

Исходя из средней оценки кинофильмов (не менее 15-ти), в которых актер сыграл главную роль, лидером выступает Леонардо ДиКаприо, а следом за ним Том Хэнкс.

Представим упорядоченный по средней оценке список актеров, вошедших в Топ-10 по числу главных ролей:

В тоже время Топ-10 актеров по числу кинофильмов, в которых ими сыграна главная роль, имеет следующий вид:

Сведем все рейтинги в одну таблицу:

Итак, получен список 18 претендентов на звание лучшего актера. Далее стоит вопрос о том, какую применить методику для выбора наилучшего.

Источники

1. https://varmara.github.io/proteomics-course/02_data_preprocessing.html
2. https://blog.nycdatascience.com/student-works/machine-learning/movie-rating-prediction/
3. https://www.kaggle.com/deepmatrix/imdb-5000-movie-dataset/