1 Antecedentes

En este estudio se analiza la cantidad de personas afectadas por Covid-19 y los fallecimientos a causa de esta enfermedad en varios países: Francia, Alemania, Irán, Italia, España, Reino Unido y Estados Unidos. En una etapa inicial, se investigan las interconexiones entre estos países utilizando el método de correlación de Pearson. Luego, se procede a clasificarlos según la velocidad de propagación del Covid-19, utilizando el análisis de componentes principales. Nosotros buscamos analizar y comparar los resultados obtenidos en el artículo “Análisis de componentes principales para estudiar las relaciones entre las tasas de propagación de COVID-19 en países de alto riesgo” con los datos procesados por nosotros.

2 Material

En esta parte se describe la colección de datos utilizada en la investigación, junto con la presentación inicial del análisis de componentes principales.

Vamos a obtener la data de la página de la Unión Europea. Empezamos con la lectura y su preprocesamiento. Luego, seguiremos con su análisis descriptivo, algunas gráficas de referencia y procederemos a aplicar el análisis de componentes principales (ACP). Para esto último empezaremos analizando sus matrices de correlaciones entre los países, seguiremos a calcular sus autovalores y autovectores y con ello veremos el número de componentes a retener.

2.1 Data

Los datos utilizados en este estudio abarcan información sobre la cantidad de individuos afectados por Covid-19 y los fallecimientos causados por esta enfermedad en Francia, Alemania, Irán, Italia, España, Reino Unido y Estados Unidos, recopilados desde el 22 de febrero de 2020 hasta el 18 de abril de 2020.

2.1.1 Lectura

data_covid <- read_excel("COVID-19-geographic-disbtribution-worldwide.xlsx")
tabla1 <- head(data_covid)

knitr::kable(tabla1, caption = "Datos") %>%
kable_styling(bootstrap_options = c("striped","hover", 
                                   "condensed"), 
                                    full_width = F) %>%
            scroll_box(width = "800px", height = "450px")

Datos
dateRep	day	month	year	cases	deaths	countriesAndTerritories	geoId	countryterritoryCode	popData2019	continentExp	Cumulative_number_for_14_days_of_COVID-19_cases_per_100000
2020-12-14	14	12	2020	746	6	Afghanistan	AF	AFG	38041757	Asia	9.014
2020-12-13	13	12	2020	298	9	Afghanistan	AF	AFG	38041757	Asia	7.053
2020-12-12	12	12	2020	113	11	Afghanistan	AF	AFG	38041757	Asia	6.869
2020-12-11	11	12	2020	63	10	Afghanistan	AF	AFG	38041757	Asia	7.134
2020-12-10	10	12	2020	202	16	Afghanistan	AF	AFG	38041757	Asia	6.969
2020-12-09	9	12	2020	135	13	Afghanistan	AF	AFG	38041757	Asia	6.963

2.1.2 Preprocesamiento

# Ordenar el dataframe por la columna dateRep
data_covid <- data_covid[order(data_covid$dateRep), ]

data_covid$dateRep <- as.Date(data_covid$dateRep)
tabla2 <- head(data_covid)

knitr::kable(tabla2, caption = "Datos") %>%
kable_styling(bootstrap_options = c("striped","hover", 
                                   "condensed"), 
                                    full_width = F) %>%
            scroll_box(width = "800px", height = "430px")

Datos
dateRep	day	month	year	countriesAndTerritories	geoId	countryterritoryCode	popData2019	continentExp	Cumulative_number_for_14_days_of_COVID-19_cases_per_100000
2019-12-31	31	12	2019	Afghanistan	AF	AFG	38041757	Asia	NA
2019-12-31	31	12	2019	Algeria	DZ	DZA	43053054	Africa	NA
2019-12-31	31	12	2019	Armenia	AM	ARM	2957728	Europe	NA
2019-12-31	31	12	2019	Australia	AU	AUS	25203200	Oceania	NA
2019-12-31	31	12	2019	Austria	AT	AUT	8858775	Europe	NA
2019-12-31	31	12	2019	Azerbaijan	AZ	AZE	10047719	Europe	NA

Primero, no es necesario todas las columnas que se tienen en la data; por lo tanto, vamos a seleccionar las que usaremos:

#selecionando solo las columnas que usaremos
data_covid <- data_covid[, c("dateRep", "countriesAndTerritories", "cases", "deaths")]

tabla4 <- head(data_covid)
knitr::kable(tabla4, caption = "Datos") %>%
kable_styling(bootstrap_options = c("striped","hover", 
                                   "condensed"), 
                                    full_width = F) %>%
            scroll_box(width = "800px", height = "340px")

Datos
dateRep	countriesAndTerritories	cases	deaths
2019-12-31	Afghanistan	0	0
2019-12-31	Algeria	0	0
2019-12-31	Armenia	0	0
2019-12-31	Australia	0	0
2019-12-31	Austria	0	0
2019-12-31	Azerbaijan	0	0

