library(tidyverse)
library(psych)

# devtools::install_github("schmettow/mascutils")
library(mascutils)



#rstan_options(auto_write = TRUE)
#options(mc.cores = 3)

Data preparation

load("Data/PS.Rda")

PS <- PS_1  
#DK <- D_$MathurRepl

sort(names(PS)) 
##  [1] "Condition" "huMech"    "huMech0"   "huMech1"   "huMech2"  
##  [6] "huMech3"   "Item"      "Part"      "response"  "RT"       
## [11] "Scale"     "Set"       "Stimulus"  "trial"
#sort(names(DK))

UV <- PS %>% 
  select(Part, Item, Stimulus, response) %>% 
  glimpse()
## Observations: 8,424
## Variables: 4
## $ Part     <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,...
## $ Item     <chr> "nE1", "nE2", "nE3", "nE4", "nE5", "nE6", "nE7", "nE8...
## $ Stimulus <chr> "18", "8", "31", "76.2", "46", "71", "22", "66", "12"...
## $ response <dbl> -0.25333333, 0.50666667, 0.41333333, 0.07333333, 0.47...

Design and populations

Sample sizes

length(unique(UV$Part))
## [1] 39
length(unique(UV$Item))
## [1] 8
length(unique(UV$Stimulus))
## [1] 87

Descriptives

Comparing psychometric with designometric reliability

Creating Person-Item (psycho) and Stim-Item (design) matrices

D_psycho <- UV %>% 
  group_by(Part, Item) %>% 
  summarize(mean_resp = mean(response)) %>% 
  ungroup() %>% 
  spread(Item, value = mean_resp) %>% 
  select(-Part) %>% 
  glimpse()
## Observations: 39
## Variables: 8
## $ nE1 <dbl> -0.0434567901, -0.0904938272, -0.0009876543, 0.2324691358,...
## $ nE2 <dbl> -0.115555556, -0.157407407, -0.417777778, 0.117777778, 0.0...
## $ nE3 <dbl> -0.10148148, -0.37456790, -0.42814815, -0.31197531, 0.2583...
## $ nE4 <dbl> -0.133333333, 0.393950617, -0.109012346, 0.184074074, 0.22...
## $ nE5 <dbl> -0.19382716, 0.25679012, 0.16876543, 0.12938272, 0.2014814...
## $ nE6 <dbl> -0.25827160, 0.07024691, -0.09037037, -0.09851852, 0.32333...
## $ nE7 <dbl> -0.264567901, 0.179382716, -0.020123457, -0.112098765, 0.0...
## $ nE8 <dbl> -0.14950617, 0.10209877, 0.38185185, 0.16913580, 0.1223456...
D_design <- UV %>% 
  group_by(Stimulus, Item) %>% 
  summarize(mean_resp = mean(response)) %>% 
  ungroup() %>% 
  spread(Item, value = mean_resp) %>% 
  select(-Stimulus) %>% 
  glimpse()
## Observations: 87
## Variables: 8
## $ nE1 <dbl> -0.35962963, NA, NA, 0.04722222, -0.34066667, -0.17000000,...
## $ nE2 <dbl> -0.307333333, -0.085925926, -0.186222222, 0.324444444, NA,...
## $ nE3 <dbl> -0.37444444, -0.72148148, -0.37208333, -0.77370370, -0.746...
## $ nE4 <dbl> 0.197333333, -0.771111111, -0.377777778, -0.389861111, -0....
## $ nE5 <dbl> -0.050000000, -0.307777778, 0.058055556, NA, 0.101111111, ...
## $ nE6 <dbl> -0.38814815, -0.43083333, -0.33238095, -0.11000000, -0.369...
## $ nE7 <dbl> -0.29629630, -0.47511111, -0.22888889, -0.07333333, -0.142...
## $ nE8 <dbl> 0.22333333, -0.30555556, -0.12296296, 0.04533333, -0.06361...

Descriptives

Computing internal consistency measures for both matrices:

M_1_psycho <- psych::alpha(D_psycho)
M_1_design <- psych::alpha(D_design)

Comparing total reliability

bind_rows(M_1_psycho$total, 
          M_1_design$total) %>% 
  mutate(Perspective = c("Psychometric", "Designometric")) %>% 
  mascutils::go_first(Perspective)

Observations:

  • Designometric model has slightly better reliability

Comparing item-level reliability

Item_rel <-
  bind_rows(
    as_tibble(M_1_psycho$item.stats, rownames = "Item") %>% 
      mutate(Perspective = "Psychometric"), 
    as_tibble(M_1_design$item.stats, rownames = "Item")  %>% 
      mutate(Perspective = "Designometric")) %>% 
  mascutils::go_first(Perspective)

Item_rel
Item_rel %>% 
  ggplot(aes(x = Perspective, y = std.r, color = Item)) +
  geom_point() +
  geom_line(aes(group = Item)) +
  geom_label(aes(label = Item))

Observations:

  • all items have better reliability under designometric perspective
  • reliability under psychometrics seems to be lower by a constant for six items
  • two items one would discard as unreliable under a psychometric perspective