1 Introducción

El análisis de datos en diferentes áreas como la gestión empresarial, las finanzas, la salud y las ciencias sociales requiere herramientas estadísticas que permitan comprender la relación entre diversas variables. En este estudio se aplica el método de la Ingeniería Estadística, el cual propone un proceso estructurado para resolver problemas mediante la identificación del problema, la construcción de modelos estadísticos y la validación de soluciones.
Para el análisis se utiliza la base de datos Affairs, disponible en el paquete AER del software R. Esta base contiene información relacionada con características personales y matrimoniales de individuos, incluyendo edad, años de matrimonio, nivel de religiosidad, educación y número de aventuras extramaritales. El objetivo es aplicar distintos modelos de regresión para analizar cómo diversos factores influyen en el comportamiento de los individuos.

2 Método de la Ingeniería Estadística

2.1 Descripción del problema

El objetivo central de este análisis consiste en identificar los factores personales que influyen en el comportamiento matrimonial de los individuos. Para ello, se han evaluado las siguientes dimensiones críticas:

  • Dimensión Cuantitativa: Número de aventuras extramaritales.
  • Dimensión Probabilística: Probabilidad de incurrir en infidelidad.
  • Dimensión Cualitativa: Nivel de satisfacción matrimonial.

Áreas de Aplicación

Los hallazgos derivados de este tipo de modelos estadísticos poseen una alta relevancia en diversos campos del conocimiento:

  1. Ciencias Sociales: Para el análisis profundo de la estructura y dinámica del comportamiento social.
  2. Economía: En estudios de comportamiento y toma de decisiones bajo modelos de utilidad.
  3. Comportamiento Organizacional: Para entender cómo los factores personales y el bienestar externo impactan en el desempeño dentro de las empresas.

2.2 Identificación de los factores importantes

Primero se identifican las variables de la base de datos.
library(knitr)
library(kableExtra)

# Definición de los datos
variables <- data.frame(
  Variable = c("affairs", "age", "yearsmarried", "religiousness", "education", "occupation", "rating"),
  Descripción = c("Número de aventuras extramaritales",
                  "Edad de la persona",
                  "Años de matrimonio",
                  "Nivel de religiosidad",
                  "Años de educación",
                  "Tipo de ocupación",
                  "Nivel de satisfacción matrimonial"),
  Tipo = c("Cuantitativa", "Cuantitativa", "Cuantitativa", "Ordinal", "Cuantitativa", "Categórica", "Ordinal"),
  Rol = c("Respuesta", "Predictor", "Predictor", "Predictor", "Predictor", "Predictor", "Predictor")
)

# Generación de la tabla 
variables %>%
  kbl(caption = "Definición y Rol de las Variables en el Estudio",
      align = "llll",
      booktabs = TRUE) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"),
                full_width = F,
                position = "center") %>%
  column_spec(1, bold = TRUE, color = "black", background = "pink") %>%
  row_spec(0, bold = TRUE, color = "black", background = "pink")
Definición y Rol de las Variables en el Estudio
Variable Descripción Tipo Rol
affairs Número de aventuras extramaritales Cuantitativa Respuesta
age Edad de la persona Cuantitativa Predictor
yearsmarried Años de matrimonio Cuantitativa Predictor
religiousness Nivel de religiosidad Ordinal Predictor
education Años de educación Cuantitativa Predictor
occupation Tipo de ocupación Categórica Predictor
rating Nivel de satisfacción matrimonial Ordinal Predictor

2.3 Propuesta del modelo

if (!require("DiagrammeR")) install.packages("DiagrammeR")
## Cargando paquete requerido: DiagrammeR
library(DiagrammeR)

