Trabajo Grupal de Estadística para análisis político 2

Abrimos librerías

library(rio)
library(lubridate)

## 
## Attaching package: 'lubridate'

## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union

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

PRIMERA PARTE: LIMPIEZA DE DATOS

PRIMERO TRABAJAREMOS NUESTRA VARAIBLE DEPENDENDIENTE: contagios por población

Contagios

Traemos la data de contagios

data_covid= "https://github.com/CarlosGDiez/COVID-19/raw/master/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_confirmed_global.csv"

#Es necesario sacar días
WorldData<-import(file = data_covid)%>%
  mutate(type="datacon")%>% 
  tidyr::gather(Fecha,Valor,-c(type,"Province/State",
                        "Country/Region",Lat,Long))   #juntando fechas distintas en una sola.
WorldData= WorldData%>%
  filter(Valor>0)

Convertimos a formato fecha

#Convertimos a formato de fecha
WorldData$Fecha=mdy(WorldData$Fecha)
WorldData$Fecha=as.Date(WorldData$Fecha)

Ponemos un nombre

names(WorldData)[2]="Country"

Juntamos provincias en paises

WorldData=aggregate(Valor
                  ~ Country + Fecha, 
          data = WorldData,    
          sum) 

Nombramos bien Egipto

WorldData$Country=gsub('Egypt',"Egypt, Arab Rep.",WorldData$Country)

Un parénteisis necesario para tener el código de cada país Ahora, necesitamos agregar el código a cada país y quedarnos con eso

link1="https://github.com/CarlosGDiez/BasesLimpias/raw/master/Gee_sucio.csv" 
oto=import(link1)
oto = oto[,c(1,2)]
names(oto) = c("Country","CODE")
oto=oto[!duplicated(oto), ]

Calculamos el día 100

Dia100=WorldData%>%
group_by(Country)%>%
mutate(dia100= ifelse(Fecha==nth(Fecha,100),1,0))%>%
filter(dia100==1)
#Mergeamos con Oto para el código
Dia100=merge(oto,Dia100, by.x = 'Country', by.y='Country')
#Nos quedamos solo con el día y el código
Dia100=Dia100[,c(2:4)]
#Nombramos bien el valor
names(Dia100)[2] = "Fecha100"
names(Dia100)[3] = "Valor100"
#Variable mergeable que servirá más adelante
Dia100$DIA100=paste(Dia100$CODE,Dia100$Fecha)

Calculamos el día 7

Dia7=WorldData%>%
group_by(Country)%>%
mutate(dia7= ifelse(Fecha==nth(Fecha,7),1,0))%>%
filter(dia7==1)
#Mergeamos con Oto para el código
Dia7=merge(oto,Dia7, by.x = 'Country', by.y='Country')
#Nos quedamos solo con el día y el código
Dia7=Dia7[,c(2:4)]
#Nombramos bien el valor
names(Dia7)[2] = "Fecha7"
names(Dia7)[3] = "Valor7"
#Variable mergeable que servirá más adelante
Dia7$DIA7=paste(Dia7$CODE,Dia7$Fecha)

Ahora podemos tocar World data por separado

WorldData=merge(oto,WorldData, by.x = 'Country', by.y='Country')
WorldData$Country = NULL

Un parénteisis necesario para abrir más librerías

library(BBmisc)

## 
## Attaching package: 'BBmisc'

## The following objects are masked from 'package:dplyr':
## 
##     coalesce, collapse

## The following object is masked from 'package:base':
## 
##     isFALSE

library(car)

## Loading required package: carData

## 
## Attaching package: 'car'

## The following object is masked from 'package:dplyr':
## 
##     recode

library(cluster)
library(data.table)

## 
## Attaching package: 'data.table'

## The following objects are masked from 'package:dplyr':
## 
##     between, first, last

## The following objects are masked from 'package:lubridate':
## 
##     hour, isoweek, mday, minute, month, quarter, second, wday, week,
##     yday, year

library(dbscan)
library(descr)
library(DescTools)

## 
## Attaching package: 'DescTools'

## The following object is masked from 'package:data.table':
## 
##     %like%

## The following object is masked from 'package:car':
## 
##     Recode

## The following object is masked from 'package:BBmisc':
## 
##     %nin%

library(foreign)
library(fpc)

## 
## Attaching package: 'fpc'

## The following object is masked from 'package:dbscan':
## 
##     dbscan

library(ggcorrplot)

## Loading required package: ggplot2

library(GPArotation)
library(haven)
library(htmltab)
library(jsonlite)
library(matrixcalc)
library(nFactors)

## Loading required package: lattice

## 
## Attaching package: 'nFactors'

## The following object is masked from 'package:lattice':
## 
##     parallel

library(nortest)
library(parameters)
library(plotly)

## 
## Attaching package: 'plotly'

## The following object is masked from 'package:ggplot2':
## 
##     last_plot

## The following object is masked from 'package:rio':
## 
##     export

## The following object is masked from 'package:stats':
## 
##     filter

## The following object is masked from 'package:graphics':
## 
##     layout

library(PMCMRplus)
library(polycor)
library(psych)

## 
## Attaching package: 'psych'

## The following object is masked from 'package:polycor':
## 
##     polyserial

## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha

## The following objects are masked from 'package:DescTools':
## 
##     AUC, ICC, SD

## The following object is masked from 'package:car':
## 
##     logit

library(readr) 
library(readxl)
library(rio)
library(see)
library(stringi)
library(stringr)
library(tidyr)
library(tidyverse)

## Found more than one class "atomicVector" in cache; using the first, from namespace 'Matrix'

## Also defined by 'Rmpfr'

## Found more than one class "atomicVector" in cache; using the first, from namespace 'Matrix'

## Also defined by 'Rmpfr'

## Found more than one class "atomicVector" in cache; using the first, from namespace 'Matrix'

## Also defined by 'Rmpfr'

## Found more than one class "atomicVector" in cache; using the first, from namespace 'Matrix'

## Also defined by 'Rmpfr'

## Found more than one class "atomicVector" in cache; using the first, from namespace 'Matrix'

## Also defined by 'Rmpfr'

## Found more than one class "atomicVector" in cache; using the first, from namespace 'Matrix'

## Also defined by 'Rmpfr'

## Found more than one class "atomicVector" in cache; using the first, from namespace 'Matrix'

## Also defined by 'Rmpfr'

## Found more than one class "atomicVector" in cache; using the first, from namespace 'Matrix'

## Also defined by 'Rmpfr'

## Found more than one class "atomicVector" in cache; using the first, from namespace 'Matrix'

## Also defined by 'Rmpfr'

## Found more than one class "atomicVector" in cache; using the first, from namespace 'Matrix'

## Also defined by 'Rmpfr'

## Found more than one class "atomicVector" in cache; using the first, from namespace 'Matrix'

## Also defined by 'Rmpfr'

## Found more than one class "atomicVector" in cache; using the first, from namespace 'Matrix'

## Also defined by 'Rmpfr'

## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.0 ──

## ✓ tibble  3.0.4     ✓ forcats 0.5.0
## ✓ purrr   0.3.4

## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x psych::%+%()             masks ggplot2::%+%()
## x psych::alpha()           masks ggplot2::alpha()
## x lubridate::as.difftime() masks base::as.difftime()
## x data.table::between()    masks dplyr::between()
## x BBmisc::coalesce()       masks dplyr::coalesce()
## x BBmisc::collapse()       masks dplyr::collapse()
## x lubridate::date()        masks base::date()
## x plotly::filter()         masks dplyr::filter(), stats::filter()
## x data.table::first()      masks dplyr::first()
## x purrr::flatten()         masks jsonlite::flatten()
## x data.table::hour()       masks lubridate::hour()
## x lubridate::intersect()   masks base::intersect()
## x data.table::isoweek()    masks lubridate::isoweek()
## x dplyr::lag()             masks stats::lag()
## x data.table::last()       masks dplyr::last()
## x data.table::mday()       masks lubridate::mday()
## x data.table::minute()     masks lubridate::minute()
## x data.table::month()      masks lubridate::month()
## x data.table::quarter()    masks lubridate::quarter()
## x car::recode()            masks dplyr::recode()
## x data.table::second()     masks lubridate::second()
## x lubridate::setdiff()     masks base::setdiff()
## x purrr::some()            masks car::some()
## x purrr::transpose()       masks data.table::transpose()
## x lubridate::union()       masks base::union()
## x data.table::wday()       masks lubridate::wday()
## x data.table::week()       masks lubridate::week()
## x data.table::yday()       masks lubridate::yday()
## x data.table::year()       masks lubridate::year()

library(Rmisc)

## Loading required package: plyr

## ------------------------------------------------------------------------------

## You have loaded plyr after dplyr - this is likely to cause problems.
## If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
## library(plyr); library(dplyr)

## ------------------------------------------------------------------------------

## 
## Attaching package: 'plyr'

## The following object is masked from 'package:purrr':
## 
##     compact

## The following objects are masked from 'package:plotly':
## 
##     arrange, mutate, rename, summarise

## The following objects are masked from 'package:dplyr':
## 
##     arrange, count, desc, failwith, id, mutate, rename, summarise,
##     summarize

Población

Traemos la data de población en cada país

linkedin = "https://github.com/AriannaNKZC/Estad-2/raw/master/%C2%BFSera%20la%20data%3F.xls"
poblacion = import(linkedin)

Nos quedamos con las columnas que nos sirven

poblacion = poblacion[,c(1,2,64)]

Le ponemos nombre

names(poblacion)= c("Country", "CODE", "pobla")

Ahora combinamos las datas de contagios y las de población

WorldData=merge(poblacion,WorldData, by.x = 'CODE', by.y='CODE')

AHORA TRABAJAMOS LAS VARIABLES INDEPENDIENTES

Un parénteisis necesario para tener el código de cada país en español Ahora, necesitamos agregar el código a cada país y quedarnos con eso Traemos la base de datos

CODESPAÑOL<- "https://raw.githubusercontent.com/AriannaNKZC/TrabajoGrupal/bases-de-datos/API_SH.XPD.CHEX.GD.ZS_DS2_es_csv_v2_1347692.csv"
CDSP=import(CODESPAÑOL)

Nos quedamos con las columnas y filas que nos sirven

names(CDSP)=(CDSP[1,])
CDSP = CDSP[-1,]
CDSP = CDSP[,c(1,2)]

Le ponemos nombres

names(CDSP) = c("PAIS", "CODE")

Primera variable: PBI PER CAPITA por precio de dolar actual (2018)

Traemos la data

data_ppp <- "https://raw.githubusercontent.com/AriannaNKZC/TrabajoGrupal/bases-de-datos/API_NY.GDP.PCAP.CD_DS2_es_csv_v2_1347337.csv"
ppp_pib =import(data_ppp)

Nos quedamos con las filas y columnas que nos sirven

names(ppp_pib)=(ppp_pib[1,])
ppp_pib = ppp_pib[-1,]
ppp_pib = ppp_pib[,c(2,63)]

Le ponemos nombres

names(ppp_pib) = c("CODE", "PPP_2018")

Segunda variable: Government Effectiveness Estimate (Índice de la Efectidad de la Gobernanza)

Traemos la data (LA MISMA QUE SE USÓ PARA CREAR A OTO)

GEE=import(link1)

Le ponemos nombres

names(GEE) = c("Country","CODE","Series", "SC", "GEE")

Nos quedamos con las filas y columnas que nos sirven

#Filtrar para tomar valor GEE y no el error estandar
GEE=GEE%>%
  group_by(Country)%>%
  mutate(Index = ifelse(Series==nth(Series,1), 1, 0))%>%
  filter(Index==1)

#eliminamos filas vacías
GEE=GEE[-c(215,216,217,218,219),]

## Warning: The `i` argument of ``[.tbl_df`()` must lie in [-rows, 0] if negative, as of tibble 3.0.0.
## Use `NA_integer_` as row index to obtain a row full of `NA` values.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.

#Columnas necesarias
GEE = GEE[,c(2,5)]

Tercera variable: Índice de rigurosidad al séptimo día de contagio

Traemos las data

