Загрузка и фильтрация данных

library(dplyr)
library(ggplot2)
library(stringr)
library(readr)
library(knitr)
library(psych)
library(magrittr)
library(kableExtra)
library(tidytext)
library(RColorBrewer)
library(haven)
library(wordcloud2)
library(RColorBrewer)
library(tidyr)
library(igraph)
movies1 <- read_csv("D:/Documents/movies.csv")
movies <- read_csv("D:/Documents/movies1.csv")
ratings <- read_csv("D:/Documents/ratings.csv")
movies_rating = inner_join( x = movies1, y = ratings, by = "movie_id")
movies2 = movies %>% 
  rename(title = name)
movies3 = movies_rating %>% 
  rename(title = title.x)
moviesfin = movies2 %>% 
  inner_join(movies3, by = "title")
net1 = moviesfin
net1$movie_year <- as.numeric(as.character(net1$movie_year, ordered= F, exclude = NA))

net1$movie_year1 <- ifelse (net1$movie_year <= 1916 & net1$movie_year <= 1920, "1920s",
                    ifelse(net1$movie_year <= 1921 & net1$movie_year <= 1930, "1930s", 
                    ifelse(net1$movie_year <= 1931 & net1 <= 1940, "1940s", 
                    ifelse(net1$movie_year <= 1941 & net1$movie_year <= 1950, "1950s",
                    ifelse(net1$movie_year <= 1951 & net1$movie_year <= 1960, "1960s",
                    ifelse(net1$movie_year <= 1961 & net1$movie_year <= 1970, "1970s",
                    ifelse(net1$movie_year <= 1971 & net1$movie_year <= 1980, "1980s",
                    ifelse(net1$movie_year <= 1981 & net1$movie_year <= 1990, "1990s",
                    ifelse(net1$movie_year <= 1991 & net1$movie_year <= 2000, "2000s", "2010s")))))))))
net1$movie_year1 <- factor(net1$movie_year1, ordered= F, exclude = NA)
moviess = net1
moviess6 = moviess %>% filter(!is.na(rating.x))

Анализ новых данных

Cписок дополнительных переменных, которые удалось привлечь: : director, star, votes, writer, rating (возрастные ограничения).

Самые популярные фигуры кинематографа

moviess1 = moviess %>%
  select(director, popularity) %>% 
  group_by(director) %>% 
  summarize(mean.popularity = mean(popularity)) %>% 
  top_n(10) %>% 
  arrange(desc(mean.popularity))
kable(moviess1) %>% 
  kable_styling(bootstrap_options=c("bordered", "responsive","striped"), full_width = FALSE)
director mean.popularity
Gore Verbinski 271.97289
Jeremiah S. Chechik 144.44863
Joss Whedon 144.44863
Brad Bird 130.31135
Christopher Nolan 115.04002
James Cameron 100.02590
Hayao Miyazaki 96.01283
Barry Sonnenfeld 82.99932
Chris Columbus 81.48768
Ron Clements 76.84225 
moviess2 = moviess %>%
  select(star, popularity) %>% 
  group_by(star) %>% 
  summarize(mean.popularity = mean(popularity)) %>% 
  top_n(10) %>% 
  arrange(desc(mean.popularity))
kable(moviess2) %>% 
  kable_styling(bootstrap_options=c("bordered", "responsive","striped"), full_width = FALSE)
star mean.popularity
Johnny Depp 161.35684
Daveigh Chase 118.96856
Leonardo DiCaprio 100.02590
Christian Bale 96.96907
Robert Downey Jr. 94.92100
Vince Vaughn 93.06787
Tommy Lee Jones 89.83147
Tate Donovan 76.84225
Jim Carrey 69.19151
Ming-Na Wen 67.42776 
moviess3 = moviess %>%
  select(writer, popularity) %>% 
  group_by(writer) %>% 
  summarize(mean.popularity = mean(popularity)) %>% 
  top_n(10) %>% 
  arrange(desc(mean.popularity))
kable(moviess3) %>% 
  kable_styling(bootstrap_options=c("bordered", "responsive","striped"), full_width = FALSE)
writer mean.popularity
Ted Elliott 271.97289
Joss Whedon 144.44863
Sydney Newman 144.44863
Damon Lindelof 130.31135
Bob Kane 115.04002
Steve Koren 109.68479
James Cameron 100.02590
Hayao Miyazaki 96.01283
Robert Bloch 93.06787
Lowell Cunningham 91.33285

Итак, теперь мы знаем наиболее популярных актеров, режиссеров и писателей. Если мы захотим сделать рекомендацию, обращенную на большинство пользователей сразу, то в приоритете можно предлагать фильмы, в которых задействованы эти фигуры кино.

Возрастные ограничения

options(scipen =999)

moviess4 = moviess %>% 
  filter(rating.x != "NOT RATED") %>% 
  filter(rating.x != "Not specified") %>% 
  filter(rating.x != "UNRATED") 

moviess4 = moviess4[!duplicated(moviess[,c('movie_id')]),]
moviess4$rating <- factor(moviess4$rating.x, levels = c("G", "PG", "PG-13", "R", "NC-17"), ordered = T)

