hombres <- read_csv("dat/ROLESTODO_hombres_descriptores_long.csv")SADCAT para ROLES en Hombres
SADCAT para Roles en Hombres
Notebook de análisis del dataset ROLESTODO mediante el cálculo de las puntuaciones en distintas facetas y dimensiones de teoría de estereotipos a partir del diccionario SADCAT en español.
Este notebook está preparado para analizar el dataset de roles en hombres. Comenzamos con su importación y análisis de estructura:
str(hombres)spc_tbl_ [82 × 6] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
$ CODIGO : num [1:82] 301 302 303 304 305 306 307 308 309 310 ...
$ TIPO_cuestionario: num [1:82] 3 3 3 3 3 3 3 3 3 3 ...
$ item : chr [1:82] "PA1.TORERO" "PA1.TORERO" "PA1.TORERO" "PA1.TORERO" ...
$ descripcion : chr [1:82] "Valiente, Capaz, Fuerte" "Fuerte, Valiente, Agresivo, Inteligente, Estratega, Rápido, Cruel" "Español, Tradicional, Cultural, Asesino, Artista, Firme, Insensible" "Artista, Habilidoso, Elegancia, Valorado, Tradicional, Ostentoso, Valiente, Honrado" ...
$ fase : chr [1:82] "PA1" "PA1" "PA1" "PA1" ...
$ target : chr [1:82] "TORERO" "TORERO" "TORERO" "TORERO" ...
- attr(*, "spec")=
.. cols(
.. CODIGO = col_double(),
.. TIPO_cuestionario = col_double(),
.. item = col_character(),
.. descripcion = col_character(),
.. fase = col_character(),
.. target = col_character()
.. )
- attr(*, "problems")=<externalptr> División de descriptores
Las descripciones quedan definidas en la columna descripcion del dataset y están separadas por ,. Se ha diseñado una función en el script Data.R, ya importado a este notebook en la inicialización, para separar los descriptores y limpiarlos. Aplicamos la función:
library(udpipe)
m <- udpipe_download_model(language = "spanish")
ud_model <- udpipe_load_model(m$file_model)
hombres_split <- split_descriptors(hombres,input_type = "data", desc_col = "descripcion", lemmatize = "both", udpipe_model = ud_model)Accediendo a la cabecera del dataset vemos que los descriptores aparecen cada uno en una columna, eliminando acentos, mayúsculas y caraceteres especiales, y uniendo los n_gramas (SADCAT está diseñado para evaluar n_gramas unidos).
head(hombres_split)Análisis de cobertura global
Posteriormente, se aplica una función definida en Dictionary.R para analizar el coverage global del diccionario. Esto nos permite analizar qué descripciones son quedan mejor representadas en el diccionario SADCAT en español, y nos permitirá más adelante evaluar la posible eliminación de casos, o la limpieza de los descriptores.
hombres_cov <- dict_coverage(hombres_split, prefix = "descriptor_")hombres_covAnálisis de cobertura por dimensión
A continuación, se utiliza la función dict_dim_coverage_all() para combrobar la cobertura de cada dimensión y faceta del diccionario por separado en cada uno de los casos. Los resultados muestran una baja cobertura en la mayoría de las facetas. En muchos casos, esto puede ser normal, ya que la tarea no fué diseñada para evaluar dichas facetas.
hombres_cov_dims <- dict_dim_coverage_all(hombres_cov, prefix = "descriptor_")Para evaluar la cobertura de las dimensiones y facetas con mayor precisión, a continuación se prepara un bloque de resumen de la cobertura media (media por casos) para cada uno de estos elementos. Se ordena de forma descendente.
cov_cols <- grep("^cov_", names(hombres_cov_dims), value = TRUE)
m <- colMeans(hombres_cov_dims[, cov_cols, drop = FALSE], na.rm = TRUE)
means_cov <- data.frame(
variable = names(m),
mean_coverage = as.numeric(m),
row.names = NULL
)
means_cov <- means_cov[order(means_cov$mean_coverage, decreasing = TRUE), ]
means_covCálculo de dirección para cada dimensión y faceta
Finalmente, se calcula la dirección media en cada faceta y dimensión. Este procedimiento está definido en la función dict_dim_dirmean_all() en el script Dictionary.R que ya ha sido importado en el cuaderno. El procedimiento utilizado es el recomendado por Gandalf Nicolás, documentado en (referencia SADCAT):
Para cada fila (p. ej., un animal descrito por varios descriptor_n) y para cada dimensión X_dir del diccionario, tomamos solo los descriptores que:
- aparecen en
SADCAT::Spanishdicts$Palabra, y
- tienen un valor no-NA en
X_dir(típicamente -1, 0 o 1).
Entonces:
\[ dirmean_X = \text{mean}(X\_dir) \in [-1,1] \]
Si una fila no tiene ningún descriptor aplicable a esa dimensión, dirmean_X = NA.
Resultados esperables:
dirmean_X ≈ 1→ todos los descriptores aplicables son “alto” en X.dirmean_X ≈ -1→ todos los descriptores aplicables son “bajo” en X.dirmean_X ≈ 0→ mezcla de altos y bajos (o presencia de neutros si el diccionario usa 0).dirmean_X = NA→ no hay evidencia para esa dimensión (ningún descriptor conX_dirno-NA).
hombres_con_dirmean <- dict_dim_dirmean_all(hombres_cov_dims, prefix = "descriptor_")A continuación se prepara un bloque de análisis de los resultados en los que se pueden ver los descriptivos de cobertura, dirección media, y número de descriptores que contribuyen a estimar esta dirección media.
Descriptivos de cobertura, dirección y ocurrencias
cov_cols <- grep("^cov_", names(hombres_con_dirmean), value = TRUE)
dirmean_cols <- grep("^dirmean_", names(hombres_con_dirmean), value = TRUE)
n_cols <- grep("^n_dirmean_", names(hombres_con_dirmean), value = TRUE)summary_block <- function(df, cols) {
x <- df[, cols, drop = FALSE]
out <- data.frame(
variable = cols,
n = sapply(x, function(z) sum(!is.na(z))),
na = sapply(x, function(z) sum(is.na(z))),
mean = sapply(x, function(z) mean(z, na.rm = TRUE)),
sd = sapply(x, function(z) sd(z, na.rm = TRUE)),
min = sapply(x, function(z) min(z, na.rm = TRUE)),
q25 = sapply(x, function(z) quantile(z, 0.25, na.rm = TRUE, names = FALSE)),
median = sapply(x, function(z) median(z, na.rm = TRUE)),
q75 = sapply(x, function(z) quantile(z, 0.75, na.rm = TRUE, names = FALSE)),
max = sapply(x, function(z) max(z, na.rm = TRUE)),
row.names = NULL
)
out
}
cov_summary <- summary_block(hombres_con_dirmean, cov_cols)
dirmean_summary <- summary_block(hombres_con_dirmean, dirmean_cols)
n_summary <- summary_block(hombres_con_dirmean, n_cols)
cov_summary[order(cov_summary$mean, decreasing = TRUE), ]dirmean_summary[order(abs(dirmean_summary$mean), decreasing = TRUE), ] n_summary[order(n_summary$mean, decreasing = TRUE), ]Guardado de los datos
Exportamos el dataset con toda la información para continuar con en análisis predictivo a partir de los modelos lineales en los siguientes bloques.
write.csv(
hombres_con_dirmean,
file = "./dat/hombres_SADCAT.csv",
row.names = FALSE,
fileEncoding = "UTF-8"
)Modelado de dimensiones de competencia y cordialidad
Importamos tanto el dataset guardado, como el dataset con las puntuaciones de los participantes en la investigación. (en este punto habría que documentar bien qué significa cada variable en el dataset de ROLESTODO)
path_roles <- "./dat/ROLESTODO_hombres_scores.csv"
path_sadcat <- "./dat/hombres_SADCAT.csv"
roles <- read_csv(path_roles, show_col_types = FALSE)
sadcat <- read_csv(path_sadcat, show_col_types = FALSE)El dataset sadcat está en modo “long” porque resultaba más sencillo aplicar las funciones de cálculo de dirección y cobertura, pero para realizar los análisis predictivos debemos de ponerlo en modo “wide”. Esto lo hacemos en el siguiente bloque.
# Claves de unión (usa TIPO_cuestionario solo si está en ambos)
by_keys <- "CODIGO"
if ("TIPO_cuestionario" %in% names(roles) && "TIPO_cuestionario" %in% names(sadcat)) {
by_keys <- c("CODIGO", "TIPO_cuestionario")
}
# Recodifica target a un sufijo limpio
# (evitamos acentos y nombres largos en columnas)
sadcat_wide <- sadcat %>%
mutate(rol = case_when(
str_detect(target, "TORERO") ~ "torero",
str_detect(target, "HOMBRE_DEPORTISTA") ~ "hdeportista",
TRUE ~ make.names(target)
)) %>%
select(-target) %>%
pivot_wider(
id_cols = all_of(by_keys),
names_from = rol,
values_from = -c(all_of(by_keys), rol),
names_glue = "{.value}_{rol}",
values_fn = dplyr::first # <- clave: devuelve un valor escalar, no una lista
)
# 2) Une al dataset de roles (mantiene CODIGO y todo lo de roles)
df_roles_sadcat <- roles %>%
left_join(sadcat_wide, by = by_keys)Una vez disponemos del dataset df_roles_sadcat en el formato adecuado, podemos estimar los modelos de regresión simple para cada faceta o dimensión. A continuación se pueden ver algunos ejemplos con las dimensiones de cordialidad y competencia.
# Torero
m_cord_torero <- lm(cordialidad_torero ~ dirmean_Warmth_torero,
data = df_roles_sadcat, na.action = na.exclude)
m_comp_torero <- lm(competencia_torero ~ dirmean_Competence_torero,
data = df_roles_sadcat, na.action = na.exclude)
# Hombre deportista
m_cord_hdeportista <- lm(cordialidad_hombre_deportista ~ dirmean_Warmth_hdeportista,
data = df_roles_sadcat, na.action = na.exclude)
m_comp_hdeportista <- lm(competencia_hombre_deportista ~ dirmean_Competence_hdeportista,
data = df_roles_sadcat, na.action = na.exclude)# Ver resultados
summary(m_cord_torero)
Call:
lm(formula = cordialidad_torero ~ dirmean_Warmth_torero, data = df_roles_sadcat,
na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-1.8372 -0.9014 -0.1288 0.7631 2.5986
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 3.0835 0.2328 13.246 8.11e-16 ***
dirmean_Warmth_torero 0.6821 0.3794 1.798 0.0802 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.158 on 38 degrees of freedom
(1 observation deleted due to missingness)
Multiple R-squared: 0.07839, Adjusted R-squared: 0.05414
F-statistic: 3.232 on 1 and 38 DF, p-value: 0.08015summary(m_comp_torero)
Call:
lm(formula = competencia_torero ~ dirmean_Competence_torero,
data = df_roles_sadcat, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-2.4266 -0.6771 0.1948 0.8229 2.5354
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 3.561 0.589 6.047 7.49e-07 ***
dirmean_Competence_torero 1.116 0.652 1.711 0.0962 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.155 on 34 degrees of freedom
(5 observations deleted due to missingness)
Multiple R-squared: 0.07929, Adjusted R-squared: 0.05221
F-statistic: 2.928 on 1 and 34 DF, p-value: 0.09616summary(m_cord_hdeportista)
Call:
lm(formula = cordialidad_hombre_deportista ~ dirmean_Warmth_hdeportista,
data = df_roles_sadcat, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-2.3990 -0.6122 0.1167 0.6010 1.6010
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 5.3990 0.1716 31.462 <2e-16 ***
dirmean_Warmth_hdeportista 0.6396 0.2560 2.499 0.0173 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.9442 on 35 degrees of freedom
(4 observations deleted due to missingness)
Multiple R-squared: 0.1514, Adjusted R-squared: 0.1271
F-statistic: 6.244 on 1 and 35 DF, p-value: 0.01731summary(m_comp_hdeportista)
Call:
lm(formula = competencia_hombre_deportista ~ dirmean_Competence_hdeportista,
data = df_roles_sadcat, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-2.25599 -0.75599 0.02983 0.74401 1.74401
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 4.8273 0.7151 6.750 1.08e-07 ***
dirmean_Competence_hdeportista 0.4287 0.7678 0.558 0.58
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.042 on 33 degrees of freedom
(6 observations deleted due to missingness)
Multiple R-squared: 0.009361, Adjusted R-squared: -0.02066
F-statistic: 0.3118 on 1 and 33 DF, p-value: 0.5803# Ver gráficos de residuos (comentado para el render)
# plot(m_cord_torero)
# plot(m_comp_torero)
# plot(m_cord_hdeportista)
# plot(m_comp_hdeportista)Vamos a filtrar solo casos con un coverage mayor a cierto punto de corte para ver si cambian los resultados con datos más fiables:
- CASO A: Filtrado por coverage GLOBAL (>= 30%)
- Torero: filtrar por cov_pct_global_torero
- Deportista: filtrar por cov_pct_global_hdeportista
df_global30_torero <- filter_by_coverage(df_roles_sadcat, "cov_pct_global_torero", 30)
df_global30_hdeportista <- filter_by_coverage(df_roles_sadcat, "cov_pct_global_hdeportista", 30)
# Modelos (global >= 30%)
m_cord_torero_g30 <- lm(cordialidad_torero ~ dirmean_Warmth_torero,
data = df_global30_torero, na.action = na.exclude)
m_comp_torero_g30 <- lm(competencia_torero ~ dirmean_Competence_torero,
data = df_global30_torero, na.action = na.exclude)
m_cord_hdep_g30 <- lm(cordialidad_hombre_deportista ~ dirmean_Warmth_hdeportista,
data = df_global30_hdeportista, na.action = na.exclude)
m_comp_hdep_g30 <- lm(competencia_hombre_deportista ~ dirmean_Competence_hdeportista,
data = df_global30_hdeportista, na.action = na.exclude)
# Ver resultados (global >= 30%)
summary(m_cord_torero_g30)
Call:
lm(formula = cordialidad_torero ~ dirmean_Warmth_torero, data = df_global30_torero,
na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-1.80921 -0.82329 -0.08386 0.78023 2.67671
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 3.0839 0.2329 13.241 1.31e-15 ***
dirmean_Warmth_torero 0.7606 0.3879 1.961 0.0575 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.158 on 37 degrees of freedom
(1 observation deleted due to missingness)
Multiple R-squared: 0.09412, Adjusted R-squared: 0.06963
F-statistic: 3.844 on 1 and 37 DF, p-value: 0.05748summary(m_comp_torero_g30)
Call:
lm(formula = competencia_torero ~ dirmean_Competence_torero,
data = df_global30_torero, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-2.4266 -0.6771 0.1948 0.8229 2.5354
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 3.561 0.589 6.047 7.49e-07 ***
dirmean_Competence_torero 1.116 0.652 1.711 0.0962 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.155 on 34 degrees of freedom
(4 observations deleted due to missingness)
Multiple R-squared: 0.07929, Adjusted R-squared: 0.05221
F-statistic: 2.928 on 1 and 34 DF, p-value: 0.09616summary(m_cord_hdep_g30)
Call:
lm(formula = cordialidad_hombre_deportista ~ dirmean_Warmth_hdeportista,
data = df_global30_hdeportista, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-2.3990 -0.6122 0.1167 0.6010 1.6010
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 5.3990 0.1716 31.462 <2e-16 ***
dirmean_Warmth_hdeportista 0.6396 0.2560 2.499 0.0173 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.9442 on 35 degrees of freedom
(2 observations deleted due to missingness)
Multiple R-squared: 0.1514, Adjusted R-squared: 0.1271
F-statistic: 6.244 on 1 and 35 DF, p-value: 0.01731summary(m_comp_hdep_g30)
Call:
lm(formula = competencia_hombre_deportista ~ dirmean_Competence_hdeportista,
data = df_global30_hdeportista, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-2.25599 -0.75599 0.02983 0.74401 1.74401
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 4.8273 0.7151 6.750 1.08e-07 ***
dirmean_Competence_hdeportista 0.4287 0.7678 0.558 0.58
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.042 on 33 degrees of freedom
(4 observations deleted due to missingness)
Multiple R-squared: 0.009361, Adjusted R-squared: -0.02066
F-statistic: 0.3118 on 1 and 33 DF, p-value: 0.5803CASO B: Filtrado por coverage ESPECÍFICO por análisis (>= 20%)
- Cordialidad torero: cov_Warmth_dict_pct_torero
- Competencia torero: cov_Competence_dict_pct_torero
- Cordialidad Deport.: cov_Warmth_dict_pct_hdeportista
- Competencia Deport.: cov_Competence_dict_pct_hdeportista
df_warmth20_torero <- filter_by_coverage(df_roles_sadcat,
"cov_Warmth_dict_pct_torero", 20)
df_comp20_torero <- filter_by_coverage(df_roles_sadcat,
"cov_Competence_dict_pct_torero", 20)
df_warmth20_hdeportista <- filter_by_coverage(df_roles_sadcat,
"cov_Warmth_dict_pct_hdeportista", 20)
df_comp20_hdeportista <- filter_by_coverage(df_roles_sadcat,
"cov_Competence_dict_pct_hdeportista", 20)
# Modelos (específico >= 20%)
m_cord_torero_w20 <- lm(cordialidad_torero ~ dirmean_Warmth_torero,
data = df_warmth20_torero, na.action = na.exclude)
m_comp_torero_c20 <- lm(competencia_torero ~ dirmean_Competence_torero,
data = df_comp20_torero, na.action = na.exclude)
m_cord_hdep_w20 <- lm(cordialidad_hombre_deportista ~ dirmean_Warmth_hdeportista,
data = df_warmth20_hdeportista, na.action = na.exclude)
m_comp_hdep_c20 <- lm(competencia_hombre_deportista ~ dirmean_Competence_hdeportista,
data = df_comp20_hdeportista, na.action = na.exclude)
# Ver resultados (específico >= 20%)
summary(m_cord_torero_w20)
Call:
lm(formula = cordialidad_torero ~ dirmean_Warmth_torero, data = df_warmth20_torero,
na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-1.7648 -0.6366 -0.1242 0.6671 1.8820
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 3.1304 0.2214 14.141 4.88e-16 ***
dirmean_Warmth_torero 1.0124 0.3726 2.717 0.0102 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.078 on 35 degrees of freedom
Multiple R-squared: 0.1742, Adjusted R-squared: 0.1506
F-statistic: 7.383 on 1 and 35 DF, p-value: 0.01017summary(m_comp_torero_c20)
Call:
lm(formula = competencia_torero ~ dirmean_Competence_torero,
data = df_comp20_torero, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-2.3077 -0.6654 0.3346 0.8346 2.6381
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 3.0719 0.6826 4.501 0.000116 ***
dirmean_Competence_torero 1.5934 0.7602 2.096 0.045591 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.148 on 27 degrees of freedom
Multiple R-squared: 0.1399, Adjusted R-squared: 0.1081
F-statistic: 4.393 on 1 and 27 DF, p-value: 0.04559summary(m_cord_hdep_w20)
Call:
lm(formula = cordialidad_hombre_deportista ~ dirmean_Warmth_hdeportista,
data = df_warmth20_hdeportista, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-2.3690 -0.6677 0.1343 0.6310 1.6310
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 5.3690 0.1898 28.294 <2e-16 ***
dirmean_Warmth_hdeportista 0.6518 0.2799 2.329 0.0263 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.9569 on 32 degrees of freedom
Multiple R-squared: 0.1449, Adjusted R-squared: 0.1182
F-statistic: 5.424 on 1 and 32 DF, p-value: 0.02634summary(m_comp_hdep_c20)
Call:
lm(formula = competencia_hombre_deportista ~ dirmean_Competence_hdeportista,
data = df_comp20_hdeportista, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-2.3173 -0.8173 0.1077 0.6827 1.6827
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 4.7925 0.6934 6.912 7.97e-08 ***
dirmean_Competence_hdeportista 0.5248 0.7461 0.703 0.487
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.01 on 32 degrees of freedom
Multiple R-squared: 0.01522, Adjusted R-squared: -0.01555
F-statistic: 0.4947 on 1 and 32 DF, p-value: 0.4869