link2="https://github.com/CarlosGDiez/BasesLimpias/blob/master/Rigurosidad.csv?raw=true"
Rigurosidad=import(link2)

Nos quedamos con las filas y columnas que nos sirven

Rigurosidad=Rigurosidad[, c(1,2,5,35)]

Les ponemos nombres

names(Rigurosidad) = c("Country", "CODE","Date","Rigurosidad")

Hay que ordenarlos y juntarlos por fechas

Rigurosidad$Date <- ymd(Rigurosidad$Date)

Creamos variables mergeables

Rigurosidad$DIA7=paste(Rigurosidad$CODE,Rigurosidad$Date)

Nos quedamos solo con la información a la semana de contagios

Rigurosidad=merge(Rigurosidad,Dia7, by.x="DIA7", by.y = "DIA7")

Una vez más, nos quedamos con las filas y columnas que nos sirven

Rigurosidad=Rigurosidad[,c(3,5)]

Nombramos bien las columnas

names(Rigurosidad) = c("CODE","Rigurosidad")

Cuarta variable: Campañas informativas al séptimo día de contagio

Traemos las data

infocamp = "https://raw.githubusercontent.com/CarlaMendozaE/Prueba/master/public-campaigns-covid.csv"
dataic=import(infocamp)

Hay que ordenarlos y juntarlos por fechas

dataic$Date <- ymd(dataic$Date)

Creamos variables mergeables

dataic$DIA7=paste(dataic$Code,dataic$Date)

Nos quedamos solo con la información a la semana de contagios

dataic=merge(dataic,Dia7, by.x="DIA7", by.y = "DIA7")

Una vez más, nos quedamos con las filas y columnas que nos sirven

dataic=dataic[,c(5,6)]

Quinta varaible: Población Urbana

Traemos la data

xurb = "https://raw.githubusercontent.com/CarlaMendozaE/Prueba/master/API_SP.URB.TOTL.IN.ZS_DS2_es_csv_v2_1347951.csv"
dataxurb=import(xurb)

Reacomodamos el nombre de las columnas

names(dataxurb)=(dataxurb[1,])

Nos quedamos con las columnas y filas que nos sirven

dataxurb=dataxurb[,c(2,64)]
dataxurb=dataxurb[-1,]

Nombramos bien las columnas

names(dataxurb) = c("CODE","Poburbana")

Nombramos bien las filas

dataxurb$num=c(1:264)
rownames(dataxurb)=dataxurb[,3]
dataxurb[,3]= NULL

Redondeamos

dataxurb$Poburbana=round(dataxurb$Poburbana, digits = 2)

Sexta variable:Índice de Desarrollo Humano (Human Development Index), indicador que integra las variables PBI, Educación y Esperanza de vida

Traemos la data

LIDH="https://github.com/CarlaMendozaE/Prueba/blob/master/IDH.xlsx?raw=true"
IDH=import(LIDH)

Nos quedamos con las filas y columnas que nos sirven

IDH[,c(1,8,9)]=NULL

Ponemos nombres

names(IDH) = c("Country","HDI","EXPECTATIVAVIDA","EXPECTCOLE","YEARS_SCHOOLING","GNI_GROSSNATIONALINCOME")
IDH$Country=gsub('Egypt',"Egypt, Arab Rep.",IDH$Country)

Convertimos a numéricas

IDH[,c(2:6)]=lapply(IDH[,c(2:6)], as.numeric)

## Warning in lapply(IDH[, c(2:6)], as.numeric): NAs introduced by coercion

## Warning in lapply(IDH[, c(2:6)], as.numeric): NAs introduced by coercion

## Warning in lapply(IDH[, c(2:6)], as.numeric): NAs introduced by coercion

## Warning in lapply(IDH[, c(2:6)], as.numeric): NAs introduced by coercion

## Warning in lapply(IDH[, c(2:6)], as.numeric): NAs introduced by coercion

Redondeamos

IDH[2:6]=round(IDH[,2:6], digits = 2)

Agregamos CODE

IDH=merge(oto,IDH, by.x = 'Country', by.y='Country')

Séptima variable: Ayuda económica

Traemos la data

linkayuda="https://raw.githubusercontent.com/CarlosGDiez/BasesLimpias/master/Rigurosidad.csv"
dataayuda=import(linkayuda)

Nos quedamos con las filas y columnas que nos sirven

dataayuda = dataayuda[,c(2,5, 21)]
#USA
dataayuda <- dataayuda[-c(48601 :62640), ]
#UK
dataayuda <- dataayuda[-c(16741 :17820), ]

Les ponemos nombres

names(dataayuda) = c("CODE","Date","Ayuda Económica")

Hay que ordenarlos y juntarlos por fechas

dataayuda$Date <- ymd(dataayuda$Date)

Creamos variables mergeables

dataayuda$DIA7=paste(dataayuda$CODE,dataayuda$Date)

Nos quedamos solo con la información a la semana de contagios

dataayuda=merge(dataayuda,Dia7, by.x="DIA7", by.y = "DIA7")

Una vez más, nos quedamos con las filas y columnas que nos sirven

dataayuda = dataayuda[,c(2,4)]

Nombramos bien CODE

names(dataayuda)[1] = "CODE"

Octava variable: Densidad de la población

Traemos la data

linkdensidad="https://github.com/MariaJoseVega/Trabajo-grupal-2020.2/raw/master/Excel%20densidad.xlsx.xls"
datadensidad=import(linkdensidad)

## New names:
## * `` -> ...3
## * `` -> ...4
## * `` -> ...5
## * `` -> ...6
## * `` -> ...7
## * ...

Reacomodamos el nombre de las columnas

names(datadensidad)=(datadensidad[3,])

Nos quedamos con las filas y columnas que nos sirven

datadensidad = datadensidad[,c(2, 63)]
datadensidad <- datadensidad[-c(1:3),]

Ponemos nombres

names(datadensidad) = c("CODE","Densidadpob")

Convertimos a numéricas

datadensidad$Densidadpob=as.numeric(datadensidad$Densidadpob)

Redondeamos

datadensidad$Densidadpob=round(datadensidad$Densidadpob, digits = 2)

Novena variable: Tasa de desempleo

Traemos la data

datadesempleo <- "https://github.com/MariaJoseVega/Trabajo-grupal-2020.2/raw/master/datadesempleooriginal.csv"
datadesempleo=import(datadesempleo)

Le ponemos nombre

names(datadesempleo)= c("PAIS", "Tasadesempleo")
datadesempleo$PAIS=gsub("Egipto","Egipto, República Árabe de",datadesempleo$PAIS)
datadesempleo$PAIS=gsub("Benín","Benin",datadesempleo$PAIS)
datadesempleo$PAIS=gsub("Bahráin","Bahrein",datadesempleo$PAIS)
datadesempleo$PAIS=gsub("Bosnia y Hercegovina","Bosnia y Herzegovina",datadesempleo$PAIS)
datadesempleo$PAIS=gsub("Bután","Bhután",datadesempleo$PAIS)
datadesempleo$PAIS=gsub("Botsuana","Botswana",datadesempleo$PAIS)
datadesempleo$PAIS=gsub("Kazajistán","Kazajstán",datadesempleo$PAIS)
datadesempleo$PAIS=gsub("Kenia","Kenya",datadesempleo$PAIS)
datadesempleo$PAIS=gsub("Lesoto","Lesotho",datadesempleo$PAIS)
datadesempleo$PAIS=gsub("Malaui","Malawi",datadesempleo$PAIS)
datadesempleo$PAIS=gsub("Nueva Zelanda","Nueva Zelandia",datadesempleo$PAIS)
datadesempleo$PAIS=gsub("Ruanda","Rwanda",datadesempleo$PAIS)
datadesempleo$PAIS=gsub("Arabia Saudí","Arabia Saudita",datadesempleo$PAIS)
datadesempleo$PAIS=gsub("Surinam","Suriname",datadesempleo$PAIS)
datadesempleo$PAIS=gsub("Zimbabue","Zimbabwe",datadesempleo$PAIS)

Agregamos CODE

datadesempleo=merge(CDSP,datadesempleo, by.x = 'PAIS', by.y='PAIS')

Décima variable: Regulatory quality

Traemos la data

perro = "https://raw.githubusercontent.com/AriannaNKZC/Estad-2/master/258c45e7-1b68-4b8e-853d-a2554f1bb145_Data.csv"
regulatory = import(perro)

Nos quedamos con las filas y columnas que nos sirven

regulatory=regulatory[, c(2,5)]

Ponemos nombres

names(regulatory) = c("CODE","Regulatory_quality")

Convertimos a numéricas

regulatory$Regulatory_quality=as.numeric(regulatory$Regulatory_quality)

## Warning: NAs introduced by coercion

Redondeamos

regulatory$Regulatory_quality=round(regulatory$Regulatory_quality, digits = 2)

Undécima variable: Control de la corrupción

Traemos la data

gato= "https://raw.githubusercontent.com/AriannaNKZC/Estad-2/master/51253f2e-7374-408f-8685-c729a64d043a_Data.csv"
control_co = import(gato)

Nos quedamos con las filas y columnas que nos sirven

control_co=control_co[, c(2,5)]

Ponemos nombres

names(control_co) = c("CODE","Control_co")

Convertimos a numéricas

control_co$Control_co=as.numeric(control_co$Control_co)

## Warning: NAs introduced by coercion

Redondeamos

control_co$Control_co=round(control_co$Control_co, digits = 2)

Duodécima variable: Rule of law

Traemos la data

AXA = "https://raw.githubusercontent.com/AriannaNKZC/Estad-2/master/a9249c7d-95ab-4618-9160-3a247dea2bae_Data.csv"
ruleof = import(AXA)

Nos quedamos con las filas y columnas que nos sirven

ruleof=ruleof[, c(2,5)]

Ponemos nombres

names(ruleof) = c("CODE","Ruleoflaw")

Convertimos a numéricas

ruleof$Ruleoflaw=as.numeric(ruleof$Ruleoflaw)

## Warning: NAs introduced by coercion

Redondeamos

ruleof$Ruleoflaw=round(ruleof$Ruleoflaw, digits = 2)

Décimotercera variable: Voice and accountability

Traemos la data

VA = 'https://github.com/AriannaNKZC/Estad-2/raw/master/Voice_and_accountability.csv'
VocA = import(VA)

Nos quedamos con las filas y columnas que nos sirven

VocA=VocA[, c(2,5)]

Ponemos nombres

names(VocA) = c("CODE","Voice_acco")

Convertimos a numéricas

VocA$Voice_acco=as.numeric(VocA$Voice_acco)

## Warning: NAs introduced by coercion

Redondeamos

VocA$Voice_acco=round(VocA$Voice_acco, digits = 2)

Décimocuarta variable: Political stability

Traemos la data

PS='https://github.com/AriannaNKZC/Estad-2/raw/master/e0757e7a-8829-44d2-a7a3-11a580c19a53_Data.csv'
PolS = import(PS)

Nos quedamos con las filas y columnas que nos sirven

PolS=PolS[, c(2,5)]

Ponemos nombres

names(PolS) = c("CODE","Political_sta")

Convertimos a numéricas

PolS$Political_sta=as.numeric(PolS$Political_sta)

## Warning: NAs introduced by coercion

Redondeamos

PolS$Political_sta=round(PolS$Political_sta, digits = 2)

MERGEAMOS TODAS LAS VARIABLES EN UN SOLO DATAFRAME

Data=merge(PolS,VocA, by.x = 'CODE', by.y='CODE')
Data=merge(Data,ruleof, by.x = 'CODE', by.y='CODE')
Data=merge(Data,control_co, by.x = 'CODE', by.y='CODE')
Data=merge(Data,regulatory, by.x = 'CODE', by.y='CODE')
Data=merge(Data,datadesempleo, by.x = 'CODE', by.y='CODE')
Data=merge(Data,datadensidad, by.x = 'CODE', by.y='CODE')
Data=merge(Data,dataayuda, by.x = 'CODE', by.y='CODE')
Data=merge(Data,IDH, by.x = 'CODE', by.y='CODE')
Data=merge(Data,dataxurb, by.x = 'CODE', by.y='CODE')
Data=merge(Data,dataic, by.x = 'CODE', by.y='CODE')
Data=merge(Data,Rigurosidad, by.x = 'CODE', by.y='CODE')
Data=merge(Data,GEE, by.x = 'CODE', by.y='CODE')
Data=merge(Data,ppp_pib, by.x = 'CODE', by.y='CODE')
Data=merge(Data,Dia100, by.x = 'CODE', by.y='CODE')
Data=merge(Data,poblacion, by.x = 'CODE', by.y='CODE')

