Distribución de mujeres de 15 años y más por disponibilidad de ingresos según estado conyugal

Fuente:ENCUESTA NACIONAL SOBRE LA DINÁMICA DE LAS RELACIONES EN LOS HOGARES (ENDIREH) 20161

Información en http://www.beta.inegi.org.mx/proyectos/enchogares/especiales/endireh/2016/.

Población objetivo Las mujeres de 15 años o más residentes habituales de las viviendas seleccionadas en la muestra en

Mujeres casadas o unidas.
Mujeres separadas, Divorciadas o Viudas.
Mujeres solteras.

Se cubrieron los iguientes temas

Características de la Vivienda y Hogares en la Vivienda.
Características Sociodemográficas de las Personas Residentes de la Vivienda.
Elegibilidad y Verificación de Estado Conyugal de la Mujer Elegida de 15 años o más.
Situación de la Relación de Pareja / Ingresos y Recursos.
Consentimiento y Privacidad.
Ámbito Escolar.
Ámbito Laboral.
Ámbito Comunitario.
Atención Obstétrica.
Ámbito Familiar.
Familia de Origen.
Vida en Pareja.
Tensiones y Conflictos.
Relación Actual o última.
Decisiones y Libertad Personal.
Opinión sobre los Roles Masculinos y Femeninos.
Recursos Sociales.
División del Trabajo en el Hogar.
Mujeres de 60 años o más.

El ejemplo to tomaremos de la sección # 4 que trata de la Situación de la Relación de Pareja, de sus ingresos y recursos De los tabulados básicos

http://www.beta.inegi.org.mx/contenidos/proyectos/enchogares/especiales/endireh/2016/tabulados/IV_Ingresos_y_recursos_estimaciones_endireh2016.xlsx

Tabla básica 4.1

Se trata de una tabla combinada de la variable del estado conyugal y de los ingresos de acuerdo a la siguiente característica

Sin ingresos propios o de otras fuentes
Sólo dispone de ingresos propios
Dispone de ingresos propios y algún otro apoyo (ayudas familiares, becas escolares o programas gubernamentales)2
Dispone de ingresos por ayuda de familiares o conocidos y de otros apoyos (programas gubernamentales y/o becas)3
Solo dispone de ingresos por apoyos de programas gubernamentales y/o becas para ella o para sus hijas/os4

La variable relacionada con los ingresos está en considerada en el marco conceptual de acuerdo a la siguiente tabla http://www.beta.inegi.org.mx/app/biblioteca/ficha.html?upc=702825095055

Ingresos Y corresponde a las siguientes preguntas del cuestionario

Ingresos propios

otros ingresos

Creación de nuevas variables

Es necesario desde cada pregunta la variable compuesta, para determinar si solo dispone de ingresos propios (salario y pensiones), si no tiene ingresos de ningún tipo y la combinación de si tiene ingreso proveniente de ayudas familiares o del gobierno.

Para tal efecto se consideró el siguiente espacio de probabilidades de ingreso

Variables creada desde los reactivos puntuales Así Sin ingresos propios o de otras fuentes, responde que no a 4.1,4.8.1: 4.8.2;4.8.3; 4.8.4; 4.8.5;4.8.6;4.8.7:4.8.8