# Generar el organizador gráfico con toda la información consolidada
grViz("
digraph propuesta_modelado {
  # Configuración del gráfico
  graph [layout = dot, rankdir = TB, fontname = 'Helvetica', nodesep = 0.5]
  
  # Estilo de los bloques
  node [shape = record, style = filled, fontname = 'Helvetica']
  
  # Bloques de información (Nombre | Respuesta | Tipo | Objetivo)
  modelo1 [label = '{ <f0> Regresión Lineal Simple | Variable: affairs | Tipo: Continua | Objetivo: Analizar relación entre años de matrimonio y aventuras }', fillcolor = '#E8F8F5']
  
  modelo2 [label = '{ <f0> Regresión Lineal Múltiple | Variable: affairs | Tipo: Continua | Objetivo: Analizar efecto conjunto de varios factores }', fillcolor = '#EBF5FB']
  
  modelo3 [label = '{ <f0> Regresión Logística | Variable: affair_yes | Tipo: Binaria | Objetivo: Estimar probabilidad de infidelidad }', fillcolor = '#FEF9E7']

  # Flujo de ejecución
  modelo1 -> modelo2 -> modelo3
  
  # Estilo de las flechas
  edge [color = '#2C3E50', arrowhead = vee, penwidth = 1.5]
}
")

2.4 Recolección de datos

Los datos provienen de la base Affairs incluida en el paquete AER.
library(AER)
## Cargando paquete requerido: car
## Cargando paquete requerido: carData
## Cargando paquete requerido: lmtest
## Cargando paquete requerido: zoo
## 
## Adjuntando el paquete: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
## Cargando paquete requerido: sandwich
## Cargando paquete requerido: survival
library(dplyr)
## 
## Adjuntando el paquete: 'dplyr'
## The following object is masked from 'package:car':
## 
##     recode
## 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, union
library(knitr)
library(ggplot2)

data("Affairs")

# Seleccionar solo variables numéricas
datos_num <- Affairs %>%
  select(affairs, age, yearsmarried, religiousness, education, occupation, rating)

tabla_desc <- data.frame(
  Variable = names(datos_num),
  N = sapply(datos_num, length),
  Media = sapply(datos_num, mean),
  Mediana = sapply(datos_num, median),
  DE = sapply(datos_num, sd),
  Min = sapply(datos_num, min),
  Max = sapply(datos_num, max)
)

kable(tabla_desc,
      caption = "Estadísticas descriptivas de las variables principales")
Estadísticas descriptivas de las variables principales
Variable N Media Mediana DE Min Max
affairs affairs 601 1.455907 0 3.298758 0.000 12
age age 601 32.487521 32 9.288762 17.500 57
yearsmarried yearsmarried 601 8.177696 7 5.571303 0.125 15
religiousness religiousness 601 3.116472 3 1.167509 1.000 5
education education 601 16.166389 16 2.402555 9.000 20
occupation occupation 601 4.194675 5 1.819443 1.000 7
rating rating 601 3.931780 4 1.103179 1.000 5

3 Modelo de Regresión Lineal Simple

Se analiza la relación entre años de matrimonio y número de aventuras extramaritales.
# ── Estimación ──────────────────────────────────────────────────
modelo_lineal  <- lm(affairs ~ yearsmarried, data = Affairs)
resumen_simple <- summary(modelo_lineal)

# ── Valores que usan las interpretaciones ───────────────────────
b0_s     <- round(coef(resumen_simple)[1,1], 4)   # intercepto
b1_s     <- round(coef(resumen_simple)[2,1], 4)   # pendiente yearsmarried
r2_s     <- round(resumen_simple$r.squared, 4)
r2_s_pct <- round(r2_s * 100, 2)
p_b1_s   <- coef(resumen_simple)[2,4]             # p-valor yearsmarried

# Etiqueta legible del p-valor
sig_s <- ifelse(p_b1_s < 0.001, "p < 0.001",
         ifelse(p_b1_s < 0.01,  "p < 0.01",
         ifelse(p_b1_s < 0.05,  "p < 0.05", "p ≥ 0.05")))

# ¿Sube o baja el número de aventuras?
dir_s <- ifelse(b1_s > 0, "aumenta", "disminuye")

# Calidad del ajuste
calidad_s <- ifelse(r2_s < 0.3,
  "valor bajo: los años de matrimonio por sí solos explican poco el número de aventuras extramaritales.",
  ifelse(r2_s < 0.6,
  "valor moderado: los años de matrimonio influyen en el número de aventuras, pero existen otros factores relevantes.",
  "valor alto: los años de matrimonio son el principal determinante del número de aventuras."))
resumen_simple
## 
## Call:
## lm(formula = affairs ~ yearsmarried, data = Affairs)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.2106 -1.6575 -0.9937 -0.5974 11.3658 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   0.55122    0.23511   2.345   0.0194 *  
## yearsmarried  0.11063    0.02377   4.655    4e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.243 on 599 degrees of freedom
## Multiple R-squared:  0.03491,    Adjusted R-squared:  0.0333 
## F-statistic: 21.67 on 1 and 599 DF,  p-value: 3.996e-06

Modelo: \[\text{affairs} = \beta_0 + \beta_1 \times \text{yearsmarried} + \epsilon\]

\[\text{affairs} = 0.55122 + 0.11063 \times \text{yearsmarried}\]

ggplot(Affairs, aes(x = yearsmarried, y = affairs)) +
  geom_point(alpha = 0.3, color = "pink", size = 1.5) +
  geom_smooth(method = "lm", color = "blue", se = TRUE, linewidth = 1.2) +
  labs(
    title    = "Regresión Lineal Simple: Años de matrimonio vs. Aventuras extramaritales",
    subtitle = paste0("R² = ", r2_s, "  |  p-valor (yearsmarried): ", sig_s),
    x        = "Años de matrimonio (yearsmarried)",
    y        = "Número de aventuras extramaritales (affairs)",
    caption  = "Fuente: Datos del paquete AER"
  ) +
  theme_minimal(base_size = 13) +
  theme(
    plot.title    = element_text(face = "bold"),
    plot.subtitle = element_text(color = "purple")
  )
## `geom_smooth()` using formula = 'y ~ x'

Interpretación:

  • Relación Positiva: Existe una relación directa entre las variables. Por cada año adicional de matrimonio, el número de aventuras extramaritales tiende a incrementar en 0.11 unidades en promedio.
  • Significancia Estadística: El factor “años de matrimonio” es un predictor significativo (\(p\)-valor < 0.05), lo que significa que el efecto observado no es producto del azar.
  • Capacidad Explicativa: A pesar de ser significativo, el modelo tiene un alcance muy limitado. El \(R^2\) de 0.035 indica que los años de matrimonio solo explican el 3.5% de la variación en las aventuras.
  • En resumen: Los años de matrimonio influyen, pero hay muchísimos otros factores (el 96.5% restante) que no están siendo considerados en este modelo lineal simple.

4 Modelo de Regresión Lineal Múltiple

Se considera el efecto conjunto de varios factores.
# ── Estimación ──────────────────────────────────────────────────
modelo_multiple <- lm(affairs ~ age + yearsmarried + religiousness +
                      education + occupation + rating, data = Affairs)

resumen_mult <- summary(modelo_multiple)

# ── Valores que usan las interpretaciones ───────────────────────
cm <- coef(resumen_mult)   # matriz con coeficientes

b_age  <- round(cm["age", 1], 4)
b_year <- round(cm["yearsmarried", 1], 4)
b_rel  <- round(cm["religiousness", 1], 4)
b_edu  <- round(cm["education", 1], 4)
b_occ  <- round(cm["occupation", 1], 4)
b_rat  <- round(cm["rating", 1], 4)

r2_m     <- round(resumen_mult$adj.r.squared, 4)
r2_m_pct <- round(r2_m * 100, 2)

sig_m <- function(var) {
  p <- cm[var, 4]
  ifelse(p < 0.001, "estadísticamente significativo (p < 0.001)",
  ifelse(p < 0.01,  "estadísticamente significativo (p < 0.01)",
  ifelse(p < 0.05,  "estadísticamente significativo (p < 0.05)",
                    "no estadísticamente significativo")))
}

dir_m <- function(b) ifelse(b > 0, "aumenta", "reduce")
resumen_mult
## 
## Call:
## lm(formula = affairs ~ age + yearsmarried + religiousness + education + 
##     occupation + rating, data = Affairs)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -5.0658 -1.7110 -0.7708  0.2164 12.7951 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)    5.76250    1.09049   5.284 1.77e-07 ***
## age           -0.05003    0.02218  -2.256   0.0245 *  
## yearsmarried   0.16174    0.03693   4.379 1.41e-05 ***
## religiousness -0.47737    0.11151  -4.281 2.17e-05 ***
## education     -0.01303    0.06280  -0.207   0.8357    
## occupation     0.11487    0.08300   1.384   0.1669    
## rating        -0.70897    0.11943  -5.936 4.96e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.09 on 594 degrees of freedom
## Multiple R-squared:  0.1315, Adjusted R-squared:  0.1227 
## F-statistic: 14.99 on 6 and 594 DF,  p-value: 5.302e-16
Este modelo permite analizar cómo factores como:
- edad
- educación
- religiosidad
- años de matrimonio
influyen simultáneamente en el comportamiento de los individuos.

Modelo \[affairs = \beta_0 + \beta_1(age) + \beta_2(yearsmarried) + \beta_3(religiousness) + \beta_4(education) + \beta_5(occupation) + \beta_6(rating) + \epsilon\] \[\text{affairs} = 5.76250 - 0.05003(\text{age}) + 0.16174(\text{yearsmarried}) - 0.47737(\text{religiousness}) - 0.01303(\text{education}) + 0.11487(\text{occupation}) - 0.70897(\text{rating})\]

coefs_plot <- data.frame(
  Variable  = rownames(cm)[-1],
  Estimado  = cm[-1, 1],
  Error     = cm[-1, 2],
  Pvalor    = cm[-1, 4]
) %>%
  mutate(
    Sig = ifelse(Pvalor < 0.05, "Sig. (p < 0.05)", "No significativo"),
    Variable = recode(Variable,
                      "age" = "Edad",
                      "yearsmarried" = "Años de matrimonio",
                      "religiousness" = "Religiosidad",
                      "education" = "Años de educación",
                      "occupation" = "Tipo de ocupación",
                      "rating" = "Satisfacción matrimonial")
  )

ggplot(coefs_plot,
       aes(x = reorder(Variable, Estimado),
           y = Estimado,
           color = Sig,
           fill = Sig)) +

  geom_hline(yintercept = 0,
             linetype = "dashed",
             color = "brown") +

  geom_col(alpha = 0.7, width = 0.6) +

  geom_errorbar(aes(ymin = Estimado - 1.96 * Error,
                    ymax = Estimado + 1.96 * Error),
                width = 0.25,
                linewidth = 0.9) +

  scale_color_manual(values = c("Sig. (p < 0.05)" = "green",
                                "No significativo" = "purple")) +

  scale_fill_manual(values = c("Sig. (p < 0.05)" = "green",
                               "No significativo" = "purple")) +

  coord_flip() +

  labs(
    title    = "Coeficientes del Modelo de Regresión Múltiple",
    subtitle = paste0("R² ajustado = ", r2_m,
                      "  |  Barras de error = IC al 95%"),
    x = NULL,
    y = "Coeficiente estimado",
    color = NULL,
    fill = NULL,
    caption = "Fuente: Datos del paquete AER"
  ) +

  theme_minimal(base_size = 13) +
  theme(
    plot.title = element_text(face = "bold"),
    legend.position = "bottom"
  )

Interpretación

  • Factores de reducción: La satisfacción matrimonial (rating) y la religiosidad son los predictores más importantes; a mayores niveles de ambos, el número de aventuras disminuye significativamente.
  • Factor de incremento: Los años de matrimonio mantienen una relación positiva; a más tiempo de casados, mayor es la tendencia al aumento de aventuras.
  • Variables no significativas: La educación y la ocupación no tienen un efecto estadísticamente relevante (\(p > 0.05\)).
  • Poder explicativo: El modelo logra explicar el 12.3% de la variabilidad de los datos (\(R^2\) ajustado = 0.1227), lo cual es una mejora respecto al modelo simple.

5 Modelo de Regresión Logística

Se crea una variable binaria:

0 = no tuvo aventuras

1 = tuvo al menos una aventura

Affairs$affair_bin <- ifelse(Affairs$affairs > 0, 1, 0)
# ── Estimación ──────────────────────────────────────────────────
modelo_logistico <- glm(affair_bin ~ age + yearsmarried + religiousness +
                        education + occupation + rating,
                        data   = Affairs,
                        family = binomial)

resumen_log <- summary(modelo_logistico)
ic_log <- confint(modelo_logistico)
## Waiting for profiling to be done...
# Función: Odds Ratio de una variable
or_v <- function(var) round(exp(coef(modelo_logistico)[var]), 3)
sig_l <- function(var) {
  p <- coef(resumen_log)[var, 4]
  ifelse(p < 0.001, "estadísticamente significativo (p < 0.001)",
  ifelse(p < 0.01,  "estadísticamente significativo (p < 0.01)",
  ifelse(p < 0.05,  "estadísticamente significativo (p < 0.05)",
                    "no estadísticamente significativo")))
}
efecto_or <- function(var) {
  or <- or_v(var)
  if (or > 1)
    paste0("incrementa la probabilidad de tener aventuras extramaritales en un ",
           round((or - 1) * 100, 1), "%")
  else
    paste0("reduce la probabilidad de tener aventuras extramaritales en un ",
           round((1 - or) * 100, 1), "%")
}

resumen_log
## 
## Call:
## glm(formula = affair_bin ~ age + yearsmarried + religiousness + 
##     education + occupation + rating, family = binomial, data = Affairs)
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)    1.32620    0.85389   1.553 0.120393    
## age           -0.04105    0.01794  -2.288 0.022138 *  
## yearsmarried   0.10617    0.02949   3.600 0.000318 ***
## religiousness -0.32024    0.08958  -3.575 0.000351 ***
## education      0.03615    0.04977   0.726 0.467571    
## occupation     0.04689    0.06659   0.704 0.481292    
## rating        -0.47870    0.09050  -5.289 1.23e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 675.38  on 600  degrees of freedom
## Residual deviance: 613.17  on 594  degrees of freedom
## AIC: 627.17
## 
## Number of Fisher Scoring iterations: 4
La regresión logística permite estimar la probabilidad de que una persona tenga una aventura.