moviess4 = moviess4 %>% filter(!is.na(rating))
ggplot(data = moviess4, aes(x = rating)) + geom_bar(fill = "orange") + xlab("Возрастные ограничения") + ylab("Количество") + ggtitle("Количество фильмов разных рейтингов")

Итак, для просмотра большей части фильмов для зрителей до 17 лет обязательно сопровождение родителя или взрослого опекуна. Примечательно, что фильмы, запрещенных для зрителей до 17 лет составляет наименьшую часть от общего количества. Более 1/3 фильмов предназначены для зрителей старшей 17 лет.

moviess4$Decades <- factor(moviess4$movie_year1, ordered = T)
ggplot(data = moviess4, aes(x = Decades, fill = rating)) + geom_bar(position="fill") + coord_flip() + xlab("Возрастные ограничения") + ylab("Процент") + ggtitle("Возрастные ограничения по десятилетиям ")

Итак, фильмы 1960х - 1980-х годов предназначены для зрителей старше 13-ти лет. Начиная с 1990х годов, примерно для 50% фильмов указано, что они могут содержать сцены с использованием непристойной лексики, продолжительных сцен насилия, секса или употребления наркотиков. Фильмы без возрастных ограничений присутствуют только в 1990-х и 2010-х. Фильмы, запрещенные для зрителей до 17-ти лет представлены только в 2010-х.

ggplot(data = moviess4, aes(x = rating, y = popularity)) + geom_boxplot() +ylim(0,151) + xlab("Рейтинг") + ylab("Популярность") + ggtitle("Популярность возрастных ограничений")

Итак, наибольшую популярность(для 25%, 50%, 75% фильмов) имеют фильмы, в которых отсутствуют возрастные ограничения. Фильмы рейтингов PG И PG-13 имеют одинаковое значение медианы. Тем не менее, для рейтинга PG-13 представлено гораздо большее количество выбросов, согласно которым самые популярные фильмы содержат именно это возрастное ограничение.Наименьшее из представленных медианных значений имеет рейтинг NC-17.

Создание сети по десятилетиям

Нод - год выпуска.

moviess4 = moviess4[!duplicated(moviess4[,c('movie_id')]),]
meta <- moviess4 %>% 
  dplyr::select(movie_id, movie_year1)
meta$count = 1
met = spread(meta, key = movie_year1, value = count)

 met[is.na(met)] <- 0
met1 = met %>% 
  select(-movie_id) %>% 
  as.matrix()
g <- graph_from_incidence_matrix(met1)
 
is.bipartite(g)
## [1] TRUE
pr = bipartite.projection(g) 
 
p <- pr[[1]]
p
## IGRAPH 4a8e2af U-W- 296 30838 -- 
## + attr: weight (e/n)
## + edges from 4a8e2af:
##  [1] 1-- 2 1-- 3 1-- 4 1-- 5 1-- 6 1-- 7 1-- 8 1--10 1--11 1--12 1--14
## [12] 1--15 1--16 1--17 1--18 1--19 1--20 1--21 1--22 1--23 1--24 1--26
## [23] 1--27 1--28 1--30 1--32 1--33 1--34 1--35 1--36 1--37 1--38 1--39
## [34] 1--40 1--41 1--42 1--43 1--44 1--45 1--48 1--49 1--51 1--53 1--54
## [45] 1--55 1--56 1--58 1--59 1--60 1--61 1--63 1--64 1--65 1--66 1--67
## [56] 1--68 1--69 1--70 1--71 1--73 1--74 1--76 1--77 1--78 1--79 1--80
## [67] 1--81 1--82 1--83 1--84 1--85 1--86 1--87 1--88 1--89 1--90 1--91
## [78] 1--93 1--94 1--95 1--96 1--97 1--98
## + ... omitted several edges
V(p)$label <- NA
fgcommune <- fastgreedy.community(p)
membership(fgcommune)
##   [1] 1 1 1 1 1 1 1 1 3 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 2 1 1 1 2 1 3 1 1 1 1
##  [36] 1 1 1 1 1 1 1 1 1 1 4 2 1 1 2 1 2 1 1 1 1 2 1 1 1 1 2 1 1 1 1 1 1 1 1
##  [71] 1 2 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1 2 1 1 1 1 2 1
## [106] 1 1 1 1 1 1 3 1 5 2 1 1 1 3 1 1 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1 1 1 2
## [141] 1 1 1 1 1 1 1 1 1 2 1 1 2 1 1 1 1 1 1 1 1 1 1 1 1 2 2 1 1 1 1 1 1 1 1
## [176] 1 1 1 1 1 1 1 2 1 1 6 2 1 1 1 2 1 1 2 1 1 4 1 1 1 1 2 1 2 2 1 2 1 2 1
## [211] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 3 1 1 1 1 1 2 1 1 1 1 3 2 1 1 1 1 1 2 2
## [246] 1 1 1 2 1 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 2 1 1 1 1 1 1 1 1 1 2 1
## [281] 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1
modularity(fgcommune) # how well the node in each community/cluster is bonded to each other.
## [1] 0.04460563
?modularity
V(p)$size = 7
V(p)$label.dist = 0.9 # labels outside the circles
E(p)$width = 2

plot(fgcommune, p, layout = layout.fruchterman.reingold(p))