df<-read.csv("TB_SEC_IV.csv")
df<- subset(df, df$DOMINIO=="R")
#str(df)
##1  $ ï..ID_VIV : num  1e+05 1e+05 1e+05 1e+05 1e+05 ...
##2  $ ID_MUJ    : Factor w/ 111256 levels "0100002.01.01.03",..: 92 98 100 99 103 104 101 102 105 106 ...
##3  $ UPM       : int  100090 100097 100097 100097 100101 100101 100101 100101 100101 100103 ...
##4  $ REN_M_ELE : int  2 2 1 2 1 3 4 2 3 1 ...
##5  $ VIV_SEL   : int  4 1 5 3 3 4 1 2 5 2 ...
##6  $ PROG      : int  78 18 121 130 33 51 69 102 114 46 ...
##7  $ HOGAR     : int  1 1 1 1 1 1 1 1 1 1 ...
##8  $ DOMINIO   : Factor w/ 3 levels "C","R","U": 3 3 3 3 3 3 3 3 3 3 ...
##9  $ CVE_ENT   : int  1 1 1 1 1 1 1 1 1 1 ...
##10  $ NOM_ENT   : Factor w/ 32 levels "Aguascalientes",..: 1 1 1 1 1 1 1 1 1 1 ...
##11  $ CVE_MUN   : int  1 1 1 1 1 1 1 1 1 1 ...
##12  $ NOM_MUN   : Factor w/ 1334 levels "?LVARO OBREG?N",..: 41 41 41 41 41 41 41 41 41 41 ...
##13  $ COD_RES   : int  1 1 1 1 1 1 1 1 1 1 ...
##14  $ COD_RES_MU: int  1 1 1 1 1 1 1 1 1 1 ...
##15  $ T_INSTRUM : Factor w/ 6 levels "A1","A2","B1",..: 1 1 3 1 4 3 5 1 5 4 ...
##16  $ num_renesp: int  1 1 NA 1 NA NA NA 1 NA NA ...
##17  $ P4AB_1    : int  1 1 1 1 3 3 NA 3 NA 3 ...
##18  $ P4AB_2    : int  NA NA 49 NA 9 2 NA NA NA 3 ...
##19  $ P4A_1     : int  NA NA NA NA NA NA NA NA NA NA ...
##20  $ P4A_2     : int  NA NA NA NA NA NA NA NA NA NA ...
##21  $ P4B_1     : int  NA NA 1 NA 3 2 NA NA NA 3 ...
##22  $ P4B_2     : int  NA NA 9 NA NA 2 NA NA NA NA ...
##23  $ P4BC_1    : int  NA NA 98 NA 81 31 18 NA 47 69 ...
##24  $ P4BC_2    : int  NA NA 0 NA 2 4 4 NA 10 0 ...
##25  $ P4C_1     : int  NA NA NA NA NA NA 1 NA 2 NA ...
##26  $ P4BC_3    : int  NA NA 8 NA 3 3 8 NA 3 1 ...
##27  $ P4BC_4    : int  NA NA 2 NA 2 2 2 NA 2 2 ...
##28  $ P4BC_5    : int  NA NA NA NA NA NA NA NA NA NA ...
##29  $ P4_1      : int  1 2 2 1 2 1 2 2 1 2 ...
##30  $ P4_2      : int  750 NA NA 600 NA 400 NA NA 10000 NA ...
##31  $ P4_2_1    : int  1 NA NA 1 NA 1 NA NA 3 NA ...
##32 $ P4_3      : int  1 1 2 2 NA 1 8 2 1 NA ...
##33  $ P4_4      : Factor w/ 22188 levels "","A LA CONSTRUCCION",..: 20327 592 1 1 1 6130 1 1 21295 1 ...
##34  $ P4_4_CVE  : int  7112 7121 NA NA NA 2711 NA NA 4223 NA ...
##35  $ P4_5_AB   : int  999998 2500 NA NA NA 3000 NA NA NA NA ...
##36  $ P4_5_1_AB : int  NA 1 NA NA NA 1 NA NA NA NA ...
##37  $ P4_6_AB   : int  1 1 2 1 NA 2 NA 1 NA NA ...
##38  $ P4_7_AB   : int  2400 4000 NA 4000 NA NA NA 10000 NA NA ...
##39  $ P4_8_1    : int  2 2 2 2 2 2 2 2 2 2 ...
##40  $ P4_8_2    : int  2 2 2 1 2 2 2 2 2 1 ...
##41  $ P4_8_3    : int  2 2 1 2 2 2 1 2 2 2 ...
##42  $ P4_8_4    : int  2 2 2 2 2 2 2 2 2 2 ...
##43  $ P4_8_5    : int  2 2 2 2 2 2 2 2 2 2 ...
##44  $ P4_8_6    : int  2 2 2 2 2 2 2 2 2 2 ...
##45 $ P4_8_7    : int  2 2 1 2 1 2 2 2 2 1 ...
##46  $ P4_8_8    : int  2 2 2 2 1 2 2 2 2 2 ...
##47  $ P4_9_1    : int  NA NA NA NA NA NA NA NA NA NA ...
##48  $ P4_9_2    : int  NA NA NA 4000 NA NA NA NA NA 1200 ...
##49  $ P4_10_2_1 : int  NA NA NA 5 NA NA NA NA NA 2 ...
##50  $ P4_10_2_2 : int  NA NA NA NA NA NA NA NA NA NA ...
##51  $ P4_10_2_3 : int  NA NA NA NA NA NA NA NA NA NA ...
##52  $ P4_9_3    : int  NA NA 999998 NA NA NA 999998 NA NA NA ...
##53  $ P4_10_3_1 : int  NA NA 2 NA NA NA 1 NA NA NA ...
##54  $ P4_10_3_2 : int  NA NA NA NA NA NA NA NA NA NA ...
##55  $ P4_10_3_3 : int  NA NA NA NA NA NA NA NA NA NA ...
##56  $ P4_9_4    : int  NA NA NA NA NA NA NA NA NA NA ...
##57  $ P4_9_5    : int  NA NA NA NA NA NA NA NA NA NA ...
##58  $ P4_9_6    : int  NA NA NA NA NA NA NA NA NA NA ...
##59  $ P4_9_7    : int  NA NA 550 NA 550 NA NA NA NA 500 ...
##60  $ P4_9_8    : int  NA NA NA NA 1200 NA NA NA NA NA ...
##61  $ P4_11     : int  2 1 2 2 2 2 2 2 1 2 ...
##62  $ P4_12_1   : int  2 2 2 2 2 2 2 2 2 2 ...
##63  $ P4_12_2   : int  2 2 2 2 2 1 2 1 1 2 ...
##64  $ P4_12_3   : int  2 2 2 2 2 2 2 2 2 2 ...
##65  $ P4_12_4   : int  2 2 2 2 1 1 1 1 1 2 ...
##66  $ P4_12_5   : int  2 2 2 2 2 2 1 2 2 2 ...
##67  $ P4_12_6   : int  2 2 2 2 2 2 2 2 1 2 ...
##68  $ P4_12_7   : int  2 2 2 2 2 2 2 1 1 2 ...
##69  $ P4_13_1   : int  NA NA NA NA NA NA NA NA NA NA ...
##70  $ P4_13_2   : int  NA NA NA NA NA 5 NA 2 98 NA ...
##71  $ P4_13_3   : int  NA NA NA NA NA NA NA NA NA NA ...
##72  $ P4_13_4   : int  NA NA NA NA 1 5 98 2 5 NA ...
##73  $ P4_13_5   : int  NA NA NA NA NA NA 98 NA NA NA ...
##74  $ P4_13_6   : int  NA NA NA NA NA NA NA NA 6 NA ...
##75  $ P4_13_7   : int  NA NA NA NA NA NA NA 2 6 NA ...
##76  $ FAC_VIV   : int  72 82 82 82 94 94 94 94 94 61 ...
##77  $ FAC_MUJ   : int  72 82 82 82 94 189 283 94 283 61 ...
##78  $ ESTRATO   : int  2 2 2 2 3 3 3 3 3 2 ...
##79  $ UPM_DIS   : int  26 28 28 28 29 29 29 29 29 30 ...
##80  $ EST_DIS   : int  10 10 10 10 20 20 20 20 20 10 ...
#NUEVAS COLUMNAS


df$edociv<-ifelse(df$T_INSTRUM=="A1","Cas o uni",
        ifelse(df$T_INSTRUM=="A2","Cas o uni",
        ifelse(df$T_INSTRUM=="B1","Sep,div,viuda",
        ifelse(df$T_INSTRUM=="B2","Sep,div,viuda","Soltera"))))

dfm <- subset(df, select = c(ID_MUJ,edociv,P4_1,P4_8_1,P4_8_2,P4_8_3,P4_8_4,P4_8_5,P4_8_6,P4_8_7,P4_8_8))
kable(head(dfm), caption = "Datos originales 1 es Si, 2 es No")