Modelo \[\ln\left(\frac{P}{1-P}\right) = \beta_0 + \beta_1(age) + \beta_2(yearsmarried) + \beta_3(religiousness) + \beta_4(education) + \beta_5(occupation) + \beta_6(rating)\]

\[\text{logit}(P) = 1.3262 - 0.0411(age) + 0.1062(yearsmarried) - 0.3202(religiousness) + 0.0362(education) + 0.0469(occupation) - 0.4787(rating)\]

library(kableExtra)
or_tabla <- data.frame(
  Variable = names(coef(modelo_logistico))[-1],
  OR       = round(exp(coef(modelo_logistico))[-1], 3),
  IC_inf   = round(exp(ic_log[-1, 1]), 3),
  IC_sup   = round(exp(ic_log[-1, 2]), 3),
  Pvalor   = round(coef(resumen_log)[-1, 4], 4)
) %>%
  mutate(
    Efecto = ifelse(OR > 1,
                    paste0("↑ +", round((OR-1)*100,1), "%"),
                    paste0("↓ -", round((1-OR)*100,1), "%")),
    Sig = ifelse(Pvalor < 0.001, "***",
          ifelse(Pvalor < 0.01,  "**",
          ifelse(Pvalor < 0.05,  "*", "n.s."))),
    
    # nombres más claros para el informe
    Variable = recode(Variable,
                      "age" = "Edad",
                      "yearsmarried" = "Años de matrimonio",
                      "religiousness" = "Religiosidad",
                      "education" = "Años de educación",
                      "occupation" = "Tipo de ocupación",
                      "rating" = "Satisfacción matrimonial")
  )