Tenemos un rango de fecha establecido por el autor del artículo que va desde el 22 de febrero hasta el 18 de abril del 2020, seleccionaremos solo los datos que cumplan con ello.

fecha_inicio <- as.Date("2020-02-22")
fecha_fin <- as.Date("2020-04-18")
datos_covid <- subset(data_covid, dateRep >= fecha_inicio & dateRep <= fecha_fin)
tabla5 <- head(datos_covid)
knitr::kable(tabla5, caption = "Datos") %>%
kable_styling(bootstrap_options = c("striped","hover", 
                                   "condensed"), 
                                    full_width = F) %>%
            scroll_box(width = "800px", height = "340px")

Datos
dateRep	countriesAndTerritories	cases
2020-02-22	Afghanistan	0
2020-02-22	Algeria	0
2020-02-22	Armenia	0
2020-02-22	Australia	4
2020-02-22	Austria	0
2020-02-22	Azerbaijan	0

Segundo, solo se va a seleccionar los países que se usaron para la investigación en el artículo, los cuales son:

Francia
Estados Unidos
Reino Unido
Irán
Alemania
Italia
España

paises <- c("France", "Germany", "Iran", "Italy", "Spain", "United_Kingdom", "United_States_of_America")

data1 <- subset(datos_covid, countriesAndTerritories %in% paises)
tabla6 <- head(data1)
knitr::kable(tabla6, caption = "Datos") %>%
kable_styling(bootstrap_options = c("striped","hover", 
                                   "condensed"), 
                                    full_width = F) %>%
            scroll_box(width = "800px", height = "340px")

Datos
dateRep	countriesAndTerritories	cases	deaths
2020-02-22	France	0	0
2020-02-22	Germany	0	0
2020-02-22	Iran	13	2
2020-02-22	Italy	14	0
2020-02-22	Spain	0	0
2020-02-22	United_Kingdom	0	0

Tercero, en el artículo realizan el análisis de componentes principales (ACP) a los números de pacientes y difuntos, así como a sus cantidades acumuladas. Por ello, vamos a crear 2 nuevas columnas: “cumulative_patients” y “cumulative_deaths”.

data1 <- as.data.frame(data1)

data1 <- data1 %>%  arrange(data1$countriesAndTerritories)


# Asegúrate de que el número total de filas sea un múltiplo de 57
n <- nrow(data1)
n_restantes <- n %% 57
data1 <- head(data1, n - n_restantes)

# Calcula las frecuencias acumuladas reiniciando cada 57 filas
data1$cumulative_patients <- unlist(tapply(data1$cases, rep(1:(nrow(data1) %/% 57), each = 57, length.out = nrow(data1)), cumsum))

data1$cumulative_deaths <- unlist(tapply(data1$deaths, rep(1:(nrow(data1) %/% 57), each = 57, length.out = nrow(data1)), cumsum))

# Mostrar el dataframe con la nueva columna
tabla7 <- head(data1)
knitr::kable(tabla7, caption = "Datos") %>%
kable_styling(bootstrap_options = c("striped","hover", 
                                   "condensed"), 
                                    full_width = F) %>%
            scroll_box(width = "800px", height = "340px")

Datos
dateRep	countriesAndTerritories	cases	deaths	cumulative_patients	cumulative_deaths
2020-02-22	France	0	0	0	0
2020-02-23	France	0	0	0	0
2020-02-24	France	0	0	0	0
2020-02-25	France	0	0	0	0
2020-02-26	France	2	0	2	0
2020-02-27	France	3	1	5	1

Finalmente, para evitar confusiones al momento de realizar la comparación de los resultados, usaremos los mismos nombres que usa el autor en el artículo y se trabajarán con las matrices de las variables:

patients <- acast(data1, dateRep ~ countriesAndTerritories, value.var = "cases")
deaths <- acast(data1, dateRep ~ countriesAndTerritories, value.var = "deaths")
cumulative_patients <- acast(data1, dateRep ~ countriesAndTerritories, value.var = "cumulative_patients")
cumulative_deaths <- acast(data1, dateRep ~ countriesAndTerritories, value.var = "cumulative_deaths")

Patients <- as.matrix(patients)
deaths <- as.matrix(deaths)
cumulative_patients <- as.matrix(cumulative_patients)
cumulative_deaths <- as.matrix(cumulative_deaths)

2.1.3 Análisis Descriptivo

Vamos a realizar un análisis descriptivo teniendo como observaciones a las fechas y a las variables como los países, ya que el artículo lo trabaja de esa manera y buscamos replicar este trabajo. Tendremos como datos a la cantidad de individuos afectados, la cantidad de fallecidos por día y los acumulados de ambos.

Nota: Estas van a estar en matrices.

2.1.3.1 patients