Datos originales 1 es Si, 2 es No
	ID_MUJ	edociv	P4_1	P4_8_1	P4_8_2	P4_8_3	P4_8_4	P4_8_5	P4_8_6	P4_8_7	P4_8_8
1383	0160080.12.01.01	Cas o uni	2	2	1	2	2	2	2	2	2
1384	0160080.13.01.04	Cas o uni	2	2	2	2	2	2	2	2	2
1385	0160080.14.01.02	Cas o uni	2	2	2	2	2	2	2	2	2
1386	0160080.15.01.02	Cas o uni	2	2	2	2	2	2	2	2	2
1387	0160080.04.01.01	Sep,div,viuda	2	2	2	2	2	2	2	2	1
1388	0160080.05.01.02	Cas o uni	2	2	2	1	2	2	2	1	2

#head(dfm)
#str(df)

df$ningprop<-ifelse((df$P4_1 == 2 & df$P4_8_1 ==2 & df$P4_8_8 ==2),1,2)
df$ingprop<-ifelse((df$ningprop == 2),1,2)
tablaingprop<-acast(df,edociv ~ingprop,value.var="ID_MUJ")
#tablaingprop
#tablaningprop<-acast(df,edociv ~ningprop,value.var="ID_MUJ")
kable(tablaingprop, caption = "Ingresos propios, recibe salario, o jubilaciones y pensiones 4.1 o P48.1 o P48.8")

Ingresos propios, recibe salario, o jubilaciones y pensiones 4.1 o P48.1 o P48.8
	1	2
Cas o uni	4025	15683
Sep,div,viuda	1683	2255
Soltera	1164	2347

#4.82n y 483 n
df$nayudafam<-ifelse((df$P4_8_2 == 2 & df$P4_8_3 ==2),1,2)
df$ayudafam<-ifelse((df$nayudafam == 2),1,2)

tablayudafam<-acast(df,edociv ~ayudafam,value.var="ID_MUJ")
kable(tablayudafam,caption = "Ayuda familiar P48.2 o P48.3")

Ayuda familiar P48.2 o P48.3
	1	2
Cas o uni	1244	18464
Sep,div,viuda	686	3252
Soltera	347	3164

#tablanayudafam<-acast(df,edociv ~nayudafam,value.var="ID_MUJ")
#tablanayudafam

#484ny485ny486ny487n
df$nayudagob<-ifelse((df$P4_8_4 == 2 & df$P4_8_5 ==2 & df$P4_8_6 ==2 & df$P4_8_7 ==2),1,2)
df$ayudagob<-ifelse((df$nayudagob == 2),1,2)

tablayudagob<-acast(df,edociv ~ayudagob,value.var="ID_MUJ")
#tablayudagob
kable(tablayudagob,caption = "Ayuda gobierno P48.4 o P48.5 o P48.6 o P48.7")

Ayuda gobierno P48.4 o P48.5 o P48.6 o P48.7
	1	2
Cas o uni	9077	10631
Sep,div,viuda	2156	1782
Soltera	967	2544

#tablanayudagob<-acast(df,edociv ~nayudagob,value.var="ID_MUJ")
#tablanayudagob

#1  ningprop y nayudafam y nayudagob            Sin ingresos propios o de otras fuentes     
df$siningpropniotrafuente<-ifelse((df$ningprop == 1 & df$nayudafam ==1 & df$nayudagob ==1),1,2)
tablasiningpropniotrafuente<-acast(df,edociv ~siningpropniotrafuente,value.var="ID_MUJ")
#tablasiningpropniotrafuente

#2  ingprop y nayudasf y nayudagob          Solo ingresos propios   
df$soloingprop<-ifelse((df$ingprop == 1 & df$nayudafam ==1 & df$nayudagob ==1),1,2)
tablasoloingprop<-acast(df,edociv ~soloingprop,value.var="ID_MUJ")
#tablasoloingprop

#3  ingprop y ayudasf y ayudas gob  o inprop y ayudasf y nayudagob  o ingprop y nayudasf y ayudasgob                            
#Dispone de ingresos propios y algún otro apoyo (ayudas familiares, becas escolares o programas gubernamentales)2
df$ingpropyayudasfamgob<-ifelse((df$ingprop == 1 & df$ayudafam ==1 & df$ayudagob ==1) | (df$ingprop == 1 & df$ayudafam ==1 & df$nayudagob ==1) | (df$ingprop == 1 & df$nayudafam ==1 & df$ayudagob ==1),1,2)
tablaingpropyayudasfamgob<-acast(df,edociv ~ingpropyayudasfamgob,value.var="ID_MUJ")
#tablaingpropyayudasfamgob

#4  ningprop y ayudasf y ayudagob  o ningprop y ayudasf y nayudagob             
#Dispone de ingresos por ayuda de familiares o conocidos y de otros apoyos (programas gubernamentales y/o becas)3
df$ingayudasfamgob<-ifelse((df$ningprop == 1 & df$ayudafam ==1 & df$ayudagob ==1) | (df$ningprop == 1 & df$ayudafam ==1 & df$nayudagob ==1),1,2)
tablaingayudasfamgob<-acast(df,edociv ~ingayudasfamgob,value.var="ID_MUJ")
#tablaingayudasfamgob


#5  ningprop y nayudafam y ayudagob     
#Solo dispone de ingresos por apoyos de programas gubernamentales y/o becas para ella o para sus hijas/os4
df$soloayudagob<-ifelse((df$ningprop == 1 & df$nayudafam ==1 & df$ayudagob ==1),1,2)
tablasoloayudagob<-acast(df,edociv ~soloayudagob,value.var="ID_MUJ")
#tablasoloayudagob

df$sitdinero<-ifelse(df$siningpropniotrafuente == 1,"siningpropniotrafuente",
        ifelse(df$soloingprop ==1,"soloingprop",
        ifelse(df$ingpropyayudasfamgob==1,"ingpropyayudasfamgob",
        ifelse(df$ingayudasfamgob==1,"ingayudasfamgob ","soloayudagob"))))

tablasitdinero<-acast(df,edociv ~sitdinero,value.var="ID_MUJ")
kable(tablasitdinero,caption = "Situación de ingresos")

Situación de ingresos
	ingayudasfamgob	ingpropyayudasfamgob	siningpropniotrafuente	soloayudagob	soloingprop