kable(or_tabla,
      col.names = c("Variable","Odds Ratio","IC 95% Inf.","IC 95% Sup.",
                    "p-valor","Efecto sobre aventuras","Sig."),
      caption = "Odds Ratios del modelo de regresión logística") %>%
  kable_styling(bootstrap_options = c("striped","hover"), full_width = TRUE) %>%
  column_spec(2, bold = TRUE,
              color = ifelse(or_tabla$OR > 1, "purple", "red")) %>%
  row_spec(which(or_tabla$Pvalor < 0.05), background = "#eaf4fb")
Odds Ratios del modelo de regresión logística
Variable Odds Ratio IC 95% Inf. IC 95% Sup. p-valor Efecto sobre aventuras Sig.
age Edad 0.960 0.926 0.993 0.0221 ↓ -4%
yearsmarried Años de matrimonio 1.112 1.050 1.179 0.0003 ↑ +11.2% ***
religiousness Religiosidad 0.726 0.608 0.864 0.0004 ↓ -27.4% ***
education Años de educación 1.037 0.941 1.144 0.4676 ↑ +3.7% n.s.
occupation Tipo de ocupación 1.048 0.921 1.196 0.4813 ↑ +4.8% n.s.
rating Satisfacción matrimonial 0.620 0.518 0.739 0.0000 ↓ -38% *** 
or_plot <- or_tabla %>%
  mutate(Variable = recode(Variable,
                           "Edad" = "Edad",
                           "Años de matrimonio" = "Años de matrimonio",
                           "Religiosidad" = "Religiosidad",
                           "Años de educación" = "Años de educación",
                           "Tipo de ocupación" = "Tipo de ocupación",
                           "Satisfacción matrimonial" = "Satisfacción matrimonial"))