Limpiamos

#Eliminamos columnas
Data=Data[,c(-7,-24,-25)]
#Eliminamos filas repetidas
Data = Data[!duplicated(Data),]

Nombramos bien

names(Data)[10] = "Country"
names(Data)[17] = "infoalawk"

Arreglamos numérica

Data$GEE=as.numeric(Data$GEE)

## Warning: NAs introduced by coercion

Redondeamos

Data$GEE=round(Data$GEE, digits = 2)
Data$PPP_2018=round(Data$PPP_2018, digits = 2)

Arreglamos ordinales

#Ayuda Económica
Data$`Ayuda Económica`= as.ordered(Data$`Ayuda Económica`)
levels(Data$`Ayuda Económica`) = c("Sin apoyo", "Menos del 50% del sueldo")
table(Data$`Ayuda Económica`)

## 
##                Sin apoyo Menos del 50% del sueldo 
##                      121                        8

#Campañas infomrativas
Data$infoalawk = as.ordered(Data$infoalawk)
levels(Data$infoalawk) = c("Ninguna", "Campañas del gobierno", "Campañas integrales")
table(Data$infoalawk)

## 
##               Ninguna Campañas del gobierno   Campañas integrales 
##                    17                    19                    93

Eliminamos na’s

Data=na.omit(Data)

Limpieza final de la Data

names(Data)

##  [1] "CODE"                    "Political_sta"          
##  [3] "Voice_acco"              "Ruleoflaw"              
##  [5] "Control_co"              "Regulatory_quality"     
##  [7] "Tasadesempleo"           "Densidadpob"            
##  [9] "Ayuda Económica"         "Country"                
## [11] "HDI"                     "EXPECTATIVAVIDA"        
## [13] "EXPECTCOLE"              "YEARS_SCHOOLING"        
## [15] "GNI_GROSSNATIONALINCOME" "Poburbana"              
## [17] "infoalawk"               "Rigurosidad"            
## [19] "GEE"                     "PPP_2018"               
## [21] "Fecha100"                "Valor100"               
## [23] "pobla"

Data$Valor100 = (Data$Valor100/Data$pobla)*100
rownames(Data) = Data$Country 
Data$Country = NULL
Data$CODE = NULL
Data$Fecha100 = NULL

SEGUNDA PARTE: ANÁLISIS UNIVARIADO

EN ESTA PARTE DIVIDIMOS LAS VARIABLES EN CATEGORÍAS

Categoría 1: Medidas tempranas: evalúa que tan rápido y riguroso respondieron los Estados dentro de los primeros 7 días desde su primer infectado

Apoyo a través de ingresos

str(Data$`Ayuda Económica`)

##  Ord.factor w/ 2 levels "Sin apoyo"<"Menos del 50% del sueldo": 1 1 1 1 1 1 1 1 1 1 ...

Mode(Data$`Ayuda Económica`)

## [1] Sin apoyo
## attr(,"freq")
## [1] 119
## Levels: Sin apoyo < Menos del 50% del sueldo

Median(Data$`Ayuda Económica`, na.rm = TRUE) #sin apoyo

## [1] Sin apoyo
## Levels: Sin apoyo < Menos del 50% del sueldo

IQR(Data$`Ayuda Económica`) #1 

## [1] 0

pie(table(Data$`Ayuda Económica`), main="Gráfico 1: Apoyo a través de ingresos contexto Covid-19", col = c("mediumpurple1", "purple", "lightslateblue"))

Campañas informativas

str(Data$infoalawk)

##  Ord.factor w/ 3 levels "Ninguna"<"Campañas del gobierno"<..: 3 2 3 1 1 3 3 3 3 3 ...

Mode(Data$infoalawk) #Moda: campañas integrales

## [1] Campañas integrales
## attr(,"freq")
## [1] 90
## Levels: Ninguna < Campañas del gobierno < Campañas integrales

Median(Data$infoalawk) #Mediana: campañas integrales

## [1] Campañas integrales
## Levels: Ninguna < Campañas del gobierno < Campañas integrales

IQR(Data$infoalawk)

## [1] 1

library(ggplot2)
pie(table(Data$infoalawk), main="Gráfico 2: Campañas informativas del Covid-19", col = c("mediumpurple1", "purple", "lightslateblue"))

Índice de rigurosidad en medidas tempranas

str(Data$Rigurosidad)

##  num [1:126] 27.78 33.33 81.48 0 2.78 ...

summary(Data$Rigurosidad)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    0.00   11.11   22.22   31.11   50.70   93.52

sd(Data$Rigurosidad)

## [1] 25.83322

hist(Data$Rigurosidad, col = "royalblue1", main = "Gráfico 3: Índice de rigurosidad en medidas tempranas según países", xlab = "Índice de rigurosidad", ylab ="Número de países")

Categoría 2: Demografía: Evalúa la concentración de personas en cada país

Densidad poblacional

str(Data$`Densidadpob`)

##  num [1:126] 56.9 24.7 104.6 163.8 135.6 ...

summary(Data$`Densidadpob`)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    2.04   30.55   89.42  213.91  185.29 7953.00

Mode(Data$`Densidadpob`)

## [1] NA
## attr(,"freq")
## [1] 1

sd(Data$`Densidadpob`, na.rm = TRUE)

## [1] 734.7614

mis.colores = colorRampPalette( c( "lightslateblue","cyan1"))
hist(Data$`Densidadpob`, col = mis.colores(14), main = "Gráfico 4: Densidad de población por metro cuadrado", xlab = "Número de personas por metro cuadrado ", ylab = "Número de países")

Población urbana

str(Data$`Poburbana`)

##  num [1:126] 25.8 66.2 61.2 88 86.8 ...

summary(Data$`Poburbana`)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   16.52   47.27   63.70   62.23   80.53  100.00

sd(Data$`Poburbana`)

## [1] 21.95835

Mode(Data$`Poburbana`)

## [1]  55.98 100.00
## attr(,"freq")
## [1] 2

hist(Data$`Poburbana`, col = mis.colores(14), main = "Gráfico 5: Población urbana según países", xlab = "Porcentaje de población urbana", ylab = "Número de países")

Categoría 3: Estructural: Evalúa las condiciones socioeconómicas con las que cada país tuvo que enfrentar la pandemia

Índice de Desarrollo Humano (IDH)

str(Data$HDI)

##  num [1:126] 0.5 0.57 0.79 0.86 0.87 0.83 0.94 0.91 0.75 0.92 ...

summary(Data$HDI)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.3800  0.6200  0.7600  0.7303  0.8500  0.9500

sd(Data$HDI, na.rm = TRUE)

## [1] 0.1508957

Mode(Data$HDI)

## [1] 0.76
## attr(,"freq")
## [1] 7

boxplot(Data$HDI, col = "plum1", main = "Gráfico 6: Indice de Desarrollo Humano")

PBI precio dolar actual per cápita

summary(Data$PPP_2018)

##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##    381.3   2075.1   7093.7  16801.4  20013.4 116654.3

sd(Data$PPP_2018, na.rm = TRUE)

## [1] 22170.64

Mode(Data$PPP_2018, na.rm = TRUE)

## [1] NA
## attr(,"freq")
## [1] 1

mis.colores1 = colorRampPalette( c(  "plum", "mediumpurple1","mediumpurple2", "plum1", "plum2"))
boxplot(Data$PPP_2018, col = mis.colores1(14), main = "Gráfico 7: PBI per cápita según el precio del dolar", xlab = "PPP 2018", ylab = NULL )

Desempleo

summary(Data$Tasadesempleo)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    0.00    4.00    7.00   10.20   11.75   77.00

sd(Data$Tasadesempleo, na.rm = TRUE)

## [1] 10.41769

Mode(Data$Tasadesempleo, na.rm = TRUE)

## [1] 6
## attr(,"freq")
## [1] 14

boxplot(Data$Tasadesempleo, col = "plum1", main = "Gráfico 8: Porcentaje de desempleo en el 2018")

Categoría 4: Gobernanza: Evalúa la “capacidad de gobernar” de un Estado a través de la legitimidad, eficiencia y estabilidad, y la “forma de gobernar” a través de participación, transparencia y rendición de cuentas.

Estabilidad política

summary(Data$Political_sta)

##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -2.65000 -0.65750 -0.08500 -0.07762  0.64000  1.66000

sd(Data$Political_sta, na.rm = TRUE)

## [1] 0.9378438

Mode(Data$Political_sta, na.rm = TRUE)

##  [1] -0.92 -0.83 -0.78 -0.55 -0.54 -0.35 -0.24 -0.23 -0.10 -0.08  0.06  0.11
## [13]  0.12  0.31  0.46  0.52  0.53  0.64  0.70  0.82  1.01  1.05  1.09
## attr(,"freq")
## [1] 2

mis.colores1 = colorRampPalette( c(  "plum", "mediumpurple1","mediumpurple2", "plum1", "plum2"))
hist(Data$Political_sta, col = mis.colores1(14), main = "Gráfico 9: Estabilidad política por país según países", xlab = "Estabilidad Política", ylab = "Número de países" )

Imperio de la ley

summary(Data$Ruleoflaw)

##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -1.85000 -0.58000 -0.13000  0.07579  0.67250  2.02000

sd(Data$Ruleoflaw, na.rm = TRUE)

## [1] 0.964479

Mode(Data$Ruleoflaw, na.rm = TRUE)

## [1] -0.43
## attr(,"freq")
## [1] 4

mis.colores1 = colorRampPalette( c(  "plum", "mediumpurple1","mediumpurple2", "plum1", "plum2"))
hist(Data$Ruleoflaw, col = mis.colores1(14), main = "Gráfico 10: Imperio de la ley según países", xlab = "Imperio de la ley", ylab = "Número de países" )

Índice de Efectividad de la Gobernanza (GEE)

str(Data$GEE)

##  num [1:126] -1.46 -1.05 0.11 1.94 1.43 0.03 1.6 1.45 -0.1 1.17 ...

summary(Data$GEE)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1.9100 -0.6100 -0.0050  0.1101  0.6525  2.2300

sd(Data$GEE)

## [1] 0.961738

Mode(Data$GEE)

## [1] 0.11
## attr(,"freq")
## [1] 4

hist(Data$GEE, col = mis.colores1(14), main = "Gráfico 11: Índice de Efectividad de la Gobernanza según países", xlab = "Índice de Efectividad de la Gobernanza", ylab = "Número de países" )

Voz y rendición de cuentas

str(Data$Voice_acco)

##  num [1:126] -0.99 -0.78 0.15 1.14 -1.12 0.6 1.32 1.33 -1.49 1.37 ...

summary(Data$Voice_acco)

##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -1.83000 -0.66000  0.12000  0.09802  0.89500  1.69000

sd(Data$Voice_acco)

## [1] 0.9142315

Mode(Data$Voice_acco)

## [1] 0.03 0.53
## attr(,"freq")
## [1] 3

hist(Data$Voice_acco, col = mis.colores1(14), main = "Gráfico 12: Voz y rendición de cuentas según países", xlab = "Voz y rendición de cuentas", ylab = "Número de países" )

Control de la corrupción

str(Data$Control_co)

##  num [1:126] -1.4 -1.05 -0.53 1.23 1.11 -0.07 1.81 1.55 -0.87 1.55 ...

summary(Data$Control_co)

##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -1.60000 -0.70750 -0.19000  0.06984  0.75000  2.17000

sd(Data$Control_co)

## [1] 1.01238

Mode(Data$Control_co)

## [1] -0.32
## attr(,"freq")
## [1] 4