Cas o uni	1078	1466	7504	7101	2559
Sep,div,viuda	505	767	564	1186	916
Soltera	282	236	1366	699	928

tablasitdineroT<-acast(df,sitdinero ~edociv,value.var="ID_MUJ")
kable(tablasitdineroT,caption = "Situación de ingresos transpuesta")

Situación de ingresos transpuesta
	Cas o uni	Sep,div,viuda	Soltera
ingayudasfamgob	1078	505	282
ingpropyayudasfamgob	1466	767	236
siningpropniotrafuente	7504	564	1366
soloayudagob	7101	1186	699
soloingprop	2559	916	928

Análisis estadísticos renglones, columnas, chi cuadrado, gtest, correspondencia

Interpretación de la tabla de contingencia, el tamaño de los puntos refleja la magnitud de los valores de la tabla

#http://www.sthda.com/english/articles/31-principal-component-methods-in-r-practical-guide/120-correspondence-analysis-theory-and-practice/#visualize-a-contingency-table
dt <- as.table(as.matrix(tablasitdineroT))

# 2. Graph
balloonplot(t(dt), main ="Disponibilidad de ingresos setún estado conyugal", xlab ="", ylab="",
            label = FALSE, show.margins = FALSE)

Cálculo de los totales de margen distribución marginal

Variables en renglones

# Row margins
row.sum <- apply(tablasitdineroT, 1, sum)

kable(head(row.sum), caption = "Total de renglón" )

Total de renglón
ingayudasfamgob	1865
ingpropyayudasfamgob	2469
siningpropniotrafuente	9434
soloayudagob	8986
soloingprop	4403

row.profile <- tablasitdineroT/row.sum
kable(head(row.profile), caption = "Distribución marginal por renglón")

Distribución marginal por renglón
	Cas o uni	Sep,div,viuda	Soltera
ingayudasfamgob	0.5780161	0.2707775	0.1512064
ingpropyayudasfamgob	0.5937627	0.3106521	0.0955853
siningpropniotrafuente	0.7954208	0.0597838	0.1447954
soloayudagob	0.7902292	0.1319831	0.0777877
soloingprop	0.5811946	0.2080400	0.2107654

# Column margins
col.sum <- apply(tablasitdineroT, 2, sum)

# grand total
n <- sum(tablasitdineroT)
# average row profile = Column sums / grand total
average.rp <- col.sum/n 
average.rp

##     Cas o uni Sep,div,viuda       Soltera 
##     0.7257061     0.1450087     0.1292853

Distancia entre renglones

Si se quiere comparar entre dos renglones, por ejemplo la distancia entre quienes reciben ayuda de familiares y gobierno y quienes no recien ayuda de ningún tipo

soloingprop.p <- row.profile["soloingprop",]
siningpropniotrafuente.p <- row.profile["siningpropniotrafuente",]
soloayudagob.p <- row.profile["soloayudagob",]
# Distancia entre quienes sólo tienen ingresos propios y los que no tienen y de ninguna otra fuente
d2 <- sum(((soloingprop.p - siningpropniotrafuente.p)^2) / average.rp)
# Distancia entre quienes sólo tienen ingresos propios y solo ayuda de gobierno
d3 <- sum(((soloingprop.p - soloayudagob.p)^2) / average.rp)
# Distancia entre quienes sólo ayuda de gobierno y quienes no tienen ninguna ayuda
d4 <- sum(((soloayudagob.p - siningpropniotrafuente.p)^2) / average.rp)

Distancia entre quienes sólo tienen ingresos propios y los que no tienen y de ninguna otra fuente 0.2484777

Distancia entre quienes sólo tienen ingresos propios y solo ayuda de gobierno 0.2368784

Distancia entre quienes sólo ayuda de gobierno y quienes no tienen ninguna ayuda 0.0707146

Distancia de cada renglón con el promedio de renglón

d2.row <- apply(row.profile, 1, 
        function(row.p, av.p){sum(((row.p - av.p)^2)/av.p)}, 
        average.rp)

kable(as.matrix(round(d2.row,3)))

ingayudasfamgob	0.143
ingpropyayudasfamgob	0.222
siningpropniotrafuente	0.059
soloayudagob	0.027
soloingprop	0.108

Distancia de cada renglón con cada uno de ellos, en la tabla de contingencia

El resultado es una matriz que indica la diferencia o la correlación entre renglones El tamaño del círculo es proporcional a la distancia entre ellos

dist.matrix <- function(data, average.profile){
   mat <- as.matrix(t(data))
    n <- ncol(mat)
    dist.mat<- matrix(NA, n, n)
    diag(dist.mat) <- 0
    for (i in 1:(n - 1)) {
        for (j in (i + 1):n) {
            d2 <- sum(((mat[, i] - mat[, j])^2) / average.profile)
            dist.mat[i, j] <- dist.mat[j, i] <- d2
        }
    }
  colnames(dist.mat) <- rownames(dist.mat) <- colnames(mat)
  dist.mat
}
# Distance matrix
dist.mat <- dist.matrix(row.profile, average.rp)
dist.mat <-round(dist.mat, 2)
# Visualize the matrix

corrplot(dist.mat, type="upper",  is.corr = FALSE)

row.sum <- apply(tablasitdineroT, 1, sum)

Peso de cada renglón Row mass

Es el total de cada renglón dividida entre el total de la población

grand.total <- sum(tablasitdineroT)
row.mass <- row.sum/grand.total
head(row.mass)

##       ingayudasfamgob    ingpropyayudasfamgob siningpropniotrafuente 
##             0.06867474             0.09091579             0.34738741 
##           soloayudagob            soloingprop 
##             0.33089075             0.16213131

Inercia

La inercia de cada renglón se calcula como el peso de cada renglón multiplicado por la distancia entre el renglón y el promedio de renglones

Corresponde al total de la información contenida en la tabla

row.inertia <- row.mass * d2.row
head(row.inertia)

##       ingayudasfamgob    ingpropyayudasfamgob siningpropniotrafuente 
##            0.009810553            0.020182220            0.020373045 
##           soloayudagob            soloingprop 
##            0.009072907            0.017433415

