Trabajo final enRedados

Camila Andrea Lira Davila

2022-11-23

Predicción del desempeño de una persona con condición de discapacidad empleando la regresión logística ordinal y la regresión lineal múltiple - Planteamiento de la pregunta de investigación

¿De qué manera los factores contextuales determinan el desempeño de una persona con condición de discapacidad?

Presentación y análisis de resultados

Activamos las librerías

library(rio)
library(haven)
library(dslabs)
library(MASS)
library(car)
library(dplyr)
library(tidyverse)
library(DescTools)#para el pseudo R2
library(ggfortify)
library(see)
library(patchwork)
library(performance)
library(car)
library(lmtest)#para usar breusch pagan
library(nortest)#para usar Kolmogorov-Smirnov

Limpieza de la data

bd=import("Base de Datos II Estudio Nacional de la Discapacidad.sav")
bd_1=bd%>%filter(edad > 18)
data<- bd_1[,c("des_puntaje_adulto","educc","sexo","h4","h9","zona","c41_1","disc_grado_adulto", "fa1", "fa2", "fa3","fa4","fa5","fa6","fa7","fa8","fa9","fa10","fa11","fa22","fa25_6","fa32","fa32_1","fa26_3","fa26_6","fa40","d1","d2","d3","d4","d5","d6","d7","d10","d11","d12","d13","d14","d15","d16","d19","d20","d21","d22","d23","d24","d25","d26","d27","d28","d29","d34","d35","d36")]

Recodificación de variables

1: Pertenencia a una comunidad indígena

table(data$h9)
## 
##     1     2     3     4     5     6     7     8     9    10    96 
##   388   104    45  2004    42    31    15     1    97 26757    24
class(data$h9)
## [1] "numeric"
data$h9=as.numeric(data$h9)
data$indigena <- car::recode(data$h9, "1=1; 2=1; 3=1; 4=1; 5=1; 6=1; 7=1; 8=1; 9=1; 10=2; else = NA")
table(data$indigena)
## 
##     1     2 
##  2727 26757

2. Pertenencia a zona rural o urbana

table(data$zona)
## 
##     1     2 
## 24819  4689
#urbano=1;  rural=2

Nivel de educación

niveles:

data$educc=as.numeric(data$educc)
data$educacion <- car::recode(data$educc, "0=0; 1=1; 2=2; 3=3; 4=4; 5=5; 6=6; else = NA")
table(data$educacion)
## 
##    0    1    2    3    4    5    6 
##  736 4248 3205 4093 8462 3620 5115
class(data$educacion)
## [1] "numeric"

si la persona es casada o no*

data$h4=as.numeric(data$h4)
data$casado <- car::recode(data$h4, "1=1; 2=2; 3=2; 4=2; 5=2; 6=2; 7=2; else = NA")
table(data$casado)
## 
##     1     2 
## 11393 18115
class(data$casado)
## [1] "numeric"

sexo, grado de discapacidad de la persona

table(data$sexo)
## 
##     1     2 
## 13586 15922
#1=hombre; 2=mujer
table(data$disc_grado_adulto)
## 
##    0    1    2 
## 9453 1518 1090
#0=persona sin discapacidad; 1= persona con discapacidad leve a moderada; 2=persona con discapacidad severa

Dolor