ggplot(or_plot, aes(x = reorder(Variable, OR), y = OR, color = OR > 1)) +
  geom_hline(yintercept = 1, linetype = "dashed", color = "gray50", linewidth = 0.8) +
  
  geom_point(size = 4) +
  
  geom_errorbar(aes(ymin = IC_inf, ymax = IC_sup),
                width = 0.2,
                linewidth = 1.1) +
  
  scale_color_manual(values = c("TRUE" = "orange", "FALSE" = "red"),
                     labels  = c("TRUE"  = "OR > 1: aumenta probabilidad de aventuras",
                                 "FALSE" = "OR < 1: reduce probabilidad de aventuras")) +
  
  scale_y_log10() +
  
  coord_flip() +
  
  labs(
    title    = "Odds Ratios — Regresión Logística",
    subtitle = "OR > 1: mayor probabilidad de aventuras extramaritales | OR < 1: menor probabilidad\nEscala logarítmica. Barras = IC al 95%.",
    x = NULL,
    y = "Odds Ratio (escala log)",
    color = NULL,
    caption = "Fuente: Datos del paquete AER"
  ) +
  
  theme_minimal(base_size = 13) +
  theme(
    plot.title      = element_text(face = "bold"),
    plot.subtitle   = element_text(color = "#555555", size = 10),
    legend.position = "bottom"
  )