tin<-sum(row.inertia)

El total de la inercia corresponde a la cantidad de información que tiene 0.0768721

En resumen la información de cada renglón, distancia, peso e inercia puede concentrarse en esta tabla

row <- cbind.data.frame(d2 = d2.row, mass = row.mass, inertia = row.inertia)
round(row,3)

##                           d2  mass inertia
## ingayudasfamgob        0.143 0.069   0.010
## ingpropyayudasfamgob   0.222 0.091   0.020
## siningpropniotrafuente 0.059 0.347   0.020
## soloayudagob           0.027 0.331   0.009
## soloingprop            0.108 0.162   0.017

col.profile <- t(tablasitdineroT)/col.sum
col.profile <- as.data.frame(t(col.profile))

Variables en columnas

col.profile <- t(tablasitdineroT)/col.sum
col.profile <- as.data.frame(t(col.profile))
kable(head(col.profile), caption="Distribución marginal por columna")

Distribución marginal por columna
	Cas o uni	Sep,div,viuda	Soltera
ingayudasfamgob	0.0546986	0.1282377	0.0803190
ingpropyayudasfamgob	0.0743860	0.1947689	0.0672173
siningpropniotrafuente	0.3807591	0.1432199	0.3890629
soloayudagob	0.3603105	0.3011681	0.1990886
soloingprop	0.1298457	0.2326054	0.2643122

# Column margins
col.sum <- apply(tablasitdineroT, 2, sum)

# grand total
n <- sum(tablasitdineroT)
# average row profile = Column sums / grand total


# average column profile= row sums/grand total
average.cp <- col.sum/n 
head(average.cp)

##     Cas o uni Sep,div,viuda       Soltera 
##     0.7257061     0.1450087     0.1292853

Distancia entre columnas

Si se quiere comparar entre dos columnas, por ejemplo la distancia entre quienes solteras y separadas, divorciadas o viudas

# Row sums
col.sum <- apply(tablasitdineroT, 2, sum)
# average column profile= row sums/grand total
average.cp <- col.sum/n 
head(average.cp)

##     Cas o uni Sep,div,viuda       Soltera 
##     0.7257061     0.1450087     0.1292853

sepdivviuda.p <- col.profile[, "Sep,div,viuda"]
soltera.p <- col.profile[, "Soltera"]
casouni.p <- col.profile["Cas o uni"]

# Distancia entre separadas, divorciadas o viudas y solteras
d2 <- sum(((sepdivviuda.p - soltera.p)^2) / average.cp)

# Distancia entre separadas, divorciadas o viudas y casadas o unidas
d3 <- sum(((sepdivviuda.p - casouni.p)^2) / average.cp)
# Distancia entre casadas o unidas y solteras
d4 <- sum(((casouni.p - soltera.p)^2) / average.cp)

Distancia entre separadas, divorciadas o viudas y solteras 0.6041358

Distancia entre separadas, divorciadas o viudas y casadas o unidas 0.621468

Distancia entre casadas o unidas y solteras 0.1622997

Distancia de cada columna con el promedio de columna

d2.col <- apply(col.profile, 2, 
        function(col.p, av.p){sum(((col.p - av.p)^2)/av.p)}, 
        average.cp)
kable(round(d2.col,3))

Cas o uni	1.330
Sep,div,viuda	0.812
Soltera	1.618

Distancia de cada columna con cada una de ellos, en la tabla de contingencia

El resultado es una matriz que indica la diferencia o la correlación entre columnas El tamaño del círculo es proporcional a la distancia entre ellos

# Distance matrix
dist.mat <- dist.matrix(t(col.profile), average.cp)
dist.mat <-round(dist.mat, 2)
dist.mat

##               Cas o uni Sep,div,viuda Soltera
## Cas o uni          0.00          0.62    0.16
## Sep,div,viuda      0.62          0.00    0.60
## Soltera            0.16          0.60    0.00

# Visualize the matrix

corrplot(dist.mat, type="upper", order="hclust", is.corr = FALSE)

Peso de cada columna Col mass

Es el total de cada renglón dividida entre el total de la población

col.sum <- apply(tablasitdineroT, 2, sum)
grand.total <- sum(tablasitdineroT)
col.mass <- col.sum/grand.total
head(col.mass)

##     Cas o uni Sep,div,viuda       Soltera 
##     0.7257061     0.1450087     0.1292853

Inercia

La inercia de cada columna se calcula como el peso de cada columna multiplicado por la distancia entre la columna y el promedio de columnas

Corresponde al total de la información contenida en la tabla

col.inertia <- col.mass * d2.col
head(col.inertia)

##     Cas o uni Sep,div,viuda       Soltera 
##     0.9648507     0.1177091     0.2091799

tin2<-sum(col.inertia)

El total de la inercia corresponde a la cantidad de información que tiene 1.2917398

En resumen la información de cada renglón, distancia, peso e inercia puede concentrarse en esta tabla

col <- cbind.data.frame(d2 = d2.col, mass = col.mass, 
                        inertia = col.inertia)
round(col,3)

##                  d2  mass inertia
## Cas o uni     1.330 0.726   0.965
## Sep,div,viuda 0.812 0.145   0.118
## Soltera       1.618 0.129   0.209

Relación y asociación entre las variables de renglón y columna

Cuando las tablas de contingencia no son muy grandes o no es fácil visualizar e interpretar la relación entre las columnas y renglones se utilizan otros métodos estadísticos.

Uno de ellos es la pruba de independencia de Xi cuadrado Es una prueba de hipótesis utilizada en tablas de contingencia para probar la independencia entre variables, esto es si están significativamente asociadas.

La hipótesis nula dice que ambas variables, la de las columnas o de los renglones son independientes La hipótesis alternativa es que son dependientes o están asociados.

Para cada cruce o celda de la tabla se calcula el valore esperado en el supuesto de la independencia esto el total del renglón por el total de columna entre el total.

El estadístico de prueba o Xi cuadrada es la suma del cuadrado de las diferencias de valores observados menos valores esperados.