Teniendo como información a patients

tabla8 <- stat.desc(patients)
knitr::kable(tabla8, caption = "Datos") %>%
kable_styling(bootstrap_options = c("striped","hover", 
                                   "condensed"), 
                                    full_width = F) %>%
            scroll_box(width = "800px", height = "540px")

Datos
	France	Germany	Iran	Italy	Spain	United_Kingdom	United_States_of_America
nbr.val	57.0000	57.0000	57.0000	57.0000	57.0000	57.000	57.000
nbr.null	4.0000	4.0000	1.0000	0.0000	3.0000	3.000	3.000
nbr.na	0.0000	0.0000	0.0000	0.0000	0.0000	0.000	0.000
min	0.0000	0.0000	0.0000	14.0000	0.0000	0.000	0.000
max	7578.0000	6294.0000	5275.0000	6557.0000	9181.0000	5450.000	35527.000
range	7578.0000	6294.0000	5275.0000	6543.0000	9181.0000	5450.000	35527.000
sum	109240.0000	137424.0000	79489.0000	172431.0000	193963.0000	111725.000	702148.000
median	1559.0000	2342.0000	1234.0000	3497.0000	3694.0000	1055.000	5374.000
mean	1916.4912	2410.9474	1394.5439	3025.1053	3402.8596	1960.088	12318.386
SE.mean	248.4413	296.7839	139.9461	266.9801	387.0120	265.432	1770.768
CI.mean.0.95	497.6877	594.5295	280.3458	534.8254	775.2781	531.725	3547.275
var	3518214.8615	5020598.0508	1116340.2525	4062867.7387	8537361.2657	4015899.867	178730358.384
std.dev	1875.6905	2240.6691	1056.5700	2015.6557	2921.8763	2003.971	13369.007
coef.var	0.9787	0.9294	0.7576	0.6663	0.8587	1.022	1.085

Vemos que va a ser necesario una estandarización a los datos, esta se va a realizar al aplicar el ACP.

2.1.3.2 deaths

Teniendo como información a deaths

tabla9 <- stat.desc(deaths)
knitr::kable(tabla9, caption = "Datos") %>%
kable_styling(bootstrap_options = c("striped","hover", 
                                   "condensed"), 
                                    full_width = F) %>%
            scroll_box(width = "800px", height = "540px")

Datos
	France	Germany	Iran	Italy	Spain	United_Kingdom	United_States_of_America
nbr.val	57.000	57.000	57.0000	57.0000	57.0000	57.000	57.000
nbr.null	10.000	21.000	1.0000	2.0000	14.0000	16.000	9.000
nbr.na	0.000	0.000	0.0000	0.0000	0.0000	0.000	0.000
min	0.000	0.000	0.0000	0.0000	0.0000	0.000	0.000
max	2004.000	315.000	292.0000	971.0000	950.0000	1122.000	4928.000
range	2004.000	315.000	292.0000	971.0000	950.0000	1122.000	4928.000
sum	18680.000	4110.000	4956.0000	22747.0000	20043.0000	16942.000	37054.000
median	112.000	22.000	111.0000	473.0000	235.0000	36.000	80.000
mean	327.719	72.105	86.9474	399.0702	351.6316	297.228	650.070
SE.mean	59.751	12.673	8.1674	40.5473	45.9758	51.772	135.664
CI.mean.0.95	119.696	25.386	16.3612	81.2260	92.1005	103.711	271.767
var	203500.527	9153.846	3802.2293	93712.8164	120484.9511	152777.965	1049065.102
std.dev	451.110	95.676	61.6622	306.1255	347.1094	390.868	1024.239
coef.var	1.377	1.327	0.7092	0.7671	0.9871	1.315	1.576

Vemos que va a ser necesario una estandarización a los datos, esta se va a realizar al aplicar el ACP.

2.1.3.3 cumulative_patients

Teniendo como información a cumulative_patients

tabla10 <- stat.desc(cumulative_patients)
knitr::kable(tabla10, caption = "Datos") %>%
kable_styling(bootstrap_options = c("striped","hover", 
                                   "condensed"), 
                                    full_width = F) %>%
            scroll_box(width = "800px", height = "540px")

Datos
	France	Germany	Iran	Italy	Spain	United_Kingdom	United_States_of_America