Interpretación

  • Factores que disminuyen el riesgo: La satisfacción matrimonial (rating) y la religiosidad son los inhibidores más fuertes. Por cada punto adicional en la escala de satisfacción, la probabilidad de tener una aventura se reduce drásticamente.

  • Factores que aumentan el riesgo: Los años de matrimonio incrementan significativamente la probabilidad de incurrir en conductas extramaritales conforme aumenta el tiempo de relación.

  • Impacto de la edad: La edad muestra un efecto negativo significativo; a mayor edad (controlando el resto de factores), disminuye la probabilidad de tener una aventura.

  • Variables irrelevantes: Al igual que en los modelos anteriores, la educación y la ocupación no tienen un impacto estadísticamente significativo en la probabilidad.

  • Bondad de ajuste: La reducción de la Deviance (de 675.38 a 613.17) indica que el modelo es útil y que los predictores elegidos mejoran significativamente la estimación respecto al modelo nulo.

6 Confirmación de la solución y recomendaciones

resumen_final <- data.frame(
  Factor = c("Edad (age)",
             "Años de matrimonio (yearsmarried)",
             "Religiosidad (religiousness)",
             "Años de educación (education)",
             "Tipo de ocupación (occupation)",
             "Satisfacción matrimonial (rating)"),

  Efecto_Affairs = c(
    paste0(ifelse(coef(resumen_mult)["age",1]>0,"↑","↓"),
           " β = ", round(coef(resumen_mult)["age",1],3)),

    paste0(ifelse(coef(resumen_mult)["yearsmarried",1]>0,"↑","↓"),
           " β = ", round(coef(resumen_mult)["yearsmarried",1],3)),

    paste0(ifelse(coef(resumen_mult)["religiousness",1]>0,"↑","↓"),
           " β = ", round(coef(resumen_mult)["religiousness",1],3)),

    paste0(ifelse(coef(resumen_mult)["education",1]>0,"↑","↓"),
           " β = ", round(coef(resumen_mult)["education",1],3)),

    paste0(ifelse(coef(resumen_mult)["occupation",1]>0,"↑","↓"),
           " β = ", round(coef(resumen_mult)["occupation",1],3)),

    paste0(ifelse(coef(resumen_mult)["rating",1]>0,"↑","↓"),
           " β = ", round(coef(resumen_mult)["rating",1],3))
  ),

  Efecto_Logistico = c(
    paste0("OR = ", or_v("age")),
    paste0("OR = ", or_v("yearsmarried")),
    paste0("OR = ", or_v("religiousness")),
    paste0("OR = ", or_v("education")),
    paste0("OR = ", or_v("occupation")),
    paste0("OR = ", or_v("rating"))
  )
)
resumen_final
##                              Factor Efecto_Affairs Efecto_Logistico
## 1                        Edad (age)    ↓ β = -0.05        OR = 0.96
## 2 Años de matrimonio (yearsmarried)    ↑ β = 0.162       OR = 1.112
## 3      Religiosidad (religiousness)   ↓ β = -0.477       OR = 0.726
## 4     Años de educación (education)   ↓ β = -0.013       OR = 1.037
## 5    Tipo de ocupación (occupation)    ↑ β = 0.115       OR = 1.048
## 6 Satisfacción matrimonial (rating)   ↓ β = -0.709        OR = 0.62
kable(resumen_final,
      col.names = c("Factor",
                    "Efecto sobre aventuras (Reg. Múltiple)",
                    "Efecto sobre probabilidad (Reg. Logística)"),
      caption = "Resumen consolidado de efectos por variable") %>%
  kable_styling(bootstrap_options = c("striped","hover"), full_width = TRUE) %>%
  column_spec(2:3, bold = TRUE)