El valor crítico con el que se compara se obtiene de tablas de distribución o de tablas con grados de libertad (renglón-1)*(columnas-1) con un nivel de significancia .05 Error típico tipo 1. Rechazar siendo cierto. (Pruebas de hipótesis)

Si el valor calculado es mayor que el valor crítico, las variables no son independientes, esto implica que están asociadas significativamente

Si se calcula el pvalue.

*• Si el nivel de significancia (0.5) es mayor que el p-value rechazar H0. Por los resultados de la muestra hay suficiente evidencia para concluir que es incorrecta la hipótesis nula y que la alternativa podría ser la correcta.

*• Si el nivel de significancia (0.5) es menor que el p-value aceptar H0. Por los resultados de la muestra hay suficiente evidencia para concluir que es correcta la hipótesis nula y que la alternativa podría sería la incorrecta.

Cuando no se rechaza la Ho, no significa que se crea que es cierta sino que no hay suficiente evidencia para dudar de ella.

Sólo se apolica cuando la frecuencia esperada de cualquier celda es al menos cinco.

Esta prueba establece la asociación, aunque se desconoce la naturaleza de la misma

chisq <- chisq.test(tablasitdineroT)
chisq

## 
##  Pearson's Chi-squared test
## 
## data:  tablasitdineroT
## X-squared = 2087.6, df = 8, p-value < 2.2e-16

Valores esperados, Valores observados

round(chisq$expected,2)

##                        Cas o uni Sep,div,viuda Soltera
## ingayudasfamgob          1353.44        270.44  241.12
## ingpropyayudasfamgob     1791.77        358.03  319.21
## siningpropniotrafuente   6846.31       1368.01 1219.68
## soloayudagob             6521.19       1303.05 1161.76
## soloingprop              3195.28        638.47  569.24

chisq$observed

##                        Cas o uni Sep,div,viuda Soltera
## ingayudasfamgob             1078           505     282
## ingpropyayudasfamgob        1466           767     236
## siningpropniotrafuente      7504           564    1366
## soloayudagob                7101          1186     699
## soloingprop                 2559           916     928

Residuales

Para saber cuál es el cruce o la celda que más contibuye al resultado de la Chii cuadrada se utilzan los residuales, esto es la Chi cuadrada de cada celda

round(chisq$residuals, 3)

##                        Cas o uni Sep,div,viuda Soltera
## ingayudasfamgob           -7.487        14.263   2.633
## ingpropyayudasfamgob      -7.696        21.614  -4.657
## siningpropniotrafuente     7.949       -21.738   4.190
## soloayudagob               7.180        -3.243 -13.577
## soloingprop              -11.256        10.983  15.037

corrplot(chisq$residuals, is.cor = FALSE)

El tamaño del círculo en cada celda es proporcional a la cantidad de contribución El signo de cada valor residual también es importante para interpretar la asociación entre las columnas y los renglones de acuerdo a lo siguiente

Los resultados positivos son azules, especifican una asociación positiva (atracción) entre las columnas y los renglones correspondientes

Los resultados negativos son rojos, implican una asociación negativa(repulsión) entre las columnas y renglones correspondientes

En el análisis de correspondencia se descomponen los residuales estandarizados. (una nueva distribución)

Contribución

La conttribución en términos de porcentajes es la relación entre cada residual al cuadrado y la xi cuadrada total. Se calcula como contribuye en %

contrib <- 100*chisq$residuals^2/chisq$statistic
round(contrib, 3)

##                        Cas o uni Sep,div,viuda Soltera
## ingayudasfamgob            2.685         9.745   0.332
## ingpropyayudasfamgob       2.837        22.378   1.039
## siningpropniotrafuente     3.026        22.635   0.841
## soloayudagob               2.469         0.504   8.830
## soloingprop                6.069         5.779  10.831

corrplot(contrib, is.cor = FALSE)

Es una indicación de la naturaleza de la dependencia entre renglones y columnas de la tabla de contingencia Esta interpretación es complicada cuando la tabla es muy grande, la contribución es una forma útil de establecer la naturaleza de la dependencia

Inercia total

Es como se dijo anteriormente la información contenida en la tabla

phi2 <- as.numeric(chisq$statistic/sum(tablasitdineroT))

trace<-sqrt(phi2)

Inercia Total 0.0768721

Trace 0.2772583

La raíz cuadrada de esta inercia es llmada “trace” y puede ser interpretada como coeficiente de correlación (Bendixen, 2003). Cualquier valor mayor de 0.2 indica una dependencia significativa entre renglones y columnas (Bendixen M., 2003)

Gráfico de mozaico, utilizado en las tablas de contingencia para examinar la asociación entre variables categóricas

mosaicplot(tablasitdineroT,  las=2, col="steelblue",
           main = "Situación conyugal e ingresos - conteo observado")

mosaicplot(chisq$expected,  las=2, col = "gray",
           main = "Situación conyugal e ingresos - conteo esperado")

Para cada celda la altura de las barras es proporcional a la frecuencia relativa de los observado El gráfico azul es el de los valores observados, el gris es el de los esperados siendo cierta la hypotesis nula que dice que son independientes, la diferencia es la que marca la distancia entres lo esperado y lo observado

Entre estos dos gráficos, está el de los residuales que calcula la diferencia entre ambos.

mosaicplot(tablasitdineroT, shade = TRUE,   # Color the graph
           las = 2,                    # produces vertical labels
           main = "Situación conyugal e ingresos")

G-test: Likelihood ratio test

La prueba de independencia G-Test o prueba likelihood radio es una prueba alternativa a la prueba de chi-cuadrada y que da aproximadamente los mismos resultados

EStá basada en el radio likelihood que compara lo observado con lo espeado.

gtest <- G.test(as.matrix(tablasitdineroT))
gtest

## 
##  G-test
## 
## data:  as.matrix(tablasitdineroT)
## G = 2061, df = 8, p-value < 2.2e-16

Interpretación del radio likehood como asociación entre renglones y columnas

Para una celda dada Si el radio es >1 hay una atracción (asociación) entre las columnas y renglones correspondientes Si el radio es <1 hay una repulsón entre las columnas y renglones correspondientes

ratio <- chisq$observed/chisq$expected
round(ratio,3)