nbr.val	57.000	57.000	57.0000	57.0000	57.00	57.000	57.000
nbr.null	4.000	4.000	0.0000	0.0000	3.00	1.000	0.000
nbr.na	0.000	0.000	0.0000	0.0000	0.00	0.000	0.000
min	0.000	0.000	13.0000	14.0000	0.00	0.000	19.000
max	109240.000	137424.000	79489.0000	172431.0000	193963.00	111725.000	702148.000
range	109240.000	137424.000	79476.0000	172417.0000	193963.00	111725.000	702129.000
sum	1853004.000	2414132.000	1635631.0000	3647773.0000	3703184.00	1523346.000	8964661.000
median	12600.000	18172.000	19639.0000	47018.0000	31748.00	6471.000	19608.000
mean	32508.842	42353.193	28695.2807	63996.0175	64968.14	26725.368	157274.754
SE.mean	5001.257	6435.683	3561.5250	8009.5275	9294.15	4651.221	29199.819
CI.mean.0.95	10018.722	12892.221	7134.5919	16045.0117	18618.42	9317.515	58494.265
var	1425716816.171	2360826637.051	723014242.5984	3656694292.7318	4923727321.37	1233129665.201	48599875767.224
std.dev	37758.665	48588.338	26888.9242	60470.6068	70169.28	35115.946	220453.795
coef.var	1.161	1.147	0.9371	0.9449	1.08	1.314	1.402

Vemos que va a ser necesario una estandarización a los datos, esta se va a realizar al aplicar el ACP.

2.1.3.4 cumulative_deaths

Teniendo como información a cumulative_deaths

tabla11 <- stat.desc(cumulative_deaths)
knitr::kable(tabla11, caption = "Datos") %>%
kable_styling(bootstrap_options = c("striped","hover", 
                                   "condensed"), 
                                    full_width = F) %>%
            scroll_box(width = "800px", height = "540px")

Datos
	France	Germany	Iran	Italy	Spain	United_Kingdom	United_States_of_America
nbr.val	57.000	57.000	57.0000	57.000	57.00	57.000	57.000
nbr.null	5.000	17.000	0.0000	1.000	12.00	14.000	8.000
nbr.na	0.000	0.000	0.0000	0.000	0.00	0.000	0.000
min	0.000	0.000	2.0000	0.000	0.00	0.000	0.000
max	18680.000	4110.000	4956.0000	22747.000	20043.00	16942.000	37054.000
range	18680.000	4110.000	4954.0000	22747.000	20043.00	16942.000	37054.000
sum	220441.000	43092.000	103312.0000	425619.000	306123.00	177269.000	323756.000
median	449.000	45.000	1431.0000	4032.000	1002.00	194.000	260.000
mean	3867.386	756.000	1812.4912	7467.000	5370.58	3109.983	5679.930
SE.mean	762.534	155.795	226.7832	1044.489	903.58	658.011	1278.306
CI.mean.0.95	1527.539	312.095	454.3012	2092.363	1810.09	1318.155	2560.754
var	33143109.920	1383513.143	2931544.1472	62184538.393	46538034.71	24679806.875	93141742.531
std.dev	5757.005	1176.228	1712.1753	7885.717	6821.88	4967.877	9650.997
coef.var	1.489	1.556	0.9447	1.056	1.27	1.597	1.699

Vemos que va a ser necesario una estandarización a los datos, esta se va a realizar al aplicar el ACP.

2.2 Gráficas

Tomando en cuenta la fecha registrada como nuestro eje ‘X’:

2.2.1 patients

data1 <- data1 %>%
  mutate(fecha = rep(1:57, length.out = n()))

# Convierte la columna 'fecha' a tipo numérico si no lo está
data1$fecha <- as.numeric(data1$fecha)

# Asignar colores específicos a los países
colores_paises <- c("France" = "RosyBrown1", "Germany" = "dodgerblue2", "Iran" = "darkorange",
                    "Italy" = "chartreuse3", "Spain" = "gold", "United_Kingdom" = "red",
                    "United_States_of_America" = "black")

# Crea el gráfico ggplot
(Casos<- ggplot(data1, aes(x = fecha, y = cases, color = countriesAndTerritories)) +
  geom_line() +
  labs(title = "Casos por cada número de día", x = "Número de días", y = "Casos") +
  scale_x_continuous(breaks = seq(0, 60, 5), limits = c(0, 60)) +
  scale_y_continuous(breaks = seq(0, 35000, 5000), limits = c(0, 35000)) +
  theme_minimal() +
  theme(legend.position = "right") +
  scale_color_manual(values = colores_paises) +
  guides(color = guide_legend(title = "paises" , ))+
  transition_reveal(fecha)+
  enter_fade() +
  exit_fade())

2.2.2 deaths

(Muertes<- ggplot(data1, aes(x = fecha, y = deaths, color = countriesAndTerritories)) +
  geom_line() +
  labs(title = "Defunciones por cada número de día", x = "Número de días", y = "Muertes") +
  scale_x_continuous(breaks = seq(0, 60, 5), limits = c(0, 60)) +
  scale_y_continuous(breaks = seq(0, 5000, 1000), limits = c(0, 5000)) +
  theme_minimal() +
  theme(legend.position = "right") +
  scale_color_manual(values = colores_paises) +
  guides(color = guide_legend(title = "paises" , ))+transition_reveal(fecha)+
  enter_fade() +
  exit_fade())

