Examen Integral
Grupo The powerpuff girls
#Limpieza de la Primera Data
Este periodo incluye a la variable dependiente (prevalencia del VIH en mujeres) del quinquenio 2008-2012 con las variables independientes del quinquenio 2003-2017
#VARIABLE DEPENDIENTE PREVALENCIA DEL VIH DEL 2008 AL 2012
link1="https://docs.google.com/spreadsheets/d/e/2PACX-1vQ51CAVKCjF_48ylMXr4FJkuVOHpXlUhaGmIA44cdQeWt4cBNjfekSgrPMjZMXrZg/pub?gid=14954305&single=true&output=csv"
DataVIH=read.csv(link1, stringsAsFactors = F)
DataVIH1 = DataVIH[,c(1,53:57)]
names(DataVIH1) = c("Pais","2008","2009","2010","2011","2012")
DataVIH1$`2009` = gsub("\\,", ".", DataVIH1$`2009`)
DataVIH1$`2010` = gsub("\\,", ".", DataVIH1$`2010`)
DataVIH1$`2008` = gsub("\\,", ".", DataVIH1$`2008`)
DataVIH1$`2011` = gsub("\\,", ".", DataVIH1$`2011`)
DataVIH1$`2012` = gsub("\\,", ".", DataVIH1$`2012`)
DataVIH1[,c(2:6)]=lapply(DataVIH1[,c(2:6)],as.numeric) #volver numerico en grupo
DataVIH1 = DataVIH1[complete.cases(DataVIH1),]
row.names(DataVIH1) = NULL
DataVIH1$VIH = rowMeans(DataVIH1[,2:6])
DataVIH1 = DataVIH1[,c (1,7)]
#VARIABLES INDEPENDIENTES DEL 2003 AL 2007
#PRIMERA HIPOTESIS: AUMENTO DEL REFORZAMIENTO DE LAS CAPACIDADES FEMENINAS
##TASA DE POBLACION ACTIVA MUJERES
link2="https://docs.google.com/spreadsheets/d/e/2PACX-1vQ-T56gOlA6lVVHHnrqUR6bc_doAmUewuvSlG4CcNgYyeZVUbPiozpcciPpDS3SyQ/pub?gid=1993384276&single=true&output=csv"
DataAct=read.csv(link2,stringsAsFactors = F)
DataAct1 = DataAct[,c(1,48:52)]
names(DataAct1) = c("Pais","2003","2004","2005", "2006", "2007")
DataAct1$`2003` = gsub("\\,", ".", DataAct1$`2003`)
DataAct1$`2004` = gsub("\\,", ".", DataAct1$`2004`)
DataAct1$`2005` = gsub("\\,", ".", DataAct1$`2005`)
DataAct1$`2006` = gsub("\\,", ".", DataAct1$`2006`)
DataAct1$`2007` = gsub("\\,", ".", DataAct1$`2007`)
DataAct1[,c(2:6)]=lapply(DataAct1[,c(2:6)],as.numeric) #volver numerico en grupo
DataAct1 = DataAct1[complete.cases(DataAct1),]
row.names(DataAct1) = NULL
DataAct1$PoblacionActiva = rowMeans(DataAct1[,2:6])
DataAct1= DataAct1[,c (1,7)]
##PARTICIPACION EN LA FUERZA LABORAL
link3="https://docs.google.com/spreadsheets/d/e/2PACX-1vTDcvi_z6RrnoATATdOGBLj2WlKRmVxqvx2hc4lUqkMwCcF3j9BLklmz0VjjIX4vA/pub?gid=1181245938&single=true&output=csv"
DataFLM= read.csv(link3, stringsAsFactors = F)
DataFLM1 = DataFLM[,c(1,48:52)]
names(DataFLM1) = c("Pais","2003","2004","2005", "2006", "2007")
DataFLM1$`2003` = gsub("\\,", ".", DataFLM1$`2003`)
DataFLM1$`2004` = gsub("\\,", ".", DataFLM1$`2004`)
DataFLM1$`2005` = gsub("\\,", ".", DataFLM1$`2005`)
DataFLM1$`2006` = gsub("\\,", ".", DataFLM1$`2006`)
DataFLM1$`2007` = gsub("\\,", ".", DataFLM1$`2007`)
DataFLM1[,c(2:6)]=lapply(DataFLM1[,c(2:6)],as.numeric)
DataFLM1$FLM = rowMeans(DataFLM1[,2:6],na.rm = TRUE)
DataFLM1= DataFLM1[,c (1,7)]
DataFLM1 = DataFLM1[complete.cases(DataFLM1),]
row.names(DataFLM1) = NULL
##PREVALENCIA DE USO DE METODOS ANTICONCEPTIVOS
link4="https://docs.google.com/spreadsheets/d/e/2PACX-1vRI-hkw-v7fdeFY_c1aS0c_DD86WJ-0k_G9Ti2lE_0_P3nGcPHagckLPhVM9SzD5g/pub?gid=932337199&single=true&output=csv"
DataMetodos= read.csv(link4, stringsAsFactors = F)
DataMetodos1 = DataMetodos[,c(1,48:52)]
names(DataMetodos1) = c("Pais","2003","2004","2005", "2006", "2007")
DataMetodos1$`2003` = gsub("\\,", ".", DataMetodos1$`2003`)
DataMetodos1$`2004` = gsub("\\,", ".", DataMetodos1$`2004`)
DataMetodos1$`2005` = gsub("\\,", ".", DataMetodos1$`2005`)
DataMetodos1$`2006` = gsub("\\,", ".", DataMetodos1$`2006`)
DataMetodos1$`2007` = gsub("\\,", ".", DataMetodos1$`2007`)
DataMetodos1[,c(2:6)]=lapply(DataMetodos1[,c(2:6)],as.numeric)
DataMetodos1$Metodos = rowMeans(DataMetodos1[,2:6],na.rm = TRUE)
DataMetodos1= DataMetodos1[,c (1,7)]
DataMetodos1 = DataMetodos1[complete.cases(DataMetodos1),]
row.names(DataMetodos1) = NULL
##SEGUNDA HIPOTESIS: AUMENTO DEL NIVEL DE CALIDAD DE VIDA
##POBLACIÓN QUE VIVE EN BARRIOS DE TUGURIOS
link5="https://docs.google.com/spreadsheets/d/e/2PACX-1vQnghOacrnZH200jpcJc-Vym7n8rrfuQlupJ470spsBTvZ0WUWvl63x2AYL1W92sw/pub?gid=1538383881&single=true&output=csv"
DataTugurios= read.csv(link5, stringsAsFactors = F)
DataTugurios1 = DataTugurios[,c(1,48:52)]
names(DataTugurios1) = c("Pais","2003","2004","2005", "2006", "2007")
DataTugurios1$`2003` = gsub("\\,", ".", DataTugurios1$`2003`)
DataTugurios1$`2004` = gsub("\\,", ".", DataTugurios1$`2004`)
DataTugurios1$`2005` = gsub("\\,", ".", DataTugurios1$`2005`)
DataTugurios1$`2006` = gsub("\\,", ".", DataTugurios1$`2006`)
DataTugurios1$`2007` = gsub("\\,", ".", DataTugurios1$`2007`)
DataTugurios1[,c(2:6)]=lapply(DataTugurios1[,c(2:6)],as.numeric)
DataTugurios1$BarriosTugurios = rowMeans(DataTugurios1[,2:6],na.rm = TRUE)
DataTugurios1= DataTugurios1[,c (1,7)]
DataTugurios1 = DataTugurios1[complete.cases(DataTugurios1),]
row.names(DataTugurios1) = NULL
##ALFABETIZACIÓN
LINK11="https://docs.google.com/spreadsheets/d/e/2PACX-1vTTojodRJwkAu-98fKnnuzUCJZE-Wj4tDFm7F2XQLDeT3CSifu-yWiHZuZv-uzL2Q/pub?gid=1142139153&single=true&output=csv"
EDU=read.csv(LINK11,stringsAsFactors = F)
EDU1=EDU[,-c(2:47)]
names(EDU1)=c("Pais","2003","2004","2005","2006","2007","2008","2009","2010","2011","2012","2013","2014","2015","2016","2017","2018")
#Para eliminar simbolos DATA COMPLETA
EDU1$`2003`= gsub("\\,", ".",EDU1$`2003`)
EDU1$`2004`= gsub("\\,", ".",EDU1$`2004`)
EDU1$`2005`= gsub("\\,", ".",EDU1$`2005`)
EDU1$`2006`= gsub("\\,", ".",EDU1$`2006`)
EDU1$`2007`= gsub("\\,", ".",EDU1$`2007`)
EDU1$`2008`= gsub("\\,", ".",EDU1$`2008`)
EDU1$`2009`= gsub("\\,", ".",EDU1$`2009`)
EDU1$`2010`= gsub("\\,", ".",EDU1$`2010`)
EDU1$`2011`= gsub("\\,", ".",EDU1$`2011`)
EDU1$`2012`= gsub("\\,", ".",EDU1$`2012`)
EDU1[c(2:11)] = lapply(EDU1[c(2:11)], as.numeric)
EDU2=EDU1[,c(1:6)]
EDU2$'EDU1' = rowMeans(EDU2[,2:6], na.rm = TRUE)
EDU2=EDU2[,c(1,7)]
EDU2=EDU2[complete.cases(EDU2),]
row.names(EDU2)=NULL #2003 al2007
##ACCESO A LA ELECTRICIDAD
LINK12="https://docs.google.com/spreadsheets/d/e/2PACX-1vQrlQtEYBGaf0IhPz_H9oaM8uD1UaVoR1J_xP6bYe8ZqNAVSRJiLh4DXq52KomGsQ/pub?gid=2059415238&single=true&output=csv"
ENER=read.csv(LINK12,stringsAsFactors = F)
ENER1=ENER[,-c(2:47)]
names(ENER1)=c("Pais","2003","2004","2005","2006","2007","2008","2009","2010","2011","2012","2013","2014","2015","2016","2017","2018")
#Para eliminar simbolos
ENER1$`2003`= gsub("\\,", ".",ENER1$`2003`)
ENER1$`2004`= gsub("\\,", ".",ENER1$`2004`)
ENER1$`2005`= gsub("\\,", ".",ENER1$`2005`)
ENER1$`2006`= gsub("\\,", ".",ENER1$`2006`)
ENER1$`2007`= gsub("\\,", ".",ENER1$`2007`)
ENER1$`2008`= gsub("\\,", ".",ENER1$`2008`)
ENER1$`2009`= gsub("\\,", ".",ENER1$`2009`)
ENER1$`2010`= gsub("\\,", ".",ENER1$`2010`)
ENER1$`2011`= gsub("\\,", ".",ENER1$`2011`)
ENER1$`2012`= gsub("\\,", ".",ENER1$`2012`)
ENER1[c(2:11)] = lapply(ENER1[c(2:11)], as.numeric)
ENER2=ENER1[,c(1:6)]
ENER2$'ENER1' = rowMeans(ENER2[,2:6], na.rm = TRUE)
ENER2=ENER2[,c(1,7)]
ENER2=ENER2[complete.cases(ENER2),]
row.names(ENER2)=NULL #2003 al 2007
##ESPERANZA DE VIDA MUJERES
link23="https://docs.google.com/spreadsheets/d/e/2PACX-1vQoWu6HPrX8qbiqsewwImM89BxWol-bI-b_ubT6v_hxbPG9JTxXFxaxX5nUJTm-bg/pub?gid=72965045&single=true&output=csv"
EspVida=read.csv(link23, stringsAsFactors = F)
#la esperanza de vida entre 2003 al 2007
EspVida1=EspVida[,c(1,48:52)]
names(EspVida1) = c("Pais","2003","2004","2005", "2006", "2007")
EspVida1$`2003` = gsub("\\,", ".", EspVida1$`2003`)
EspVida1$`2004` = gsub("\\,", ".", EspVida1$`2004`)
EspVida1$`2005` = gsub("\\,", ".", EspVida1$`2005`)
EspVida1$`2006` = gsub("\\,", ".", EspVida1$`2006`)
EspVida1$`2007` = gsub("\\,", ".", EspVida1$`2007`)
EspVida1[,c(2:6)]=lapply(EspVida1[,c(2:6)],as.numeric) #volver numerico en grupo
EspVida1$VidaM = rowMeans(EspVida1[,2:6], na.rm = TRUE)
EspVida1= EspVida1[,c (1,7)]
EspVida1 = EspVida1[complete.cases(EspVida1),]
row.names(EspVida1) = NULL
##COBERTURA DEL TRATAMIENTO ANTIRRETROVIRAL
link22="https://docs.google.com/spreadsheets/d/e/2PACX-1vQ7mf0BRsmhcre-RKQseWRY_aGZrVve25Wmmm85m4OMF2Eb8_NyqGhDjrRmePcuWg/pub?gid=26033417&single=true&output=csv"
antiRetrov=read.csv(link22, stringsAsFactors = F)
#la cobertura entre 2003 al 2007
antiRetrov1=antiRetrov[,c(1,48:52)]
names(antiRetrov1) = c("Pais","2003","2004","2005", "2006", "2007")
antiRetrov1[,c(2:6)]=lapply(antiRetrov1[,c(2:6)],as.numeric) #volver numerico en grupo## Warning in lapply(antiRetrov1[, c(2:6)], as.numeric): NAs introduced by
## coercion
## Warning in lapply(antiRetrov1[, c(2:6)], as.numeric): NAs introduced by
## coercion
## Warning in lapply(antiRetrov1[, c(2:6)], as.numeric): NAs introduced by
## coercion
## Warning in lapply(antiRetrov1[, c(2:6)], as.numeric): NAs introduced by
## coercion
## Warning in lapply(antiRetrov1[, c(2:6)], as.numeric): NAs introduced by
## coercionantiRetrov1$CobARet = rowMeans(antiRetrov1[,2:6], na.rm = TRUE)
antiRetrov1= antiRetrov1[,c (1,7)]
antiRetrov1 = antiRetrov1[complete.cases(antiRetrov1),]
row.names(antiRetrov1) = NULL
## INDICE DE GINI
link6="https://docs.google.com/spreadsheets/d/e/2PACX-1vSOdz-vUkw9_yctGztLL_PS87cCS7GoU10PiLA3ywnO8-iNXG1OBi_8OBOpZ0r3AQ/pub?gid=826191890&single=true&output=csv"
DataGini= read.csv(link6, stringsAsFactors = F)
DataGini1 = DataGini[,c(1,48:52)]
names(DataGini1) = c("Pais","2003","2004","2005", "2006", "2007")
DataGini1$`2003` = gsub("\\,", ".", DataGini1$`2003`)
DataGini1$`2004` = gsub("\\,", ".", DataGini1$`2004`)
DataGini1$`2005` = gsub("\\,", ".", DataGini1$`2005`)
DataGini1$`2006` = gsub("\\,", ".", DataGini1$`2006`)
DataGini1$`2007` = gsub("\\,", ".", DataGini1$`2007`)
DataGini1[,c(2:6)]=lapply(DataGini1[,c(2:6)],as.numeric)
DataGini1$Gini = rowMeans(DataGini1[,2:6],na.rm = TRUE)
DataGini1= DataGini1[,c (1,7)]
DataGini1= DataGini1[complete.cases(DataGini1),]
row.names(DataGini1) = NULL
#HIPOTESIS 3: MAYOR MOVILIDAD SOCIAL Y TECNOLOGICA
##GASTO EN INVESTIGACIÓN Y DESARROLLO
LINK13="https://docs.google.com/spreadsheets/d/e/2PACX-1vQ6hJgrir9ZBg6Qo5dfwQGluWp4oZLEfSVgz-sVzHEqav1pulMwix_2jNcjxcCkjw/pub?gid=1845220649&single=true&output=csv"
GAST=read.csv(LINK13,stringsAsFactors = F)
GAST1=GAST[,-c(2:47)]
names(GAST1)=c("Pais","2003","2004","2005","2006","2007","2008","2009","2010","2011","2012","2013","2014","2015","2016","2017","2018")
#Para eliminar simbolos
GAST1$`2003`= gsub("\\,", ".",GAST1$`2003`)
GAST1$`2004`= gsub("\\,", ".",GAST1$`2004`)
GAST1$`2005`= gsub("\\,", ".",GAST1$`2005`)
GAST1$`2006`= gsub("\\,", ".",GAST1$`2006`)
GAST1$`2007`= gsub("\\,", ".",GAST1$`2007`)
GAST1$`2008`= gsub("\\,", ".",GAST1$`2008`)
GAST1$`2009`= gsub("\\,", ".",GAST1$`2009`)
GAST1$`2010`= gsub("\\,", ".",GAST1$`2010`)
GAST1$`2011`= gsub("\\,", ".",GAST1$`2011`)
GAST1$`2012`= gsub("\\,", ".",GAST1$`2012`)
GAST1[c(2:11)] = lapply(GAST1[c(2:11)], as.numeric)
GAST2=GAST1[,c(1:6)]
GAST2$'GAST1' = rowMeans(GAST2[,2:6], na.rm = TRUE)
GAST2=GAST2[,c(1,7)]
GAST2=GAST2[complete.cases(GAST2),]
row.names(GAST2)=NULL
##SUSCRIPCION A BANDA ANCHA
LINK17="https://docs.google.com/spreadsheets/d/e/2PACX-1vTJo2T8oxMssc3utiol3H4IZDOw4jq1sNu12vGh4LUz2aZU-BTtDvkhDaESiIwCJQ/pub?gid=508597872&single=true&output=csv"
ban=read.csv(LINK17,stringsAsFactors = F)
ban=ban[,-c(2:47)]
names(ban)=c("Pais","2003","2004","2005","2006","2007","2008","2009","2010","2011","2012","2013","2014","2015","2016","2017","2018")
ban$`2003`= gsub("\\,", ".",ban$`2003`)
ban$`2004`= gsub("\\,", ".",ban$`2004`)
ban$`2005`= gsub("\\,", ".",ban$`2005`)
ban$`2006`= gsub("\\,", ".",ban$`2006`)
ban$`2007`= gsub("\\,", ".",ban$`2007`)
ban$`2008`= gsub("\\,", ".",ban$`2008`)
ban$`2009`= gsub("\\,", ".",ban$`2009`)
ban$`2010`= gsub("\\,", ".",ban$`2010`)
ban$`2011`= gsub("\\,", ".",ban$`2011`)
ban$`2012`= gsub("\\,", ".",ban$`2012`)
ban[c(2:11)] = lapply(ban[c(2:11)], as.numeric)
ban2=ban[,c(1:6)]
ban2$'ban1' = rowMeans(ban2[,2:6], na.rm = TRUE)
ban2=ban2[,c(1,7)]
ban2=ban2[complete.cases(ban2),]
row.names(ban2)=NULL
##MIGRACION NETA
link25="https://docs.google.com/spreadsheets/d/e/2PACX-1vSri2T-73zRzhVczOzNqkAKmQ_qLcWrQHzuVl7QIFUE7fJRUbtKoDCeJ1zixpCjRA/pub?gid=1968467072&single=true&output=csv"
neta=read.csv(link25, stringsAsFactors = F)
#la migracion entre 2003 al 2007
migra1=neta[,c(1,52)]
names(migra1) = c("Pais","Migracion")
migra1 = migra1[complete.cases(migra1),]
row.names(migra1) = NULL
migra1[,c(2)]=as.numeric(migra1[,c(2)]) #volver numericoDado que nuestro trabajo tiene 2 periodos de tiempo, la limpieza de datas es del primer periodo del chunk “data1”.
Para responder a la primera pregunta realizare un merge (sin la variable dependiente).
Debido a los casos que perderiamos, por no estar completas las 12 variables, hemos decidido imputar con la media. Sin embargo se han eliminado islas que no tienen suficiente informacion antes de imputar con la media a las columnas.
factorial1=merge(DataAct1,DataFLM1,all.x=T,all.y=T)
factorial1=merge(factorial1,DataMetodos1,all.x=T,all.y=T)
factorial1=merge(factorial1,EDU2,all.x=T,all.y=T)
factorial1=merge(factorial1,ENER2,all.x=T,all.y=T)
factorial1=merge(factorial1,DataTugurios1,all.x=T,all.y=T)
factorial1=merge(factorial1,EspVida1,all.x=T,all.y=T)
factorial1=merge(factorial1,antiRetrov1,all.x=T,all.y=T)
factorial1=merge(factorial1,DataGini1,all.x=T,all.y=T)
factorial1=merge(factorial1,GAST2,all.x=T,all.y=T)
factorial1=merge(factorial1,ban2,all.x=T,all.y=T)
factorial1=merge(factorial1,migra1,all.x=T,all.y=T)
factorial1=factorial1[-grep("San|high|Pacific|French|Caribbean|Early|Late|Island|Small|West|Sint|Other|OECD|North|World|Euro|Latin|Upper|High|Heavily|IBR|IDA|Least|Low|Middle|East|Central|Fragile|Post|Pre",factorial1$Pais),] #buscar y eliminar
row.names(factorial1)=NULL
factorial1=factorial1[-c(4,5,10,14,22,28,42,44,52,15,28,47,70,72,74,89,104,109,122,124,134,144,160,163,171:173),] #eliminar
row.names(factorial1)=NULL
factorial1[is.na(factorial1$FLM), "FLM"]=mean(factorial1$FLM, na.rm=T)
factorial1[is.na(factorial1$PoblacionActiva), "PoblacionActiva"]=mean(factorial1$PoblacionActiva, na.rm=T)
factorial1[is.na(factorial1$Metodos), "Metodos"]=mean(factorial1$Metodos, na.rm=T)
factorial1[is.na(factorial1$EDU1), "EDU1"]=mean(factorial1$EDU1, na.rm=T)
factorial1[is.na(factorial1$ENER1), "ENER1"]=mean(factorial1$ENER1, na.rm=T)
factorial1[is.na(factorial1$BarriosTugurios), "BarriosTugurios"]=mean(factorial1$BarriosTugurios, na.rm=T)
factorial1[is.na(factorial1$VidaM), "VidaM"]=mean(factorial1$VidaM, na.rm=T)
factorial1[is.na(factorial1$CobARet), "CobARet"]=mean(factorial1$CobARet, na.rm=T)
factorial1[is.na(factorial1$Gini), "Gini"]=mean(factorial1$Gini, na.rm=T)
factorial1[is.na(factorial1$GAST1), "GAST1"]=mean(factorial1$GAST1, na.rm=T)
factorial1[is.na(factorial1$ban1), "ban1"]=mean(factorial1$ban1, na.rm=T)
factorial1[is.na(factorial1$Migracion), "Migracion"]=mean(factorial1$Migracion, na.rm=T)
row.names(factorial1)=NULLTenemos 2 variables contraintuitivas que la pasaremos a intuitivas:
factorial1[which.max(factorial1$Gini),]factorial1[which.max(factorial1$BarriosTugurios),]#Ponemos las variables en forma intuitiva restando con el mayor valor
factorial1$BarriosTugurios= 97 - factorial1$BarriosTugurios
factorial1$Gini= 64.8 - factorial1$Gini#PREGUNTA 1
ANALISIS FACTORIAL DE 12 VARIABLES
factorial2=factorial1
row.names(factorial2) = factorial2$Pais
factorial2=factorial2[-c(1)]
factorial2=as.data.frame(scale(factorial2[,c(1:12)]))
head(factorial2)En el merge anterior (al juntar las variables independientes) se estandarizo la data factorial2 para usarla en esta pregunta. Ademas, se han usado las variables simples, ninguna de estas variables son algun score.
library(psych)
#test de bartlett
cortest.bartlett(factorial2, n=nrow(factorial2))## R was not square, finding R from data## $chisq
## [1] 1169.816
##
## $p.value
## [1] 1.345082e-201
##
## $df
## [1] 66#correlacion de una data
pearson=cor(factorial2)
#matriz de correlación
cor.plot(pearson,
numbers=T,
upper=FALSE,
main = "Correlation",
show.legend = FALSE)
INTERPRETACIÓN: -Segun la prueba de esfericidad de Bartlett por el p-value puedo rechazar la hipotesis nula con lo cual se que mi matriz de correlacion no es igual a mi matriz de identidad; comprobando que hacer analisis factorial tiene sentido.
-Segun el grafico de la matriz de correlacion observo visualmente que efectivamente esta matriz no es igual a la matriz de identidad. Ademas observo que tengo algunas variables que no estan muy correlacionadas con las otras
##el KMO es un estimador, admite una representación gráfica por medio de una función escalonada.
#que tan apropiado es que se junten las variables, más cercano a 1 mejor
KMO(factorial2) ## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = factorial2)
## Overall MSA = 0.78
## MSA for each item =
## PoblacionActiva FLM Metodos EDU1
## 0.65 0.66 0.87 0.90
## ENER1 BarriosTugurios VidaM CobARet
## 0.79 0.89 0.82 0.93
## Gini GAST1 ban1 Migracion
## 0.66 0.71 0.71 0.71INTERPRETACION: El MSA general es 0.78 (cercano a 1) lo que me indica que en general si es apropiado que junte mis variables.
La variable con menor valor en su MSA es PoblacionActiva con 0.65 le sigue Gini con 0.66 con lo cual el KMO me dice que posiblemente sean las que menos se acomoden “apropiadamente” cuando junte mis variables
fa.parallel(pearson,fm="pa", fa="fa",main = "Scree Plot", n.obs = nrow(factorial2))
## Parallel analysis suggests that the number of factors = 3 and the number of components = NAEl scree plot me dice el numero de factores en los que debo dividir este analisis factorial es 3.
#sustenta que las variables están correlacionadas; mira como se juntan mis variables y el puntaje alternativo que me da
#creo el objeto para el factorial
factorial2_sF <- fa(factorial2, #de donde esta la data
nfactors=3, #numero de dimensiones
rotate="varimax"
)
#puedes ver que variables pertenecen a un mismo grupo
factorial2_sF$loadings ##
## Loadings:
## MR1 MR3 MR2
## PoblacionActiva -0.205 0.919
## FLM -0.186 0.816
## Metodos 0.752 0.166
## EDU1 0.718
## ENER1 0.814 0.335 -0.293
## BarriosTugurios 0.654 -0.117 -0.269
## VidaM 0.768 0.495 -0.177
## CobARet 0.358 0.446
## Gini -0.112 0.535 -0.142
## GAST1 0.740 0.143
## ban1 0.192 0.887 0.192
## Migracion 0.150 0.187 0.156
##
## MR1 MR3 MR2
## SS loadings 3.043 2.263 1.803
## Proportion Var 0.254 0.189 0.150
## Cumulative Var 0.254 0.442 0.592El objeto factorial2_sF recoge los resultados de mi analisis factorial
Puedo observar que con 3 divisiones se ha recogido el 59.2% de la informacion que tenian mis 12 variables
#observa las dimensiones en los que estan separando
fa.diagram(factorial2_sF) 
Visualmente puedo observar como se juntan mis variables en 3 grupos segun cuanto se parecen estas variables entre si.
El primer grupo (MR1) seria ENER1, Metodos, VidaM, EDU1, BarriosTugurios El segundo grupo (MR3) seria ban1, GAST1, Gini, CobARet El tercer grupo (MR2) seria Poblacion Activa y FLM
Este resultado segun nuestro plan de trabajo tiene algunos exitos: -El MR2 es correcto a nuestro plan de crear un puntaje que represente el empoderamiento para la primera hipotesis -En el MR1 tanto EDU1, ENER1 y BarriosTugurios serian un indice de densidad estatal para la segunda hipotesis -En el MR3 ban1 y GAST1 serian un indice para formar la variable acceso a la informacion para la hipotesis 3
-El resto de variables iban a ir “solas” para el resto de las hipotesis: Gini, Metodos, Migracion, VidaM, CobARetrov.
NOTA: al inicio queriamos juntar VidaM (esperanza de vida de la mujer) con CobARetrov (cobertura del tratamiento antirretroviral) pero al hacer el analisis factorial descubrimos que no era apropiado
# mientras mas grande mejor (esta aportando al AF)
#esta contribuyendo, aunque no te esta diciendo con cual se va (si es correcto con cual se esta yendo)
sort(factorial2_sF$communalities)## Migracion Gini CobARet BarriosTugurios
## 0.0815926 0.3190099 0.3281595 0.5135866
## EDU1 GAST1 Metodos FLM
## 0.5202725 0.5722523 0.5934867 0.7050810
## ban1 ENER1 VidaM PoblacionActiva
## 0.8608920 0.8615418 0.8657544 0.8864326En general al analisis quienes mas estan aportando son: PoblacionActiva,VidaM,ENER1 y ban1 (en ese orden)
# mientras menor sea mejor
#mas grande peor (lo que mantiene)
sort(factorial2_sF$uniquenesses)## PoblacionActiva VidaM ENER1 ban1
## 0.1135680 0.1342456 0.1384579 0.1391077
## FLM Metodos GAST1 EDU1
## 0.2949195 0.4065133 0.4277475 0.4797271
## BarriosTugurios CobARet Gini Migracion
## 0.4864134 0.6718391 0.6809903 0.9184074En general quienes menos aportan son: Migracion, Gini y CobARet (en ese orden)
# cercania a factores
#mientras mas se acerca a 1 mejor porque te esta diciendo que solo se va a 1 dimension y que no esta coquetenado con otra
sort(factorial2_sF$complexity)## EDU1 GAST1 Metodos PoblacionActiva
## 1.018643 1.090942 1.097440 1.099530
## FLM ban1 Gini BarriosTugurios
## 1.118225 1.190821 1.233128 1.402618
## ENER1 VidaM CobARet Migracion
## 1.614685 1.834713 1.919940 2.882015No sabemos exactamente a que grupos se estan juntando Migracion y CobARetrov (con cierta duda), pero estamos seguros que va a mas de 1 (al menos Migracion esta posiblemente aportando a mas de 1 grupo)
#PREGUNTA 1 Parte 2
CONGLOMERADOS
Con k-means informo que deseo organizar los casos en 3 centroides. Elijo el numero 3 porque fue el resultado del analisis factorial y curiosamente concuerda con el numero de hipotesis en este trabajo
set.seed(2)
# KMEANS numero de centroides
factorial_clus=kmeans(factorial2,centers = 3) #uso factorial2 o
#visualizo los centroides
factorial_clus$cluster## Afghanistan Albania
## 3 2
## Algeria Angola
## 2 3
## Antigua and Barbuda Argentina
## 2 2
## Armenia Australia
## 2 1
## Austria Azerbaijan
## 1 2
## Bangladesh Barbados
## 2 1
## Belarus Belgium
## 2 1
## Belize Benin
## 2 3
## Bhutan Bolivia
## 3 2
## Bosnia and Herzegovina Botswana
## 2 3
## Brazil Bulgaria
## 2 2
## Burkina Faso Burundi
## 3 3
## Cabo Verde Cambodia
## 2 3
## Cameroon Canada
## 3 1
## Chad Chile
## 3 2
## China Colombia
## 2 2
## Comoros Congo, Dem. Rep.
## 2 3
## Costa Rica Croatia
## 2 2
## Cuba Cyprus
## 2 2
## Czech Republic Denmark
## 1 1
## Djibouti Dominican Republic
## 3 2
## Ecuador Egypt, Arab Rep.
## 2 2
## El Salvador Equatorial Guinea
## 2 3
## Eritrea Estonia
## 3 1
## Eswatini Ethiopia
## 3 3
## Fiji Finland
## 2 1
## France Gabon
## 1 2
## Gambia, The Georgia
## 3 2
## Germany Ghana
## 1 3
## Greece Grenada
## 2 2
## Guatemala Guinea
## 2 3
## Guinea-Bissau Guyana
## 3 2
## Haiti Honduras
## 3 2
## Hong Kong SAR, China Hungary
## 1 2
## Iceland India
## 1 2
## Indonesia Iran, Islamic Rep.
## 2 2
## Iraq Ireland
## 2 1
## Israel Italy
## 1 1
## Jamaica Japan
## 2 1
## Jordan Kazakhstan
## 2 2
## Kenya Kiribati
## 3 2
## Korea, Dem. People’s Rep. Korea, Rep.
## 3 1
## Kosovo Kuwait
## 2 2
## Kyrgyz Republic Lao PDR
## 2 3
## Lebanon Lesotho
## 2 3
## Liberia Libya
## 3 2
## Lithuania Luxembourg
## 2 1
## Macao SAR, China Madagascar
## 2 3
## Malawi Malaysia
## 3 2
## Maldives Mali
## 2 3
## Malta Mauritania
## 2 3
## Mauritius Mexico
## 2 2
## Moldova Mongolia
## 2 2
## Montenegro Morocco
## 2 2
## Mozambique Myanmar
## 3 3
## Namibia Nauru
## 2 2
## Nepal Netherlands
## 3 1
## New Zealand Nicaragua
## 1 2
## Niger Nigeria
## 3 3
## Norway Oman
## 1 2
## Pakistan Palau
## 2 2
## Panama Paraguay
## 2 2
## Peru Philippines
## 2 2
## Poland Portugal
## 2 1
## Puerto Rico Qatar
## 2 2
## Romania Russian Federation
## 2 2
## Rwanda Samoa
## 3 2
## Sao Tome and Principe Saudi Arabia
## 2 2
## Senegal Serbia
## 3 2
## Sierra Leone Singapore
## 3 1
## Slovenia Somalia
## 1 3
## South Africa South Asia
## 2 2
## South Sudan Spain
## 3 1
## Sri Lanka Sub-Saharan Africa
## 2 3
## Sudan Suriname
## 3 2
## Sweden Switzerland
## 1 1
## Syrian Arab Republic Tajikistan
## 2 2
## Tanzania Thailand
## 3 2
## Timor-Leste Togo
## 3 3
## Tonga Trinidad and Tobago
## 2 2
## Tunisia Turkey
## 2 2
## Turkmenistan Tuvalu
## 2 2
## Uganda Ukraine
## 3 2
## United Arab Emirates United Kingdom
## 2 1
## United States Uruguay
## 1 2
## Uzbekistan Vanuatu
## 2 3
## Venezuela, RB Vietnam
## 2 2
## Yemen, Rep. Zambia
## 2 3
## Zimbabwe
## 3#cuantos casos tiene cada centroide
table(factorial_clus$cluster)##
## 1 2 3
## 30 98 49Tenemos organzado los casos en 3 grupos. La caracteristica de la clusterizacion es que forman grupos que se parezcan mucho y que al mismo tiempo se diferencien mucho.
Traemos un mapa: https://app.box.com/s/r7w52vsp44xmil8dwn307yf4raqoeusy
#HAGAMOS EL MAPA
library(rgdal)## Loading required package: sp## rgdal: version: 1.4-4, (SVN revision 833)
## Geospatial Data Abstraction Library extensions to R successfully loaded
## Loaded GDAL runtime: GDAL 2.1.3, released 2017/20/01
## Path to GDAL shared files: /usr/share/gdal/2.1
## GDAL binary built with GEOS: TRUE
## Loaded PROJ.4 runtime: Rel. 4.9.2, 08 September 2015, [PJ_VERSION: 492]
## Path to PROJ.4 shared files: (autodetected)
## Linking to sp version: 1.3-1folderMap='MapaMundo'
fileName='world_map.shp'
fileToRead=file.path(folderMap,fileName)
library(rgdal)
mundoMap = readOGR(fileToRead,stringsAsFactors=FALSE)## OGR data source with driver: ESRI Shapefile
## Source: "/cloud/project/MapaMundo/world_map.shp", layer: "world_map"
## with 246 features
## It has 11 fields
## Integer64 fields read as strings: POP2005#dibujo los bordes del mapa
plot(mundoMap, border='grey')
#guardemos la info de los cluster en una data
countryClus=as.data.frame(factorial_clus$cluster)
countryClusnames(countryClus)='cluster'
countryClus$NAME=row.names(countryClus)
head(countryClus)#juntemos esta info con el mapa
mundoMap_factorial=merge(mundoMap,countryClus)
# colores
myColors=rainbow(5)
#visualicemos el mapa en 5 colores
plot(mundoMap,col='grey',border=NA)
plot(mundoMap_factorial,col=myColors[mundoMap_factorial$cluster],main='Grupos',border=NA,add=T)
#PREGUNTA 2
MODELO DE REGRESION
Para explicar la prevalencia del VIH utilizare una regresion beta. Me interesa saber en que medida las variables de mis hipotesis explican la prevalencia del VIH en el mundo. Es una regresion beta porque la prevalencia del VIH (es decir la variable dependiente) fue medida en porcentaje y por eso se la modela como proporcion de manera acotada (de 0 a 1)
Pero esta regresion no se hara con las 12 variables de la data factorial1 sino que usare las variables unidas en un puntaje que tenia mi trabajo segun las 3 hipotesis.
Asi empezaremos a usar lo del primer chunk: Data1, y tambien incluiremos las variables de control del trabajo.
##para la H1
EMPODERAMIENTO (DataAct, DataFLM)
Act1FLM1_X=merge(DataAct1,DataFLM1,all.x=T,all.y=T)
Act1FLM1=merge(DataAct1,DataFLM1,all.x=T,all.y=T)
#paises al indice para el analisis factorial
row.names(Act1FLM1) = Act1FLM1$Pais
Act1FLM1$Pais = NULL
#imputamos
Act1FLM1[is.na(Act1FLM1$PoblacionActiva), "PoblacionActiva"]=mean(Act1FLM1$PoblacionActiva, na.rm=T)
Act1FLM1[is.na(Act1FLM1$FLM), "FLM"]=mean(Act1FLM1$FLM, na.rm=T)
#creamos y estandarizamos la data con las variables que componen "Empoderamiento"
Act1FLM1=as.data.frame(scale(Act1FLM1[,c(1,2)]))
head(Act1FLM1)library(psych)
pearson1 = cor(Act1FLM1) #sacar la correlación de los puntajes estandarizadas
cor.plot(pearson1,
numbers=T,
upper=FALSE,
main = "Correlation",
show.legend = FALSE) #verlo en un gráfico
La matriz de correlacion es diferente de la matriz de identidad.
KMO(Act1FLM1)## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = Act1FLM1)
## Overall MSA = 0.5
## MSA for each item =
## PoblacionActiva FLM
## 0.5 0.5Act1FLM1 = fa(Act1FLM1,
nfactors=1,
rotate="varimax") #codigo para el analisis factorial solo cambiar la data y el numero de factores
Act1FLM1$loadings##
## Loadings:
## MR1
## PoblacionActiva 0.887
## FLM 0.887
##
## MR1
## SS loadings 1.574
## Proportion Var 0.787Ha recogido el 78.7% de la informacion de mis variables
Act1FLM1$scores## MR1
## Afghanistan -0.218081911
## Albania -0.747419191
## Algeria -1.224632385
## Angola 1.296292143
## Arab World -1.979997621
## Argentina 0.004582650
## Armenia -0.310238745
## Aruba 0.367840847
## Australia 0.498514225
## Austria 0.105783795
## Azerbaijan 0.302854548
## Bahamas, The 0.623402726
## Bahrain -0.853641697
## Bangladesh -1.472732756
## Barbados 0.960750286
## Belarus 0.329622731
## Belgium -0.306988194
## Belize -0.867062954
## Benin 1.580277249
## Bhutan 0.567385718
## Bolivia 0.743099218
## Bosnia and Herzegovina -1.034565215
## Botswana 0.336834077
## Brazil 0.394759215
## Brunei Darussalam 0.195202744
## Bulgaria -0.243377536
## Burkina Faso 1.389544683
## Burundi 1.045368902
## Cabo Verde 0.136991681
## Cambodia 1.808782549
## Cameroon 1.760772259
## Canada 0.819332764
## Caribbean small states 0.072862091
## Cayman Islands 1.053765461
## Central African Republic 0.509861315
## Central Europe and the Baltics -0.125440772
## Chad 0.448841779
## Channel Islands 0.001251200
## Chile -0.593441335
## China 0.546450719
## Colombia 0.227261289
## Comoros -1.114769780
## Congo, Dem. Rep. 1.415986742
## Congo, Rep. 1.166573364
## Costa Rica -0.397352481
## Cote d'Ivoire -0.061868183
## Croatia -0.336865361
## Cuba -0.959734638
## Cyprus 0.310985908
## Czech Republic 0.069977696
## Denmark 0.739197542
## Djibouti -0.037241149
## Dominican Republic -0.655151160
## Early-demographic dividend -0.865927088
## East Asia & Pacific 0.386330446
## East Asia & Pacific (excluding high income) 0.442014163
## East Asia & Pacific (IDA & IBRD countries) 0.436908551
## Ecuador 0.176081095
## Egypt, Arab Rep. -2.005033677
## El Salvador -0.264923711
## Equatorial Guinea 0.060289066
## Eritrea 0.744175438
## Estonia 0.277800750
## Eswatini -0.498152426
## Ethiopia 1.679320454
## Euro area -0.106349196
## Europe & Central Asia -0.006807899
## Europe & Central Asia (excluding high income) -0.001337942
## Europe & Central Asia (IDA & IBRD countries) -0.019361503
## European Union -0.039837413
## Fiji -0.946866807
## Finland 0.515624322
## Fragile and conflict affected situations -0.034553476
## France 0.052207623
## French Polynesia -0.151777904
## Gabon -0.271022288
## Gambia, The -0.054741891
## Georgia 0.411265626
## Germany 0.092597943
## Ghana 1.324422734
## Greece -0.488210709
## Guam 0.340044186
## Guatemala -0.378624796
## Guinea 0.416189510
## Guinea-Bissau 0.491520630
## Guyana -0.513258095
## Haiti 0.195356957
## Heavily indebted poor countries (HIPC) 0.485561463
## High income 0.149685853
## Honduras -0.589130873
## Hong Kong SAR, China 0.171289897
## Hungary -0.456806438
## IBRD only -0.023631135
## Iceland 1.693784620
## IDA & IBRD total -0.018782865
## IDA blend -0.806941564
## IDA only 0.161754091
## IDA total 0.001778396
## India -1.185765411
## Indonesia -0.162841980
## Iran, Islamic Rep. -2.112360416
## Iraq -2.536029376
## Ireland 0.238920337
## Isle of Man 0.256001551
## Israel 0.377123027
## Italy -0.782635384
## Jamaica 0.421407379
## Japan -0.072704909
## Jordan -2.490151045
## Kazakhstan 1.027408228
## Kenya 0.735505219
## Kiribati -0.985310951
## Korea, Dem. People’s Rep. 0.830878402
## Korea, Rep. 0.034976626
## Kosovo -0.698268280
## Kuwait 0.046047582
## Kyrgyz Republic 0.300847727
## Lao PDR 1.999875482
## Late-demographic dividend 0.388485135
## Latin America & Caribbean 0.041142445
## Latin America & Caribbean (excluding high income) 0.075280389
## Latin America & the Caribbean (IDA & IBRD countries) 0.065569377
## Latvia 0.128623266
## Least developed countries: UN classification 0.216709160
## Lebanon -1.946961775
## Lesotho -0.137693307
## Liberia 0.765510910
## Libya -0.941884570
## Liechtenstein 0.141807689
## Lithuania 0.134496532
## Low & middle income -0.014293141
## Low income 0.508704767
## Lower middle income -0.818704121
## Luxembourg -0.227072385
## Macao SAR, China 0.539375369
## Madagascar 2.273801315
## Malawi 1.975846557
## Malaysia -0.280719425
## Maldives -0.319897128
## Mali 0.730988288
## Malta -1.298600132
## Mauritania -0.703685818
## Mauritius -0.575270084
## Mexico -0.573230839
## Middle East & North Africa -1.975443501
## Middle East & North Africa (excluding high income) -2.028850299
## Middle East & North Africa (IDA & IBRD countries) -2.025291777
## Middle income -0.060565269
## Moldova -0.238247760
## Mongolia 0.432687495
## Montenegro -0.414569055
## Morocco -1.568033163
## Mozambique 2.542142687
## Myanmar 0.199796113
## Namibia -0.249277877
## Nepal 2.538850436
## Netherlands 0.521080833
## New Caledonia 0.334361949
## New Zealand 0.725181542
## Nicaragua -0.361433382
## Niger 0.251317114
## Nigeria -0.091427247
## North America 0.648117672
## North Macedonia -0.468344263
## Northern Mariana Islands 1.125439692
## Norway 1.054652072
## OECD members 0.039050741
## Oman -1.671541746
## Other small states -0.024994858
## Pacific island small states -0.169651496
## Pakistan -2.086227681
## Palau 0.321096783
## Panama -0.182764593
## Papua New Guinea 0.305338522
## Paraguay 0.319355648
## Peru 0.900286201
## Philippines -0.147202953
## Poland -0.151082728
## Portugal 0.382453534
## Post-demographic dividend 0.202798162
## Pre-demographic dividend 0.260775226
## Puerto Rico -0.831745121
## Qatar -0.272388758
## Romania -0.120953027
## Russian Federation 0.597349047
## Rwanda 2.350623422
## Samoa -1.374880549
## San Marino 0.172208561
## Sao Tome and Principe -1.019860577
## Saudi Arabia -2.129877574
## Senegal -1.054152738
## Serbia -0.308830749
## Sierra Leone 1.023502680
## Singapore 0.186636237
## Slovak Republic 0.138050914
## Slovenia 0.203810232
## Small states -0.010767330
## Solomon Islands 0.444523960
## Somalia -1.074265326
## South Africa -0.416041508
## South Asia -1.199783982
## South Asia (IDA & IBRD) -1.199783982
## South Sudan 0.664178656
## Spain -0.221935582
## Sri Lanka -0.897814432
## St. Lucia 0.649728560
## St. Vincent and the Grenadines 0.131420593
## Sub-Saharan Africa 0.379954847
## Sub-Saharan Africa (excluding high income) 0.379954847
## Sub-Saharan Africa (IDA & IBRD countries) 0.379954847
## Sudan -0.843744066
## Suriname -0.436831030
## Sweden 0.641036800
## Switzerland 0.680393591
## Syrian Arab Republic -2.245588328
## Tajikistan -0.674952343
## Tanzania 2.512556173
## Thailand 1.073992684
## Timor-Leste -0.395653700
## Togo 2.104439749
## Tonga -0.658657852
## Trinidad and Tobago 0.152339251
## Tunisia -1.785198120
## Turkey -1.729348682
## Turkmenistan 0.063497873
## Uganda 0.677071249
## Ukraine 0.250958153
## United Arab Emirates -0.805208024
## United Kingdom 0.368314436
## United States 0.628777497
## Upper middle income 0.246886943
## Uruguay 0.147303509
## Uzbekistan -0.351101194
## Vanuatu 0.365019405
## Venezuela, RB -0.001698803
## Vietnam 1.399045475
## Virgin Islands (U.S.) 0.282411076
## West Bank and Gaza -2.388327075
## World -0.003717115
## Yemen, Rep. -2.505323817
## Zambia 0.760219351
## Zimbabwe 1.866854539DataEmpoderamiento1=as.data.frame(Act1FLM1$scores)
names(DataEmpoderamiento1) = c("Empoderamiento")
#para el merge final tambien coloco el pais como una columna
DataEmpoderamiento1$Pais = row.names(DataEmpoderamiento1)
head(DataEmpoderamiento1)para la H2
DENSIDAD (EDU, ENER, DataTugurios)
#Para la segunda hipotesis se usa la DataGini como variable "suelta", y la DataTugurios como componente de la avriable densidad. Pero ambas son contraintuitivas.
DataGini1[which.max(DataGini1$Gini),]DataTugurios1[which.max(DataTugurios1$BarriosTugurios),]#Ponemos las variables en forma intuitiva restando con el mayor valor
DataTugurios1$BarriosTugurios= 97 - DataTugurios1$BarriosTugurios
DataGini1$Gini= 64.8 - DataGini1$Ginidensidad1x= merge(EDU2,ENER2,all.x=T,all.y=T)
densidad1x=merge(densidad1x,DataTugurios1,all.x=T,all.y=T)
row.names(densidad1x) = densidad1x$Pais
#imputar
densidad1x[is.na(densidad1x$BarriosTugurios), "BarriosTugurios"]=mean(densidad1x$BarriosTugurios, na.rm=T)
densidad1x[is.na(densidad1x$EDU1), "EDU1"]=mean(densidad1x$EDU1, na.rm=T)
densidad1x[is.na(densidad1x$ENER1), "ENER1"]=mean(densidad1x$ENER1, na.rm=T)
densidad1x=as.data.frame(scale(densidad1x[,c(2:4)]))
head(densidad1x)library(psych)
#test de bartlett
cortest.bartlett(densidad1x, n=nrow(densidad1x))## R was not square, finding R from data## $chisq
## [1] 223.2036
##
## $p.value
## [1] 4.075464e-48
##
## $df
## [1] 3#correlacion de una data
pearson2 = cor(densidad1x)
#matriz de correlación
cor.plot(pearson2,
numbers=T,
upper=FALSE,
main = "Correlation",
show.legend = FALSE)
La matriz de correlacion no es igual que la matriz de identidad, es correcto hacer analisis factorial
##el KMO es un estimador, admite una representación gráfica por medio de una función escalonada.
#que tan apropiado es que se junten las variables, más cercano a 1 mejor
KMO(densidad1x) ## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = densidad1x)
## Overall MSA = 0.7
## MSA for each item =
## EDU1 ENER1 BarriosTugurios
## 0.72 0.66 0.71EL MSA significa que es 0.7 es apropiado juntar las variables
#sustenta que las variables están correlacionadas; mira comose juntan mis variables y el puntaje alternativo que me da
#El AF compara variable con variable
#crea el objeto para el factorial
densidad1x_f <- fa(densidad1x, #de donde esta la data
nfactors=1, #numero de dimensiones
rotate="varimax"
)
densidad1x_f$loadings ##
## Loadings:
## MR1
## EDU1 0.699
## ENER1 0.818
## BarriosTugurios 0.707
##
## MR1
## SS loadings 1.658
## Proportion Var 0.553Ha recogido el 55.3% de la informacion de mis variables
#haces una data con tus scores (los MR del AF)
densidad1x_plus=as.data.frame(densidad1x_f$scores) #los scores ya estaban creados cuando hiciste AF
#le ponemos nombre a nuestros indices
names(densidad1x_plus)=c("Densidad")
densidad1x_plus$Pais = row.names(densidad1x_plus)
head(densidad1x_plus)para la H3
ACCESO A LA INFO (GAST, ban)
infox1=merge(GAST2,ban2,all.x=T,all.y=T)
row.names(infox1) = infox1$Pais
#densidad1x$Pais = NULL
#imputar
infox1[is.na(infox1$GAST1), "GAST1"]=mean(infox1$GAST1, na.rm=T)
infox1[is.na(infox1$ban1), "ban1"]=mean(infox1$ban1, na.rm=T)
infox1=as.data.frame(scale(infox1[,c(2,3)]))
head(infox1)library(psych)
#test de bartlett
cortest.bartlett(infox1, n=nrow(infox1))## R was not square, finding R from data## $chisq
## [1] 111.3476
##
## $p.value
## [1] 4.965349e-26
##
## $df
## [1] 1#correlacion de una data
pearson3 = cor(infox1)
#matriz de correlación
cor.plot(pearson3,
numbers=T,
upper=FALSE,
main = "Correlation",
show.legend = FALSE)
Es correcto hacer un analisis factorial porque la matriz de correlacion y la matriz de identidad son diferentes
##el KMO es un estimador, admite una representación gráfica por medio de una función escalonada.
#que tan apropiado es que se junten las avriables, más cercano a 1 mejor
KMO(infox1) ## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = infox1)
## Overall MSA = 0.5
## MSA for each item =
## GAST1 ban1
## 0.5 0.5#sustenta que las variables están correlacionadas; mira comose juntan mis variables y el puntaje alternativo que me da
#El AF compara variable con variable
#crea el objeto para el factorial
infox1_f <- fa(infox1, #de donde esta la data
nfactors=1, #numero de dimensiones
rotate="varimax"
)
#la varianza acumulada significa que se ha recogido el __% de la informacion de tu set de variables
#puedes ver que variables pertenecen a un mismo grupo
infox1_f$loadings ##
## Loadings:
## MR1
## GAST1 0.787
## ban1 0.787
##
## MR1
## SS loadings 1.24
## Proportion Var 0.62Ha recogido el 62% de la informacion de las variables
#haces una data con tus scores (los MR del AF)
infox1_plus=as.data.frame(infox1_f$scores) #los scores ya estaban creados cuando hiciste AF
#le ponemos nombre a nuestros indices
names(infox1_plus)=c("Informacion")
infox1_plus$Pais = row.names(infox1_plus)
head(infox1_plus)Para la regresion tenemos dos variables de control:
#Variable de control1: GDP
link10="https://docs.google.com/spreadsheets/d/e/2PACX-1vSZRzhntcGTwaPWt9AzFNIuAhw_AIIz8e4xBtNopkV8Sib3CzKJ8sp4EFBfe0potA/pub?gid=711902649&single=true&output=csv"
GDP=read.csv(link10, stringsAsFactors = F)
#la cobertura entre 2003 al2007
GDP1=GDP[,c(1,48:52)]
names(GDP1) = c("Pais","2003","2004","2005", "2006", "2007")
GDP1[,c(2:6)]=lapply(GDP1[,c(2:6)],as.numeric) #volver numerico en grupo## Warning in lapply(GDP1[, c(2:6)], as.numeric): NAs introduced by coercion
## Warning in lapply(GDP1[, c(2:6)], as.numeric): NAs introduced by coercion
## Warning in lapply(GDP1[, c(2:6)], as.numeric): NAs introduced by coercion
## Warning in lapply(GDP1[, c(2:6)], as.numeric): NAs introduced by coercion
## Warning in lapply(GDP1[, c(2:6)], as.numeric): NAs introduced by coercionGDP1$GDP = rowMeans(GDP1[,2:6], na.rm = TRUE)
GDP1= GDP1[,c (1,7)]
GDP1 = GDP1[complete.cases(GDP1),]
row.names(GDP1) = NULL
#Variable de control2: ODA
link20="https://docs.google.com/spreadsheets/d/e/2PACX-1vQMbPO51JV-DhQLOOX9GnTSN7Z4hlKuFjX6Ft9QRS07q1i28GeqAsAAhdfXkNq-uA/pub?gid=1457611805&single=true&output=csv"
ODA=read.csv(link20, stringsAsFactors = F)
#la cobertura entre 2003 al2007
ODA1=ODA[,c(1,48:52)]
names(ODA1) = c("Pais","2003","2004","2005", "2006", "2007")
ODA1$`2003` = gsub("\\,", ".", ODA1$`2003`)
ODA1$`2004` = gsub("\\,", ".", ODA1$`2004`)
ODA1$`2005` = gsub("\\,", ".", ODA1$`2005`)
ODA1$`2006` = gsub("\\,", ".", ODA1$`2006`)
ODA1$`2007` = gsub("\\,", ".", ODA1$`2007`)
ODA1[,c(2:6)]=lapply(ODA1[,c(2:6)],as.numeric) #volver numerico en grupo
ODA1$ODA = rowMeans(ODA1[,2:6], na.rm = TRUE)
ODA1= ODA1[,c (1,7)]
ODA1 = ODA1[complete.cases(ODA1),]
row.names(ODA1) = NULL##juntar las variables para mi regresion
responsabilidad1 = merge(DataEmpoderamiento1, DataMetodos1, all.x=T,all.y=T)
responsabilidad1 = merge(responsabilidad1, densidad1x_plus, all.x=T,all.y=T)
responsabilidad1 = merge(responsabilidad1, EspVida1, all.x=T,all.y=T)
responsabilidad1 = merge(responsabilidad1, antiRetrov1, all.x=T,all.y=T)
responsabilidad1 = merge(responsabilidad1, DataGini1, all.x=T,all.y=T)
responsabilidad1 = merge(responsabilidad1, infox1_plus, all.x=T,all.y=T)
regresion = merge(responsabilidad1, migra1, all.x=T,all.y=T)
regresion=regresion[-grep("small|San|high|Pacific|French|Caribbean|Early|Late|Island|Small|West|Sint|Other|OECD|North|World|Euro|Latin|Upper|High|Heavily|IBR|IDA|Least|Low|Middle|East|Central|Fragile|Post|Pre",regresion$Pais),] #buscar y eliminar
row.names(regresion)=NULL
regresion=regresion[-c(4,5,10,14,22,28,42,44,52,15,28,47,70,72,74,89,104,109,122,124,134,144,160,163,171:173),] #eliminar
row.names(regresion)=NULL
regresion1 = merge(regresion, DataVIH1,all.y=T) #data para la regresion
regresion1=regresion1[-grep("small|San|high|Pacific|French|Caribbean|Early|Late|Island|Small|West|Sint|Other|OECD|North|World|Euro|Latin|Upper|High|Heavily|IBR|IDA|Least|Low|Middle|East|Central|Fragile|Post|Pre",regresion1$Pais),] #buscar y eliminar
row.names(regresion1)=NULL
regresion1=regresion1[-c(9,10,30,32,98,111),] #eliminar
row.names(regresion1)=NULL
regresion1 = merge(regresion1,GDP1 ,all.x=T)
regresion1 = merge(regresion1,ODA1 ,all.x=T) #data para la regresion
regresion1[is.na(regresion1$Metodos), "Metodos"]=mean(regresion1$Metodos, na.rm=T)
regresion1[is.na(regresion1$Empoderamiento), "Empoderamiento"]=mean(regresion1$Empoderamiento, na.rm=T)
regresion1[is.na(regresion1$Densidad), "Densidad"]=mean(regresion1$Densidad, na.rm=T)
regresion1[is.na(regresion1$GDP), "GDP"]=mean(regresion1$GDP, na.rm=T)
regresion1[is.na(regresion1$ODA), "ODA"]=mean(regresion1$ODA, na.rm=T)
regresion1[is.na(regresion1$VidaM), "VidaM"]=mean(regresion1$VidaM, na.rm=T)
regresion1[is.na(regresion1$Informacion), "Informacion"]=mean(regresion1$Informacion, na.rm=T)
regresion1[is.na(regresion1$CobARet), "CobARet"]=mean(regresion1$CobARet, na.rm=T)
regresion1[is.na(regresion1$Gini), "Gini"]=mean(regresion1$Gini, na.rm=T)
regresion1[is.na(regresion1$Migracion), "Migracion"]=mean(regresion1$Migracion, na.rm=T)He decidido no imputar los datos de la DataVIH1 dado que deseo tener conocimiento de esta variable
library(betareg)
#un subset con la VD y las VI
betaData=regresion1[,c(2:12)]
betaData$VIH= betaData$VIH/100
BETmodelo=betareg(VIH~., #vd
data=betaData)
#mira el p-value y la dirección del efecto
summary(BETmodelo)##
## Call:
## betareg(formula = VIH ~ ., data = betaData)
##
## Standardized weighted residuals 2:
## Min 1Q Median 3Q Max
## -4.9091 -0.4006 0.1005 0.5093 3.7494
##
## Coefficients (mean model with logit link):
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 4.972e+00 5.871e-01 8.469 < 2e-16 ***
## Empoderamiento -3.405e-02 7.027e-02 -0.485 0.628015
## Metodos 1.616e-02 4.712e-03 3.430 0.000603 ***
## Densidad 3.356e-01 1.227e-01 2.735 0.006231 **
## VidaM -1.567e-01 8.776e-03 -17.855 < 2e-16 ***
## CobARet 1.774e-02 4.906e-03 3.616 0.000300 ***
## Gini -6.081e-03 7.693e-03 -0.791 0.429227
## Informacion 7.864e-02 1.474e-01 0.534 0.593622
## Migracion 2.113e-07 7.704e-08 2.742 0.006104 **
## GDP 1.621e-14 1.843e-13 0.088 0.929907
## ODA -1.754e-02 1.186e-02 -1.479 0.139200
##
## Phi coefficients (precision model with identity link):
## Estimate Std. Error z value Pr(>|z|)
## (phi) 163.3 23.8 6.86 6.88e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Type of estimator: ML (maximum likelihood)
## Log-likelihood: 537.5 on 12 Df
## Pseudo R-squared: 0.7098
## Number of iterations: 78 (BFGS) + 15 (Fisher scoring)Las variables significativas que pueden explicar a mi variable dependiente son: Metodos, Densidad, VidaM, CobARet y Migracion. De las cuales VidaM tiene un sentido negativo.
library(margins)
BETAmarg = margins(BETmodelo)
Resultado=summary(BETAmarg)
ResultadoPor cada punto adicional en la variable Metodos la probabilidad de prevalencia del VIH aumenta en 0.002% Por cada punto adicional en la variable Densidad la probabilidad de prevalencia del VIH aumenta en 0.37% Por cada punto adicional en la variable CobARet la probabilidad de prevalencia del VIH aumenta en 0.002% Por cada punto adicional en la variable Migracion la probabilidad de prevalencia del VIH aumenta en 0% Por cada punto adicional en la variable VidaM la probabilidad de prevalencia del VIH disminuye en 0.17%
#sale sus limites de su error
bet=summary(BETAmarg)
library(ggplot2)##
## Attaching package: 'ggplot2'## The following objects are masked from 'package:psych':
##
## %+%, alphaggplot(bet,aes(x=factor, y=AME)) + geom_point() + geom_errorbar(aes(ymin=lower, ymax=upper))
Podemos observar que la variable Migracion no es un buen indicador para la prevalencia del VIH. Por otro lado, el margen de error de la variable densidad es amplio y aunque es significativo solo afecta en un 0.37% la probabilidad de prevalencia del VIH.