Resumen consolidado de efectos por variable
Factor Efecto sobre aventuras (Reg. Múltiple) Efecto sobre probabilidad (Reg. Logística)
Edad (age) ↓ β = -0.05 OR = 0.96
Años de matrimonio (yearsmarried) ↑ β = 0.162 OR = 1.112
Religiosidad (religiousness) ↓ β = -0.477 OR = 0.726
Años de educación (education) ↓ β = -0.013 OR = 1.037
Tipo de ocupación (occupation) ↑ β = 0.115 OR = 1.048
Satisfacción matrimonial (rating) ↓ β = -0.709 OR = 0.62

Interpretación de la tabla

Predictores de Protección: La satisfacción matrimonial (rating) y la religiosidad son los factores más determinantes para reducir tanto el número de aventuras (\(\beta\) negativos) como la probabilidad de tenerlas (\(OR < 1\)).

7 Diagrama de Ishikawa

library(ggplot2)
library(dplyr)

# ── Categorías ─────────────────────────────────
categorias <- data.frame(
  nombre = c("Características individuales",
             "Relación de pareja",
             "Entorno social",
             "Capital humano",
             "Condiciones laborales"),
  y = c(4, 2, 0, -2, -4),
  color = c("#1abc9c","#e67e22","#3498db","#9b59b6","#e74c3c")
)

# ── Subcausas con separación vertical ──────────
causas <- data.frame(
  categoria = c(
    rep("Características individuales",3),
    rep("Relación de pareja",3),
    rep("Entorno social",3),
    rep("Capital humano",3),
    rep("Condiciones laborales",3)
  ),

  causa = c(
    "Edad","Etapa de vida","Madurez emocional",
    "Años de matrimonio","Satisfacción marital","Estabilidad de pareja",
    "Religiosidad","Normas sociales","Valores culturales",
    "Nivel educativo","Formación académica","Acceso a educación",
    "Tipo de ocupación","Estrés laboral","Tiempo de trabajo"
  ),

  offset = rep(c(-0.6,0,0.6),5)
)

