UPDATED 2025_JeffersonEmpathyAnalysis_Sindija

Author

S Uribe

CREATED

April 15, 2025

UPDATED

July 5, 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 NOT NORMALIZED

DATA NORMALIZED

Data

Cronbach’s alpha

Original

[1] 0.7867376

Cronbach’s alpha with Confidence Interval

Cronbach's alpha: 0.787 with 95% CI [ 0.742 , 0.827 ]

Visualization

Table

Item-Total Correlations (JSE-HPS, Latvian Version)
Cronbach's alpha = 0.79
Item	Item-Total Correlation	Threshold
Q_Norm_1	0.414	≥ 0.30
Q_Norm_2	0.393	≥ 0.30
Q_Norm_3	0.115	< 0.30
Q_Norm_4	0.263	< 0.30
Q_Norm_5	0.130	< 0.30
Q_Norm_6	0.052	< 0.30
Q_Norm_7	0.385	≥ 0.30
Q_Norm_8	0.353	≥ 0.30
Q_Norm_9	0.541	≥ 0.30
Q_Norm_10	0.402	≥ 0.30
Q_Norm_11	0.591	≥ 0.30
Q_Norm_12	0.398	≥ 0.30
Q_Norm_13	0.413	≥ 0.30
Q_Norm_14	0.459	≥ 0.30
Q_Norm_15	0.432	≥ 0.30
Q_Norm_16	0.546	≥ 0.30
Q_Norm_17	0.395	≥ 0.30
Q_Norm_18	0.161	< 0.30
Q_Norm_19	0.181	< 0.30
Q_Norm_20-	0.606	≥ 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.79
Item	Item-Total Correlation	Threshold
Q_Norm_20-	0.606	≥ 0.30
Q_Norm_11	0.591	≥ 0.30
Q_Norm_16	0.546	≥ 0.30
Q_Norm_9	0.541	≥ 0.30
Q_Norm_14	0.459	≥ 0.30
Q_Norm_15	0.432	≥ 0.30
Q_Norm_1	0.414	≥ 0.30
Q_Norm_13	0.413	≥ 0.30
Q_Norm_10	0.402	≥ 0.30
Q_Norm_12	0.398	≥ 0.30
Q_Norm_17	0.395	≥ 0.30
Q_Norm_2	0.393	≥ 0.30
Q_Norm_7	0.385	≥ 0.30
Q_Norm_8	0.353	≥ 0.30
Q_Norm_4	0.263	< 0.30
Q_Norm_19	0.181	< 0.30
Q_Norm_18	0.161	< 0.30
Q_Norm_5	0.130	< 0.30
Q_Norm_3	0.115	< 0.30
Q_Norm_6	0.052	< 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: "UPDATED 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 NOT NORMALIZED ```{r} df_raw <- read_csv("https://docs.google.com/spreadsheets/d/e/2PACX-1vQDqJVG3B4KNbXXZp3KeBSSHY8wfH0AXvJwN10uRPC6gh4tYzGspQLVDOCmVFqNDOXMH65Higi4QT9H/pub?gid=362257206&single=true&output=csv") |> select(Code, "1. Recognising patients’ emotions affects treatment outcomes.":"20. Empathy as a therapeutic tool.") ``` ```{r} likert_items_raw <- df_raw %>% select(contains(".")) ``` ```{r} # Convert to factors with Likert levels likert_items_raw <- likert_items_raw %>% 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_raw, values = "none") + labs(title = "Jefferson Scale of Empathy") + theme( plot.margin = margin(10, 10, 10, 10), axis.text.y = element_text(size = 8) ) ``` ```{r} rm(likert_items_raw, df_raw) ``` ## DATA NORMALIZED ## Data ```{r} df <- read_csv("https://docs.google.com/spreadsheets/d/e/2PACX-1vQDqJVG3B4KNbXXZp3KeBSSHY8wfH0AXvJwN10uRPC6gh4tYzGspQLVDOCmVFqNDOXMH65Higi4QT9H/pub?gid=362257206&single=true&output=csv") |> select(Code, 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, check.keys=TRUE) # Some items 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 ``` ```{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.