rm(list=ls())
library(tidyverse)
# load in the dataset
<- read_csv('data/responses.csv') responses
7 Item Discrimination
The more an item discriminates among individuals with different amounts of the underlying concept of interest, the higher the discrimination index.
7.1 The extreme group method (Cappelleri (2014))
7.1.1 Step 1
Partition respondents who have the highest and lowest overall scores on the overall scale, aggregated across all items, into upper and lower groups. The upper group can be composed of the top x% (e.g., 25%) of scores on the scale, while the lower group can be composed of the bottom x% (e.g., 25%) of scores on the scale.
# calculate the total score for each respondent
<- responses %>%
responses mutate(total = rowSums(pick(ends_with('_score')),na.rm=TRUE))
# partition the respondents into 4 quartiles based on their total score
<- responses %>%
responses mutate(quartile = cut(total,quantile(total,probs=c(0,0.25,0.5,0.75,1)),labels=c('Q1','Q2','Q3','Q4'),include.lowest=TRUE))
# double check
%>%
responses group_by(quartile) %>%
summarise(mean_score = mean(total))
# A tibble: 4 × 2
quartile mean_score
<fct> <dbl>
1 Q1 7.20
2 Q2 11.0
3 Q3 13.9
4 Q4 17.8
<- responses %>% select(quartile, ends_with('_score'))
items # pivot the items longer for analysis
<- items %>% pivot_longer(-quartile, names_to = 'item', values_to = 'score') items
7.1.2 Step 2
Examine each item and determine the proportion of individual respondents in the sample who correctly respond to each item in the upper group and lower group.
# create a summary table with item stats
<- items %>%
item_stats group_by(quartile, item) %>%
summarise(mean_score = mean(score, na.rm=TRUE))
`summarise()` has grouped output by 'quartile'. You can override using the
`.groups` argument.
# pivot wider so we have the item stats for each quartile
<- item_stats %>%
item_wide_stats pivot_wider(names_from = quartile, values_from = mean_score)
<- item_wide_stats %>% mutate(
item_wide_stats item_name = factor(item, levels=paste('Q',1:20, '_score',sep=''),labels = paste0('Q',1:20),ordered = TRUE)
%>% arrange(item_name)
)
<- item_wide_stats %>% select(
item_wide_stats
item_name, Q1 = `Q1`,
Q2 = `Q2`,
Q3 = `Q3`,
Q4 = `Q4`
)
7.1.3 Step 3
Subtract the pair of proportions noted in Step 2.
<- item_wide_stats %>% mutate(
item_wide_stats Q1_Q4 = Q4 - Q1,
)::kable(item_wide_stats, digits=2) knitr
item_name | Q1 | Q2 | Q3 | Q4 | Q1_Q4 |
---|---|---|---|---|---|
Q1 | 0.85 | 0.98 | 0.99 | 1.00 | 0.14 |
Q2 | 0.79 | 0.97 | 0.99 | 1.00 | 0.21 |
Q3 | 0.33 | 0.65 | 0.82 | 0.95 | 0.62 |
Q4 | 0.82 | 0.97 | 0.99 | 1.00 | 0.18 |
Q5 | 0.74 | 0.93 | 0.96 | 1.00 | 0.26 |
Q6 | 0.08 | 0.22 | 0.52 | 0.90 | 0.83 |
Q7 | 0.08 | 0.15 | 0.35 | 0.81 | 0.73 |
Q8 | 0.06 | 0.14 | 0.44 | 0.86 | 0.79 |
Q9 | 0.21 | 0.48 | 0.85 | 0.98 | 0.77 |
Q10 | 0.48 | 0.83 | 0.92 | 0.98 | 0.50 |
Q11 | 0.57 | 0.84 | 0.95 | 0.98 | 0.41 |
Q12 | 0.22 | 0.50 | 0.82 | 0.96 | 0.75 |
Q13 | 0.41 | 0.66 | 0.78 | 0.92 | 0.51 |
Q14 | 0.39 | 0.73 | 0.89 | 0.96 | 0.57 |
Q15 | 0.05 | 0.07 | 0.13 | 0.54 | 0.49 |
Q16 | 0.09 | 0.13 | 0.32 | 0.79 | 0.70 |
Q17 | 0.31 | 0.52 | 0.62 | 0.85 | 0.53 |
Q18 | 0.40 | 0.64 | 0.71 | 0.83 | 0.43 |
Q19 | 0.06 | 0.09 | 0.26 | 0.77 | 0.71 |
Q20 | 0.36 | 0.54 | 0.60 | 0.77 | 0.42 |
7.2 Interpretation
The higher the item discrimination index, the more the item discriminates. For example, if 60% of the upper group and 25% of the lower group endorse a particular item in the scale, the item discrimination index for that item would be calculated as (0.60−0.25) = 0.35.
What do we learn from the item discrimination index?
7.3 Extension Exercise
Try and recreate the item discrimination plot here