setwd("~/Library/CloudStorage/OneDrive-Personal/1_UMN/Teaching/1_IntroToMeasurement/R")
Thurstone scaling (case v) example
# If you do not have 'psych' package installed on your computer, run
# install.packages("psych")
library(psych) # load 'psych' package
# pairwise judgment data
classmat <- matrix(c(.50, .75, .85, .80, .90,
.25, .50, .55, .60, .65,
.15, .45, .50, .70, .70,
.20, .40, .30, .50, .80,
.10, .35, .30, .20, .50), ncol=5, byrow=T)
classmat
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.50 0.75 0.85 0.8 0.90
## [2,] 0.25 0.50 0.55 0.6 0.65
## [3,] 0.15 0.45 0.50 0.7 0.70
## [4,] 0.20 0.40 0.30 0.5 0.80
## [5,] 0.10 0.35 0.30 0.2 0.50
# Use 'thurstone()' function to find the scale values
y <- thurstone(classmat)
y
## Thurstonian scale (case 5) scale values
## Call: thurstone(x = classmat)
## [1] 0.00 0.75 0.79 0.92 1.37
##
## Goodness of fit of model 0.99
y$residual # residual matrix (deviation between the observed proportions and scale-based proportions)
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.00000000 0.02302660 -0.06491636 0.02183186 0.01518567
## [2,] -0.02302660 0.00000000 -0.03379680 -0.03112239 0.08386566
## [3,] 0.06491636 0.03379680 0.00000000 -0.14713988 0.02036294
## [4,] -0.02183186 0.03112239 0.14713988 0.00000000 -0.12598424
## [5,] -0.01518567 -0.08386566 -0.02036294 0.12598424 0.00000000
# If residuals are close to 0, it means that data are well captured.
1-sum((y$residual)^2)/sum(classmat^2) # calculation of Goodness of Fit
## [1] 0.9860471
Guttman scaling example
# item response data
mat <- matrix(c(1, 1, 1, 1,
1, 1, 0, 1,
1, 0, 1, 1,
1, 0, 0, 0,
1, 0, 0, 1,
0, 0, 0, 0,
1, 0, 1, 1,
0, 0, 1, 1,
1, 0, 0, 0,
1, 0, 0, 1), ncol=4, byrow=T)
colnames(mat) <- c("A", "B", "C", "D") # assign column names
rownames(mat) <- 1:10 # assign subject ID number
mat
## A B C D
## 1 1 1 1 1
## 2 1 1 0 1
## 3 1 0 1 1
## 4 1 0 0 0
## 5 1 0 0 1
## 6 0 0 0 0
## 7 1 0 1 1
## 8 0 0 1 1
## 9 1 0 0 0
## 10 1 0 0 1
imean <- apply(mat, 2, mean); imean # calculate the proportion of endorsement of each item
## A B C D
## 0.8 0.2 0.4 0.7
psum <- apply(mat, 1, sum); psum # calculate the total score for each individual
## 1 2 3 4 5 6 7 8 9 10
## 4 3 3 1 2 0 3 2 1 2
# Arrange rows and columns so that the subjects and items are ranked from highest to lowest values
mat[order(psum, decreasing=T), order(imean, decreasing = T)]
## A D C B
## 1 1 1 1 1
## 2 1 1 0 1
## 3 1 1 1 0
## 7 1 1 1 0
## 5 1 1 0 0
## 8 0 1 1 0
## 10 1 1 0 0
## 4 1 0 0 0
## 9 1 0 0 0
## 6 0 0 0 0
| 4 |
1 |
1 |
1 |
1 |
1 |
| 3 |
1 |
1 |
1 |
0 |
3, 7 |
| 2 |
1 |
1 |
0 |
0 |
5, 10 |
| 1 |
1 |
0 |
0 |
0 |
4, 9 |
| 0 |
0 |
0 |
0 |
0 |
6 |
| Error patterns |
|
|
|
|
|
| 3 |
1 |
1 |
0 |
1 |
2 |
| 2 |
0 |
1 |
1 |
0 |
8 |
# Coefficient of reproducibility
CR <- 1-(2+2)/(10*4) ; CR
## [1] 0.9