RankingTVShow
JOHN JAIRO PRADO PIÑERES
2024-09-28
options(digits = 3)setwd("C:/Users/john/Desktop/Practica DS/Universidad del Bosque/2. Analisis Multivariado de Datos - AMD")#install.packages('dplyr') # Para manipulación de datos
#install.packages('tibble') # Para trabajar con data frames mejorados
#install.packages('tidyr') # Para limpiar y transformar datos
#install.packages('stringr') # Para manipular cadenas de texto
#install.packages('readxl') # Para leer archivos Excel
#install.packages('mice') # Para imputación de datos faltantes
#install.packages('FactoMineR') # Para análisis de componentes principales (ACP) y análisis factorial
#install.packages('factoextra') # Para visualizar resultados de ACP
#install.packages('ggplot2') # Para gráficos
#install.packages('kernlab') # Para ACP con Kernel
#install.packages('WDI') # Para acceder a la base de datos del Banco Mundial
#install.packages('writexl') # Para escribir archivos Excel
#install.packages("remotes") # Sirve para instalar un paquete directamente desde un repositorio de GitHub, por ejemplo: remotes::install_github("usuario/nombre_paquete")# Carga de librerías necesarias
library(dplyr) # Para manipulación de datos.
library(tibble) # Para trabajar con data frames mejorados.
library(tidyr) # Para limpiar y transformar datos.
library(stringr) # Para manipular cadenas de texto.
library(readxl) # Para leer archivos Excel.
library(mice) # Para imputación de datos faltantes.
library(FactoMineR) # Para análisis de componentes. principales (ACP) y análisis factorial.
library(factoextra) # Para visualizar resultados de ACP.
library(ggplot2) # Para gráficos.
library(kernlab) # Para ACP con Kernel.
library(WDI) # Para acceder a la base de datos del Banco Mundial.
library(writexl) # Para escribir data frames a archivos Excel.
library(remotes) # Sirve para instalar un paquete directamente desde un repositorio de GitHub.library(readxl)
library(dplyr)
library(tibble)
# Cargar los datos y preprocesarlos
af_ranking <- read_xlsx("RankingTVShow.xlsx") %>%
na.omit() %>%
select(`Overall`, `IMDb Users`, `RT Critics`, `RT Users`,
`Metacritic Critics`, `Metacritic Users`,
`TMDB Rating`, `TASTE Rating`,
`Reelgood Rating`, `JustWatch Rating`,
`FA Rating`, `IMDb Votes`)
# Convertir a data frame
af_ranking_df_Overall <- as.data.frame(af_ranking)
# Eliminar la columna 'Overall'
af_ranking_df <- af_ranking_df_Overall[, !names(af_ranking_df_Overall) %in% "Overall"]library(factoextra)
library(gridExtra)
# ACP
acp = PCA(af_ranking_df, scale.unit = T, ncp = 5,
quali.sup = 1:2, graph = FALSE)
# Valores propios y porcentajes de inercia
colnames(acp$eig) = c("v. propio", "inercia", "iner. acum.")
acp$eig## v. propio inercia iner. acum.
## comp 1 3.634 40.37 40.4
## comp 2 1.488 16.53 56.9
## comp 3 1.419 15.76 72.7
## comp 4 0.882 9.80 82.5
## comp 5 0.583 6.47 88.9
## comp 6 0.379 4.21 93.1
## comp 7 0.274 3.04 96.2
## comp 8 0.229 2.55 98.7
## comp 9 0.114 1.26 100.0CONCLUSIONES
La primera componente (CP1) explica el 40.37% de la varianza total, lo que indica que representa una gran parte de la información contenida en los datos. La segunda componente (CP2) añade un 16.53%, acumulando un total del 56.90%. Esto sugiere que las dos primeras componentes juntas capturan más de la mitad de la variabilidad en el conjunto de datos, lo cual es significativo para la interpretación de los resultados.
La tercera componente (CP3) explica un 15.76% adicional, llevando la varianza acumulada a 72.70%. A partir de la cuarta componente (CP4), la inercia comienza a disminuir notablemente, con solo un 9.80% de varianza explicada. Las componentes posteriores contribuyen menos al modelo, lo que indica que su impacto es marginal en comparación con las primeras tres.
Dado que las tres primeras componentes explican más del 72% de la varianza total, es razonable considerar que se puede reducir la dimensionalidad del conjunto de datos a tres dimensiones sin perder una cantidad significativa de información. Esto es útil para visualización y análisis posteriores.
# Histograma de valores propios (Scree Plot)
fviz_screeplot(acp) +
xlab("Componentes") +
ylab("% de varianza explicada")
CONCLUSION:
La combinación de los dos primeros componentes principales captura más de la mitad de la variabilidad de los datos. Esto sugiere que estos componentes son cruciales para entender la estructura de los datos y las relaciones entre las variables.
# Vectores propios (Q)
rownames(acp$svd$V) = rownames(acp$var$coord)
colnames(acp$svd$V) = paste("CP", 1:ncol(acp$svd$V), sep = "")
acp$svd$V # Q## CP1 CP2 CP3 CP4 CP5
## RT Users -0.160 0.0554 0.6380 -0.4332 -0.3752
## Metacritic Critics -0.111 -0.4566 0.4807 0.4420 -0.2546
## Metacritic Users -0.153 0.4379 0.4904 0.0181 0.6613
## TMDB Rating 0.416 -0.1587 0.0841 -0.4997 0.1015
## TASTE Rating 0.320 -0.5038 0.0395 0.0365 0.4806
## Reelgood Rating 0.355 0.4842 0.0724 0.2458 -0.0796
## JustWatch Rating 0.468 -0.0265 0.1238 -0.3124 -0.0969
## FA Rating 0.380 -0.0626 0.3014 0.4106 0.0539
## IMDb Votes 0.417 0.2803 -0.0367 0.1975 -0.3119CONCLUSIONES
CP1: Varias variables, como JustWatch Rating y IMDb Votes, tienen valores positivos altos, indicando que a medida que aumentan estas calificaciones, el componente 1 también tiende a aumentar. Esto sugiere que este componente puede estar relacionado con la popularidad o el reconocimiento general de las series. CP2: La variable Metacritic Critics tiene un valor negativo significativo, mientras que Metacritic Users es positiva. Esto sugiere que este componente podría reflejar diferencias en la percepción crítica versus la percepción del público. CP3: Este componente parece estar fuertemente influenciado por RT Users y Metacritic Users, lo que sugiere que podría representar una dimensión relacionada con la aceptación o el aprecio general por parte de la audiencia. CP4 y CP5: Estas componentes tienen valores mixtos, lo que sugiere que podrían capturar aspectos más sutiles o específicos de la calidad de las series, tal vez relacionados con géneros o estilos específicos.
# Correlaciones entre variables y componentes
acp$var$cor## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## RT Users -0.304 0.0676 0.7600 -0.4068 -0.2864
## Metacritic Critics -0.212 -0.5569 0.5726 0.4150 -0.1943
## Metacritic Users -0.292 0.5341 0.5841 0.0170 0.5048
## TMDB Rating 0.794 -0.1935 0.1002 -0.4692 0.0775
## TASTE Rating 0.610 -0.6145 0.0470 0.0343 0.3668
## Reelgood Rating 0.677 0.5906 0.0863 0.2308 -0.0608
## JustWatch Rating 0.892 -0.0323 0.1474 -0.2933 -0.0739
## FA Rating 0.724 -0.0764 0.3590 0.3855 0.0411
## IMDb Votes 0.794 0.3419 -0.0437 0.1854 -0.2380# cos2 entre variables y componentes
acp$var$cos2## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## RT Users 0.0927 0.00457 0.57754 0.16547 0.08200
## Metacritic Critics 0.0450 0.31011 0.32784 0.17226 0.03776
## Metacritic Users 0.0853 0.28527 0.34118 0.00029 0.25478
## TMDB Rating 0.6303 0.03745 0.01004 0.22019 0.00601
## TASTE Rating 0.3724 0.37765 0.00221 0.00117 0.13454
## Reelgood Rating 0.4579 0.34886 0.00744 0.05327 0.00369
## JustWatch Rating 0.7957 0.00105 0.02174 0.08604 0.00547
## FA Rating 0.5238 0.00583 0.12890 0.14862 0.00169
## IMDb Votes 0.6307 0.11692 0.00191 0.03438 0.05666CONCLUSIONES
Relación de las Variables con las Dimensiones:
Dim.1: Las variables JustWatch Rating, TMDB Rating, y IMDb Votes tienen los valores más altos en esta dimensión, indicando que están fuertemente correlacionadas. Esto sugiere que estas métricas pueden estar reflejando una percepción general positiva y amplia sobre las series.
Dim.2: Metacritic Critics y Metacritic Users muestran valores significativos. Esto sugiere que esta dimensión podría estar relacionada con la evaluación crítica, diferenciando entre la opinión de los críticos y la del público.
Dim.3: La variable RT Users destaca con un valor notable. Esto podría indicar que esta dimensión captura la respuesta de la audiencia en plataformas específicas, sugiriendo una percepción de la calidad que se puede asociar con la aceptación de la serie.
Dim.4 y Dim.5: Estas dimensiones tienen menores contribuciones de las variables, lo que sugiere que pueden estar capturando aspectos más sutiles o menos relevantes en comparación con las dimensiones anteriores.
# Representación de las variables
# Componentes 1 y 2
fviz_pca_var(acp, axes = c(1,2), col.var = "cos2",
title = "Variables",repel = TRUE) +
scale_color_gradient2(low="red", mid="blue", high="black", midpoint=.3)
CONCLUSIONES:
Las variables IMDb Votes, JustWatch Rating, y Reelgood Rating muestran una correlación cercana al 80%. Esto indica que están muy relacionadas entre sí, lo que sugiere que estas métricas reflejan aspectos similares de la percepción del público sobre las series.
# Componentes 1 y 3
fviz_pca_var(acp, axes = c(1,3), col.var = "cos2",
title = "Variables",repel = TRUE) +
scale_color_gradient2(low="red", mid="blue", high="black", midpoint=.3)
CONCLUSIONES
FA Rating (FilmAffinity Rating), JustWatch Rating, y TMDB Rating presentan una correlación alta. Esto sugiere que las calificaciones de estas plataformas son consistentes entre sí, reflejando una percepción similar sobre la calidad de las series o películas evaluadas.
# Componentes 2 y 3
fviz_pca_var(acp, axes = c(2,3), col.var = "cos2",
title = "Variables",repel = TRUE) +
scale_color_gradient2(low="red", mid="blue", high="black", midpoint=.3)
CONCLUSIONES
Las variables Metacritic Users, Reelgood Rating y RT Users muestran una correlación, aunque esta es menor en comparación con la alta correlación observada entre FA Rating, JustWatch Rating y TMDB Rating. Esto sugiere que, aunque hay alguna relación, las calificaciones en estas plataformas no son tan coherentes entre sí.
# Contribuciones de las variables
acp$var$contrib## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## RT Users 2.55 0.3071 40.706 18.7671 14.074
## Metacritic Critics 1.24 20.8449 23.107 19.5371 6.482
## Metacritic Users 2.35 19.1751 24.047 0.0329 43.731
## TMDB Rating 17.35 2.5173 0.708 24.9732 1.031
## TASTE Rating 10.25 25.3846 0.156 0.1331 23.094
## Reelgood Rating 12.60 23.4492 0.525 6.0420 0.634
## JustWatch Rating 21.90 0.0703 1.532 9.7590 0.938
## FA Rating 14.41 0.3922 9.085 16.8557 0.290
## IMDb Votes 17.36 7.8593 0.135 3.8998 9.725CONCLUSIONES
La Dim.1 muestra que TMDB Rating tiene el valor más alto (17.35), lo que indica que esta variable tiene una influencia significativa en la primera dimensión del análisis. Esto sugiere que la calificación de TMDB está alineada con características que representan bien la variabilidad en los datos.
JustWatch Rating (21.90 en Dim.1) y FA Rating (14.41) también destacan en la primera dimensión, lo que sugiere que estas métricas son importantes para evaluar el rendimiento general de las series de TV. Esto implica que los usuarios que buscan recomendaciones pueden beneficiarse de estas calificaciones.
Aunque Metacritic Critics y Metacritic Users tienen contribuciones significativas en Dim.2 (20.84 y 19.18 respectivamente), sus valores son menores en Dim.1. Esto indica que si bien son importantes, su relación con la primera dimensión no es tan fuerte como la de TMDB y JustWatch.
Las dimensiones adicionales (Dim.3, Dim.4, Dim.5) muestran valores más bajos en general, lo que sugiere que las calificaciones en estas dimensiones pueden estar menos correlacionadas entre sí. Esto podría implicar que diferentes plataformas evalúan aspectos distintos de las series.
La distribución de las calificaciones en las dimensiones indica que hay varios factores que influyen en la percepción de la calidad de las series. Los consumidores deben considerar múltiples calificaciones para obtener una visión más completa.
# Gráfico de contribuciones de las variables
c1 = fviz_contrib(acp, choice = "var", axes = 1, title = "CP1") +
ylab("Contribuciones (%)")
c2 = fviz_contrib(acp, choice = "var", axes = 2, title = "CP2") +
ylab("Contribuciones (%)")
c3 = fviz_contrib(acp, choice = "var", axes = 3, title = "CP3") +
ylab("Contribuciones (%)")
grid.arrange(c1, c2, c3, ncol=2, nrow = 2)
CONCLUSIONES
El componente principal CP2 es el que abarca mas variables (Metacritic Critics, Metacritic Users, Reelgood Rating, TASTE Rating), las cuales superan el 50%.
# Coordenadas de los individuos (componentes principales)
head(acp$ind$coord, 10) # primeras filas de sqrt(n)*F## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## 1 5.278 0.9845 2.871 0.341 -0.2778
## 2 4.594 0.4385 -1.162 2.461 -1.6652
## 3 2.500 -0.3447 1.738 -0.572 0.5673
## 4 2.001 -0.8058 2.675 0.328 0.2555
## 5 2.246 -0.8271 1.548 0.268 -0.1297
## 6 2.190 -1.1317 2.314 0.745 0.2120
## 7 0.956 0.6100 1.664 -0.764 0.0302
## 8 2.108 0.9230 -0.828 -0.921 -0.4671
## 9 2.235 0.0957 -0.286 1.359 0.5942
## 10 1.547 0.5731 0.296 -0.678 0.0953CONCLUSIONES
Las Dim.1 presenta los valores más altos, lo que sugiere que esta dimensión captura la mayor parte de la variabilidad en los datos. Los primeros tres individuos (1, 2 y 3) tienen valores notablemente superiores, indicando que son representativos de características o tendencias significativas dentro del conjunto.
El segundo individuo (2) destaca en Dim.1 (4.594) y tiene una variabilidad positiva en Dim.4 (2.461), lo que sugiere que podría tener características únicas que lo diferencian del resto. Esto podría señalarlo como una serie de TV particularmente relevante o exitosa en ese contexto.
Algunos individuos (como el 5 y el 6) tienen valores negativos en Dim.5, lo que podría indicar que presentan características o elementos que son percibidos de manera menos favorable en comparación con otros. Este aspecto debe ser considerado al analizar la calidad o la recepción de las series.
Aunque hay una alta variabilidad en Dim.1, las otras dimensiones (Dim.2 a Dim.5) muestran menores contribuciones, lo que sugiere que la percepción general de calidad podría estar más fuertemente definida por la primera dimensión.
La identificación de individuos con altos valores en Dim.1 puede ser crucial para la toma de decisiones en cuanto a recomendaciones de series. Los consumidores deberían enfocarse en las características asociadas a estas dimensiones para entender mejor qué series podrían ser de su interés.
# Representación de los individuos
# Componentes 1 y 2
fviz_pca_ind(acp, axes = c(1,2), geom = c("point","text"),
habillage = 2, addEllipses = TRUE,
title = "Individuos") +
scale_color_brewer(palette = "Set1")
# Componentes 1 y 3
fviz_pca_ind(acp, axes = c(1,3), geom = c("point","text"),
habillage = 2, addEllipses = TRUE,
title = "Individuos") +
scale_color_brewer(palette = "Set1")
# Componentes 2 y 3
fviz_pca_ind(acp, axes = c(2,3), geom = c("point","text"),
habillage = 2, addEllipses = TRUE,
title = "Individuos") +
scale_color_brewer(palette = "Set1")
Representación simultánea de variables e individuos
# Componentes 1 y 2
fviz_pca_biplot(acp, axes = c(1,2), geom = c("point","text"),
col.var = "#3c3c3c",
habillage = 2, addEllipses = TRUE,
title = "Variables e individuos") +
scale_color_brewer(palette = "Set1")
1. (1.0 pts) Determine el número óptimo (k) de componentes principales empleando el método de regresión a trozos. Concluya mostrando los valores obtenidos.
library(factoextra)
library(gridExtra)
# ACP
acp = PCA(af_ranking_df, scale.unit = T, ncp = 5,
quali.sup = 1:2, graph = FALSE)
# Valores propios y porcentajes de inercia
colnames(acp$eig) = c("v. propio", "inercia", "iner. acum.")
acp$eig## v. propio inercia iner. acum.
## comp 1 3.634 40.37 40.4
## comp 2 1.488 16.53 56.9
## comp 3 1.419 15.76 72.7
## comp 4 0.882 9.80 82.5
## comp 5 0.583 6.47 88.9
## comp 6 0.379 4.21 93.1
## comp 7 0.274 3.04 96.2
## comp 8 0.229 2.55 98.7
## comp 9 0.114 1.26 100.0CONCLUSIONES
La componente 1 (CP1) explica el 40.37% de la varianza total, lo que indica que esta dimensión es fundamental para comprender las características de las series analizadas.
La componente 2 (CP2) agrega un 16.53%, y juntas las dos primeras componentes explican aproximadamente 56.9% de la variabilidad total. Esto sugiere que se puede obtener una buena comprensión del conjunto de datos utilizando solo estas dos dimensiones.
Las componentes (CP3 y CP4) contribuyen con 15.76% y 9.80%, respectivamente. Aunque son relevantes, su capacidad explicativa es considerablemente menor en comparación con las dos primeras. Esto indica que la complejidad del conjunto de datos no aumenta significativamente al considerar más componentes.
Con un 82.5% de varianza acumulada al incluir las cuatro primeras componentes, se puede obtener una buena representación de tus datos, capturando la mayoría de la variabilidad.
A partir de la componente 5 (CP5) en adelante, la varianza explicada comienza a disminuir drásticamente, con contribuciones inferiores al 7%.
# Regresión a trozos
k.opt = function(acp){
s = get_eigenvalue(acp)[,1]
sce.k = numeric(0)
for(j in 1:(length(s))){
s1 = s[1:j] ; s2 = s[(j+1):length(s)]
x1 = 1:j ; x2 = (j+1):length(s)
sce.k = c(sce.k, sum(resid(lm(s1~x1))^2) +
sum(resid(lm(s2~x2))^2))
}#Número óptimo de componentes
list(sce = sce.k, opt = which.min(sce.k))
}
k.opt(acp)## $sce
## [1] 0.185 0.173 0.753 0.978 1.233 1.530 1.898 2.338 2.724
##
## $opt
## [1] 2CONCLUSIONES Los valores de SCE proporcionan una medida de la varianza no explicada por el modelo a medida que se aumenta el número de componentes. En este caso, los valores son:
0.185 para 1 componente 0.173 para 2 componentes
Se observa un aumento en los valores de SCE a partir del tercer componente, con el último valor alcanzando 2.724 para 9 componentes. Esto sugiere que la adición de más componentes después del segundo no contribuye significativamente a la reducción del error.
El valor óptimo determinado es 2. Esto implica que, según el análisis, el modelo puede explicar mejor la varianza de los datos utilizando solo dos componentes principales. Utilizar más de dos componentes podría resultar en una complejidad innecesaria sin una mejora considerable en la interpretación de los datos.
El hecho de que el SCE disminuya con el aumento de componentes hasta el segundo indica que esos componentes capturan las características más importantes de la variabilidad en los datos. Sin embargo, a partir de tres componentes, el SCE tiende a aumentar, lo que puede indicar que las variables adicionales pueden introducir ruido en el modelo.
Dado que el modelo óptimo se establece con dos componentes, se recomienda limitar el análisis a estos componentes para facilitar la interpretación y evitar el sobreajuste. Este enfoque no solo simplifica el modelo, sino que también permite una visualización más clara y efectiva de los datos.
Considerar la realización de un análisis adicional de los componentes principales seleccionados para identificar y analizar sus contribuciones a la varianza total, así como para explorar sus relaciones con las variables originales.
2. (1.5 pts) Realice los grá cos de representación de las variables con las k componentes seleccionadas en el Punto 1 para explicar las relaciones entre los diferentes criterios de cali cación. Copie y pegue los grá cos y en un párrafo explique las relaciones observadas.
# 1. Matriz estandarizada y ponderada
Z = af_ranking_df %>%
select(where(is.numeric)) %>%
mutate(across(everything(),
function(x) (x - mean(x)) / (sd(x) * sqrt(length(x) - 1)))) %>%
as.matrix()
# 2. DVS (Z = P%*%D%*%t(Q))
dvs = svd(Z)
Q = dvs$v # Vectores propios de t(Z)*Z
F = data.frame(Z %*% Q) # Componentes principales
colnames(F) = paste("CP", 1:ncol(F), sep = "")
head(F) # Primeras filas de F## CP1 CP2 CP3 CP4 CP5 CP6 CP7 CP8 CP9
## 1 -0.827 -0.243 -0.344 -0.0322 -0.1452 -0.1919 -0.0199 0.12642 -0.00353
## 2 -0.685 0.144 0.131 0.2589 -0.3446 -0.1208 -0.0725 0.08801 -0.09517
## 3 -0.448 -0.265 -0.160 -0.0692 0.0779 -0.0429 0.1026 0.00554 -0.09906
## 4 -0.362 -0.297 -0.223 0.0910 0.0732 0.0714 -0.0586 -0.04644 0.05568
## 5 -0.407 -0.310 -0.106 0.0490 -0.0155 0.0163 0.1200 -0.14051 -0.00217
## 6 -0.397 -0.332 -0.162 0.1470 0.0586 0.0755 0.1070 -0.06603 0.06147
## CP10 CP11
## 1 -0.053989 -0.03847
## 2 0.002820 -0.00865
## 3 0.000734 -0.01984
## 4 -0.020390 0.06906
## 5 0.036815 -0.03074
## 6 0.020171 0.02810# 3. Correlaciones entre componentes y variables
Rcv = cor(Z, F) # Correlaciones
# 4. Gráfico de representación de las variables con las componentes principales
ggplot(Rcv, aes(x = CP1, y = CP2, label = rownames(Rcv))) +
geom_text(vjust = 1) +
geom_vline(xintercept = 0, lty = 2) +
geom_hline(yintercept = 0, lty = 2) +
geom_segment(aes(x = 0, y = 0, xend = CP1, yend = CP2),
arrow = arrow(length = unit(0.1, "inches"))) +
annotate("path",
x = cos(seq(0, 2 * pi, length.out = 100)),
y = sin(seq(0, 2 * pi, length.out = 100))) +
xlim(c(-1, 1)) + ylim(c(-1, 1)) +
coord_fixed() +
labs(title = "Correlaciones entre Variables y Componentes Principales",
x = "CP1", y = "CP2")
CONCLUSIONES:
Se ha identificado correlaciones significativas entre las variables IMDb Users, JustWatch Rating, TASTE Rating y TMDB Rating. Estas relaciones sugieren que los patrones de evaluación y preferencia del público en diferentes plataformas están interconectados, lo que podría indicar que los usuarios tienden a valorar las series de manera similar en estas diferentes métricas. Este hallazgo destaca la importancia de considerar múltiples fuentes de calificación al analizar la recepción y popularidad de las series de televisión.
3. (1.5 pts) Extraer las primeras k componentes principales seleccionadas en el Punto 1 y llévarlas a una escala 0-10. Realice un grá co de dispersión entre la cali cación promedio (Overall ) y cada una de las k componentes, además, calcule la correlación entre la cali cación promedio (Overall ) y cada una de las k componentes ¾se observa algún tipo de relación? Copie y pegue los grá cos y en un párrafo concluya escribiendo los valores obtenidos.
Paso 1: Extraer las Primeras k Componentes Principales Supongamos que ya has realizado un análisis de componentes principales (ACP) y que tienes un objeto llamado acp que contiene los resultados.
# Extraer las componentes principales
k <- 2 # Cambia esto al número de componentes que seleccionaste
components <- acp$ind$coord[, 1:k]
# Convertir a data frame
components_df <- as.data.frame(components)
components_df## Dim.1 Dim.2
## 1 5.2779 0.98450
## 2 4.5937 0.43851
## 3 2.5003 -0.34471
## 4 2.0014 -0.80575
## 5 2.2464 -0.82708
## 6 2.1903 -1.13165
## 7 0.9563 0.60996
## 8 2.1082 0.92297
## 9 2.2352 0.09571
## 10 1.5473 0.57315
## 11 -0.0878 -0.74395
## 12 -0.4508 -1.66725
## 13 0.8674 -0.25939
## 14 0.3828 1.56006
## 15 1.7247 2.59778
## 16 0.2047 1.10682
## 17 1.9947 1.52419
## 18 1.1426 -1.59411
## 19 -1.3156 0.44104
## 20 -1.2126 -0.80273
## 21 -1.2504 0.31872
## 22 -0.6980 1.15222
## 23 -1.3056 -0.26348
## 24 -1.2915 1.30207
## 25 1.1923 0.41287
## 26 -1.2432 -1.53120
## 27 0.2321 -1.39370
## 28 -0.5007 1.34400
## 29 1.2332 -0.96346
## 30 -1.1983 1.14008
## 31 -2.1872 -0.16659
## 32 2.5573 -4.35630
## 33 -1.0700 -2.24032
## 34 1.7499 0.33235
## 35 -1.4877 1.68794
## 36 -1.6857 -0.15983
## 37 -2.0823 -0.09653
## 38 -1.2280 -0.80360
## 39 -1.3693 1.05556
## 40 -2.3072 -1.77135
## 41 -1.7738 0.64675
## 42 -1.6663 -1.57485
## 43 -0.6381 1.30464
## 44 -0.2446 -0.19940
## 45 -2.0714 0.32383
## 46 -2.8943 0.00766
## 47 1.6952 0.74762
## 48 -1.3282 0.20859
## 49 -2.9551 0.20326
## 50 -3.0903 0.65440Paso 2: Escalar a un Rango de 0-10.
scale_to_10 <- function(x) {
return((x - min(x)) / (max(x) - min(x)) * 10)
}
scaled_components <- as.data.frame(lapply(components_df, scale_to_10)); scaled_components## Dim.1 Dim.2
## 1 10.000 7.68
## 2 9.182 6.89
## 3 6.681 5.77
## 4 6.085 5.11
## 5 6.377 5.08
## 6 6.310 4.64
## 7 4.836 7.14
## 8 6.212 7.59
## 9 6.364 6.40
## 10 5.542 7.09
## 11 3.588 5.19
## 12 3.154 3.87
## 13 4.729 5.89
## 14 4.150 8.51
## 15 5.754 10.00
## 16 3.937 7.86
## 17 6.077 8.46
## 18 5.058 3.97
## 19 2.121 6.90
## 20 2.244 5.11
## 21 2.199 6.72
## 22 2.859 7.92
## 23 2.133 5.89
## 24 2.150 8.14
## 25 5.118 6.86
## 26 2.207 4.06
## 27 3.970 4.26
## 28 3.095 8.20
## 29 5.167 4.88
## 30 2.261 7.90
## 31 1.079 6.02
## 32 6.749 0.00
## 33 2.414 3.04
## 34 5.784 6.74
## 35 1.915 8.69
## 36 1.678 6.03
## 37 1.205 6.13
## 38 2.225 5.11
## 39 2.057 7.78
## 40 0.936 3.72
## 41 1.573 7.19
## 42 1.702 4.00
## 43 2.930 8.14
## 44 3.401 5.98
## 45 1.218 6.73
## 46 0.234 6.28
## 47 5.719 7.34
## 48 2.106 6.56
## 49 0.162 6.56
## 50 0.000 7.21Paso 3: Extraer las k Primeras y k Últimas Componentes del objeto acp que contiene los resultados de tu análisis de componentes principales:
# Número de componentes a usar
k <- 2 # Cambia esto al número de componentes que seleccionaste
# Extraer las k primeras y k últimas componentes
first_components <- acp$ind$coord[, 1:k]
last_components <- acp$ind$coord[, (ncol(acp$ind$coord) - (k - 1)):ncol(acp$ind$coord)]
# Convertir a data frame
first_components_df <- as.data.frame(first_components); first_components_df ## Dim.1 Dim.2
## 1 5.2779 0.98450
## 2 4.5937 0.43851
## 3 2.5003 -0.34471
## 4 2.0014 -0.80575
## 5 2.2464 -0.82708
## 6 2.1903 -1.13165
## 7 0.9563 0.60996
## 8 2.1082 0.92297
## 9 2.2352 0.09571
## 10 1.5473 0.57315
## 11 -0.0878 -0.74395
## 12 -0.4508 -1.66725
## 13 0.8674 -0.25939
## 14 0.3828 1.56006
## 15 1.7247 2.59778
## 16 0.2047 1.10682
## 17 1.9947 1.52419
## 18 1.1426 -1.59411
## 19 -1.3156 0.44104
## 20 -1.2126 -0.80273
## 21 -1.2504 0.31872
## 22 -0.6980 1.15222
## 23 -1.3056 -0.26348
## 24 -1.2915 1.30207
## 25 1.1923 0.41287
## 26 -1.2432 -1.53120
## 27 0.2321 -1.39370
## 28 -0.5007 1.34400
## 29 1.2332 -0.96346
## 30 -1.1983 1.14008
## 31 -2.1872 -0.16659
## 32 2.5573 -4.35630
## 33 -1.0700 -2.24032
## 34 1.7499 0.33235
## 35 -1.4877 1.68794
## 36 -1.6857 -0.15983
## 37 -2.0823 -0.09653
## 38 -1.2280 -0.80360
## 39 -1.3693 1.05556
## 40 -2.3072 -1.77135
## 41 -1.7738 0.64675
## 42 -1.6663 -1.57485
## 43 -0.6381 1.30464
## 44 -0.2446 -0.19940
## 45 -2.0714 0.32383
## 46 -2.8943 0.00766
## 47 1.6952 0.74762
## 48 -1.3282 0.20859
## 49 -2.9551 0.20326
## 50 -3.0903 0.65440last_components_df <- as.data.frame(last_components); last_components_df## Dim.4 Dim.5
## 1 0.34097 -0.2778
## 2 2.46108 -1.6652
## 3 -0.57174 0.5673
## 4 0.32834 0.2555
## 5 0.26848 -0.1297
## 6 0.74518 0.2120
## 7 -0.76397 0.0302
## 8 -0.92108 -0.4671
## 9 1.35850 0.5942
## 10 -0.67774 0.0953
## 11 -0.50698 0.6139
## 12 0.40752 -0.3211
## 13 1.18598 0.5098
## 14 -1.77453 -0.2392
## 15 -1.00661 -1.3312
## 16 -1.34839 0.4396
## 17 -1.27773 0.9996
## 18 -1.10267 0.3913
## 19 0.44391 -0.3375
## 20 0.45919 -1.0223
## 21 0.48293 -0.7966
## 22 0.23160 -0.1968
## 23 0.01711 0.2764
## 24 -0.25130 0.0441
## 25 0.85969 0.7283
## 26 -2.06286 0.3602
## 27 0.45565 1.5167
## 28 -1.15650 1.5227
## 29 0.10611 -0.0787
## 30 -0.84815 -0.8378
## 31 0.76606 0.0829
## 32 -1.82905 -2.3339
## 33 0.06478 0.2889
## 34 -0.32542 1.0681
## 35 1.33559 -1.0311
## 36 -0.47079 -0.3893
## 37 0.16340 0.0777
## 38 -0.46241 0.2692
## 39 -0.65180 0.0773
## 40 -0.17051 0.6731
## 41 0.58736 -0.7657
## 42 1.83313 0.5360
## 43 0.00563 -0.5306
## 44 -0.03778 0.3985
## 45 0.47761 -0.9505
## 46 0.62765 0.1167
## 47 1.67473 1.5752
## 48 0.10409 0.1100
## 49 0.68635 -0.4550
## 50 -0.26062 -0.2738Paso 4: Calcular el Distancia de Mahalanobis La distancia de Mahalanobis es útil para identificar observaciones atípicas. Puedes calcularla utilizando las componentes.
# Combinar las componentes
combined_components <- cbind(first_components_df, last_components_df)
# Calcular la distancia de Mahalanobis
cov_matrix <- cov(combined_components)
mean_vector <- colMeans(combined_components)
mahalanobis_distances <- mahalanobis(combined_components, mean_vector, cov_matrix)
# Añadir las distancias a un data frame
combined_df <- as.data.frame(combined_components)
combined_df$mahalanobis_distances <- mahalanobis_distancesPaso 5: Identificar los Valores Atípicos Se define un umbral para considerar una observación como atípica. Un valor común es usar el percentil 97.5 de la distribución de las distancias de Mahalanobis.
# Establecer un umbral para la identificación de atípicos
threshold <- quantile(mahalanobis_distances, 0.975)
# Identificar las series atípicas
atypical_series <- rownames(af_ranking)[mahalanobis_distances > threshold]; atypical_series## [1] "2" "32"COCLUSIONES
Se ha identificado las siguientes series de televisión como atípicas basadas en las distancias de Mahalanobis: “2” y “32”. Estas series presentan características que se desvían significativamente del comportamiento general del conjunto de datos, lo que sugiere que pueden tener cualidades únicas o ser percibidas de manera diferente por la audiencia. Este análisis de atipicidad puede ser útil para profundizar en las razones detrás de estas discrepancias y entender mejor cómo estas series se posicionan en el contexto general del mercado.
Gráfico de Dispersión y Correlación Para el gráfico de dispersión entre la calificación promedio (Overall) y las componentes principales, puedes hacer lo siguiente:
# Número de componentes a extraer
k <- 2 # Cambia esto según lo que hayas seleccionado
# Extraer las componentes
components <- acp$ind$coord[, 1:k]
# Convertir a data frame
components_df <- as.data.frame(components)
# Función para escalar
scale_to_10 <- function(x) {
if (max(x) == min(x)) {
stop("Todos los valores en x son iguales. No se puede escalar.")
}
return((x - min(x)) / (max(x) - min(x)) * 10)
}
# Escalar las componentes
scaled_components <- as.data.frame(lapply(components_df, scale_to_10))
# Limpiar el ranking de NAs
ranking_clean <- na.omit(af_ranking)
# Verificar que hay suficientes valores en Overall
if (length(ranking_clean$Overall) < 50) {
stop("No hay suficientes valores en Overall después de eliminar NA.")
}
# Obtener los primeros 50 valores de Overall
overall_values <- ranking_clean$Overall[1:50]
# Verificar que las longitudes coincidan
if (length(overall_values) == nrow(scaled_components)) {
df_plot <- data.frame(Overall = overall_values, Dim1 = scaled_components[[1]], Dim2 = scaled_components[[2]])
} else {
stop("Las longitudes de Overall y las componentes escaladas no coinciden.")
}# Gráficos de dispersión
library(ggplot2)
# Obtener los primeros 50 valores de Overall
overall_values <- ranking_clean$Overall[1:50]
df_plot <- data.frame(Overall = overall_values, Dim1 = scaled_components[[1]], Dim2 = scaled_components[[2]])
# Gráfico de dispersión para Dim1
p1 <- ggplot(df_plot, aes(x = Dim1, y = Overall)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE, color = "blue") +
labs(title = "Dispersion entre Overall y Dim1", x = "Dim1 (Escalada)", y = "Calificación Promedio (Overall)")
# Gráfico de dispersión para Dim2
p2 <- ggplot(df_plot, aes(x = Dim2, y = Overall)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE, color = "blue") +
labs(title = "Dispersion entre Overall y Dim2", x = "Dim2 (Escalada)", y = "Calificación Promedio (Overall)")
# Mostrar los gráficos
print(p1)
print(p2)
CONCLUSIONES
El análisis de los gráficos de dispersión revela que la relación entre la calificación promedio (Overall) y la Dimensión 1 (Dim1) es notablemente más fuerte en comparación con la Dimensión 2 (Dim2). Esto sugiere que la Dim1 está más estrechamente relacionada con las calificaciones generales de las series analizadas, indicando que las variaciones en Dim1 pueden ser un mejor predictor de la calidad percibida de las series. Por otro lado, la relación con Dim2 es más débil, lo que sugiere que este componente puede capturar información menos relevante para la evaluación general de las series. Esta diferenciación en la correlación puede ser útil para futuras interpretaciones y decisiones basadas en los datos.
# Obtener los primeros 50 valores de Overall
overall_values <- ranking_clean$Overall[1:50]
# Calcular correlaciones
cor_dim1 <- cor(overall_values, scaled_components[[1]], use = "complete.obs")
cor_dim2 <- cor(overall_values, scaled_components[[2]], use = "complete.obs")
cat("Correlacion entre Overall y Dim1:", cor_dim1, "\n")## Correlacion entre Overall y Dim1: 0.774cat("Correlacion entre Overall y Dim2:", cor_dim2, "\n")## Correlacion entre Overall y Dim2: 0.0627# Paso 5: Agregar Información de Género.
library(skewsamp)
acp <- PCA(af_ranking_df, scale.unit = TRUE, ncp = 5, quali.sup = 1:2, graph = FALSE)
# Valores propios y porcentajes de inercia
colnames(acp$eig) <- c("v. propio", "inercia", "iner. acum.")
print(acp$eig)## v. propio inercia iner. acum.
## comp 1 3.634 40.37 40.4
## comp 2 1.488 16.53 56.9
## comp 3 1.419 15.76 72.7
## comp 4 0.882 9.80 82.5
## comp 5 0.583 6.47 88.9
## comp 6 0.379 4.21 93.1
## comp 7 0.274 3.04 96.2
## comp 8 0.229 2.55 98.7
## comp 9 0.114 1.26 100.0# Estadística d2^2
d12 <- function(acp, p1, alpha = 0.05) {
F <- acp$ind$coord # Componentes principales
F1 <- scale(F) # Componentes estandarizadas
d1i2 <- apply(F1, 1, function(f1) sum(f1[1:p1]^2)) # Distancia
cuantil <- qemp(1 - alpha, d1i2) # Cuantil empírico
# Identificación de atípicos
d12 <- data.frame(Observación = 1:nrow(F), d12 = d1i2, Cuantil = cuantil, Atípico = d1i2 > cuantil)
return(d12)
}
# Considerando las dos primeras componentes
est.d12 <- d12(acp, p1 = 2, alpha = 0.05)
# Atípicos
atypical_series <- subset(est.d12, Atípico == TRUE)
print(atypical_series)## Observación d12 Cuantil Atípico
## 1 1 8.15 6.87 TRUE
## 32 32 14.26 6.87 TRUE4. (1.0 pts) Empleando las k primeras y las k últimas componentes (k del Punto 1), ¾qué series se identi can como series de tv atípicas? Escríbalas.
Paso 5: Agregar Información de Género.
library(skewsamp)
acp = PCA(af_ranking_df, scale.unit = T, ncp = 5,
quali.sup = 1:2, graph = FALSE)
# Valores propios y porcentajes de inercia
colnames(acp$eig) = c("v. propio", "inercia", "iner. acum.")
acp$eig## v. propio inercia iner. acum.
## comp 1 3.634 40.37 40.4
## comp 2 1.488 16.53 56.9
## comp 3 1.419 15.76 72.7
## comp 4 0.882 9.80 82.5
## comp 5 0.583 6.47 88.9
## comp 6 0.379 4.21 93.1
## comp 7 0.274 3.04 96.2
## comp 8 0.229 2.55 98.7
## comp 9 0.114 1.26 100.0# Estadística d2^2
d12 = function(acp, p1, alpha=0.05){
F = acp$ind$coord # Componentes principales
F1 = scale(F) # componentes estandarizadas
d1i2 = apply(F1, 1, function(f1) sum(f1[1:p1]^2)) # distancia
cuantil = qemp(1-alpha, d1i2) # cuantil empírico
# Identificación de atípicos
d12 = data.frame(Observación = 1:nrow(F),
d12 = d1i2,
Cuantil = cuantil,
Atípico = d1i2>cuantil)
d12
}
# Considerando las dos primeras componentes
est.d12 = d12(acp, p1=2, alpha=0.05)
# Atípicos
filter(est.d12, Atípico==TRUE)## Observación d12 Cuantil Atípico
## 1 1 8.15 6.87 TRUE
## 32 32 14.26 6.87 TRUECONCLUSIONES
Observación 1 (ID 1): Valor: 8.15 Cuantil: 6.87 Clasificación como Atípica: TRUE
Observación 2 (ID 32): Valor: 14.26 Cuantil: 6.87 Clasificación como Atípica: TRUE
Ambas observaciones superan el cuantil establecido, lo que indica que sus valores son diferentes del resto del conjunto de datos. Esto sugiere que estas series podrían tener características únicas o desvíos en sus calificaciones que merecen una investigación más detallada. La identificación de estas series atípicas puede ser crucial para entender patrones en los datos y para la toma de decisiones informadas en el análisis de contenido televisivo.