mujeres <- read_csv("dat/ROLESTODO_mujeres_descriptores_long.csv")SADCAT para ROLES en Mujeres
SADCAT para Roles en Mujeres
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(mujeres)spc_tbl_ [84 × 6] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
$ CODIGO : num [1:84] 201 202 203 204 205 206 207 208 209 210 ...
$ TIPO_cuestionario: num [1:84] 2 2 2 2 2 2 2 2 2 2 ...
$ item : chr [1:84] "PA1.MUJER_MODELO" "PA1.MUJER_MODELO" "PA1.MUJER_MODELO" "PA1.MUJER_MODELO" ...
$ descripcion : chr [1:84] "DELGADA, GUAPA, PERFECTA, DIVINA, ESTILOSA, SERVICIAL, CUERPO, CARA, VACIA" "DELGADA, GUAPA, ATRACTIVA, PROTOTIPICA, ESTILOSA, GLAMUSORA, DIVA, TONTAS" "PERSO INFERIOR, PIERNAS LARGAS, FISICO DELGADO, HABILIDAD EN PASARELA, SIN DISCAPACIDAD, CABELLO LARGO, ROPA NO"| __truncated__ "LOCA, DIFICIL, COMPLEJA, TREPA, INTERESADAS, GUARRAS, INTELIGENTES, SENSIBLES, ATRACTIVAS, GUAPAS" ...
$ fase : chr [1:84] "PA1" "PA1" "PA1" "PA1" ...
$ target : chr [1:84] "MUJER_MODELO" "MUJER_MODELO" "MUJER_MODELO" "MUJER_MODELO" ...
- 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)
mujeres_split <- split_descriptors(mujeres,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(mujeres_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.
mujeres_cov <- dict_coverage(mujeres_split, prefix = "descriptor_")mujeres_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.
mujeres_cov_dims <- dict_dim_coverage_all(mujeres_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(mujeres_cov_dims), value = TRUE)
m <- colMeans(mujeres_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).
mujeres_con_dirmean <- dict_dim_dirmean_all(mujeres_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(mujeres_con_dirmean), value = TRUE)
dirmean_cols <- grep("^dirmean_", names(mujeres_con_dirmean), value = TRUE)
n_cols <- grep("^n_dirmean_", names(mujeres_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(mujeres_con_dirmean, cov_cols)
dirmean_summary <- summary_block(mujeres_con_dirmean, dirmean_cols)
n_summary <- summary_block(mujeres_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(
mujeres_con_dirmean,
file = "./dat/mujeres_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_mujeres_scores.csv"
path_sadcat <- "./dat/mujeres_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, "MUJER_MODELO") ~ "modelo",
str_detect(target, "MUJER_DEPORTISTA") ~ "mdeportista",
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.
# Modelo
m_cord_modelo <- lm(cordialidad_mujer_modelo ~ dirmean_Warmth_modelo,
data = df_roles_sadcat, na.action = na.exclude)
m_comp_modelo <- lm(competencia_mujer_modelo ~ dirmean_Competence_modelo,
data = df_roles_sadcat, na.action = na.exclude)
# Mujer deportista
m_cord_mdeportista <- lm(cordialidad_mujer_deportista ~ dirmean_Warmth_mdeportista,
data = df_roles_sadcat, na.action = na.exclude)
m_comp_mdeportista <- lm(competencia_mujer_deportista ~ dirmean_Competence_mdeportista,
data = df_roles_sadcat, na.action = na.exclude)# Ver resultados
summary(m_cord_modelo)
Call:
lm(formula = cordialidad_mujer_modelo ~ dirmean_Warmth_modelo,
data = df_roles_sadcat, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-2.54017 -1.04017 -0.04017 1.49195 2.45983
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 3.7741 0.3540 10.660 2.26e-10 ***
dirmean_Warmth_modelo 0.2661 0.4302 0.619 0.542
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.549 on 23 degrees of freedom
(17 observations deleted due to missingness)
Multiple R-squared: 0.01636, Adjusted R-squared: -0.02641
F-statistic: 0.3826 on 1 and 23 DF, p-value: 0.5423summary(m_comp_modelo)
Call:
lm(formula = competencia_mujer_modelo ~ dirmean_Competence_modelo,
data = df_roles_sadcat, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-1.3365 -0.7769 -0.4466 0.5088 3.2231
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 2.9466 0.2921 10.087 7.82e-09 ***
dirmean_Competence_modelo 0.3303 0.3324 0.994 0.334
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.266 on 18 degrees of freedom
(22 observations deleted due to missingness)
Multiple R-squared: 0.052, Adjusted R-squared: -0.0006633
F-statistic: 0.9874 on 1 and 18 DF, p-value: 0.3335summary(m_cord_mdeportista)
Call:
lm(formula = cordialidad_mujer_deportista ~ dirmean_Warmth_mdeportista,
data = df_roles_sadcat, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-1.8660 -0.5995 0.1260 0.5480 2.1260
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 4.8660 0.1792 27.156 <2e-16 ***
dirmean_Warmth_mdeportista 0.4920 0.2374 2.073 0.0472 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.9239 on 29 degrees of freedom
(11 observations deleted due to missingness)
Multiple R-squared: 0.129, Adjusted R-squared: 0.09898
F-statistic: 4.296 on 1 and 29 DF, p-value: 0.0472summary(m_comp_mdeportista)
Call:
lm(formula = competencia_mujer_deportista ~ dirmean_Competence_mdeportista,
data = df_roles_sadcat, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-2.5586 -0.5586 0.1034 0.4414 1.5062
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 4.8966 0.2550 19.200 <2e-16 ***
dirmean_Competence_mdeportista 0.1620 0.2707 0.598 0.554
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.96 on 33 degrees of freedom
(7 observations deleted due to missingness)
Multiple R-squared: 0.01073, Adjusted R-squared: -0.01925
F-statistic: 0.358 on 1 and 33 DF, p-value: 0.5537# Ver gráficos de residuos (comentado para el render)
# plot(m_cord_modelo)
# plot(m_comp_modelo)
# plot(m_cord_mdeportista)
# plot(m_comp_mdeportista)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:
# Convierte un umbral en % (p.ej., 30) a escala del vector (0-100 o 0-1)
.coverage_threshold <- function(v, thr_pct) {
v <- v[!is.na(v)]
if (length(v) == 0) return(NA_real_)
if (max(v) <= 1) thr_pct / 100 else thr_pct
}
# Filtra df por una columna de coverage con umbral en porcentaje (thr_pct)
filter_by_coverage <- function(df, coverage_col, thr_pct) {
stopifnot(is.data.frame(df), coverage_col %in% names(df))
thr <- .coverage_threshold(df[[coverage_col]], thr_pct)
if (is.na(thr)) return(df[0, , drop = FALSE]) # todo NA -> 0 filas
df[!is.na(df[[coverage_col]]) & df[[coverage_col]] >= thr, , drop = FALSE]
}- CASO A: Filtrado por coverage GLOBAL (>= 30%)
- Modelo: filtrar por cov_pct_global_modelo
- Deportista: filtrar por cov_pct_global_mdeportista
df_global30_modelo <- filter_by_coverage(df_roles_sadcat, "cov_pct_global_modelo", 30)
df_global30_mdeportista <- filter_by_coverage(df_roles_sadcat, "cov_pct_global_mdeportista", 30)
# Modelos (global >= 30%)
m_cord_modelo_g30 <- lm(cordialidad_mujer_modelo ~ dirmean_Warmth_modelo,
data = df_global30_modelo, na.action = na.exclude)
m_comp_modelo_g30 <- lm(competencia_mujer_modelo ~ dirmean_Competence_modelo,
data = df_global30_modelo, na.action = na.exclude)
m_cord_mdep_g30 <- lm(cordialidad_mujer_deportista ~ dirmean_Warmth_mdeportista,
data = df_global30_mdeportista, na.action = na.exclude)
m_comp_mdep_g30 <- lm(competencia_mujer_deportista ~ dirmean_Competence_mdeportista,
data = df_global30_mdeportista, na.action = na.exclude)
# Ver resultados (global >= 30%)
summary(m_cord_modelo_g30)
Call:
lm(formula = cordialidad_mujer_modelo ~ dirmean_Warmth_modelo,
data = df_global30_modelo, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-2.35074 -0.96568 -0.06052 1.33458 2.18948
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 3.81052 0.38013 10.024 8.6e-09 ***
dirmean_Warmth_modelo 0.04021 0.48328 0.083 0.935
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.511 on 18 degrees of freedom
(7 observations deleted due to missingness)
Multiple R-squared: 0.0003845, Adjusted R-squared: -0.05515
F-statistic: 0.006923 on 1 and 18 DF, p-value: 0.9346summary(m_comp_modelo_g30)
Call:
lm(formula = competencia_mujer_modelo ~ dirmean_Competence_modelo,
data = df_global30_modelo, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-0.9274 -0.4462 -0.4086 0.5538 1.0914
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 2.43683 0.24792 9.829 8.78e-07 ***
dirmean_Competence_modelo 0.02823 0.29087 0.097 0.924
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.7335 on 11 degrees of freedom
(14 observations deleted due to missingness)
Multiple R-squared: 0.0008553, Adjusted R-squared: -0.08998
F-statistic: 0.009417 on 1 and 11 DF, p-value: 0.9244summary(m_cord_mdep_g30)
Call:
lm(formula = cordialidad_mujer_deportista ~ dirmean_Warmth_mdeportista,
data = df_global30_mdeportista, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-1.86110 -0.66668 0.07634 0.44449 2.22215
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 4.8611 0.1929 25.200 <2e-16 ***
dirmean_Warmth_mdeportista 0.5832 0.2621 2.225 0.0362 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.9374 on 23 degrees of freedom
(2 observations deleted due to missingness)
Multiple R-squared: 0.1772, Adjusted R-squared: 0.1414
F-statistic: 4.952 on 1 and 23 DF, p-value: 0.03615summary(m_comp_mdep_g30)
Call:
lm(formula = competencia_mujer_deportista ~ dirmean_Competence_mdeportista,
data = df_global30_mdeportista, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-2.5852 -0.5852 0.4148 0.4174 1.4148
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 4.8326 0.4509 10.718 7.77e-11 ***
dirmean_Competence_mdeportista 0.2525 0.4622 0.546 0.59
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.9974 on 25 degrees of freedom
Multiple R-squared: 0.0118, Adjusted R-squared: -0.02773
F-statistic: 0.2985 on 1 and 25 DF, p-value: 0.5897CASO B: Filtrado por coverage ESPECÍFICO por análisis (>= 20%)
- Cordialidad Modelo: cov_Warmth_dict_pct_modelo
- Competencia Modelo: cov_Competence_dict_pct_modelo
- Cordialidad Deport.: cov_Warmth_dict_pct_mdeportista
- Competencia Deport.: cov_Competence_dict_pct_mdeportista
df_warmth20_modelo <- filter_by_coverage(df_roles_sadcat, "cov_Warmth_dict_pct_modelo", 20)
df_comp20_modelo <- filter_by_coverage(df_roles_sadcat, "cov_Competence_dict_pct_modelo", 20)
df_warmth20_mdeportista <- filter_by_coverage(df_roles_sadcat, "cov_Warmth_dict_pct_mdeportista", 20)
df_comp20_mdeportista <- filter_by_coverage(df_roles_sadcat, "cov_Competence_dict_pct_mdeportista", 20)
# Modelos (específico >= 20%)
m_cord_modelo_w20 <- lm(cordialidad_mujer_modelo ~ dirmean_Warmth_modelo,
data = df_warmth20_modelo, na.action = na.exclude)
# HAY DEMASIADOS NAs PARA EJECUTAR ESTE MODELO
# m_comp_modelo_c20 <- lm(competencia_mujer_modelo ~ dirmean_Competence_modelo,
# data = df_comp20_modelo, na.action = na.exclude)
m_cord_mdep_w20 <- lm(cordialidad_mujer_deportista ~ dirmean_Warmth_mdeportista,
data = df_warmth20_mdeportista, na.action = na.exclude)
m_comp_mdep_c20 <- lm(competencia_mujer_deportista ~ dirmean_Competence_mdeportista,
data = df_comp20_mdeportista, na.action = na.exclude)
# Ver resultados (específico >= 20%)
summary(m_cord_modelo_w20)
Call:
lm(formula = cordialidad_mujer_modelo ~ dirmean_Warmth_modelo,
data = df_warmth20_modelo, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-2.78762 -0.69181 -0.07033 1.14532 1.77781
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 4.2222 0.4442 9.506 2.52e-06 ***
dirmean_Warmth_modelo 0.1963 0.6798 0.289 0.779
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.502 on 10 degrees of freedom
Multiple R-squared: 0.008268, Adjusted R-squared: -0.09091
F-statistic: 0.08337 on 1 and 10 DF, p-value: 0.7787#summary(m_comp_modelo_c20)
summary(m_cord_mdep_w20)
Call:
lm(formula = cordialidad_mujer_deportista ~ dirmean_Warmth_mdeportista,
data = df_warmth20_mdeportista, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-1.6833 -0.6378 0.1235 0.4302 1.4302
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 4.6833 0.2667 17.559 1.95e-10 ***
dirmean_Warmth_mdeportista 0.6135 0.3558 1.724 0.108
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.9766 on 13 degrees of freedom
Multiple R-squared: 0.1862, Adjusted R-squared: 0.1235
F-statistic: 2.973 on 1 and 13 DF, p-value: 0.1083summary(m_comp_mdep_c20)
Call:
lm(formula = competencia_mujer_deportista ~ dirmean_Competence_mdeportista,
data = df_comp20_mdeportista, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-2.50163 -0.58217 -0.00163 0.74837 1.63394
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 4.6627 1.0967 4.251 0.000538 ***
dirmean_Competence_mdeportista 0.3389 1.1576 0.293 0.773239
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.191 on 17 degrees of freedom
Multiple R-squared: 0.005017, Adjusted R-squared: -0.05351
F-statistic: 0.08572 on 1 and 17 DF, p-value: 0.7732