# Datos
library(readxl)
IMDB_Top250_Tvshows <- read_excel("IMDB_Top250_Tvshows.xlsx")
IMDB_Top250_Tvshows
## # A tibble: 100 × 7
## Titile Year Total_episodes Age Rating Vote_count Category
## <chr> <chr> <dbl> <chr> <chr> <chr> <chr>
## 1 1. Breaking Bad 2008… 62 18 9.5 (2.2M) TV Seri…
## 2 2. Planet Earth II 2016 6 PG 9.5 (159K) TV Mini…
## 3 3. Planet Earth 2006 11 PG 9.4 (221K) TV Mini…
## 4 4. Band of Brothers 2001 10 15 9.4 (533K) TV Mini…
## 5 5. Chernobyl 2019 5 15 9.3 (876K) TV Mini…
## 6 6. The Wire 2002… 60 18 9.3 (381K) TV Seri…
## 7 7. Avatar: The Last Ai… 2005… 62 PG 9.3 (378K) TV Seri…
## 8 8. Blue Planet II 2017 7 U 9.3 (47K) TV Mini…
## 9 9. The Sopranos 1999… 86 18 9.2 (478K) TV Seri…
## 10 10. Cosmos 2014 13 PG 9.2 (130K) TV Mini…
## # ℹ 90 more rows
Primera Hipótesis: Homogeneidad
# Teniendo en cuenta estos datos, de los 100 shows con mejores puntuaciones en IMDB, haremos una prueba estadÃstica de hipotesis utilizando el método de homogeneidad. Esto con el objetivo de saber si hay una diferencia entre la distribución de las clasificaciones por edades existentes que tiene cada una de las series, con el rating ( puntuación) obtenida por las mismas.
# HIPÓTESIS NULA:
# la hipotesÃs nula escogida para este ejercicio es, que la distribución de las puntuaciones de las series IMDB Top 100 es homogénea a lo largo de las diferentes calificaciones por edades.
# HIPÓTESIS ALTERNATIVA:
# Teniendo la hipótesis nula, la alternativa quedaria de forma que la distribución de las puntucaciones de las series en IMDB TOP 100 no es homogénea a lo largo de las diferentes calificaciones por edades.
# tabla de contigencia
contigen_tabla <- table(IMDB_Top250_Tvshows$Age, IMDB_Top250_Tvshows$Rating)
print(contigen_tabla)
##
## 8.7 8.8 8.9 9 9.1 9.2 9.3 9.4 9.5
## 12 2 1 2 2 1 0 0 0 0
## 15 5 11 3 4 5 2 1 1 0
## 16 0 0 0 1 0 0 0 0 0
## 18 6 1 1 0 0 2 1 0 1
## E 0 0 0 2 1 0 0 0 0
## Not Rated 0 0 1 0 0 0 0 0 0
## PG 2 9 6 6 1 1 1 1 1
## TV-14 0 0 2 1 0 0 0 0 0
## TV-MA 0 1 0 2 1 0 0 0 0
## TV-PG 0 0 0 0 1 0 0 0 0
## U 0 0 0 0 0 0 3 1 0
# Realizamos la prueba de homogeneidad de Chi-cuadrado
chicuadrado_prueba <- chisq.test(contigen_tabla)
## Warning in chisq.test(contigen_tabla): Chi-squared approximation may be
## incorrect
print(chicuadrado_prueba)
##
## Pearson's Chi-squared test
##
## data: contigen_tabla
## X-squared = 111.67, df = 80, p-value = 0.01117
# Interpretamos los resultados de p-Valor
if(chicuadrado_prueba$p.value<0.05){
print("Rechazamos la hipótesis nula:La distribución de las puntuaciones no es homogénea entre las clasificaciones de edades")
} else {
print("No rechazamos la hipótesis nula: No hay suficiente evidencia para decir que hay diferencias entre la distribución de las puntuaciones y la de las clasificaciones por edades")
}
## [1] "Rechazamos la hipótesis nula:La distribución de las puntuaciones no es homogénea entre las clasificaciones de edades"
# Residuos estandarizados
residuos_df <- as.data.frame(as.table(chicuadrado_prueba$stdres))
colnames(residuos_df)<- c("Age", "Rating", "Standardized_Residual")
# Gráfico de dispersión con residuos estandarizados
library(ggplot2)
ggplot(IMDB_Top250_Tvshows, aes(x= Age, y= Rating)) +
geom_point(color = "blue") +
labs(title = "Distribcuión de las puntuaciones y clasificaciones de edad", x = " clasificación Edad", y = "Rating")
# Gráfico de barras apiladas para visualizar la distribución
library(ggplot2)
ggplot(IMDB_Top250_Tvshows, aes(x= Age, fill = as.factor(Rating))) +
geom_bar(position = "fill") +
labs(title = "Distribución de las puntuaciones por clasificaciones de edad", x= "clasificación Edad", y= "Proporción", fill= "Rating") +
theme_minimal()
# Mapa de calor
library(ggplot2)
ggplot(residuos_df, aes( x= Age, y= Rating, fill= Standardized_Residual)) +
geom_tile() +
labs(title = "Mapa de calor de residuos estandarizados", x= "Clasificaión Edad", y= "Rating") +
scale_fill_gradient2(low = "red", high = "blue", mid = "white", midpoint = 0) +
theme_minimal()
Hipótesis 2: Regresión Lineal
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
# Filtrar datos necesarios
IMDB_Top250_Tvshows <- IMDB_Top250_Tvshows %>%
filter(!is.na(Rating) & !is.na(Total_episodes))
# Usaremos el modelo de regresión lineal siemple para ajustar los datos de puntuación de episodios y la cantidad de episodios emitidos, con el fin de evaluar la relación entre estas dos variables.
# Ajustar modelo de regresión
modelo<- lm(Rating ~ Total_episodes, data = IMDB_Top250_Tvshows)
modelo
##
## Call:
## lm(formula = Rating ~ Total_episodes, data = IMDB_Top250_Tvshows)
##
## Coefficients:
## (Intercept) Total_episodes
## 8.9665950 -0.0001415
# Resumen del modelo
resumen_modelo<- summary(modelo)
resumen_modelo
##
## Call:
## lm(formula = Rating ~ Total_episodes, data = IMDB_Top250_Tvshows)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.26532 -0.16203 -0.05203 0.13510 0.54218
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.9665950 0.0227778 393.655 <2e-16 ***
## Total_episodes -0.0001415 0.0001389 -1.018 0.311
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2026 on 98 degrees of freedom
## Multiple R-squared: 0.01047, Adjusted R-squared: 0.0003748
## F-statistic: 1.037 on 1 and 98 DF, p-value: 0.311
# coeficiente del modelo
coeficientes <- resumen_modelo$coefficients
print(coeficientes)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.9665949744 0.0227778177 393.654699 1.382499e-158
## Total_episodes -0.0001414549 0.0001389002 -1.018392 3.109991e-01
# (R^2) del modelo
r_cuadrado <- resumen_modelo$r.squared
r_cuadrado
## [1] 0.01047206
# Predicciones
predicciones <- predict(modelo, newdata = IMDB_Top250_Tvshows)
IMDB_Top250_Tvshows$Rating <- as.numeric(IMDB_Top250_Tvshows$Rating)
predicciones <- as.numeric(predicciones)
# Calculo de residuos
residuos= IMDB_Top250_Tvshows$Rating - predicciones
# Tabla de valores observados, predicchos y residuo
tabla_resultados <- data.frame(
Puntuacion= IMDB_Top250_Tvshows$Rating,
Episodios= IMDB_Top250_Tvshows$Total_episodes,
Puntuacion_predicha= predicciones,
Residuos= residuos
)
print(tabla_resultados)
## Puntuacion Episodios Puntuacion_predicha Residuos
## 1 9.5 62 8.957825 0.54217523
## 2 9.5 6 8.965746 0.53425376
## 3 9.4 11 8.965039 0.43496103
## 4 9.4 10 8.965180 0.43481957
## 5 9.3 5 8.965888 0.33411230
## 6 9.3 60 8.958108 0.34189232
## 7 9.3 62 8.957825 0.34217523
## 8 9.3 7 8.965605 0.33439521
## 9 9.2 86 8.954430 0.24557015
## 10 9.2 13 8.964756 0.23524394
## 11 9.3 13 8.964756 0.33524394
## 12 9.3 12 8.964898 0.33510248
## 13 9.2 74 8.956127 0.24387269
## 14 9.2 26 8.962917 0.23708285
## 15 9.4 194 8.939153 0.46084728
## 16 9.1 68 8.956976 0.14302396
## 17 9.1 74 8.956127 0.14387269
## 18 9.1 11 8.965039 0.13496103
## 19 9.1 10 8.965180 0.13481957
## 20 9.1 156 8.944528 0.15547199
## 21 9.1 15 8.964473 0.13552685
## 22 9.1 10 8.965180 0.13481957
## 23 9.1 98 8.952732 0.14726761
## 24 9.0 85 8.954571 0.04542869
## 25 9.0 188 8.940001 0.05999855
## 26 9.0 8 8.965463 0.03453667
## 27 9.0 10 8.965180 0.03481957
## 28 9.0 63 8.957683 0.04231669
## 29 9.2 10 8.965180 0.23481957
## 30 9.0 25 8.963059 0.03694140
## 31 9.0 8 8.965463 0.03453667
## 32 9.0 10 8.965180 0.03481957
## 33 8.9 14 8.964615 -0.06461461
## 34 9.0 148 8.945660 0.05434036
## 35 9.0 64 8.957542 0.04245814
## 36 9.0 9 8.965322 0.03467812
## 37 8.9 37 8.961361 -0.06136114
## 38 8.9 173 8.942123 -0.04212327
## 39 8.9 3 8.966171 -0.06617061
## 40 8.9 10 8.965180 -0.06518043
## 41 8.9 41 8.960795 -0.06079532
## 42 8.9 31 8.962210 -0.06220987
## 43 8.9 26 8.962917 -0.06291715
## 44 9.0 22 8.963483 0.03651703
## 45 8.9 51 8.959381 -0.05938077
## 46 8.9 32 8.962068 -0.06206842
## 47 9.0 55 8.958815 0.04118505
## 48 9.0 171 8.942406 0.05759382
## 49 9.0 6 8.965746 0.03425376
## 50 8.8 4 8.966029 -0.16602915
## 51 8.8 356 8.916237 -0.11623702
## 52 8.9 7 8.965605 -0.06560479
## 53 8.9 234 8.933495 -0.03349452
## 54 8.8 39 8.961078 -0.16107823
## 55 9.1 10 8.965180 0.13481957
## 56 8.8 172 8.942265 -0.14226473
## 57 8.9 155 8.944669 -0.04466946
## 58 8.8 45 8.960230 -0.16022950
## 59 8.8 120 8.949620 -0.14962038
## 60 8.8 3 8.966171 -0.16617061
## 61 9.0 1122 8.807883 0.19211746
## 62 8.9 11 8.965039 -0.06503897
## 63 8.8 77 8.955703 -0.15570294
## 64 8.8 12 8.964898 -0.16489752
## 65 8.9 28 8.962634 -0.06263424
## 66 9.1 144 8.946225 0.15377454
## 67 8.8 6 8.965746 -0.16574624
## 68 8.8 18 8.964049 -0.16404879
## 69 8.8 6 8.965746 -0.16574624
## 70 8.8 277 8.927412 -0.12741196
## 71 8.8 30 8.962351 -0.16235133
## 72 8.8 30 8.962351 -0.16235133
## 73 8.8 33 8.961927 -0.16192696
## 74 8.8 291 8.925432 -0.12543159
## 75 9.0 24 8.963200 0.03679994
## 76 9.1 20 8.963766 0.13623412
## 77 8.8 13 8.964756 -0.16475606
## 78 8.7 33 8.961927 -0.26192696
## 79 8.7 326 8.920481 -0.22048067
## 80 8.8 48 8.959805 -0.15980514
## 81 8.8 34 8.961786 -0.16178551
## 82 8.8 10 8.965180 -0.16518043
## 83 9.0 15 8.964473 0.03552685
## 84 9.1 20 8.963766 0.13623412
## 85 9.0 27 8.962776 0.03722431
## 86 8.8 36 8.961503 -0.16150260
## 87 8.7 63 8.957683 -0.25768331
## 88 8.7 22 8.963483 -0.26348297
## 89 8.7 56 8.958673 -0.25867350
## 90 8.8 26 8.962917 -0.16291715
## 91 8.7 16 8.964332 -0.26433170
## 92 8.7 26 8.962917 -0.26291715
## 93 8.7 12 8.964898 -0.26489752
## 94 8.7 33 8.961927 -0.26192696
## 95 8.7 9 8.965322 -0.26532188
## 96 8.7 89 8.954005 -0.25400549
## 97 8.7 25 8.963059 -0.26305860
## 98 8.7 74 8.956127 -0.25612731
## 99 8.7 52 8.959239 -0.25923932
## 100 8.7 768 8.857958 -0.15795759
# Prueba Chi-cuadrado para bondad de ajuste
observed<- IMDB_Top250_Tvshows$Rating
expected<- predicciones
chi_cuadrado2 <- sum((observed-expected)^2 / expected)
print(chi_cuadrado2)
## [1] 0.4492111
# Grados de libertad
df<- length(observed) - 2
p_valor <- pchisq(chi_cuadrado2, df, lower.tail = FALSE)
print(p_valor)
## [1] 1
# Visualización
library(ggplot2)
plot(IMDB_Top250_Tvshows$Total_episodes, IMDB_Top250_Tvshows$Rating, main = " Regresión Lineal Simple: Relación entre puntuación y Episodios", xlab = " Cantidad de episodios", ylab = "Rating (puntuación) del episodio", pch= 19, col = "green")
abline(modelo, col = "orange")