hist(Data$Control_co, col = mis.colores1(14), main = "Gráfico 13: Control de la corrupción según países", xlab = "Control de la corrupción", ylab = "Número de países" )

Calidad regulatoria

str(Data$Regulatory_quality)

##  num [1:126] -1.12 -0.89 0.27 1.23 0.98 -0.49 1.87 1.46 -0.23 1.29 ...

summary(Data$Regulatory_quality)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -2.3500 -0.5700 -0.0600  0.1278  0.8825  2.1600

sd(Data$Regulatory_quality)

## [1] 0.933464

Mode(Data$Regulatory_quality)

## [1] -0.11
## attr(,"freq")
## [1] 3

hist(Data$Regulatory_quality, col = mis.colores1(14), main = "Gráfico 14: Calidad regulatoria según países", xlab = "Calidad regulatoria", ylab = "Número de países" )

################################################################################

TERCERA PARTE: ANÁLISIS BIVARIADO

CONTINÚA LA DIVISIÓN POR CATEGORÍAS

Categoría 1: Medidas tempranas: evalúa que tan rápido y riguroso respondieron los Estados dentro de los primeros 7 días desde su primer infectado

Apoyo económico

#Con número de contagios al día 100
tab1=table(Data$`Ayuda Económica`,Data$Valor100)
chisq.test(tab1)

## Warning in chisq.test(tab1): Chi-squared approximation may be incorrect

## 
##  Pearson's Chi-squared test
## 
## data:  tab1
## X-squared = 126, df = 125, p-value = 0.4581

aov(Data$Valor100~Data$`Ayuda Económica`)

## Call:
##    aov(formula = Data$Valor100 ~ Data$`Ayuda Económica`)
## 
## Terms:
##                 Data$`Ayuda Económica` Residuals
## Sum of Squares                 0.07331   9.69036
## Deg. of Freedom                      1       124
## 
## Residual standard error: 0.2795497
## Estimated effects may be unbalanced

summary(aov(Data$Valor100~Data$`Ayuda Económica`))

##                         Df Sum Sq Mean Sq F value Pr(>F)
## Data$`Ayuda Económica`   1  0.073 0.07331   0.938  0.335
## Residuals              124  9.690 0.07815

TukeyHSD(aov(Data$Valor100~Data$`Ayuda Económica`))

##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = Data$Valor100 ~ Data$`Ayuda Económica`)
## 
## $`Data$`Ayuda Económica``
##                                          diff        lwr       upr     p adj
## Menos del 50% del sueldo-Sin apoyo -0.1053042 -0.3204977 0.1098893 0.3346532

ggplot(Data, aes(y = Valor100, x = `Ayuda Económica`,fill=factor(`Ayuda Económica`))) +
  geom_boxplot()+ggtitle("Gráfico 15: Número de contagios según el tipo de Ayuda económica")+xlab("Apoyo económico") 

Campañas informativas

#Es una variable categórica requiere anova o chi cuadrado  
#Con número de contagios al día 100
tabla=table(Data$infoalawk,Data$Valor100)
chisq.test(tabla)

## Warning in chisq.test(tabla): Chi-squared approximation may be incorrect

## 
##  Pearson's Chi-squared test
## 
## data:  tabla
## X-squared = 252, df = 250, p-value = 0.4526

aov(Data$Valor100~Data$infoalawk)

## Call:
##    aov(formula = Data$Valor100 ~ Data$infoalawk)
## 
## Terms:
##                 Data$infoalawk Residuals
## Sum of Squares        0.194237  9.569433
## Deg. of Freedom              2       123
## 
## Residual standard error: 0.278927
## Estimated effects may be unbalanced

summary(aov(Data$Valor100~Data$infoalawk))

##                 Df Sum Sq Mean Sq F value Pr(>F)
## Data$infoalawk   2  0.194 0.09712   1.248  0.291
## Residuals      123  9.569 0.07780

TukeyHSD(aov(Data$Valor100~Data$infoalawk))

##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = Data$Valor100 ~ Data$infoalawk)
## 
## $`Data$infoalawk`
##                                                  diff        lwr        upr
## Campañas del gobierno-Ninguna              0.04696467 -0.1739541 0.26788343
## Campañas integrales-Ninguna               -0.05757857 -0.2325748 0.11741770
## Campañas integrales-Campañas del gobierno -0.10454323 -0.2716130 0.06252651
##                                               p adj
## Campañas del gobierno-Ninguna             0.8693544
## Campañas integrales-Ninguna               0.7156298
## Campañas integrales-Campañas del gobierno 0.3018519

ggplot(Data, aes(y = Valor100, x = infoalawk,fill=factor(infoalawk))) +
  geom_boxplot()+ggtitle("Gráfico 16: Número de contagios según el tipo de campañas")+xlab("campañas informativas") 

Índice de rigurosidad en medidas tempranas

#Con número de contagios al día 100
cor.test(Data$Rigurosidad,Data$Valor100) #p-value 0.03 y cor -0.19

## 
##  Pearson's product-moment correlation
## 
## data:  Data$Rigurosidad and Data$Valor100
## t = -2.4657, df = 124, p-value = 0.01504
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.37684504 -0.04290302
## sample estimates:
##        cor 
## -0.2161877

plot(Valor100~Rigurosidad,data=Data, main="Gráfico 17: Número de contagios según el índice de Rigurosidad en medidas tempranas", xlab="Índice de rigurosidad en medidas tempranas", ylab="Número de contagios")

Categoría 2: Demografía: Evalúa la concentración de personas en cada país

Densidad poblacional

#Con número de contagios al día 100
cor.test(Data$Densidadpob,Data$Valor100)

## 
##  Pearson's product-moment correlation
## 
## data:  Data$Densidadpob and Data$Valor100
## t = 1.1244, df = 124, p-value = 0.263
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.07577095  0.27061893
## sample estimates:
##       cor 
## 0.1004674

plot(Valor100~Densidadpob,data=Data, main="Gráfico 18: Número de contagios según la densidad poblacional", xlab="Densidad poblacional", ylab="Número de contagios")

Población urbana

#Con número de contagios al día 100
cor.test(Data$Poburbana,Data$Valor100) #p-value 0.003 y cor 0.26

## 
##  Pearson's product-moment correlation
## 
## data:  Data$Poburbana and Data$Valor100
## t = 5.6256, df = 124, p-value = 1.167e-07
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.2996437 0.5800753
## sample estimates:
##       cor 
## 0.4509181

plot(Valor100~Poburbana,data=Data, main="Gráfico 19: Número de contagios según la población urbana de un país", xlab="Población urbana", ylab="Número de contagios")

Categoría 3: Estructural: Evalúa las condiciones socioeconómicas con las que cada país tuvo que enfrentar la pandemia

Índice de Desarrollo Humano (IDH)

#Con número de contagios al día 100
cor.test(Data$HDI,Data$Valor100) #p-value 0.01 y cor 0.22

## 
##  Pearson's product-moment correlation
## 
## data:  Data$HDI and Data$Valor100
## t = 4.4007, df = 124, p-value = 2.3e-05
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.2058616 0.5096775
## sample estimates:
##       cor 
## 0.3675349

plot(Valor100~HDI,data=Data, main="Gráfico 20: Número de contagios según el IDH de un país", xlab="IDH", ylab="Número de contagios")

PBI precio dolar actual per cápita

#Con número de contagios al día 100
cor.test(Data$PPP_2018,Data$Valor100)

## 
##  Pearson's product-moment correlation
## 
## data:  Data$PPP_2018 and Data$Valor100
## t = 6.7992, df = 124, p-value = 3.95e-10
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.3809398 0.6378891
## sample estimates:
##       cor 
## 0.5211247

plot(Valor100~PPP_2018,data=Data, main="Gráfico 21: Número de contagios según el Precio del Dólar actual per cápita de un país", xlab="PBI por Precio del dólar actual", ylab="Número de contagios")

Desempleo

#Con número de contagios al día 100
cor.test(Data$Tasadesempleo,Data$Valor100)

## 
##  Pearson's product-moment correlation
## 
## data:  Data$Tasadesempleo and Data$Valor100
## t = -1.5076, df = 124, p-value = 0.1342
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.30198104  0.04172577
## sample estimates:
##        cor 
## -0.1341603

plot(Valor100~Tasadesempleo,data=Data, main="Gráfico 22: Número de contagios según el Desempleo en un país", xlab="Tasa de desempleo", ylab="Número de contagios")

Categoría 4: Gobernanza: Evalúa la “capacidad de gobernar” de un Estado a través de la legitimidad, eficiencia y estabilidad, y la “forma de gobernar” a través de participación, transparencia y rendición de cuentas.

Estabilidad política

#Con número de contagios al día 100
cor.test(Data$Political_sta,Data$Valor100)

## 
##  Pearson's product-moment correlation
## 
## data:  Data$Political_sta and Data$Valor100
## t = 3.2977, df = 124, p-value = 0.001272
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.1147402 0.4371449
## sample estimates:
##       cor 
## 0.2839486

plot(Valor100~Political_sta,data=Data, main="Gráfico 23: Número de contagios según la estabilidad política en un país", xlab="Estabilidad política", ylab="Número de contagios")

Imperio de la ley

#Con número de contagios al día 100
cor.test(Data$Ruleoflaw,Data$Valor100)

## 
##  Pearson's product-moment correlation
## 
## data:  Data$Ruleoflaw and Data$Valor100
## t = 4.1167, df = 124, p-value = 6.961e-05
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.1829388 0.4918286
## sample estimates:
##       cor 
## 0.3467507

plot(Valor100~Ruleoflaw,data=Data, main="Gráfico 24: Número de contagios según el imperio de la ley en un país", xlab="Imperio de la ley", ylab="Número de contagios")

Índice de Efectividad de la Gobernanza (GEE)

#Con número de contagios al día 100
cor.test(Data$GEE,Data$Valor100)

## 
##  Pearson's product-moment correlation
## 
## data:  Data$GEE and Data$Valor100
## t = 3.9627, df = 124, p-value = 0.0001243
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.1703449 0.4819106
## sample estimates:
##       cor 
## 0.3352628

plot(Valor100~GEE,data=Data, main="Gráfico 25: Número de contagios según el Índice de Efectividad de la Governanza en un país", xlab=" Índice de Efectividad de la Governanza", ylab="Número de contagios")

Voz y rendición de cuentas

#Con número de contagios al día 100
cor.test(Data$Voice_acco,Data$Valor100)

## 
##  Pearson's product-moment correlation
## 
## data:  Data$Voice_acco and Data$Valor100
## t = 1.1472, df = 124, p-value = 0.2535
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.0737526  0.2724990
## sample estimates:
##       cor 
## 0.1024762

plot(Valor100~Voice_acco,data=Data, main="Gráfico 26: Número de contagios según la voz y rendición de cuentas de un país", xlab="Voz y rendición de cuentas", ylab="Número de contagios")

Control de la corrupción

#Con número de contagios al día 100
cor.test(Data$Control_co,Data$Valor100)

## 
##  Pearson's product-moment correlation
## 
## data:  Data$Control_co and Data$Valor100
## t = 3.6697, df = 124, p-value = 0.0003591
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.1460846 0.4625774
## sample estimates:
##       cor 
## 0.3129942

plot(Valor100~Control_co,data=Data, main="Gráfico 27: Número de contagios según el control de la corrupción en un país", xlab="Control de la corrupción", ylab="Número de contagios")

Calidad regulatoria

#Con número de contagios al día 100
cor.test(Data$Regulatory_quality,Data$Valor100)

## 
##  Pearson's product-moment correlation
## 
## data:  Data$Regulatory_quality and Data$Valor100
## t = 4.2319, df = 124, p-value = 4.468e-05
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.1922861 0.4991384
## sample estimates:
##       cor 
## 0.3552454

plot(Valor100~Regulatory_quality,data=Data, main="Gráfico 28: Número de contagios según la calidad regulatoria en un país", xlab="Control de la corrupción", ylab="Número de contagios")

CUARTA PARTE: ANÁLISIS FACTORIAL

PASITO A PASITO

