2025_JeffersonEmpathyAnalysis_Sindija

Author

S Uribe

CREATED

April 15, 2025

UPDATED

June 2, 2025

Packages

[1] "/home/sergiouribe/Insync/sergio.uribe@gmail.com/Google Drive/Research Drive/2025_Sindija_Baltic Survey of Empathy Levels Jefferson scale/analysis_jefferson"

Docs

Abstract ADEE

Manuscript

Likert Analysis

Data

Cronbach’s alpha

Original

Some items ( Q_Norm_2 Q_Norm_6 Q_Norm_17 Q_Norm_20 ) were negatively correlated with the first principal component and 
probably should be reversed.  
To do this, run the function again with the 'check.keys=TRUE' option

[1] 0.7412555

Cronbach’s alpha with Confidence Interval

Cronbach's alpha: 0.741 with 95% CI [ 0.53 , 0.886 ]

Visualization

Table

Item-Total Correlations (JSE-HPS, Latvian Version)
Cronbach's alpha = 0.74
Item	Item-Total Correlation	Threshold
Q_Norm_1	0.432	≥ 0.30
Q_Norm_2	−0.246	< 0.30
Q_Norm_3	0.453	≥ 0.30
Q_Norm_4	0.130	< 0.30
Q_Norm_5	0.238	< 0.30
Q_Norm_6	0.030	< 0.30
Q_Norm_7	0.464	≥ 0.30
Q_Norm_8	0.094	< 0.30
Q_Norm_9	0.376	≥ 0.30
Q_Norm_10	0.369	≥ 0.30
Q_Norm_11	0.476	≥ 0.30
Q_Norm_12	0.689	≥ 0.30
Q_Norm_13	0.241	< 0.30
Q_Norm_14	0.636	≥ 0.30
Q_Norm_15	0.380	≥ 0.30
Q_Norm_16	0.518	≥ 0.30
Q_Norm_17	0.101	< 0.30
Q_Norm_18	0.254	< 0.30
Q_Norm_19	0.247	< 0.30
Q_Norm_20	−0.365	< 0.30

The item-total correlation (r.drop) indicates how well each item aligns with the overall scale. A high correlation (≥ 0.30) suggests that the item is consistent with the total empathy score and contributes meaningfully to internal consistency. A low correlation (< 0.30) indicates that the item may not be measuring the same underlying construct (empathy) or may have issues related to translation, comprehension, or cultural appropriateness.

Items near the top of the graph show strong alignment with the empathy construct. In contrast, items at the bottom display weak correlations.

These low-performing items may require review due to potential ambiguity, poor wording, conceptual mismatch with the rest of the scale, or reverse-coding problems.

Ordered table

Item-Total Correlations (JSE-HPS, Latvian Version)
Cronbach's alpha = 0.74
Item	Item-Total Correlation	Threshold
Q_Norm_12	0.689	≥ 0.30
Q_Norm_14	0.636	≥ 0.30
Q_Norm_16	0.518	≥ 0.30
Q_Norm_11	0.476	≥ 0.30
Q_Norm_7	0.464	≥ 0.30
Q_Norm_3	0.453	≥ 0.30
Q_Norm_1	0.432	≥ 0.30
Q_Norm_15	0.380	≥ 0.30
Q_Norm_9	0.376	≥ 0.30
Q_Norm_10	0.369	≥ 0.30
Q_Norm_18	0.254	< 0.30
Q_Norm_19	0.247	< 0.30
Q_Norm_13	0.241	< 0.30
Q_Norm_5	0.238	< 0.30
Q_Norm_4	0.130	< 0.30
Q_Norm_17	0.101	< 0.30
Q_Norm_8	0.094	< 0.30
Q_Norm_6	0.030	< 0.30
Q_Norm_2	−0.246	< 0.30
Q_Norm_20	−0.365	< 0.30

Likert Plot with gglikert()

For the Methods section

Internal consistency of the Jefferson Scale of Empathy was assessed using Cronbach’s alpha, with item-total correlations examined for all 20 items. The 95% confidence interval for alpha was estimated using the Feldt method.

