El siguiente documento tiene como propósito comunicar los resultados de la evaluación de los supuestos de una regresión logistica multivariada. Además se proporciona el código en el lenguaje R para que el usuario reproduzca el análisis. La evaluación de supuestos parte de una base de datos previa, la cual se utilizó en la creación de los cinco modelos logisticos multivariados presentados en el articulo. La pueden encontrar en el sitio web http://rpubs.com/Sahlre/BaseDatos_y_Resultados allí se proporciona las url de las bases de datos iniciales así como todo el código que las manipula para crear la base de datos final sobre la que se hace tanto la estimación de los cinco modelos como la evaluación de los supuestos. El resultado principal de este documento es que los cinco modelos estimados en el artículo cumplen con los supuestos de la regresión logistica multivariada.
Si usted detecta algún error, tiene alguna sugerencia o requiere mayor información puede enviar un correo electrónico a shlondon8@gmail.com
Los modelos propuestos cumplen los supuestos que sustentan la aplicación del modelo de regresión logística. Según sitio web UCLA: Statistical Consulting Group y Hosmer y Lemeshow (2000) los supuestos son:
Se asume que los dos primeros supuestos se satisfacen debido a que la recolección de los datos por el proyecto GEM-Colombia años 2011 y 2012 se fundamentó en muestras aleatorias y se proporcionó a los datos el pesos apropiados para que la muestra coincida con la estructura de edad y género generalmente del Departamento Nacional de Estadística (DANE) o de la base de datos internacional de Censo proporcionada por United States Census Bureau. Los supuestos 3, 4 y 5 sugieren que las variables independientes planteadas corresponden a las mejores predictoras de la variable dependiente, es decir el modelo esta correctamente especificado; se asume que estos supuestos se satisfacen ya que el modelo logistico propuesto se fundamenta en la Teoría del Comportamiento Planeado y en la relación, empírica y teórica, de variables socieconómicas, perceptuales y de entorno con la intención emprendedora, que se ha expuesto en la literatura; por otra parte al plantear varios modelos entorno a la variable género se esta evaluando la importancia de esa variable en la explicación de la intención emprendedora, determinando así cuales variables e interacciones entre variables importan en el modelo.
Se asume que el útlimo supuesto se satisface. La tabla 1 muestra la estimación de la correlación de Spearman entre todas las variables independientes de análisis, así como el valor p (ver tabla 2) de la prueba de hipótesis que se realiza en cada estimación. Se observa que hay una correlación entre casi todas ellas sugiriendo la presencia de multicolinealidad, sin embargo dichas correlaciones son débiles evidenciando leve multicolinealidad.
#Identificar la correlación entre variables
bdcopy <- bd #Se crea una copia de la base de datos
#Se organizan los niveles de las variables cualitativas con nivel de medición ordinal
#Es el caso de GEMEDUC y se reordena la variable GEMWORK3
bdcopy$GEMEDUC <- factor(bdcopy$GEMEDUC,
levels = c("NONE", "SOME SECONDARY","SECONDARY DEGREE", "POST SECONDARY",
"GRAD EXP"))
bdcopy$GEMWORK3 <- factor(bdcopy$GEMWORK3,
levels = c("Retired students","Not working","Work:F-T, P-T"))
#Se transforman las variables cualitativas de dos niveles tipo factor
#a una variable tipo númerica con dos valores 0 y 1
#Se selecciona de bdcopy las variables sobre las que se puede automatizar la transformación
bdcopy1 <- bdcopy[,c("futsup",
"opport","suskill","fearfail",
"nbgoodc","nbstatus","knowent","nbmedia")]
bdcopy2 <- apply(bdcopy1, 2, function(x){
x1 <- factor(x,
levels = c("No","Yes"),
labels = c(1:2))
as.numeric(x1)
})
bdcopy2 <- as.data.frame(bdcopy2)
#Se transforma manualmente el resto de variables independientes
bdcopy$gender <- factor(bdcopy$gender,
labels = c(1:2))
bdcopy$gender <- as.numeric(bdcopy$gender)
bdcopy$GEMEDUC <- factor(bdcopy$GEMEDUC,
labels = c(1:5))
bdcopy$GEMEDUC <- as.numeric(bdcopy$GEMEDUC)
bdcopy$GEMWORK3 <- factor(bdcopy$GEMWORK3,
labels = c(1:3))
bdcopy$GEMWORK3 <- as.numeric(bdcopy$GEMWORK3)
bdcopy$GEMHHINC <- factor(bdcopy$GEMHHINC,
labels = c(1:3))
bdcopy$GEMHHINC <- as.numeric(bdcopy$GEMHHINC)
#Se crea un data frame con las siguientes variables "gender","GEMEDUC","GEMWORK3","GEMHHINC"
bdcopy3 <- bdcopy[,c("gender", "age","GEMEDUC","GEMWORK3","GEMHHINC")]
#Se crea data frame que me permitirá analizar la correlación entre las variables independientes
bdcopy4 <- cbind.data.frame(bdcopy3,bdcopy2)
#Organizar las columnas de tal manera que el analisis de correlación proporcione en orden los resultados expuestos en el documento
bdcopy5 <- bdcopy4[,-6]
bdcopy6 <- bdcopy4[,6]
bdcopy7 <- cbind.data.frame(bdcopy6, bdcopy5)
names(bdcopy7) <- c("futsup",names(bdcopy7)[-1])
# Correlaciones con niveles de significancia y tamaños de muestra
library(Hmisc)
correlaciones <- rcorr(as.matrix(bdcopy7),type = "spearman")
corrSpearman <- correlaciones$r
corrSpearman <- as.data.frame(corrSpearman)
corrSpearmanValoresP <- correlaciones$P
corrSpearmanValoresP <- as.data.frame(corrSpearmanValoresP)
library(knitr)
kable(round(corrSpearman,2), caption = "Tabla 1")
futsup | gender | age | GEMEDUC | GEMWORK3 | GEMHHINC | opport | suskill | fearfail | nbgoodc | nbstatus | knowent | nbmedia | |
---|---|---|---|---|---|---|---|---|---|---|---|---|---|
futsup | 1.00 | 0.10 | -0.15 | 0.04 | 0.11 | 0.04 | 0.12 | 0.22 | -0.09 | 0.04 | 0.01 | 0.13 | 0.02 |
gender | 0.10 | 1.00 | -0.06 | 0.06 | 0.22 | 0.15 | 0.03 | 0.12 | -0.10 | -0.03 | 0.03 | 0.10 | -0.04 |
age | -0.15 | -0.06 | 1.00 | -0.18 | 0.06 | -0.04 | 0.00 | 0.06 | 0.10 | 0.04 | 0.07 | -0.06 | 0.12 |
GEMEDUC | 0.04 | 0.06 | -0.18 | 1.00 | 0.16 | 0.41 | -0.07 | 0.13 | -0.07 | -0.11 | -0.13 | 0.19 | -0.21 |
GEMWORK3 | 0.11 | 0.22 | 0.06 | 0.16 | 1.00 | 0.14 | 0.03 | 0.22 | -0.05 | -0.01 | -0.01 | 0.14 | -0.02 |
GEMHHINC | 0.04 | 0.15 | -0.04 | 0.41 | 0.14 | 1.00 | -0.02 | 0.10 | -0.06 | -0.07 | -0.07 | 0.20 | -0.14 |
opport | 0.12 | 0.03 | 0.00 | -0.07 | 0.03 | -0.02 | 1.00 | 0.11 | -0.08 | 0.09 | 0.07 | 0.10 | 0.17 |
suskill | 0.22 | 0.12 | 0.06 | 0.13 | 0.22 | 0.10 | 0.11 | 1.00 | -0.17 | 0.00 | 0.00 | 0.23 | 0.01 |
fearfail | -0.09 | -0.10 | 0.10 | -0.07 | -0.05 | -0.06 | -0.08 | -0.17 | 1.00 | -0.01 | 0.04 | -0.07 | 0.02 |
nbgoodc | 0.04 | -0.03 | 0.04 | -0.11 | -0.01 | -0.07 | 0.09 | 0.00 | -0.01 | 1.00 | 0.10 | -0.04 | 0.13 |
nbstatus | 0.01 | 0.03 | 0.07 | -0.13 | -0.01 | -0.07 | 0.07 | 0.00 | 0.04 | 0.10 | 1.00 | -0.04 | 0.18 |
knowent | 0.13 | 0.10 | -0.06 | 0.19 | 0.14 | 0.20 | 0.10 | 0.23 | -0.07 | -0.04 | -0.04 | 1.00 | -0.05 |
nbmedia | 0.02 | -0.04 | 0.12 | -0.21 | -0.02 | -0.14 | 0.17 | 0.01 | 0.02 | 0.13 | 0.18 | -0.05 | 1.00 |
kable(round(corrSpearmanValoresP,4), caption = "Tabla 2")
futsup | gender | age | GEMEDUC | GEMWORK3 | GEMHHINC | opport | suskill | fearfail | nbgoodc | nbstatus | knowent | nbmedia | |
---|---|---|---|---|---|---|---|---|---|---|---|---|---|
futsup | NA | 0e+00 | 0.0000 | 0 | 0.0000 | 0.0000 | 0.0000 | 0.0000 | 0.0000 | 0.0000 | 0.2324 | 0 | 0.0265 |
gender | 0.0000 | NA | 0.0000 | 0 | 0.0000 | 0.0000 | 0.0001 | 0.0000 | 0.0000 | 0.0006 | 0.0008 | 0 | 0.0000 |
age | 0.0000 | 0e+00 | NA | 0 | 0.0000 | 0.0000 | 0.5367 | 0.0000 | 0.0000 | 0.0000 | 0.0000 | 0 | 0.0000 |
GEMEDUC | 0.0000 | 0e+00 | 0.0000 | NA | 0.0000 | 0.0000 | 0.0000 | 0.0000 | 0.0000 | 0.0000 | 0.0000 | 0 | 0.0000 |
GEMWORK3 | 0.0000 | 0e+00 | 0.0000 | 0 | NA | 0.0000 | 0.0004 | 0.0000 | 0.0000 | 0.4612 | 0.0574 | 0 | 0.0470 |
GEMHHINC | 0.0000 | 0e+00 | 0.0000 | 0 | 0.0000 | NA | 0.0213 | 0.0000 | 0.0000 | 0.0000 | 0.0000 | 0 | 0.0000 |
opport | 0.0000 | 1e-04 | 0.5367 | 0 | 0.0004 | 0.0213 | NA | 0.0000 | 0.0000 | 0.0000 | 0.0000 | 0 | 0.0000 |
suskill | 0.0000 | 0e+00 | 0.0000 | 0 | 0.0000 | 0.0000 | 0.0000 | NA | 0.0000 | 0.6535 | 0.6247 | 0 | 0.1250 |
fearfail | 0.0000 | 0e+00 | 0.0000 | 0 | 0.0000 | 0.0000 | 0.0000 | 0.0000 | NA | 0.4369 | 0.0000 | 0 | 0.0029 |
nbgoodc | 0.0000 | 6e-04 | 0.0000 | 0 | 0.4612 | 0.0000 | 0.0000 | 0.6535 | 0.4369 | NA | 0.0000 | 0 | 0.0000 |
nbstatus | 0.2324 | 8e-04 | 0.0000 | 0 | 0.0574 | 0.0000 | 0.0000 | 0.6247 | 0.0000 | 0.0000 | NA | 0 | 0.0000 |
knowent | 0.0000 | 0e+00 | 0.0000 | 0 | 0.0000 | 0.0000 | 0.0000 | 0.0000 | 0.0000 | 0.0000 | 0.0000 | NA | 0.0000 |
nbmedia | 0.0265 | 0e+00 | 0.0000 | 0 | 0.0470 | 0.0000 | 0.0000 | 0.1250 | 0.0029 | 0.0000 | 0.0000 | 0 | NA |
Para asegurar que los medelos logísticos cumplan con el último supuesto se determinó para cada variable un indicador de cuánta colinealidad puede tolerar un análisis de regresión. Este se denomina tolerancia y asume valores entre 0 y 1, como regla general, si asume un valor igual o inferior a 0.1 esto es un indicio de colinealidad entre la variable de interés con el resto (UCLA: Statistical Consulting Group, 2016). En la tabla 3 se confirma el dictamen realizado en el párrafo anterior, todas las variables independientes presentan débil multicolinealidad, todos los valores asociados a la tolerancia son muy superiores a 0.1. De esta manera, los modelos propuestos cumplen la no combinación lineal entre las variables independientes.
El siguiente código permite calcular la tolerancia para cada una de las variables independientes, así como la tabla 3 que se menciona arriba
#Cálculo tolerancia para la variable age
ModeloEdad <- summary(lm(age ~ gender + GEMEDUC + GEMWORK3 + GEMHHINC + #Variables socioeconómicas
opport + suskill + fearfail + #Variables perceptuales
nbgoodc + nbstatus + knowent + nbmedia, #Variables de entorno
data = bd))
#Tolerancia
ToleranciaEdad <- 1 - ModeloEdad$r.squared
#Cálculo tolerancia para la variable gender
library(rms)
ModeloGenero <- lrm(gender ~ age + GEMEDUC + GEMWORK3 + GEMHHINC + #Variables socioeconómicas
opport + suskill + fearfail + #Variables perceptuales
nbgoodc + nbstatus + knowent + nbmedia, #Variables de entorno,
data = bd)
ToleranciaGenero <- 1 - ModeloGenero$stats["R2"]
#Cálculo tolerancia para la variable GEMEDUC
ModeloEducacion <- summary(lm(GEMEDUC ~ gender + age + GEMWORK3 + GEMHHINC +
opport + suskill + fearfail +
nbgoodc + nbstatus + knowent,
data = bdcopy7))
ToleranciaEducacion <- 1 - ModeloEducacion$r.squared
#Cálculo tolerancia para la variable GEMWORK3
ModeloEstadoLaboral <- summary(lm(GEMWORK3 ~ gender + age + GEMEDUC + GEMHHINC +
opport + suskill + fearfail +
nbgoodc + nbstatus + knowent,
data = bdcopy7))
ToleranciaEstadoLaboral <- 1 - ModeloEstadoLaboral$r.squared
#Cálculo tolerancia para la variable GEMHHINC
ModeloIngreso <- summary(lm(GEMHHINC ~ gender + age + GEMEDUC + GEMWORK3 +
opport + suskill + fearfail +
nbgoodc + nbstatus + knowent,
data = bdcopy7))
ToleranciaIngreso <- 1 - ModeloIngreso$r.squared
#Cálculo tolerancia variable opport
ModeloOpport <- lrm(opport ~ age + gender +GEMEDUC + GEMWORK3 + GEMHHINC + #Variables socioeconómicas
suskill + fearfail + #Variables perceptuales
nbgoodc + nbstatus + knowent + nbmedia, #Variables de entorno,
data = bd)
ToleranciaOpport <- 1 - ModeloOpport$stats["R2"]
#Cálculo tolerancia variable suskill
ModeloSuskill <- lrm(suskill ~ age + gender +GEMEDUC + GEMWORK3 + GEMHHINC + #Variables socioeconómicas
opport + fearfail + #Variables perceptuales
nbgoodc + nbstatus + knowent + nbmedia, #Variables de entorno,
data = bd)
ToleranciaSuskill <- 1 - ModeloSuskill$stats["R2"]
#Cálculo tolerancia variable fearfail
ModeloFearfail <- lrm(fearfail ~ age + gender +GEMEDUC + GEMWORK3 + GEMHHINC + #Variables socioeconómicas
opport+ suskill + #Variables perceptuales
nbgoodc + nbstatus + knowent + nbmedia, #Variables de entorno,
data = bd)
ToleranciaFearfail <- 1 - ModeloFearfail$stats["R2"]
#Cálculo tolerancia variable nbgoodc
ModeloNbgoodc <- lrm(nbgoodc ~ age + gender +GEMEDUC + GEMWORK3 + GEMHHINC + #Variables socioeconómicas
opport+ suskill + fearfail + #Variables perceptuales
nbstatus + knowent + nbmedia, #Variables de entorno,
data = bd)
ToleranciaNbgoodc <- 1 - ModeloNbgoodc$stats["R2"]
#Cálculo tolerancia variable nbstatus
ModeloNbstatus <- lrm(nbstatus ~ age + gender +GEMEDUC + GEMWORK3 + GEMHHINC + #Variables socioeconómicas
opport+ suskill + fearfail + #Variables perceptuales
nbgoodc + knowent + nbmedia, #Variables de entorno,
data = bd)
ToleranciaNbstatus <- 1 - ModeloNbstatus$stats["R2"]
#Cálculo tolerancia variable knowent
ModeloKnowent <- lrm( knowent ~ age + gender +GEMEDUC + GEMWORK3 + GEMHHINC + #Variables socioeconómicas
opport+ suskill + fearfail + #Variables perceptuales
nbgoodc + nbstatus + nbmedia, #Variables de entorno,
data = bd)
ToleranciaKnowent <- 1 - ModeloKnowent$stats["R2"]
#Cálculo tolerancia variable nbmedia
ModeloNbmedia <- lrm( nbmedia ~ age + gender +GEMEDUC + GEMWORK3 + GEMHHINC + #Variables socioeconómicas
opport+ suskill + fearfail + #Variables perceptuales
nbgoodc + nbstatus + knowent , #Variables de entorno,
data = bd)
ToleranciaNbmedia <- 1 - ModeloNbmedia$stats["R2"]
Tabla3 <- data.frame(Variable = c(names(bdcopy7)[-1]),
Tolerancia = c(ToleranciaEdad, ToleranciaGenero,
ToleranciaEducacion,
ToleranciaEstadoLaboral,
ToleranciaIngreso,
ToleranciaOpport, ToleranciaSuskill,
ToleranciaFearfail,
ToleranciaNbgoodc,
ToleranciaNbstatus,
ToleranciaKnowent,
ToleranciaNbmedia))
kable(Tabla3, caption = "Tabla 3")
Variable | Tolerancia |
---|---|
gender | 0.8313916 |
age | 0.8827916 |
GEMEDUC | 0.7644094 |
GEMWORK3 | 0.9237648 |
GEMHHINC | 0.8079604 |
opport | 0.9139165 |
suskill | 0.8370638 |
fearfail | 0.9253335 |
nbgoodc | 0.9359449 |
nbstatus | 0.9290986 |
knowent | 0.8563267 |
nbmedia | 0.8567361 |