FACTORIAL DE GOBERNANZA Y MEDIDAS TEMPRANAS

Calculemos matriz de correlación:

names(Data)

##  [1] "Political_sta"           "Voice_acco"             
##  [3] "Ruleoflaw"               "Control_co"             
##  [5] "Regulatory_quality"      "Tasadesempleo"          
##  [7] "Densidadpob"             "Ayuda Económica"        
##  [9] "HDI"                     "EXPECTATIVAVIDA"        
## [11] "EXPECTCOLE"              "YEARS_SCHOOLING"        
## [13] "GNI_GROSSNATIONALINCOME" "Poburbana"              
## [15] "infoalawk"               "Rigurosidad"            
## [17] "GEE"                     "PPP_2018"               
## [19] "Valor100"                "pobla"

theData = Data
theData = Data[, c(1:5,8,15:17)]
table(theData$`Ayuda Económica`)

## 
##                Sin apoyo Menos del 50% del sueldo 
##                      119                        7

#theData$Voice_acco = NULL

Analizamos

lapiz=polycor::hetcor(theData)$correlations

Exploramos correlaciones:

ggcorrplot(lapiz)

#evaluandos ignificancia
ggcorrplot(lapiz,
          p.mat = cor_pmat(lapiz),
          insig = "blank",
          title = "Gráfico 1: Matriz de correlación")

Verificamos si los datos se pueden factorizar

psych::KMO(lapiz) 

## Kaiser-Meyer-Olkin factor adequacy
## Call: psych::KMO(r = lapiz)
## Overall MSA =  0.83
## MSA for each item = 
##      Political_sta         Voice_acco          Ruleoflaw         Control_co 
##               0.90               0.90               0.85               0.83 
## Regulatory_quality    Ayuda Económica          infoalawk        Rigurosidad 
##               0.82               0.35               0.53               0.74 
##                GEE 
##               0.86

Verificamos si la matriz de correlaciones es adecuada

cortest.bartlett(lapiz,n=nrow(theData))$p.value>0.05

## [1] FALSE

library(matrixcalc)
is.singular.matrix(lapiz)

## [1] FALSE

Determinamos en cuántos factores o variables latentes podriamos redimensionar la data

theData$`Ayuda Económica` = as.numeric(theData$`Ayuda Económica`)
theData$infoalawk = as.numeric(theData$infoalawk)
fa.parallel(theData, fm = 'ML', fa = 'fa')

## Parallel analysis suggests that the number of factors =  2  and the number of components =  NA

REDIMENSIONAMOS A UN NÚMERO MENOR DE FACTORES

Resultado inicial:

mandarina <- fa(theData,nfactors = 2,cor = 'mixed',rotate ="varimax",fm="minres")

## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## The estimated weights for the factor scores are probably incorrect. Try a
## different factor score estimation method.

## Warning in fac(r = r, nfactors = nfactors, n.obs = n.obs, rotate = rotate, : An
## ultra-Heywood case was detected. Examine the results carefully

## mixed.cor is deprecated, please use mixedCor.
print(mandarina$loadings)

## 
## Loadings:
##                    MR1    MR2   
## Political_sta       0.840       
## Voice_acco          0.792       
## Ruleoflaw           0.963 -0.217
## Control_co          0.946 -0.135
## Regulatory_quality  0.926 -0.179
## Ayuda Económica            0.482
## infoalawk                  0.481
## Rigurosidad        -0.242  0.979
## GEE                 0.931 -0.256
## 
##                  MR1   MR2
## SS loadings    4.942 1.585
## Proportion Var 0.549 0.176
## Cumulative Var 0.549 0.725

Resultado visual

fa.diagram(mandarina, main = c("Gráfico 2: Árbol de factorización del primer modelo"))

Evaluamos resultado obtenido: ¿La Raíz del error cuadrático medio corregida está cerca a cero?

mandarina$crms

## [1] 0.03658976

¿La Raíz del error cuadrático medio de aproximación es menor a 0.05?

mandarina$RMSEA

##      RMSEA      lower      upper confidence 
##  0.1667304  0.1324592  0.2044561  0.9000000

¿El índice de Tucker-Lewis es mayor a 0.9?

mandarina$TLI

## [1] 0.8956513

¿Qué variables aportaron mas a los factores?

sort(mandarina$communality)

##    Ayuda Económica          infoalawk         Voice_acco      Political_sta 
##          0.2325703          0.2357622          0.6277258          0.7061226 
## Regulatory_quality         Control_co                GEE          Ruleoflaw 
##          0.8892774          0.9138902          0.9314220          0.9734708 
##        Rigurosidad 
##          1.0163076

¿Qué variables contribuyen a mas de un factor? #conviene que salga 1

sort(mandarina$complexity)

##    Ayuda Económica         Voice_acco      Political_sta          infoalawk 
##           1.000263           1.000346           1.001687           1.037678 
##         Control_co Regulatory_quality          Ruleoflaw        Rigurosidad 
##           1.040483           1.074851           1.101283           1.121989 
##                GEE 
##           1.149998

factorial_casos<-as.data.frame(mandarina$scores) #en esta no me sale el factorial
head(factorial_casos)

##                             MR1        MR2
## Afghanistan          -1.8887443 -0.4077092
## Angola               -1.1601934 -0.2620495
## Albania               0.0368565  1.7407112
## Andorra               1.4049975 -1.3051795
## United Arab Emirates  0.6920686 -1.2259458
## Argentina            -0.5383236 -0.8125784

summary(factorial_casos)

##       MR1               MR2         
##  Min.   :-2.0235   Min.   :-1.7756  
##  1st Qu.:-0.6876   1st Qu.:-0.7682  
##  Median :-0.2155   Median :-0.2225  
##  Mean   : 0.0000   Mean   : 0.0000  
##  3rd Qu.: 0.7355   3rd Qu.: 0.6333  
##  Max.   : 1.9438   Max.   : 3.2592

FACTORIALES CON LA DIMENSIÓN ESTRUCTURAL

Calculamos matriz de correlación:

#Creamos una data con variables seleccionadas por teoría
demo = Data
names(demo)

##  [1] "Political_sta"           "Voice_acco"             
##  [3] "Ruleoflaw"               "Control_co"             
##  [5] "Regulatory_quality"      "Tasadesempleo"          
##  [7] "Densidadpob"             "Ayuda Económica"        
##  [9] "HDI"                     "EXPECTATIVAVIDA"        
## [11] "EXPECTCOLE"              "YEARS_SCHOOLING"        
## [13] "GNI_GROSSNATIONALINCOME" "Poburbana"              
## [15] "infoalawk"               "Rigurosidad"            
## [17] "GEE"                     "PPP_2018"               
## [19] "Valor100"                "pobla"

demo = (Data[, c(10:13, 18, 6)])
#Convertimos la tasa de desempleo a proporciones 
demo$empleo = 100 - (demo$Tasadesempleo)
head(demo)

##                      EXPECTATIVAVIDA EXPECTCOLE YEARS_SCHOOLING
## Afghanistan                    64.49      10.14            3.93
## Angola                         60.78      11.78            5.13
## Albania                        78.46      15.23           10.05
## Andorra                        81.79      13.30           10.16
## United Arab Emirates           77.81      13.64           10.95
## Argentina                      76.52      17.64           10.56
##                      GNI_GROSSNATIONALINCOME PPP_2018 Tasadesempleo empleo
## Afghanistan                          1745.67   524.16            24     76
## Angola                               5554.70  3289.65             7     93
## Albania                             12299.80  5284.38            14     86
## Andorra                             48640.89 41793.06             4     96
## United Arab Emirates                66911.66 43839.36             2     98
## Argentina                           17611.22 11683.95             8     92

demo$Tasadesempleo = NULL

Analizamos

pinguino=polycor::hetcor(demo)$correlations

Exploramos correlaciones

ggcorrplot(pinguino)

#evaluandos ignificancia
ggcorrplot(pinguino,
          p.mat = cor_pmat(pinguino),
          insig = "blank",
          title = "Gráfico 1: Matriz de correlación")

Verificamos si los datos se pueden factorizar

psych::KMO(pinguino) 

## Kaiser-Meyer-Olkin factor adequacy
## Call: psych::KMO(r = pinguino)
## Overall MSA =  0.83
## MSA for each item = 
##         EXPECTATIVAVIDA              EXPECTCOLE         YEARS_SCHOOLING 
##                    0.89                    0.84                    0.87 
## GNI_GROSSNATIONALINCOME                PPP_2018                  empleo 
##                    0.76                    0.77                    0.93

Verificamos si la matriz de correlaciones es adecuada

cortest.bartlett(pinguino,n=nrow(demo))$p.value>0.05

## [1] FALSE

library(matrixcalc)
is.singular.matrix(pinguino)

## [1] FALSE

Determinar en cuántos factores o variables latentes podriamos redimensionar la data

fa.parallel(demo, fm = 'ML', fa = 'fa')

## Parallel analysis suggests that the number of factors =  2  and the number of components =  NA

REDIMENSIONAMOS A UN NÚMERO MENOR DE FACTORES

Resultado inicial:

alfalfa <- fa(demo,nfactors = 1,cor = 'mixed',rotate ="varimax",fm="minres")

## mixed.cor is deprecated, please use mixedCor.
print(alfalfa$loadings,cutoff = 0.5)

## 
## Loadings:
##                         MR1  
## EXPECTATIVAVIDA         0.864
## EXPECTCOLE              0.855
## YEARS_SCHOOLING         0.862
## GNI_GROSSNATIONALINCOME 0.839
## PPP_2018                0.825
## empleo                       
## 
##                  MR1
## SS loadings    3.731
## Proportion Var 0.622

Resultado visual

fa.diagram(alfalfa, main = c("Gráfico 2: Árbol de factorización del primer modelo"))

Evaluando Resultado obtenido: ¿La Raíz del error cuadrático medio corregida está cerca a cero?

alfalfa$crms

## [1] 0.09378219

¿La Raíz del error cuadrático medio de aproximación es menor a 0.05?

alfalfa$RMSEA

##      RMSEA      lower      upper confidence 
##  0.2930635  0.2456668  0.3457595  0.9000000

¿El índice de Tucker-Lewis es mayor a 0.9?

alfalfa$TLI

## [1] 0.7117268

¿Qué variables aportaron mas a los factores?

sort(alfalfa$communality)

##                  empleo                PPP_2018 GNI_GROSSNATIONALINCOME 
##               0.1260794               0.6811339               0.7043395 
##              EXPECTCOLE         YEARS_SCHOOLING         EXPECTATIVAVIDA 
##               0.7308917               0.7424977               0.7462551

¿Qué variables contribuyen a mas de un factor? #conviene que salga 1

sort(alfalfa$complexity)

##         EXPECTATIVAVIDA              EXPECTCOLE                PPP_2018 
##                       1                       1                       1 
##         YEARS_SCHOOLING GNI_GROSSNATIONALINCOME                  empleo 
##                       1                       1                       1

factorial_casos<-as.data.frame(alfalfa$scores) #en esta no me sale el factorial
head(factorial_casos)

##                             MR1
## Afghanistan          -1.2751293
## Angola               -1.0796263
## Albania               0.1860176
## Andorra               0.8835804
## United Arab Emirates  1.0710668
## Argentina             0.4568132

summary(factorial_casos)

##       MR1          
##  Min.   :-1.77527  
##  1st Qu.:-0.77311  
##  Median :-0.02028  
##  Mean   : 0.00000  
##  3rd Qu.: 0.67733  
##  Max.   : 1.94743

AGREGAMOS LOS FACTORES A LA DATA

AJA=cbind(Data[1],as.data.frame(mandarina$scores))

Data$Gobernanza= normalize(AJA$MR1, 
                       method = "range", 
                       margin=2, # by column
                       range = c(0, 10))
Data$Medidas_tempranas=normalize(AJA$MR2, 
                       method = "range", 
                       margin=2, # by column
                       range = c(0, 10))

EJE=cbind(Data[1],as.data.frame(alfalfa$scores))

Data$estructural= normalize(EJE$MR1, 
                       method = "range", 
                       margin=2, # by column
                       range = c(0, 10))