--- title: "2025_JeffersonEmpathyAnalysis_Sindija" author: "S Uribe" date: 2025-04-15 date-modified: last-modified language: title-block-published: "CREATED" title-block-modified: "UPDATED" format: html: toc: true toc-expand: 3 code-fold: true code-tools: true editor: visual execute: echo: false cache: false warning: false message: false --- # Packages ```{r} pacman::p_load(tidyverse, here, sjPlot, gt, # for the table psych, # for the crohnbach ggstats, # for the new likert gtsummary, irr) # for ICC ``` ```{r} here::here() ``` ```{r} theme_set(theme_minimal()) ``` # Docs [Abstract ADEE](https://docs.google.com/document/d/1hdRnpvj2s_lVpJtQwfAJDkZES_H5vUdn/edit) [Manuscript](https://docs.google.com/document/d/18EtAMJm36GVRP5PKIuI_fwndDhnVS_lgfY2zpjZZBas/edit?tab=t.0#heading=h.suq8ocx8doy2) # Likert Analysis ## Data ```{r} df <- read_csv(here("data", "JSA_Latvia_validacija (atbildes) - Validacijai normalizēts.csv")) |> select(Respondents, Q_Norm_1:Q_Norm_20) # the new normalized data ``` ```{r} # glimpse(df) ``` ```{r} likert_items <- df %>% select(starts_with("Q")) ``` ```{r} # colnames(likert_items) <- paste0("Q", 1:20) ``` ```{r} # Convert to factors with Likert levels likert_items <- likert_items %>% mutate(across(everything(), ~ factor(., levels = 1:7, labels = c("1 Strongly Disagree", "2", "3", "4", "5", "6", "7 Strongly Agree")))) ``` ```{r} plot_likert(likert_items, values = "none") + labs(title = "Jefferson Scale of Empathy – Latvian Version (n = 18)") + theme( plot.margin = margin(10, 10, 10, 10), axis.text.y = element_text(size = 8) ) ``` # **Cronbach's alpha** ## Original ```{r} # Select only the JSE items jse_items <- df %>% select(starts_with("Q")) ``` ```{r} # Calculate Cronbach's alpha alpha_results <- psych::alpha(jse_items) ``` ```{r} # View Cronbach's alpha alpha_results$total$raw_alpha ``` ## **Cronbach's alpha with Confidence Interval** ```{r} # Extract 95% confidence interval ci_lower <- alpha_results$feldt$lower.ci$raw_alpha ci_upper <- alpha_results$feldt$upper.ci$raw_alpha alpha_value <- alpha_results$total$raw_alpha cat("Cronbach's alpha:", round(alpha_value, 3), "with 95% CI [", round(ci_lower, 3), ",", round(ci_upper, 3), "]") ``` ```{r} rm(ci_lower, ci_upper, alpha_value ) ``` ## Visualization ```{r} # Extract item-total correlations from item.stats item_corrs <- alpha_results$item.stats %>% as.data.frame() %>% rownames_to_column("Item") %>% select(Item, r.drop) ``` ```{r} item_corrs |> mutate(Q = paste0("Q", row_number())) |> ggplot(aes(x = reorder(Q, r.drop), y = r.drop)) + geom_col(fill = "steelblue") + geom_hline(yintercept = 0.30, linetype = "dashed", color = "red") + coord_flip() + labs( title = "Item-Total Correlations (After Reverse-Scoring)", subtitle = paste("Cronbach's alpha =", round(alpha_results$total$raw_alpha, 2)), x = "Item", y = "Item-Total Correlation" ) + theme_minimal(base_size = 12) ``` ## Table ```{r} item_corrs |> mutate(Category = ifelse(r.drop >= 0.30, "≥ 0.30", "< 0.30")) |> gt() |> tab_header( title = "Item-Total Correlations (JSE-HPS, Latvian Version)", subtitle = paste("Cronbach's alpha =", round(alpha_results$total$raw_alpha, 2)) ) |> fmt_number(columns = r.drop, decimals = 3) |> data_color( columns = r.drop, fn = function(x) ifelse(x >= 0.30, "steelblue", "black") ) |> cols_label( Item = "Item", r.drop = "Item-Total Correlation", Category = "Threshold" ) ``` The item-total correlation (r.drop) indicates how well each item aligns with the overall scale. **A high correlation (≥ 0.30)** suggests that the item is consistent with the total empathy score and contributes meaningfully to internal consistency. **A low correlation (\< 0.30)** indicates that the item may not be measuring the same underlying construct (empathy) or may have issues related to translation, comprehension, or cultural appropriateness. **Items near the top of the graph** show strong alignment with the empathy construct. In contrast, **items at the bottom** display weak correlations. These low-performing items may require review due to potential ambiguity, poor wording, conceptual mismatch with the rest of the scale, or reverse-coding problems. ## Ordered table ```{r} item_corrs |> mutate(Category = ifelse(r.drop >= 0.30, "≥ 0.30", "< 0.30")) |> arrange(desc(r.drop)) |> gt() |> tab_header( title = "Item-Total Correlations (JSE-HPS, Latvian Version)", subtitle = paste("Cronbach's alpha =", round(alpha_results$total$raw_alpha, 2)) ) |> fmt_number(columns = r.drop, decimals = 3) |> data_color( columns = r.drop, fn = function(x) ifelse(x >= 0.30, "steelblue", "black") ) |> cols_label( Item = "Item", r.drop = "Item-Total Correlation", Category = "Threshold" ) ``` # Likert Plot with gglikert() ```{r} # Convert data to labeled Likert factors likert_items_labels <- df |> select(starts_with("Q")) |> mutate(across(everything(), ~ factor(.x, levels = 1:7, labels = c("Strongly disagree", "Disagree", "Somewhat disagree", "Somewhat agree", "Agree", "More than agree", "Strongly agree") ))) ``` ```{r} # Plot Likert responses using gglikert gglikert(likert_items_labels, sort = "descending", y_label_wrap = 20, add_labels = TRUE, labels_size = 3, reverse_likert = FALSE, totals_include_center = FALSE) + ggtitle( "Distribution of Responses – Jefferson Scale of Empathy (Latvian Version)", subtitle = "Centered by response polarity (disagree vs agree)" ) + labs(caption = "Percentages at the right and left represent the total proportion of positive and negative responses,\nexcluding the central (neutral) category.") + scale_fill_brewer(palette = "RdYlBu") ``` ```{r} likert_items_collapsed <- likert_items_labels |> mutate(across(everything(), ~ fct_collapse(., Disagree = c("Strongly disagree", "Disagree", "Somewhat disagree"), Neutral = c("Somewhat agree"), Agree = c("Agree", "More than agree", "Strongly agree") ))) ``` ```{r} gglikert(likert_items_collapsed, sort = "descending", y_label_wrap = 20, add_labels = TRUE, labels_size = 3, reverse_likert = FALSE, totals_include_center = FALSE) + ggtitle( "Distribution of Responses – Jefferson Scale of Empathy (Latvian Version)", subtitle = "Centered by response polarity (disagree vs agree)" ) + scale_fill_brewer(palette = "RdYlBu") ``` ## For the Methods section Internal consistency of the Jefferson Scale of Empathy was assessed using Cronbach’s alpha, with item-total correlations examined for all 20 items. The 95% confidence interval for alpha was estimated using the Feldt method.