2.2.3 cumulative_patients

(AcuCasos<- ggplot(data1, aes(x = fecha, y =cumulative_patients, color = countriesAndTerritories)) +
  geom_line() +
  labs(title = "Casos Acumulados por cada número de día", x = "Número de días", y = "Casos Acumulado") +
  scale_x_continuous(breaks = seq(0, 60, 5), limits = c(0, 60)) +
  scale_y_continuous(breaks = seq(0, 600000, 100000), limits = c(0, 600000)) +
  theme_minimal() +
  theme(legend.position = "right") +
  scale_color_manual(values = colores_paises) +
  guides(color = guide_legend(title = "paises" , ))+ transition_reveal(fecha)+
  enter_fade() +
  exit_fade())

2.2.4 cumulative_deaths

(AcuMuertes<- ggplot(data1, aes(x = fecha, y =cumulative_deaths, color = countriesAndTerritories)) +
  geom_line() +
  labs(title = "Defunciones Acumuladas por por cada número de día", x = "Número de días", y = "Casos Acumulado") +
  scale_x_continuous(breaks = seq(0, 60, 5), limits = c(0, 60)) +
  scale_y_continuous(breaks = seq(0, 30000, 10000), limits = c(0, 30000)) +
  theme_minimal() +
  theme(legend.position = "right") +
  scale_color_manual(values = colores_paises) +
  guides(color = guide_legend(title = "paises" , ))+ transition_reveal(fecha)+
  enter_fade() +
  exit_fade())

3 Metodología ACP

Vamos a utilizar el análisis de componentes principales para obtener los grupos de países pertenecientes a cada componente.

Para ello vamos a empezar con la matriz de variancia-covarianza de cada una de las variables de la data.

3.1 Matriz variancia-covarianza

Se realiza la matriz variancia-covarianza para cada una de las variables de la data.

3.1.1 patients

cov1  <- cov(patients)
knitr::kable(cov1, caption = "Matriz de variancia-covarianza patients") %>%
kable_styling(bootstrap_options = c("striped","hover", 
                                   "condensed"), 
                                    full_width = F) %>%
            scroll_box(width = "800px", height = "330px")

Matriz de variancia-covarianza patients
	France	Germany	Iran	Italy	Spain	United_Kingdom	United_States_of_America
France	3518215	3498088	1410382	2595804	4539268	2994989	19964680
Germany	3498088	5020598	1763445	3768755	5920789	3606969	23566313
Iran	1410382	1763445	1116340	1452257	2271596	1453110	9528754
Italy	2595804	3768755	1452257	4062868	5188759	2441965	15434797
Spain	4539268	5920789	2271596	5188759	8537361	4075407	25895007
United_Kingdom	2994989	3606969	1453110	2441965	4075407	4015900	26455344
United_States_of_America	19964680	23566313	9528754	15434797	25895007	26455344	178730358

3.1.2 deaths

cov1  <- cov(deaths)
knitr::kable(cov1, caption = "Matriz de variancia-covarianza deaths") %>%
kable_styling(bootstrap_options = c("striped","hover", 
                                   "condensed"), 
                                    full_width = F) %>%
            scroll_box(width = "800px", height = "330px")

Matriz de variancia-covarianza deaths
	France	Germany	Iran	Italy	Spain	United_Kingdom	United_States_of_America
France	203501	36616	10025	80762	115734	152518	361524
Germany	36616	9154	2517	17037	25095	35823	89802
Iran	10025	2517	3802	14986	14115	10455	19867
Italy	80762	17037	14986	93713	95633	68969	141739
Spain	115734	25095	14115	95633	120485	103409	212468
United_Kingdom	152518	35823	10455	68969	103409	152778	349599
United_States_of_America	361524	89802	19867	141739	212468	349599	1049065

3.1.3 cumulative_patients

cov1  <- cov(cumulative_patients)
knitr::kable(cov1, caption = "Matriz de variancia-covarianza cumulative_patients") %>%
kable_styling(bootstrap_options = c("striped","hover", 
                                   "condensed"), 
                                    full_width = F) %>%
            scroll_box(width = "800px", height = "330px")

Matriz de variancia-covarianza cumulative_patients
	France	Germany	Iran	Italy	Spain	United_Kingdom	United_States_of_America
France	1425716816	1831603066	1005416290	2235985805	2629788348	1312423100	8180320172
Germany	1831603066	2360826637	1295741980	2895174472	3398909164	1675919719	10425916988
Iran	1005416290	1295741980	723014243	1615884735	1875173474	913394333	5661301450
Italy	2235985805	2895174472	1615884735	3656694293	4217467488	2008680925	12401357091
Spain	2629788348	3398909164	1875173474	4217467488	4923727321	2381376334	14761921608
United_Kingdom	1312423100	1675919719	913394333	2008680925	2381376334	1233129665	7733062244
United_States_of_America	8180320172	10425916988	5661301450	12401357091	14761921608	7733062244	48599875767