QUINTA PARTE: REGRESIÓN MULTIVARIADA

TAMBIÉN PASITO A PASITO

Creamos un dataframe con lo que se va utilizar por teoría en la regresión

data_regre=Data
names(data_regre)

##  [1] "Political_sta"           "Voice_acco"             
##  [3] "Ruleoflaw"               "Control_co"             
##  [5] "Regulatory_quality"      "Tasadesempleo"          
##  [7] "Densidadpob"             "Ayuda Económica"        
##  [9] "HDI"                     "EXPECTATIVAVIDA"        
## [11] "EXPECTCOLE"              "YEARS_SCHOOLING"        
## [13] "GNI_GROSSNATIONALINCOME" "Poburbana"              
## [15] "infoalawk"               "Rigurosidad"            
## [17] "GEE"                     "PPP_2018"               
## [19] "Valor100"                "pobla"                  
## [21] "Gobernanza"              "Medidas_tempranas"      
## [23] "estructural"

data_regre$pobla = NULL
str(data_regre)

## 'data.frame':    126 obs. of  22 variables:
##  $ Political_sta          : num  -2.65 -0.31 0.12 1.62 0.7 -0.12 1.09 0.98 -0.68 0.48 ...
##  $ Voice_acco             : num  -0.99 -0.78 0.15 1.14 -1.12 0.6 1.32 1.33 -1.49 1.37 ...
##  $ Ruleoflaw              : num  -1.71 -1.05 -0.41 1.58 0.84 -0.43 1.73 1.88 -0.58 1.36 ...
##  $ Control_co             : num  -1.4 -1.05 -0.53 1.23 1.11 -0.07 1.81 1.55 -0.87 1.55 ...
##  $ Regulatory_quality     : num  -1.12 -0.89 0.27 1.23 0.98 -0.49 1.87 1.46 -0.23 1.29 ...
##  $ Tasadesempleo          : int  24 7 14 4 2 8 6 6 5 7 ...
##  $ Densidadpob            : num  56.9 24.7 104.6 163.8 135.6 ...
##  $ Ayuda Económica        : Ord.factor w/ 2 levels "Sin apoyo"<"Menos del 50% del sueldo": 1 1 1 1 1 1 1 1 1 1 ...
##  $ HDI                    : num  0.5 0.57 0.79 0.86 0.87 0.83 0.94 0.91 0.75 0.92 ...
##  $ EXPECTATIVAVIDA        : num  64.5 60.8 78.5 81.8 77.8 ...
##  $ EXPECTCOLE             : num  10.1 11.8 15.2 13.3 13.6 ...
##  $ YEARS_SCHOOLING        : num  3.93 5.13 10.05 10.16 10.95 ...
##  $ GNI_GROSSNATIONALINCOME: num  1746 5555 12300 48641 66912 ...
##  $ Poburbana              : num  25.8 66.2 61.2 88 86.8 ...
##  $ infoalawk              : Ord.factor w/ 3 levels "Ninguna"<"Campañas del gobierno"<..: 3 2 3 1 1 3 3 3 3 3 ...
##  $ Rigurosidad            : num  27.78 33.33 81.48 0 2.78 ...
##  $ GEE                    : num  -1.46 -1.05 0.11 1.94 1.43 0.03 1.6 1.45 -0.1 1.17 ...
##  $ PPP_2018               : num  524 3290 5284 41793 43839 ...
##  $ Valor100               : num  0.043397 0.000814 0.058581 1.104457 0.166214 ...
##  $ Gobernanza             : num  0.34 2.18 5.19 8.64 6.84 ...
##  $ Medidas_tempranas      : num  2.717 3.006 6.984 0.934 1.092 ...
##  $ estructural            : num  1.34 1.87 5.27 7.14 7.65 ...
##  - attr(*, "na.action")= 'omit' Named int [1:3] 39 107 112
##   ..- attr(*, "names")= chr [1:3] "39" "116" "121"

names(data_regre)=c("Political stability", "Voice and accountability", "Rule of law", "Control Corruption", "Regulatory Quality", "Tasa de desempleo", "Densidad de la poblacion", "Ayuda economica", "IDH", "Expectativa de vida", "Expectativa de años de escolaridad", "Promedio de años de escolaridad", "Renta Nacional", "Poblacion urbana", "Campañas informativas", "Rigurosidad", "GEE", "PBI per capita", "Contagiados", "Gobernanza", "Medidas tempranas", "Estructural")

Realizamos las regresiones

#Gobernanza, población urbana, renta nacional, expectativa de años de escolaridad
MINARISE=formula(Contagiados~data_regre$Gobernanza+data_regre$`Poblacion urbana`+data_regre$`Renta Nacional` +data_regre$`Expectativa de años de escolaridad`)
MINARISEM=lm(MINARISE,data=data_regre)
summary(MINARISEM)

## 
## Call:
## lm(formula = MINARISE, data = data_regre)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.58747 -0.07887 -0.01999  0.04565  1.03327 
## 
## Coefficients:
##                                                   Estimate Std. Error t value
## (Intercept)                                      2.980e-01  9.494e-02   3.139
## data_regre$Gobernanza                           -2.327e-02  1.175e-02  -1.979
## data_regre$`Poblacion urbana`                    1.906e-03  1.152e-03   1.655
## data_regre$`Renta Nacional`                      1.288e-05  1.444e-06   8.921
## data_regre$`Expectativa de años de escolaridad` -3.024e-02  9.619e-03  -3.144
##                                                 Pr(>|t|)    
## (Intercept)                                      0.00213 ** 
## data_regre$Gobernanza                            0.05004 .  
## data_regre$`Poblacion urbana`                    0.10045    
## data_regre$`Renta Nacional`                     5.95e-15 ***
## data_regre$`Expectativa de años de escolaridad`  0.00210 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.1911 on 121 degrees of freedom
## Multiple R-squared:  0.5473, Adjusted R-squared:  0.5324 
## F-statistic: 36.58 on 4 and 121 DF,  p-value: < 2.2e-16

#Gobernanza, medidas tempranas, Estructural, Población urbana y Densidad de la población
efe= formula(Contagiados~ + data_regre$Gobernanza + data_regre$`Medidas tempranas` + data_regre$Estructural + data_regre$`Poblacion urbana` + data_regre$`Densidad de la poblacion`)
afa = lm(efe, data = data_regre)
summary(afa)

## 
## Call:
## lm(formula = efe, data = data_regre)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.32305 -0.12371 -0.02479  0.05341  2.01556 
## 
## Coefficients:
##                                         Estimate Std. Error t value Pr(>|t|)  
## (Intercept)                           -1.566e-01  8.444e-02  -1.854   0.0661 .
## data_regre$Gobernanza                 -1.067e-02  1.669e-02  -0.639   0.5240  
## data_regre$`Medidas tempranas`        -4.693e-03  1.172e-02  -0.400   0.6895  
## data_regre$Estructural                 3.691e-02  1.992e-02   1.853   0.0664 .
## data_regre$`Poblacion urbana`          3.128e-03  1.480e-03   2.113   0.0367 *
## data_regre$`Densidad de la poblacion`  5.958e-06  3.080e-05   0.193   0.8470  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2482 on 120 degrees of freedom
## Multiple R-squared:  0.2426, Adjusted R-squared:  0.2111 
## F-statistic: 7.688 on 5 and 120 DF,  p-value: 2.667e-06

library(stargazer)

## 
## Please cite as:

##  Hlavac, Marek (2018). stargazer: Well-Formatted Regression and Summary Statistics Tables.

##  R package version 5.2.2. https://CRAN.R-project.org/package=stargazer

Anovita=anova(MINARISEM, afa)
stargazer(Anovita,type = 'text',summary = F,title = "Table de Análisis de Varianza")

## 
## Table de Análisis de Varianza
## =====================================
##   Res.Df  RSS  Df Sum of Sq F Pr(> F)
## -------------------------------------
## 1  121   4.420                       
## 2  120   7.395 1   -2.975            
## -------------------------------------

stargazer(afa, MINARISEM,  type='text')

## 
## ===================================================================================
##                                                   Dependent variable:              
##                                      ----------------------------------------------
##                                                       Contagiados                  
##                                               (1)                     (2)          
## -----------------------------------------------------------------------------------
## Gobernanza                                   -0.011                 -0.023*        
##                                             (0.017)                 (0.012)        
##                                                                                    
## `Medidas tempranas`                          -0.005                                
##                                             (0.012)                                
##                                                                                    
## Estructural                                  0.037*                                
##                                             (0.020)                                
##                                                                                    
## `Poblacion urbana`                          0.003**                  0.002         
##                                             (0.001)                 (0.001)        
##                                                                                    
## `Densidad de la poblacion`                  0.00001                                
##                                            (0.00003)                               
##                                                                                    
## `Renta Nacional`                                                  0.00001***       
##                                                                    (0.00000)       
##                                                                                    
## `Expectativa de años de escolaridad`                               -0.030***       
##                                                                     (0.010)        
##                                                                                    
## Constant                                    -0.157*                0.298***        
##                                             (0.084)                 (0.095)        
##                                                                                    
## -----------------------------------------------------------------------------------
## Observations                                  126                     126          
## R2                                           0.243                   0.547         
## Adjusted R2                                  0.211                   0.532         
## Residual Std. Error                     0.248 (df = 120)       0.191 (df = 121)    
## F Statistic                          7.688*** (df = 5; 120) 36.577*** (df = 4; 121)
## ===================================================================================
## Note:                                                   *p<0.1; **p<0.05; ***p<0.01

el_elegido = MINARISEM

Un paréntesis necesario para abrir más librerías

library(ggpubr) #gráfico para ver normalidad

## 
## Attaching package: 'ggpubr'

## The following object is masked from 'package:plyr':
## 
##     mutate

library(scatterplot3d)
library(stargazer)
library(lmtest)

## Loading required package: zoo

## 
## Attaching package: 'zoo'

## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric

ANALIZAMOS LAS CIFRAS DE MINARISEM

Empezamos con linealidad

plot(el_elegido, 1, main = c("Gráfico 2: Linealidad"))  #diagonal, casi lineal

Continuamos con homocedasticidad

plot(el_elegido, 3, main = c("Gráfico 3: Homocedasticidad"))#diagonal

bptest(el_elegido) #valor P mayor a 0.05 Homocedasticidad

## 
##  studentized Breusch-Pagan test
## 
## data:  el_elegido
## BP = 59.784, df = 4, p-value = 3.22e-12

Sigue normalidad de residuos. Puntos cerca de la diagonal.

plot(el_elegido, 2, main = c("Gráfico 4: Normalidad de residuos")) #se alejan de diagonal

shapiro.test(el_elegido$residuals) #menor a 0.05 el valor P entonces indica que no hay normaldiad de residusos

## 
##  Shapiro-Wilk normality test
## 
## data:  el_elegido$residuals
## W = 0.80466, p-value = 1.173e-11

Última prueba

VIF(el_elegido)

##                           data_regre$Gobernanza 
##                                        2.948200 
##                   data_regre$`Poblacion urbana` 
##                                        2.188019 
##                     data_regre$`Renta Nacional` 
##                                        2.852955 
## data_regre$`Expectativa de años de escolaridad` 
##                                        2.707592

ANALIZAMOS VALORES INFLUYENTES

Prestar atención al indice de Cook.

plot(el_elegido, 5, main = c("Gráfico 5: Identificación de valores influyentes"))

checkMINARISA=as.data.frame(influence.measures(el_elegido)$is.inf)

## Warning in abbreviate(vn): abbreviate used with non-ASCII chars

checkMINARISA[checkMINARISA$cook.d | checkMINARISA$hat,] #120, 124

##        dfb.1_ dfb.d_$G dfb.d_$u dfb.d_$N dfb.ddade dffit cov.r cook.d  hat
## Kuwait  FALSE    FALSE    FALSE    FALSE     FALSE FALSE  TRUE  FALSE TRUE
## Qatar    TRUE     TRUE    FALSE     TRUE      TRUE  TRUE  TRUE   TRUE TRUE

