Regresión lineal
Ana Gutierrez Montufar
2024-06-15
Regresión lineal:
library(rio)
demo=import("V-Dem-2024 - V-Dem-2024.csv")
names(demo)## [1] "country_name" "v2x_polyarchy" "v2x_liberal" "v2x_partip"
## [5] "v2xdl_delib" "v2x_egal"H: El componente participativo (v2x_partip), el deliberativo (v2xdl_delib), el igualitario (v2x_egal) y el liberal (v2x_liberal) explican el índice de democracia electoral (v2x_polyarchy)
str(demo)## 'data.frame': 179 obs. of 6 variables:
## $ country_name : chr "Mexico" "Suriname" "Sweden" "Switzerland" ...
## $ v2x_polyarchy: num 0.53 0.75 0.88 0.89 0.66 0.69 0.82 0.08 0.19 0.51 ...
## $ v2x_liberal : num 0.48 0.84 0.98 0.96 0.86 0.85 0.9 0.04 0.15 0.75 ...
## $ v2x_partip : num 0.65 0.57 0.65 0.88 0.38 0.56 0.57 0.31 0.38 0.56 ...
## $ v2xdl_delib : num 0.55 0.77 0.91 0.98 0.85 0.87 0.9 0.22 0.2 0.44 ...
## $ v2x_egal : num 0.45 0.71 0.9 0.93 0.68 0.63 0.93 0.21 0.4 0.71 ...modelo1=lm(demo$v2x_polyarchy ~demo$v2x_partip+demo$v2xdl_delib+demo$v2x_egal+demo$v2x_liberal)
summary(modelo1)##
## Call:
## lm(formula = demo$v2x_polyarchy ~ demo$v2x_partip + demo$v2xdl_delib +
## demo$v2x_egal + demo$v2x_liberal)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.27888 -0.06142 0.01883 0.06897 0.19187
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.09343 0.02400 -3.893 0.000141 ***
## demo$v2x_partip 0.34928 0.06361 5.491 1.39e-07 ***
## demo$v2xdl_delib -0.01623 0.05634 -0.288 0.773587
## demo$v2x_egal 0.12920 0.05385 2.399 0.017474 *
## demo$v2x_liberal 0.60183 0.06025 9.989 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.09657 on 174 degrees of freedom
## Multiple R-squared: 0.8663, Adjusted R-squared: 0.8632
## F-statistic: 281.9 on 4 and 174 DF, p-value: < 2.2e-16En una tabla:
library(modelsummary)## `modelsummary` 2.0.0 now uses `tinytable` as its default table-drawing
## backend. Learn more at: https://vincentarelbundock.github.io/tinytable/
##
## Revert to `kableExtra` for one session:
##
## options(modelsummary_factory_default = 'kableExtra')
##
## Change the default backend persistently:
##
## config_modelsummary(factory_default = 'gt')
##
## Silence this message forever:
##
## config_modelsummary(startup_message = FALSE)model1=list('democracia'=modelo1)
modelsummary(model1, title = "Regresion: modelo 1",
stars = TRUE,
output = "kableExtra")| democracia | |
|---|---|
| (Intercept) | -0.093*** |
| (0.024) | |
| demo\(v2x_partip </td> <td style="text-align:center;"> 0.349*** </td> </tr> <tr> <td style="text-align:left;"> </td> <td style="text-align:center;"> (0.064) </td> </tr> <tr> <td style="text-align:left;"> demo\)v2xdl_delib | -0.016 |
| (0.056) | |
| demo\(v2x_egal </td> <td style="text-align:center;"> 0.129* </td> </tr> <tr> <td style="text-align:left;"> </td> <td style="text-align:center;"> (0.054) </td> </tr> <tr> <td style="text-align:left;"> demo\)v2x_liberal | 0.602*** |
| (0.060) | |
| Num.Obs. | 179 |
| R2 | 0.866 |
| R2 Adj. | 0.863 |
| AIC | -321.9 |
| BIC | -302.8 |
| Log.Lik. | 166.949 |
| F | 281.851 |
| RMSE | 0.10 |
| + p < 0.1, * p < 0.05, ** p < 0.01, *** p < 0.001 |
Linealidad:
plot(modelo1, 1)
Homocedasticidad:
plot(modelo1, 3)
library(lmtest)## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericlibrary(kableExtra)
resBP=bptest(modelo1)
data.frame(list('BP'=resBP$statistic,
'df'=resBP$parameter,
"p-value"=resBP$p.value))%>%
kable(caption = resBP$method)%>%kable_styling(full_width = F)| BP | df | p.value | |
|---|---|---|---|
| BP | 6.27892 | 4 | 0.1792642 |
El BP es de 6.279 y el p valor es mayor que 0.05, por lo que se niega que exista heterocedasticidad en el modelo y se puede considerar que cumple con la suposición de homocedasticidad. Se concluye que no hay evidencia significativa para evidenciar la heterocedasticidad en el modelo, por lo que se considera que cumple con la suposición de homocedasticidad.
Normalidad:
plot(modelo1, 2)
resSW=shapiro.test(modelo1$residuals)
data.frame(list('SW'=resSW$statistic,
"p-value"=resSW$p.value))%>%
kable(caption = resSW$method)%>%kable_styling(full_width = F)| SW | p.value | |
|---|---|---|
| W | 0.9622271 | 9.37e-05 |
El valor de SW se acerca a 1, por lo que se considera que tiene una distribución normal y el p-valor es menor a 0.05. Se concluye que como el p-valor es mucho menor a 0.05 los residuos del modelo no siguen una distribución normal.
PL4 Regresión de Cox:
cancer=import("cancer.xlsx - Sheet1.csv")
names(cancer)## [1] "cod_institucion" "tiempo_dias" "estado"
## [4] "edad" "sexo" "rendimiento"
## [7] "puntuacion_medico" "puntuacion_paciente" "calorias"
## [10] "perdida_peso"str(cancer)## 'data.frame': 228 obs. of 10 variables:
## $ cod_institucion : int 3 3 3 5 1 12 7 11 1 7 ...
## $ tiempo_dias : int 306 455 1010 210 883 1022 310 361 218 166 ...
## $ estado : int 2 2 1 2 2 1 2 2 2 2 ...
## $ edad : int 74 68 56 57 60 74 68 71 53 61 ...
## $ sexo : int 1 1 1 1 1 1 2 2 1 1 ...
## $ rendimiento : int 1 0 0 1 0 1 2 2 1 2 ...
## $ puntuacion_medico : int 90 90 90 90 100 50 70 60 70 70 ...
## $ puntuacion_paciente: int 100 90 90 60 90 80 60 80 80 70 ...
## $ calorias : int 1175 1225 NA 1150 NA 513 384 538 825 271 ...
## $ perdida_peso : int NA 15 15 11 0 0 10 1 16 34 ...cancer[]=lapply(cancer, function(x) if (is.integer(x))as.numeric(x)else x)
str(cancer)## 'data.frame': 228 obs. of 10 variables:
## $ cod_institucion : num 3 3 3 5 1 12 7 11 1 7 ...
## $ tiempo_dias : num 306 455 1010 210 883 ...
## $ estado : num 2 2 1 2 2 1 2 2 2 2 ...
## $ edad : num 74 68 56 57 60 74 68 71 53 61 ...
## $ sexo : num 1 1 1 1 1 1 2 2 1 1 ...
## $ rendimiento : num 1 0 0 1 0 1 2 2 1 2 ...
## $ puntuacion_medico : num 90 90 90 90 100 50 70 60 70 70 ...
## $ puntuacion_paciente: num 100 90 90 60 90 80 60 80 80 70 ...
## $ calorias : num 1175 1225 NA 1150 NA ...
## $ perdida_peso : num NA 15 15 11 0 0 10 1 16 34 ...cancer1=cancer[complete.cases(cancer),]
print(cancer1)## cod_institucion tiempo_dias estado edad sexo rendimiento puntuacion_medico
## 2 3 455 2 68 1 0 90
## 4 5 210 2 57 1 1 90
## 6 12 1022 1 74 1 1 50
## 7 7 310 2 68 2 2 70
## 8 11 361 2 71 2 2 60
## 9 1 218 2 53 1 1 70
## 10 7 166 2 61 1 2 70
## 11 6 170 2 57 1 1 80
## 15 12 567 2 57 1 1 80
## 17 22 613 2 70 1 1 90
## 18 16 707 2 63 1 2 50
## 19 1 61 2 56 2 2 60
## 21 11 301 2 67 1 1 80
## 22 6 81 2 49 2 0 100
## 24 15 371 2 58 1 0 90
## 26 12 520 2 70 2 1 90
## 27 4 574 2 60 1 0 100
## 28 13 118 2 70 1 3 60
## 29 13 390 2 53 1 1 80
## 30 1 12 2 74 1 2 70
## 31 12 473 2 69 2 1 90
## 32 1 26 2 73 1 2 60
## 34 16 107 2 60 2 2 50
## 35 12 53 2 61 1 2 70
## 37 22 814 2 65 1 2 70
## 38 15 965 1 66 2 1 70
## 39 1 93 2 74 1 2 50
## 40 1 731 2 64 2 1 80
## 41 5 460 2 70 1 1 80
## 42 11 153 2 73 2 2 60
## 43 10 433 2 59 2 0 90
## 45 7 583 2 68 1 1 60
## 46 7 95 2 76 2 2 60
## 47 1 303 2 74 1 0 90
## 48 3 519 2 63 1 1 80
## 49 13 643 2 74 1 0 90
## 50 22 765 2 50 2 1 90
## 53 21 53 2 68 1 0 90
## 54 1 246 2 58 1 0 100
## 55 6 689 2 59 1 1 90
## 57 5 5 2 65 2 0 100
## 59 3 687 2 58 2 1 80
## 60 1 345 2 64 2 1 90
## 61 22 444 2 75 2 2 70
## 62 12 223 2 48 1 1 90
## 64 11 60 2 65 2 1 90
## 65 3 163 2 69 1 1 80
## 66 3 65 2 68 1 2 70
## 68 5 821 1 64 2 0 90
## 69 22 428 2 68 1 0 100
## 70 6 230 2 67 1 1 80
## 71 13 840 1 63 1 0 90
## 72 3 305 2 48 2 1 80
## 73 5 11 2 74 1 2 70
## 75 21 226 2 53 2 1 90
## 76 12 426 2 71 2 1 90
## 77 1 705 2 51 2 0 100
## 78 6 363 2 56 2 1 80
## 80 1 176 2 73 1 0 90
## 81 4 791 2 59 1 0 100
## 82 13 95 2 55 1 1 70
## 83 11 196 1 42 1 1 80
## 84 21 167 2 44 2 1 80
## 85 16 806 1 44 1 1 80
## 86 6 284 2 71 1 1 80
## 87 22 641 2 62 2 1 80
## 88 21 147 2 61 1 0 100
## 89 13 740 1 44 2 1 90
## 90 1 163 2 72 1 2 70
## 91 11 655 2 63 1 0 100
## 93 5 88 2 66 1 1 90
## 94 10 245 2 57 2 1 80
## 96 12 30 2 72 1 2 80
## 99 11 477 2 64 1 1 90
## 101 1 559 1 58 2 0 100
## 102 6 450 2 69 2 1 80
## 106 12 156 2 66 1 1 80
## 107 26 529 1 54 2 1 80
## 109 21 429 2 55 1 1 100
## 110 3 351 2 75 2 2 60
## 111 13 15 2 69 1 0 90
## 112 1 181 2 44 1 1 80
## 113 10 283 2 80 1 1 80
## 116 1 13 2 76 1 2 70
## 117 3 212 2 49 1 2 70
## 118 1 524 2 68 1 2 60
## 119 16 288 2 66 1 2 70
## 120 15 363 2 80 1 1 80
## 122 26 199 2 60 2 2 70
## 123 3 550 2 69 2 1 70
## 124 11 54 2 72 1 2 60
## 125 1 558 2 70 1 0 90
## 126 22 207 2 66 1 1 80
## 127 7 92 2 50 1 1 80
## 128 12 60 2 64 1 1 80
## 129 16 551 1 77 2 2 80
## 131 4 293 2 59 2 1 80
## 133 6 353 2 47 1 0 100
## 135 1 267 2 67 1 0 90
## 136 22 511 1 74 2 2 60
## 139 1 457 2 54 1 1 90
## 140 5 337 2 56 1 0 100
## 141 21 201 2 73 2 2 70
## 142 3 404 1 74 1 1 80
## 143 26 222 2 76 1 2 70
## 144 1 62 2 65 2 1 80
## 145 11 458 1 57 1 1 80
## 147 16 353 2 71 1 0 100
## 148 16 163 2 54 1 1 90
## 149 12 31 2 82 1 0 100
## 151 13 229 2 70 1 1 70
## 155 32 156 2 55 1 2 70
## 158 4 291 2 62 1 2 70
## 159 12 179 2 63 1 1 80
## 160 1 376 1 56 2 1 80
## 161 32 384 1 62 2 0 90
## 162 10 268 2 44 2 1 90
## 163 11 292 1 69 1 2 60
## 164 6 142 2 63 1 1 90
## 165 7 413 1 64 1 1 80
## 166 16 266 1 57 2 0 90
## 168 21 320 2 46 1 0 100
## 169 6 181 2 61 1 1 90
## 170 12 285 2 65 1 0 100
## 171 13 301 1 61 1 1 90
## 172 2 348 2 58 2 0 90
## 173 2 197 2 56 1 1 90
## 174 16 382 1 43 2 0 100
## 175 1 303 1 53 1 1 90
## 176 13 296 1 59 2 1 80
## 177 1 180 2 56 1 2 60
## 179 1 145 2 53 2 1 80
## 180 7 269 1 74 2 0 100
## 181 13 300 1 60 1 0 100
## 182 1 284 1 39 1 0 100
## 185 12 292 1 51 2 0 90
## 186 12 332 1 45 2 0 90
## 187 2 285 2 72 2 2 70
## 188 3 259 1 58 1 0 90
## 189 15 110 2 64 1 1 80
## 190 22 286 2 53 1 0 90
## 191 16 270 2 72 1 1 80
## 194 1 225 1 64 1 1 90
## 195 22 269 2 71 1 1 90
## 196 12 225 1 70 1 0 100
## 197 32 243 1 63 2 1 80
## 199 1 276 1 52 2 0 100
## 200 32 135 2 60 1 1 90
## 201 15 79 2 64 2 1 90
## 202 22 59 2 73 1 1 60
## 203 32 240 1 63 2 0 90
## 204 3 202 1 50 2 0 100
## 205 26 235 1 63 2 0 100
## 208 13 239 2 50 2 2 60
## 211 1 252 1 60 2 0 100
## 212 6 221 1 67 1 1 80
## 213 15 185 1 69 1 1 90
## 216 11 222 1 65 1 1 90
## 218 21 183 2 76 1 2 80
## 219 11 211 1 70 2 2 70
## 220 2 175 1 57 2 0 80
## 221 22 197 1 67 1 1 80
## 222 11 203 1 71 2 1 80
## 225 13 191 1 39 1 0 90
## 226 32 105 1 75 2 2 60
## 227 6 174 1 66 1 1 90
## 228 22 177 1 58 2 1 80
## puntuacion_paciente calorias perdida_peso
## 2 90 1225 15
## 4 60 1150 11
## 6 80 513 0
## 7 60 384 10
## 8 80 538 1
## 9 80 825 16
## 10 70 271 34
## 11 80 1025 27
## 15 70 2600 60
## 17 100 1150 -5
## 18 70 1025 22
## 19 60 238 10
## 21 80 1025 17
## 22 70 1175 -8
## 24 100 975 13
## 26 80 825 6
## 27 100 1025 -13
## 28 70 1075 20
## 29 70 875 -7
## 30 50 305 20
## 31 90 1025 -1
## 32 70 388 20
## 34 60 925 -15
## 35 100 1075 10
## 37 60 513 28
## 38 90 875 4
## 39 40 1225 24
## 40 100 1175 15
## 41 60 975 10
## 42 70 1075 11
## 43 90 363 27
## 45 70 1025 7
## 46 60 625 -24
## 47 70 463 30
## 48 70 1025 10
## 49 90 1425 2
## 50 100 1175 4
## 53 100 1025 0
## 54 90 1175 7
## 55 80 1300 15
## 57 80 338 5
## 59 80 1225 10
## 60 80 1075 -3
## 61 70 438 8
## 62 80 1300 68
## 64 80 1025 0
## 65 60 1125 0
## 66 50 825 8
## 68 70 1025 3
## 69 80 1039 0
## 70 100 488 23
## 71 90 1175 -1
## 72 90 538 29
## 73 100 1175 0
## 75 80 825 3
## 76 90 1075 19
## 77 80 1300 0
## 78 70 1225 -2
## 80 70 169 30
## 81 80 768 5
## 82 90 1500 15
## 83 80 1425 8
## 84 90 588 -1
## 85 80 1025 1
## 86 90 1100 14
## 87 80 1150 1
## 88 90 1175 4
## 89 80 588 39
## 90 70 910 2
## 91 90 975 -1
## 93 80 875 8
## 94 60 280 14
## 96 60 288 7
## 99 100 910 0
## 101 100 710 15
## 102 90 1175 3
## 106 90 875 14
## 107 100 975 -3
## 109 80 975 5
## 110 50 925 11
## 111 70 575 10
## 112 90 1175 5
## 113 100 1030 6
## 116 70 413 20
## 117 60 675 20
## 118 70 1300 30
## 119 60 613 24
## 120 90 346 11
## 122 80 675 10
## 123 80 910 0
## 124 60 768 -3
## 125 90 1025 17
## 126 80 925 20
## 127 60 1075 13
## 128 90 993 0
## 129 60 750 28
## 131 80 925 52
## 133 90 1225 5
## 135 70 313 6
## 136 40 96 37
## 139 90 975 -5
## 140 100 1500 15
## 141 60 1225 -16
## 142 70 413 38
## 143 70 1500 8
## 144 90 1075 0
## 145 100 513 30
## 147 80 775 2
## 148 80 1225 13
## 149 90 413 27
## 151 60 1175 -2
## 155 30 1025 10
## 158 60 475 27
## 159 70 538 -2
## 160 90 825 17
## 161 90 588 8
## 162 100 2450 2
## 163 70 2450 36
## 164 80 875 2
## 165 70 413 16
## 166 90 1075 3
## 168 100 860 4
## 169 90 730 0
## 170 90 1025 0
## 171 100 825 2
## 172 80 1225 10
## 173 60 768 37
## 174 90 338 6
## 175 80 1225 12
## 176 100 1025 0
## 177 80 1225 -2
## 179 90 588 13
## 180 100 588 0
## 181 100 975 5
## 182 90 1225 -5
## 185 80 1225 0
## 186 100 975 5
## 187 90 463 20
## 188 80 1300 8
## 189 60 1025 12
## 190 90 1225 8
## 191 90 488 14
## 194 80 825 33
## 195 90 1300 -2
## 196 100 1175 6
## 197 90 825 0
## 199 80 975 0
## 200 70 1275 0
## 201 90 488 37
## 202 60 2200 5
## 203 100 1025 0
## 204 100 635 1
## 205 90 413 0
## 208 60 1025 -3
## 211 90 488 -2
## 212 70 413 23
## 213 70 1075 0
## 216 70 1025 18
## 218 60 825 7
## 219 30 131 3
## 220 80 725 11
## 221 90 1500 2
## 222 90 1025 0
## 225 90 2350 -5
## 226 70 1025 5
## 227 100 1075 1
## 228 90 1060 0Rendimiento:
modeloc1=lm(cancer1$rendimiento~cancer1$sexo)
summary(modeloc1)##
## Call:
## lm(formula = cancer1$rendimiento ~ cancer1$sexo)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.96117 -0.95313 0.03883 0.04687 2.03883
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.96920 0.17111 5.664 6.42e-08 ***
## cancer1$sexo -0.00804 0.11670 -0.069 0.945
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7332 on 165 degrees of freedom
## Multiple R-squared: 2.876e-05, Adjusted R-squared: -0.006032
## F-statistic: 0.004746 on 1 and 165 DF, p-value: 0.9452La variable sexo no es estadísticamente significativa en el rendimiento del paciente
ren=cancer1$rendimiento
ind=cancer1$sexo
volsexTable=table(ren,ind,dnn = c('rendimiento','sexo'))
addmargins(volsexTable)%>%
kable(caption = "Tabla de Contingencia: 'Sexo' y 'Rendimiento'")%>%
kableExtra::kable_styling(full_width = F)| 1 | 2 | Sum | |
|---|---|---|---|
| 0 | 28 | 19 | 47 |
| 1 | 52 | 29 | 81 |
| 2 | 22 | 16 | 38 |
| 3 | 1 | 0 | 1 |
| Sum | 103 | 64 | 167 |
Ser hombre se asocia con el rendimiento del paciente
ProbMujVol=volsexTable[2,1]/sum(volsexTable[,1])
MASS::fractions(ProbMujVol)## [1] 52/103modeloc2=lm(cancer1$rendimiento~cancer1$edad+cancer1$sexo+cancer1$perdida_peso)
summary(modeloc2)##
## Call:
## lm(formula = cancer1$rendimiento ~ cancer1$edad + cancer1$sexo +
## cancer1$perdida_peso)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.55844 -0.51011 0.01442 0.48883 1.80050
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.795409 0.422296 -1.884 0.0614 .
## cancer1$edad 0.024540 0.005866 4.183 4.68e-05 ***
## cancer1$sexo 0.092954 0.112330 0.828 0.4092
## cancer1$perdida_peso 0.009209 0.004066 2.265 0.0248 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6905 on 163 degrees of freedom
## Multiple R-squared: 0.124, Adjusted R-squared: 0.1078
## F-statistic: 7.689 on 3 and 163 DF, p-value: 7.756e-05Hay una correlación más alta con la edad que explica mejor la probabilidad de supervivencia del paciente.
library(kableExtra)
modelsrl=list('Rendimiento por sexo'=modeloc1,
'Rendimiento por sexo, edad y pérdida de peso durante el tratamiento'=modeloc2)
f <- function(x) format(x, digits = 4, scientific = FALSE)
modelsummary(modelsrl,
exponentiate = T,
statistic = 'conf.int',
title = "Comparando Regresión Logísticas (Coeficientes Exponenciados)",
stars = TRUE,
gof_map = c("nobs","aic","bic","rmse","logLik"),
gof_omit = c("F"),
output = "kableExtra")| Rendimiento por sexo | Rendimiento por sexo, edad y pérdida de peso durante el tratamiento | |
|---|---|---|
| (Intercept) | 2.636*** | 0.451+ |
| [1.880, 3.695] | [0.196, 1.039] | |
| cancer1\(sexo </td> <td style="text-align:center;"> 0.992 </td> <td style="text-align:center;"> 1.097 </td> </tr> <tr> <td style="text-align:left;"> </td> <td style="text-align:center;"> [0.788, 1.249] </td> <td style="text-align:center;"> [0.879, 1.370] </td> </tr> <tr> <td style="text-align:left;"> cancer1\)edad | 1.025*** | |
| [1.013, 1.037] | ||
| cancer1$perdida_peso | 1.009* | |
| [1.001, 1.017] | ||
| Num.Obs. | 167 | 167 |
| AIC | 374.3 | 356.2 |
| BIC | 383.6 | 371.8 |
| RMSE | 0.73 | 0.68 |
| Log.Lik. | -184.133 | -173.084 |
| + p < 0.1, * p < 0.05, ** p < 0.01, *** p < 0.001 |
Se puede concluir que en el segundo modelo el sexo es igual para la ocurrencia del evento. La pérdida de peso no indica una evidencia estadística significativa para influir en el modelo. La edad presenta correlación con la variable rendimiento. Se puede conluir que la variable edad presenta suficiente evidencia estadística para influir en la probabilidad del evento.
PL5 Analisis factorial
datafac=import("https://github.com/Alexanderbenit7/EAP2_2023-2/raw/main/data/criminal_eap.xlsx")
names(datafac)## [1] "Country"
## [2] "Year"
## [3] "Factor 8: Criminal Justice"
## [4] "8.1 Criminal investigation system is effective"
## [5] "8.2 Criminal adjudication system is timely and effective"
## [6] "8.3 Correctional system is effective in reducing criminal behavior"
## [7] "8.4 Criminal system is impartial"
## [8] "8.5 Criminal system is free of corruption"
## [9] "8.6 Criminal system is free of improper government influence"
## [10] "8.7. Due process of the law and rights of the accused" names(datafac)[1]="Criminal Justice"
names(datafac)[2]="Criminal investigation system is effective"
names(datafac)[3]="Criminal adjudication system is timely and effective"
names(datafac)[4]="Correctional system is effective in reducing criminal behavior"
names(datafac)[5]="Criminal system is impartial"
names(datafac)[6]="Criminal system is free of corruption"
names(datafac)[7]=
"Criminal system government influence"
names(datafac)[8]="Due process of the law and rights of the accused"library(dplyr)##
## Attaching package: 'dplyr'## The following object is masked from 'package:kableExtra':
##
## group_rows## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, uniondatafac=datafac%>%
select(-1,-2)
str(datafac)## 'data.frame': 140 obs. of 8 variables:
## $ Factor 8: Criminal Justice : num 0.261 0.4 0.397 0.346 0.519 ...
## $ 8.1 Criminal investigation system is effective : num 0.298 0.424 0.266 0.354 0.456 ...
## $ 8.2 Criminal adjudication system is timely and effective : num 0.412 0.362 0.438 0.353 0.503 ...
## $ 8.3 Correctional system is effective in reducing criminal behavior: num 0.212 0.37 0.466 0.235 0.408 ...
## $ 8.4 Criminal system is impartial : num 0.169 0.493 0.567 0.376 0.457 ...
## $ 8.5 Criminal system is free of corruption : num 0.27 0.334 0.42 0.497 0.692 ...
## $ 8.6 Criminal system is free of improper government influence : num 0.186 0.303 0.153 0.292 0.546 ...
## $ 8.7. Due process of the law and rights of the accused : num 0.278 0.515 0.471 0.316 0.574 ...library(magrittr)
head(datafac,10)%>%
rmarkdown::paged_table()Calcular la correlación entre las variables:
library(polycor)corMatrix=polycor::hetcor(datafac)$correlations## Warning in hetcor.data.frame(datafac): the correlation matrix has been adjusted
## to make it positive-definiteround(corMatrix,2)## Factor 8: Criminal Justice
## Factor 8: Criminal Justice 1.00
## 8.1 Criminal investigation system is effective 0.86
## 8.2 Criminal adjudication system is timely and effective 0.88
## 8.3 Correctional system is effective in reducing criminal behavior 0.90
## 8.4 Criminal system is impartial 0.84
## 8.5 Criminal system is free of corruption 0.93
## 8.6 Criminal system is free of improper government influence 0.87
## 8.7. Due process of the law and rights of the accused 0.95
## 8.1 Criminal investigation system is effective
## Factor 8: Criminal Justice 0.86
## 8.1 Criminal investigation system is effective 1.00
## 8.2 Criminal adjudication system is timely and effective 0.82
## 8.3 Correctional system is effective in reducing criminal behavior 0.79
## 8.4 Criminal system is impartial 0.62
## 8.5 Criminal system is free of corruption 0.80
## 8.6 Criminal system is free of improper government influence 0.65
## 8.7. Due process of the law and rights of the accused 0.78
## 8.2 Criminal adjudication system is timely and effective
## Factor 8: Criminal Justice 0.88
## 8.1 Criminal investigation system is effective 0.82
## 8.2 Criminal adjudication system is timely and effective 1.00
## 8.3 Correctional system is effective in reducing criminal behavior 0.84
## 8.4 Criminal system is impartial 0.68
## 8.5 Criminal system is free of corruption 0.78
## 8.6 Criminal system is free of improper government influence 0.66
## 8.7. Due process of the law and rights of the accused 0.79
## 8.3 Correctional system is effective in reducing criminal behavior
## Factor 8: Criminal Justice 0.90
## 8.1 Criminal investigation system is effective 0.79
## 8.2 Criminal adjudication system is timely and effective 0.84
## 8.3 Correctional system is effective in reducing criminal behavior 1.00
## 8.4 Criminal system is impartial 0.72
## 8.5 Criminal system is free of corruption 0.79
## 8.6 Criminal system is free of improper government influence 0.64
## 8.7. Due process of the law and rights of the accused 0.85
## 8.4 Criminal system is impartial
## Factor 8: Criminal Justice 0.84
## 8.1 Criminal investigation system is effective 0.62
## 8.2 Criminal adjudication system is timely and effective 0.68
## 8.3 Correctional system is effective in reducing criminal behavior 0.72
## 8.4 Criminal system is impartial 1.00
## 8.5 Criminal system is free of corruption 0.71
## 8.6 Criminal system is free of improper government influence 0.69
## 8.7. Due process of the law and rights of the accused 0.80
## 8.5 Criminal system is free of corruption
## Factor 8: Criminal Justice 0.93
## 8.1 Criminal investigation system is effective 0.80
## 8.2 Criminal adjudication system is timely and effective 0.78
## 8.3 Correctional system is effective in reducing criminal behavior 0.79
## 8.4 Criminal system is impartial 0.71
## 8.5 Criminal system is free of corruption 1.00
## 8.6 Criminal system is free of improper government influence 0.82
## 8.7. Due process of the law and rights of the accused 0.87
## 8.6 Criminal system is free of improper government influence
## Factor 8: Criminal Justice 0.87
## 8.1 Criminal investigation system is effective 0.65
## 8.2 Criminal adjudication system is timely and effective 0.66
## 8.3 Correctional system is effective in reducing criminal behavior 0.64
## 8.4 Criminal system is impartial 0.69
## 8.5 Criminal system is free of corruption 0.82
## 8.6 Criminal system is free of improper government influence 1.00
## 8.7. Due process of the law and rights of the accused 0.81
## 8.7. Due process of the law and rights of the accused
## Factor 8: Criminal Justice 0.95
## 8.1 Criminal investigation system is effective 0.78
## 8.2 Criminal adjudication system is timely and effective 0.79
## 8.3 Correctional system is effective in reducing criminal behavior 0.85
## 8.4 Criminal system is impartial 0.80
## 8.5 Criminal system is free of corruption 0.87
## 8.6 Criminal system is free of improper government influence 0.81
## 8.7. Due process of the law and rights of the accused 1.00Test KMO:
library(psych)##
## Attaching package: 'psych'## The following object is masked from 'package:polycor':
##
## polyserial## The following object is masked from 'package:modelsummary':
##
## SDpsych::KMO(corMatrix) ## Kaiser-Meyer-Olkin factor adequacy
## Call: psych::KMO(r = corMatrix)
## Overall MSA = 0.39
## MSA for each item =
## Factor 8: Criminal Justice
## 0.44
## 8.1 Criminal investigation system is effective
## 0.37
## 8.2 Criminal adjudication system is timely and effective
## 0.38
## 8.3 Correctional system is effective in reducing criminal behavior
## 0.39
## 8.4 Criminal system is impartial
## 0.34
## 8.5 Criminal system is free of corruption
## 0.40
## 8.6 Criminal system is free of improper government influence
## 0.35
## 8.7. Due process of the law and rights of the accused
## 0.41cortest.bartlett(corMatrix,n=nrow(datafac))$p.value>0.05## [1] FALSE