library(readxl)
## Warning: package 'readxl' was built under R version 4.2.3
library(pscl)
## Warning: package 'pscl' was built under R version 4.2.3
## Classes and Methods for R originally developed in the
## Political Science Computational Laboratory
## Department of Political Science
## Stanford University (2002-2015),
## by and under the direction of Simon Jackman.
## hurdle and zeroinfl functions by Achim Zeileis.
library(car)
## Loading required package: carData
## Warning: package 'carData' was built under R version 4.2.3
library(nnet)
library(tidyverse)
## Warning: package 'ggplot2' was built under R version 4.2.3
## Warning: package 'tibble' was built under R version 4.2.3
## Warning: package 'tidyr' was built under R version 4.2.3
## Warning: package 'readr' was built under R version 4.2.3
## Warning: package 'purrr' was built under R version 4.2.3
## Warning: package 'stringr' was built under R version 4.2.3
## Warning: package 'lubridate' was built under R version 4.2.3
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.0 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ✖ dplyr::recode() masks car::recode()
## ✖ purrr::some() masks car::some()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(plotly)
## Warning: package 'plotly' was built under R version 4.2.3
##
## Attaching package: 'plotly'
##
## The following object is masked from 'package:ggplot2':
##
## last_plot
##
## The following object is masked from 'package:stats':
##
## filter
##
## The following object is masked from 'package:graphics':
##
## layout
library(dplyr)
library(caret)
## Warning: package 'caret' was built under R version 4.2.3
## Loading required package: lattice
##
## Attaching package: 'caret'
##
## The following object is masked from 'package:purrr':
##
## lift
Cargar los datos Excel
Datos_Encuesta1 <- read_excel("C:/Users/HWP/Desktop/Mario/Datos_Encuesta.xlsx")
data <- Datos_Encuesta1
Acondicionamiento de los datos
Asegurar que Tipo_apuesta sea un factor
data$Tipo_apuesta <- as.factor(data$Tipo_apuesta)
Asegurar que la variable ‘Apuesta’ sea binaria (0 o 1)
data <- data %>%
mutate(Apuesta = ifelse(Apuesta == "Si", 1, 0))
Manejo de datos faltantes para variables numéricas
data$Edad[is.na(data$Edad)] <- mean(data$Edad, na.rm = TRUE)
data$Estrato[is.na(data$Estrato)] <- mean(data$Estrato, na.rm = TRUE)
Crear variables indicadoras para cada respuesta
data_wide <- data_long %>%
mutate(Indicador = 1) %>% # Crear una columna indicadora
pivot_wider(names_from = Respuesta,
values_from = Indicador,
values_fill = list(Indicador = 0)) # Rellenar con 0 donde no hay respuesta
Asegurar que las respuestas de factores tengan nombres
adecuados
colnames(data_wide) <- make.names(colnames(data_wide))
Eliminar filas con IDs repetidos (Mantendremos solo la primera
ocurrencia)
data_unique <- data_wide %>%
distinct(ID, .keep_all = TRUE)
colnames(data_unique)
## [1] "ID"
## [2] "Facultad"
## [3] "Programa"
## [4] "Edad"
## [5] "Estrato"
## [6] "Sexo"
## [7] "Apuesta"
## [8] "Frecuencia"
## [9] "Tipo_apuesta"
## [10] "Gasto"
## [11] "Ingresos"
## [12] "Factor"
## [13] "Emoción.y.adrenalina..Busco.la.emoción.y.la.adrenalina.que.proporciona.la.actividad.de.apostar."
## [14] "Entretenimiento..Lo.hago.como.forma.de.entretenimiento.y.diversión."
## [15] "NA."
## [16] "No.tengo.motivos.para.apostar"
## [17] "Ganancias.financieras..Busco.ganancias.financieras.y.la.posibilidad.de.obtener.beneficios.económicos."
## [18] "Conocimiento.del.deporte.o.evento..Me.motiva.el.conocimiento.que.tengo.sobre.el.deporte.o.evento.en.el.que.estoy.apostando."
## [19] "Publicidad.y.promociones..La.publicidad.y.las.promociones.de.las.casas.de.apuestas.me.impulsan.a.participar."
## [20] "Ninguna.de.las.anteriores"
## [21] "Socialización..Participar.en.apuestas.es.una.manera.de.socializar.con.amigos.o.familiares."
## [22] "Influencia.de.amigos.o.familiares..La.influencia.de.amigos.o.familiares.me.motiva.a.realizar.apuestas."
data_unique <- data_unique %>%
select(-Factor)
data_unique <- data_unique %>%
rename(
Emoción_y_adrenalina =Emoción.y.adrenalina..Busco.la.emoción.y.la.adrenalina.que.proporciona.la.actividad.de.apostar.,
Entretenimiento =Entretenimiento..Lo.hago.como.forma.de.entretenimiento.y.diversión.,
Ganancias =Ganancias.financieras..Busco.ganancias.financieras.y.la.posibilidad.de.obtener.beneficios.económicos.,
Conocimiento_deporte =Conocimiento.del.deporte.o.evento..Me.motiva.el.conocimiento.que.tengo.sobre.el.deporte.o.evento.en.el.que.estoy.apostando.,
Publicidad =Publicidad.y.promociones..La.publicidad.y.las.promociones.de.las.casas.de.apuestas.me.impulsan.a.participar.,
Socialización =Socialización..Participar.en.apuestas.es.una.manera.de.socializar.con.amigos.o.familiares.,
Influencia.amigos.familiares =Influencia.de.amigos.o.familiares..La.influencia.de.amigos.o.familiares.me.motiva.a.realizar.apuestas.,
)
Asegurar que ‘Frecuencia’ es un factor
data_unique$Frecuencia <- as.factor(data_unique$Frecuencia)
Ajustar los niveles de ‘Frecuencia’ con los nombres exactos
data_unique$Frecuencia <- factor(data_unique$Frecuencia,
levels = c("Diaria", "Semanal", "Quincenal", "Mensual", "Raramente (lapsos de mas de un mes entre apuestas)", "No apuesta"))
levels(data_unique$Frecuencia)
## [1] "Diaria"
## [2] "Semanal"
## [3] "Quincenal"
## [4] "Mensual"
## [5] "Raramente (lapsos de mas de un mes entre apuestas)"
## [6] "No apuesta"
Establecer categoria de referencia
data_unique$Frecuencia <- relevel(data_unique$Frecuencia, ref = "Raramente (lapsos de mas de un mes entre apuestas)")
Ajustar el modelo de regresión logística multinomial inicial
modelo_multinom <- multinom(Frecuencia ~ Emoción_y_adrenalina + Entretenimiento +
Ganancias + Socialización +
Influencia.amigos.familiares +
Conocimiento_deporte +
Publicidad +
No.tengo.motivos.para.apostar,
data = data_unique)
## # weights: 60 (45 variable)
## initial value 696.994434
## iter 10 value 262.792623
## iter 20 value 247.828098
## iter 30 value 247.047584
## iter 40 value 247.044481
## iter 40 value 247.044479
## iter 40 value 247.044479
## final value 247.044479
## converged
summary(modelo_multinom)
## Call:
## multinom(formula = Frecuencia ~ Emoción_y_adrenalina + Entretenimiento +
## Ganancias + Socialización + Influencia.amigos.familiares +
## Conocimiento_deporte + Publicidad + No.tengo.motivos.para.apostar,
## data = data_unique)
##
## Coefficients:
## (Intercept) Emoción_y_adrenalina Entretenimiento Ganancias
## Diaria -11.630010 7.941106 -8.535383 9.187658
## Semanal -9.320442 8.196511 8.850437 8.669854
## Quincenal -6.434666 5.741514 5.607984 5.784074
## Mensual -5.160224 2.857637 4.179396 3.816491
## No apuesta -12.842564 -5.938669 -5.156633 -6.565183
## Socialización Influencia.amigos.familiares Conocimiento_deporte
## Diaria -2.817240 -6.619584 -13.291942
## Semanal 10.419139 -14.635839 -22.562855
## Quincenal 8.044172 -17.768336 5.230688
## Mensual -11.502773 5.160222 3.956252
## No apuesta -1.683276 -7.923096 -10.800062
## Publicidad No.tengo.motivos.para.apostar
## Diaria -10.52902 13.034397
## Semanal -20.12330 11.865613
## Quincenal -23.27397 4.199204
## Mensual -21.42419 7.796738
## No apuesta -12.47895 37.703302
##
## Std. Errors:
## (Intercept) Emoción_y_adrenalina Entretenimiento Ganancias
## Diaria 2.4367362 2.5058742 0.0441990 2.4736347
## Semanal 3.7454819 3.7536435 3.7584890 3.7556292
## Quincenal 0.2394196 0.3276005 0.4407123 0.3766472
## Mensual 3.4491862 3.4756684 3.4712766 3.4694396
## No apuesta 702.5314482 154.6256955 131.5616764 41.2317727
## Socialización Influencia.amigos.familiares Conocimiento_deporte
## Diaria 1.2582825 3.742280e-02 2.331642e-04
## Semanal 3.8512978 1.906145e-04 3.441155e-07
## Quincenal 0.9259542 1.007994e-06 5.883975e-01
## Mensual 0.1340788 3.544516e+00 3.490815e+00
## No apuesta 327.3499177 8.721068e-01 2.453024e-01
## Publicidad No.tengo.motivos.para.apostar
## Diaria 1.478654e-03 5.8605271
## Semanal 1.577566e-06 18.6816514
## Quincenal 8.191226e-09 0.1522336
## Mensual 2.534964e-05 20.5090944
## No apuesta 1.830165e-02 46.6266749
##
## Residual Deviance: 494.089
## AIC: 574.089
Calcular los z-values (coeficientes / errores estándar)
z_values <- coeficientes / errores_estandar
Calcular los p-valores para los z-values usando la distribución
normal estándar
p_valores <- 2 * (1 - pnorm(abs(z_values)))
Imprimir los p-valores
print(p_valores)
## (Intercept) Emoción_y_adrenalina Entretenimiento Ganancias
## Diaria 1.816986e-06 0.001529663 0.00000000 0.0002038202
## Semanal 1.283015e-02 0.028990566 0.01853338 0.0209715808
## Quincenal 0.000000e+00 0.000000000 0.00000000 0.0000000000
## Mensual 1.346354e-01 0.410972438 0.22859190 0.2713186759
## No apuesta 9.854152e-01 0.969363388 0.96873448 0.8734905849
## Socialización Influencia.amigos.familiares Conocimiento_deporte
## Diaria 0.02515872 0.0000000 0.0000000
## Semanal 0.00682308 0.0000000 0.0000000
## Quincenal 0.00000000 0.0000000 0.0000000
## Mensual 0.00000000 0.1454389 0.2570749
## No apuesta 0.99589719 0.0000000 0.0000000
## Publicidad No.tengo.motivos.para.apostar
## Diaria 0 0.02614173
## Semanal 0 0.52533190
## Quincenal 0 0.00000000
## Mensual 0 0.70382663
## No apuesta 0 0.41873326
Matriz de correlacion
Calcular la matriz de correlación de las variables predictoras
cor_matrix <- cor(data_unique[, c("Emoción_y_adrenalina", "Entretenimiento",
"Ganancias", "Socialización",
"Influencia.amigos.familiares",
"Conocimiento_deporte",
"Publicidad", "No.tengo.motivos.para.apostar")])
print(cor_matrix)
## Emoción_y_adrenalina Entretenimiento Ganancias
## Emoción_y_adrenalina 1.00000000 -0.16717271 -0.20322410
## Entretenimiento -0.16717271 1.00000000 -0.13545854
## Ganancias -0.20322410 -0.13545854 1.00000000
## Socialización -0.07707199 -0.05137215 -0.06245074
## Influencia.amigos.familiares -0.05104659 -0.03402498 -0.04136259
## Conocimiento_deporte -0.10372243 -0.06913594 -0.08404535
## Publicidad -0.05104659 -0.03402498 -0.04136259
## No.tengo.motivos.para.apostar -0.47445944 -0.31624980 -0.38445020
## Socialización Influencia.amigos.familiares
## Emoción_y_adrenalina -0.07707199 -0.05104659
## Entretenimiento -0.05137215 -0.03402498
## Ganancias -0.06245074 -0.04136259
## Socialización 1.00000000 -0.01568661
## Influencia.amigos.familiares -0.01568661 1.00000000
## Conocimiento_deporte -0.03187389 -0.02111083
## Publicidad -0.01568661 -0.01038961
## No.tengo.motivos.para.apostar -0.14580131 -0.09656764
## Conocimiento_deporte Publicidad
## Emoción_y_adrenalina -0.10372243 -0.05104659
## Entretenimiento -0.06913594 -0.03402498
## Ganancias -0.08404535 -0.04136259
## Socialización -0.03187389 -0.01568661
## Influencia.amigos.familiares -0.02111083 -0.01038961
## Conocimiento_deporte 1.00000000 -0.02111083
## Publicidad -0.02111083 1.00000000
## No.tengo.motivos.para.apostar -0.19621742 -0.09656764
## No.tengo.motivos.para.apostar
## Emoción_y_adrenalina -0.47445944
## Entretenimiento -0.31624980
## Ganancias -0.38445020
## Socialización -0.14580131
## Influencia.amigos.familiares -0.09656764
## Conocimiento_deporte -0.19621742
## Publicidad -0.09656764
## No.tengo.motivos.para.apostar 1.00000000
Selección de variables para modelo optimizado
data_unique$Frecuencia <- ifelse(data_unique$Frecuencia %in% c("Diaria", "Semanal"),
"Diaria_Semanal",
as.character(data_unique$Frecuencia))
data_unique$Frecuencia <- factor(data_unique$Frecuencia,
levels = c("Diaria_Semanal", "Quincenal", "Mensual", "Raramente (lapsos de mas de un mes entre apuestas)","No apuesta"))
Establecer categoria de referencia
data_unique$Frecuencia <- relevel(data_unique$Frecuencia, ref = "Raramente (lapsos de mas de un mes entre apuestas)")
Modelo optimizado
modelo_multinom <- multinom(Frecuencia ~ Emoción_y_adrenalina + Entretenimiento +
Ganancias + Socialización +
Influencia.amigos.familiares +
Conocimiento_deporte +
Publicidad +
No.tengo.motivos.para.apostar,
data = data_unique)
## # weights: 50 (36 variable)
## initial value 626.071348
## iter 10 value 251.717050
## iter 20 value 238.086215
## iter 30 value 237.701276
## final value 237.700390
## converged
summary(modelo_multinom)
## Call:
## multinom(formula = Frecuencia ~ Emoción_y_adrenalina + Entretenimiento +
## Ganancias + Socialización + Influencia.amigos.familiares +
## Conocimiento_deporte + Publicidad + No.tengo.motivos.para.apostar,
## data = data_unique)
##
## Coefficients:
## (Intercept) Emoción_y_adrenalina Entretenimiento Ganancias
## Diaria_Semanal -10.152199 9.102372 9.682189 9.655757
## Quincenal -6.562615 5.869465 5.735931 5.912021
## Mensual -6.738306 4.435732 5.757477 5.394574
## No apuesta -13.336525 -5.680259 -4.057439 -5.012629
## Socialización Influencia.amigos.familiares Conocimiento_deporte
## Diaria_Semanal 11.2506304 -14.846770 -23.049733
## Quincenal 8.1718832 -18.587828 5.358639
## Mensual -12.0723348 6.738292 5.534327
## No apuesta -0.8734645 -8.114345 -10.084105
## Publicidad No.tengo.motivos.para.apostar
## Diaria_Semanal -20.24256 8.295915
## Quincenal -24.68472 5.661999
## Mensual -24.33559 1.809215
## No apuesta -13.19335 33.679071
##
## Std. Errors:
## (Intercept) Emoción_y_adrenalina Entretenimiento Ganancias
## Diaria_Semanal 2.3554000 2.3676542 2.3760277 2.3699980
## Quincenal 5.2430326 5.2478032 5.2560945 5.2510973
## Mensual 0.2598198 0.5008376 0.4693478 0.4556354
## No apuesta 565.0699753 54.5726790 122.7945326 61.9010236
## Socialización Influencia.amigos.familiares Conocimiento_deporte
## Diaria_Semanal 2.519992e+00 2.601139e-05 3.571375e-08
## Quincenal 5.319302e+00 5.001852e-05 5.270516e+00
## Mensual 2.418854e-04 8.568390e-01 5.969893e-01
## No apuesta 2.083674e+02 2.182560e-01 1.522044e-01
## Publicidad No.tengo.motivos.para.apostar
## Diaria_Semanal 2.397355e-07 11.704852
## Quincenal 2.250620e-07 31.426284
## Mensual 4.526767e-09 0.531381
## No apuesta 2.716703e-03 117.061203
##
## Residual Deviance: 475.4008
## AIC: 539.4008
Matriz de correlación
cor(data_unique[, c("Emoción_y_adrenalina", "Entretenimiento", "Ganancias", "Socialización", "Influencia.amigos.familiares", "Conocimiento_deporte", "Publicidad","No.tengo.motivos.para.apostar")])
## Emoción_y_adrenalina Entretenimiento Ganancias
## Emoción_y_adrenalina 1.00000000 -0.16717271 -0.20322410
## Entretenimiento -0.16717271 1.00000000 -0.13545854
## Ganancias -0.20322410 -0.13545854 1.00000000
## Socialización -0.07707199 -0.05137215 -0.06245074
## Influencia.amigos.familiares -0.05104659 -0.03402498 -0.04136259
## Conocimiento_deporte -0.10372243 -0.06913594 -0.08404535
## Publicidad -0.05104659 -0.03402498 -0.04136259
## No.tengo.motivos.para.apostar -0.47445944 -0.31624980 -0.38445020
## Socialización Influencia.amigos.familiares
## Emoción_y_adrenalina -0.07707199 -0.05104659
## Entretenimiento -0.05137215 -0.03402498
## Ganancias -0.06245074 -0.04136259
## Socialización 1.00000000 -0.01568661
## Influencia.amigos.familiares -0.01568661 1.00000000
## Conocimiento_deporte -0.03187389 -0.02111083
## Publicidad -0.01568661 -0.01038961
## No.tengo.motivos.para.apostar -0.14580131 -0.09656764
## Conocimiento_deporte Publicidad
## Emoción_y_adrenalina -0.10372243 -0.05104659
## Entretenimiento -0.06913594 -0.03402498
## Ganancias -0.08404535 -0.04136259
## Socialización -0.03187389 -0.01568661
## Influencia.amigos.familiares -0.02111083 -0.01038961
## Conocimiento_deporte 1.00000000 -0.02111083
## Publicidad -0.02111083 1.00000000
## No.tengo.motivos.para.apostar -0.19621742 -0.09656764
## No.tengo.motivos.para.apostar
## Emoción_y_adrenalina -0.47445944
## Entretenimiento -0.31624980
## Ganancias -0.38445020
## Socialización -0.14580131
## Influencia.amigos.familiares -0.09656764
## Conocimiento_deporte -0.19621742
## Publicidad -0.09656764
## No.tengo.motivos.para.apostar 1.00000000
Graficar
# Calcular la suma de cada motivación para cada frecuencia
data_resumen <- data_unique %>%
group_by(Frecuencia) %>%
summarise(
Emoción_y_adrenalina = mean(Emoción_y_adrenalina, na.rm = TRUE),
Entretenimiento = mean(Entretenimiento, na.rm = TRUE),
Ganancias = mean(Ganancias, na.rm = TRUE),
Socialización = mean(Socialización, na.rm = TRUE),
Influencia.amigos.familiares = mean(Influencia.amigos.familiares, na.rm = TRUE),
Conocimiento_deporte = mean(Conocimiento_deporte, na.rm = TRUE),
Publicidad = mean(Publicidad, na.rm = TRUE),
No.tengo.motivos.para.apostar = mean(No.tengo.motivos.para.apostar, na.rm = TRUE),
.groups = 'drop'
)
# Transformar los datos para el gráfico
data_grafico <- pivot_longer(data_resumen,
cols = -Frecuencia,
names_to = "Motivacion",
values_to = "Proporcion")
# Graficar
plot2<-ggplot(data_grafico, aes(x = Frecuencia, y = Proporcion, fill = Motivacion)) +
geom_bar(stat = "identity", position = position_dodge()) +
labs(title = "Proporción de Motivaciones para Apostar según Frecuencia de Apuestas",
x = "Frecuencia de Apuestas",
y = "Proporción") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggplotly(plot2)
Validación cruzada
train_control <- trainControl(method = "cv", number = 10)
Ajustar el modelo multinomial usando validación cruzada
modelo_multinom_cv <- train(Frecuencia ~ Emoción_y_adrenalina + Entretenimiento +
Ganancias + Socialización +
Influencia.amigos.familiares +
Conocimiento_deporte +
Publicidad +
No.tengo.motivos.para.apostar,
data = data_unique,
method = "multinom",
trControl = train_control)
## # weights: 50 (36 variable)
## initial value 560.084394
## iter 10 value 213.403252
## iter 20 value 209.963255
## iter 30 value 209.748627
## iter 40 value 209.732291
## final value 209.732264
## converged
## # weights: 50 (36 variable)
## initial value 560.084394
## iter 10 value 248.995973
## iter 20 value 227.039603
## iter 30 value 224.954487
## iter 30 value 224.954486
## iter 30 value 224.954486
## final value 224.954486
## converged
## # weights: 50 (36 variable)
## initial value 560.084394
## iter 10 value 213.448847
## iter 20 value 210.034289
## iter 30 value 209.892999
## iter 40 value 209.853856
## iter 50 value 209.850941
## iter 60 value 209.847129
## iter 70 value 209.827659
## final value 209.827349
## converged
## # weights: 50 (36 variable)
## initial value 563.303269
## iter 10 value 217.191536
## iter 20 value 213.178957
## iter 30 value 212.828891
## iter 40 value 212.810065
## final value 212.810034
## converged
## # weights: 50 (36 variable)
## initial value 563.303269
## iter 10 value 248.304367
## iter 20 value 229.126534
## final value 227.930712
## converged
## # weights: 50 (36 variable)
## initial value 563.303269
## iter 10 value 217.235133
## iter 20 value 213.240483
## iter 30 value 212.976697
## iter 40 value 212.930958
## iter 50 value 212.926490
## iter 60 value 212.924413
## iter 70 value 212.913131
## iter 80 value 212.909441
## iter 90 value 212.905668
## iter 100 value 212.898168
## final value 212.898168
## stopped after 100 iterations
## # weights: 50 (36 variable)
## initial value 564.912707
## iter 10 value 219.391865
## iter 20 value 214.346797
## iter 30 value 214.086616
## iter 40 value 214.063278
## final value 214.063242
## converged
## # weights: 50 (36 variable)
## initial value 564.912707
## iter 10 value 237.593646
## iter 20 value 229.375189
## iter 30 value 229.235116
## final value 229.235032
## converged
## # weights: 50 (36 variable)
## initial value 564.912707
## iter 10 value 219.438189
## iter 20 value 214.414094
## iter 30 value 214.223360
## iter 40 value 214.186086
## iter 50 value 214.183011
## iter 60 value 214.178734
## iter 70 value 214.160116
## final value 214.158225
## converged
## # weights: 50 (36 variable)
## initial value 561.693831
## iter 10 value 219.295870
## iter 20 value 214.630954
## iter 30 value 213.890183
## iter 40 value 213.850065
## final value 213.849946
## converged
## # weights: 50 (36 variable)
## initial value 561.693831
## iter 10 value 254.951972
## iter 20 value 230.973361
## iter 30 value 228.784925
## final value 228.784915
## converged
## # weights: 50 (36 variable)
## initial value 561.693831
## iter 10 value 219.342474
## iter 20 value 214.684739
## iter 30 value 214.012787
## iter 40 value 213.981975
## iter 50 value 213.968191
## iter 60 value 213.963827
## iter 70 value 213.947125
## iter 80 value 213.945864
## iter 90 value 213.941096
## iter 100 value 213.937133
## final value 213.937133
## stopped after 100 iterations
## # weights: 50 (36 variable)
## initial value 564.912707
## iter 10 value 219.173915
## iter 20 value 214.778726
## iter 30 value 214.607726
## iter 40 value 214.598761
## final value 214.598748
## converged
## # weights: 50 (36 variable)
## initial value 564.912707
## iter 10 value 253.658942
## iter 20 value 230.830419
## iter 30 value 229.265437
## iter 30 value 229.265436
## iter 30 value 229.265436
## final value 229.265436
## converged
## # weights: 50 (36 variable)
## initial value 564.912707
## iter 10 value 219.217439
## iter 20 value 214.852345
## iter 30 value 214.755482
## iter 40 value 214.716256
## iter 50 value 214.714801
## iter 60 value 214.709522
## iter 70 value 214.689034
## iter 80 value 214.688593
## iter 90 value 214.683894
## iter 100 value 214.682837
## final value 214.682837
## stopped after 100 iterations
## # weights: 50 (36 variable)
## initial value 566.522145
## iter 10 value 222.821760
## iter 20 value 218.267803
## iter 30 value 218.022527
## iter 40 value 217.994574
## final value 217.994486
## converged
## # weights: 50 (36 variable)
## initial value 566.522145
## iter 10 value 240.723173
## iter 20 value 233.048087
## iter 30 value 232.912202
## final value 232.912015
## converged
## # weights: 50 (36 variable)
## initial value 566.522145
## iter 10 value 222.866972
## iter 20 value 218.334663
## iter 30 value 218.155771
## iter 40 value 218.119953
## iter 50 value 218.112147
## iter 60 value 218.105168
## iter 70 value 218.085275
## final value 218.084921
## converged
## # weights: 50 (36 variable)
## initial value 564.912707
## iter 10 value 217.697452
## iter 20 value 214.372637
## iter 30 value 214.134107
## iter 40 value 214.112807
## final value 214.112756
## converged
## # weights: 50 (36 variable)
## initial value 564.912707
## iter 10 value 238.105818
## iter 20 value 229.338728
## iter 30 value 229.157935
## final value 229.157698
## converged
## # weights: 50 (36 variable)
## initial value 564.912707
## iter 10 value 217.743127
## iter 20 value 214.439604
## iter 30 value 214.272001
## iter 40 value 214.234400
## iter 50 value 214.230074
## iter 60 value 214.225721
## iter 70 value 214.205556
## iter 80 value 214.204957
## iter 90 value 214.198835
## iter 100 value 214.197032
## final value 214.197032
## stopped after 100 iterations
## # weights: 50 (36 variable)
## initial value 563.303269
## iter 10 value 216.815191
## iter 20 value 213.365119
## iter 30 value 212.959864
## iter 40 value 212.942387
## final value 212.942360
## converged
## # weights: 50 (36 variable)
## initial value 563.303269
## iter 10 value 250.287852
## iter 20 value 230.621527
## iter 30 value 228.190002
## final value 228.189985
## converged
## # weights: 50 (36 variable)
## initial value 563.303269
## iter 10 value 216.860033
## iter 20 value 213.426029
## iter 30 value 213.106907
## iter 40 value 213.065095
## iter 50 value 213.061680
## iter 60 value 213.057430
## iter 70 value 213.040312
## final value 213.038318
## converged
## # weights: 50 (36 variable)
## initial value 561.693831
## iter 10 value 213.475848
## iter 20 value 210.559542
## iter 30 value 210.345768
## iter 40 value 210.334987
## final value 210.334950
## converged
## # weights: 50 (36 variable)
## initial value 561.693831
## iter 10 value 247.747783
## iter 20 value 228.483311
## iter 30 value 226.639530
## final value 226.639526
## converged
## # weights: 50 (36 variable)
## initial value 561.693831
## iter 10 value 213.522264
## iter 20 value 210.637844
## iter 30 value 210.517633
## iter 40 value 210.468056
## iter 50 value 210.466488
## iter 60 value 210.461880
## iter 70 value 210.448897
## final value 210.447200
## converged
## # weights: 50 (36 variable)
## initial value 563.303269
## iter 10 value 215.558538
## iter 20 value 212.146242
## iter 30 value 211.907798
## iter 40 value 211.891533
## final value 211.891510
## converged
## # weights: 50 (36 variable)
## initial value 563.303269
## iter 10 value 250.397786
## iter 20 value 229.287745
## iter 30 value 227.197844
## final value 227.197840
## converged
## # weights: 50 (36 variable)
## initial value 563.303269
## iter 10 value 215.603184
## iter 20 value 212.215863
## iter 30 value 212.056555
## iter 40 value 212.013716
## iter 50 value 212.010581
## iter 60 value 212.006750
## iter 70 value 211.991030
## final value 211.990355
## converged
## # weights: 50 (36 variable)
## initial value 626.071348
## iter 10 value 261.684510
## iter 20 value 253.526885
## iter 30 value 253.376775
## final value 253.376601
## converged
# Ver el resumen del modelo
print(modelo_multinom_cv)
## Penalized Multinomial Regression
##
## 389 samples
## 8 predictor
## 5 classes: 'Raramente (lapsos de mas de un mes entre apuestas)', 'Diaria_Semanal', 'Quincenal', 'Mensual', 'No apuesta'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 348, 350, 351, 349, 351, 352, ...
## Resampling results across tuning parameters:
##
## decay Accuracy Kappa
## 0e+00 0.7200103 0.5691997
## 1e-04 0.7254158 0.5775707
## 1e-01 0.7254158 0.5775707
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was decay = 0.1.
Modelo de Regresión Logístico
Seleccionar solo las columnas relevantes para el modelo
data_modelo <- data %>%
select(Apuesta, Edad, Estrato, Sexo)
Ajustar el modelo de regresión logística
modelo_logistico <- glm(Apuesta ~ Edad + Estrato + Sexo,
data = data_modelo,
family = binomial())
Resumen del modelo
summary(modelo_logistico)
##
## Call:
## glm(formula = Apuesta ~ Edad + Estrato + Sexo, family = binomial(),
## data = data_modelo)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.8878 -1.1603 0.6894 1.0768 1.8517
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 4.24798 1.02359 4.150 3.32e-05 ***
## Edad -0.14089 0.04509 -3.125 0.00178 **
## Estrato -0.25538 0.09938 -2.570 0.01018 *
## SexoMujer -1.22007 0.24476 -4.985 6.20e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 538.13 on 388 degrees of freedom
## Residual deviance: 496.66 on 385 degrees of freedom
## AIC: 504.66
##
## Number of Fisher Scoring iterations: 4
Analisis de colinealidad
vif_model <- lm(Apuesta ~ Edad + Estrato + Facultad + Sexo, data = data_unique)
vif(vif_model)
## GVIF Df GVIF^(1/(2*Df))
## Edad 1.072872 1 1.035795
## Estrato 1.134734 1 1.065239
## Facultad 1.226977 7 1.014718
## Sexo 1.109947 1 1.053540
Calcular las probabilidades predichas usando el modelo
logístico
data_modelo$Probabilidad <- predict(modelo_logistico, newdata = data_modelo, type = "response")
Crear una curva de datos para diferentes combinaciones de Edad, Sexo
y Estrato
data_curve <- expand.grid(
Edad = seq(min(data_modelo$Edad, na.rm = TRUE), max(data_modelo$Edad, na.rm = TRUE), length.out = 100),
Sexo = unique(data_modelo$Sexo),
Estrato = unique(data_modelo$Estrato)
)
Calcular las probabilidades predichas para la curva de datos
data_curve$Probabilidad <- predict(modelo_logistico, newdata = data_curve, type = "response")
# Verificar los datos para detectar posibles problemas
print(head(data_modelo))
## # A tibble: 6 × 5
## Apuesta Edad Estrato Sexo Probabilidad
## <dbl> <dbl> <dbl> <chr> <dbl>
## 1 1 18 2 Hombre 0.769
## 2 0 22 2 Hombre 0.654
## 3 0 19 3 Mujer 0.398
## 4 0 22 1 Hombre 0.710
## 5 0 24 2 Hombre 0.588
## 6 0 22 2 Hombre 0.654
print(head(data_curve))
## Edad Sexo Estrato Probabilidad
## 1 17.00000 Hombre 2 0.7928420
## 2 17.13131 Hombre 2 0.7897870
## 3 17.26263 Hombre 2 0.7866990
## 4 17.39394 Hombre 2 0.7835781
## 5 17.52525 Hombre 2 0.7804243
## 6 17.65657 Hombre 2 0.7772376
Graficar los resultados
Plot1<-ggplot() +
geom_col(data = data_modelo, aes(x = Edad, y = Probabilidad, fill = Sexo), position = "dodge", alpha = 0.5) +
geom_line(data = data_curve, aes(x = Edad, y = Probabilidad, group = interaction(Sexo, Estrato), color = factor(Estrato)), linetype = "solid", linewidth = 0.8) + # Curva de regresión
labs(title = "Probabilidad de Apostar según Edad, Sexo y Estrato",
x = "Edad",
y = "Probabilidad de Apostar",
fill = "Sexo",
color = "Estrato") +
scale_fill_manual(values = c("lightblue", "pink")) + # Ajustar los colores para Sexo
scale_color_manual(values = c("darkblue", "darkred", "green", "orange", "purple", "yellow", "black")) +
theme_minimal() +
theme(legend.position = "bottom")
ggplotly(Plot1)
Convertir la variable ‘Apuesta’ en un factor con dos niveles
data_modelo$Apuesta <- as.factor(data_modelo$Apuesta)
Verificar los niveles de la variable ‘Apuesta’
levels(data_modelo$Apuesta)
## [1] "0" "1"
Ajustar el modelo usando validación cruzada
modelo_logistico_cv <- train(Apuesta ~ Edad + Estrato + Sexo,
data = data_modelo,
method = "glm",
family = "binomial",
trControl = train_control)
# Resumen del modelo con validación cruzada
print(modelo_logistico_cv)
## Generalized Linear Model
##
## 389 samples
## 3 predictor
## 2 classes: '0', '1'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 350, 351, 350, 350, 349, 351, ...
## Resampling results:
##
## Accuracy Kappa
## 0.6118826 0.2139101