Segundo planteamiento, eliminando al valor influyente de Singapur

CUARTA PARTE.2: ANÁLISIS FACTORIAL

PASITO A PASITO

FACTORIAL DE GOBERNANZA Y MEDIDAS TEMPRANAS

Calculemos matriz de correlación:

names(Data)

##  [1] "Political_sta"           "Voice_acco"             
##  [3] "Ruleoflaw"               "Control_co"             
##  [5] "Regulatory_quality"      "Tasadesempleo"          
##  [7] "Densidadpob"             "Ayuda Económica"        
##  [9] "HDI"                     "EXPECTATIVAVIDA"        
## [11] "EXPECTCOLE"              "YEARS_SCHOOLING"        
## [13] "GNI_GROSSNATIONALINCOME" "Poburbana"              
## [15] "infoalawk"               "Rigurosidad"            
## [17] "GEE"                     "PPP_2018"               
## [19] "Valor100"                "pobla"                  
## [21] "Gobernanza"              "Medidas_tempranas"      
## [23] "estructural"

data=Data[c(1:106, 108:126),] #Se elimina por ser outlier

Creamos una data con variables seleccionadas por teoría

Esta = data
Esta = data[, c(1:5,8,15:17)]
table(Esta$`Ayuda Económica`)

## 
##                Sin apoyo Menos del 50% del sueldo 
##                      118                        7

#Esta$Voice_acco = NULL

Analizamos

color=polycor::hetcor(Esta)$correlations

Exploramos correlaciones:

ggcorrplot(color)

#evaluandos ignificancia
ggcorrplot(color,
          p.mat = cor_pmat(color),
          insig = "blank",
          title = "Gráfico 1: Matriz de correlación")

Verificamos si los datos se pueden factorizar

psych::KMO(color) 

## Kaiser-Meyer-Olkin factor adequacy
## Call: psych::KMO(r = color)
## Overall MSA =  0.82
## MSA for each item = 
##      Political_sta         Voice_acco          Ruleoflaw         Control_co 
##               0.89               0.89               0.84               0.83 
## Regulatory_quality    Ayuda Económica          infoalawk        Rigurosidad 
##               0.81               0.33               0.55               0.74 
##                GEE 
##               0.86

Verificamos si la matriz de correlaciones es adecuada

cortest.bartlett(color,n=nrow(Esta))$p.value>0.05

## [1] FALSE

library(matrixcalc)
is.singular.matrix(color)

## [1] FALSE

Determinamos en cuántos factores o variables latentes podriamos redimensionar la data

Esta$`Ayuda Económica` = as.numeric(Esta$`Ayuda Económica`)
Esta$infoalawk = as.numeric(Esta$infoalawk)
fa.parallel(Esta, fm = 'ML', fa = 'fa')

## Parallel analysis suggests that the number of factors =  2  and the number of components =  NA

REDIMENSIONAMOS A UN NÚMERO MENOR DE FACTORES

Resultado inicial:

manzana <- fa(Esta,nfactors = 2,cor = 'mixed',rotate ="varimax",fm="minres")

## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## The estimated weights for the factor scores are probably incorrect. Try a
## different factor score estimation method.

## Warning in fac(r = r, nfactors = nfactors, n.obs = n.obs, rotate = rotate, : An
## ultra-Heywood case was detected. Examine the results carefully

## mixed.cor is deprecated, please use mixedCor.
print(manzana$loadings)

## 
## Loadings:
##                    MR1    MR2   
## Political_sta       0.835       
## Voice_acco          0.814       
## Ruleoflaw           0.962 -0.213
## Control_co          0.945 -0.130
## Regulatory_quality  0.925 -0.176
## Ayuda Económica            0.482
## infoalawk                  0.484
## Rigurosidad        -0.247  0.976
## GEE                 0.931 -0.254
## 
##                  MR1   MR2
## SS loadings    4.969 1.578
## Proportion Var 0.552 0.175
## Cumulative Var 0.552 0.727

Resultado visual

fa.diagram(manzana, main = c("Gráfico 2: Árbol de factorización del primer modelo"))

Evaluamos resultado obtenido: ¿La Raíz del error cuadrático medio corregida está cerca a cero?

manzana$crms

## [1] 0.03800651

¿La Raíz del error cuadrático medio de aproximación es menor a 0.05?

manzana$RMSEA

##      RMSEA      lower      upper confidence 
##  0.1715892  0.1373051  0.2093756  0.9000000

¿El índice de Tucker-Lewis es mayor a 0.9?

manzana$TLI

## [1] 0.8893754

¿Qué variables aportaron mas a los factores?

sort(manzana$communality)

##    Ayuda Económica          infoalawk         Voice_acco      Political_sta 
##          0.2320900          0.2409486          0.6618985          0.6985701 
## Regulatory_quality         Control_co                GEE          Ruleoflaw 
##          0.8869448          0.9106537          0.9306910          0.9711806 
##        Rigurosidad 
##          1.0142999

¿Qué variables contribuyen a mas de un factor? #conviene que salga 1

sort(manzana$complexity)

##         Voice_acco    Ayuda Económica      Political_sta         Control_co 
##           1.000006           1.000738           1.002742           1.037732 
##          infoalawk Regulatory_quality          Ruleoflaw        Rigurosidad 
##           1.056320           1.071947           1.097528           1.127458 
##                GEE 
##           1.147903

factorial_esta<-as.data.frame(manzana$scores) #en esta no me sale el factorial
head(factorial_esta)

##                              MR1        MR2
## Afghanistan          -1.88496962 -0.4147411
## Angola               -1.15737442 -0.2725842
## Albania               0.04317185  1.7314727
## Andorra               1.45471332 -1.2923853
## United Arab Emirates  0.70559981 -1.2392933
## Argentina            -0.50424708 -0.7991403

summary(factorial_esta)

##       MR1               MR2         
##  Min.   :-2.0138   Min.   :-1.7851  
##  1st Qu.:-0.6831   1st Qu.:-0.7623  
##  Median :-0.2090   Median :-0.2188  
##  Mean   : 0.0000   Mean   : 0.0000  
##  3rd Qu.: 0.7056   3rd Qu.: 0.6276  
##  Max.   : 1.9846   Max.   : 3.2463

FACTORIALES CON LA DIMENSIÓN ESTRUCTURAL

Calculamos matriz de correlación:

#Creamos una data con variables seleccionadas por teoría
structural = data
names(structural)

##  [1] "Political_sta"           "Voice_acco"             
##  [3] "Ruleoflaw"               "Control_co"             
##  [5] "Regulatory_quality"      "Tasadesempleo"          
##  [7] "Densidadpob"             "Ayuda Económica"        
##  [9] "HDI"                     "EXPECTATIVAVIDA"        
## [11] "EXPECTCOLE"              "YEARS_SCHOOLING"        
## [13] "GNI_GROSSNATIONALINCOME" "Poburbana"              
## [15] "infoalawk"               "Rigurosidad"            
## [17] "GEE"                     "PPP_2018"               
## [19] "Valor100"                "pobla"                  
## [21] "Gobernanza"              "Medidas_tempranas"      
## [23] "estructural"

structural = (data[, c(10:13, 18, 6)])
#Convertimos la tasa de desempleo a proporciones 
structural$empleo = 100 - (structural$Tasadesempleo)
head(structural)

##                      EXPECTATIVAVIDA EXPECTCOLE YEARS_SCHOOLING
## Afghanistan                    64.49      10.14            3.93
## Angola                         60.78      11.78            5.13
## Albania                        78.46      15.23           10.05
## Andorra                        81.79      13.30           10.16
## United Arab Emirates           77.81      13.64           10.95
## Argentina                      76.52      17.64           10.56
##                      GNI_GROSSNATIONALINCOME PPP_2018 Tasadesempleo empleo
## Afghanistan                          1745.67   524.16            24     76
## Angola                               5554.70  3289.65             7     93
## Albania                             12299.80  5284.38            14     86
## Andorra                             48640.89 41793.06             4     96
## United Arab Emirates                66911.66 43839.36             2     98
## Argentina                           17611.22 11683.95             8     92

structural$Tasadesempleo = NULL

Analizamos

morsa=polycor::hetcor(structural)$correlations

Exploramos correlaciones

ggcorrplot(morsa)

#evaluandos ignificancia
ggcorrplot(morsa,
          p.mat = cor_pmat(morsa),
          insig = "blank",
          title = "Gráfico 1: Matriz de correlación")

Verificamos si los datos se pueden factorizar

psych::KMO(morsa) 

## Kaiser-Meyer-Olkin factor adequacy
## Call: psych::KMO(r = morsa)
## Overall MSA =  0.83
## MSA for each item = 
##         EXPECTATIVAVIDA              EXPECTCOLE         YEARS_SCHOOLING 
##                    0.89                    0.84                    0.87 
## GNI_GROSSNATIONALINCOME                PPP_2018                  empleo 
##                    0.77                    0.77                    0.93

Verificamos si la matriz de correlaciones es adecuada

cortest.bartlett(morsa,n=nrow(structural))$p.value>0.05

## [1] FALSE

library(matrixcalc)
is.singular.matrix(morsa)

## [1] FALSE

Determinar en cuántos factores o variables latentes podriamos redimensionar la data

fa.parallel(structural, fm = 'ML', fa = 'fa')

## Parallel analysis suggests that the number of factors =  2  and the number of components =  NA

REDIMENSIONAMOS A UN NÚMERO MENOR DE FACTORES

Resultado inicial:

cactus <- fa(structural,nfactors = 1,cor = 'mixed',rotate ="varimax",fm="minres")

## mixed.cor is deprecated, please use mixedCor.
print(cactus$loadings,cutoff = 0.5)

## 
## Loadings:
##                         MR1  
## EXPECTATIVAVIDA         0.860
## EXPECTCOLE              0.856
## YEARS_SCHOOLING         0.863
## GNI_GROSSNATIONALINCOME 0.842
## PPP_2018                0.822
## empleo                       
## 
##                  MR1
## SS loadings    3.724
## Proportion Var 0.621

Resultado visual

fa.diagram(cactus, main = c("Gráfico 2: Árbol de factorización del primer modelo"))

Evaluando Resultado obtenido: ¿La Raíz del error cuadrático medio corregida está cerca a cero?

cactus$crms

## [1] 0.09278042

¿La Raíz del error cuadrático medio de aproximación es menor a 0.05?

cactus$RMSEA

##      RMSEA      lower      upper confidence 
##  0.2876571  0.2400340  0.3406230  0.9000000

¿El índice de Tucker-Lewis es mayor a 0.9?

cactus$TLI

## [1] 0.719773

¿Qué variables aportaron mas a los factores?

sort(cactus$communality)

##                  empleo                PPP_2018 GNI_GROSSNATIONALINCOME 
##               0.1212575               0.6749885               0.7091592 
##              EXPECTCOLE         EXPECTATIVAVIDA         YEARS_SCHOOLING 
##               0.7333696               0.7403700               0.7451315

¿Qué variables contribuyen a mas de un factor? #conviene que salga 1

sort(cactus$complexity)

##                PPP_2018         EXPECTATIVAVIDA              EXPECTCOLE 
##                       1                       1                       1 
##         YEARS_SCHOOLING GNI_GROSSNATIONALINCOME                  empleo 
##                       1                       1                       1

factorial_str<-as.data.frame(cactus$scores) #en esta no me sale el factorial
head(factorial_str)

##                             MR1
## Afghanistan          -1.2736427
## Angola               -1.0697512
## Albania               0.1963525
## Andorra               0.9113822
## United Arab Emirates  1.1208654
## Argentina             0.4756400

summary(factorial_str)

##       MR1          
##  Min.   :-1.77100  
##  1st Qu.:-0.78127  
##  Median :-0.01865  
##  Mean   : 0.00000  
##  3rd Qu.: 0.64947  
##  Max.   : 1.99009

AGREGAMOS LOS FACTORES A LA DATA

UWU=cbind(data[1],as.data.frame(manzana$scores))

data$Gobernanza= normalize(UWU$MR1, 
                       method = "range", 
                       margin=2, # by column
                       range = c(0, 10))