3.1.4 cumulative_deaths

cov1  <- cov(cumulative_deaths)
knitr::kable(cov1, caption = "Matriz de variancia-covarianza cumulative_deaths") %>%
kable_styling(bootstrap_options = c("striped","hover", 
                                   "condensed"), 
                                    full_width = F) %>%
            scroll_box(width = "800px", height = "330px")

Matriz de variancia-covarianza cumulative_deaths
	France	Germany	Iran	Italy	Spain	United_Kingdom	United_States_of_America
France	33143110	6751460	8998321	42522939	38348521	28492887	54650320
Germany	6751460	1383513	1806657	8555571	7753495	5837426	11275883
Iran	8998321	1806657	2931544	13436402	11297727	7542762	14143448
Italy	42522939	8555571	13436402	62184538	53031546	35736571	67125410
Spain	38348521	7753495	11297727	53031546	46538035	32508798	61454881
United_Kingdom	28492887	5837426	7542762	35736571	32508798	24679807	47658381
United_States_of_America	54650320	11275883	14143448	67125410	61454881	47658381	93141743

3.2 Análisis de Correlación

Ahora veamos a ver las matrices de sus coeficientes de correlación entre los países, teniendo en cuenta a:

3.2.1 patients

Matriz de correlación entre los países teniendo como información al número de pacientes.

corrP<-cor(patients)
network_plot(corrP)

Como se pueden observar, en los 4 casos se presentan correlaciones positivas muy altas.

Ahora, para realizar el Análisis de Componentes Principales (ACP), vamos a escalar los datos por cada tipo de información obtenida (el número de pacientes, defunciones y sus acumulados de ambos).

3.2.2 deaths

Matriz de correlación entre los países teniendo como información al número de defunciones.

corrD<-cor(deaths)
network_plot(corrD)

Como se pueden observar, en los 4 casos se presentan correlaciones positivas muy altas.

Ahora, para realizar el Análisis de Componentes Principales (ACP), vamos a escalar los datos por cada tipo de información obtenida (el número de pacientes, defunciones y sus acumulados de ambos).

3.2.3 cumulative_patients

Matriz de correlación entre los países teniendo como información al número de pacientes acumulados.

corrCP<-cor(cumulative_patients)
network_plot(corrCP)

Como se pueden observar, en los 4 casos se presentan correlaciones positivas muy altas.

Ahora, para realizar el Análisis de Componentes Principales (ACP), vamos a escalar los datos por cada tipo de información obtenida (el número de pacientes, defunciones y sus acumulados de ambos).

3.2.4 cumulative_deaths

Matriz de correlación entre los países teniendo como información al número de defunciones acumuladas.

corrCD<-cor(cumulative_deaths)
network_plot(corrCD)

Como se pueden observar, en los 4 casos se presentan correlaciones positivas muy altas.

Ahora, para realizar el Análisis de Componentes Principales (ACP), vamos a escalar los datos por cada tipo de información obtenida (el número de pacientes, defunciones y sus acumulados de ambos).

3.3 ACP con cada variable

3.3.1 patients

# Vamos a escalar los datos

acpP <- dudi.pca(patients,
                scannf=FALSE, 
                scale=TRUE, #Matriz de correlación 
                nf=2)

El número de componentes a retener según el PCA para ‘patients’ son:

Gráfica de Valores propios ‘Patients’

acpP$eig

## [1] 5.55475 0.69417 0.33936 0.22645 0.10668 0.06805 0.01054

inertia.dudi(acpP)

## Inertia information:
## Call: inertia.dudi(x = acpP)
## 
## Decomposition of total inertia:
##     inertia     cum  cum(%)
## Ax1 5.55475   5.555   79.35
## Ax2 0.69417   6.249   89.27
## Ax3 0.33936   6.588   94.12
## Ax4 0.22645   6.815   97.35
## Ax5 0.10668   6.921   98.88
## Ax6 0.06805   6.989   99.85
## Ax7 0.01054   7.000  100.00

Entonces, con el número de pacientes, tenemos que nos quedamos con las 2 primeras componentes.

# Gráfica de Valores propios
screeplot(acpP, main ="Screeplot - Valores Propios")

#Gráfica del Codo
plot(acpP$eig,type="b",pch=20,col="blue",
     main = "Gráfico de sedimentación - Scree Plot")

#abline(h=1,lty=3,col="red")

Gráfica de las variables sobre el Círculo de correlaciones

acpP$co

##                            Comp1    Comp2
## France                   -0.9085  0.06822
## Germany                  -0.9493 -0.10966
## Iran                     -0.8368 -0.08059
## Italy                    -0.8430 -0.44416
## Spain                    -0.9169 -0.31140
## United_Kingdom           -0.8953  0.41366
## United_States_of_America -0.8803  0.45347