table(data$d19)
## 
##    1    2    3    4    5   88   96 
## 4543 3209 2576 1288  437    6    2
data$d19=as.numeric(data$d19)
data$dolor <- car::recode(data$d19, "0=0; 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$dolor)
## 
##    1    2    3    4    5 
## 4543 3209 2576 1288  437

Indicador de vista

table(data$d15)
## 
##    1    2    3    4    5   88   96 
## 8119 1913 1261  573  186    6    3
data$d15=as.numeric(data$d15)
data$d15 <- car::recode(data$d15, "0=0; 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")

table(data$d16)
## 
##    1    2    3    4    5   88   96   99 
## 8504 1895 1082  440  129    6    4    1
data$d16=as.numeric(data$d16)
data$d16 <- car::recode(data$d16, "0=0; 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")

data$vista=data$d15+data$d16
summary(data$vista)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   2.000   2.000   2.000   3.062   4.000  10.000   17459
data$vista=(((data$d15+data$d16)-2)*5/8)
summary(data$vista)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   0.000   0.000   0.000   0.663   1.250   5.000   17459

Elaboración de indicadores

Indicador de movilidad

table(data$d1)
## 
##    1    2    3    4    5   99 
## 8051 1910 1252  635  212    1
data$d1=as.numeric(data$d1)
data$d1 <- car::recode(data$d1, " 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$d1)
## 
##    1    2    3    4    5 
## 8051 1910 1252  635  212
table(data$d2)
## 
##    1    2    3    4    5   88   96   99 
## 7961 1806 1261  673  355    2    2    1
data$d2=as.numeric(data$d2)
data$d2 <- car::recode(data$d2, " 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$d2)
## 
##    1    2    3    4    5 
## 7961 1806 1261  673  355
table(data$d3)
## 
##    1    2    3    4    5   96   99 
## 9666 1040  710  413  225    4    3
data$d3=as.numeric(data$d3)
data$d3 <- car::recode(data$d3, " 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$d3)
## 
##    1    2    3    4    5 
## 9666 1040  710  413  225
table(data$d4)
## 
##    1    2    3    4    5   88   96   99 
## 9598 1102  713  405  239    2    1    1
data$d4=as.numeric(data$d4)
data$d4 <- car::recode(data$d4, " 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$d4)
## 
##    1    2    3    4    5 
## 9598 1102  713  405  239
table(data$d5)
## 
##    1    2    3    4    5   88   99 
## 7618 1631 1148  839  762   59    4
data$d5=as.numeric(data$d5)
data$d5 <- car::recode(data$d5, " 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$d5)
## 
##    1    2    3    4    5 
## 7618 1631 1148  839  762
table(data$d6)
## 
##    1    2    3    4    5   88   96   99 
## 5869 1699 1383 1093 1449  538    5   25
data$d6=as.numeric(data$d6)
data$d6 <- car::recode(data$d6, " 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$d6)
## 
##    1    2    3    4    5 
## 5869 1699 1383 1093 1449
table(data$d7)
## 
##    1    2    3    4    5   88   96   99 
## 9356 1097  764  494  322   16   10    2
data$d7=as.numeric(data$d7)
data$d7 <- car::recode(data$d7, " 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$d7)
## 
##    1    2    3    4    5 
## 9356 1097  764  494  322
#lo estandarizamos del 1 al 5
data$movilidad=data$d1+data$d2+data$d3+data$d4+data$d5+data$d6+data$d7
summary(data$movilidad)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##    7.00    7.00    8.00   11.42   13.00   35.00   18073
data$movilidad=(((data$d1+data$d2+data$d3+data$d4+data$d5+data$d6+data$d7)-7)*5/28)
summary(data$movilidad)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   0.000   0.000   0.179   0.789   1.071   5.000   18073

Indicador cuidado personal

table(data$d10)
## 
##     1     2     3     4     5    96    99 
## 10956   533   311   158   101     1     1
data$d10=as.numeric(data$d10)
data$d10 <- car::recode(data$d10, " 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$d10)
## 
##     1     2     3     4     5 
## 10956   533   311   158   101
table(data$d11)
## 
##     1     2     3     4     5    96    99 
## 11505   299   147    61    45     3     1
data$d11=as.numeric(data$d11)
data$d11 <- car::recode(data$d11, " 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$d11)
## 
##     1     2     3     4     5 
## 11505   299   147    61    45
table(data$d12)
## 
##     1     2     3     4     5    88    96    99 
## 11407   309   172    87    80     1     4     1
data$d12=as.numeric(data$d12)
data$d12 <- car::recode(data$d12, " 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$d12)
## 
##     1     2     3     4     5 
## 11407   309   172    87    80
table(data$d13)
## 
##    1    2    3    4    5   88   96   99 
## 9705  824  613  397  490   21    6    5
data$d13=as.numeric(data$d13)
data$d13 <- car::recode(data$d13, " 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$d13)
## 
##    1    2    3    4    5 
## 9705  824  613  397  490
table(data$d14)
## 
##     1     2     3     4     5    88    96    99 
## 10294   932   471   188   158    12     3     3
data$d14=as.numeric(data$d14)
data$d14 <- car::recode(data$d14, " 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$d14)
## 
##     1     2     3     4     5 
## 10294   932   471   188   158
data$cuidadopersonal=data$d10+data$d11+data$d12+data$d13+data$d14
summary(data$cuidadopersonal)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   5.000   5.000   5.000   6.033   6.000  25.000   17499
data$cuidadopersonal=(((data$d10+data$d11+data$d12+data$d13+data$d14)-5)*5/20)
summary(data$cuidadopersonal)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   0.000   0.000   0.000   0.258   0.250   5.000   17499

Indicador relaciones interpersonales

table(data$d26)
## 
##     1     2     3     4     5    88    99 
## 10738   838   324   102    49     9     1
data$d26=as.numeric(data$d26)
data$d26 <- car::recode(data$d26, " 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$d26)
## 
##     1     2     3     4     5 
## 10738   838   324   102    49
table(data$d27)
## 
##     1     2     3     4     5    88    99 
## 10469   991   363   102    81    48     7
data$d27=as.numeric(data$d27)
data$d27 <- car::recode(data$d27, " 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$d27)
## 
##     1     2     3     4     5 
## 10469   991   363   102    81
table(data$d28)
## 
##     1     2     3     4     5    88    96    99 
## 10517   902   329    99    92   108     2    12
data$d28=as.numeric(data$d28)
data$d28 <- car::recode(data$d28, " 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$d28)
## 
##     1     2     3     4     5 
## 10517   902   329    99    92
table(data$d29)
## 
##    1    2    3    4    5   88   96   99 
## 9117  631  433  209  412 1027    3  229
data$d29=as.numeric(data$d29)
data$d29 <- car::recode(data$d29, " 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$d29)
## 
##    1    2    3    4    5 
## 9117  631  433  209  412
data$relacionesinterpersonales=data$d26+data$d27+data$d28+data$d29
summary(data$relacionesinterpersonales)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   4.000   4.000   4.000   4.875   5.000  20.000   18791
data$relacionesinterpersonales=(((data$d26+data$d27+data$d28+data$d29)-4)*5/16)
summary(data$relacionesinterpersonales)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   0.000   0.000   0.000   0.273   0.312   5.000   18791

Indicador de factores ambientales

data$fa1=as.numeric(data$fa1)
data$fa1 <- car::recode(data$fa1, " 1=5; 2=4; 3=3; 4=2; 5=1; else = NA")
table(data$fa1)
## 
##    1    2    3    4    5 
## 1659 1230 1827 1799 5376
data$fa2=as.numeric(data$fa2)
data$fa2 <- car::recode(data$fa2, " 1=5; 2=4; 3=3; 4=2; 5=1; else = NA")
table(data$fa2)
## 
##    1    2    3    4    5 
##  637  652 2348 1359 6569
data$fa3=as.numeric(data$fa3)
data$fa3 <- car::recode(data$fa3, " 1=5; 2=4; 3=3; 4=2; 5=1; else = NA")
table(data$fa3)
## 
##    1    2    3    4    5 
##  545  550 1501 1210 7990
data$fa4=as.numeric(data$fa4)
data$fa4 <- car::recode(data$fa4, " 1=5; 2=4; 3=3; 4=2; 5=1; else = NA")
table(data$fa4)
## 
##    1    2    3    4    5 
##  260  263 2457  588 5870
data$fa5=as.numeric(data$fa5)
data$fa5 <- car::recode(data$fa5, " 1=5; 2=4; 3=3; 4=2; 5=1; else = NA")
table(data$fa5)
## 
##    1    2    3    4    5 
## 1259 1026 1461 1301 6602
data$fa6=as.numeric(data$fa6)
data$fa6 <- car::recode(data$fa6, " 1=5; 2=4; 3=3; 4=2; 5=1; else = NA")
table(data$fa6)
## 
##    1    2    3    4    5 
##  340  473  922  831 9477
data$fa7=as.numeric(data$fa7)
data$fa7 <- car::recode(data$fa7, " 1=5; 2=4; 3=3; 4=2; 5=1; else = NA")
table(data$fa7)
## 
##    1    2    3    4    5 
##  424  687 1407 1103 8428
data$fa8=as.numeric(data$fa8)
data$fa8 <- car::recode(data$fa8, " 1=5; 2=4; 3=3; 4=2; 5=1; else = NA")
table(data$fa8)
## 
##    1    2    3    4    5 
##  179  432 1235  970 9232
data$fa9=as.numeric(data$fa9)
data$fa9 <- car::recode(data$fa9, " 1=5; 2=4; 3=3; 4=2; 5=1; else = NA")
table(data$fa9)
## 
##    1    2    3    4    5 
##  620  943 1705 1179 7601
data$fa10=as.numeric(data$fa10)
data$fa10 <- car::recode(data$fa10, "1=5; 2=4; 3=3; 4=2; 5=1; else = NA")
table(data$fa10)
## 
##    1    2    3    4    5 
## 1114 1503 2277 1223 5847
data$fa11=as.numeric(data$fa11)
data$fa11 <- car::recode(data$fa11, "1=1; 2=2; 3=3; 4=4; 5=5 ;else = NA")

data$fa32=as.numeric(data$fa32)
data$fa32 <- car::recode(data$fa32, "1=1; 2=2;else = NA")
table(data$fa32)
## 
##    1    2 
##  226 6816
data$fa40=as.numeric(data$fa40)
data$fa40 <- car::recode(data$fa40, "1=1; 2=2;else = NA")
table(data$fa10)
## 
##    1    2    3    4    5 
## 1114 1503 2277 1223 5847
summary(data$fa11)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   1.000   1.000   1.000   1.469   1.000   5.000   22498
summary(data$fa32)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   1.000   2.000   2.000   1.968   2.000   2.000   22466
#indicador
data$factores_ambientales.1=data$fa1+data$fa2+data$fa3+data$fa4+data$fa5+data$fa6+data$fa7+data$fa8+data$fa9+data$fa10
summary(data$factores_ambientales.1)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   10.00   37.00   44.00   41.91   48.00   50.00   20585
data$factores_ambientales=(((data$fa1+data$fa2+data$fa3+data$fa4+data$fa5+data$fa6+data$fa7+data$fa8+data$fa9+data$fa10)-10)*5/40)
summary(data$factores_ambientales)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   0.000   3.375   4.250   3.989   4.750   5.000   20585

Indicador de emocion

table(data$d24)
## 
##    1    2    3    4    5   88 
## 6373 2958 1666  759  298    7
data$d24=as.numeric(data$d24)
data$d24 <- car::recode(data$d24, " 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$d24)
## 
##    1    2    3    4    5 
## 6373 2958 1666  759  298
table(data$d25)
## 
##    1    2    3    4    5   88   96 
## 5509 3344 2002  866  333    6    1
data$d25=as.numeric(data$d25)
data$d25 <- car::recode(data$d25, " 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$d25)
## 
##    1    2    3    4    5 
## 5509 3344 2002  866  333
data$emocion=data$d24+data$d25
summary(data$emocion)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   2.000   2.000   3.000   3.745   5.000  10.000   17456
data$emocion=(((data$d24+data$d25)-2)*5/8)
summary(data$emocion)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   0.000   0.000   0.625   1.091   1.875   5.000   17456

Indicador energía y motivación

table(data$d20)
## 
##    1    2    3    4    5   88   96 
## 7669 1989 1492  719  187    3    2
data$d20=as.numeric(data$d20)
data$d20 <- car::recode(data$d20, " 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$d20)
## 
##    1    2    3    4    5 
## 7669 1989 1492  719  187
table(data$d21)
## 
##    1    2    3    4    5   88   96 
## 5929 3212 1916  760  236    7    1
data$d21=as.numeric(data$d21)
data$d21 <- car::recode(data$d21, " 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$d21)
## 
##    1    2    3    4    5 
## 5929 3212 1916  760  236
#indicador
table(data$energiaymotivacion)
## < table of extent 0 >
data$energiaymotivacion=data$d20+data$d21
summary(data$energiaymotivacion)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   2.000   2.000   3.000   3.504   4.000  10.000   17459
data$energiaymotivacion=(((data$d20+data$d21)-2)*5/8)
summary(data$energiaymotivacion)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   0.000   0.000   0.625   0.940   1.250   5.000   17459

Indicador de cognición

table(data$d34)
## 
##    1    2    3    4    5   88   99 
## 6751 3527 1253  383  138    8    1
data$d34=as.numeric(data$d34)
data$d34 <- car::recode(data$d34, " 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$d34)
## 
##    1    2    3    4    5 
## 6751 3527 1253  383  138
table(data$d36)
## 
##    1    2    3    4    5   88   96   99 
## 9686 1581  492  175  108   13    3    3
data$d36=as.numeric(data$d36)
data$d36 <- car::recode(data$d36, " 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$d36)
## 
##    1    2    3    4    5 
## 9686 1581  492  175  108
table(data$d35)
## 
##    1    2    3    4    5   88   99 
## 9074 1997  660  215  106    8    1
data$d35=as.numeric(data$d35)
data$d35 <- car::recode(data$d35, " 1=1; 2=2; 3=3; 4=4; 5=5; else = NA")
table(data$d35)
## 
##    1    2    3    4    5 
## 9074 1997  660  215  106
data$cognicion=data$d34+data$d35+data$d36
summary(data$cognicion)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   3.000   3.000   3.000   4.295   5.000  15.000   17473
data$cognicion=(((data$d34+data$d35+data$d36)-3)*5/12)
summary(data$cognicion)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   0.000   0.000   0.000   0.540   0.833   5.000   17473

Puntaje de desempeño de la persona

#invertimos los valores
data$desempeño.1=
  cut(data$des_puntaje_adulto, 
  breaks=c(0,25,50,75,100), 
  labels=c("bajo","medio-bajo","medio-alto","alto"))
table(data$desempeño.1)
## 
##       bajo medio-bajo medio-alto       alto 
##       1992       6999       2044         14
data$des_puntaje_adulto=100-data$des_puntaje_adulto
data$desempeño=
  cut(data$des_puntaje_adulto, 
  breaks=c(0,25,50,75,100), 
  labels=c("bajo","medio-bajo","medio-alto","alto"))
table(data$desempeño)
## 
##       bajo medio-bajo medio-alto       alto 
##         13       2044       6999       3004

Limpiamos la data

data<-na.omit(data)

Modelo de regresión logística ordinal

data$desempeño=as.factor(data$desempeño)
modelo1<- polr(desempeño~  educacion + sexo + zona + indigena + disc_grado_adulto + factores_ambientales + relacionesinterpersonales + movilidad +energiaymotivacion + dolor + cuidadopersonal + cognicion + vista + emocion, data = data, Hess=TRUE)
summary(modelo1)
## Call:
## polr(formula = desempeño ~ educacion + sexo + zona + indigena + 
##     disc_grado_adulto + factores_ambientales + relacionesinterpersonales + 
##     movilidad + energiaymotivacion + dolor + cuidadopersonal + 
##     cognicion + vista + emocion, data = data, Hess = TRUE)
## 
## Coefficients:
##                              Value Std. Error  t value
## educacion                 -0.05096    0.03433  -1.4843
## sexo                      -0.10765    0.10915  -0.9862
## zona                      -0.12660    0.15132  -0.8367
## indigena                  -0.06643    0.17461  -0.3804
## disc_grado_adulto         -0.82618    0.28748  -2.8739
## factores_ambientales       0.14062    0.06546   2.1481
## relacionesinterpersonales -2.84370    0.19813 -14.3528
## movilidad                 -3.33773    0.18993 -17.5737
## energiaymotivacion        -1.70867    0.10706 -15.9594
## dolor                     -1.00781    0.07449 -13.5294
## cuidadopersonal           -2.35585    0.33697  -6.9912
## cognicion                 -2.61884    0.15886 -16.4853
## vista                     -0.79286    0.08325  -9.5244
## emocion                   -1.57824    0.08828 -17.8767
## 
## Intercepts:
##                       Value    Std. Error t value 
## bajo|medio-bajo       -65.5316   2.1518   -30.4545
## medio-bajo|medio-alto -20.6159   0.8237   -25.0278
## medio-alto|alto        -3.4431   0.5510    -6.2484
## 
## Residual Deviance: 2212.514 
## AIC: 2246.514

Observar el p-value y determinar la significancia de las variables independientes

summary_table <- coef(summary(modelo1))
summary_table
##                                  Value Std. Error     t value
## educacion                  -0.05095703 0.03433022  -1.4843200
## sexo                       -0.10764707 0.10915315  -0.9862021
## zona                       -0.12660403 0.15131523  -0.8366906
## indigena                   -0.06643211 0.17461492  -0.3804492
## disc_grado_adulto          -0.82617568 0.28747891  -2.8738653
## factores_ambientales        0.14061963 0.06546260   2.1480909
## relacionesinterpersonales  -2.84369780 0.19812791 -14.3528383
## movilidad                  -3.33773092 0.18992767 -17.5736952
## energiaymotivacion         -1.70867474 0.10706403 -15.9593727
## dolor                      -1.00781167 0.07449061 -13.5293784
## cuidadopersonal            -2.35584751 0.33697372  -6.9911906
## cognicion                  -2.61883786 0.15885902 -16.4852956
## vista                      -0.79285693 0.08324502  -9.5243773
## emocion                    -1.57824229 0.08828473 -17.8767295
## bajo|medio-bajo           -65.53158127 2.15178723 -30.4544894
## medio-bajo|medio-alto     -20.61588859 0.82372056 -25.0277699
## medio-alto|alto            -3.44312038 0.55104098  -6.2483926
pval <- pnorm(abs(summary_table[, "t value"]),lower.tail = FALSE)* 2
pval
##                 educacion                      sexo                      zona 
##              1.377240e-01              3.240340e-01              4.027665e-01 
##                  indigena         disc_grado_adulto      factores_ambientales 
##              7.036120e-01              4.054818e-03              3.170653e-02 
## relacionesinterpersonales                 movilidad        energiaymotivacion 
##              1.022647e-46              3.918009e-69              2.451832e-57 
##                     dolor           cuidadopersonal                 cognicion 
##              1.049069e-41              2.725632e-12              4.680005e-61 
##                     vista                   emocion           bajo|medio-bajo 
##              1.660344e-21              1.790359e-71             1.044681e-203 
##     medio-bajo|medio-alto           medio-alto|alto 
##             3.048785e-138              4.146981e-10
summary_table <- cbind(summary_table, "p value" = pval)
summary_table
##                                  Value Std. Error     t value       p value
## educacion                  -0.05095703 0.03433022  -1.4843200  1.377240e-01
## sexo                       -0.10764707 0.10915315  -0.9862021  3.240340e-01
## zona                       -0.12660403 0.15131523  -0.8366906  4.027665e-01
## indigena                   -0.06643211 0.17461492  -0.3804492  7.036120e-01
## disc_grado_adulto          -0.82617568 0.28747891  -2.8738653  4.054818e-03
## factores_ambientales        0.14061963 0.06546260   2.1480909  3.170653e-02
## relacionesinterpersonales  -2.84369780 0.19812791 -14.3528383  1.022647e-46
## movilidad                  -3.33773092 0.18992767 -17.5736952  3.918009e-69
## energiaymotivacion         -1.70867474 0.10706403 -15.9593727  2.451832e-57
## dolor                      -1.00781167 0.07449061 -13.5293784  1.049069e-41
## cuidadopersonal            -2.35584751 0.33697372  -6.9911906  2.725632e-12
## cognicion                  -2.61883786 0.15885902 -16.4852956  4.680005e-61
## vista                      -0.79285693 0.08324502  -9.5243773  1.660344e-21
## emocion                    -1.57824229 0.08828473 -17.8767295  1.790359e-71
## bajo|medio-bajo           -65.53158127 2.15178723 -30.4544894 1.044681e-203
## medio-bajo|medio-alto     -20.61588859 0.82372056 -25.0277699 3.048785e-138
## medio-alto|alto            -3.44312038 0.55104098  -6.2483926  4.146981e-10

Como se observa, todas las variables escogidas tienen un p-value menor a 0.05, por lo tanto, todas son significativas es más difícil que tengas algo no significativo

Cálculo e interpretación de los exponenciales

exp(coef(modelo1))
##                 educacion                      sexo                      zona 
##                0.95031950                0.89794446                0.88108249 
##                  indigena         disc_grado_adulto      factores_ambientales 
##                0.93572644                0.43772007                1.15098676 
## relacionesinterpersonales                 movilidad        energiaymotivacion 
##                0.05821002                0.03551746                0.18110565 
##                     dolor           cuidadopersonal                 cognicion 
##                0.36501688                0.09481312                0.07288752 
##                     vista                   emocion 
##                0.45255004                0.20633746

veces ## pseudo R2”

PseudoR2(modelo1, which = c("Nagelkerke"))
## Nagelkerke 
##  0.8184704

El modelo explica un 81.9%

Construimmos la ecuación

coef(summary(modelo1))
##                                  Value Std. Error     t value
## educacion                  -0.05095703 0.03433022  -1.4843200
## sexo                       -0.10764707 0.10915315  -0.9862021
## zona                       -0.12660403 0.15131523  -0.8366906
## indigena                   -0.06643211 0.17461492  -0.3804492
## disc_grado_adulto          -0.82617568 0.28747891  -2.8738653
## factores_ambientales        0.14061963 0.06546260   2.1480909
## relacionesinterpersonales  -2.84369780 0.19812791 -14.3528383
## movilidad                  -3.33773092 0.18992767 -17.5736952
## energiaymotivacion         -1.70867474 0.10706403 -15.9593727
## dolor                      -1.00781167 0.07449061 -13.5293784
## cuidadopersonal            -2.35584751 0.33697372  -6.9911906
## cognicion                  -2.61883786 0.15885902 -16.4852956
## vista                      -0.79285693 0.08324502  -9.5243773
## emocion                    -1.57824229 0.08828473 -17.8767295
## bajo|medio-bajo           -65.53158127 2.15178723 -30.4544894
## medio-bajo|medio-alto     -20.61588859 0.82372056 -25.0277699
## medio-alto|alto            -3.44312038 0.55104098  -6.2483926

primer corte

num_1 = exp(6.7893771 - ((0.05605047* ##) + (0.11245572* ##)+ (0.13796909* ##) + (0.09391208* ##) + (0.92902088* ##)+(-0.13533601* ##)+(3.05322988* ##) + (34.40321363* ##) + (0.45276215* ##) + (1.05192937* ##) + (2.80116899* ##) + (2.78813774* ##) + (0.83081719* ##) + (1.65607065* ##)))

denom_1 = 1 + num_1 p_menorigual_muybajo= num_1/denom_1 p_menorigual_muybajo

vemos las probabilidades

head(modelo1$fitted.values)
##            bajo   medio-bajo   medio-alto         alto
## 9  7.462235e-27 2.396107e-07 0.8730850913 1.269147e-01
## 15 3.239816e-27 1.040298e-07 0.7491679145 2.508320e-01
## 21 1.026361e-28 3.295623e-09 0.0864396998 9.135603e-01
## 30 5.821515e-25 1.869242e-05 0.9981214508 1.859857e-03
## 33 2.361481e-16 9.998681e-01 0.0001318623 4.593437e-12
## 38 1.322862e-22 4.229717e-03 0.9957620835 8.199849e-06

¿Cómo se entiende esto?

Modelo de regresión lineal múltiples

modelo de prueba

summary(data$des_puntaje_adulto)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   25.23   56.87   64.95   65.53   74.95   99.71
modelo.1 <- lm(des_puntaje_adulto~ educacion + sexo + zona + indigena + disc_grado_adulto + factores_ambientales + relacionesinterpersonales + movilidad +energiaymotivacion + dolor + cuidadopersonal + cognicion + vista + emocion,data)

summary(modelo.1)
## 
## Call:
## lm(formula = des_puntaje_adulto ~ educacion + sexo + zona + indigena + 
##     disc_grado_adulto + factores_ambientales + relacionesinterpersonales + 
##     movilidad + energiaymotivacion + dolor + cuidadopersonal + 
##     cognicion + vista + emocion, data = data)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -17.442  -4.509  -1.185   3.240  25.990 
## 
## Coefficients:
##                           Estimate Std. Error t value Pr(>|t|)    
## (Intercept)               77.89201    1.09315  71.255  < 2e-16 ***
## educacion                  0.09051    0.06902   1.311  0.18980    
## sexo                      -0.55192    0.22081  -2.500  0.01248 *  
## zona                       0.04416    0.30913   0.143  0.88642    
## indigena                   0.17597    0.36235   0.486  0.62725    
## disc_grado_adulto          3.79253    0.38025   9.974  < 2e-16 ***
## factores_ambientales       0.38605    0.12802   3.016  0.00258 ** 
## relacionesinterpersonales -3.36347    0.25098 -13.401  < 2e-16 ***
## movilidad                 -3.78847    0.20225 -18.732  < 2e-16 ***
## energiaymotivacion        -2.38152    0.14419 -16.517  < 2e-16 ***
## dolor                     -2.29307    0.12808 -17.903  < 2e-16 ***
## cuidadopersonal           -0.77086    0.44128  -1.747  0.08074 .  
## cognicion                 -3.82641    0.20513 -18.653  < 2e-16 ***
## vista                     -1.68527    0.13312 -12.659  < 2e-16 ***
## emocion                   -2.77327    0.12142 -22.841  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 6.61 on 3816 degrees of freedom
## Multiple R-squared:  0.7096, Adjusted R-squared:  0.7086 
## F-statistic: 666.1 on 14 and 3816 DF,  p-value: < 2.2e-16
#+ zona, + fa40

modelo de regresión oficial

modelo <- lm(des_puntaje_adulto~ educacion + sexo  + disc_grado_adulto + factores_ambientales + relacionesinterpersonales + movilidad +energiaymotivacion + dolor + cognicion + vista + emocion,data)
summary(modelo)
## 
## Call:
## lm(formula = des_puntaje_adulto ~ educacion + sexo + disc_grado_adulto + 
##     factores_ambientales + relacionesinterpersonales + movilidad + 
##     energiaymotivacion + dolor + cognicion + vista + emocion, 
##     data = data)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -17.137  -4.521  -1.190   3.252  24.061 
## 
## Coefficients:
##                           Estimate Std. Error t value Pr(>|t|)    
## (Intercept)               78.25159    0.71118 110.030  < 2e-16 ***
## educacion                  0.09065    0.06720   1.349  0.17744    
## sexo                      -0.54967    0.21989  -2.500  0.01247 *  
## disc_grado_adulto          3.64810    0.37052   9.846  < 2e-16 ***
## factores_ambientales       0.39625    0.12754   3.107  0.00191 ** 
## relacionesinterpersonales -3.37099    0.25087 -13.437  < 2e-16 ***
## movilidad                 -3.89167    0.19358 -20.104  < 2e-16 ***
## energiaymotivacion        -2.38648    0.14404 -16.568  < 2e-16 ***
## dolor                     -2.29577    0.12800 -17.936  < 2e-16 ***
## cognicion                 -3.85091    0.20467 -18.815  < 2e-16 ***
## vista                     -1.70075    0.13282 -12.805  < 2e-16 ***
## emocion                   -2.77321    0.12142 -22.839  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 6.61 on 3819 degrees of freedom
## Multiple R-squared:  0.7094, Adjusted R-squared:  0.7085 
## F-statistic: 847.4 on 11 and 3819 DF,  p-value: < 2.2e-16

Supuestos

Normalidad

lillie.test(modelo$residuals) 
## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  modelo$residuals
## D = 0.087722, p-value < 2.2e-16

Hipótesis

Hipótesis nula

Hipótesis alternativa

Dado que tenemos un p-value (2.2e-16) MENOR a (<) 0.05, se rechaza H0 (distribución normal) y podemos acepta H1 que (no hay distribución normal), por lo que nuestro modelo no cumpliaria con los suspuestos de normalidad

Homocedasticidad

bptest(modelo)
## 
##  studentized Breusch-Pagan test
## 
## data:  modelo
## BP = 265.19, df = 11, p-value < 2.2e-16

Hipótesis

Hipótesis nula

Hipótesis alternativa En este caso con un p-value (2.2e-16) MENOR a(<) que 0.05 se RECHAZA por lo que nuestro modelo tendria un problema de heterocedasticidad.

No-colinealidad

vif(modelo)
##                 educacion                      sexo         disc_grado_adulto 
##                  1.070727                  1.054273                  1.750613 
##      factores_ambientales relacionesinterpersonales                 movilidad 
##                  1.088528                  1.278835                  1.766475 
##        energiaymotivacion                     dolor                 cognicion 
##                  1.823147                  1.566763                  1.442700 
##                     vista                   emocion 
##                  1.118806                  1.620449

Independencia

durbinWatsonTest (modelo) 
##  lag Autocorrelation D-W Statistic p-value
##    1     -0.01518617      2.029799    0.32
##  Alternative hypothesis: rho != 0

Hipótesis

Hipótesis nula

Hipótesis alternativa Interpretación: Dado que la prueba de Durbin-Watson presenta un Pvale (0.302) MAYOR a(>) 0.05, no podemos rechazar la hipotesis nula, por lo que No existe auto-correlación.

Linealidad

cor.test(data$des_puntaje_adulto,data$educacion)
## 
##  Pearson's product-moment correlation
## 
## data:  data$des_puntaje_adulto and data$educacion
## t = 8.2115, df = 3829, p-value = 2.955e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.1002994 0.1625399
## sample estimates:
##       cor 
## 0.1315493
cor.test(data$des_puntaje_adulto,data$sexo)
## 
##  Pearson's product-moment correlation
## 
## data:  data$des_puntaje_adulto and data$sexo
## t = -9.685, df = 3829, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.1853924 -0.1235699
## sample estimates:
##        cor 
## -0.1546325
cor.test(data$des_puntaje_adulto,data$disc_grado_adulto)
## 
##  Pearson's product-moment correlation
## 
## data:  data$des_puntaje_adulto and data$disc_grado_adulto
## t = -32.314, df = 3829, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.4874155 -0.4376402
## sample estimates:
##        cor 
## -0.4628927
cor.test(data$des_puntaje_adulto,data$factores_ambientales)
## 
##  Pearson's product-moment correlation
## 
## data:  data$des_puntaje_adulto and data$factores_ambientales
## t = 15.205, df = 3829, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.2085311 0.2682635
## sample estimates:
##      cor 
## 0.238623
cor.test(data$des_puntaje_adulto,data$relacionesinterpersonales)
## 
##  Pearson's product-moment correlation
## 
## data:  data$des_puntaje_adulto and data$relacionesinterpersonales
## t = -28.793, df = 3829, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.4475616 -0.3954892
## sample estimates:
##        cor 
## -0.4218732
cor.test(data$des_puntaje_adulto,data$movilidad)
## 
##  Pearson's product-moment correlation
## 
## data:  data$des_puntaje_adulto and data$movilidad
## t = -48.077, df = 3829, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.6329062 -0.5933969
## sample estimates:
##        cor 
## -0.6135354
cor.test(data$des_puntaje_adulto,data$energiaymotivacion)
## 
##  Pearson's product-moment correlation
## 
## data:  data$des_puntaje_adulto and data$energiaymotivacion
## t = -51.531, df = 3829, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.6582572 -0.6208428
## sample estimates:
##        cor 
## -0.6399291
cor.test(data$des_puntaje_adulto,data$dolor)
## 
##  Pearson's product-moment correlation
## 
## data:  data$des_puntaje_adulto and data$dolor
## t = -45.498, df = 3829, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.6125575 -0.5714329
## sample estimates:
##        cor 
## -0.5923809
cor.test(data$des_puntaje_adulto,data$cognicion)
## 
##  Pearson's product-moment correlation
## 
## data:  data$des_puntaje_adulto and data$cognicion
## t = -40.604, df = 3829, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.5703798 -0.5260940
## sample estimates:
##        cor 
## -0.5486216
cor.test(data$des_puntaje_adulto,data$vista)
## 
##  Pearson's product-moment correlation
## 
## data:  data$des_puntaje_adulto and data$vista
## t = -22.766, df = 3829, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.3728818 -0.3170909
## sample estimates:
##        cor 
## -0.3452914
cor.test(data$des_puntaje_adulto,data$emocion)
## 
##  Pearson's product-moment correlation
## 
## data:  data$des_puntaje_adulto and data$emocion
## t = -51.026, df = 3829, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.6546840 -0.6169688
## sample estimates:
##        cor 
## -0.6362063

forma gráfica

plot(modelo,1)

autoplot(modelo)

El modelo cumple con el supuesto de linealidad

Conclusiones