##                        Cas o uni Sep,div,viuda Soltera
## ingayudasfamgob            0.796         1.867   1.170
## ingpropyayudasfamgob       0.818         2.142   0.739
## siningpropniotrafuente     1.096         0.412   1.120
## soloayudagob               1.089         0.910   0.602
## soloingprop                0.801         1.435   1.630

corrplot(ratio, is.cor = FALSE)

Se utilizará el logaritmo del radio o relación para ver la atracción o repulsión en colores diferentes Si el radio es <1 o negativo estará en rojo (repulsión) Si el radio es >1 o positivo estará en azul (asociación)

corrplot(log2(ratio), is.cor = FALSE)

Análisis de correspondencias

Se requiere cuando las tablas de contingencia son muy grandes

Es utilizada para visualizar puntos de los renglones y puntos de las columnas en un espacio de dos dimensiones

Es un método de reducción de dimenciones, la información que se retiene para cada dimensión es llamada eigenvalor

Se utiliza el valor Phi2, o total de inercia calculado anteriormente.

Los eigenvalores se calula para las columnas y para los renglones

Las coordenadas de los renglones y de las columnas son los eigenvalores

Se calcula un índice de asociación

Si hay una atracción (asociación) las coordenadas de las renglones y de las columnas tienen el mismo signo de los ejes, Si hay repulsión (no asociación) las coordenadas correspondientes tienen signos diferentes Un alto valor indica una fuerte atracción o repulsión

# Grand total
n <- sum(tablasitdineroT)
# Standardized residuals
residuals <- chisq$residuals/sqrt(n)
# Number of dimensions
nb.axes <- min(nrow(residuals)-1, ncol(residuals)-1)
# Singular value decomposition
res.svd <- svd(residuals, nu = nb.axes, nv = nb.axes)
res.svd

## $d
## [1] 2.415200e-01 1.361624e-01 2.072475e-17
## 
## $u
##            [,1]        [,2]
## [1,] -0.4098638 -0.02487072
## [2,] -0.5516601  0.36204079
## [3,]  0.5587860 -0.34127679
## [4,]  0.1974004  0.60561089
## [5,] -0.4200881 -0.62054292
## 
## $v
##            [,1]       [,2]
## [1,]  0.4497829  0.2683082
## [2,] -0.8836579  0.2722869
## [3,] -0.1297850 -0.9240512

sv <- res.svd$d[1:nb.axes] # singular value
u <-res.svd$u
v <- res.svd$v

# Eigenvalues
eig <- sv^2
# Variances in percentage
variance <- eig*100/sum(eig)
# Cumulative variances
cumvar <- cumsum(variance)
eig<- data.frame(eig = eig, variance = variance,
                     cumvariance = cumvar)
head(eig)

##          eig variance cumvariance
## 1 0.05833193 75.88176    75.88176
## 2 0.01854021 24.11824   100.00000

barplot(eig[, 2], names.arg=1:nrow(eig), 
       main = "Variances",
       xlab = "Dimensions",
       ylab = "Percentage of variances",
       col ="steelblue")
# Add connected line segments to the plot
lines(x = 1:nrow(eig), eig[, 2], 
      type="b", pch=19, col = "red")

¿Cuantas dimensiones (ejes) se pueden retener?:

El número máximo de ejes son el el valor mínimo entre (los renglones menos uno, las columnas menos uno, en este ejercicio hay 5 renglones y 3 columnas, es el valor menor entre 3 y 2, es decir dos ejes dos dimensiones

Coordenadas de las variables de renglón

# row sum
row.sum <- apply(tablasitdineroT, 1, sum)
# row mass
row.mass <- row.sum/n
# row coord = sv * u /sqrt(row.mass)
cc <- t(apply(u, 1, '*', sv)) # each row X sv
row.coord <- apply(cc, 2, '/', sqrt(row.mass))
rownames(row.coord) <- rownames(tablasitdineroT)
colnames(row.coord) <- paste0("Dim.", 1:nb.axes)
round(row.coord,3)

##                         Dim.1  Dim.2
## ingayudasfamgob        -0.378 -0.013
## ingpropyayudasfamgob   -0.442  0.163
## siningpropniotrafuente  0.229 -0.079
## soloayudagob            0.083  0.143
## soloingprop            -0.252 -0.210

# plot
plot(row.coord, pch=19, col = "blue")
text(row.coord, labels =rownames(row.coord), pos = 3, col ="blue")
abline(v=0, h=0, lty = 2)

Coordenadas de las variables de columnas

# Coordinates of columns
col.sum <- apply(tablasitdineroT, 2, sum)
col.mass <- col.sum/n
# coordinates sv * v /sqrt(col.mass)
cc <- t(apply(v, 1, '*', sv))
col.coord <- apply(cc, 2, '/', sqrt(col.mass))
rownames(col.coord) <- colnames(tablasitdineroT)
colnames(col.coord) <- paste0("Dim", 1:nb.axes)
head(col.coord)

##                      Dim1        Dim2
## Cas o uni      0.12751924  0.04288554
## Sep,div,viuda -0.56045450  0.09736145
## Soltera       -0.08717726 -0.34992810

plot(col.coord, pch=17, col = "red")
text(col.coord, labels =rownames(col.coord), pos = 3, col ="red")
abline(v=0, h=0, lty = 2)

Gráfico con las variables de renglón y columna para ver la asociación

xlim <- range(c(row.coord[,1], col.coord[,1]))*1.1
ylim <- range(c(row.coord[,2], col.coord[,2]))*1.1
# Plot of rows
plot(row.coord, pch=19, col = "blue", xlim = xlim, ylim = ylim)
text(row.coord, labels =rownames(row.coord), pos = 3, col ="blue")
# plot off columns
points(col.coord, pch=17, col = "red")
text(col.coord, labels =rownames(col.coord), pos = 3, col ="red")
abline(v=0, h=0, lty = 2)

Se puede interpretar la distancia entre los puntos de los renglones o entre los puntos de las columnas pero la distancia entre ellas no tiene mucho significado.

Es necesario hacer un diagnótico Tomando en cuenta la inercia total.

Para saber cuánta información hay en el gráfico

Se calcula la contribución de renglones y columnas

Contribución de renglones en %

# contrib <- row.mass * row.coord^2/eigenvalue
cc <- apply(row.coord^2, 2, "*", row.mass)
row.contrib <- t(apply(cc, 1, "/", eig[1:nb.axes,1])) *100
round(row.contrib, 2)

##                        Dim.1 Dim.2
## ingayudasfamgob        16.80  0.06
## ingpropyayudasfamgob   30.43 13.11
## siningpropniotrafuente 31.22 11.65
## soloayudagob            3.90 36.68
## soloingprop            17.65 38.51

corrplot(row.contrib, is.cor = FALSE)

Contribución de columnas en %

# contrib <- col.mass * col.coord^2/eigenvalue
cc <- apply(col.coord^2, 2, "*", col.mass)
col.contrib <- t(apply(cc, 1, "/", eig[1:nb.axes,1])) *100
round(col.contrib, 2)

##                Dim1  Dim2
## Cas o uni     20.23  7.20
## Sep,div,viuda 78.09  7.41
## Soltera        1.68 85.39

corrplot(col.contrib, is.cor = FALSE)

Calidad de la representación .. La variables estudiadas, son los principales componentes de lo observado.

Renglones

Es llamada también COS2

Se calcula con la relación entre las coordenadas de los renglones y la distancia del promedio Muestra la importancia de los componentes principales de lo que se observa

Note como se explica cada variable, el total por rengón es 1 o 100%

La calidad de la representación de los renglones en el mapa de factores es:

# http://www.utdallas.edu/~herve/abdi-awPCA2010.pdf
row.profile <- tablasitdineroT/row.sum
#head(round(row.profile, 3))
average.profile <- col.sum/n
#head(round(average.profile, 3))

d2.row <- apply(row.profile, 1, 
                function(row.p, av.p){sum(((row.p - av.p)^2)/av.p)}, 
                average.rp)

#head(round(d2.row,3))
row.cos2 <- apply(row.coord^2, 2, "/", d2.row)
round(row.cos2, 3)

##                        Dim.1 Dim.2
## ingayudasfamgob        0.999 0.001
## ingpropyayudasfamgob   0.880 0.120
## siningpropniotrafuente 0.894 0.106
## soloayudagob           0.251 0.749
## soloingprop            0.590 0.410

corrplot(row.cos2, is.cor = FALSE)

Columnas

col.profile <- t(tablasitdineroT)/col.sum
col.profile <- t(col.profile)
#head(round(col.profile, 3))
average.profile <- row.sum/n
#head(round(average.profile, 3))
d2.col <- apply(col.profile, 2, 
        function(col.p, av.p){sum(((col.p - av.p)^2)/av.p)}, 
        average.profile)
#round(d2.col,3)

col.cos2 <- apply(col.coord^2, 2, "/", d2.col)
round(col.cos2, 3)

##                Dim1  Dim2
## Cas o uni     0.898 0.102
## Sep,div,viuda 0.971 0.029
## Soltera       0.058 0.942

corrplot(col.cos2, is.cor = FALSE)

Uso de paquete FactoMineR

res.ca <- CA(tablasitdineroT, graph = F)
# print
res.ca

## **Results of the Correspondence Analysis (CA)**
## The row variable has  5  categories; the column variable has 3 categories
## The chi square of independence between the two variables is equal to 2087.617 (p-value =  0 ).
## *The results are available in the following objects:
## 
##    name              description                   
## 1  "$eig"            "eigenvalues"                 
## 2  "$col"            "results for the columns"     
## 3  "$col$coord"      "coord. for the columns"      
## 4  "$col$cos2"       "cos2 for the columns"        
## 5  "$col$contrib"    "contributions of the columns"
## 6  "$row"            "results for the rows"        
## 7  "$row$coord"      "coord. for the rows"         
## 8  "$row$cos2"       "cos2 for the rows"           
## 9  "$row$contrib"    "contributions of the rows"   
## 10 "$call"           "summary called parameters"   
## 11 "$call$marge.col" "weights of the columns"      
## 12 "$call$marge.row" "weights of the rows"

head(res.ca$eig)[, 1:2]

##       eigenvalue percentage of variance
## dim 1 0.05833193               75.88176
## dim 2 0.01854021               24.11824

# barplot of percentage of variance
barplot(res.ca$eig[,2], names.arg = rownames(res.ca$eig))

plot(res.ca, invisible ="col")

plot(res.ca, invisible ="row")

plot(res.ca)

Tratamiento de Variables en encuestas, independencia y correspondencia Medio Rural

Claudia Guerrero

2 de abril de 2018

Distribución de mujeres de 15 años y más por disponibilidad de ingresos según estado conyugal

Creación de nuevas variables

Análisis estadísticos renglones, columnas, chi cuadrado, gtest, correspondencia

Interpretación de la tabla de contingencia, el tamaño de los puntos refleja la magnitud de los valores de la tabla

Cálculo de los totales de margen distribución marginal

Variables en renglones

Distancia entre renglones

Distancia de cada renglón con el promedio de renglón

Distancia de cada renglón con cada uno de ellos, en la tabla de contingencia

Peso de cada renglón Row mass

Inercia

En resumen la información de cada renglón, distancia, peso e inercia puede concentrarse en esta tabla

Variables en columnas

Distancia entre columnas

Distancia de cada columna con el promedio de columna

Distancia de cada columna con cada una de ellos, en la tabla de contingencia

Peso de cada columna Col mass

Inercia

En resumen la información de cada renglón, distancia, peso e inercia puede concentrarse en esta tabla

Relación y asociación entre las variables de renglón y columna

Valores esperados, Valores observados

Residuales

Contribución

Inercia total

Gráfico de mozaico, utilizado en las tablas de contingencia para examinar la asociación entre variables categóricas

G-test: Likelihood ratio test

Interpretación del radio likehood como asociación entre renglones y columnas

Análisis de correspondencias

Coordenadas de las variables de renglón

Coordenadas de las variables de columnas

Gráfico con las variables de renglón y columna para ver la asociación

Calidad de la representación .. La variables estudiadas, son los principales componentes de lo observado.

Renglones

Columnas

Uso de paquete FactoMineR