library(flextable)
library(psychTools)
library(psych)
library(lavaan)
library(semPlot)
library(mirt)
library(ltm)
library(ggplot2)
library(officer)
library(officedown)
library(gt)
library(knitr)
set_flextable_defaults( decimal.mark = ",", big.mark = " ")Selle peatüki näidetes kasutame kaht andmestikku, mida nimetame tinglikult võimekuse ja isiksuse näidisandmestikuks. Polütoomsete mudelite puhul kasutame R-i lisamoodulist psychTools pärinevat vabavaralist andmestikku bfi, milles on 2800 inimese vastused isiksuseküsimustiku “Big Five Inventory” 25 väitele, samuti vastajate sugu, haridustase ja vanus. Praegu ei ole vajadust süveneda selle küsimustiku üksikväidete sisusse; tunnuste jaotus isiksuse viiefaktorilise mudeli järgi on toodud tabelis 1.
names <- c("A", "C", "E", "N", "O")
names.EE <- c("Sotsiaalsus", "Meelekindlus", "Ekstravertsus", "Neurootilisus", "Avatus kogemusele")
names.EN <- c("Agreeableness", "Conscientiousness", "Extraversion", "Neuroticism", "Openness")
tunnused <- apply(outer(names, 1:5, paste0), 1, paste, collapse=",")
bfi1 <- data.frame(Lühend = names, "Dimensiooni nimi eesti keeles" = names.EE, Tunnusenimed = tunnused)
if(knitr::pandoc_to("docx")) knitr::kable(x = NULL, format = "html")
#qflextable(bfi1)
gt(bfi1)| Lühend | Dimensiooni.nimi.eesti.keeles | Tunnusenimed |
|---|---|---|
| A | Sotsiaalsus | A1,A2,A3,A4,A5 |
| C | Meelekindlus | C1,C2,C3,C4,C5 |
| E | Ekstravertsus | E1,E2,E3,E4,E5 |
| N | Neurootilisus | N1,N2,N3,N4,N5 |
| O | Avatus kogemusele | O1,O2,O3,O4,O5 |
Huvilistele on tabelis 2 toodud ka BFI väidete ingliskeelne tekst koos eestikeelse tõlkega. Tabelis toodud väited ei ole autoriõigusega kaitsud, kuna need on valitud rahvusvahelisest isiksuseväidete kogumist (IPIP) nii, et skaalade sisu oleks kokkuvõttes võimalikult sarnane algse BFI küsimustikuga. Seega oleks korrektsem öelda, et tegu on BFI vabavaralise analoogiga ning kasutada näiteks lühendit IPIP-BFI. Väiteid vabalt ja kelleltki luba küsimata kasutada, kuid eestikeelse tõlke puhul ei oleks see siiski hea mõte, kuna väited on eeltestimata.
# label: tbl-bfi2
if(knitr::pandoc_to("docx")) knitr::kable(x = NULL, format = "html")
# Algse BFI autoriõigus https://www.ocf.berkeley.edu/~johnlab/bfi.htm
# IPIP-BFI väited: The items are from the ipip (Goldberg, 1999). The data are from the SAPA project
# (Revelle, Wilt and Rosenthal, 2010) , collected Spring, 2010 ( https://www.sapa-project.org/).
# Goldberg, L.R. (1999) A broad-bandwidth, public domain, personality inventory measuring the lower-level facets of several five-factor models. In Mervielde, I. and Deary, I. and De Fruyt, F. and Ostendorf, F. (eds) Personality psychology in Europe. 7. Tilburg University Press. Tilburg, The Netherlands.
# Revelle, W., Wilt, J., and Rosenthal, A. (2010) Individual Differences in Cognition: New Methods for examining the Personality-Cognition Link In Gruszka, A. and Matthews, G. and Szymura, B. (Eds.) Handbook of Individual Differences in Cognition: Attention, Memory and Executive Control, Springer.
eesti <- scan(text="Teiste tunded ei lähe mulle korda
Küsin teistelt, kuidas neil läheb
Oskan teisi lohutada
Armastan lapsi
Teen nii, et teised tunneksid end vabalt
Olen oma töös täpne
Jätkan kuni kõik on täiuslikult tehtud
Teen asju plaani järgi
Teen asju üle jala
Raiskan aega
Ei räägi palju
Mul on raske teistele läheneda
Tean, kuidas teisi kaasa haarata
Leian kergesti sõpru
Võtan vastutuse
Vihastan kergesti
Ärritun kergesti
Minu meeleolu muutub sageli
Tunnen sageli kurbust
Satun kergesti paanikasse
Olen ideedest tulvil
Väldin keeruliste tekstide lugemist
Viin vestluse kõrgemale tasandile
Veedan aega asjade üle järele mõeldes
Ei süvene teemadesse põhjalikult", what="", sep="\n")
bfi2 <- data.frame(Tunnus = as.character(rownames(bfi.dictionary)),
Pööratud = bfi.dictionary$Keying,
"Väite tekst" = as.character(bfi.dictionary$Item),
stringsAsFactors = FALSE)[1:25,]
bfi2$Tõlge <- eesti
gt(bfi2)| Tunnus | Pööratud | Väite.tekst | Tõlge |
|---|---|---|---|
| A1 | -1 | Am indifferent to the feelings of others. | Teiste tunded ei lähe mulle korda |
| A2 | 1 | Inquire about others' well-being. | Küsin teistelt, kuidas neil läheb |
| A3 | 1 | Know how to comfort others. | Oskan teisi lohutada |
| A4 | 1 | Love children. | Armastan lapsi |
| A5 | 1 | Make people feel at ease. | Teen nii, et teised tunneksid end vabalt |
| C1 | 1 | Am exacting in my work. | Olen oma töös täpne |
| C2 | 1 | Continue until everything is perfect. | Jätkan kuni kõik on täiuslikult tehtud |
| C3 | 1 | Do things according to a plan. | Teen asju plaani järgi |
| C4 | -1 | Do things in a half-way manner. | Teen asju üle jala |
| C5 | -1 | Waste my time. | Raiskan aega |
| E1 | -1 | Don't talk a lot. | Ei räägi palju |
| E2 | -1 | Find it difficult to approach others. | Mul on raske teistele läheneda |
| E3 | 1 | Know how to captivate people. | Tean, kuidas teisi kaasa haarata |
| E4 | 1 | Make friends easily. | Leian kergesti sõpru |
| E5 | 1 | Take charge. | Võtan vastutuse |
| N1 | -1 | Get angry easily. | Vihastan kergesti |
| N2 | -1 | Get irritated easily. | Ärritun kergesti |
| N3 | -1 | Have frequent mood swings. | Minu meeleolu muutub sageli |
| N4 | -1 | Often feel blue. | Tunnen sageli kurbust |
| N5 | -1 | Panic easily. | Satun kergesti paanikasse |
| O1 | 1 | Am full of ideas. | Olen ideedest tulvil |
| O2 | -1 | Avoid difficult reading material. | Väldin keeruliste tekstide lugemist |
| O3 | 1 | Carry the conversation to a higher level. | Viin vestluse kõrgemale tasandile |
| O4 | 1 | Spend time reflecting on things. | Veedan aega asjade üle järele mõeldes |
| O5 | -1 | Will not probe deeply into a subject. | Ei süvene teemadesse põhjalikult |
BFI küsimustel on vastatud kuuepunktisel skaalal (1…6), kus suurem number tähendab tugevamat nõustumist antud väitega.
Juhuslikult genereeritud võimekuse näidisandmestikus, mille esimest kuut rida näete järgnevas tabelis 3, on kokku 14 tunnust, mis jagunevad kahe faktori vahel (i1...i6 ning j1...j8). Esimesed kuus tunnust (i1...i6) on samad, mis eelmise peatüki näidistes; nende aluseks on ühine latentne tunnus, mida võime nimetada näiteks I. Järgneva 8 tunnuse aluseks on latentne tunnus (nimetame seda J), mille korrelatsioon I-ga on umbes 0,3. Esimesed 5 tunnust (j1...j5) on genereeritud nii, et igal järgneval tunnusel on umbes 1 võrra väiksem rasuksaste kui eelmisel (st raskusastmed ca 2, 1, 0, -1, -2). Tunnuste j6 ja j7 jäägid on korreleeritud, kuid esimene tunnus on oluliselt raskem (raskusaste ca +2) kui teine (raskusaste ca -2). Lõpuks, viimane tunnus j8 on nullilähedase (st keskmise) raskusastmega, kuid seotud mõlema latentse tunnusega (J-iga tugevamalt kui I-ga).
# järgnev rida on trikk et docx formaadis tabelite numeratsioon töötaks
if(knitr::pandoc_to("docx")) knitr::kable(x = NULL, format = "html")
set.seed(42)
t1 <- rnorm(1000) # true score
# Kolm erineva eristusvõimega küsimust
i1 <- rbinom(1000, 1, pnorm(t1-1*rnorm(1000))) # Kõige parem
i2 <- rbinom(1000, 1, pnorm(t1+2*rnorm(1000))) # keskmine
i3 <- rbinom(1000, 1, pnorm(t1+3*rnorm(1000))) # kõige mürasem
i4 <- rbinom(1000, 1, pnorm(t1-1 + rnorm(1000))) # kõige raskem (eeldatav raskusaste: 1)
i5 <- rbinom(1000, 1, pnorm(t1 + rnorm(1000))) # keskmine (eeldatavalt raskusaste: 0)
i6 <- rbinom(1000, 1, pnorm(t1+1 + rnorm(1000))) # kõige kergem (eeldatav raskusaste -1)
t2 <- scale(t1*0.3 + rnorm(1000))
j1 <- rbinom(1000, 1, pnorm(t2 -2 + rnorm(1000)))
j2 <- rbinom(1000, 1, pnorm(t2 -1 + rnorm(1000)))
j3 <- rbinom(1000, 1, pnorm(t2 -0 + rnorm(1000)))
j4 <- rbinom(1000, 1, pnorm(t2 +1 + rnorm(1000)))
j5 <- rbinom(1000, 1, pnorm(t2 +2 + rnorm(1000)))
ej6 <- rnorm(1000)
j6 <- rbinom(1000, 1, pnorm(t2 -2 + ej6 + rnorm(1000)))
j7 <- rbinom(1000, 1, pnorm(t2 +2 + ej6 + rnorm(1000)))
j8 <- rbinom(1000, 1, pnorm(t1*.5 + t2 + rnorm(1000)))
df2 <- data.frame(i1,i2,i3,i4, i5, i6, j1, j2, j3, j4, j5, j6, j7, j8)
gt(head(df2, 6))| i1 | i2 | i3 | i4 | i5 | i6 | j1 | j2 | j3 | j4 | j5 | j6 | j7 | j8 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 0 | 1 | 1 | 0 | 1 | 1 | 0 | 0 | 1 | 1 | 1 | 0 | 1 | 1 |
| 1 | 1 | 0 | 0 | 0 | 1 | 1 | 0 | 1 | 1 | 1 | 1 | 1 | 1 |
| 0 | 1 | 1 | 0 | 0 | 1 | 0 | 0 | 0 | 1 | 1 | 0 | 1 | 1 |
| 0 | 1 | 1 | 0 | 0 | 1 | 1 | 1 | 1 | 1 | 1 | 0 | 1 | 1 |
| 1 | 1 | 0 | 1 | 0 | 1 | 0 | 0 | 0 | 0 | 1 | 0 | 1 | 1 |
| 1 | 1 | 0 | 0 | 0 | 0 | 0 | 0 | 1 | 0 | 1 | 0 | 1 | 0 |
Joonisel 1 on näha võimekuse näidisandmestiku lihtsustatud struktuur.
mudel <- "I =~ NA*i1 + i2 + i3 + i4 +i5 + i6 + j8
J =~ NA*j1 + j2 + j3 + j4 + j5 + j6 +j7 +j8
j6 ~~ j7
I ~~ 1*I
J ~~ 1*J
I ~~ J
"
#lava1 <- sem(mudel, df2, ordered=TRUE)
lava2 <- sem(mudel, df2, ordered=!TRUE)
semPaths(lava2, style="lisrel", sizeLat=7, sizeMan=7, normalize=!FALSE, mar=c(6,1,5,1))
text(0, 1.4, "ca 0.3", cex=2)
Tabelis 4 on toodud võimekuse näidisandmiestiku kirjeldav statistika: iga tunnuse õigete vastuste protsent, korrelatsioon skaala ülejäänud küsimuste summaga (esimesed 6 ja viimased 8 küsimust on arvestatud eraldi skaaladena) ning faktorlaadungid kahefaktorilise lahenduse puhul kasutades kaldnurkset promax pööramist.
# #| label: tbl-vnkesk
if(knitr::pandoc_to("docx")) knitr::kable(x = NULL, format = "html")
avg <- colMeans(df2)*100
df2a <- df2[,1:6]
df2b <- df2[, 7:14]
korr1 <- sapply(1:6, function(i) cor(df2a[,i], rowSums(df2a[,-i])))
korr2 <- sapply(1:8, function(i) cor(df2b[,i], rowSums(df2b[,-i])))
f12 <- round(factanal(df2, 2, rotation="promax")$loadings[,1:2],2)
f12 <- setNames(as.data.frame(f12), c("Faktor 1", "Faktor 2"))
stats <- data.frame(Küsimus = names(df2), Keskmine = round(avg),
Korrelatsioon = c(round(korr1,2), round(korr2,2)),
f12, check.names = FALSE
)
qflextable(stats)Küsimus | Keskmine | Korrelatsioon | Faktor 1 | Faktor 2 |
|---|---|---|---|---|
i1 | 48 | 0,31 | 0,01 | 0,48 |
i2 | 50 | 0,24 | -0,02 | 0,35 |
i3 | 50 | 0,15 | 0,00 | 0,21 |
i4 | 28 | 0,32 | 0,02 | 0,48 |
i5 | 46 | 0,29 | 0,03 | 0,40 |
i6 | 72 | 0,28 | 0,08 | 0,38 |
j1 | 13 | 0,31 | 0,42 | -0,02 |
j2 | 29 | 0,35 | 0,47 | -0,01 |
j3 | 50 | 0,32 | 0,43 | 0,01 |
j4 | 70 | 0,34 | 0,45 | 0,00 |
j5 | 88 | 0,19 | 0,24 | 0,00 |
j6 | 16 | 0,27 | 0,38 | -0,08 |
j7 | 85 | 0,25 | 0,32 | -0,04 |
j8 | 53 | 0,36 | 0,44 | 0,23 |
Eelmises peatükis käsitlesime ÜVT mudeleid, mis sobivad dihhotoomsetele tunnustele, st tunnustele, millel on kaks võimalikku väärtust, mida tavaliselt kodeeritakse 0 (mille tähendus võib olla näiteks ‘vale’, ‘puudub’, ‘ei ole nõus’) ja `1’ (mille tähendus võib olla näiteks ‘õige’, ‘esineb’ või ‘nõus’). Ajalooliselt on ÜVT tekkinud vaimse võimekuse hindamise kontekstis, seega kasutatakse sageli sellest valdkonnast pärit terminoloogiat, näiteks ‘latentne võimekus’ (\(\theta\)) ja ‘raskusaste’. Kuid mudelid ise on valdkonnast sõltumatud - see tähendab, et dihhotoomsete tunnuste mudelid sobivad ka isiksuse- või hoiakutestide jaoks, kui nende vastused on dihhotoomsed. See tähendab ainult natuke terminoloogilist ebamugavust: kui meie mudel käib näiteks riskikäitumise indikaatorite kohta, siis ‘raskusastme’ parameeter tähenduseks on, kui suurele riskile iga küsimus viitab (näiteks kevadel sallita õue minemise küsimus on ‘kergem’ kui raudteel kõndimise küsimus) ning ‘võimekuse’ parameeter (st tehnilisemalt - isikuparameeter \(\theta\)) näitab, kui ‘võimekas’ riskija iga vastaja on (nt raudteel kõndija on ‘võimekam’ riskija kui sallita õue mineja). Kui selle terminoloogilise ebamugavusega hakkama saada (õnneks on kõigil parameetritel olemas ka tehnilised tähised, st võimekuse testimisest pärineva sõnavara kasutamine ei ole paratamatu), siis saab ÜVT mudeleid väga edukalt kasutada ka väljaspool võimekuse testimsit.
Aga mida teha polütoomsete küsimustega st küsimustega, kus vastused on küll järjestatud, aga vastamisvõimalusi on rohkem kui üks? Selliste vastuseskaalade näiteks on sagedusskaala (iga päev - 4-6 korda nädalas - 2-3 korda nädalas - 1 kord nädalas - 2-3 korda kuus - kord kuus - harvem) ja nõusolekumäära skaala (täiesti nõus - pigem nõus - pigem ei ole nõus - ei ole üldse nõus). Siin on võimalik kasutada dispersioonanalüüsist tuntud ümberkodeerimist, kus N kategooriaga tunnuses olev info esitatakse N-1 dihhotoomse tunnuse abil.
Tabelis (5) on kujutatud kaht võimalust, kuidas nelja väärtusega järjestustunnust kodeerida kolme eri dihhotoomse tunnuse abil. Nendel kodeerimisviisidel on teatud sisuline erinevus: tabeli vasakpoolses osas kujutatud kodeerimisviisi puhul võrreldakse iga kategooriat kõigi eelnevatega (seega uusi tunnuseid võiks tõlgendada kui “vähemalt 2”, “vähemalt 3” jne), kuid paremal pool kujutatud kodeerimisviis võrdleb iga kategooriat talle vahetult eelnevaga (seega usi tunnuseid võiks tõlgendada kui “2, aga mitte 1”, “3, aga mitte 2” jne).
if(knitr::pandoc_to("docx")) knitr::kable(x = NULL, format = "html")
nms <- c("ei ole üldse nõus (1)", "pigem ei ole nõus (2)", "pigem nõus (3)", "täiesti nõus (4)")
kat <- 1:4
grms <- c("vähemalt (2)", "vähemalt (3)", "vähemalt (4)")
pcms <- c("1 vs 2", "2 vs 3", "3 vs 4")
df <- read.table(text =
"x vähemalt_2 vähemalt_3 vähemalt_4 | 1_vs_2 2_vs_3 3_vs_4
1 0 0 0 | 0 - -
2 1 0 0 | 1 0 -
3 1 1 0 | - 1 0
4 1 1 1 | - - 1",
header=TRUE, check.names=FALSE)
df$x <- nms
names(df)[1] <- " "
names(df) <- gsub("_", " ", names(df))
df[,5] <- NULL
qf <- qflextable(df)
vline(qf, j= c(1,4))
| vähemalt 2 | vähemalt 3 | vähemalt 4 | 1 vs 2 | 2 vs 3 | 3 vs 4 |
|---|---|---|---|---|---|---|
ei ole üldse nõus (1) | 0 | 0 | 0 | 0 | - | - |
pigem ei ole nõus (2) | 1 | 0 | 0 | 1 | 0 | - |
pigem nõus (3) | 1 | 1 | 0 | - | 1 | 0 |
täiesti nõus (4) | 1 | 1 | 1 | - | - | 1 |
# GRM vs PCM: 1) mõlemad sobivad järjestusskaalade puhul; 2) võimalik on seisukoht, et "Likerti" skaala puhul pigem GRM -- aga see on pigem traditsiooni küsimus; 3) PCM on Raschi mudeli edasiarendus, GPCM-i aluseks on 2PL; 4) aluseks võib võtta mudeli sobitusastme võrdluse; 5) PC mudeli alus: järjestikused paarid 1 vs 2, 2 vs 3, 3 vs 4 jne. St iga kategooriat võrreldakse järgmisega. GRM mudel: iga kategooriat võrreldakse kõigi eelnevatega, st 2 vs 1, 3 vs 1 või 2, 4 vs 1-3, jne.
# GRM vt [[https://github.com/ccs-amsterdam/r-course-material/blob/master/tutorials/R_test-theory_3_irt_graded.md]{.underline}](https://github.com/ccs-amsterdam/r-course-material/blob/master/tutorials/R_test-theory_3_irt_graded.md)
# PCM vt cf [[https://hanhao23.github.io/project/irttutorial/irt-tutorial-in-r-with-mirt-package/]{.underline}](https://hanhao23.github.io/project/irttutorial/irt-tutorial-in-r-with-mirt-package/)
# [[https://assess.com/what-is-the-generalized-partial-credit-model/]{.underline}](https://assess.com/what-is-the-generalized-partial-credit-model/)
# [[https://rpubs.com/scientist97/Tutorial_GRM_byMarvianto]{.underline}](https://rpubs.com/scientist97/Tutorial_GRM_byMarvianto)
# In the past, it has been suggested that the theoretical choice between the GPCM and GRM is somewhat arbitrary (e.g., Ostini & Nering, 2005). Essentially, the only difference between the two models is purely mathematical.
# https://www.frontiersin.org/articles/10.3389/feduc.2021.721963/full # compare GPCM vs GRM
# https://www.tandfonline.com/doi/full/10.1080/00220973.2022.2153783 # Number of Response Categories and Sample Size Requirements in Polytomous IRT ModelsEsimest (tabelis 5 vasakul kujutatud) kodeerimisviisi rakendav ÜVT mudelit võiks eesti keeles nimetada “astmelise vastuse mudeliks” (Graded Response Model, GRM), teist (tabelis paremal pool kujutatud kodeermisviisi) aga “osapunkti mudeliks” (Partial Credit Model, PCM). Nende mudelite rakendusvõimalused on küllaltki sarnased, seetõttu tutvustame siin neist vaid esimest. GRM on olemuselt kaheparameetrilise logistilise mudeli üldistus polütoomsetele tunnustele, kuna PCM kujutab endast Raschi mudeli üldistust. PCM-i edasiarendus GPCM (Generalized Partial Credit Model - üldistatud osapunkti mudel) sisaldab sarnaselt GRM-ile ka eristusvõime parameetrit ning on seega ühtlasi 2PL mudeli üldistus. Sageli tuuakse osapunkti (PCM) mudeli rakendamise näitena esseede või matemaatikaülesannete hindamine, kus lahenduse või töö eest võib vastavalt hindamisjuhendile saada mistahes arvu punkte nulli ja maksimumi vahel. Astmelise vastuse mudeli (GRM) rakendusnäiteks tuuakse sageli nõustumismäära skaala. Kuid tegelikkuses rakendatakse mõlemat mudelit mõlemat tüüpi andmetel. Mudeli valimisel on lisaks valdkonna tavale (nt PISA uuringu hoiakuküsimuste analüüsil kasutatakse valdavalt GPCM-i) võimalik siiski lähtuda veel kahest asjaolust.
Kui oluline on ÜVT skooride (isikuparameetrite) võrreldavus punktisummadega, siis võib lähtuda Raschi mudelist või selle edasiarendustest (nt PCM, kuid mitte GPCM), kus isikuparameetri (\(\theta\)) ja punktisumma vahel on üks-ühene (kuigi mitte lineaarne) seos. See tuleneb asjaolust, et Raschi mudelis nagu ka lihtsal punktisumma arvutamisel on kõik küsimused võrdse kaaluga - küsimuste eristusvõime parameetrid on võrdsed.
Astmelise vastuse mudel (GRM) eeldab, et vastusekategooriad on rangelt järjestatud, kuid (üldistatud) osapunkti mudel (PCM ja GPCM) seda ei eelda. See tähendab, et GPCM-is on võimalik näiteks olukord, kus kolme punkti vääriline vastus on “parem” (viitab suuremale võimekusele) kui kahepunktine vastus. Üldisemalt: GRM-is on vastusekategooriatele vastavad b-parameetrid monotoonselt (kas kasvavalt või kahanevalt) järjestatud, kuid (G)PCM-is ei pruugi nad seda olla. Seega on mõned juhud, kus sisuliselt võiks sobida GPCM, kuid ei sobi GRM.
Joonisel 2 on võrreldud GRM ja GPCM mudeleid isiksuse näidisandmestiku sotsiaalsuse skaala näitel. Mõlema mudeli põhjal on ennustatud tõenäosust, et vastus (x) on vähemalt 2 (st x > 1), 3, 4 jne. Need joonised näevad välja nagu mitu dihhotoomise tunnuse iseloomulikku kõverat samale joonisel panduna - ning olemuslikult nad seda ongi.
##| label: fig-grmvsgpcm
MIRT <- FALSE
if(MIRT){
library(gridExtra)
muda1 <- mirt(bfi[,1:5], 1, itemtype="graded", verbose=FALSE)
muda2 <- mirt(bfi[,1:5], 1, itemtype="gpcm", verbose=FALSE)
p1 <- itemplot(muda1,2, type="threshold", auto.key=list(columns=3, lines=FALSE, points=TRUE, pch=16), main="GRM")
p2 <- itemplot(muda2,2, type="threshold", auto.key= list(columns=3, lines=FALSE, points=TRUE), main="GPCM")
grid.arrange(p1,p2, ncol=2)
} else{
library(ltm)
sv <- structure(c(0.905, -3.03, -2.276, -3.352, -3.005, -0.744, -2.139,
-1.604, -2.232, -1.955, -1.654, -1.645, -1.17, -1.67, -1.319,
-2.774, -0.66, -0.404, -0.709, -0.369, -4.459, 0.65, 0.73, 0.414,
0.948, -0.862, 1.839, 2.527, 1.047, 1.701), dim = 5:6, dimnames = list(
c("A1", "A2", "A3", "A4", "A5"), c("Extrmt1", "Extrmt2",
"Extrmt3", "Extrmt4", "Extrmt5", "Dscrmn")))
m1 <- grm(bfi[,1:5])
m2 <- gpcm(bfi[,1:5], start.val = lapply(1:5, function(i) -sv[i,]))
par(mar=c(4,2,1,1), mfcol=1:2)
plot(m1, items=2, type="OCCu", main="GRM", xlab="Võimekus")
plot(m2, items=2, type="OCCu", main="GPCM", xlab="Võimekus")
}
Joonise 2 vasak- ja parempoolset osa võrreldes näeme, et need on küllaltki sarnased: lävendid on samas järjestuses ning see järjestus on mõlemal juhul “õige”. Peamine erinevus on selles, et GRM-i puhul (vasakpoolne paneel) on kõverad üksteisega paralleelsed, kuid GPCM-i puhul (parempoolne paneel) mitte, st mõned vastusevariandid võivad olla teistest (mitte päris täpselt väljendudes) parema eristusvõimega või informatiivsemad.
Teiseks näeme joonisel 2, et kõveraid on ühe võrra vähem kui vastusekategooriaid: see tähendab, et numbriga “1” tähistatud kõver kujutab tõenäosust, et valitakse teine (ja mitte esimene) vastusekategooria. Lõpuks, lävendi on järjestatud ootuspärasele vastupidiselt: see tähendab, et horisontaalteljel kujutatud latentne omadus on tõlgendatav kui sotsiaalsuse vastand (latentse omaduse kõrge väärtus tähendab madalat sotsaalsust ja vastupidi). Kui uuritavate küsimuste hulgas on nii “pööramata” kui ka “pööratud” küsimusi, st latentse omaduse kõrget taset näitab mõnel juhul väitega nõustumine ja teisel juhul väitega mittenõustumine, siis on latentse omaduse märk juhuslik, st teises arvutis või teise programmiga tehtuna võib tulemus olla vastandmärgiline, kuid numbriliselt sama. See ei ole tarkvara puudus vaid paratamatu asjaolu, millega tuleb arvestada. Programm ei tea väidete sisu; see, kas me tahame mõõta sotsiaalsust või näiteks antisotsiaalsust, on eelkõige kokkuleppe küsimus.
# label: fig-grmicc
plot(m1, items=2, type="ICC", xlab="Latentne omadus (-A = sotsiaalsuse vastand)", ylab="Tõenäosus", main="")
abline(v=2, h=0.13, lty="dotted", col="gray")
abline(v=2.8, lty="dotted", col="red")
ltm)Joomisel 3 näeme väite A2 (“1”) vastusekategooriate tõenäosusi natuke kergemini tõlgendataval viisil. Lilla kõver kujutab 6. vastusekategooria (maksimaalne nõusolek) tõenäosuse seost latentse omadusega. Selle vastuse tõenäosus on seda väiksem, mida suurem on latentse omaduse väärtus - st näeme uuesti, et latentne omadus on tõlgendatav sotsiaalsuse vastandina. Mustaga tähistatud kategooria (maksimaalne mittenõustumine väitega) tõenäosus on seda suurem, mida kõrgem on latentse omaduse tase. Kui latentse omaduse (eba- või antisotsiaalsuse) tase on 2 (st 2 standardhälvet üle keskmise ehk üle 97% vastajatest saavad sellest väiksema tulemuse), siis on selle vastusevariandi tõenäosus umbes 13% - seda kohta kujutab hall punktiirjoon joonisel. Seega äärmuslik mittenõustumine selle väitega on üsna vähe tõenäoline ka äärmiselt madala sotsiaalsuse korral ning see vastusevarint muutub 2. vastusevariandist (joonisel punase joonega tähistatud vähem äärmuslik mittenõustumine) tõenäolisemaks alles väga ebatavaliselt madala sotsiaalsuse korral (umbes \(\theta\) = 0.8, joonisel tähistatud vertikaalse punase punktiirjoonega).
muda1 <- mirt(bfi[,1:5], 1, itemtype="graded", verbose=FALSE)
plt <- plot(muda1, type="trace", which.items=2)
env <- environment(plt$formula)
rm("...", envir=env)
theta <- env$Theta
#env$itemtrace
#env$P$A2
items <- env$P$A2
#items <- split(items$P, items$cat)
#plot(theta, items[[1]], type="l")
items$theta <- rep(theta, 6)
items$cat <- sub("P","", items$cat)
names(items)[2] <- "Vastusekategooria"
ggplot(items, aes(x=theta, y=P, col=Vastusekategooria)) + geom_line() + theme_bw() +
xlab("Latentne omadus (A = sotsiaalsus)") +
ylab("Vastuse tõenäosus") + theme(legend.position = c(0.9,0.7), legend.title=element_blank())Warning: A numeric `legend.position` argument in `theme()` was deprecated in ggplot2
3.5.0.
ℹ Please use the `legend.position.inside` argument of `theme()` instead.
mirt)Joonistel 3 ja 4 on kaks erinevust. Kõigepealt, esimese aluseks olev mudel on tehtud R-i lisamooduliga ltm, teise aluseks olev mudel aga lisamooduliga mirt. See erinevus on väheoluline, sest mõlemad programmid kasutavad sama algoritmi. Teiseks, latentse omaduse skaala on joonistel vastupidise märgiga: \(\theta\) suurem väärtus joonisel 3 tähendab madalamat sotsiaalsust, kuid joonisel 4 kõrgemat sotsiaalsust. Ka see erinevus on tehniline ja õigupoolest lausa juhuslik, kuid oluline selles mõttes, et seda on vaja tulemuste tõlgendamisel kindlasti arvestada.
Küsimus on seda informatiivsem, mida lähemal on õige vastuse tõenäosus 50%-le. Seda on lihtne põhjendada vastandlike äärmuste kaudu: kui küsimusele vastavad kõik õigesti (õige vastuse tõenäosus on 100%) või ei vasta keegi õigesti (õige vastuse tõenäosus on 0%), siis ei ole küsimus üldse informatiivne ning seda ei ole mõtet küsida, sest me teame vastust juba ette. Seetõttu peaks õige vastuse tõenäosus asuma kusagil 0 ja 100% vahel.
Kaheparameetrilise logistilise mudeli puhul saab küsimuse informatiivsust väljendada valemiga
#<!-- $I_j(\theta) = \alpha_j^2p_j(1-p_j)$ -->\(I = a^2p(1-p)\)
See tähendab, et informatiivsus mingi valitud võimekuse (\(\theta\)) taseme korral sõltub küsimuse eristusvõimest (mida suurem eristusvõime ruut, seda informatiivsem küsimus üldiselt on) ning õige vastuse tõenäosusest (\(p\)) vastava \(\theta\) taseme korral. Lihtne on veenduda, et tõenäosuse (\(p\)) ja tema vastandväärtuse (\(1-p\), vahel tähistatud ka kui \(q\)) korrutis on maksimaalne, kui \(p = 0.5\). Kui \(p=0.5\), siis \(pq = 0.25\), kui \(p=0.4\), siis \(pq = 0.24\), aga kui \(p=0.1\), siis \(pq = 0.09\) (vt ka joonis 5).
curve(x*(1-x), xlim=c(0,1), ylim=c(0,0.5), xlab="Tõenäosus (p)", ylab=expression(p * (1-p)))
Seega täidab küsimuse informatsioonikõver talle seatud eesmärki: jooniselt 5 näeme, et informatiivsus on seda suurem, mida lähemal on õige vastuse tõenäosus 50%-le.
Sama loogika kehtib ka polütoomsete tunnuste kohta, kuid natuke keerukamal kujul - mida vähem on võimalik vastust ette ennustada üldiste teadmiste põhjal, seda informatiivsem see vastus on.
Uurime seda kõigepealt võimekuse näidisandmestikus, mida on tutvustatud käesoleva peatüki alguses (tabel 3). Järgnevalt toome välja kahe 2PL mudeli tulemused selle andmestiku kohta: analüüsime kumbagi latentset tunnust eraldi, st eraldi analüüsides on tunnused i1-i6 (tabel 6) ja j1-j8 (tabel 7).
if(knitr::pandoc_to("docx")) knitr::kable(x = NULL, format = "html")
m1 <- mirt(df2[, paste0("i", 1:6)], itemtype="2PL", verbose=FALSE)
m1s <- summary(m1, verbose=FALSE)
m1c <- coef(m1, simplify=TRUE, IRTpar = TRUE)$items
tblm1 <- data.frame(Küsimus = paste0("i", 1:6), F1 = round(m1s$rotF[,1],2), round(m1c,2))
qflextable(tblm1)Küsimus | F1 | a | b | g | u |
|---|---|---|---|---|---|
i1 | 0,59 | 1,24 | 0,08 | 0 | 1 |
i2 | 0,41 | 0,75 | -0,02 | 0 | 1 |
i3 | 0,25 | 0,43 | 0,02 | 0 | 1 |
i4 | 0,65 | 1,46 | 0,88 | 0 | 1 |
i5 | 0,51 | 1,00 | 0,18 | 0 | 1 |
i6 | 0,56 | 1,14 | -1,06 | 0 | 1 |
if(knitr::pandoc_to("docx")) knitr::kable(x = NULL, format = "html")
m2 <- mirt(df2[, paste0("j", 1:8)], itemtype="2PL", verbose=FALSE)
m2s <- summary(m2, verbose=FALSE)
m2c <- coef(m2, simplify=TRUE, IRTpar = TRUE)$items
tblm2 <- data.frame(Küsimus = paste0("j", 1:8), F1 = round(m2s$rotF[,1], 2), round(m2c,2))
m2 <- mirt(df2[, paste0("j", 1:8)], itemtype="Rasch", verbose=FALSE)
m2s <- summary(m2, verbose=FALSE)
m2c <- coef(m2, simplify=TRUE, IRTpar = TRUE)$items
tblm2b <- data.frame(Küsimus = paste0("j", 1:8), F1 = round(m2s$rotF[,1], 2), round(m2c,2))
tblm2b <- setNames(tblm2b, paste(names(tblm2b), " "))
tblm2 <- data.frame(tblm2, " "=NA, tblm2b[,-1], check.names=FALSE)
qflextable(tblm2)Küsimus | F1 | a | b | g | u |
| F1 | a | b | g | u |
|---|---|---|---|---|---|---|---|---|---|---|---|
j1 | 0,70 | 1,66 | 1,62 | 0 | 1 | 0,57 | 1 | 2,33 | 0 | 1 | |
j2 | 0,62 | 1,34 | 0,89 | 0 | 1 | 0,57 | 1 | 1,14 | 0 | 1 | |
j3 | 0,53 | 1,06 | -0,01 | 0 | 1 | 0,57 | 1 | -0,01 | 0 | 1 | |
j4 | 0,60 | 1,29 | -0,87 | 0 | 1 | 0,57 | 1 | -1,09 | 0 | 1 | |
j5 | 0,43 | 0,81 | -2,70 | 0 | 1 | 0,57 | 1 | -2,42 | 0 | 1 | |
j6 | 0,55 | 1,12 | 1,82 | 0 | 1 | 0,57 | 1 | 2,08 | 0 | 1 | |
j7 | 0,51 | 1,00 | -2,02 | 0 | 1 | 0,57 | 1 | -2,13 | 0 | 1 | |
j8 | 0,60 | 1,29 | -0,11 | 0 | 1 | 0,57 | 1 | -0,14 | 0 | 1 |
getinfoplot <- function(i, m, THETA = TRUE, I = TRUE){
foo <- itemplot(m, item=i, type="info")
bar <- foo$formula |> environment()
theta <- bar$theta
info <- bar$info
if(THETA) data.frame(theta, i, info) else info
}
df3 <- do.call(rbind, lapply(1:6, getinfoplot, m1))
df4 <- rbind(df3,
data.frame(theta=df3[1:200, "theta"],
i = "test",
info = (plot(m1, type="info")$formula |> environment())$info)
)
ggplot(df3, aes(x=theta, y=info, col=factor(i))) + geom_line() +
xlab("Latentne võimekus") +
ylab("Küsimuse informatiivsus") + theme_bw() +
theme(legend.position = c(0.9,0.7), legend.title=element_blank()) # + geom_vline(xintercept=0.88)
Uurime joonist 6 ja püüame sealt kõigepealt leida kõige informatiivsema ja vähem informatiivse küsimuse. Iformatiivsus sõltub ka latentse võimekuse tasemest (ja see on suurel määral ju kogu selle joonise mõte), kuid jätame selle mõtte esialgu kõrvale. Näeme, et kõige kõrgemale ulatub helesinisega tähistatud 4-nda küsimuse informatiivsuskõver ning kõige madalamal lösutab roheline 3-nda küsimuse infokõver. Tabelist 6 näeme, et just need on küsimused, mille eristusvõime (\(a\)) parameetrid on vastavalt kõige kõrgem ja kõige madalam.
Aga 4. küsimus ei ole sugugi kõigi jaoks kõige informatiivsem, vaid eelkõige nende vastajate jaoks, kelle latentne võimekus (\(\theta\)) on lähedane küsimuse raskusastmele. Leidke tabelist 6 4. küsimuse raskusastme parameeter ning veenduge, et see näitab kätte selle küsimuse infokõvera kõige kõrgema punkti. Kui vastaja võimekus on alla keskmise, siis on 4. küsimusest informatiivsemad näiteks 6. ja 1. küsimus. Sellist võimekuse piirkonda, kus kõige informatiivsem oleks kõige madalama informatiivsusega 3. küsimus, tegelikult jooniselt ei leia. Me võiks küll öelda, et roheline joon on teistest pisut kõrgem, kui võimekus on üle 4.5 või siis alla -4.5, kuid kõigepealt, teades normaaljaotuse omadusi, teame ka, et sellise võimekusega vastajaid on kaduvväike hulk. Teiseks, praeguses andmestikus selliseid vastajaid ei ole: järelikult on kõik, mida mudel selle võimekuspiirkonna kohta väidab, juba ette kahtlane – või siis, peenemalt öelduna, väga laia usaldusvahemikuga.
Kõigi üksikküsimuste infokõverate summa moodustab testi infokõvera (joonis 7).
ggplot(df4, aes(x=theta, y=info, col=factor(i))) + geom_line() +
xlab("Latentne võimekus") +
ylab("Küsimuste või kogu testi informatiivsus") + theme_bw() +
theme(legend.position = c(0.9,0.7), legend.title=element_blank()) # + geom_vline(xintercept=0.88)
Kaheparameetrilises logistilises mudelis mõjutab infokõverat nii küsimuse raskusaste kui ka eristusvõime. Üheparameetrilises mudelis (sealhulgas Raschi mudelis) erinevad infokõverad ainult oma asukoha poolest, kuid on kõik sama kujuga. Vaatleme Raschi mudeli (tabeli 7 parempoolne osa) põhjal tehtud jooniseid võimekuse näidisandmestiku teise latentse tunnuse indikaatorite (j1-j8) kohta.
Raschi mudelit on mõistlik kasutada juhul, kui on teada, et küsimused on võrdse eristusvõimega – või siis on hea põhjus sellist eeldust andmetele nö peale suruda. Praegusel juhul on see eeldus tegelikult õige vähemalt utnnuste j1-j5 puhul, mis on genereeritud nii, et nendes on latentse tunnuse “osakaal” kõigis ühesugune.
df5 <- do.call(rbind, lapply(1:5, getinfoplot, m2))
df6 <- rbind(df5,
data.frame(theta=df5[1:200, "theta"],
i = "test",
info = (plot(m2, type="info")$formula |> environment())$info))
ggplot(df5, aes(x=theta, y=info, col=factor(i))) + geom_line() +
xlab("Latentne võimekus") +
ylab("Küsimuse informatiivsus") + theme_bw() +
theme(legend.position = c(0.9,0.7), legend.title=element_blank()) # + geom_vline(xintercept=0.88)
ggplot(df6, aes(x=theta, y=info, col=factor(i))) + geom_line() +
xlab("Latentne võimekus") +
ylab("Küsimuse informatiivsus") + theme_bw() +
theme(legend.position = c(0.9,0.7), legend.title=element_blank()) # + geom_vline(xintercept=0.88)
Lõpuks, informatsiooni (informatiivsuse) mõiste on kasutatav ka polütoomsete tunnuste mudelites. Kui eespool nägime, et testi infokõver on kõigi üksikküsimuste infokõverate summa, siis polütoomse tunnuse puhul on võimalik eraldi uurida ka iga vastusekategooria informatiivsust ning küsimuse infokõver on vastusekategooriate infokõverate summa. Joonisel 10 näeme, et vastusekategooriate infokõverad võivad olla küllaltki keerulise kujuga ning latentse omaduse väärtuse suurenedes mitu korda nii tõusta kui langeda (nt 2. kategooria infokõver joonisel 10).
#rida 249
# muda1 <- mirt(bfi[,1:5], 1, itemtype="graded", verbose=FALSE)
# m3 <- mirt(bfi[, paste0("A", 1:5)])
m3 <- muda1
theta <- seq(-3,3,0.1); item <- 3
bang <- iteminfo(extract.item(m3,item), theta, total.info = FALSE)
bang <- do.call(rbind, lapply(1:ncol(bang), function(i) data.frame(kat=i, theta = theta, I = bang[,i])))
bang <- rbind(bang, data.frame(kat="Kokku", theta=theta, I = iteminfo(extract.item(m3,item), theta)))
ggplot(bang, aes(x=theta, y=I, col=kat)) + geom_line() + xlab("Latentne omadus") + theme_bw() +
ylab("Informatsioon") +
theme(legend.position = c(0.87,0.7), legend.title = element_blank(),
legend.key = element_rect(colour = "transparent", fill = "transparent"))
bang <- sapply(1:5, function(i) iteminfo(extract.item(m3,i), theta))
bang <- do.call(rbind, lapply(1:ncol(bang), function(i) data.frame(item=i, theta=theta, I = bang[,i])))
bang <- rbind(bang, data.frame(item="Test", theta=theta, I = testinfo(m3, theta)))
ggplot(bang, aes(x=theta, y=I, col=item)) + geom_line() + xlab("Latentne omadus") + theme_bw() +
ylab("Informatsioon") + theme(legend.position = c(0.85,0.7), legend.title = element_blank())
ÜVT üks suuremaid eeliseid on võimalus küsimuste informatiivsust kompaktselt väljendada. See on abiks küsimuste valimisel testi, kuna iseenesestmõistetav eesmärk on enamasti küsida võimalikult informatiivseid küsimusi. Maksimaalne informatiivsus ei ole alati ainus eesmärk ja ei ole ka alati saavutatav. Üheks erandiks on nö “soojendusküsimused” kognitiivse testi alguses, mis hõlbustavad järgmistest küsimustest aru saamist. Soojendusküsimus ise ei ole kuigi informatiivne, kuna eesmärgiks on, et kõik vastajad saaksid küsimusest aru ning see aitaks neil mõista järgmiste küsimuste formaati. Kuid sellise väheinformatiivse küsimuse ära jätmine kahjustaks järgnevate küsimuste informatiivsust. Võib juhtuda ka, et küsimused ei ole üksteisest sõltumatud. Näiteks keeletestides tuleb sageli ette, et paarist lõigust koosneva teksti kohta esitatakse järjest mitu küsimust. Need küsimused ei ole üksteisest sõltumatud: näiteks kui esimene küsimus ära jätta, siis ei pruugi järgnevad olla enam arusaadavad. Siin kehtib üldreegel, et testi koostamisel ei saa lähtuda ainult mudelitest ja arvudest, vaid tuleb arvestad ka küsimuste sisu.
Testi infokõver näitab meile, milliste latentse tunnuse tasemete puhul on testi informatiivne ning milliste puhul vähem informatiivne.
Näiteks jooniselt 9 näeme, et võimekuse näidisandmestiku teist latentset omadust (J) saame küsimuste \(j1...j8\) abil mõõta üsna hästi latentse omaduse vahemikus \(-3...+3\); väljaspool seda vahemikku informatiivsus langeb, kuid mitte järsult; kõige informatiivsem on test \(\theta=0\) ümbruses. Selline sümmeetriline pilt on kooskõlas sellega, mida teame andmete saamisloost: andmestiku esimesed 5 tunnust on genereeritud nii, et nende raskusaksmed oleksid umbes -2, -1, 0, +1 ja +2. Kui me tahaksime testi mõõtmisdiapasooni laiendada, siis oleks vaja tekitada juurde väga raskeid (näiteks raskusastmega 3) või väga kergeid (nt raskusastmega -3) küsimusi. Kui väga võimekate vastajate täpne järjestamine ei ole tähtis ning testi kasutamise eesmärgiks on pigem eristada keskmist või kõrget võimekust madalast või väga madalast, siis ei anna rasked (nt raskusaste üle +1) küsimused midagi juurde ning nende arvelt võiks suurendada keskmiste ja mõõdukalt raskete küsimuste arvu.
Isiksuse näidisküsimustiku sotsiaalsuse skaalaga on üsna teisiti: jooniselt 11 näeme, et skaala on informatiivne latentse tunnuse madalate ja keskmiste väärtuse puhul (ca \(-3...+1\)) ning sealt edasi langeb informatiivsus üsna järsult. Skaala kindlasti ei sobi selleks, et eristada kõige sotsiaalsusega vastajaid väga kõrge sotsiaalsusega vastajatest. See tuleb välja ka väidete sisust (tabel 2): väited viitavad tavalisele prosotsiaalsele käitumisele, asjadele, mida ühiskond ja kaasinimesed meilt tavaliselt ootavad ja normaalseks peavad. Näiteks väitega A4 (armastan lapsi) oli pigem nõus (vastusevariandi 4,5,6) 81% vastajatest ning täiesti vastumeelne oli see mõte (st väitega ei nõustunud üldse, valides vastusevariandi 1) ainult 4,6% vastajaist. Ka tugev nõustumine selle väitega ei näita, et vastaja oleks kuidagi iseäranis prosotsiaalne, vaid ta on seda üsna tavalisel määral. Kui me tahaks selle skaala mõõtmisdiapasooni suurendada, siis esimeses järjekorras tuleks lisada küsimusi, mis viitavad ebatavaliselt kõrgele (pro)sotsiaalsusele.
Eelnev käib olukorra kohta, kus meil on vaja koostada test, mida saaks kasutada paljude vastajatega ühtmoodi. Võiksime seda kutsuda fikseeritud testiks - vastandina adaptiivsele testile, kus igale vastajale esitatakse küsimusi, mis just tema puhul on kõige informatiivsemad. Enne esimese küsimuse esitamist me ei tea vastaja võimekuse kohta mitte midagi: seega on mõistlik eeldada, et tema võimekus on keskmine. Sellist eeldust tehes eksime tõenäoliselt kõige vähem. Kui ta vastab esimesele küsimusele õigesti, siis võiksime tema võimekuse hinnangut korrigeerida natuke ülespoole ning kui ta vastab valesti, siis allapoole. Adaptiivse testimise algoritmide ülesandeks on leida sellele “natukesele” hästi põhjendatud konkreetne väärtus. Kuid iga küsimuse valikul on loogika sama: küsimustepangast valitakse selline küsimus (mida ei ole enne esitatud!), mis on mingi kindla võimekusega vastaja puhul kõige informatiivsem. See tähendab maksimaalse eristusvõimega küsimust, mille raskusaste on kõige lähedasem vastaja võimekuse hinnangule – kuid nagu eespool nägime, siis küsimuse informatsioonifunktsioon kombineerib need kaks parameetrit üheks. Ainuke vastamata küsimus on nüüd, millal testimine lõpetada? Üks mõeldav vastus oleks, et küsime kõigilt võrdse arvu küsimusi, näiteks 10. Aga miks just 10 ja mitte 11 või lausa 12? Enamasti kasutatakse teistsugust lähenemist, mis eeldab mõnevõrra keerulisemat arvutuskäiku. Iga kord, kui arvutatakse hinnang vastaja võimekusele, leitakse ka selle hinnangu standardviga. Vastaja võib ühe küsimuse vastata juhuslikult õigesti, kuid kaks õiget vastust järjest on vähem tõenäoline ja kolm veelgi vähem. Seega üldreeglina, mida rohkem küsimusi küsida, seda väiksemaks muutub võimekuse hinnangu standardviga – kuid see vähenemine ei ole kõigil ühesugune, vaid sõltub vastamismustrist ning küsimuste omadustest testipangas (nt kas pangast on võtta küsimus, mille raskusaste oleks täpselt 4,3 või siis tuleb kasutada kõige lähedasemat küsimust raskusastmega 2,3). Kui vastaja vastamismuster on ebaregulaarne st ei ole mudeliga heas kooskõlas (näiteks ta teab mõne väga keerulise küsimuse vastust juhuslikult, tähelepanu hajub, või on ta tugev mingis spetsiifilises valdkonnas, mis on kitsam, kui testitav võimekus), siis on võimekushinnangu standardviga suurem ning täpsema hinnangu saamiseks tuleb küsida rohkem küsimusi. Lõpuks, küsimuste esitamine lõpetatakse siis, kui hinnangu standardviga on piisavalt väike, st on saavutatud soovitud täpsus. Mõistagi on võimalik kasutada ka keerulisemaid lõpetamiskriteeriume. Üks võimalus, mida on kasulik ette näha, on väga erandlikud vastajad, kelle puhul standardviga ei muutu kunagi piisavalt väikseks. Selline vastaja võib näiteks proovida testimissüsteemist välja õngitseda võimalikult palju küsimusi; seetõttu on kasulik seada esitatavale küsimuste arvule mingi ülempiir. Võimalik on, et testimise eesmärk on saada teada, kas vastaja ületab mingi lävendi. Kui lävendi ületamise tõenäosus seniste vastuste põhjal on piisavalt väike, siis võib testimise lõpetada isegi kui võimekuse hinnang ei ole eriti täpne; kui aga võimekushinnang on lävendile väga lähedal, siis on ilmselt nõutav eriti väikse standardveaga hinnang.
Üksikvastuste teooriat on võimalik kasutada lihtsalt testi koostamise abivahendina, kasutades vastaja latentse omaduse hinnanguna edasi summaarskoori. Seda lähenemist ei saa täiesti hukka mõista, kuna summaarskoori arvutamiseks ei ole vaja eritarkvara (lihtsamal juhul piisab sõrmdedel loendamisest) ning kui mudel on valitud vähegi mõistlikult, siis on tulemus ÜVT mudeli põhjal arvutatuga väga sarnane. Kuid ÜVT skoori kasutamisel on siiski mõned eelised:
Kõigil nendel eelistel on mõnikord praktiline tähtsus. ÜVT mudeleid (peamiselt Raschi mudelit ning üldistatud osapunkti mudelit) kasutatakse palju näiteks PISA testis – see võimaldab hakkama saada väiksema hulga küsimustega, küsida eri vastajatelt mõnevõrra erinevaid küsimusi (mis aitab kaasa testi turvalisusele), ning seejures leida iga vastaja jaoks latentse omaduse (näiteks matemaatikavõimekuse või matemaatika-alase enesetõhususe) hinnangu. Teine geograafiliselt lähedane näide on TÜ akadeemilise võimekuse test, kus kasutatakse adaptiivset testimist. See võimaldab märkimisväärselt kokku hoida nii testijate kui ka tudengikandidaatide aega, sest igalt vastajalt on vaja küsida oluliselt vähem küsimusi.
Tasub tähele panna, et ÜVT skooride kasutamise eelduseks on õige mudeli kasutamine: mudelite eeldustest oli juttu eelmises peatükis. Nende eelduste hulgas on olulisel kohal mõõtmise invariantsus: see tähendab, küsimuste samaväärsed mõõtmisomadused kõigis gruppides. Seda eeldust on raske täielikult kontrolllida ning eelduse väike rikkumine ei pruugi mudeli rakendatavust hävitada (vt ptk 4 ja mõõtmise invariantsuse peatükk), seega kahjuks või õnneks on siin ruumi ad hoc subjektiivseteks otsustusteks.
Võrdleme isikuparameetrit \(\theta\) ja summaarskoori eri mudelite korral. Eespool oli juttu, et Raschi mudelis on kõigi küsimuste eristusvõime sama: seega võime eeldada üks-ühest seost \(\theta\) ja summaarskoori (nt õigete vastuste arvu) vahel. Jooniselt 12 on näha, et seos on tõepoolest üks-ühene, kuid mitte päris lineaarne. (Kuidas peaksid punktid paiknema joone suhtes perfektselt lineaarse seose korral?)
# label: fig-thetasumRasch
In <- paste0("i", 1:6)
ssi <- rowSums(df2[, In])
m1r <- mirt(df2[,In], itemtype="Rasch", verbose = FALSE)
fsm1 <- fscores(m1r)[, "F1"]
plot(fsm1, ssi, pch=16, col="red", ylab="Summaarskoor", xlab="Latentse omaduse väärtus Raschi mudeli põhjal", xlim = c(-1.5,1.5), ylim=c(0,6))
abline(lsfit(fsm1, ssi))
Kaheparameetrilises logistilises mudelis (joonis 13) võib küsimuste eristusvõime olla erinev ning seega on erinev ka õige vastuse väärtus: õige vastus hea eristusvõimega küsimusele loeb rohkem (on informatiivsem) kui õige vastus halva eristusvõimega küsimusele. Samas on ka kaheparameetrilise mudeli puhul muidugi olemas üks-ühene seos vastustemustri ja isikuparameetri vahel: samale vastustemustrile vastab alati sama isikuparameeter. Minimaalse (0) või maksimaalse (6) võimaliku õigete vastuste arvu saavutamiseks on ainult üks võimalus – vastata kas kõigile küsimustele vastavalt kas valesti või õigesti. Jooniselt näeme, et maksimaalsele ja minimaalsele võimalikule summaarskoorile vastab täpselt üks \(\theta\) väärtus. Kuuest küsimusest koosnevas testis on 6 erinevat võimalust vastata õigesti täpselt ühele küsimusele. Isikuparameetri leidmisel on oluline, millisele küsimusele õigesti vastati. Seda on täpsemalt kujutatud tabelis 8, kus on sama mudeli põhjal leitud \(\theta\) väärtused kõigi täpselt ühe õige vastusega vastamismustrite korral. Kui õigesti on vastatud ainult 4. küsimusele (eristusvõime parameeter 1,45), siis hindab mudel vastaja võimekuse väärtuseks -0,63, aga kui ainus õigesti vastatud küsimus on kolmas küsimus (0,43), siis leitakse \(\theta\) väärtuseks -1,13. Seega sama õigete vastuste arvu juures võib 2PL mudeli alusel leitud võimekuse hinnang olla küllalt erinev sõltuvalt sellest, millistele küsimustele on õigesti vastatud. Suurem kaal on parema eristusvõimega küsimustel.
# label: fig-thetasum2PL
m2r <- mirt(df2[,In], itemtype="2PL", verbose = FALSE)
fsm2 <- fscores(m2r)[,"F1"]
plot(fsm2, ssi, pch=16, col="red", ylab="Summaarskoor", xlab="Latentse omaduse väärtus 2PL mudeli põhjal")
abline(lsfit(fsm2, ssi))
# label: tbl-thetasum2PL
if(knitr::pandoc_to("docx")) knitr::kable(x = NULL, format = "html")
foo2 <- cbind(df2[, paste0("i", 1:6)], ssi, fsm2)
foo2 <- subset(foo2, ssi==1)
foo2 <- foo2[!duplicated(foo2),]
foo2 <- foo2[order(apply(foo2[,1:6], 1, \(x) which(x == 1))), ]
foo2 <- cbind(foo2, coef(m2r, simplify=TRUE, IRTpar=TRUE)$items[,1:2])
names(foo2) <- c(paste0("i", 1:6), "Summa", "theta", "a", "b")
foo2$theta <- round(foo2$theta,2)
foo2$a <- round(foo2$a,2)
foo2$b <- round(foo2$b,2)
qflextable(foo2)i1 | i2 | i3 | i4 | i5 | i6 | Summa | theta | a | b |
|---|---|---|---|---|---|---|---|---|---|
1 | 0 | 0 | 0 | 0 | 0 | 1 | -0,73 | 1,24 | 0,08 |
0 | 1 | 0 | 0 | 0 | 0 | 1 | -0,97 | 0,75 | -0,02 |
0 | 0 | 1 | 0 | 0 | 0 | 1 | -1,13 | 0,43 | 0,02 |
0 | 0 | 0 | 1 | 0 | 0 | 1 | -0,63 | 1,46 | 0,88 |
0 | 0 | 0 | 0 | 1 | 0 | 1 | -0,85 | 1,00 | 0,18 |
0 | 0 | 0 | 0 | 0 | 1 | 1 | -0,78 | 1,14 | -1,06 |
Nüüd võiks küsida, kumb lähenene on parem: kas kõigi küsimuste võrdne kohtlemine (nagu Raschi mudelis) või siis parema eristusvõimega küsimuste eelistamine (nagu 2PL mudelis)? Kui küsimuste eristusvõimed on tegelikult (empiiriliselt) võrdsed, siis see on tugev põhjus eelistada lihtsamat mudelit. Teine põhjus Raschi mudeli eelistamiseks võib olla teoreetiline: mõnel juhul on vaja anda kõigile küsimustele võrdne kaal isegi, kui ei ole suudetud koostada võrdselt häid küsimusi. Raschi mudeli eelistamine võib tuleneda ka vajadusest tagada IRT skoori üks-ühene teisendatavus summaarskooriks (nt õigete vastuste arv). Teiselt poolt: kui küsimused tegelikult ei ole sama eristusvõimega, siis üldjuhul tuleks seda asjaolu ka arvestada.
Küsimuse isikuparameetri täpsusest võib jagada kaheks. Kõigepealt on võimalik hinnata, kui hästi iga vastustemuster antud mudeliga sobib. Näiteks on ebatõenäoline, et keegi vastab õigesti väga raske küsimuse, kuid seejärel eksib mõne väga lihtsa küsimusega. Selline vastustemuster on ebatõenäoline, kuid ei ole võimatu: raske küsimuse õige vastus võis olla juhuslik tabamus ning lihtsa küsimuse vale vastus võis olla juhuslik möödalask. Kuid ebatõenäolise vastustemustri taga võib olla ka näiteks sihilik valesti vastamine, spikerdamine mõne üksiku küsimuse puhul vms. Seega isiku sobitusastme (person fit) indeksi alusel võime leida üles vastusemustrid, mis mudeli alusel on ebatõenäolised – kuid indeks ise ei ütle meile, mida sellisel juhul teha. Väga suur hulk väga madala isiku sobitusastmega vastajaid võib osutada viletsale mudelile või siis suurele petturite või hooletute vastajate hulgale valimis. Problemaatiline on ka väga madal sobitusastme väärtus mõne vastaja puhul. Sageli kasutatakse standardiseeritud sobitusastme indekseid, mille väärtus peaks olema võrreldav standardse normaaljaotusega. Selliste indeksite puhul võiks näiteks eeldada, et 1.96-st suurem absoluutväärtus ei esine sagedamini kui 5% juhtudest ning 2.6-st suurema absoluutväärtuse sagedus ei ole suurem kui 1%. Problemaatiline on mõistagi ebatõenäoliselt kehv sobitusaste; ebatõenäoluselt hea sobitusastmega on vähem sisulisi probleeme. Tabelis 9 on võimekuse näidisandmestiku kõige madalama isiku sobivusastmega vastusteread. Näeme, et madala sobitusastme tag on sageli näiteks õige vastus kõige raskemele küsimusele (i4) kombinatsioonis vale vastusega kõige kergemale küsimusele (i6). Rõhutame uuesti, et selline vastus pole tingimata vale, kuid see on lihtsalt ebatõenäoline.
if(knitr::pandoc_to("docx")) knitr::kable(x = NULL, format = "html")
# Zh statistiku kohta: Drasgow jt
# https://bpspsychub-onlinelibrary-wiley-com.ezproxy.utlib.ut.ee/doi/10.1111/j.2044-8317.1985.tb00817.x
Zh <- personfit(m2r)[,"Zh"]
df3 <- cbind(df2[,1:6], Zh)
df32 <- df3[order(df3$Zh),][1:10,]
df32 <- df32[!duplicated(df32),]
df32 <- data.frame(Vastaja=rownames(df32), df32)
df31 <- data.frame(Vastaja="(Raskusaste:)", as.data.frame(as.list(coef(m2r, simplify=TRUE, IRTpar=TRUE)$items[,2] |> round(2))), Zh=NA)
df3x <- rbind(df31, df32)
qflextable(df3x)Vastaja | i1 | i2 | i3 | i4 | i5 | i6 | Zh |
|---|---|---|---|---|---|---|---|
(Raskusaste:) | 0,08 | -0,02 | 0,02 | 0,88 | 0,18 | -1,06 | |
303 | 0,00 | 0,00 | 1,00 | 1,00 | 1,00 | 0,00 | -2,695992 |
435 | 0,00 | 1,00 | 0,00 | 1,00 | 1,00 | 0,00 | -2,639006 |
86 | 1,00 | 0,00 | 1,00 | 1,00 | 0,00 | 0,00 | -2,587465 |
219 | 0,00 | 0,00 | 0,00 | 1,00 | 1,00 | 0,00 | -2,546811 |
284 | 1,00 | 0,00 | 0,00 | 1,00 | 0,00 | 0,00 | -2,543262 |
336 | 1,00 | 1,00 | 0,00 | 1,00 | 0,00 | 0,00 | -2,442885 |
Teine individuaalse hinnangu täpsust iseloomustav näitaja on isikuparameetri \(\theta\) standardviga. Standardviga näitab, kui kindlad me saame olla, et vastaja tegelik võimekus (vm latentse omaduse väärtus) on lähedal mudeli põhjal saadud hinnangule. Standardvea põhjal saab arvutada näiteks 95% usalduspiirid (punkthinnang \(\pm 1.96 \times SE\)). Isikuparameetri standardviga on seotud eespool käsitletud informatiivsusega: mida suurem informatiivsus, seda väiksem standardviga. Joonisel 14 on kujutatud informatiivsuse ja isikuparameetri standardvea seos isikuparameetriga; tuginedes eespool kirjeldatule, kumba värvi joonega on joonisel tähistatud standardviga, kas punase või sinisega?
Z <- fscores(m2r, full.scores.SE = TRUE)
Z1 <- Z[order(Z[,1]),]
(plot(m2r, type="SE", xlim = c(-1.5, 1.5), ylim=c(0,2))$formula |> environment())$plt -> Z2
Z22 <- rbind(data.frame(what="Info", Theta = Z2$Theta, value = Z2$info), data.frame(what="Standardviga", Theta = Z2$Theta, value=Z2$SE))
#ggplot(Z2, aes(x=Theta, y = SE)) + geom_line(col="blue") + geom_line(aes(x=Theta, y = info, col="red"), show.legend=FALSE) + ylim(c(0,2)) + xlim(c(-3,3)) + theme_bw() + xlab(expression(theta)) + ylab("Info / Standardviga")
#plot(NA, xlim=c(-1.5,1.5), ylim=c(0,2))
#lines(Z1[,1], Z1[,2])
ggplot(Z22, aes(x=Theta, y = value, col =what)) + geom_line() +
ylim(c(0,2)) + xlim(c(-3,3)) + theme_bw() + xlab(expression(theta)) + theme(legend.title=element_blank(), legend.position=c(0.3,0.2)) +
ylab("")
Eelmises peatükis on juttu ühedimensioonilisuse eelduse kontrollimisest paralleelanalüüsi abil. Kuid paralleelanalüüsi rakendatavus on laiem: see on eelkõige mõeldud õige (või piisava) dimensioonide arvu määramiseks. Proovime paralleelanalüüsi kahel andmestikul:
res1 <- fa.parallel(df2, plot = FALSE)
ne <- psychTools::bfi[, c("N1", "N2", "N3", "N4", "N5", "E1", "E2", "E3", "E4", "E5")] |> na.omit()
res2 <- fa.parallel(ne, plot=FALSE)
res1 <- res1[ c("fa.values", "pc.values", "fa.sim", "pc.sim")] |> as.data.frame()
res1$no <- 1:nrow(res1)
res2 <- res2[ c("fa.values", "pc.values", "fa.sim", "pc.sim")] |> as.data.frame()
res2$no <- 1:nrow(res2)Joonisel 15 näeme, et punase katkendjoonega kujutatud juhuslikust tasemest on suurem omaväärtus täpselt kolmel faktoril. Praegusel juhul on see tehniliselt õige vastus, sest kuigi andmed on genereeritud kahe latentse tunnuse alusel, lisandub sellele kahe lähtetunnuse (j6 ja j7) korreleeritud viga. Kuna ka mõõtmisviga on latentne tunnus, siis ühiseid faktoreid on selles andmestikus tõepoolest kolm. Samas teame ka, et sisulises mõttes kolmas faktor meile huvi ei paku.
Et asja keerulisemaks ajada, siis paralleelanalüüsist on mitu versiooni, mille vahel tuleb valida. Näiteks tuleb otsustada, kas aluseks võtta peakomponendid või faktorid; millist faktorite eraldamise meetodit kasutada; kas kasutada juhuslike omaväärtuste leidmiseks algandmestiku juhuslikke permutatsioone või juhuslikult genereeritud mingi kindla jaotusega arve; kas võtta võrdlusaluseks juhuslike omaväärtuste keskmine või näiteks 95. või 99. protsentiil; kui palju juhuslikke andmestikke või permutatsioone tekitada. Siin ei saa ruumipuudusel kõiki neid nüansse käsitleda, kuid tasub teada, et erinevaid paralleelanalüüsi versioone on võimalik katsetada R-i lisamoodulis psych ning need võivad anda mõnevõrra erinevaid tulemusi (praeguse andmestikuga vahemikus 2-4).
Kuid kokkuvõttes on meil vaja jõuda ühese faktorite arvuni ning paralleelanalüüs ei anna alati täpset ega selget vastust, eriti arvestades eeltoodud valikuvõimalusi. Seega peaks arvestama järgmisi lisategureid:
##| fig-width: 12
##| fig-height: 6
#par(mfcol=1:2, mar = c(4,4,3,1), cex.axis=2, cex.main=2, cex=2 )
p1 <- ggplot(res1, aes(x=no, y = fa.values)) + geom_line() + geom_point() + geom_line(aes(x=no, y=fa.sim), col="red", lty="dotted") + theme_bw() + xlab("Faktorite arv") + ylab("Omaväärtused") + scale_x_continuous(breaks=1:14) #+ ggtitle("Võimekuse näidisandmestik")
p1
Isiksuse näidisandmestikuga on keerulisem, sest erinevalt juhuslikult genereeritud võimekuse andmetest ei ole siin õige dimensionaalsus ette teada. Vaatleme lihtsuse mõttes bfi väidetest ainult ekstravertsuse ja neurootilisuse väiteid - need kaks faktorit on tavaliselt paremini tuvastatavad kui näiteks sotsiaalsus ja avatus. Isiksuse viiefaktorilisele mudelile tuginedes võiksime eeldada kahefaktorilist lahendust, kuid on võimalikud ka näiteks madalama taseme faktorid, mida me ei pruugi puhtalt väidete sisu vaadates osata ette näha.
##| fig-width: 12
##| fig-height: 6
p2 <- ggplot(res2, aes(x=no, y = fa.values)) + geom_line() + geom_point() + geom_line(aes(x=no, y=fa.sim), col="red", lty="dotted") + theme_bw() + xlab("Faktorite arv") + ylab("Omaväärtused") + scale_x_continuous(breaks=1:14) #+ ggtitle("Isiksuse näidisandmestik (E, N)")
p2
Jooniselt 16 näeme, et IPIP-BFI neurootilisuse ja ekstravertsuse väidete kirjeldamiseks sobiks kolm dimensiooni. Uurime nüüd, kas need dimensioonid on sisuliselt tõlgendatavad: selleks kasutame eksploratiivset (uurivat) faktoranalüüsi (vt peatükist ##).
if(knitr::pandoc_to("docx")) knitr::kable(x = NULL, format = "html")
tn<-subset(bfi2, substr(Tunnus,1,1) %in% c("N", "E"))
tn <- tn[match(names(ne), tn$Tunnus),]
fan <- fa(ne, 3)
fanc <- fan$Phi[c(2,1,3), c(2,1,3)] |> round(2)
fan3 <- fan |> loadings() |> unclass() |> round(3) |> as.data.frame()
names(fan3) <- sub("MR", "F", names(fan3))
fan3 <- data.frame(Tunnus = rownames(fan3), Tõlge = tn$Tõlge, fan3[, c(2,1,3)])
qflextable(fan3)Tunnus | Tõlge | F1 | F2 | F3 |
|---|---|---|---|---|
N1 | Vihastan kergesti | 0,763 | -0,002 | 0,103 |
N2 | Ärritun kergesti | 0,840 | -0,045 | 0,016 |
N3 | Minu meeleolu muutub sageli | 0,241 | 0,099 | 0,626 |
N4 | Tunnen sageli kurbust | 0,024 | -0,168 | 0,626 |
N5 | Satun kergesti paanikasse | 0,043 | 0,005 | 0,560 |
E1 | Ei räägi palju | -0,075 | -0,597 | 0,025 |
E2 | Mul on raske teistele läheneda | 0,018 | -0,675 | 0,156 |
E3 | Tean, kuidas teisi kaasa haarata | -0,042 | 0,611 | 0,109 |
E4 | Leian kergesti sõpru | -0,137 | 0,720 | 0,093 |
E5 | Võtan vastutuse | 0,262 | 0,485 | -0,224 |
Tabelist 10 näeme, et kolm dimensiooni on sisuliselt tõlgendatavad, kuid neurootilisuse väited jagunevad kahe faktori vahel: esimesse faktorisse (F1) kuuluvad väited vihastamise ja ärritumise kohta, kolmandasse faktorisse (F3) väited kurbuse, paanika ja meeleolu muutlikkuse kohta. Nendele faktoritele võime panna nimeks näiteks vihastamine ja kurbus. Kõgigi ekstravertsuse väidete suurim faktorlaadung on teisel faktoril, kuid ekstravertsuse viies väide (“võtan vastutuse”) on seotud ka vihastamise ja kurbuse faktoritega (esimesega positiivselt, teisega negatiivselt).
Eelnevas analüüsis kasutasime kaldnurkset pööramist, seega on faktorid omavahel korreleeritud: 1. ja 3. faktori vaheline korrelatsioon on 0.63, 1. ja 2. vahel -0.1 ning 2. ja 3. vahel -0.32. Seega on võimalik õigustada ka kahefaktorilist lahendust, mis on paremas kooskõlas “suure viisiku” mudeliga; kinnitavas faktoranalüüsis võiksime sel juhul lisada viha küsimustele jääkkorrelatsiooni parameetri. (Kahe indikaatoriga vihastamise faktor ei ole kinnitava faktoranalüüsi mudelis hästi identifitseeritav ning on sisulise tõlgenduse küsimus, kas tegu on kahe tunnuse jääkkorrelatsiooniga või eraldi faktoriga.)
if(knitr::pandoc_to("docx")) knitr::kable(x = NULL, format = "html")
tn<-subset(bfi2, substr(Tunnus,1,1) %in% c("N", "E"))
tn <- tn[match(names(ne), tn$Tunnus),]
fan <- fa(ne, 2)
fanc2 <- fan$Phi |> round(2)
fan2 <- fan |> loadings() |> unclass() |> round(3) |> as.data.frame()
names(fan2) <- sub("MR", "F", names(fan2))
fan2 <- data.frame(Tunnus = rownames(fan2), Tõlge = tn$Tõlge, fan2)
qflextable(fan2)Tunnus | Tõlge | F1 | F2 |
|---|---|---|---|
N1 | Vihastan kergesti | 0,808 | 0,059 |
N2 | Ärritun kergesti | 0,783 | 0,037 |
N3 | Minu meeleolu muutub sageli | 0,745 | -0,011 |
N4 | Tunnen sageli kurbust | 0,519 | -0,296 |
N5 | Satun kergesti paanikasse | 0,494 | -0,112 |
E1 | Ei räägi palju | -0,084 | -0,618 |
E2 | Mul on raske teistele läheneda | 0,111 | -0,717 |
E3 | Tean, kuidas teisi kaasa haarata | 0,079 | 0,582 |
E4 | Leian kergesti sõpru | -0,023 | 0,675 |
E5 | Võtan vastutuse | 0,092 | 0,562 |
Nagu nimetuse järgi võib oletada, eristub mitmemõõtmeline ÜVT ühemõõtmeliselst selle poolest, et korraga hinnatakse mitut latentset muutujat. Proovime mitmemõõtmelist ÜVT mudelit võimekuse näidisandmestikuga; seekord saame analüüsi võtta korraga kõik tunnused, st ei ole vaja lähtuda ühemõõtmelisuse eeldusest. Küll aga on endiselt oluline selle eelduse üldistus: õige dimensionaalsuse eeldus.
Kuna teame, et vaimse võimekuse näidisandmestik on kahefaktoriline (eespool käsitletud mööndusega, st kui mitte pidada tunnuste J6 ja J7 jääkkorrelatsiooni eraldi latentseks tunnuseks), siis vaatleme kõigepealt kahefaktorilist 2PL mudelit. Praegu on tegu nn uuriva (eksploratiivse) ÜVT-ga, kus iga lähtetunnus on seotud iga faktoriga, kuid need seosed (faktorlaadungid) on erinevad. Selline mudel on idee poolest väga sarnane uuriva faktoranalüüsi mudeliga; kohati kattub terminoloogia (nt mõlemal juhul räägitakse faktorlaadungitest) ja meetodid (nt faktorite pööramiseks saab nii ÜVT-s kui uurivas faktoranalüüsis kasutada samu algoritme). Seetõttu tasub uurida, kui sarnased on ÜVT ja uuriva faktoranalüüsi tulemused.
if(knitr::pandoc_to("docx")) knitr::kable(x = NULL, format = "html")
m2pl2 <- mirt(df2, model=2, itemtype="2PL", verbose=FALSE)
m2pl2s <- summary(m2pl2, verbose=FALSE)
fl.irt <- m2pl2s$rotF |> round(3) |> as.data.frame()
fl.irt$h2 <- m2pl2s$h2 |> round(3)
fl.irt.cor <- m2pl2s$fcor[2,1] |> round(3)
faa <- fa(df2, 2, rotate="oblimin", cor="tet", fm = "ml")faa.cor <- faa$Phi[2,1] |> round(3)
faa.fl <- loadings(faa) |> unclass() |> round(3) |> as.data.frame()
faa.fl$h2 <- faa$communalities |> round(3)
tfl <- data.frame(Tunnus = rownames(fl.irt), fl.irt, faa.fl)
qtfl <- qflextable(tfl)
qtfl <- add_header_row(qtfl, values= c("", "ÜVT", "Faktoranalüüs"), colwidths=c(1,3,3), top=TRUE)
vline(qtfl, j=c(1, 4))ÜVT | Faktoranalüüs | |||||
|---|---|---|---|---|---|---|
Tunnus | F1 | F2 | h2 | ML1 | ML2 | h2.1 |
i1 | -0,030 | 0,591 | 0,339 | -0,034 | 0,590 | 0,338 |
i2 | -0,050 | 0,429 | 0,173 | -0,038 | 0,419 | 0,168 |
i3 | -0,021 | 0,258 | 0,064 | -0,026 | 0,275 | 0,073 |
i4 | -0,012 | 0,652 | 0,420 | -0,001 | 0,620 | 0,384 |
i5 | 0,004 | 0,496 | 0,248 | -0,012 | 0,515 | 0,262 |
i6 | 0,060 | 0,550 | 0,327 | 0,035 | 0,560 | 0,325 |
j1 | 0,695 | -0,011 | 0,478 | 0,551 | 0,107 | 0,347 |
j2 | 0,609 | 0,010 | 0,375 | 0,536 | 0,095 | 0,324 |
j3 | 0,516 | 0,034 | 0,278 | 0,480 | 0,099 | 0,266 |
j4 | 0,601 | 0,011 | 0,365 | 0,564 | 0,071 | 0,345 |
j5 | 0,429 | 0,013 | 0,188 | 0,344 | 0,068 | 0,135 |
j6 | 0,601 | -0,122 | 0,330 | 0,701 | -0,156 | 0,456 |
j7 | 0,538 | -0,073 | 0,271 | 0,636 | -0,121 | 0,378 |
j8 | 0,513 | 0,313 | 0,462 | 0,486 | 0,370 | 0,471 |
Tabelis 12 on ÜVT ja faktoranalüüsi tulemuste võrdlus: mõlema meetodi puhul on ära toodud faktorlaadungid (oblimin pööramine) ja kommunaliteedid. Näeme, et tulemused on väga sarnased, kuigi mitte identsed. Faktoritevaheline korrelatsioon oli vastavalt 0.315 ja 0.271; mõlemad arvud on küllalt lähedal sellele, mida andmete genereerimise skeemi põhjal võiks eeldada.
ÜVT faktorlaadungid on sõltumatud eespool käsitletud raskusastme parameetrist, kuid on üks-üheselt seotud eristusvõime parameetriga. Võib öelda, et faktorlaadung on lihtsalt eristusvõime parameeter teistes ühikutes väljendatuna. Mitmemõõtmelise mudeli puhul tasub tähele panna, et siin on ka eristusvõime parameetreid sama palju kui faktoreid, kuid raskusastme parameetreid endiselt üks. Kahe latentse tunnuse seost küsimuse i1 õige vastuse tõenäosusega illustreerib joonis 17. Muidugi peab ütlema, et kogu ilust hoolimata on selliselt kolmememõõtmeliselt jooniselt mingi sisulise tulemuse välja lugemine keeruline. Peamine on sellegipoolest näha: õige vastuse tõenäosus sõltub mittelineaarsel moel kahest latentsest tunnusest (\(\theta_1\) ja \(\theta_2\)), ühest rohkem ja teisest vähem.
fig.item1 <- itemplot(m2pl2, item=7, rot=list(xaxis=-90, yaxis=-70, zaxis=0)) #, rot = list(40,-30,10))
fig.item1$main <- ""
fig.item1$panel.args.common$zlab <- "ÕVT"
fig.item1$panel.args.common$scales.3d$z.scales$at <- seq(0,1,0.2)
fig.item1$panel.args.common$scales.3d$z.scales$labels <- c("0,0", "0,2", "0,4", "0,6", "0,8", "1,0")
fig.item1
Mitmemõõtmelise ÜVT puhul on nagu faktoranalüüsiski võimalik rääkida uurivast (exploratory) ja kinnitavast (confirmatory) ÜVT-st. Esimesel juhul annab uurija ette ainult andmed ja faktorite arvu ning algoritmi ülesandeks on leida selle andmestiku kirjeldamiseks sobivad latentsed tunnused (kusjuures iga algtunnus on erineval määral seotud iga latentse tunnusega); teisel juhul koostab uurija mudeli määrates, millised latentsed tunnused peavad seostuma millise vaadeldud tunnusega ning algoritmi ülesandeks on seda mudelit kontrollida.
Kuna ka kinnitava faktoranalüüsi programmid (nt Mplus ja R-i lisamoodul lavaan) saavad tänapäeval hakkama dihhotoomsete ja järjestustunnustega, siis ei olegi ÜVT ja kinnitava faktoranalüüsi vahel enam jäika vahet.
Võrdleme võimekuse näidisandmestikul kaht mudelit (ÜVT ja kinnitav faktoranalüüs), millele on ette antud samasugused tingimused: leida tuleb kaks latentset tunnust, kus esimene on seotud vaadeldud tunnustega i1-i6 ning j8, teine aga vaadeldud tunnustega j1-j8. See on sama skeem, mida näeme joonisel 1 - jätame esialgu välja vaid küsimuste j6 ja j7 vahelise jääkkorrelatsiooni.
if(knitr::pandoc_to("docx")) knitr::kable(x = NULL, format = "html")
mud.mirt <- mirt.model("I = 1-6, 14
J = 7-14
COV = I*J")
fit.mirt <- mirt(df2, model=mud.mirt, itemtype="2PL", verbose=FALSE)
fl3 <- summary(fit.mirt, verbose=FALSE)
fl3.cor <- fl3$fcor[1,2] |> round(3)
fl3 <- do.call(data.frame, fl3[c("rotF", "h2")]) |> round(3)
names(fl3) <- sub("rotF\\.", "", names(fl3))
fl3 <- data.frame(" " = rownames(fl3), fl3, check.names=FALSE)
qflextable(fl3)
| I | J | h2 |
|---|---|---|---|
i1 | 0,574 | 0,000 | 0,329 |
i2 | 0,407 | 0,000 | 0,166 |
i3 | 0,250 | 0,000 | 0,062 |
i4 | 0,650 | 0,000 | 0,422 |
i5 | 0,499 | 0,000 | 0,249 |
i6 | 0,580 | 0,000 | 0,336 |
j1 | 0,000 | 0,694 | 0,481 |
j2 | 0,000 | 0,620 | 0,385 |
j3 | 0,000 | 0,533 | 0,284 |
j4 | 0,000 | 0,606 | 0,367 |
j5 | 0,000 | 0,431 | 0,186 |
j6 | 0,000 | 0,543 | 0,295 |
j7 | 0,000 | 0,504 | 0,254 |
j8 | 0,337 | 0,541 | 0,407 |
Joonis 18 kujutab küsimuse j1 õige vastuse tõenäosuse seost kahe latentse muutujaga. Ka siit on raske välja lugeda midagi rohkemat, kui et õige vastuse tõenäosus on seotud \(\theta_2\)-ga üsna tugevalt ning \(\theta_1\)-ga ei tundu seost olevat.
ip <- itemplot(fit.mirt, item=7, rot=list(xaxis=-90, yaxis=-70, zaxis=0))
ip$main <- ""
ip$zlab <- "ÕVT"
ip$panel.args.common$scales.3d$z.scales$at <- seq(0,1,0.2)
ip$panel.args.common$scales.3d$z.scales$labels <- c("0,0", "0,2", "0,4", "0,6", "0,8", "1,0")
ip$legend <- NULL
ip
Lõpuks teeme samade piirangutega analüüsi läbi ka kinnitava faktoranalüüsi abil. Hinnatud mudeli parameetrid on näha tabelis 14. Ridades 1-7 on esimese faktori (I) laadungid, mis on võrreldavad esimese arvutulbaga tabelis 13, ridades 8-15 on teise faktori laadungid (J), mis on võrreldavad tabeli 13 teise arvutulbaga. Viimane parameeter (16. rida) näitab faktoritevahelist korrelatsiooni. Kokkuvõttes, tulemused on väga sarnased ja see ongi ootuspärane, sest lähteülesanne ja andmed on mõlemal juhul samad ning mõlemad meetodid saavad hakkama latentse tunnuse ja vaadeldud tunnuse vahelise mittelineaarse seosega. Kumba meetodit eelistada, sõltub eesmärgist ja edasistest plaanidest.
ÜVT puhul on rohkem võimalusi faktori ja vaadeldud tunnuse vahelise seose modelleerimiseks: näiteks saab mudelile kergesti lisada mõistatamise parameetri (3PL) või ülemise asümptoodi (4PL).
Kinnitavas faktoranalüüsis on rohkem võimalusi mudeli ad hoc täiendamiseks (näiteks modifitseerimisindeksite põhjal), samuti saab mudelit kasutada suurema struktuurivõrrandite mudeli koosseisus nn mõõtmismudelina.
if(knitr::pandoc_to("docx")) knitr::kable(x = NULL, format = "html")
lavmud <- sem("I =~ NA*i1+i2+i3+i4+i5+i6+j8
J =~ NA*j1 + j2 + j3 +j4+j5+j6+j7+j8
I~~1*I
J~~1*J", df2, ordered=TRUE)
fl.lavaan <- summary(lavmud)$pe[c(1:15,46),]
fl.lavaan$coef <- with(fl.lavaan, paste0(lhs,op,rhs))
fl.lavaan <- fl.lavaan[, c(9, 5:8)]
fl.lavaan[, 2:4]<- round(fl.lavaan[,2:4],3)
fl.lavaan$pvalue <- round(fl.lavaan$pvalue,6)
names(fl.lavaan) <- c("Parameeter", "Väärtus", "Standardviga", "z", "p")
fl.lavaan <- data.frame(" " = 1:nrow(fl.lavaan), fl.lavaan, check.names=FALSE)
qflextable(fl.lavaan)
| Parameeter | Väärtus | Standardviga | z | p |
|---|---|---|---|---|---|
1 | I=~i1 | 0,579 | 0,047 | 12,371 | 0,000000 |
2 | I=~i2 | 0,411 | 0,050 | 8,162 | 0,000000 |
3 | I=~i3 | 0,259 | 0,052 | 4,960 | 0,000001 |
4 | I=~i4 | 0,650 | 0,052 | 12,529 | 0,000000 |
5 | I=~i5 | 0,515 | 0,049 | 10,581 | 0,000000 |
6 | I=~i6 | 0,585 | 0,048 | 12,160 | 0,000000 |
7 | I=~j8 | 0,321 | 0,052 | 6,186 | 0,000000 |
8 | J=~j1 | 0,657 | 0,054 | 12,058 | 0,000000 |
9 | J=~j2 | 0,616 | 0,045 | 13,639 | 0,000000 |
10 | J=~j3 | 0,549 | 0,043 | 12,701 | 0,000000 |
11 | J=~j4 | 0,606 | 0,045 | 13,506 | 0,000000 |
12 | J=~j5 | 0,399 | 0,061 | 6,513 | 0,000000 |
13 | J=~j6 | 0,521 | 0,052 | 10,081 | 0,000000 |
14 | J=~j7 | 0,487 | 0,060 | 8,125 | 0,000000 |
15 | J=~j8 | 0,521 | 0,048 | 10,815 | 0,000000 |
16 | I~~J | 0,290 | 0,055 | 5,258 | 0,000000 |
save(list=ls(all.names = TRUE), file="IRT2.rda")
if(FALSE){
# run this to "tangle" the code in this chapter
knit("IRT2.qmd", tangle=TRUE)
}
# noquote(readLines("Simulatsioonid.R"))