animales <- read_csv("dat/ROLESTODO_animales_descriptores_long.csv")SADCAT para ROLES en Animales
SADCAT para Roles en Animales
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 animales. Comenzamos con su importación y análisis de estructura:
str(animales)spc_tbl_ [73 × 6] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
$ CODIGO : num [1:73] 101 102 103 104 105 106 107 108 109 110 ...
$ TIPO_cuestionario: num [1:73] 1 1 1 1 1 1 1 1 1 1 ...
$ item : chr [1:73] "PA1.ANIMAL_CANICHE" "PA1.ANIMAL_CANICHE" "PA1.ANIMAL_CANICHE" "PA1.ANIMAL_CANICHE" ...
$ descripcion : chr [1:73] "Pequeño, chillón, Molesto, irritable, feo, rata, patada, gruñón, abuela, pija" "Pequeño, Agresivo, Ruidoso, Feo, Cabezón, Adorable" "Infantil, Pijo y adinerado, Como una rata, Poca personalidad, Tonto" "Mono, Cobarde, Débil, Vulnerable, Achuchable, Bonito, Amariconado" ...
$ fase : chr [1:73] "PA1" "PA1" "PA1" "PA1" ...
$ target : chr [1:73] "ANIMAL_CANICHE" "ANIMAL_CANICHE" "ANIMAL_CANICHE" "ANIMAL_CANICHE" ...
- 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:
animales_split <- split_descriptors(animales,input_type = "data", desc_col = "descripcion")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(animales_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. Un ejemplo de esto puede ser el caso 124, si nos fijamos, tiene 6 descriptores y una cobertura del 0%. Esto sucede porque utiliza el plural en todos sus descriptores, y la función dict_coverage() aún no tiene implementada una solución a este problema. Este tipo de situaciones deben de quedar documentadas para realizar los cambios pertinentes en las funciones.
animales_cov <- dict_coverage(animales_split, prefix = "descriptor_")animales_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.
animales_cov_dims <- dict_dim_coverage_all(animales_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(animales_cov_dims), value = TRUE)
m <- colMeans(animales_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).
animales_con_dirmean <- dict_dim_dirmean_all(animales_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(animales_con_dirmean), value = TRUE)
dirmean_cols <- grep("^dirmean_", names(animales_con_dirmean), value = TRUE)
n_cols <- grep("^n_dirmean_", names(animales_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(animales_con_dirmean, cov_cols)
dirmean_summary <- summary_block(animales_con_dirmean, dirmean_cols)
n_summary <- summary_block(animales_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(
animales_con_dirmean,
file = "./dat/animales_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_animales_scores.csv"
path_sadcat <- "./dat/animales_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(animal = case_when(
str_detect(target, "CANICHE") ~ "caniche",
str_detect(target, "COLIBR") ~ "colibri",
TRUE ~ make.names(target)
)) %>%
select(-target) %>%
pivot_wider(
id_cols = all_of(by_keys),
names_from = animal,
values_from = -c(all_of(by_keys), animal),
names_glue = "{.value}_{animal}",
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.
# Caniche
m_cord_caniche <- lm(cordialidad_caniche ~ dirmean_Warmth_caniche,
data = df_roles_sadcat, na.action = na.exclude)
m_comp_caniche <- lm(competencia_caniche ~ dirmean_Competence_caniche,
data = df_roles_sadcat, na.action = na.exclude)
# Colibrí
m_cord_colibri <- lm(cordialidad_colibri ~ dirmean_Warmth_colibri,
data = df_roles_sadcat, na.action = na.exclude)
m_comp_colibri <- lm(competencia_colibri ~ dirmean_Competence_colibri,
data = df_roles_sadcat, na.action = na.exclude)# Ver resultados
summary(m_cord_caniche)
Call:
lm(formula = cordialidad_caniche ~ dirmean_Warmth_caniche, data = df_roles_sadcat,
na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-3.8245 -1.1025 0.1755 1.0739 3.3825
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 4.0589 0.2799 14.499 7.17e-16 ***
dirmean_Warmth_caniche 1.7656 0.4038 4.372 0.000116 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.652 on 33 degrees of freedom
(2 observations deleted due to missingness)
Multiple R-squared: 0.3668, Adjusted R-squared: 0.3476
F-statistic: 19.12 on 1 and 33 DF, p-value: 0.0001156summary(m_comp_caniche)
Call:
lm(formula = competencia_caniche ~ dirmean_Competence_caniche,
data = df_roles_sadcat, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-2.33149 -0.95623 -0.08097 0.87693 2.79429
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 3.5810 0.3578 10.010 1.53e-08 ***
dirmean_Competence_caniche 0.2495 0.4068 0.613 0.548
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.449 on 17 degrees of freedom
(18 observations deleted due to missingness)
Multiple R-squared: 0.02164, Adjusted R-squared: -0.03591
F-statistic: 0.3761 on 1 and 17 DF, p-value: 0.5478summary(m_cord_colibri)
Call:
lm(formula = cordialidad_colibri ~ dirmean_Warmth_colibri, data = df_roles_sadcat,
na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-3.1139 -0.6139 -0.1139 1.3861 2.3971
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 4.4979 0.5677 7.923 6.06e-09 ***
dirmean_Warmth_colibri 0.1160 0.6297 0.184 0.855
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.494 on 31 degrees of freedom
(4 observations deleted due to missingness)
Multiple R-squared: 0.001094, Adjusted R-squared: -0.03113
F-statistic: 0.03396 on 1 and 31 DF, p-value: 0.855summary(m_comp_colibri)
Call:
lm(formula = competencia_colibri ~ dirmean_Competence_colibri,
data = df_roles_sadcat, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-1.9207 -0.7341 0.2659 0.7659 1.2659
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 4.4208 0.3708 11.924 1.11e-09 ***
dirmean_Competence_colibri 0.8133 0.4160 1.955 0.0672 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.045 on 17 degrees of freedom
(18 observations deleted due to missingness)
Multiple R-squared: 0.1836, Adjusted R-squared: 0.1355
F-statistic: 3.822 on 1 and 17 DF, p-value: 0.06722# Ver gráficos de residuos (comentado para el render)
# plot(m_cord_caniche)
# plot(m_comp_caniche)
# plot(m_cord_colibri)
# plot(m_comp_colibri)Debido a la elevada cantidad de NAs probamos a separar dirección de ocurrencia, y ver si el efecto de la no ocurrencia de descriptores está afectando a nuestros modelos:
# has_* = 1 si hay evidencia (n_dirmean > 0); 0 si no.
# warmth_ o competence_ = dirmean cuando has=1, y 0 cuando has=0.
# Esto aplica a todos los modelos.
df_roles_sadcat$has_warmth_caniche <- as.integer(df_roles_sadcat$n_dirmean_Warmth_caniche > 0)
df_roles_sadcat$warmth_caniche <- ifelse(df_roles_sadcat$has_warmth_caniche == 1,
df_roles_sadcat$dirmean_Warmth_caniche, 0)
m_cord_caniche <- lm(cordialidad_caniche ~ warmth_caniche + has_warmth_caniche,
data = df_roles_sadcat, na.action = na.exclude)
summary(m_cord_caniche)
Call:
lm(formula = cordialidad_caniche ~ warmth_caniche + has_warmth_caniche,
data = df_roles_sadcat, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-3.8245 -0.8818 0.1755 0.9411 3.3825
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 6.0000 1.1542 5.198 9.50e-06 ***
warmth_caniche 1.7656 0.3989 4.426 9.41e-05 ***
has_warmth_caniche -1.9411 1.1869 -1.635 0.111
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.632 on 34 degrees of freedom
Multiple R-squared: 0.3933, Adjusted R-squared: 0.3576
F-statistic: 11.02 on 2 and 34 DF, p-value: 0.0002046Entre sujetos con evidencia de Warmth (has=1), si dirmean_Warmth aumenta 1 unidad (p. ej. de 0 a 1), la cordialidad sube ~1.77 puntos.
Como dirmean está en [-1, 1], pasar de -1 a +1 implica un cambio esperado de ~3.53 puntos (2×1.77). Eso es grande en una escala típica tipo 1–7.
El origen = 6.00 es la cordialidad esperada cuando has=0 (sin evidencia de Warmth). Si hay pocos casos has=0, este valor puede ser inestable.
Aquí sí parece que el diccionario capta un componente que se alinea con cordialidad.
df_roles_sadcat$has_comp_caniche <- as.integer(df_roles_sadcat$n_dirmean_Competence_caniche > 0)
df_roles_sadcat$comp_caniche <- ifelse(df_roles_sadcat$has_comp_caniche == 1,
df_roles_sadcat$dirmean_Competence_caniche, 0)
m_comp_caniche <- lm(competencia_caniche ~ comp_caniche + has_comp_caniche,
data = df_roles_sadcat, na.action = na.exclude)
summary(m_comp_caniche)
Call:
lm(formula = competencia_caniche ~ comp_caniche + has_comp_caniche,
data = df_roles_sadcat, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-2.3315 -1.2353 -0.1581 0.7647 2.7943
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 3.2353 0.3264 9.912 2.02e-11 ***
comp_caniche 0.2495 0.3777 0.660 0.514
has_comp_caniche 0.3457 0.4657 0.742 0.463
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.346 on 33 degrees of freedom
(1 observation deleted due to missingness)
Multiple R-squared: 0.02319, Adjusted R-squared: -0.03601
F-statistic: 0.3917 on 2 and 33 DF, p-value: 0.679Ni la dirección de Competence ni la mera presencia de términos de Competence parecen asociarse a la competencia percibida del caniche.
df_roles_sadcat$has_warmth_colibri <- as.integer(df_roles_sadcat$n_dirmean_Warmth_colibri > 0)
df_roles_sadcat$warmth_colibri <- ifelse(df_roles_sadcat$has_warmth_colibri == 1,
df_roles_sadcat$dirmean_Warmth_colibri, 0)
m_cord_colibri <- lm(cordialidad_colibri ~ warmth_colibri + has_warmth_colibri,
data = df_roles_sadcat, na.action = na.exclude)
summary(m_cord_colibri)
Call:
lm(formula = cordialidad_colibri ~ warmth_colibri + has_warmth_colibri,
data = df_roles_sadcat, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-3.1139 -0.6139 -0.1139 1.3861 2.3971
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 3.5000 1.0432 3.355 0.00206 **
warmth_colibri 0.1160 0.6220 0.187 0.85319
has_warmth_colibri 0.9979 1.1844 0.843 0.40573
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.475 on 32 degrees of freedom
(2 observations deleted due to missingness)
Multiple R-squared: 0.03223, Adjusted R-squared: -0.02825
F-statistic: 0.5329 on 2 and 32 DF, p-value: 0.592Misma interpretación que en el caso anterior.
df_roles_sadcat$has_comp_colibri <- as.integer(df_roles_sadcat$n_dirmean_Competence_colibri > 0)
df_roles_sadcat$comp_colibri <- ifelse(df_roles_sadcat$has_comp_colibri == 1,
df_roles_sadcat$dirmean_Competence_colibri, 0)
m_comp_colibri <- lm(competencia_colibri ~ comp_colibri + has_comp_colibri,
data = df_roles_sadcat, na.action = na.exclude)
summary(m_comp_colibri)
Call:
lm(formula = competencia_colibri ~ comp_colibri + has_comp_colibri,
data = df_roles_sadcat, na.action = na.exclude)
Residuals:
Min 1Q Median 3Q Max
-2.3750 -0.8045 0.1250 0.7659 2.1250
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 3.8750 0.2841 13.642 6.96e-15 ***
comp_colibri 0.8133 0.4524 1.798 0.0816 .
has_comp_colibri 0.5458 0.4932 1.107 0.2767
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.136 on 32 degrees of freedom
(2 observations deleted due to missingness)
Multiple R-squared: 0.2619, Adjusted R-squared: 0.2158
F-statistic: 5.677 on 2 and 32 DF, p-value: 0.007761Entre quienes tienen evidencia de Competence (has=1), más dirección positiva en Competence tiende a asociarse con más competencia percibida (pendiente positiva).
Que el F global sea significativo mientras b1 no lo es al 5% suele pasar cuando hay colinealidad entre comp_colibri_0 y has_comp_colibri (en tu construcción, comp_0 solo puede ser distinta de 0 cuando has=1, así que es normal que estén correlacionados).
Hay señal plausible, pero conviene re-estimar de forma más estable. A continuación se hace un modelo en el que se añade no solo las puntuaciones en competencia para los casos con evidencia, sino también el propio tamaño de la evidencia (el número de descriptores de competencia para cada caso).
m_comp_colibri <- lm(competencia_colibri ~ comp_colibri + n_dirmean_Competence_colibri,
data = df_roles_sadcat)
summary(m_comp_colibri)
Call:
lm(formula = competencia_colibri ~ comp_colibri + n_dirmean_Competence_colibri,
data = df_roles_sadcat)
Residuals:
Min 1Q Median 3Q Max
-2.3434 -0.8205 0.1566 0.6566 2.1566
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 3.8434 0.2499 15.379 2.46e-16 ***
comp_colibri 0.7567 0.3915 1.933 0.0622 .
n_dirmean_Competence_colibri 0.3487 0.1816 1.921 0.0637 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.096 on 32 degrees of freedom
(2 observations deleted due to missingness)
Multiple R-squared: 0.3129, Adjusted R-squared: 0.2699
F-statistic: 7.285 on 2 and 32 DF, p-value: 0.002471