data$Medidas_tempranas=normalize(UWU$MR2, 
                       method = "range", 
                       margin=2, # by column
                       range = c(0, 10))

EWE=cbind(data[1],as.data.frame(cactus$scores))

data$estructural= normalize(EWE$MR1, 
                       method = "range", 
                       margin=2, # by column
                       range = c(0, 10))

QUINTA PARTE.2: REGRESIÓN MULTIVARIADA

TAMBIÉN PASITO A PASITO

Creamos un dataframe con lo que se va utilizar por teoría en la regresión

regre_data=data
names(regre_data)

##  [1] "Political_sta"           "Voice_acco"             
##  [3] "Ruleoflaw"               "Control_co"             
##  [5] "Regulatory_quality"      "Tasadesempleo"          
##  [7] "Densidadpob"             "Ayuda Económica"        
##  [9] "HDI"                     "EXPECTATIVAVIDA"        
## [11] "EXPECTCOLE"              "YEARS_SCHOOLING"        
## [13] "GNI_GROSSNATIONALINCOME" "Poburbana"              
## [15] "infoalawk"               "Rigurosidad"            
## [17] "GEE"                     "PPP_2018"               
## [19] "Valor100"                "pobla"                  
## [21] "Gobernanza"              "Medidas_tempranas"      
## [23] "estructural"

regre_data$pobla = NULL
str(regre_data)

## 'data.frame':    125 obs. of  22 variables:
##  $ Political_sta          : num  -2.65 -0.31 0.12 1.62 0.7 -0.12 1.09 0.98 -0.68 0.48 ...
##  $ Voice_acco             : num  -0.99 -0.78 0.15 1.14 -1.12 0.6 1.32 1.33 -1.49 1.37 ...
##  $ Ruleoflaw              : num  -1.71 -1.05 -0.41 1.58 0.84 -0.43 1.73 1.88 -0.58 1.36 ...
##  $ Control_co             : num  -1.4 -1.05 -0.53 1.23 1.11 -0.07 1.81 1.55 -0.87 1.55 ...
##  $ Regulatory_quality     : num  -1.12 -0.89 0.27 1.23 0.98 -0.49 1.87 1.46 -0.23 1.29 ...
##  $ Tasadesempleo          : int  24 7 14 4 2 8 6 6 5 7 ...
##  $ Densidadpob            : num  56.9 24.7 104.6 163.8 135.6 ...
##  $ Ayuda Económica        : Ord.factor w/ 2 levels "Sin apoyo"<"Menos del 50% del sueldo": 1 1 1 1 1 1 1 1 1 1 ...
##  $ HDI                    : num  0.5 0.57 0.79 0.86 0.87 0.83 0.94 0.91 0.75 0.92 ...
##  $ EXPECTATIVAVIDA        : num  64.5 60.8 78.5 81.8 77.8 ...
##  $ EXPECTCOLE             : num  10.1 11.8 15.2 13.3 13.6 ...
##  $ YEARS_SCHOOLING        : num  3.93 5.13 10.05 10.16 10.95 ...
##  $ GNI_GROSSNATIONALINCOME: num  1746 5555 12300 48641 66912 ...
##  $ Poburbana              : num  25.8 66.2 61.2 88 86.8 ...
##  $ infoalawk              : Ord.factor w/ 3 levels "Ninguna"<"Campañas del gobierno"<..: 3 2 3 1 1 3 3 3 3 3 ...
##  $ Rigurosidad            : num  27.78 33.33 81.48 0 2.78 ...
##  $ GEE                    : num  -1.46 -1.05 0.11 1.94 1.43 0.03 1.6 1.45 -0.1 1.17 ...
##  $ PPP_2018               : num  524 3290 5284 41793 43839 ...
##  $ Valor100               : num  0.043397 0.000814 0.058581 1.104457 0.166214 ...
##  $ Gobernanza             : num  0.322 2.142 5.145 8.675 6.801 ...
##  $ Medidas_tempranas      : num  2.724 3.006 6.989 0.979 1.085 ...
##  $ estructural            : num  1.32 1.86 5.23 7.13 7.69 ...
##  - attr(*, "na.action")= 'omit' Named int [1:3] 39 107 112
##   ..- attr(*, "names")= chr [1:3] "39" "116" "121"

names(regre_data)=c("Political stability", "Voice and accountability", "Rule of law", "Control Corruption", "Regulatory Quality", "Tasa de desempleo", "Densidad de la poblacion", "Ayuda economica", "IDH", "Expectativa de vida", "Expectativa de años de escolaridad", "Promedio de años de escolaridad", "Renta Nacional", "Poblacion urbana", "Campañas informativas", "Rigurosidad", "GEE", "PBI per capita", "Contagiados", "Gobernanza", "Medidas tempranas", "Estructural")

Realizamos las regresiones

#Gobernanza, población urbana, renta nacional, expectativa de años de escolaridad
CARLOS=formula(Contagiados~regre_data$Gobernanza+regre_data$`Poblacion urbana`+regre_data$`Renta Nacional` +regre_data$`Expectativa de años de escolaridad`)
CARLOSM=lm(CARLOS,data=regre_data)
summary(CARLOSM)

## 
## Call:
## lm(formula = CARLOS, data = regre_data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.64222 -0.08302 -0.01803  0.05097  0.92788 
## 
## Coefficients:
##                                                   Estimate Std. Error t value
## (Intercept)                                      3.228e-01  9.223e-02   3.500
## regre_data$Gobernanza                           -2.280e-02  1.135e-02  -2.008
## regre_data$`Poblacion urbana`                    1.927e-03  1.112e-03   1.733
## regre_data$`Renta Nacional`                      1.391e-05  1.431e-06   9.720
## regre_data$`Expectativa de años de escolaridad` -3.354e-02  9.385e-03  -3.573
##                                                 Pr(>|t|)    
## (Intercept)                                     0.000654 ***
## regre_data$Gobernanza                           0.046849 *  
## regre_data$`Poblacion urbana`                   0.085667 .  
## regre_data$`Renta Nacional`                      < 2e-16 ***
## regre_data$`Expectativa de años de escolaridad` 0.000509 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.1846 on 120 degrees of freedom
## Multiple R-squared:  0.5803, Adjusted R-squared:  0.5663 
## F-statistic: 41.48 on 4 and 120 DF,  p-value: < 2.2e-16

#Gobernanza, medidas tempranas, Estructural, Población urbana y Densidad de la población
MAJO= formula(Contagiados~ + regre_data$Gobernanza + regre_data$`Medidas tempranas` + regre_data$Estructural + regre_data$`Poblacion urbana` + regre_data$`Densidad de la poblacion`)
MAJITO = lm(MAJO, data = regre_data)
summary(MAJITO)

## 
## Call:
## lm(formula = MAJO, data = regre_data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.34773 -0.12268 -0.03390  0.06314  1.99284 
## 
## Coefficients:
##                                         Estimate Std. Error t value Pr(>|t|)  
## (Intercept)                           -1.873e-01  8.584e-02  -2.182   0.0311 *
## regre_data$Gobernanza                 -1.110e-02  1.651e-02  -0.673   0.5026  
## regre_data$`Medidas tempranas`        -3.638e-03  1.160e-02  -0.314   0.7544  
## regre_data$Estructural                 3.688e-02  1.979e-02   1.864   0.0648 .
## regre_data$`Poblacion urbana`          3.248e-03  1.472e-03   2.206   0.0293 *
## regre_data$`Densidad de la poblacion`  1.609e-04  9.276e-05   1.734   0.0854 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2456 on 119 degrees of freedom
## Multiple R-squared:  0.2632, Adjusted R-squared:  0.2322 
## F-statistic: 8.502 on 5 and 119 DF,  p-value: 6.596e-07

library(stargazer)

Anovita=anova(CARLOSM, MAJITO)
stargazer(Anovita,type = 'text',summary = F,title = "Table de Análisis de Varianza")

## 
## Table de Análisis de Varianza
## =====================================
##   Res.Df  RSS  Df Sum of Sq F Pr(> F)
## -------------------------------------
## 1  120   4.088                       
## 2  119   7.176 1   -3.088            
## -------------------------------------

stargazer(MAJITO, CARLOSM,  type='text')

## 
## ===================================================================================
##                                                   Dependent variable:              
##                                      ----------------------------------------------
##                                                       Contagiados                  
##                                               (1)                     (2)          
## -----------------------------------------------------------------------------------
## Gobernanza                                   -0.011                -0.023**        
##                                             (0.017)                 (0.011)        
##                                                                                    
## `Medidas tempranas`                          -0.004                                
##                                             (0.012)                                
##                                                                                    
## Estructural                                  0.037*                                
##                                             (0.020)                                
##                                                                                    
## `Poblacion urbana`                          0.003**                 0.002*         
##                                             (0.001)                 (0.001)        
##                                                                                    
## `Densidad de la poblacion`                  0.0002*                                
##                                             (0.0001)                               
##                                                                                    
## `Renta Nacional`                                                  0.00001***       
##                                                                    (0.00000)       
##                                                                                    
## `Expectativa de años de escolaridad`                               -0.034***       
##                                                                     (0.009)        
##                                                                                    
## Constant                                    -0.187**               0.323***        
##                                             (0.086)                 (0.092)        
##                                                                                    
## -----------------------------------------------------------------------------------
## Observations                                  125                     125          
## R2                                           0.263                   0.580         
## Adjusted R2                                  0.232                   0.566         
## Residual Std. Error                     0.246 (df = 119)       0.185 (df = 120)    
## F Statistic                          8.502*** (df = 5; 119) 41.477*** (df = 4; 120)
## ===================================================================================
## Note:                                                   *p<0.1; **p<0.05; ***p<0.01

elegido_supremo = CARLOSM

Un paréntesis necesario para abrir más librerías

library(ggpubr) #gráfico para ver normalidad
library(scatterplot3d)
library(stargazer)
library(lmtest)

ANALIZAMOS LAS CIFRAS DE CARLOSM

Empezamos con linealidad

plot(elegido_supremo, 1, main = c("Gráfico 2: Linealidad"))  #diagonal, casi lineal

Continuamos con homocedasticidad

plot(elegido_supremo, 3, main = c("Gráfico 3: Homocedasticidad"))#diagonal

bptest(elegido_supremo) #valor P mayor a 0.05 Homocedasticidad

## 
##  studentized Breusch-Pagan test
## 
## data:  elegido_supremo
## BP = 57.162, df = 4, p-value = 1.144e-11

Sigue normalidad de residuos. Puntos cerca de la diagonal.

plot(elegido_supremo, 2, main = c("Gráfico 4: Normalidad de residuos")) #se alejan de diagonal

shapiro.test(elegido_supremo$residuals) #menor a 0.05 el valor P entonces indica que no hay normaldiad de residusos

## 
##  Shapiro-Wilk normality test
## 
## data:  elegido_supremo$residuals
## W = 0.83156, p-value = 1.211e-10

Última prueba

VIF(elegido_supremo)

##                           regre_data$Gobernanza 
##                                        2.876856 
##                   regre_data$`Poblacion urbana` 
##                                        2.135327 
##                     regre_data$`Renta Nacional` 
##                                        2.759840 
## regre_data$`Expectativa de años de escolaridad` 
##                                        2.745941

ANALIZAMOS VALORES INFLUYENTES

Prestar atención al indice de Cook.

plot(elegido_supremo, 5, main = c("Gráfico 5: Identificación de valores influyentes"))

checkMINARISA=as.data.frame(influence.measures(elegido_supremo)$is.inf)

## Warning in abbreviate(vn): abbreviate used with non-ASCII chars

checkMINARISA[checkMINARISA$cook.d | checkMINARISA$hat,] #120, 124

##        dfb.1_ dfb.r_$G dfb.r_$u dfb.r_$N dfb.rdade dffit cov.r cook.d  hat
## Kuwait  FALSE    FALSE    FALSE    FALSE     FALSE FALSE FALSE  FALSE TRUE
## Qatar    TRUE     TRUE    FALSE     TRUE      TRUE  TRUE  TRUE   TRUE TRUE