s.corcircle(acpP$co,grid=FALSE)

3.3.2 deaths

acpD <- dudi.pca(deaths,
                scannf=FALSE, 
                scale=TRUE, #Matriz de correlación 
                nf=2)

El número de componentes a retener según el PCA para ‘deaths’ son:

Gráfica de Valores propios ‘deaths’

acpD$eig

## [1] 5.10719 1.20874 0.32152 0.16867 0.11943 0.04158 0.03287

inertia.dudi(acpD)

## Inertia information:
## Call: inertia.dudi(x = acpD)
## 
## Decomposition of total inertia:
##     inertia     cum  cum(%)
## Ax1 5.10719   5.107   72.96
## Ax2 1.20874   6.316   90.23
## Ax3 0.32152   6.637   94.82
## Ax4 0.16867   6.806   97.23
## Ax5 0.11943   6.926   98.94
## Ax6 0.04158   6.967   99.53
## Ax7 0.03287   7.000  100.00

Entonces, con el número de defunciones, tenemos que nos quedamos con las 2 primeras componentes.

# Gráfica de Valores propios
screeplot(acpD, main ="Screeplot - Valores Propios")

#Gráfica del Codo
plot(acpD$eig,type="b",pch=20,col="blue",
     main = "Gráfico de sedimentación - Scree Plot")

#abline(h=1,lty=3,col="red")

Gráfica de las variables sobre el Círculo de correlaciones ‘deaths’

acpD$co

##                           Comp1   Comp2
## France                   0.8834  0.2559
## Germany                  0.9347  0.2885
## Iran                     0.6383 -0.6688
## Italy                    0.8036 -0.5359
## Spain                    0.9052 -0.2731
## United_Kingdom           0.9317  0.2735
## United_States_of_America 0.8440  0.4197

s.corcircle(acpD$co,grid=FALSE)

3.3.3 cumulative_patients

acpCP <- dudi.pca(cumulative_patients,
                scannf=FALSE, 
                scale=TRUE, #Matriz de correlación 
                nf=2)

El número de componentes a retener según el PCA para ‘cumulative_patients’ son:

Gráfica de Valores propios ‘cumulative_patients’

acpCP$eig

## [1] 6.8753302 0.1124906 0.0087594 0.0027125 0.0004430 0.0002179 0.0000464

inertia.dudi(acpCP)

## Inertia information:
## Call: inertia.dudi(x = acpCP)
## 
## Decomposition of total inertia:
##       inertia     cum  cum(%)
## Ax1 6.8753302   6.875   98.22
## Ax2 0.1124906   6.988   99.83
## Ax3 0.0087594   6.997   99.95
## Ax4 0.0027125   6.999   99.99
## Ax5 0.0004430   7.000  100.00
## Ax6 0.0002179   7.000  100.00
## Ax7 0.0000464   7.000  100.00

Entonces, con el número de defunciones, tenemos que nos quedamos con las 2 primeras componentes.

# Gráfica de Valores propios
screeplot(acpCP, main ="Screeplot - Valores Propios")

#Gráfica del Codo
plot(acpCP$eig,type="b",pch=20,col="blue",
     main = "Gráfico de sedimentación - Scree Plot")

#abline(h=1,lty=3,col="red")

Gráfica de las variables sobre el Círculo de correlaciones ‘cumulative_patients’

acpCP$co

##                            Comp1    Comp2
## France                   -0.9994  0.02138
## Germany                  -0.9987 -0.02074
## Iran                     -0.9935 -0.09114
## Italy                    -0.9844 -0.17074
## Spain                    -0.9944 -0.09470
## United_Kingdom           -0.9875  0.15678
## United_States_of_America -0.9794  0.20149

s.corcircle(acpCP$co,grid=FALSE)

3.3.4 cumulative_deaths

acpCD <- dudi.pca(cumulative_deaths,
                scannf=FALSE, 
                scale=TRUE, #Matriz de correlación 
                nf=2)

El número de componentes a retener según el PCA para ‘cumulative_deaths’ son:

Gráfica de Valores propios ‘cumulative_deaths’

acpCD$eig

## [1] 6.7022700 0.2759705 0.0163780 0.0042537 0.0007322 0.0002842 0.0001114

inertia.dudi(acpCD)

## Inertia information:
## Call: inertia.dudi(x = acpCD)
## 
## Decomposition of total inertia:
##       inertia     cum  cum(%)
## Ax1 6.7022700   6.702   95.75
## Ax2 0.2759705   6.978   99.69
## Ax3 0.0163780   6.995   99.92
## Ax4 0.0042537   6.999   99.98
## Ax5 0.0007322   7.000   99.99
## Ax6 0.0002842   7.000  100.00
## Ax7 0.0001114   7.000  100.00

