Итоговая работа по курсу R
Захарова ОР
2026-03-25
library(tidyverse)## Warning: пакет 'tidyverse' был собран под R версии 4.5.3## Warning: пакет 'ggplot2' был собран под R версии 4.5.3## Warning: пакет 'tidyr' был собран под R версии 4.5.3## Warning: пакет 'readr' был собран под R версии 4.5.3## Warning: пакет 'purrr' был собран под R версии 4.5.3## Warning: пакет 'stringr' был собран под R версии 4.5.3## Warning: пакет 'forcats' был собран под R версии 4.5.3## Warning: пакет 'lubridate' был собран под R версии 4.5.3## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.2.0 ✔ readr 2.2.0
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ ggplot2 4.0.2 ✔ tibble 3.3.1
## ✔ lubridate 1.9.5 ✔ tidyr 1.3.2
## ✔ purrr 1.2.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(ggplot2)
library(pROC)## Warning: пакет 'pROC' был собран под R версии 4.5.3## Type 'citation("pROC")' for a citation.
##
## Присоединяю пакет: 'pROC'
##
## Следующие объекты скрыты от 'package:stats':
##
## cov, smooth, varТема: Факторы, определяющие тип контента (фильм или телешоу) в каталоге Netflix.
Обоснование: Netflix — одна из крупнейших стриминговых платформ в мире, формирование её контентной библиотеки подчиняется определённым стратегиям. Понимание того, какие характеристики отличают фильмы от сериалов, позволяет не только описать текущую структуру каталога, но и выявить тренды в производстве и добавлении контента. В данном исследовании мы анализируем, как год выпуска, страна производства, жанр, возрастной рейтинг и длительность, связаны с типом контента.
Датасет netflix_titles_cleaned.csv представляет собой очищенную версию публичного набора данных о фильмах и сериалах, доступных на Netflix (источник: Kaggle).
netflix <- read_csv("netflix_titles_cleaned.csv")## Rows: 8807 Columns: 13
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (11): show_id, type, title, director, cast, country, date_added, rating,...
## dbl (2): release_year, duration_value
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.Для анализа создадим новые переменные:
duration_num — числовая длительность (минуты для фильмов, количество сезонов для шоу);
main_genre — первый жанр из списка;
main_country — первая страна производства;
decade — десятилетие выпуска.
Переменные type rating main_genre main_country определяем как фактор. Удаляем пропущенные значения.
netflix <- netflix %>%
mutate(
type = as.factor(type),
rating = as.factor(rating),
duration_num = parse_number(duration),
duration_min = if_else(type == "Movie", duration_num, NA_real_),
seasons = if_else(type == "TV Show", duration_num, NA_real_),
main_genre = str_split(listed_in, ", ", simplify = TRUE)[,1] %>% as.factor(),
main_country = str_split(country, ", ", simplify = TRUE)[,1] %>% as.factor(),
decade = floor(release_year / 10) * 10,
# Добавляем преобразование даты добавления
date_added_parsed = mdy(date_added), # парсим дату (если формат "September 15, 2021")
year_added = year(date_added_parsed) # извлекаем год
) %>%
filter(!is.na(main_country), !is.na(main_genre), !is.na(rating))Просмотр структуры данных
glimpse(netflix)## Rows: 8,807
## Columns: 21
## $ show_id <chr> "s1", "s2", "s3", "s4", "s5", "s6", "s7", "s8", "s9"…
## $ type <fct> Movie, TV Show, TV Show, TV Show, TV Show, TV Show, …
## $ title <chr> "Dick Johnson Is Dead", "Blood & Water", "Ganglands"…
## $ director <chr> "Kirsten Johnson", "Unknown", "Julien Leclercq", "Un…
## $ cast <chr> "Various", "Ama Qamata, Khosi Ngema, Gail Mabalane, …
## $ country <chr> "United States", "South Africa", "International", "I…
## $ date_added <chr> "September 25, 2021", "September 24, 2021", "Septemb…
## $ release_year <dbl> 2020, 2021, 2021, 2021, 2021, 2021, 2021, 1993, 2021…
## $ rating <fct> PG-13, TV-MA, TV-MA, TV-MA, TV-MA, TV-MA, PG, TV-MA,…
## $ duration <chr> "90 min", "2 Seasons", "1 Season", "1 Season", "2 Se…
## $ listed_in <chr> "Documentaries", "International TV Shows, TV Dramas,…
## $ description <chr> "As her father nears the end of his life, filmmaker …
## $ duration_value <dbl> 90, 2, 1, 1, 2, 1, 91, 125, 9, 104, 1, 1, 127, 91, 1…
## $ duration_num <dbl> 90, 2, 1, 1, 2, 1, 91, 125, 9, 104, 1, 1, 127, 91, 1…
## $ duration_min <dbl> 90, NA, NA, NA, NA, NA, 91, 125, NA, 104, NA, NA, 12…
## $ seasons <dbl> NA, 2, 1, 1, 2, 1, NA, NA, 9, NA, 1, 1, NA, NA, 1, 4…
## $ main_genre <fct> Documentaries, International TV Shows, Crime TV Show…
## $ main_country <fct> "United States", "South Africa", "International", "I…
## $ decade <dbl> 2020, 2020, 2020, 2020, 2020, 2020, 2020, 1990, 2020…
## $ date_added_parsed <date> 2021-09-25, 2021-09-24, 2021-09-24, 2021-09-24, 202…
## $ year_added <dbl> 2021, 2021, 2021, 2021, 2021, 2021, 2021, 2021, 2021…summary(netflix)## show_id type title director
## Length:8807 Movie :6131 Length:8807 Length:8807
## Class :character TV Show:2676 Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
##
## cast country date_added release_year
## Length:8807 Length:8807 Length:8807 Min. :1925
## Class :character Class :character Class :character 1st Qu.:2013
## Mode :character Mode :character Mode :character Median :2017
## Mean :2014
## 3rd Qu.:2019
## Max. :2021
##
## rating duration listed_in description
## TV-MA :3211 Length:8807 Length:8807 Length:8807
## TV-14 :2160 Class :character Class :character Class :character
## TV-PG : 863 Mode :character Mode :character Mode :character
## R : 799
## PG-13 : 490
## TV-Y7 : 334
## (Other): 950
## duration_value duration_num duration_min seasons
## Min. : 1.00 Min. : 1.00 Min. : 3.00 Min. : 1.000
## 1st Qu.: 2.00 1st Qu.: 2.00 1st Qu.: 87.00 1st Qu.: 1.000
## Median : 88.00 Median : 88.00 Median : 98.00 Median : 1.000
## Mean : 69.86 Mean : 69.86 Mean : 99.58 Mean : 1.765
## 3rd Qu.:106.00 3rd Qu.:106.00 3rd Qu.:114.00 3rd Qu.: 2.000
## Max. :312.00 Max. :312.00 Max. :312.00 Max. :17.000
## NA's :2676 NA's :6131
## main_genre main_country decade
## Dramas :1600 United States :3210 Min. :1920
## Comedies :1210 India :1008 1st Qu.:2010
## Action & Adventure : 859 International : 831 Median :2010
## Documentaries : 829 United Kingdom: 626 Mean :2009
## International TV Shows : 774 Canada : 271 3rd Qu.:2010
## Children & Family Movies: 605 Japan : 259 Max. :2020
## (Other) :2930 (Other) :2602
## date_added_parsed year_added
## Min. :2003-07-01 Min. :2003
## 1st Qu.:2018-04-03 1st Qu.:2018
## Median :2019-07-01 Median :2019
## Mean :2019-05-14 Mean :2019
## 3rd Qu.:2020-08-18 3rd Qu.:2020
## Max. :2021-09-25 Max. :2021
## 1.Описательный анализ ключевой переменной
ggplot(netflix, aes(x = type, fill = type)) +
geom_bar() +
labs(title = "Распределение типов контента в каталоге Netflix",
x = "Тип контента", y = "Количество") +
theme_minimal()
В каталоге Netflix преобладают фильмы (Movie), однако доля телешоу (TV Show) также значительна. Это отражает стратегию платформы по привлечению аудитории разными форматами.
2. Анализ категориальных переменных
Динамика контента на Netflix по годам
netflix %>%
filter(!is.na(year_added)) %>%
ggplot(aes(x = year_added, fill = type)) +
geom_histogram(binwidth = 1, alpha = 0.7, position = "stack") +
labs(title = "Динамика добавления контента на Netflix по годам",
x = "Год добавления", y = "Количество") +
theme_minimal()
Этот график показывает, как росла библиотека Netflix с 2008 по 2021 год. Виден резкий скачок добавлений после 2015 года, что связано с началом активного производства оригинального контента. Сериалы начинают добавляться в больших объёмах позже фильмов, но к 2020 году их доля существенно увеличивается.
Доля фильмов и сериалов по годам (выпуск)
netflix %>%
group_by(release_year, type) %>%
summarise(count = n(), .groups = "drop") %>%
group_by(release_year) %>%
mutate(prop = count / sum(count)) %>%
filter(!is.na(release_year), release_year > 1950) %>% # убираем ранние годы с малым числом
ggplot(aes(x = release_year, y = prop, fill = type)) +
geom_area(alpha = 0.6) +
labs(title = "Доля фильмов и сериалов по годам выпуска",
x = "Год выпуска", y = "Доля") +
scale_y_continuous(labels = scales::percent) +
theme_minimal()
График показывает, что до 2000-х годов почти весь контент составляли фильмы. С 2005 года начинает расти доля сериалов.
Гипотеза 1: тип контента зависит от года выпуска
t_test_year <- t.test(release_year ~ type, data = netflix)
t_test_year##
## Welch Two Sample t-test
##
## data: release_year by type
## t = -20.976, df = 8034, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group Movie and group TV Show is not equal to 0
## 95 percent confidence interval:
## -3.809848 -3.158635
## sample estimates:
## mean in group Movie mean in group TV Show
## 2013.122 2016.606p-value < 2.2e-16, что значительно меньше 0.05. Следовательно, средний год выпуска фильмов и сериалов статистически значимо различается. Сериалы в среднем выпущены позже фильмов.
ggplot(netflix, aes(x = release_year, fill = type)) +
geom_histogram(binwidth = 2, alpha = 0.7, position = "identity") +
labs(title = "Распределение фильмов и сериалов по году выпуска",
x = "Год выпуска", y = "Количество") +
theme_minimal()
Пик выпуска фильмов приходится на 2018–2020 годы, тогда как сериалы активнее выпускаются с 2016 года. Это объясняет значимые различия в среднем годе выпуска между типами контента.
Гипотеза 2: тип контента связан со страной производства (топ-10 стран)
top_countries <- netflix %>%
count(main_country, sort = TRUE) %>%
slice_head(n = 10) %>%
pull(main_country)
tab_country <- netflix %>%
filter(main_country %in% top_countries) %>%
select(type, main_country) %>%
table()
tab_country <- tab_country[rowSums(tab_country) > 0, colSums(tab_country) > 0]
chi2_country <- chisq.test(tab_country, simulate.p.value = TRUE, B = 10000)
chi2_country##
## Pearson's Chi-squared test with simulated p-value (based on 10000
## replicates)
##
## data: tab_country
## X-squared = 776.8, df = NA, p-value = 9.999e-05p-value < 9.999e-05, что указывает на значимую связь между типом контента и страной производства.
netflix %>%
filter(main_country %in% top_countries) %>%
ggplot(aes(x = fct_infreq(main_country), fill = type)) +
geom_bar(position = "dodge") +
labs(title = "Топ-10 стран производства контента",
x = "Страна", y = "Количество") +
coord_flip() +
theme_minimal()
На графике видно, что США лидируют по количеству контента, причём доля сериалов там выше, чем в других странах. Это визуально подтверждает значимую связь между страной и типом контента
Гипотеза 3: тип контента связан с основным жанром (топ-10 жанров)
top_genres <- netflix %>%
count(main_genre, sort = TRUE) %>%
slice_head(n = 10) %>%
pull(main_genre)
tab_genre <- netflix %>%
select(type, main_genre) %>%
table()
tab_genre <- tab_genre[rowSums(tab_genre) > 0, colSums(tab_genre) > 0]
chi2_genre <- chisq.test(tab_genre, simulate.p.value = TRUE, B = 10000)
chi2_genre##
## Pearson's Chi-squared test with simulated p-value (based on 10000
## replicates)
##
## data: tab_genre
## X-squared = 8807, df = NA, p-value = 9.999e-05Результаты теста хи‑квадрат (p‑value = 0.0001, симуляция Монте‑Карло) указывают на статистически значимую связь между типом контента и жанром. Некоторые жанры, такие как «Документальные фильмы», чаще встречаются среди фильмов, а «Детские”, семейные» и “криминальное телевидение” — среди сериалов.
netflix %>%
filter(main_genre %in% top_genres) %>%
ggplot(aes(x = fct_infreq(main_genre), fill = type)) +
geom_bar(position = "dodge") +
labs(title = "Топ-10 жанров",
x = "Жанр", y = "Количество") +
coord_flip() +
theme_minimal()
На графике видно, что в жанрах «Драма», «Комедия» и «Документальные» преобладают фильмы, а в «Детских» и «Аниме» — сериалы. Это визуально подтверждает результаты теста хи-квадрат.
Гипотеза 4: тип контента связан с возрастным рейтингом
chi2_rating <- netflix %>%
select(type, rating) %>%
table() %>%
chisq.test()## Warning in chisq.test(.): аппроксимация на основе хи-квадрат может быть
## неправильнойchi2_rating##
## Pearson's Chi-squared test
##
## data: .
## X-squared = 1047.9, df = 16, p-value < 2.2e-16p-value < 2.2e-16 — связь значима. Например, рейтинг «TV-MA» чаще встречается у сериалов, а «PG-13» — у фильмов.
ggplot(netflix, aes(x = rating, fill = type)) +
geom_bar(position = "dodge") +
labs(title = "Распределение возрастных рейтингов по типу контента",
x = "Возрастной рейтинг", y = "Количество") +
coord_flip() +
theme_minimal()
Распределение возрастных рейтингов различается для фильмов и сериалов. Например, рейтинг «TV-MA» чаще встречается у сериалов, а «PG-13» — у фильмов, что согласуется с результатами теста.
Гипотеза 5: тип контента зависит от десятилетия выпуска
chi2_decade <- netflix %>%
select(type, decade) %>%
table() %>%
chisq.test()## Warning in chisq.test(.): аппроксимация на основе хи-квадрат может быть
## неправильнойchi2_decade##
## Pearson's Chi-squared test
##
## data: .
## X-squared = 436.71, df = 9, p-value < 2.2e-16p-value < 2.2e-16 — связь значима. Доля сериалов растёт в последние десятилетия, что отражает тренд на увеличение производства оригинальных сериалов.
ggplot(netflix, aes(x = factor(decade), fill = type)) +
geom_bar(position = "dodge") +
labs(title = "Распределение контента по десятилетиям выпуска",
x = "Десятилетие", y = "Количество") +
theme_minimal()
Доля сериалов растёт в последние десятилетия, особенно в 2010-е годы. Это отражает глобальный тренд на увеличение производства оригинальных сериалов.
Корреляционный анализ
library(corrplot)## Warning: пакет 'corrplot' был собран под R версии 4.5.3## corrplot 0.95 loadedcor_data <- netflix %>%
select(release_year, duration_num) %>%
drop_na()
cor_matrix <- cor(cor_data)
corrplot(cor_matrix, method = "color", type = "upper",
tl.col = "black", tl.srt = 45, addCoef.col = "black")
Из корреляционной матрицы видно, что коэффициент корреляции Пирсона между годом выпуска и длительностью контента составляет -0.25. Это означает слабую отрицательную связь, то есть чем новее контент, тем меньше его длительность.
3. Многомерное статистическое моделирование. Логистическая регрессия
Подготовка данных для модели
Отбираем частые страны, жанры и возрастные рейтинги, чтобы уменьшить количество категорий, создаем бинарную зависимую переменную (фильм — 1, сериал — 0), объединяем редкие категории в группу «Other» и удаляем строки с пропусками
model_data <- netflix %>%
filter(main_country %in% top_countries,
main_genre %in% top_genres,
rating %in% c("TV-MA", "TV-14", "PG-13", "R", "TV-PG", "PG")) %>%
mutate(
type_bin = ifelse(type == "Movie", 1, 0),
log_duration = log(duration_num + 1),
main_genre = fct_lump_n(main_genre, n = 10, other_level = "Other"),
main_country = fct_lump_n(main_country, n = 10, other_level = "Other"),
rating = fct_lump_n(rating, n = 6, other_level = "Other")
) %>%
select(type_bin, release_year, log_duration, main_genre, main_country, rating) %>%
drop_na()
nrow(model_data)## [1] 4810Регуляризованная логистическая регрессия
library(glmnet)## Warning: пакет 'glmnet' был собран под R версии 4.5.3## Загрузка требуемого пакета: Matrix## Warning: пакет 'Matrix' был собран под R версии 4.5.3##
## Присоединяю пакет: 'Matrix'## Следующие объекты скрыты от 'package:tidyr':
##
## expand, pack, unpack## Loaded glmnet 4.1-10library(pROC)
X <- model.matrix(~ release_year + log_duration + main_genre + main_country + rating,
data = model_data)[, -1]
y <- model_data$type_bin
set.seed(123)
cv_fit <- cv.glmnet(X, y, family = "binomial", alpha = 0)
logit_model <- glmnet(X, y, family = "binomial", alpha = 0, lambda = cv_fit$lambda.min)Коэффициенты и odds ratios
coef(logit_model)## 29 x 1 sparse Matrix of class "dgCMatrix"
## s0
## (Intercept) 27.56698283
## release_year -0.01356767
## log_duration 0.73271284
## main_genreChildren & Family Movies 0.46817670
## main_genreComedies 0.50958497
## main_genreCrime TV Shows -2.91142700
## main_genreDocumentaries 0.62400400
## main_genreDramas 0.53888276
## main_genreHorror Movies 0.47420638
## main_genreInternational TV Shows -2.68568914
## main_genreKids' TV -3.13631009
## main_genreStand-Up Comedy 0.64931557
## main_genreOther .
## main_countryFrance -0.09907370
## main_countryIndia 0.18566552
## main_countryInternational -0.37320469
## main_countryJapan -0.21730716
## main_countryMexico -0.29469551
## main_countrySouth Korea -0.84941467
## main_countrySpain -0.22565454
## main_countryUnited Kingdom 0.29537928
## main_countryUnited States 0.18969306
## main_countryOther .
## ratingPG-13 0.32387235
## ratingR 0.34371768
## ratingTV-14 -0.15887093
## ratingTV-MA -0.21192884
## ratingTV-PG -0.08472668
## ratingOther .exp(coef(logit_model))## 29 x 1 Matrix of class "dgeMatrix"
## s0
## (Intercept) 9.379691e+11
## release_year 9.865240e-01
## log_duration 2.080718e+00
## main_genreChildren & Family Movies 1.597080e+00
## main_genreComedies 1.664600e+00
## main_genreCrime TV Shows 5.439805e-02
## main_genreDocumentaries 1.866386e+00
## main_genreDramas 1.714091e+00
## main_genreHorror Movies 1.606739e+00
## main_genreInternational TV Shows 6.817420e-02
## main_genreKids' TV 4.344280e-02
## main_genreStand-Up Comedy 1.914230e+00
## main_genreOther 1.000000e+00
## main_countryFrance 9.056760e-01
## main_countryIndia 1.204019e+00
## main_countryInternational 6.885243e-01
## main_countryJapan 8.046828e-01
## main_countryMexico 7.447583e-01
## main_countrySouth Korea 4.276652e-01
## main_countrySpain 7.979937e-01
## main_countryUnited Kingdom 1.343636e+00
## main_countryUnited States 1.208878e+00
## main_countryOther 1.000000e+00
## ratingPG-13 1.382471e+00
## ratingR 1.410180e+00
## ratingTV-14 8.531065e-01
## ratingTV-MA 8.090223e-01
## ratingTV-PG 9.187634e-01
## ratingOther 1.000000e+00Построенная модель логистической регрессии позволяет оценить влияние факторов на вероятность того, что контент является фильмом. Год выпуска имеет отрицательный эффект - с каждым годом шанс быть фильмом снижается примерно на 1,35% (odds ratio = 0,986).
Предсказанные вероятности и классы
вычислим предсказанные вероятности и выведем матрицу ошибок
pred_prob <- predict(logit_model, newx = X, type = "response")[,1]
pred_class <- ifelse(pred_prob > 0.5, 1, 0)
conf_matrix <- table(Actual = y, Predicted = pred_class)
accuracy <- sum(diag(conf_matrix)) / sum(conf_matrix)
conf_matrix## Predicted
## Actual 0 1
## 0 762 0
## 1 0 4048accuracy## [1] 1Матрица ошибок показывает, что модель правильно классифицировала все 762 сериала и 4048 фильмов, достигнув точности 100%. Это свидетельствует об отличной разделяющей способности выбранных предикторов на обучающей выборке, accuracy = 1.
построим ROC-кривую
roc_obj <- roc(y, pred_prob)## Setting levels: control = 0, case = 1## Setting direction: controls < casesplot(roc_obj, main = "ROC-кривая")
auc(roc_obj)## Area under the curve: 1Площадь под ROC-кривой (AUC) составляет 1.0, что указывает на идеальную разделяющую способность модели. Модель правильно классифицирует все наблюдения, accuracy = 100%.
Модель хорошо различает фильмы и сериалы.
Вывод
В ходе работы был проведён анализ факторов, влияющих на тип контента в каталоге Netflix. Установлено, что тип контента значимо связан с годом выпуска, страной производства, жанром, возрастным рейтингом и десятилетием выпуска. Построенная логистическая регрессионная модель позволяет предсказывать тип контента с точностью 100%. По величине стандартизированных коэффициентов наиболее важными предикторами являются год выпуска и длительность.