causas <- causas %>%
  left_join(categorias, by=c("categoria"="nombre")) %>%
  mutate(
    y_sub = y + offset,
    x = 3.5
  )

# ── Gráfico ───────────────────────────────────
ggplot() +

  theme_void() +

  # espina central
  geom_segment(aes(x=0,xend=10,y=0,yend=0),
               linewidth=2.5,
               color="#2c3e50",
               arrow=arrow(length=unit(0.4,"cm"),type="closed")) +

  # ramas principales
  geom_segment(data=categorias,
               aes(x=2,xend=5,y=y,yend=0,color=color),
               linewidth=1.8,
               show.legend=FALSE) +

  scale_color_identity() +

  # etiquetas categorías
  geom_label(data=categorias,
             aes(x=1.6,y=y,label=nombre,fill=color),
             color="white",
             fontface="bold",
             size=4,
             show.legend=FALSE) +

  scale_fill_identity() +

  # líneas de subcausas
  geom_segment(data=causas,
               aes(x=3.1,xend=2.4,y=y_sub,yend=y),
               linewidth=0.9,
               color="gray40") +

  # texto subcausas
  geom_text(data=causas,
            aes(x=3.6,y=y_sub,label=causa),
            size=3.2,
            hjust=0) +

  # problema central
  annotate("label",
           x=10.5,
           y=0,
           label="INFIDELIDAD\n(Affairs)",
           fill="#e74c3c",
           color="white",
           fontface="bold",
           size=5,
           label.padding=unit(0.5,"lines")) +

  xlim(-1,12) + ylim(-5,5) +

  labs(
    title="Diagrama de Ishikawa: Factores asociados a la infidelidad",
    subtitle="Basado en la base de datos Affairs",
    caption="Fuente: paquete AER"
  ) +

  theme(
    plot.title=element_text(face="bold",hjust=0.5),
    plot.subtitle=element_text(hjust=0.5)
  )

Interpretación

El diagrama muestra que la infidelidad (Affairs) puede estar influenciada por varios grupos de factores. Entre ellos se encuentran las características individuales (edad y madurez), la relación de pareja (años de matrimonio y satisfacción conyugal), el entorno social (religión y normas culturales), el capital humano (nivel educativo) y las condiciones laborales (tipo de trabajo y estrés laboral).
En conjunto, estos factores pueden contribuir al comportamiento de infidelidad dentro de la relación.

8 Conclusión

En este trabajo se analizó la base de datos Affairs con el objetivo de identificar los factores asociados a la infidelidad utilizando herramientas de análisis estadístico y modelos de regresión. A través del análisis exploratorio y de los modelos aplicados, se observó que variables relacionadas con las características personales, la relación de pareja, el entorno social, el nivel educativo y las condiciones laborales pueden influir en la probabilidad de que ocurra infidelidad.
Los resultados obtenidos muestran que aspectos como los años de matrimonio, la satisfacción en la relación, el nivel educativo y algunos factores sociales presentan relación con el comportamiento estudiado. Además, el uso de modelos estadísticos permitió comprender cómo estas variables contribuyen al fenómeno desde una perspectiva cuantitativa.
En general, el análisis evidencia que la infidelidad no depende de un solo factor, sino de la interacción de diversas condiciones personales, sociales y relacionales. Por lo tanto, el uso de herramientas estadísticas resulta fundamental para identificar patrones y comprender mejor este tipo de comportamientos dentro de las relaciones de pareja.

9 Recomendación

10 Bibligrafía

R Core Team. (2024). R: Un lenguaje y entorno para el análisis estadístico. R Foundation for Statistical Computing. https://www.r-project.org/
Montgomery, D. C., Peck, E. A., & Vining, G. G. (2015). Introducción al análisis de regresión lineal (5.ª ed.). Limusa Wiley.
Hosmer, D. W., Lemeshow, S., & Sturdivant, R. X. (2013). Regresión logística aplicada (3.ª ed.). Wiley.