ASAP-AQ_Analysis
Steve Heil
2024-08-06
Examine the calibration work of expert judges for the development of pilot ASAP-AQ using the Thurstone scaling method.
Load calibration data
The calibration dataset is in long format, with each item’s score by a judge on its own row.
cal.long <- read.csv("asapaq-calibration-long.csv")
str(cal.long)## 'data.frame': 833 obs. of 5 variables:
## $ uniqueItemID: chr "FORA01JEFI" "FORA02JEFI" "FORA03JEFI" "FORA04JEFI" ...
## $ constructID : chr "FORA" "FORA" "FORA" "FORA" ...
## $ itemID : chr "FORA01" "FORA02" "FORA03" "FORA04" ...
## $ judgeID : chr "JEFI" "JEFI" "JEFI" "JEFI" ...
## $ Score : int 6 4 9 6 5 9 11 8 1 1 ...This shows a score by each judge for each item, which is assigned an item ID. The uniqueItemID is unique to a judge also. It will be removed because it’s not useful.
Analyze dataset
How many judges have contributed and how many scores did each provide?
# Remove the uniqueItemID column
cal.scores <- cal.long %>% select(-uniqueItemID)
table(cal.long$judgeID)##
## CADO CHGP ENZI JEFI LEDR MILE STHE
## 119 119 119 119 119 119 119This table shows if any items were missed by a judge.
Shape and organize the data
First, subset the data for each construct.
cal.scores.fora <- cal.scores %>% filter(constructID == "FORA")
cal.scores.epft <- cal.scores %>% filter(constructID == "EPFT")
cal.scores.ehdp <- cal.scores %>% filter(constructID == "EHDP")Reshape the data from long to wide format for correlation analysis.
# Reshape the data from long to wide format
cal.wide.fora <- spread(cal.scores.fora, key = judgeID, value = Score)
cal.wide.epft <- spread(cal.scores.epft, key = judgeID, value = Score)
cal.wide.ehdp <- spread(cal.scores.ehdp, key = judgeID, value = Score)Calculate the correlation matrix
First for FORA:
#FORA
cor_matrix.fora <- cor(cal.wide.fora[, 3:ncol(cal.wide.fora)], use = "complete.obs", method ="spearman")
print(cor_matrix.fora)## CADO CHGP ENZI JEFI LEDR MILE STHE
## CADO 1.0000000 0.6106019 0.12225651 0.426631795 0.253599094 0.7734847 0.5472404
## CHGP 0.6106019 1.0000000 0.39922443 0.362759775 0.246701144 0.5680445 0.7584499
## ENZI 0.1222565 0.3992244 1.00000000 0.013547029 0.100254932 0.3330968 0.3902311
## JEFI 0.4266318 0.3627598 0.01354703 1.000000000 0.003393348 0.4773003 0.3160193
## LEDR 0.2535991 0.2467011 0.10025493 0.003393348 1.000000000 0.2966773 0.2769670
## MILE 0.7734847 0.5680445 0.33309685 0.477300283 0.296677284 1.0000000 0.6070602
## STHE 0.5472404 0.7584499 0.39023110 0.316019254 0.276967014 0.6070602 1.0000000This shows that there are some more promising and less promising groupings, if needed.
#EPFT
cor_matrix.epft <- cor(cal.wide.epft[, 3:ncol(cal.wide.epft)], use = "complete.obs", method="spearman")
print(cor_matrix.epft)## CADO CHGP ENZI JEFI LEDR MILE STHE
## CADO 1.0000000 0.5428397 0.3739515 0.4474811 0.6960196 0.6493145 0.6248978
## CHGP 0.5428397 1.0000000 0.3499198 0.6199409 0.4618531 0.4204491 0.3414341
## ENZI 0.3739515 0.3499198 1.0000000 0.1640116 0.3881987 0.3385423 0.1764487
## JEFI 0.4474811 0.6199409 0.1640116 1.0000000 0.4839430 0.3954859 0.3382670
## LEDR 0.6960196 0.4618531 0.3881987 0.4839430 1.0000000 0.5905670 0.3953956
## MILE 0.6493145 0.4204491 0.3385423 0.3954859 0.5905670 1.0000000 0.3806970
## STHE 0.6248978 0.3414341 0.1764487 0.3382670 0.3953956 0.3806970 1.0000000#EHDP
cor_matrix.ehdp <- cor(cal.wide.ehdp[, 3:ncol(cal.wide.ehdp)], use = "complete.obs", method = "spearman")
print(cor_matrix.ehdp)## CADO CHGP ENZI JEFI LEDR MILE STHE
## CADO 1.0000000 0.6173547 0.5508085 0.5461203 0.4845838 0.6303347 0.6251446
## CHGP 0.6173547 1.0000000 0.3808666 0.4577192 0.5375495 0.8884571 0.9022045
## ENZI 0.5508085 0.3808666 1.0000000 0.2249980 0.3614261 0.3235858 0.3071095
## JEFI 0.5461203 0.4577192 0.2249980 1.0000000 0.5369401 0.5478325 0.5595225
## LEDR 0.4845838 0.5375495 0.3614261 0.5369401 1.0000000 0.5469815 0.5784848
## MILE 0.6303347 0.8884571 0.3235858 0.5478325 0.5469815 1.0000000 0.8649401
## STHE 0.6251446 0.9022045 0.3071095 0.5595225 0.5784848 0.8649401 1.0000000Now analyze the central tendency and variability of each unique item based on all judges’ scores.
#function for finding the mode of scores
mode_function <- function(v) {
uniq_vals <- unique(v)
uniq_vals[which.max(tabulate(match(v, uniq_vals)))]
}cal.analysis_summary <- cal.long %>%
group_by(constructID, itemID) %>%
summarize(
mean_score = mean(Score),
standard_deviation = sd(Score),
standard_error = sd(Score) / sqrt(n()),
variance = var(Score),
mode = mode_function(Score),
median_score = median(Score),
interquartile_range = IQR(Score),
range = max(Score) - min(Score),
min = min(Score),
max = max(Score),
n = n()
) %>%
ungroup()## `summarise()` has grouped output by 'constructID'. You can override using the
## `.groups` argument.print(cal.analysis_summary)## # A tibble: 119 × 13
## constructID itemID mean_score standard_deviation standard_error variance
## <chr> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 EHDP EHDP01 1.14 0.378 0.143 0.143
## 2 EHDP EHDP02 5.29 4.19 1.58 17.6
## 3 EHDP EHDP03 2.86 0.378 0.143 0.143
## 4 EHDP EHDP04 3.43 2.57 0.972 6.62
## 5 EHDP EHDP05 9.57 2.99 1.13 8.95
## 6 EHDP EHDP06 7.14 0.900 0.340 0.810
## 7 EHDP EHDP07 4.57 3.69 1.39 13.6
## 8 EHDP EHDP08 3.29 2.21 0.837 4.90
## 9 EHDP EHDP09 3.86 3.63 1.37 13.1
## 10 EHDP EHDP10 1 0 0 0
## # ℹ 109 more rows
## # ℹ 7 more variables: mode <int>, median_score <int>,
## # interquartile_range <dbl>, range <int>, min <int>, max <int>, n <int>Merge cal.analysis_summary with imported “Item Evaluation.csv” to get the item descriptions included.
item_evaluation <- read.csv("Item Evaluation.csv")Join item texts to calibration data and write as “Calibrated Items All Judges Complete.csv” and use this for selecting based on central tendency and vairability of each item’s score across all judges.
df <- left_join(item_evaluation, cal.analysis_summary, by = "itemID")write.csv(df, "Calibrated Items All Judges Complete.csv", row.names = FALSE)Find the best group of four judges. Loop through each combination of 4 judges.
# Get unique judge IDs
judge_ids <- unique(cal.long$judgeID)
# Create combinations of three judges
comb <- combn(judge_ids, 4, simplify = FALSE)
# Initialize a list to store the results
results <- list()
# Loop through each combination of three judges
for (i in seq_along(comb)) {
# Create a label for the current combination of judges
label <- paste(comb[[i]], collapse = "_")
# Filter the data to include only the current combination of judges
filtered_data <- cal.long %>%
filter(judgeID %in% comb[[i]]) %>%
group_by(constructID, itemID) %>%
summarize(
mean_score = mean(Score),
standard_deviation = sd(Score),
standard_error = sd(Score) / sqrt(n()),
variance = var(Score),
mode = mode_function(Score),
median_score = median(Score),
interquartile_range = IQR(Score),
range = max(Score) - min(Score),
min = min(Score),
max = max(Score),
n = n(),
.groups = 'keep'
) %>%
ungroup()
# Store the results in the list
results[[label]] <- filtered_data
}Loop through the results to show the number of items IQR <= 2.
for (label in names(results)) {
current_result <- results[[label]]
filtered_rows <- current_result %>%
filter(interquartile_range <= 2)
cat("Number of items with IQR <= 2 for combination:", label)
print(nrow(filtered_rows))
cat("\n")
}## Number of items with IQR <= 2 for combination: JEFI_ENZI_STHE_CADO[1] 60
##
## Number of items with IQR <= 2 for combination: JEFI_ENZI_STHE_LEDR[1] 57
##
## Number of items with IQR <= 2 for combination: JEFI_ENZI_STHE_MILE[1] 67
##
## Number of items with IQR <= 2 for combination: JEFI_ENZI_STHE_CHGP[1] 67
##
## Number of items with IQR <= 2 for combination: JEFI_ENZI_CADO_LEDR[1] 58
##
## Number of items with IQR <= 2 for combination: JEFI_ENZI_CADO_MILE[1] 63
##
## Number of items with IQR <= 2 for combination: JEFI_ENZI_CADO_CHGP[1] 63
##
## Number of items with IQR <= 2 for combination: JEFI_ENZI_LEDR_MILE[1] 59
##
## Number of items with IQR <= 2 for combination: JEFI_ENZI_LEDR_CHGP[1] 58
##
## Number of items with IQR <= 2 for combination: JEFI_ENZI_MILE_CHGP[1] 64
##
## Number of items with IQR <= 2 for combination: JEFI_STHE_CADO_LEDR[1] 67
##
## Number of items with IQR <= 2 for combination: JEFI_STHE_CADO_MILE[1] 81
##
## Number of items with IQR <= 2 for combination: JEFI_STHE_CADO_CHGP[1] 77
##
## Number of items with IQR <= 2 for combination: JEFI_STHE_LEDR_MILE[1] 71
##
## Number of items with IQR <= 2 for combination: JEFI_STHE_LEDR_CHGP[1] 75
##
## Number of items with IQR <= 2 for combination: JEFI_STHE_MILE_CHGP[1] 74
##
## Number of items with IQR <= 2 for combination: JEFI_CADO_LEDR_MILE[1] 73
##
## Number of items with IQR <= 2 for combination: JEFI_CADO_LEDR_CHGP[1] 74
##
## Number of items with IQR <= 2 for combination: JEFI_CADO_MILE_CHGP[1] 77
##
## Number of items with IQR <= 2 for combination: JEFI_LEDR_MILE_CHGP[1] 69
##
## Number of items with IQR <= 2 for combination: ENZI_STHE_CADO_LEDR[1] 63
##
## Number of items with IQR <= 2 for combination: ENZI_STHE_CADO_MILE[1] 65
##
## Number of items with IQR <= 2 for combination: ENZI_STHE_CADO_CHGP[1] 70
##
## Number of items with IQR <= 2 for combination: ENZI_STHE_LEDR_MILE[1] 59
##
## Number of items with IQR <= 2 for combination: ENZI_STHE_LEDR_CHGP[1] 59
##
## Number of items with IQR <= 2 for combination: ENZI_STHE_MILE_CHGP[1] 71
##
## Number of items with IQR <= 2 for combination: ENZI_CADO_LEDR_MILE[1] 61
##
## Number of items with IQR <= 2 for combination: ENZI_CADO_LEDR_CHGP[1] 61
##
## Number of items with IQR <= 2 for combination: ENZI_CADO_MILE_CHGP[1] 70
##
## Number of items with IQR <= 2 for combination: ENZI_LEDR_MILE_CHGP[1] 63
##
## Number of items with IQR <= 2 for combination: STHE_CADO_LEDR_MILE[1] 74
##
## Number of items with IQR <= 2 for combination: STHE_CADO_LEDR_CHGP[1] 77
##
## Number of items with IQR <= 2 for combination: STHE_CADO_MILE_CHGP[1] 81
##
## Number of items with IQR <= 2 for combination: STHE_LEDR_MILE_CHGP[1] 74
##
## Number of items with IQR <= 2 for combination: CADO_LEDR_MILE_CHGP[1] 74Write best results to csv
Change the value of label to the match the codes of the group of best-agreement judges with underscore between (from manually analyzing the previous output).
label <- "STHE_CADO_MILE_CHGP"
cat("Results for combination:", label)## Results for combination: STHE_CADO_MILE_CHGPcurrent_result <- results[[label]]
print(table(current_result$interquartile_range))##
## 0 0.25 0.5 0.75 1 1.25 1.5 1.75 2 2.25 2.5 2.75 3 3.25 3.5 4
## 9 7 13 4 8 14 13 8 5 6 9 3 5 2 2 4
## 4.25 4.75 5.5 6.5 7.5
## 2 2 1 1 1print(describe(current_result$interquartile_range))## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 119 1.74 1.38 1.5 1.57 1.48 0 7.5 7.5 1.34 2.48 0.13hist(current_result$interquartile_range)
Merge result with imported Items Evaluation.csv to add item text,
df <- left_join(item_evaluation, current_result, by = "itemID")Write to .csv file for later filtering and selecting items in Excel.
write.csv(df, paste("Calibrated Items Best Group Complete",label,".csv"), row.names = FALSE)