Entonces, con el número de defunciones, tenemos que nos quedamos con las 2 primeras componentes.

# Gráfica de Valores propios
screeplot(acpCD, main ="Screeplot - Valores Propios")

#Gráfica del Codo
plot(acpCD$eig,type="b",pch=20,col="blue",
     main = "Gráfico de sedimentación - Scree Plot")

#abline(h=1,lty=3,col="red")

Gráfica de las variables sobre el Círculo de correlaciones ‘cumulative_deaths’

acpCD$co

##                            Comp1    Comp2
## France                   -0.9935  0.09933
## Germany                  -0.9895  0.14356
## Iran                     -0.9507 -0.30228
## Italy                    -0.9682 -0.24921
## Spain                    -0.9911 -0.10232
## United_Kingdom           -0.9855  0.16706
## United_States_of_America -0.9702  0.23160

s.corcircle(acpCD$co,grid=FALSE)

4 Resultados

4.1 patients

Gráfica ACP con el número de pacientes admitidos al día

(D_AacpP<-fviz_pca_var(acpP, col.var="steelblue")+
  ggtitle("Pacientes") +
  theme_minimal())

Primer grupo: Italia, Irán, Alemania, España y Francia.
Segundo grupo: Estados Unidos América y Reino Unido.

4.2 deaths

Gráfica ACP con el número de defunciones al día

(D_AacpD<-fviz_pca_var(acpD, col.var="steelblue")+
  ggtitle("Defunciones") +
  theme_minimal())

Primer grupo: Estados Unidos América, Reino Unido, Alemania y Francia.
Segundo grupo: España, Italia e Irán.

4.3 cumulative_patients

Gráfica ACP con el número de pacientes admitidos acumulados al día

(D_AacpCP<-fviz_pca_var(acpCP, col.var="steelblue")+
  ggtitle("Pacientes Acumulados") +
  theme_minimal())

Primer grupo: Reino Unido y Estados Unidos de América.
Segundo grupo: Francia, España, Alemania, Irán e Italia.

4.4 cumulative_deaths

Gráfica ACP con el número de defunciones al día acumulados

(D_AacpCD<-fviz_pca_var(acpCD, col.var="steelblue")+
  ggtitle("Defunciones Acumulados") +
  theme_minimal())

Primer grupo: Estados Unidos América, Reino Unido, Alemania y Francia.
Segundo grupo: España, Italia e Irán.

5 Comparaciones

Luego de realizar este trabajo de replicación, hemos obtenido algunas diferencias singulares en los resultados. Esto es más evidente en el análisis descriptivo, ya que se observa variaciones entre las medidas estadísticas de nuestro trabajo con los del artículo. La razón es porque la base de datos tomada es de origen distinto, además que en las primeras etapas del COVID la recolección de datos no fue fácil, tanto por el contexto como por el crecimiento exponencial de casos, la data se actualizaba de forma diaria y era complicado clasificar a los pacientes con COVID o no. Estas complicaciones fueron en parte por las pruebas de descartes, las cuales no eran muy efectivas; sin embargo, a pesar de estas diferencias, el presente trabajo muestra resultados próximos a los del artículo, obteniendo la misma cantidad de grupos y sus mismos participantes en cada uno de ellos.

Análisis de componentes principales para estudiar las relaciones entre las tasas de propagación de COVID-19 en países de alto riesgo en el 2020

Bermudez Huayhua, Yudenio - yudenio-1997@hotmail.com

Carrasco Castañeda, Edwar Frank - edwarfrank2001@gmail.com

Flores Taco, Alex Jesus - gesufiori@gmail.com

Geronimo Oscanoa, Geraldine Gianella - geralgeronimos@gmail.com

Micha Velasque, Margaret Pilar - margaretpmv@gmail.com

2024-01-07

1 Antecedentes

2 Material

2.1 Data

2.1.1 Lectura

2.1.2 Preprocesamiento

2.1.3 Análisis Descriptivo

2.1.3.1 patients

2.1.3.2 deaths

2.1.3.3 cumulative_patients

2.1.3.4 cumulative_deaths

2.2 Gráficas

2.2.1 patients

2.2.2 deaths

2.2.3 cumulative_patients

2.2.4 cumulative_deaths

3 Metodología ACP

3.1 Matriz variancia-covarianza

3.1.1 patients

3.1.2 deaths

3.1.3 cumulative_patients

3.1.4 cumulative_deaths

3.2 Análisis de Correlación

3.2.1 patients

3.2.2 deaths

3.2.3 cumulative_patients

3.2.4 cumulative_deaths

3.3 ACP con cada variable

3.3.1 patients

3.3.2 deaths

3.3.3 cumulative_patients

3.3.4 cumulative_deaths

4 Resultados

4.1 patients

4.2 deaths

4.3 cumulative_patients

4.4 cumulative_deaths

5 Comparaciones