psychotools/0000755000176200001440000000000015143126103012634 5ustar liggesuserspsychotools/tests/0000755000176200001440000000000013277172617014017 5ustar liggesuserspsychotools/tests/Examples/0000755000176200001440000000000014413771404015565 5ustar liggesuserspsychotools/tests/Examples/psychotools-Ex.Rout.save0000644000176200001440000030521715143115724022343 0ustar liggesusers R version 4.5.0 (2025-04-11) -- "How About a Twenty-Six" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > pkgname <- "psychotools" > source(file.path(R.home("share"), "R", "examples-header.R")) > options(warn = 1) > library('psychotools') > > base::assign(".oldSearch", base::search(), pos = 'CheckExEnv') > base::assign(".old_wd", base::getwd(), pos = 'CheckExEnv') > cleanEx() > nameEx("ConspiracistBeliefs2016") > ### * ConspiracistBeliefs2016 > > flush(stderr()); flush(stdout()) > > ### Name: ConspiracistBeliefs2016 > ### Title: Generic Conspiracist Beliefs Scale (2016 Data) > ### Aliases: ConspiracistBeliefs2016 > ### Keywords: datasets > > ### ** Examples > > ## overview > data("ConspiracistBeliefs2016", package = "psychotools") > str(ConspiracistBeliefs2016) 'data.frame': 2449 obs. of 3 variables: $ resp : num [1:2449, 1:15] 4 1 4 4 0 3 4 0 0 3 ... ..- attr(*, "dimnames")=List of 2 .. ..$ : NULL .. ..$ : chr [1:15] "q1" "q2" "q3" "q4" ... $ area : Factor w/ 3 levels "rural","suburban",..: 2 2 1 2 1 2 1 3 3 2 ... $ gender: Factor w/ 3 levels "male","female",..: 2 2 1 1 1 1 1 1 1 3 ... > > ## response > plot(itemresp(ConspiracistBeliefs2016$resp)) > ## covariates > summary(ConspiracistBeliefs2016[, -1]) area gender rural : 475 male :1204 suburban:1124 female:1117 urban : 850 other : 128 > > > > cleanEx() > nameEx("FirstNames") > ### * FirstNames > > flush(stderr()); flush(stdout()) > > ### Name: FirstNames > ### Title: Popularity of First Names > ### Aliases: FirstNames > ### Keywords: datasets > > ### ** Examples > > data("FirstNames", package = "psychotools") > summary(FirstNames$preference) > < Tim : Lucas 87 105 Tim : Michael 103 89 Lucas : Michael 112 80 Tim : Robin 125 67 Lucas : Robin 129 63 Michael : Robin 106 86 Tim : Benedikt 140 52 Lucas : Benedikt 146 46 Michael : Benedikt 129 63 Robin : Benedikt 127 65 Tim : Julius 109 83 Lucas : Julius 120 72 Michael : Julius 103 89 Robin : Julius 95 97 Benedikt : Julius 73 119 > covariates(FirstNames$preference) vowel Tim front Lucas back Michael front Robin back Benedikt front Julius back > > > > cleanEx() > nameEx("GermanParties2009") > ### * GermanParties2009 > > flush(stderr()); flush(stdout()) > > ### Name: GermanParties2009 > ### Title: Choice among German Political Parties > ### Aliases: GermanParties2009 > ### Keywords: datasets > > ### ** Examples > > data("GermanParties2009", package = "psychotools") > summary(GermanParties2009$preference) > < none : Linke 119 73 none : Gruene 25 167 Linke : Gruene 23 169 none : SPD 38 154 Linke : SPD 34 158 Gruene : SPD 124 68 none : CDU/CSU 69 123 Linke : CDU/CSU 76 116 Gruene : CDU/CSU 128 64 SPD : CDU/CSU 125 67 none : FDP 83 109 Linke : FDP 70 122 Gruene : FDP 137 55 SPD : FDP 134 58 CDU/CSU : FDP 106 86 > > > > cleanEx() > nameEx("MathExam14W") > ### * MathExam14W > > flush(stderr()); flush(stdout()) > > ### Name: MathExam14W > ### Title: Mathematics 101 Exam Results > ### Aliases: MathExam14W > ### Keywords: datasets > > ### ** Examples > > ## load data and exclude extreme scorers > data("MathExam14W", package = "psychotools") > MathExam14W <- transform(MathExam14W, + points = 2 * nsolved - 0.5 * rowSums(credits == 1) + ) > me <- subset(MathExam14W, nsolved > 0 & nsolved < 13) > > > ## item response data: > ## solved (correct/other) or credits (correct/incorrect/not attempted) > par(mfrow = c(1, 2)) > plot(me$solved) > plot(me$credits) > > ## PCA > pr <- prcomp(me$solved, scale = TRUE) > names(pr$sdev) <- 1:10 > plot(pr, main = "", xlab = "Number of components") > biplot(pr, col = c("transparent", "black"), main = "", + xlim = c(-0.065, 0.005), ylim = c(-0.04, 0.065)) > > > ## points achieved (and 50% threshold) > par(mfrow = c(1, 1)) > hist(MathExam14W$points, breaks = -4:13 * 2 + 0.5, + col = "lightgray", main = "", xlab = "Points") > abline(v = 12.5, lwd = 2, col = 2) > > > ## Rasch and partial credit model > ram <- raschmodel(me$solved) > pcm <- pcmodel(me$credits) > > ## various types of graphics displays > plot(ram, type = "profile") > plot(pcm, type = "profile", add = TRUE, col = "blue") > plot(ram, type = "piplot") > plot(pcm, type = "piplot") > plot(ram, type = "region") > plot(pcm, type = "region") > plot(ram, type = "curves") > plot(pcm, type = "curves") > > > > > > graphics::par(get("par.postscript", pos = 'CheckExEnv')) > cleanEx() > nameEx("MemoryDeficits") > ### * MemoryDeficits > > flush(stderr()); flush(stdout()) > > ### Name: MemoryDeficits > ### Title: Memory Deficits in Psychiatric Patients > ### Aliases: MemoryDeficits > ### Keywords: datasets > > ### ** Examples > > data("MemoryDeficits", package = "psychotools") > aggregate(cbind(E1, E2, E3, E4) ~ trial + group, MemoryDeficits, sum) trial group E1 E2 E3 E4 1 1 Schizo 31 15 154 380 2 2 Schizo 79 45 163 293 3 3 Schizo 127 63 160 230 4 4 Schizo 148 74 149 209 5 5 Schizo 176 73 152 179 6 6 Schizo 198 67 138 177 7 1 SchizoCtl 49 31 149 271 8 2 SchizoCtl 116 66 151 167 9 3 SchizoCtl 190 66 136 108 10 4 SchizoCtl 243 68 108 81 11 5 SchizoCtl 269 77 81 73 12 6 SchizoCtl 301 76 71 52 13 1 OrganicAlc 20 9 91 300 14 2 OrganicAlc 34 18 102 266 15 3 OrganicAlc 43 30 102 245 16 4 OrganicAlc 57 25 114 224 17 5 OrganicAlc 58 35 98 229 18 6 OrganicAlc 65 29 100 226 19 1 AlcCtl 45 24 97 254 20 2 AlcCtl 106 41 107 166 21 3 AlcCtl 171 40 110 99 22 4 AlcCtl 202 50 79 89 23 5 AlcCtl 217 64 69 70 24 6 AlcCtl 243 64 65 48 > > > > cleanEx() > nameEx("PairClustering") > ### * PairClustering > > flush(stderr()); flush(stdout()) > > ### Name: PairClustering > ### Title: Pair Clustering Data in Klauer (2006) > ### Aliases: PairClustering > ### Keywords: datasets > > ### ** Examples > > data("PairClustering", package = "psychotools") > aggregate(cbind(E1, E2, E3, E4, F1, F2) ~ trial, PairClustering, sum) trial E1 E2 E3 E4 F1 F2 1 1 80 10 122 418 65 250 2 2 171 32 122 305 111 204 > > > > cleanEx() > nameEx("Sim3PL") > ### * Sim3PL > > flush(stderr()); flush(stdout()) > > ### Name: Sim3PL > ### Title: Simulated Data for fitting a 3PL and 3PLu > ### Aliases: Sim3PL > ### Keywords: datasets > > ### ** Examples > > ## overview > data("Sim3PL", package = "psychotools") > str(Sim3PL) 'data.frame': 10000 obs. of 2 variables: $ resp : num [1:10000, 1:10] 1 1 1 1 0 1 0 1 0 0 ... ..- attr(*, "dimnames")=List of 2 .. ..$ : NULL .. ..$ : chr [1:10] "I01" "I02" "I03" "I04" ... $ resp2: num [1:10000, 1:10] 1 0 0 0 0 0 1 0 0 1 ... ..- attr(*, "dimnames")=List of 2 .. ..$ : NULL .. ..$ : chr [1:10] "I01" "I02" "I03" "I04" ... > > ## data generation > M <- 10000 > N <- 10 > > ## 3PL scenario > set.seed(277) > theta <- rnorm(M, 0, 1) > a <- rlnorm(N, 0, 0.25) > b <- rnorm(N, 0, 1) > g <- runif(N, 0.1, 0.2) > u <- rep(1, N) > probs <- matrix(g, M, N, byrow = TRUE) + matrix(u - g, M, N, byrow = TRUE) * + plogis(matrix(a, M, N, byrow = TRUE) * outer(theta, b, "-")) > resp <- (probs > matrix(runif(M * N, 0, 1), M, N)) + 0 > all.equal(resp, Sim3PL$resp, check.attributes = FALSE) [1] TRUE > > ## 3PLu scenario > set.seed(167) > theta <- rnorm(M, 0, 1) > a <- rlnorm(N, 0, 0.25) > b <- rnorm(N, 0, 1) > g <- rep(0, N) > u <- runif(N, 0.8, 0.9) > probs <- matrix(g, M, N, byrow = TRUE) + matrix(u - g, M, N, byrow = TRUE) * + plogis(matrix(a, M, N, byrow = TRUE) * outer(theta, b, "-")) > resp2 <- (probs > matrix(runif(M * N, 0, 1), M, N)) + 0 > all.equal(resp2, Sim3PL$resp2, check.attributes = FALSE) [1] TRUE > > > > cleanEx() > nameEx("SoundQuality") > ### * SoundQuality > > flush(stderr()); flush(stdout()) > > ### Name: SoundQuality > ### Title: Quality of Multichannel Reproduced Sound > ### Aliases: SoundQuality > ### Keywords: datasets > > ### ** Examples > > data("SoundQuality", package = "psychotools") > summary(SoundQuality$preference) > < Mono : PhantomMono 268 515 Mono : Stereo 46 737 PhantomMono : Stereo 85 698 Mono : WideStereo 94 689 PhantomMono : WideStereo 126 657 Stereo : WideStereo 468 315 Mono : Matrix 65 718 PhantomMono : Matrix 99 684 Stereo : Matrix 391 392 WideStereo : Matrix 358 425 Mono : Upmix1 65 718 PhantomMono : Upmix1 104 679 Stereo : Upmix1 443 340 WideStereo : Upmix1 394 389 Matrix : Upmix1 411 372 Mono : Upmix2 81 702 PhantomMono : Upmix2 142 641 Stereo : Upmix2 504 279 WideStereo : Upmix2 436 347 Matrix : Upmix2 458 325 Upmix1 : Upmix2 432 351 Mono : Original 61 722 PhantomMono : Original 101 682 Stereo : Original 399 384 WideStereo : Original 369 414 Matrix : Original 381 402 Upmix1 : Original 373 410 Upmix2 : Original 333 450 > ftable(xtabs(~ time + repet + progmat, data = SoundQuality)) progmat Beethoven Rachmaninov SteelyDan Sting time repet before 1 39 39 40 39 2 39 39 40 39 3 39 39 40 39 after 1 39 39 39 39 2 39 39 39 39 3 0 0 0 0 > > > > cleanEx() > nameEx("SourceMonitoring") > ### * SourceMonitoring > > flush(stderr()); flush(stdout()) > > ### Name: SourceMonitoring > ### Title: Performance in a Source-Monitoring Experiment > ### Aliases: SourceMonitoring > ### Keywords: datasets > > ### ** Examples > > data("SourceMonitoring", package = "psychotools") > xtabs(~ gender + I(age >= 30) + sources, SourceMonitoring) , , sources = think-say I(age >= 30) gender FALSE TRUE female 16 16 male 16 16 , , sources = write-say I(age >= 30) gender FALSE TRUE female 16 16 male 16 16 > > > > cleanEx() > nameEx("StereotypeThreat") > ### * StereotypeThreat > > flush(stderr()); flush(stdout()) > > ### Name: StereotypeThreat > ### Title: Stereotype Threat in Dutch Differential Aptitude Test > ### Aliases: StereotypeThreat > ### Keywords: datasets > > ### ** Examples > > ## Data: Load and include/order wrt group variable > data("StereotypeThreat", package = "psychotools") > StereotypeThreat <- transform(StereotypeThreat, group = interaction(ethnicity, condition)) > StereotypeThreat <- StereotypeThreat[order(StereotypeThreat$group),] > > ## Exploratory analysis (Table 2, p. 703) > tab2 <- with(StereotypeThreat, rbind( + "#" = tapply(numerical, group, length), + "Numerical" = tapply(numerical, group, mean), + " " = tapply(numerical, group, sd), + "Abstract " = tapply(abstract, group, mean), + " " = tapply(abstract, group, sd), + "Verbal " = tapply(verbal, group, mean), + " " = tapply(verbal, group, sd))) > round(tab2, digits = 2) majority.control minority.control majority.threat minority.threat # 79.00 65.00 78.00 73.00 Numerical 5.35 4.88 5.49 4.67 2.54 2.47 2.31 2.52 Abstract 10.42 6.80 9.24 7.34 2.96 3.33 3.34 2.83 Verbal 7.27 5.37 6.65 5.56 3.01 2.82 3.47 2.70 > > ## Corresponding boxplots > plot(numerical ~ group, data = StereotypeThreat) > plot(abstract ~ group, data = StereotypeThreat) > plot(verbal ~ group, data = StereotypeThreat) > > ## MANOVA (p. 703) > m <- lm(cbind(numerical, abstract, verbal) ~ ethnicity * condition, data = StereotypeThreat) > anova(m, update(m, . ~ . - ethnicity:condition)) Analysis of Variance Table Model 1: cbind(numerical, abstract, verbal) ~ ethnicity * condition Model 2: cbind(numerical, abstract, verbal) ~ ethnicity + condition Res.Df Df Gen.var. Pillai approx F num Df den Df Pr(>F) 1 291 7.5292 2 292 1 7.5714 0.026692 2.6419 3 289 0.04961 * --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 > ## corresponding univariate results > printCoefmat(t(sapply(summary(m), + function(x) x$coefficients["ethnicityminority:conditionthreat", ]))) Estimate Std. Error t value Pr(>|t|) Response numerical -0.33844 0.57424 -0.5894 0.55607 Response abstract 1.71660 0.72798 2.3580 0.01903 * Response verbal 0.80439 0.70783 1.1364 0.25672 --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 > > ## MGCFA (Table 3, p. 704) > ## can be replicated using package lavaan > ## Not run: > ##D ## convenience function for multi-group CFA on this data > ##D mgcfa <- function(model, ...) cfa(model, data = StereotypeThreat, > ##D group = "group", likelihood = "wishart", start = "simple", ...) > ##D > ##D ## list of all 9 models > ##D m <- vector("list", length = 9) > ##D names(m) <- c("m2", "m2a", "m3", "m3a", "m4", "m5", "m5a", "m5b", "m6") > ##D > ##D ## Step 2: Fix loadings across groups > ##D f <- 'ability =~ abstract + verbal + numerical' > ##D m$m2 <- mgcfa(f, group.equal = "loadings") > ##D > ##D ## Step 2a: Free numerical loading in group 4 (minority.threat) > ##D f <- 'ability =~ abstract + verbal + c(l1, l1, l1, l4) * numerical' > ##D m$m2a <- mgcfa(f, group.equal = "loadings") > ##D > ##D ## Step 3: Fix variances across groups > ##D m$m3 <- mgcfa(f, group.equal = c("loadings", "residuals")) > ##D > ##D ## Step 3a: Free numerical variance in group 4 > ##D f <- c(f, 'numerical ~~ c(e1, e1, e1, e4) * numerical') > ##D m$m3a <- mgcfa(f, group.equal = c("loadings", "residuals")) > ##D > ##D ## Step 4: Fix latent variances within conditions > ##D f <- c(f, 'ability ~~ c(vmaj, vmin, vmaj, vmin) * ability') > ##D m$m4 <- mgcfa(f, group.equal = c("loadings", "residuals")) > ##D > ##D ## Step 5: Fix certain means, free others > ##D f <- c(f, 'numerical ~ c(na1, na1, na1, na4) * 1') > ##D m$m5 <- mgcfa(f, group.equal = c("loadings", "residuals", "intercepts")) > ##D > ##D ## Step 5a: Free ability mean in group majority.control > ##D f <- c(f, 'abstract ~ c(ar1, ar2, ar2, ar2) * 1') > ##D m$m5a <- mgcfa(f, group.equal = c("loadings", "residuals", "intercepts")) > ##D > ##D ## Step 5b: Free also ability mean in group minority.control > ##D f <- c(f[1:4], 'abstract ~ c(ar1, ar2, ar3, ar3) * 1') > ##D m$m5b <- mgcfa(f, group.equal = c("loadings", "residuals", "intercepts")) > ##D > ##D ## Step 6: Different latent mean structure > ##D f <- c(f, 'ability ~ c(maj, min, maj, min) * 1 + c(0, NA, 0, NA) * 1') > ##D m$m6 <- mgcfa(f, group.equal = c("loadings", "residuals", "intercepts")) > ##D > ##D ## Extract measures of fit > ##D tab <- t(sapply(m, fitMeasures, c("chisq", "df", "pvalue", "rmsea", "cfi"))) > ##D tab <- rbind("1" = c(0, 0, 1, 0, 1), tab) > ##D tab <- cbind(tab, > ##D delta_chisq = c(NA, abs(diff(tab[, "chisq"]))), > ##D delta_df = c(NA, diff(tab[, "df"]))) > ##D tab <- cbind(tab, "pvalue2" = pchisq(tab[, "delta_chisq"], > ##D abs(tab[, "delta_df"]), lower.tail = FALSE)) > ##D tab <- tab[, c(2, 1, 3, 7, 6, 8, 4, 5)] > ##D round(tab, digits = 3) > ## End(Not run) > > > > cleanEx() > nameEx("VerbalAggression") > ### * VerbalAggression > > flush(stderr()); flush(stdout()) > > ### Name: VerbalAggression > ### Title: Situation-Response Questionnaire on Verbal Aggression > ### Aliases: VerbalAggression > ### Keywords: datasets > > ### ** Examples > > data("VerbalAggression", package = "psychotools") > > ## Rasch model for the self-to-blame situations > m <- raschmodel(VerbalAggression$resp2[, 1:12]) > plot(m) > > ## IGNORE_RDIFF_BEGIN > summary(m) Rasch model Difficulty parameters: Estimate Std. Error z value Pr(>|z|) S1DoCurse -1.556e-08 2.042e-01 0.000 1.00000 S1WantScold 6.857e-01 1.995e-01 3.436 0.00059 *** S1DoScold 8.727e-01 1.994e-01 4.376 1.21e-05 *** S1WantShout 1.208e+00 2.003e-01 6.032 1.62e-09 *** S1DoShout 2.294e+00 2.131e-01 10.766 < 2e-16 *** S2WantCurse -5.393e-01 2.135e-01 -2.527 0.01152 * S2DoCurse 3.614e-01 2.009e-01 1.799 0.07200 . S2WantScold 5.345e-01 2.000e-01 2.673 0.00753 ** S2DoScold 1.359e+00 2.012e-01 6.755 1.42e-11 *** S2WantShout 1.283e+00 2.007e-01 6.395 1.61e-10 *** S2DoShout 3.067e+00 2.343e-01 13.088 < 2e-16 *** --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 Log-likelihood: -1255 (df = 11) Number of iterations in BFGS optimization: 19 > ## IGNORE_RDIFF_END > > > > cleanEx() > nameEx("YouthGratitude") > ### * YouthGratitude > > flush(stderr()); flush(stdout()) > > ### Name: YouthGratitude > ### Title: Measuring Gratitude in Youth > ### Aliases: YouthGratitude > ### Keywords: datasets > > ### ** Examples > > data("YouthGratitude", package = "psychotools") > head(YouthGratitude) id age agegroup gq6_1 gq6_2 gq6_3 gq6_4 gq6_5 gq6_6 gac_1 gac_2 gac_3 losd_1 1 18 10 10-11 6 5 3 6 5 5 3 3 4 9 2 33 10 10-11 6 7 7 7 5 6 2 3 3 8 3 36 10 10-11 7 7 6 7 7 7 5 5 5 9 4 49 10 10-11 7 6 7 6 6 5 5 5 5 9 5 54 10 10-11 6 6 6 6 6 6 4 4 4 8 6 61 10 10-11 7 7 6 7 7 4 4 5 5 9 losd_2 losd_3 losd_4 losd_5 losd_6 sa_1 sa_2 sa_3 sa_4 sa_5 sa_6 ao_1 ao_2 1 5 4 5 6 2 8 7 9 4 7 7 7 7 2 3 1 1 1 1 6 3 1 2 5 6 9 7 3 1 1 1 1 3 9 1 9 5 9 9 9 9 4 4 1 1 1 3 9 5 9 1 9 8 9 9 5 7 7 5 5 7 8 7 6 5 6 8 9 8 6 2 4 8 9 5 4 3 5 7 8 8 8 8 ao_3 ao_4 1 8 6 2 5 6 3 9 9 4 9 9 5 6 7 6 7 5 > > ## modeling can be carried out using package lavaan > ## Not run: > ##D ## remove cases with 'imputed' values (not in 1, ..., 9) > ##D yg <- YouthGratitude[apply(YouthGratitude[, 4:28], 1, function(x) all(x ##D > ##D > ##D ## GQ-6 > ##D gq6_congeneric <- cfa( > ##D 'f1 =~ gq6_1 + gq6_2 + gq6_3 + gq6_4 + gq6_5', > ##D data = yg, group = "agegroup", meanstructure = TRUE) > ##D gq6_tauequivalent <- cfa( > ##D 'f1 =~ gq6_1 + gq6_2 + gq6_3 + gq6_4 + gq6_5', > ##D data = yg, group = "agegroup", meanstructure = TRUE, > ##D group.equal = "loadings") > ##D gq6_parallel <- cfa( > ##D 'f1 =~ gq6_1 + gq6_2 + gq6_3 + gq6_4 + gq6_5', > ##D data = yg, group = "agegroup", meanstructure = TRUE, > ##D group.equal = c("loadings", "residuals", "lv.variances")) > ##D anova(gq6_congeneric, gq6_tauequivalent, gq6_parallel) > ##D t(sapply( > ##D list(gq6_congeneric, gq6_tauequivalent, gq6_parallel), > ##D function(m) fitMeasures(m)[c("chisq", "df", "cfi", "srmr")] > ##D )) > ##D > ##D ## GAC > ##D gac_congeneric <- cfa( > ##D 'f1 =~ gac_1 + gac_2 + gac_3', > ##D data = yg, group = "agegroup", meanstructure = TRUE) > ##D gac_tauequivalent <- cfa( > ##D 'f1 =~ gac_1 + gac_2 + gac_3', > ##D data = yg, group = "agegroup", meanstructure = TRUE, > ##D group.equal = "loadings") > ##D gac_parallel <- cfa( > ##D 'f1 =~ gac_1 + gac_2 + gac_3', > ##D data = yg, group = "agegroup", meanstructure = TRUE, > ##D group.equal = c("loadings", "residuals", "lv.variances")) > ##D anova(gac_congeneric, gac_tauequivalent, gac_parallel) > ##D t(sapply( > ##D list(gac_congeneric, gac_tauequivalent, gac_parallel), > ##D function(m) fitMeasures(m)[c("chisq", "df", "cfi", "srmr")] > ##D )) > ##D > ##D ## GRAT > ##D grat_congeneric <- cfa( > ##D 'f1 =~ losd_2 + losd_3 + losd_4 + losd_5 + losd_6 > ##D f2 =~ sa_1 + sa_2 + sa_3 + sa_4 + sa_5 + sa_6 > ##D f3 =~ ao_1 + ao_2 + ao_3 + ao_4', > ##D data = yg, group = "agegroup", meanstructure = TRUE) > ##D grat_tauequivalent <- cfa( > ##D 'f1 =~ losd_2 + losd_3 + losd_4 + losd_5 + losd_6 > ##D f2 =~ sa_1 + sa_2 + sa_3 + sa_4 + sa_5 + sa_6 > ##D f3 =~ ao_1 + ao_2 + ao_3 + ao_4', > ##D data = yg, group = "agegroup", meanstructure = TRUE, > ##D group.equal = "loadings") > ##D grat_parallel <- cfa( > ##D 'f1 =~ losd_2 + losd_3 + losd_4 + losd_5 + losd_6 > ##D f2 =~ sa_1 + sa_2 + sa_3 + sa_4 + sa_5 + sa_6 > ##D f3 =~ ao_1 + ao_2 + ao_3 + ao_4', > ##D data = yg, group = "agegroup", meanstructure = TRUE, > ##D group.equal = c("loadings", "residuals", "lv.variances")) > ##D anova(grat_congeneric, grat_tauequivalent, grat_parallel) > ##D t(sapply( > ##D list(grat_congeneric, grat_tauequivalent, grat_parallel), > ##D function(m) fitMeasures(m)[c("chisq", "df", "cfi", "srmr")] > ##D )) > ## End(Not run) > > > > cleanEx() > nameEx("anchor") > ### * anchor > > flush(stderr()); flush(stdout()) > > ### Name: anchor > ### Title: Anchor Methods for the Detection of Uniform DIF the Rasch Model > ### Aliases: anchor anchor.default anchor.formula print.anchor > ### print.summary.anchor summary.anchor > ### Keywords: regression > > ### ** Examples > > ## Verbal aggression data > data("VerbalAggression", package = "psychotools") > > ## Gini anchor (Strobl et al. 2021) for gender DIF in the self-to-blame situations > anchor(resp2[, 1:12] ~ gender , data = VerbalAggression) Anchor selection with Gini criterion and constant length 1 Anchor item: `resp2[, 1:12]`S1WantCurse > > ## alternatively: based on fitted raschmodel objects > raschmodels <- with(VerbalAggression, lapply(levels(gender), function(i) + raschmodel(resp2[gender == i, 1:12]))) > anchor(raschmodels[[1]], raschmodels[[2]]) Anchor selection with Gini criterion and constant length 1 Anchor item: S1WantCurse > > if(requireNamespace("multcomp")) { + + ## four anchor items from constant anchor class using MPT-selection (Kopf et al. 2015b) + anchor(object = raschmodels[[1]], object2 = raschmodels[[2]], + class = "constant", select = "MPT", length = 4) + + ## iterative forward anchor class using MTT-selection (Kopf et al. 2015b) + set.seed(1) + fanchor <- anchor(object = raschmodels[[1]], object2 = raschmodels[[2]], + class = "forward", select = "MTT", range = c(0.05, 1)) + fanchor + + ## the same using the formula interface + set.seed(1) + fanchor2 <- anchor(resp2[, 1:12] ~ gender , data = VerbalAggression, + class = "forward", select = "MTT", range = c(0.05, 1)) + + ## criteria really the same? + all.equal(fanchor$criteria, fanchor2$criteria, check.attributes = FALSE) + } Loading required namespace: multcomp [1] TRUE > > > > cleanEx() > nameEx("anchortest") > ### * anchortest > > flush(stderr()); flush(stdout()) > > ### Name: anchortest > ### Title: Anchor methods for the detection of uniform DIF in the Rasch > ### model > ### Aliases: anchortest anchortest.default anchortest.formula > ### print.anchortest print.summary.anchortest summary.anchortest > ### Keywords: regression > > ### ** Examples > > if(requireNamespace("multcomp")) { + + o <- options(digits = 4) + + ## Verbal aggression data + data("VerbalAggression", package = "psychotools") + + ## Rasch model for the self-to-blame situations; gender DIF test + raschmodels <- with(VerbalAggression, lapply(levels(gender), function(i) + raschmodel(resp2[gender == i, 1:12]))) + + ## single anchor from Gini selection (default) + gini1 <- anchortest(object = raschmodels[[1]], object2 = raschmodels[[2]]) + gini1 + summary(gini1) + + ## four anchor items from constant anchor class using MPT selection + const1 <- anchortest(object = raschmodels[[1]], object2 = raschmodels[[2]], + class = "constant", select = "MPT", length = 4) + const1 + summary(const1) + + ## iterative forward anchor class using MTT selection + set.seed(1) + forw1 <- anchortest(object = raschmodels[[1]], object2 = raschmodels[[2]], + class = "forward", select = "MTT", test = TRUE, + adjust = "none", range = c(0.05,1)) + forw1 + + ## DIF test with fixed given anchor (arbitrarily selected to be items 1 and 2) + anchortest(object = raschmodels[[1]], object2 = raschmodels[[2]], select = 1:2) + + options(digits = o$digits) + } > > > > cleanEx() > nameEx("as.list.itemresp") > ### * as.list.itemresp > > flush(stderr()); flush(stdout()) > > ### Name: as.list.itemresp > ### Title: Coercing Item Response Data > ### Aliases: is.itemresp as.list.itemresp as.character.itemresp > ### as.data.frame.itemresp as.double.itemresp as.integer.itemresp > ### as.matrix.itemresp > ### Keywords: classes > > ### ** Examples > > ## item responses from binary matrix > x <- cbind(c(1, 0, 1, 0), c(1, 0, 0, 0), c(0, 1, 1, 1)) > xi <- itemresp(x) > ## change mscale > mscale(xi) <- c("-", "+") > xi [1] {+,+,-} {-,-,+} {+,-,+} {-,-,+} > > ## coercion to list of factors with levels taken from mscale > as.list(xi) $item1 [1] + - + - Levels: - + $item2 [1] + - - - Levels: - + $item3 [1] - + + + Levels: - + > ## same but levels taken as integers 0, 1 > as.list(xi, mscale = FALSE) $item1 [1] 1 0 1 0 Levels: 0 1 $item2 [1] 1 0 0 0 Levels: 0 1 $item3 [1] 0 1 1 1 Levels: 0 1 > ## only for first two items > as.list(xi, items = 1:2) $item1 [1] + - + - Levels: - + $item2 [1] + - - - Levels: - + > ## result as data.frame > as.list(xi, df = TRUE) item1 item2 item3 1 + + - 2 - - + 3 + - + 4 - - + > > ## data frame with single itemresp column > as.data.frame(xi) xi 1 {+,+,-} 2 {-,-,+} 3 {+,-,+} 4 {-,-,+} > > ## integer matrix > as.matrix(xi) item1 item2 item3 [1,] 1 1 0 [2,] 0 0 1 [3,] 1 0 1 [4,] 0 0 1 > > ## character vector > as.character(xi) [1] "{+,+,-}" "{-,-,+}" "{+,-,+}" "{-,-,+}" > > ## check class of xi > is.itemresp(xi) [1] TRUE > > > > cleanEx() > nameEx("btmodel") > ### * btmodel > > flush(stderr()); flush(stdout()) > > ### Name: btmodel > ### Title: Bradley-Terry Model Fitting Function > ### Aliases: btmodel btReg.fit print.btmodel summary.btmodel > ### print.summary.btmodel coef.btmodel worth.btmodel deviance.btmodel > ### logLik.btmodel vcov.btmodel estfun.btmodel > ### Keywords: regression > > ### ** Examples > > o <- options(digits = 4) > > ## data > data("GermanParties2009", package = "psychotools") > > ## Bradley-Terry model > bt <- btmodel(GermanParties2009$preference) > summary(bt) Bradley-Terry model Parameters: Estimate Std. Error z value Pr(>|z|) none -0.3756 0.0890 -4.22 2.5e-05 *** Linke -0.6161 0.0910 -6.77 1.3e-11 *** Gruene 1.1858 0.0951 12.47 < 2e-16 *** SPD 0.8131 0.0907 8.97 < 2e-16 *** CDU/CSU 0.1756 0.0875 2.01 0.045 * --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 Log-likelihood: -1720 (df = 5) > plot(bt) > > options(digits = o$digits) > > > > cleanEx() > nameEx("covariates") > ### * covariates > > flush(stderr()); flush(stdout()) > > ### Name: covariates > ### Title: Extract/Set Covariates > ### Aliases: covariates covariates<- > ### Keywords: classes > > ### ** Examples > > ## method for "paircomp" data > pc <- paircomp(rbind( + c(1, 1, 1), # a > b, a > c, b > c + c(1, 1, -1), # a > b, a > c, b < c + c(1, -1, -1), # a > b, a < c, b < c + c(1, 1, 1))) > covariates(pc) NULL > covariates(pc) <- data.frame(foo = factor(c(1, 2, 2), labels = c("foo", "bar"))) > covariates(pc) foo a foo b bar c bar > > > > cleanEx() > nameEx("curveplot") > ### * curveplot > > flush(stderr()); flush(stdout()) > > ### Name: curveplot > ### Title: Response Curve Plots for IRT Models > ### Aliases: curveplot > ### Keywords: aplot > > ### ** Examples > > ## load verbal aggression data > data("VerbalAggression", package = "psychotools") > > ## fit Rasch, rating scale and partial credit model to verbal aggression data > rmmod <- raschmodel(VerbalAggression$resp2) > rsmod <- rsmodel(VerbalAggression$resp) > pcmod <- pcmodel(VerbalAggression$resp) > > ## curve plots of the dichotomous RM > plot(rmmod, type = "curves") > > ## curve plots under the RSM for the first six items of the data set > plot(rsmod, type = "curves", items = 1:6) > > ## curve plots under the PCM for the first six items of the data set with > ## custom labels > plot(pcmod, type = "curves", items = 1:6, names = paste("Item", 1:6)) > > ## compare the predicted probabilities under the RSM and the PCM for a single > ## item > plot(rsmod, type = "curves", item = 1) > plot(pcmod, type = "curves", item = 1, lty = 2, add = TRUE) > legend(x = "topleft", y = 1.0, legend = c("RSM", "PCM"), lty = 1:2, bty = "n") > > > > > cleanEx() > nameEx("discrpar") > ### * discrpar > > flush(stderr()); flush(stdout()) > > ### Name: discrpar > ### Title: Extract Discrimination Parameters of Item Response Models > ### Aliases: discrpar discrpar.raschmodel discrpar.rsmodel discrpar.pcmodel > ### discrpar.nplmodel discrpar.gpcmodel coef.discrpar print.discrpar > ### vcov.discrpar > ### Keywords: classes > > ### ** Examples > > o <- options(digits = 4) > > ## load verbal aggression data > data("VerbalAggression", package = "psychotools") > > ## fit Rasch model to verbal aggression data > rmod <- raschmodel(VerbalAggression$resp2) > > ## extract the discrimination parameters > dp1 <- discrpar(rmod) > > ## extract the standard errors > sqrt(diag(vcov(dp1))) S1WantCurse S1DoCurse S1WantScold S1DoScold S1WantShout S1DoShout 0 0 0 0 0 0 S2WantCurse S2DoCurse S2WantScold S2DoScold S2WantShout S2DoShout 0 0 0 0 0 0 S3WantCurse S3DoCurse S3WantScold S3DoScold S3WantShout S3DoShout 0 0 0 0 0 0 S4WantCurse S4DoCurse S4WantScold S4DoScold S4WantShout S4DoShout 0 0 0 0 0 0 > > if(requireNamespace("mirt")) { + ## fit 2PL to verbal aggression data + twoplmod <- nplmodel(VerbalAggression$resp2) + + ## extract the discrimination parameters + dp2 <- discrpar(twoplmod) + + ## this time with the first discrimination parameter being the reference + discrpar(twoplmod, ref = 1) + + ## extract the standard errors + sqrt(diag(vcov(dp2))) + } Loading required namespace: mirt S1WantCurse S1DoCurse S1WantScold S1DoScold S1WantShout S1DoShout 0.2275 0.2688 0.2364 0.3494 0.2107 0.2226 S2WantCurse S2DoCurse S2WantScold S2DoScold S2WantShout S2DoShout 0.2580 0.2343 0.2455 0.2963 0.2017 0.2610 S3WantCurse S3DoCurse S3WantScold S3DoScold S3WantShout S3DoShout 0.1666 0.1837 0.2201 0.2244 0.1798 0.2483 S4WantCurse S4DoCurse S4WantScold S4DoScold S4WantShout S4DoShout 0.1990 0.2202 0.2408 0.2238 0.1774 0.2194 > > options(digits = o$digits) > > > > cleanEx() > nameEx("elementary_symmetric_functions") > ### * elementary_symmetric_functions > > flush(stderr()); flush(stdout()) > > ### Name: elementary_symmetric_functions > ### Title: Calculation of the Elementary Symmetric Functions and Their > ### Derivatives > ### Aliases: elementary_symmetric_functions > ### Keywords: misc > > ### ** Examples > > > ## calculate zero and first order elementary symmetric functions > ## for 10 polytomous items with three categories each. > pi <- split(rnorm(20), rep(1:10, each = 2)) > x <- elementary_symmetric_functions(pi) > > ## use difference algorithm instead and compare results > y <- elementary_symmetric_functions(pi, diff = TRUE) > all.equal(x, y) [1] TRUE > > > > cleanEx() > nameEx("gpcmodel") > ### * gpcmodel > > flush(stderr()); flush(stdout()) > > ### Name: gpcmodel > ### Title: Generalized Partial Credit Model Fitting Function > ### Aliases: gpcmodel print.gpcmodel summary.gpcmodel > ### print.summary.gpcmodel coef.gpcmodel bread.gpcmodel estfun.gpcmodel > ### logLik.gpcmodel vcov.gpcmodel > ### Keywords: regression > > ### ** Examples > > if(requireNamespace("mirt")) { + + o <- options(digits = 4) + + ## mathematics 101 exam results + data("MathExam14W", package = "psychotools") + + ## generalized partial credit model + gpcm <- gpcmodel(y = MathExam14W$credit) + summary(gpcm) + + ## how to specify starting values as a vector of model parameters + st <- coef(gpcm) + gpcm <- gpcmodel(y = MathExam14W$credit, start = st) + ## or a list containing a vector of slopes and a list of intercept vectors + ## itemwise + set.seed(0) + st <- list(a = rlnorm(13, 0, 0.0625), d = replicate(13, rnorm(2, 0, 1), FALSE)) + gpcm <- gpcmodel(y = MathExam14W$credit, start = st) + + ## visualizations + plot(gpcm, type = "profile") + plot(gpcm, type = "regions") + plot(gpcm, type = "piplot") + plot(gpcm, type = "curves", xlim = c(-6, 6)) + plot(gpcm, type = "information", xlim = c(-6, 6)) + ## visualizing the IRT parametrization + plot(gpcm, type = "curves", xlim = c(-6, 6), items = 1) + abline(v = threshpar(gpcm)[[1]]) + abline(v = itempar(gpcm)[1], lty = 2) + + options(digits = o$digits) + } > > > > cleanEx() > nameEx("guesspar") > ### * guesspar > > flush(stderr()); flush(stdout()) > > ### Name: guesspar > ### Title: Extract Guessing Parameters of Item Response Models > ### Aliases: guesspar guesspar.raschmodel guesspar.rsmodel guesspar.pcmodel > ### guesspar.nplmodel guesspar.gpcmodel coef.guesspar print.guesspar > ### vcov.guesspar > ### Keywords: classes > > ### ** Examples > > if(requireNamespace("mirt")) { + + o <- options(digits = 3) + + ## load simulated data + data("Sim3PL", package = "psychotools") + + ## fit 2PL to data simulated under the 3PL + twoplmod <- nplmodel(Sim3PL$resp) + + ## extract the guessing parameters (all fixed at 0) + gp1 <- guesspar(twoplmod) + + ## fit 3PL to data simulated under the 3PL + threeplmod <- nplmodel(Sim3PL$resp, type = "3PL") + + ## extract the guessing parameters + gp2 <- guesspar(threeplmod) + + ## extract the standard errors + sqrt(diag(vcov(gp2))) + + ## extract the guessing parameters on the logit scale + gp2_logit <- guesspar(threeplmod, logit = TRUE) + + ## along with the delta transformed standard errors + sqrt(diag(vcov(gp2_logit))) + + options(digits = o$digits) + } > > > > cleanEx() > nameEx("infoplot") > ### * infoplot > > flush(stderr()); flush(stdout()) > > ### Name: infoplot > ### Title: Information Plots for IRT Models > ### Aliases: infoplot > ### Keywords: aplot > > ### ** Examples > > ## load verbal aggression data > data("VerbalAggression", package = "psychotools") > > ## fit Rasch and partial credit model to verbal aggression data > rmmod <- raschmodel(VerbalAggression$resp2) > pcmod <- pcmodel(VerbalAggression$resp) > > ## category information plots for all items under the dichotomous RM > plot(rmmod, type = "information", what = "categories") > > ## category information plots for all items under the PCM > plot(pcmod, type = "information", what = "categories") > > ## overlayed item information plots for the first six items of the > ## data set under the PCM > plot(pcmod, type = "information", what = "items", items = 1:6) > > ## a comparison of the item information for the first six items under the > ## dichotomous RM and the PCM > plot(pcmod, type = "information", what = "items", items = 1:6, + xlim = c(-5, 5)) > plot(rmmod, type = "information", what = "items", items = 1:6, + lty = 2, add = TRUE) > legend(x = "topright", legend = c("PCM", "RM"), lty = 1:2, bty = "n") > > ## a comparison of the test information based on all items of the > ## data set under the dichotomous RM and the PCM > plot(pcmod, type = "information", what = "test", items = 1:6, xlim = c(-5, 5)) > plot(rmmod, type = "information", what = "test", items = 1:6, lty = 2, + add = TRUE) > legend(x = "topright", legend = c("PCM", "RM"), lty = 1:2, bty = "n") > > if(requireNamespace("mirt")) { + ## fit 2PL to verbal aggression data + twoplmod <- nplmodel(VerbalAggression$resp2) + + ## category information plots for all items under the dichotomous 2PL + plot(twoplmod, type = "information", what = "categories") + } > > > > cleanEx() > nameEx("itempar") > ### * itempar > > flush(stderr()); flush(stdout()) > > ### Name: itempar > ### Title: Extract Item Parameters of Item Response Models > ### Aliases: itempar itempar.btmodel itempar.raschmodel itempar.rsmodel > ### itempar.pcmodel itempar.nplmodel itempar.gpcmodel itempar.raschtree > ### itempar.bttree coef.itempar print.itempar vcov.itempar > ### Keywords: classes > > ### ** Examples > > o <- options(digits = 4) > > ## load verbal aggression data > data("VerbalAggression", package = "psychotools") > > ## fit a Rasch model to dichotomized verbal aggression data > raschmod <- raschmodel(VerbalAggression$resp2) > > ## extract item parameters with sum zero or use last two items as anchor > ip1 <- itempar(raschmod) > ip2a <- itempar(raschmod, ref = 23:24) # with position indices > ip2b <- itempar(raschmod, ref = c("S4WantShout", "S4DoShout")) # with item label > > ip1 Item response item parameters (RM): S1WantCurse S1DoCurse S1WantScold S1DoScold S1WantShout S1DoShout -1.3834 -1.3834 -0.7307 -0.5566 -0.2491 0.6981 S2WantCurse S2DoCurse S2WantScold S2DoScold S2WantShout S2DoShout -1.9093 -1.0367 -0.8727 -0.1131 -0.1810 1.3120 S3WantCurse S3DoCurse S3WantScold S3DoScold S3WantShout S3DoShout -0.6955 0.0403 0.5136 1.3348 1.3577 2.8709 S4WantCurse S4DoCurse S4WantScold S4DoScold S4WantShout S4DoShout -1.2450 -0.8727 0.1779 0.2126 0.8711 1.8402 > ip2a Item response item parameters (RM): S1WantCurse S1DoCurse S1WantScold S1DoScold S1WantShout S1DoShout -2.73904 -2.73905 -2.08637 -1.91227 -1.60471 -0.65752 S2WantCurse S2DoCurse S2WantScold S2DoScold S2WantShout S2DoShout -3.26495 -2.39238 -2.22840 -1.46881 -1.53669 -0.04366 S3WantCurse S3DoCurse S3WantScold S3DoScold S3WantShout S3DoShout -2.05119 -1.31534 -0.84209 -0.02087 0.00205 1.51526 S4WantCurse S4DoCurse S4WantScold S4DoScold S4WantShout S4DoShout -2.60068 -2.22840 -1.17772 -1.14302 -0.48456 0.48456 > > all.equal(ip2a, ip2b) [1] TRUE > > ## extract vcov > vc1 <- vcov(ip1) > vc2 <- vcov(ip2a) > > ## adjusted standard errors, > ## smaller with more items used as anchors > sqrt(diag(vc1)) S1WantCurse S1DoCurse S1WantScold S1DoScold S1WantShout S1DoShout 0.1400 0.1400 0.1306 0.1294 0.1283 0.1349 S2WantCurse S2DoCurse S2WantScold S2DoScold S2WantShout S2DoShout 0.1535 0.1341 0.1321 0.1284 0.1283 0.1479 S3WantCurse S3DoCurse S3WantScold S3DoScold S3WantShout S3DoShout 0.1303 0.1287 0.1324 0.1485 0.1492 0.2219 S4WantCurse S4DoCurse S4WantScold S4DoScold S4WantShout S4DoShout 0.1374 0.1321 0.1294 0.1296 0.1378 0.1654 > sqrt(diag(vc2)) S1WantCurse S1DoCurse S1WantScold S1DoScold S1WantShout S1DoShout 0.1822 0.1822 0.1739 0.1727 0.1715 0.1758 S2WantCurse S2DoCurse S2WantScold S2DoScold S2WantShout S2DoShout 0.1940 0.1770 0.1752 0.1714 0.1714 0.1861 S3WantCurse S3DoCurse S3WantScold S3DoScold S3WantShout S3DoShout 0.1736 0.1715 0.1740 0.1866 0.1872 0.2524 S4WantCurse S4DoCurse S4WantScold S4DoScold S4WantShout S4DoShout 0.1799 0.1752 0.1719 0.1720 0.1098 0.1098 > > ## Wald confidence intervals > confint(ip1) 2.5 % 97.5 % S1WantCurse -1.65779 -1.108969 S1DoCurse -1.65780 -1.108975 S1WantScold -0.98677 -0.474645 S1DoScold -0.81017 -0.303037 S1WantShout -0.50057 0.002469 S1DoShout 0.43369 0.962584 S2WantCurse -2.21010 -1.608490 S2DoCurse -1.29956 -0.773879 S2WantScold -1.13156 -0.613916 S2DoScold -0.36472 0.138425 S2WantShout -0.43251 0.070440 S2DoShout 1.02215 1.601865 S3WantCurse -0.95101 -0.440049 S3DoCurse -0.21201 0.292654 S3WantScold 0.25401 0.773120 S3DoScold 1.04370 1.625879 S3WantShout 1.06536 1.650059 S3DoShout 2.43599 3.305848 S4WantCurse -1.51430 -0.975743 S4DoCurse -1.13156 -0.613916 S4WantScold -0.07573 0.431608 S4DoScold -0.04146 0.466738 S4WantShout 0.60095 1.141248 S4DoShout 1.51595 2.164496 > confint(ip2a) 2.5 % 97.5 % S1WantCurse -3.0961 -2.3819 S1DoCurse -3.0962 -2.3819 S1WantScold -2.4272 -1.7455 S1DoScold -2.2507 -1.5738 S1WantShout -1.9408 -1.2686 S1DoShout -1.0022 -0.3129 S2WantCurse -3.6451 -2.8848 S2DoCurse -2.7393 -2.0454 S2WantScold -2.5717 -1.8850 S2DoScold -1.8047 -1.1329 S2WantShout -1.8726 -1.2007 S2DoShout -0.4084 0.3211 S3WantCurse -2.3915 -1.7109 S3DoCurse -1.6515 -0.9792 S3WantScold -1.1831 -0.5011 S3DoScold -0.3866 0.3449 S3WantShout -0.3648 0.3689 S3DoShout 1.0206 2.0099 S4WantCurse -2.9533 -2.2481 S4DoCurse -2.5717 -1.8850 S4WantScold -1.5146 -0.8408 S4DoScold -1.4802 -0.8058 S4WantShout -0.6998 -0.2694 S4DoShout 0.2694 0.6998 > > options(digits = o$digits) > > > > cleanEx() > nameEx("itemresp") > ### * itemresp > > flush(stderr()); flush(stdout()) > > ### Name: itemresp > ### Title: Data Structure for Item Response Data > ### Aliases: itemresp is.na.itemresp labels.itemresp labels<-.itemresp > ### length.itemresp levels.itemresp mscale.itemresp mscale<-.itemresp > ### names.itemresp names<-.itemresp rep.itemresp str.itemresp > ### xtfrm.itemresp > ### Keywords: classes > > ### ** Examples > > ## binary responses to three items, coded as matrix > x <- cbind(c(1, 0, 1, 0), c(1, 0, 0, 0), c(0, 1, 1, 1)) > ## transformed to itemresp object > xi <- itemresp(x) > > ## printing (see also ?print.itemresp) > print(xi) [1] {1,1,0} {0,0,1} {1,0,1} {0,0,1} > print(xi, labels = TRUE) [1] {item1:1,item2:1,item3:0} {item1:0,item2:0,item3:1} [3] {item1:1,item2:0,item3:1} {item1:0,item2:0,item3:1} > > ## subsetting/indexing (see also ?subset.itemresp) > xi[2] [1] {0,0,1} > xi[c(TRUE, TRUE, FALSE, FALSE)] [1] {1,1,0} {0,0,1} > subset(xi, items = 1:2) [1] {1,1} {0,0} {1,0} {0,0} > dim(xi) [1] 4 3 > length(xi) [1] 4 > > ## summary/visualization (see also ?summary.itemresp) > summary(xi) 0 1 item1 2 2 item2 3 1 item3 1 3 > plot(xi) > > ## query/set measurement scale labels > ## extract mscale (tries to collapse to vector) > mscale(xi) [1] 0 1 > ## extract as list > mscale(xi, simplify = FALSE) $item1 [1] 0 1 $item2 [1] 0 1 $item3 [1] 0 1 > ## replacement by list > mscale(xi) <- list(item1 = c("no", "yes"), + item2 = c("nay", "yae"), item3 = c("-", "+")) > xi [1] {yes,yae,-} {no,nay,+} {yes,nay,+} {no,nay,+} > mscale(xi) $item1 [1] "no" "yes" $item2 [1] "nay" "yae" $item3 [1] "-" "+" > ## replacement with partially named list plus default > mscale(xi) <- list(item1 = c("n", "y"), 0:1) > mscale(xi) $item1 [1] "n" "y" $item2 [1] "0" "1" $item3 [1] "0" "1" > ## replacement by vector (if number of categories constant) > mscale(xi) <- c("-", "+") > mscale(xi, simplify = FALSE) $item1 [1] "-" "+" $item2 [1] "-" "+" $item3 [1] "-" "+" > > ## query/set item labels and subject names > labels(xi) [1] "item1" "item2" "item3" > labels(xi) <- c("i1", "i2", "i3") > names(xi) NULL > names(xi) <- c("John", "Joan", "Jen", "Jim") > print(xi, labels = TRUE) John Joan Jen Jim {i1:+,i2:+,i3:-} {i1:-,i2:-,i3:+} {i1:+,i2:-,i3:+} {i1:-,i2:-,i3:+} > > ## coercion (see also ?as.list.itemresp) > ## to integer matrix > as.matrix(xi) i1 i2 i3 John 1 1 0 Joan 0 0 1 Jen 1 0 1 Jim 0 0 1 > ## to data frame with single itemresp column > as.data.frame(xi) xi John {+,+,-} Joan {-,-,+} Jen {+,-,+} Jim {-,-,+} > ## to list of factors > as.list(xi) $i1 John Joan Jen Jim + - + - Levels: - + $i2 John Joan Jen Jim + - - - Levels: - + $i3 John Joan Jen Jim - + + + Levels: - + > ## to data frame with factors > as.list(xi, df = TRUE) i1 i2 i3 John + + - Joan - - + Jen + - + Jim - - + > > > ## polytomous responses with missing values and unequal number of > ## categories in a data frame > d <- data.frame( + q1 = c(-2, 1, -1, 0, NA, 1, NA), + q2 = c(3, 5, 2, 5, NA, 2, 3), + q3 = factor(c(1, 2, 1, 2, NA, 3, 2), levels = 1:3, + labels = c("disagree", "neutral", "agree"))) > di <- itemresp(d) > di 1 2 3 4 5 6 {-2,3,dsgr} {1,5,ntrl} {-1,2,dsgr} {0,5,ntrl} {NA,NA,NA} {1,2,agre} 7 {NA,3,ntrl} > > ## auto-completion of mscale: full range (-2, ..., 2) for q1, starting > ## from smallest observed (negative) value (-2) to the same (positive) > ## value (2), full (positive) range for q2, starting from smallest > ## observed value (2) to largest observed value (5), missing category of > ## 4 is detected, for q3 given factor levels are used > mscale(di) $q1 [1] "-2" "-1" "0" "1" "2" $q2 [1] "2" "3" "4" "5" $q3 [1] "disagree" "neutral" "agree" > > ## set mscale for q2 and add category 1, q1 and q3 are auto-completed: > di <- itemresp(d, mscale = list(q2 = 1:5)) > > ## is.na.itemresp - only true for observation 5 (all missing) > is.na(di) 1 2 3 4 5 6 7 FALSE FALSE FALSE FALSE TRUE FALSE FALSE > > ## illustration for larger data set > data("VerbalAggression", package = "psychotools") > r <- itemresp(VerbalAggression$resp[, 1:12]) > str(r) Item response data from 316 subjects for 12 items. S1WantCurse: 0, 1, 2 S1DoCurse: 0, 1, 2 S1WantScold: 0, 1, 2 S1DoScold: 0, 1, 2 S1WantShout: 0, 1, 2 S1DoShout: 0, 1, 2 S2WantCurse: 0, 1, 2 S2DoCurse: 0, 1, 2 S2WantScold: 0, 1, 2 S2DoScold: 0, 1, 2 S2WantShout: 0, 1, 2 S2DoShout: 0, 1, 2 > head(r) [1] {0,1,0,0,0,1,0,1,0,0,0,0} {0,0,0,0,0,0,0,0,0,0,0,0} [3] {1,0,1,1,1,1,1,0,0,0,1,1} {1,1,1,1,1,1,1,2,1,1,1,1} [5] {1,1,0,1,1,0,1,1,0,0,0,0} {2,2,2,0,0,0,2,2,0,0,0,0} > plot(r) > summary(r) 0 1 2 S1WantCurse 91 95 130 S1DoCurse 91 108 117 S1WantScold 126 86 104 S1DoScold 136 97 83 S1WantShout 154 99 63 S1DoShout 208 68 40 S2WantCurse 67 112 137 S2DoCurse 109 97 110 S2WantScold 118 93 105 S2DoScold 162 92 62 S2WantShout 158 84 74 S2DoShout 238 53 25 > prop.table(summary(r), 1) 0 1 2 S1WantCurse 0.2879747 0.3006329 0.41139241 S1DoCurse 0.2879747 0.3417722 0.37025316 S1WantScold 0.3987342 0.2721519 0.32911392 S1DoScold 0.4303797 0.3069620 0.26265823 S1WantShout 0.4873418 0.3132911 0.19936709 S1DoShout 0.6582278 0.2151899 0.12658228 S2WantCurse 0.2120253 0.3544304 0.43354430 S2DoCurse 0.3449367 0.3069620 0.34810127 S2WantScold 0.3734177 0.2943038 0.33227848 S2DoScold 0.5126582 0.2911392 0.19620253 S2WantShout 0.5000000 0.2658228 0.23417722 S2DoShout 0.7531646 0.1677215 0.07911392 > > ## dichotomize response > r2 <- r > mscale(r2) <- c(0, 1, 1) > plot(r2) > > ## transform to "likert" package > if(require("likert")) { + lik <- likert(as.data.frame(as.list(r))) + lik + } Loading required package: likert Loading required package: ggplot2 Loading required package: xtable Item 0 1 2 1 S1WantCurse 28.79747 30.06329 41.139241 2 S1DoCurse 28.79747 34.17722 37.025316 3 S1WantScold 39.87342 27.21519 32.911392 4 S1DoScold 43.03797 30.69620 26.265823 5 S1WantShout 48.73418 31.32911 19.936709 6 S1DoShout 65.82278 21.51899 12.658228 7 S2WantCurse 21.20253 35.44304 43.354430 8 S2DoCurse 34.49367 30.69620 34.810127 9 S2WantScold 37.34177 29.43038 33.227848 10 S2DoScold 51.26582 29.11392 19.620253 11 S2WantShout 50.00000 26.58228 23.417722 12 S2DoShout 75.31646 16.77215 7.911392 > > > > cleanEx() detaching ‘package:likert’, ‘package:xtable’, ‘package:ggplot2’ > nameEx("labels") > ### * labels > > flush(stderr()); flush(stdout()) > > ### Name: labels<- > ### Title: Set Labels > ### Aliases: labels<- > ### Keywords: classes > > ### ** Examples > > ## method for "paircomp" data > pc <- paircomp(rbind( + c(1, 1, 1), # a > b, a > c, b > c + c(1, 1, -1), # a > b, a > c, b < c + c(1, -1, -1), # a > b, a < c, b < c + c(1, 1, 1))) > labels(pc) [1] "a" "b" "c" > labels(pc) <- c("ah", "be", "ce") > pc [1] {ah > be, ah > ce, be > ce} {ah > be, ah > ce, be < ce} [3] {ah > be, ah < ce, be < ce} {ah > be, ah > ce, be > ce} > > > > cleanEx() > nameEx("mptmodel") > ### * mptmodel > > flush(stderr()); flush(stdout()) > > ### Name: mptmodel > ### Title: Multinomial Processing Tree (MPT) Model Fitting Function > ### Aliases: mptmodel coef.mptmodel confint.mptmodel deviance.mptmodel > ### estfun.mptmodel logLik.mptmodel predict.mptmodel print.mptmodel > ### summary.mptmodel print.summary.mptmodel vcov.mptmodel mptspec > ### print.mptspec update.mptspec > ### Keywords: regression > > ### ** Examples > > o <- options(digits = 4) > > ## data > data("SourceMonitoring", package = "psychotools") > > ## source-monitoring MPT model > mpt1 <- mptmodel(SourceMonitoring$y, spec = mptspec("SourceMon")) > summary(mpt1) Coefficients: Estimate Logit Estim. Std. Error z value Pr(>|z|) D1 0.614 0.4651 0.0556 8.37 <2e-16 *** d1 0.379 -0.4927 0.1828 -2.70 0.007 ** g 0.535 0.1392 0.0779 1.79 0.074 . b 0.172 -1.5687 0.0427 -36.72 <2e-16 *** D2 0.675 0.7292 0.0568 12.84 <2e-16 *** d2 0.425 -0.3031 0.1428 -2.12 0.034 * --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 Likelihood ratio G2: 0 on 0 df, p-value: 1 AIC: 12478 Number of trees: 3 > plot(mpt1) > > options(digits = o$digits) > > > > cleanEx() > nameEx("mscale") > ### * mscale > > flush(stderr()); flush(stdout()) > > ### Name: mscale > ### Title: Extract/Replace Measurement Scale > ### Aliases: mscale mscale<- > ### Keywords: classes > > ### ** Examples > > ## methods for "paircomp" data > pc <- paircomp(rbind( + c(2, 1, 0), + c(1, 1, -1), + c(1, -2, -1), + c(0, 0, 0))) > pc [1] {a >> b, a > c, b = c} {a > b, a > c, b < c} {a > b, a << c, b < c} [4] {a = b, a = c, b = c} > > ## extract > mscale(pc) [1] -2 -1 0 1 2 > > ## replace (collapse to >/=/< scale) > mscale(pc) <- sign(mscale(pc)) > pc [1] {a > b, a > c, b = c} {a > b, a > c, b < c} {a > b, a < c, b < c} [4] {a = b, a = c, b = c} > > > ## similar for "itemresp" data > ir <- itemresp(cbind( + c(-1, 0, 1, 1, 0), + c(0, 1, 2, 1, 2), + c(1, 2, 1, 1, 3))) > ir [1] {-1,0,1} {0,1,2} {1,2,1} {1,1,1} {0,2,3} > > ## extract > mscale(ir) $item1 [1] -1 0 1 $item2 [1] 0 1 2 $item3 [1] 1 2 3 > > ## replace (single scale for all items) > mscale(ir) <- 1:3 > ir [1] {1,1,1} {2,2,2} {3,3,1} {3,2,1} {2,3,3} > > > > cleanEx() > nameEx("nplmodel") > ### * nplmodel > > flush(stderr()); flush(stdout()) > > ### Name: nplmodel > ### Title: Parametric Logistic Model (n-PL) Fitting Function > ### Aliases: nplmodel plmodel print.nplmodel summary.nplmodel > ### print.summary.nplmodel coef.nplmodel confint.nplmodel bread.nplmodel > ### estfun.nplmodel logLik.nplmodel vcov.nplmodel > ### Keywords: regression > > ### ** Examples > > if(requireNamespace("mirt")) { + + o <- options(digits = 4) + + ## mathematics 101 exam results + data("MathExam14W", package = "psychotools") + + ## 2PL + twopl <- nplmodel(y = MathExam14W$solved) + summary(twopl) + + ## how to specify starting values as a vector of model parameters + st <- coef(twopl) + twopl <- nplmodel(y = MathExam14W$solved, start = st) + ## or a list containing a vector of slopes and a vector of intercepts + set.seed(0) + st <- list(a = rlnorm(13, 0, 0.0625), d = rnorm(13, 0, 1)) + twopl <- nplmodel(y = MathExam14W$solved, start = st) + + ## visualizations + plot(twopl, type = "profile") + plot(twopl, type = "regions") + plot(twopl, type = "piplot") + plot(twopl, type = "curves", xlim = c(-6, 6)) + plot(twopl, type = "information", xlim = c(-6, 6)) + ## visualizing the IRT parametrization + plot(twopl, type = "curves", xlim = c(-6, 6), items = 1) + abline(v = itempar(twopl)[1]) + abline(h = 0.5, lty = 2) + + ## 2PL accounting for gender impact + table(MathExam14W$gender) + mtwopl <- nplmodel(y = MathExam14W$solved, impact = MathExam14W$gender, + grouppars = TRUE) + summary(mtwopl) + plot(mtwopl, type = "piplot") + ## specifying starting values as a vector of model parameters, note that in + ## this example impact is being modelled and therefore grouppars must be TRUE + ## to get all model parameters + st <- coef(mtwopl) + mtwopl <- nplmodel(y = MathExam14W$solved, impact = MathExam14W$gender, + start = st) + ## or a list containing a vector of slopes, a vector of intercepts and a vector + ## of means and a vector of variances as the distributional group parameters + set.seed(1) + st <- list(a = rlnorm(13, 0, 0.0625), d = rnorm(13, 0, 1), m = 0, v = 1) + mtwopl <- nplmodel(y = MathExam14W$solved, impact = MathExam14W$gender, + start = st) + + ## MML estimated Rasch model (1PL) + rm <- nplmodel(y = MathExam14W$solved, type = "1PL") + summary(rm) + + options(digits = o$digits) + } > > > > cleanEx() > nameEx("paircomp") > ### * paircomp > > flush(stderr()); flush(stdout()) > > ### Name: paircomp > ### Title: Data Structure for Paired Comparisons > ### Aliases: paircomp length.paircomp c.paircomp [.paircomp rep.paircomp > ### xtfrm.paircomp as.character.paircomp as.data.frame.paircomp > ### as.double.paircomp as.integer.paircomp as.matrix.paircomp > ### covariates.paircomp covariates<-.paircomp labels.paircomp > ### labels<-.paircomp names.paircomp names<-.paircomp mscale.paircomp > ### mscale<-.paircomp str.paircomp summary.paircomp is.na.paircomp > ### Keywords: classes > > ### ** Examples > > ## a simple paired comparison > pc <- paircomp(rbind( + c(1, 1, 1), # a > b, a > c, b > c + c(1, 1, -1), # a > b, a > c, b < c + c(1, -1, -1), # a > b, a < c, b < c + c(1, 1, 1))) > > ## basic methods > pc [1] {a > b, a > c, b > c} {a > b, a > c, b < c} {a > b, a < c, b < c} [4] {a > b, a > c, b > c} > str(pc) Paired comparisons from 4 subjects for 3 objects: a, b, c. > summary(pc) > < a : b 4 0 a : c 3 1 b : c 2 2 > pc[2:3] [1] {a > b, a > c, b < c} {a > b, a < c, b < c} > c(pc[2], pc[c(1, 4)]) [1] {a > b, a > c, b < c} {a > b, a > c, b > c} {a > b, a > c, b > c} > > ## methods to extract/set attributes > labels(pc) [1] "a" "b" "c" > labels(pc) <- c("ah", "be", "ce") > pc [1] {ah > be, ah > ce, be > ce} {ah > be, ah > ce, be < ce} [3] {ah > be, ah < ce, be < ce} {ah > be, ah > ce, be > ce} > mscale(pc) [1] -1 1 > covariates(pc) NULL > covariates(pc) <- data.frame(foo = factor(c(1, 2, 2), labels = c("foo", "bar"))) > covariates(pc) foo ah foo be bar ce bar > names(pc) NULL > names(pc) <- LETTERS[1:4] > pc A B {ah > be, ah > ce, be > ce} {ah > be, ah > ce, be < ce} C D {ah > be, ah < ce, be < ce} {ah > be, ah > ce, be > ce} > > ## reorder() and subset() both select a subset of > ## objects and/or reorders the objects > reorder(pc, c("ce", "ah")) A B C D {ce < ah} {ce < ah} {ce > ah} {ce < ah} > > > ## include paircomp object in a data.frame > ## (i.e., with subject covariates) > dat <- data.frame( + x = rnorm(4), + y = factor(c(1, 2, 1, 1), labels = c("hansi", "beppi"))) > dat$pc <- pc > dat x y pc 1 -0.6264538 hansi {ah > be, ah > ce, be > ce} 2 0.1836433 beppi {ah > be, ah > ce, be < ce} 3 -0.8356286 hansi {ah > be, ah < ce, be < ce} 4 1.5952808 hansi {ah > be, ah > ce, be > ce} > > > ## formatting with long(er) labels and extended scale > pc2 <- paircomp(rbind( + c(4, 1, 0), + c(1, 2, -1), + c(1, -2, -1), + c(0, 0, -3)), + labels = c("Nordrhein-Westfalen", "Schleswig-Holstein", "Baden-Wuerttemberg")) > ## default: abbreviate > print(pc2) [1] {Nr-W 4> Sc-H, Nr-W > Bd-W, Sc-H = Bd-W} [2] {Nr-W > Sc-H, Nr-W 2> Bd-W, Sc-H < Bd-W} [3] {Nr-W > Sc-H, Nr-W 2< Bd-W, Sc-H < Bd-W} [4] {Nr-W = Sc-H, Nr-W = Bd-W, Sc-H 3< Bd-W} > print(pc2, abbreviate = FALSE) [1] {Nordrhein-Westfalen 4> Schleswig-Holstein, Nordrhein-Westfalen > Bad...} [2] {Nordrhein-Westfalen > Schleswig-Holstein, Nordrhein-Westfalen 2> Bad...} [3] {Nordrhein-Westfalen > Schleswig-Holstein, Nordrhein-Westfalen 2< Bad...} [4] {Nordrhein-Westfalen = Schleswig-Holstein, Nordrhein-Westfalen = Bade...} > print(pc2, abbreviate = FALSE, width = FALSE) [1] {Nordrhein-Westfalen 4> Schleswig-Holstein, Nordrhein-Westfalen > Baden-Wuerttemberg, Schleswig-Holstein = Baden-Wuerttemberg} [2] {Nordrhein-Westfalen > Schleswig-Holstein, Nordrhein-Westfalen 2> Baden-Wuerttemberg, Schleswig-Holstein < Baden-Wuerttemberg} [3] {Nordrhein-Westfalen > Schleswig-Holstein, Nordrhein-Westfalen 2< Baden-Wuerttemberg, Schleswig-Holstein < Baden-Wuerttemberg} [4] {Nordrhein-Westfalen = Schleswig-Holstein, Nordrhein-Westfalen = Baden-Wuerttemberg, Schleswig-Holstein 3< Baden-Wuerttemberg} > > > ## paired comparisons with object covariates > pc3 <- paircomp(rbind( + c(2, 1, 0), + c(1, 1, -1), + c(1, -2, -1), + c(0, 0, 0)), + labels = c("New York", "Rio", "Tokyo"), + covariates = data.frame(hemisphere = factor(c(1, 2, 1), labels = c("North", "South")))) > covariates(pc3) hemisphere New York North Rio South Tokyo North > > > > cleanEx() > nameEx("pcmodel") > ### * pcmodel > > flush(stderr()); flush(stdout()) > > ### Name: pcmodel > ### Title: Partial Credit Model Fitting Function > ### Aliases: pcmodel PCModel.fit print.pcmodel summary.pcmodel > ### print.summary.pcmodel coef.pcmodel bread.pcmodel estfun.pcmodel > ### logLik.pcmodel vcov.pcmodel > ### Keywords: regression > > ### ** Examples > > o <- options(digits = 4) > > ## Verbal aggression data > data("VerbalAggression", package = "psychotools") > > ## Partial credit model for the other-to-blame situations > pcm <- pcmodel(VerbalAggression$resp[, 1:12]) > summary(pcm) Partial credit model Item category parameters: Estimate Std. Error z value Pr(>|z|) S1WantCurse-C2 0.4315 0.2545 1.70 0.09006 . S1DoCurse-C1 -0.1066 0.2186 -0.49 0.62581 S1DoCurse-C2 0.5954 0.3587 1.66 0.09695 . S1WantScold-C1 0.5637 0.2162 2.61 0.00912 ** S1WantScold-C2 1.2544 0.3576 3.51 0.00045 *** S1DoScold-C1 0.5814 0.2118 2.74 0.00605 ** S1DoScold-C2 1.7075 0.3623 4.71 2.4e-06 *** S1WantShout-C1 0.7668 0.2096 3.66 0.00025 *** S1WantShout-C2 2.3031 0.3696 6.23 4.6e-10 *** S1DoShout-C1 1.6244 0.2179 7.46 9.0e-14 *** S1DoShout-C2 3.4790 0.3889 8.94 < 2e-16 *** S2WantCurse-C1 -0.5627 0.2286 -2.46 0.01382 * S2WantCurse-C2 -0.0786 0.3620 -0.22 0.82821 S2DoCurse-C1 0.2441 0.2162 1.13 0.25897 S2DoCurse-C2 0.9515 0.3577 2.66 0.00781 ** S2WantScold-C1 0.3977 0.2155 1.85 0.06491 . S2WantScold-C2 1.1403 0.3579 3.19 0.00144 ** S2DoScold-C1 0.9122 0.2108 4.33 1.5e-05 *** S2DoScold-C2 2.4113 0.3702 6.51 7.3e-11 *** S2WantShout-C1 0.9453 0.2134 4.43 9.4e-06 *** S2WantShout-C2 2.1175 0.3650 5.80 6.6e-09 *** S2DoShout-C1 2.1247 0.2273 9.35 < 2e-16 *** S2DoShout-C2 4.4099 0.4200 10.50 < 2e-16 *** --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 Log-likelihood: -2470 (df = 23) Number of iterations in BFGS optimization: 32 > > ## visualizations > plot(pcm, type = "profile") > plot(pcm, type = "regions") > plot(pcm, type = "piplot") > plot(pcm, type = "curves") > plot(pcm, type = "information") > > ## Get data of situation 1 ('A bus fails to > ## stop for me') and induce a null category in item 2. > pcd <- VerbalAggression$resp[, 1:6, drop = FALSE] > pcd[pcd[, 2] == 1, 2] <- NA > > ## fit pcm to these data, comparing downcoding and keeping strategy > pcm_va_keep <- pcmodel(pcd, nullcats = "keep") Warning in pcmodel(pcd, nullcats = "keep") : There are items with null categories (2). > pcm_va_down <- pcmodel(pcd, nullcats = "downcode") Warning in pcmodel(pcd, nullcats = "downcode") : There are items with null categories (2). > > plot(x = coef(pcm_va_keep), y = coef(pcm_va_down), + xlab = "Threshold Parameters (Keeping)", + ylab = "Threshold Parameters (Downcoding)", + main = "Comparison of two null category strategies (I2 with null category)", + pch = rep(as.character(1:6), each = 2)[-3]) > abline(b = 1, a = 0) > > options(digits = o$digits) > > > > cleanEx() > nameEx("personpar") > ### * personpar > > flush(stderr()); flush(stdout()) > > ### Name: personpar > ### Title: Extract Person Parameters of Item Response Models > ### Aliases: personpar personpar.raschmodel personpar.rsmodel > ### personpar.pcmodel personpar.nplmodel personpar.gpcmodel > ### coef.personpar print.personpar vcov.personpar > ### Keywords: classes > > ### ** Examples > > o <- options(digits = 3) > > ## load verbal aggression data > data("VerbalAggression", package = "psychotools") > > ## fit a Rasch model to dichotomized verbal aggression data and > ram <- raschmodel(VerbalAggression$resp2) > > ## extract person parameters > ## (= parameters of the underlying ability distribution) > rap <- personpar(ram) > rap Item response person parameters (RM): 1 2 3 4 5 6 7 8 9 10 -3.6185 -2.8441 -2.3552 -1.9815 -1.6694 -1.3947 -1.1444 -0.9104 -0.6872 -0.4708 11 12 13 14 15 16 17 18 19 20 -0.2581 -0.0464 0.1670 0.3845 0.6090 0.8438 1.0931 1.3629 1.6616 2.0035 21 22 23 2.4140 2.9489 3.7813 > > ## extract variance-covariance matrix and standard errors > vc <- vcov(rap) > sqrt(diag(vc)) 1 2 3 4 5 6 7 8 9 10 11 12 13 1.039 0.763 0.647 0.581 0.539 0.511 0.491 0.477 0.468 0.463 0.460 0.461 0.464 14 15 16 17 18 19 20 21 22 23 0.470 0.479 0.491 0.508 0.531 0.563 0.609 0.677 0.796 1.070 > > ## Wald confidence intervals > confint(rap) 2.5 % 97.5 % 1 -5.6555 -1.5814 2 -4.3397 -1.3485 3 -3.6224 -1.0880 4 -3.1200 -0.8430 5 -2.7259 -0.6128 6 -2.3957 -0.3937 7 -2.1068 -0.1820 8 -1.8459 0.0252 9 -1.6048 0.2304 10 -1.3776 0.4359 11 -1.1601 0.6439 12 -0.9491 0.8564 13 -0.7418 1.0758 14 -0.5359 1.3049 15 -0.3290 1.5470 16 -0.1189 1.8065 17 0.0969 2.0894 18 0.3212 2.4045 19 0.5576 2.7657 20 0.8106 3.1963 21 1.0861 3.7418 22 1.3885 4.5093 23 1.6838 5.8789 > > ## now match each person to person parameter with the corresponding raw score > personpar(ram, personwise = TRUE)[1:6] 1 2 3 4 5 6 -0.687 -3.618 -0.471 0.385 -0.471 -0.258 > > ## person parameters for RSM/PCM fitted to original polytomous data > rsm <- rsmodel(VerbalAggression$resp) > pcm <- pcmodel(VerbalAggression$resp) > cbind(personpar(rsm, vcov = FALSE), personpar(pcm, vcov = FALSE)) [,1] [,2] 1 -3.7657 -3.7851 2 -3.0721 -3.0866 3 -2.6623 -2.6730 4 -2.3672 -2.3749 5 -2.1338 -2.1392 6 -1.9390 -1.9424 7 -1.7701 -1.7721 8 -1.6200 -1.6208 9 -1.4837 -1.4837 10 -1.3583 -1.3574 11 -1.2412 -1.2398 12 -1.1309 -1.1291 13 -1.0260 -1.0239 14 -0.9256 -0.9232 15 -0.8287 -0.8262 16 -0.7348 -0.7322 17 -0.6433 -0.6407 18 -0.5537 -0.5511 19 -0.4657 -0.4631 20 -0.3787 -0.3762 21 -0.2926 -0.2902 22 -0.2069 -0.2047 23 -0.1215 -0.1195 24 -0.0360 -0.0343 25 0.0499 0.0513 26 0.1363 0.1374 27 0.2237 0.2244 28 0.3122 0.3125 29 0.4023 0.4021 30 0.4942 0.4934 31 0.5883 0.5870 32 0.6851 0.6833 33 0.7850 0.7826 34 0.8887 0.8857 35 0.9968 0.9933 36 1.1103 1.1063 37 1.2300 1.2257 38 1.3575 1.3530 39 1.4945 1.4900 40 1.6432 1.6391 41 1.8071 1.8038 42 1.9907 1.9889 43 2.2013 2.2021 44 2.4512 2.4556 45 2.7629 2.7727 46 3.1880 3.2054 47 3.8932 3.9209 > > if(requireNamespace("mirt")) { + ## fit a 2PL accounting for gender impact and + twoplm <- nplmodel(VerbalAggression$resp2, impact = VerbalAggression$gender) + + ## extract the person parameters + ## (= mean/variance parameters from the normal ability distribution) + twoplp <- personpar(twoplm) + twoplp + + ## extract the standard errors + sqrt(diag(vcov(twoplp))) + + ## Wald confidence intervals + confint(twoplp) + + ## now look at the individual person parameters + ## (integrated out over the normal ability distribution) + personpar(twoplm, personwise = TRUE)[1:6] + } 1 2 3 4 5 6 -0.351 -1.695 -0.134 0.472 -0.172 -0.125 > > options(digits = o$digits) > > > > cleanEx() > nameEx("piplot") > ### * piplot > > flush(stderr()); flush(stdout()) > > ### Name: piplot > ### Title: Person-Item Plots for IRT Models > ### Aliases: piplot > ### Keywords: aplot > > ### ** Examples > > ## load verbal agression data > data("VerbalAggression", package = "psychotools") > > ## fit partial credit model to verbal aggression data > pcmod <- pcmodel(VerbalAggression$resp) > > ## create a person-item plot visualization of the fitted PCM > plot(pcmod, type = "piplot") > > ## just visualize the first six items and the person parameter plot > plot(pcmod, type = "piplot", items = 1:6, pcol = "lightblue") > > > > > cleanEx() > nameEx("plot.btmodel") > ### * plot.btmodel > > flush(stderr()); flush(stdout()) > > ### Name: plot.btmodel > ### Title: Visualizing Bradley-Terry Models > ### Aliases: plot.btmodel > ### Keywords: hplot > > ### ** Examples > > ## data > data("GermanParties2009", package = "psychotools") > > ## Bradley-Terry model > bt <- btmodel(GermanParties2009$preference) > plot(bt) > plot(bt, worth = FALSE) > plot(bt, index = FALSE) > > > > cleanEx() > nameEx("plot.paircomp") > ### * plot.paircomp > > flush(stderr()); flush(stdout()) > > ### Name: plot.paircomp > ### Title: Plotting Paired Comparison Data > ### Aliases: plot.paircomp > ### Keywords: classes > > ### ** Examples > > data("GermanParties2009", package = "psychotools") > par(mar = c(5, 6, 3, 6)) > plot(GermanParties2009$preference, abbreviate = FALSE) > > > > graphics::par(get("par.postscript", pos = 'CheckExEnv')) > cleanEx() > nameEx("predict.pcmodel") > ### * predict.pcmodel > > flush(stderr()); flush(stdout()) > > ### Name: predict.pcmodel > ### Title: Predict Methods for Item Response Models > ### Aliases: predict.pcmodel predict.rsmodel predict.raschmodel > ### predict.gpcmodel predict.nplmodel > ### Keywords: regression > > ### ** Examples > > o <- options(digits = 4) > > ## load verbal aggression data > data("VerbalAggression", package = "psychotools") > > ## fit a partial credit model to first ten items > pcmod <- pcmodel(VerbalAggression$resp[, 1:10]) > > ## predicted response probabilities for each subject and category (the default) > head(predict(pcmod), 3) S1WantCurse-C0 S1WantCurse-C1 S1WantCurse-C2 S1DoCurse-C0 S1DoCurse-C1 [1,] 0.6513 0.2742 0.07457 0.6387 0.2991 [2,] 0.3956 0.3749 0.22950 0.3927 0.4139 [3,] 0.1367 0.3345 0.52886 0.1427 0.3885 S1DoCurse-C2 S1WantScold-C0 S1WantScold-C1 S1WantScold-C2 S1DoScold-C0 [1,] 0.06211 0.7757 0.1853 0.03895 0.7895 [2,] 0.19342 0.5580 0.3001 0.14194 0.5917 [3,] 0.46885 0.2448 0.3399 0.41531 0.2904 S1DoScold-C1 S1DoScold-C2 S1WantShout-C0 S1WantShout-C1 S1WantShout-C2 [1,] 0.1853 0.02522 0.8247 0.1607 0.01453 [2,] 0.3125 0.09576 0.6545 0.2871 0.05843 [3,] 0.3961 0.31349 0.3665 0.4153 0.21827 S1DoShout-C0 S1DoShout-C1 S1DoShout-C2 S2WantCurse-C0 S2WantCurse-C1 [1,] 0.9191 0.07589 0.00500 0.51720 0.3838 [2,] 0.8241 0.15315 0.02271 0.27473 0.4589 [3,] 0.6010 0.28848 0.11050 0.08487 0.3662 S2WantCurse-C2 S2DoCurse-C0 S2DoCurse-C1 S2DoCurse-C2 S2WantScold-C0 [1,] 0.09899 0.7157 0.2356 0.04868 0.7471 [2,] 0.26638 0.4795 0.3553 0.16521 0.5208 [3,] 0.54898 0.1918 0.3672 0.44097 0.2201 S2WantScold-C1 S2WantScold-C2 S2DoScold-C0 S2DoScold-C1 S2DoScold-C2 [1,] 0.2108 0.04206 0.8444 0.1423 0.01335 [2,] 0.3307 0.14852 0.6852 0.2599 0.05490 [3,] 0.3611 0.41879 0.3978 0.3897 0.21259 > > ## predicted mode (most probable category) for certain subjects whose person > ## parameters are given via argument "newdata" > predict(pcmod, type = "mode", + newdata = c("Sarah" = 1.2, "Michael" = 0.1, "Arnd" = -0.8)) S1WantCurse S1DoCurse S1WantScold S1DoScold S1WantShout S1DoShout Sarah 2 2 2 2 2 2 Michael 2 2 2 1 1 0 Arnd 0 1 0 0 0 0 S2WantCurse S2DoCurse S2WantScold S2DoScold Sarah 2 2 2 2 Michael 2 2 2 0 Arnd 1 0 0 0 > > ## rounded expected category value for the same subjects > predict(pcmod, type = "mean", + newdata = c("Sarah" = 1.2, "Michael" = 0.1, "Arnd" = -0.8)) S1WantCurse S1DoCurse S1WantScold S1DoScold S1WantShout S1DoShout Sarah 2 2 2 2 1 1 Michael 1 1 1 1 1 0 Arnd 1 1 1 0 0 0 S2WantCurse S2DoCurse S2WantScold S2DoScold Sarah 2 2 2 1 Michael 1 1 1 1 Arnd 1 1 1 0 > > ## in the Rasch model mode, mean and median are the same > raschmod <- raschmodel(VerbalAggression$resp2[, 1:10]) > med <- predict(raschmod, type = "median") > mn <- predict(raschmod, type = "mean") > mod <- predict(raschmod, type = "mode") > > head(med, 3) S1WantCurse S1DoCurse S1WantScold S1DoScold S1WantShout S1DoShout [1,] 0 0 0 0 0 0 [2,] 1 1 1 1 0 0 [3,] 1 1 1 1 0 0 S2WantCurse S2DoCurse S2WantScold S2DoScold [1,] 1 0 0 0 [2,] 1 1 1 0 [3,] 1 1 1 0 > > all.equal(med, mn) [1] TRUE > all.equal(mod, mn) [1] TRUE > > options(digits = o$digits) > > > > cleanEx() > nameEx("print.itemresp") > ### * print.itemresp > > flush(stderr()); flush(stdout()) > > ### Name: print.itemresp > ### Title: Formatting Item Response Data > ### Aliases: print.itemresp format.itemresp > ### Keywords: classes > > ### ** Examples > > ## item responses from binary matrix > x <- cbind(c(1, 0, 1, 0), c(1, 0, 0, 0), c(0, 1, 1, 1)) > xi <- itemresp(x) > ## change mscale > mscale(xi) <- c("-", "+") > xi [1] {+,+,-} {-,-,+} {+,-,+} {-,-,+} > > ## flexible formatting > ## no/other brackets > print(xi, brackets = FALSE) [1] +,+,- -,-,+ +,-,+ -,-,+ > print(xi, brackets = c(">>", "<<")) [1] >>+,+,-<< >>-,-,+<< >>+,-,+<< >>-,-,+<< > > ## include item labels (with different separators) > print(xi, labels = TRUE) [1] {item1:+,item2:+,item3:-} {item1:-,item2:-,item3:+} [3] {item1:+,item2:-,item3:+} {item1:-,item2:-,item3:+} > print(xi, labels = TRUE, sep = c(" | ", ": ")) [1] {item1: + | item2: + | item3: -} {item1: - | item2: - | item3: +} [3] {item1: + | item2: - | item3: +} {item1: - | item2: - | item3: +} > > ## handling longer mscale categories > mscale(xi) <- c("disagree", "agree") > print(xi) [1] {agre,agre,dsgr} {dsgr,dsgr,agre} {agre,dsgr,agre} {dsgr,dsgr,agre} > print(xi, mscale = FALSE) [1] {1,1,0} {0,0,1} {1,0,1} {0,0,1} > print(xi, abbreviate = FALSE) [1] {agree,agree,disagree} {disagree,disagree,agree} [3] {agree,disagree,agree} {disagree,disagree,agree} > print(xi, abbreviate = FALSE, width = 23) [1] {agree,agree,disagree} {disagree,disagree,...} {agree,disagree,agree} [4] {disagree,disagree,...} > print(xi, abbreviate = 2) [1] {ag,ag,ds} {ds,ds,ag} {ag,ds,ag} {ds,ds,ag} > > > > cleanEx() > nameEx("print.paircomp") > ### * print.paircomp > > flush(stderr()); flush(stdout()) > > ### Name: print.paircomp > ### Title: Formatting Paired Comparison Data > ### Aliases: print.paircomp format.paircomp > ### Keywords: classes > > ### ** Examples > > pc2 <- paircomp(rbind( + c(4, 1, 0), + c(1, 2, -1), + c(1, -2, -1), + c(0, 0, -3)), + labels = c("New York", "Rio", "Tokyo")) > > print(pc2) [1] {NwYr 4> Rio, NwYr > Toky, Rio = Toky} [2] {NwYr > Rio, NwYr 2> Toky, Rio < Toky} [3] {NwYr > Rio, NwYr 2< Toky, Rio < Toky} [4] {NwYr = Rio, NwYr = Toky, Rio 3< Toky} > print(pc2, abbreviate = FALSE) [1] {New York 4> Rio, New York > Tokyo, Rio = Tokyo} [2] {New York > Rio, New York 2> Tokyo, Rio < Tokyo} [3] {New York > Rio, New York 2< Tokyo, Rio < Tokyo} [4] {New York = Rio, New York = Tokyo, Rio 3< Tokyo} > print(pc2, abbreviate = FALSE, width = 10) [1] {New Y...} {New Y...} {New Y...} {New Y...} > > > > cleanEx() > nameEx("profileplot") > ### * profileplot > > flush(stderr()); flush(stdout()) > > ### Name: profileplot > ### Title: Profile Plots for IRT Models > ### Aliases: profileplot > ### Keywords: aplot > > ### ** Examples > > ## load verbal aggression data > data("VerbalAggression", package = "psychotools") > > ## fit Rasch, rating scale and partial credit model to verbal aggression data > rmmod <- raschmodel(VerbalAggression$resp2) > rsmod <- rsmodel(VerbalAggression$resp) > pcmod <- pcmodel(VerbalAggression$resp) > > ## profile plots of the item parameters of the three fitted IRT models > plot(rmmod, type = "profile", what = "items", col = 4) > plot(rsmod, type = "profile", what = "items", col = 2, add = TRUE) > plot(pcmod, type = "profile", what = "items", col = 3, add = TRUE) > legend(x = "topleft", legend = c("RM", "RSM", "PCM"), col = 1, + bg = c(4, 2, 3), pch = 21, bty = "n") > > ## profile plots of the threshold parameters of type "mode" > plot(rmmod, type = "profile", what = "thresholds", parg = list(type = "mode")) > plot(rsmod, type = "profile", what = "thresholds", parg = list(type = "mode")) > plot(pcmod, type = "profile", what = "thresholds", parg = list(type = "mode")) > > ## profile plot of the discrimination parameters of the dichotomous RM > plot(rmmod, type = "profile", what = "discrimination") > > > > > cleanEx() > nameEx("raschmodel") > ### * raschmodel > > flush(stderr()); flush(stdout()) > > ### Name: raschmodel > ### Title: Rasch Model Fitting Function > ### Aliases: raschmodel RaschModel.fit print.raschmodel summary.raschmodel > ### print.summary.raschmodel coef.raschmodel bread.raschmodel > ### estfun.raschmodel logLik.raschmodel vcov.raschmodel > ### Keywords: regression > > ### ** Examples > > o <- options(digits = 4) > > ## Verbal aggression data > data("VerbalAggression", package = "psychotools") > > ## Rasch model for the other-to-blame situations > m <- raschmodel(VerbalAggression$resp2[, 1:12]) > ## IGNORE_RDIFF_BEGIN > summary(m) Rasch model Difficulty parameters: Estimate Std. Error z value Pr(>|z|) S1DoCurse -1.56e-08 2.04e-01 0.00 1.00000 S1WantScold 6.86e-01 2.00e-01 3.44 0.00059 *** S1DoScold 8.73e-01 1.99e-01 4.38 1.2e-05 *** S1WantShout 1.21e+00 2.00e-01 6.03 1.6e-09 *** S1DoShout 2.29e+00 2.13e-01 10.77 < 2e-16 *** S2WantCurse -5.39e-01 2.13e-01 -2.53 0.01152 * S2DoCurse 3.61e-01 2.01e-01 1.80 0.07200 . S2WantScold 5.34e-01 2.00e-01 2.67 0.00753 ** S2DoScold 1.36e+00 2.01e-01 6.76 1.4e-11 *** S2WantShout 1.28e+00 2.01e-01 6.39 1.6e-10 *** S2DoShout 3.07e+00 2.34e-01 13.09 < 2e-16 *** --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 Log-likelihood: -1260 (df = 11) Number of iterations in BFGS optimization: 19 > ## IGNORE_RDIFF_END > > ## visualizations > plot(m, type = "profile") > plot(m, type = "regions") > plot(m, type = "curves") > plot(m, type = "information") > plot(m, type = "piplot") > > options(digits = o$digits) > > > > cleanEx() > nameEx("regionplot") > ### * regionplot > > flush(stderr()); flush(stdout()) > > ### Name: regionplot > ### Title: Region Plots for IRT Models > ### Aliases: regionplot > ### Keywords: aplot > > ### ** Examples > > ## load verbal aggression data > data("VerbalAggression", package = "psychotools") > > ## fit a Partial credit model to the items of the first other-to-blame > ## situation: "A bus fails to stop for me" > pcm <- pcmodel(VerbalAggression$resp[, 1:6]) > > ## a region plot with modus as cutpoint and custom labels > lab <- paste(rep(c("Curse", "Scold", "Shout"), each = 2), + rep(c("Want", "Do"), 3 ), sep = "-") > plot(pcm, type = "regions", names = lab) > > ## compare the cutpoints (with ylim specified manually) > opar <- par(no.readonly = TRUE) > ylim <- c(-2, 2) > layout(matrix(1:3, ncol = 1)) > plot(pcm, type = "regions", parg = list(type = "mode"), + main = "Modus as Cutpoint", ylim = ylim) > plot(pcm, type = "regions", parg = list(type = "median"), + main = "Median as Cutpoint", ylim = ylim) > plot(pcm, type = "regions", parg = list(type = "mean"), + main = "Mean as Cutpoint", ylim = ylim) > par(opar) > > ## PCM for full verbal aggression data set > pcm_va <- pcmodel(VerbalAggression$resp) > plot(pcm_va, type = "regions") > > if(requireNamespace("mirt")) { + ## generalized partial credit model for full verbal aggression data set + gpcm_va <- gpcmodel(VerbalAggression$resp) + plot(gpcm_va, type = "regions") + } > > > > graphics::par(get("par.postscript", pos = 'CheckExEnv')) > cleanEx() > nameEx("rgpcm") > ### * rgpcm > > flush(stderr()); flush(stdout()) > > ### Name: rgpcm > ### Title: Simulate Data under a Generalized Partial Credit Model > ### Aliases: rgpcm > > ### ** Examples > > set.seed(1) > ## item responses under a GPCM (generalized partial credit model) from > ## 6 persons with three different person parameters > ## 8 items with different combinations of two or three threshold parameters > ## and corresponding discrimination parameters > ppar <- rep(-1:1, each = 2) > tpar <- rep(list(-2:0, -1:1, 0:1, 0:2), each = 2) > dpar <- rep(list(1, 2), each = 4) > sim <- rgpcm(theta = ppar, a = dpar, b = tpar) > > ## simulated item response data along with setting parameters > sim $a $a[[1]] [1] 1 $a[[2]] [1] 1 $a[[3]] [1] 1 $a[[4]] [1] 1 $a[[5]] [1] 2 $a[[6]] [1] 2 $a[[7]] [1] 2 $a[[8]] [1] 2 $b $b[[1]] [1] -2 -1 0 $b[[2]] [1] -2 -1 0 $b[[3]] [1] -1 0 1 $b[[4]] [1] -1 0 1 $b[[5]] [1] 0 1 $b[[6]] [1] 0 1 $b[[7]] [1] 0 1 2 $b[[8]] [1] 0 1 2 $theta [1] -1 -1 0 0 1 1 $data [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [1,] 0 1 2 1 0 0 0 1 [2,] 1 0 1 0 0 0 1 0 [3,] 2 2 0 1 1 1 1 1 [4,] 3 3 3 2 0 1 1 0 [5,] 3 3 3 2 1 2 2 3 [6,] 3 3 2 3 2 1 3 2 > > ## print and plot corresponding item response object > iresp <- itemresp(sim$data) > iresp [1] {0,1,2,1,0,0,0,1} {1,0,1,0,0,0,1,0} {2,2,0,1,1,1,1,1} {3,3,3,2,0,1,1,0} [5] {3,3,3,2,1,2,2,3} {3,3,2,3,2,1,3,2} > plot(iresp) > > > > cleanEx() > nameEx("rpcm") > ### * rpcm > > flush(stderr()); flush(stdout()) > > ### Name: rpcm > ### Title: Simulate Data under a Partial Credit Model > ### Aliases: rpcm > > ### ** Examples > > set.seed(1) > ## item responses under a partial credit model (PCM) with > ## 6 persons with three different person parameters > ## 8 items with different combinations of two or three threshold parameters > ppar <- rep(-1:1, each = 2) > tpar <- rep(list(-2:0, -1:1, 0:1, 0:2), each = 2) > sim <- rpcm(theta = ppar, delta = tpar) > > ## simulated item response data along with setting parameters > sim $delta $delta[[1]] [1] -2 -1 0 $delta[[2]] [1] -2 -1 0 $delta[[3]] [1] -1 0 1 $delta[[4]] [1] -1 0 1 $delta[[5]] [1] 0 1 $delta[[6]] [1] 0 1 $delta[[7]] [1] 0 1 2 $delta[[8]] [1] 0 1 2 $theta [1] -1 -1 0 0 1 1 $data [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [1,] 0 1 2 1 2 0 1 1 [2,] 1 0 1 0 0 0 0 0 [3,] 2 2 0 1 0 1 1 1 [4,] 3 3 3 2 0 0 2 2 [5,] 3 3 3 2 1 2 3 3 [6,] 3 3 2 3 1 1 2 1 > > ## print and plot corresponding item response object > iresp <- itemresp(sim$data) > iresp [1] {0,1,2,1,2,0,1,1} {1,0,1,0,0,0,0,0} {2,2,0,1,0,1,1,1} {3,3,3,2,0,0,2,2} [5] {3,3,3,2,1,2,3,3} {3,3,2,3,1,1,2,1} > plot(iresp) > > > > cleanEx() > nameEx("rpl") > ### * rpl > > flush(stderr()); flush(stdout()) > > ### Name: rpl > ### Title: Simulate Data under a Parametric Logistic IRT Model > ### Aliases: rpl > > ### ** Examples > > set.seed(1) > ## item responses under a 2PL (two-parameter logistic) model from > ## 6 persons with three different person parameters > ## 9 increasingly difficult items and corresponding discrimination parameters > ## no guessing (= 0) and upper asymptote 1 > ppar <- rep(c(-2, 0, 2), each = 2) > ipar <- seq(-2, 2, by = 0.5) > dpar <- rep(c(0.5, 1, 1.5), each = 3) > sim <- rpl(theta = ppar, a = dpar, b = ipar) > > ## simulated item response data along with setting parameters > sim $a [1] 0.5 0.5 0.5 1.0 1.0 1.0 1.5 1.5 1.5 $b [1] -2.0 -1.5 -1.0 -0.5 0.0 0.5 1.0 1.5 2.0 $g [1] 0 0 0 0 0 0 0 0 0 $u [1] 1 1 1 1 1 1 1 1 1 $theta [1] -2 -2 0 0 2 2 $data [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [1,] 1 0 0 0 0 0 0 0 0 [2,] 1 0 0 0 0 0 0 0 0 [3,] 1 1 0 0 1 0 0 0 0 [4,] 0 1 1 1 1 1 0 0 0 [5,] 1 1 1 1 1 0 0 1 1 [6,] 0 1 0 1 1 1 1 1 1 > > ## print and plot corresponding item response object > iresp <- itemresp(sim$data) > iresp [1] {1,0,0,0,0,0,0,0,0} {1,0,0,0,0,0,0,0,0} {1,1,0,0,1,0,0,0,0} [4] {0,1,1,1,1,1,0,0,0} {1,1,1,1,1,0,0,1,1} {0,1,0,1,1,1,1,1,1} > plot(iresp) > > > > cleanEx() > nameEx("rrm") > ### * rrm > > flush(stderr()); flush(stdout()) > > ### Name: rrm > ### Title: Simulate Data under a Rasch model > ### Aliases: rrm > > ### ** Examples > > set.seed(1) > ## item responses under a Rasch model from > ## 6 persons with three different person parameters > ## 9 increasingly difficult items > ppar <- rep(-1:1, each = 2) > ipar <- seq(-2, 2, by = 0.5) > sim <- rrm(theta = ppar, beta = ipar) > > ## simulated item response data along with setting parameters > sim $beta [1] -2.0 -1.5 -1.0 -0.5 0.0 0.5 1.0 1.5 2.0 $theta [1] -1 -1 0 0 1 1 $data [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [1,] 1 0 0 0 1 0 0 0 0 [2,] 1 0 1 0 0 0 1 0 0 [3,] 1 1 0 0 1 0 0 0 0 [4,] 0 1 1 1 1 1 0 0 0 [5,] 1 1 1 1 0 0 0 1 0 [6,] 1 1 0 1 1 0 0 0 1 > > ## print and plot corresponding item response object > iresp <- itemresp(sim$data) > iresp [1] {1,0,0,0,1,0,0,0,0} {1,0,1,0,0,0,1,0,0} {1,1,0,0,1,0,0,0,0} [4] {0,1,1,1,1,1,0,0,0} {1,1,1,1,0,0,0,1,0} {1,1,0,1,1,0,0,0,1} > plot(iresp) > > > > cleanEx() > nameEx("rrsm") > ### * rrsm > > flush(stderr()); flush(stdout()) > > ### Name: rrsm > ### Title: Simulate Data under a Rating Scale Model > ### Aliases: rrsm > > ### ** Examples > > set.seed(1) > ## item responses under a rating scale model (RSM) with > ## 6 persons with three different person parameters > ## 9 increasingly difficult items > ## 3 different threshold parameters > ppar <- rep(-1:1, each = 2) > ipar <- seq(-2, 2, by = 0.5) > tpar <- 0:2 > sim <- rrsm(theta = ppar, beta = ipar, tau = tpar) > > ## simulated item response data along with setting parameters > sim $beta [1] -2.0 -1.5 -1.0 -0.5 0.0 0.5 1.0 1.5 2.0 $tau [1] 0 1 2 $theta [1] -1 -1 0 0 1 1 $data [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [1,] 0 0 1 2 2 0 0 2 0 [2,] 1 1 0 1 0 0 1 0 0 [3,] 2 3 3 3 1 1 0 0 0 [4,] 3 2 2 0 0 2 2 1 2 [5,] 3 3 2 2 3 3 3 3 1 [6,] 3 3 3 1 2 1 0 0 3 > > ## print and plot corresponding item response object > iresp <- itemresp(sim$data) > iresp [1] {0,0,1,2,2,0,0,2,0} {1,1,0,1,0,0,1,0,0} {2,3,3,3,1,1,0,0,0} [4] {3,2,2,0,0,2,2,1,2} {3,3,2,2,3,3,3,3,1} {3,3,3,1,2,1,0,0,3} > plot(iresp) > > > > cleanEx() > nameEx("rsmodel") > ### * rsmodel > > flush(stderr()); flush(stdout()) > > ### Name: rsmodel > ### Title: Rating Scale Model Fitting Function > ### Aliases: rsmodel RSModel.fit print.rsmodel summary.rsmodel > ### print.summary.rsmodel coef.rsmodel bread.rsmodel estfun.rsmodel > ### logLik.rsmodel vcov.rsmodel > ### Keywords: regression > > ### ** Examples > > o <- options(digits = 4) > > ## Verbal aggression data > data("VerbalAggression", package = "psychotools") > > ## Rating scale model for the other-to-blame situations > rsm <- rsmodel(VerbalAggression$resp[, 1:12]) > summary(rsm) Rating scale model Item location and threshold parameters: Estimate Std. Error z value Pr(>|z|) S1DoCurse 0.0899 0.1177 0.76 0.44467 S1WantScold 0.4205 0.1181 3.56 0.00037 *** S1DoScold 0.6379 0.1194 5.34 9.1e-08 *** S1WantShout 0.9161 0.1220 7.51 6.0e-14 *** S1DoShout 1.5657 0.1330 11.77 < 2e-16 *** S2WantCurse -0.2182 0.1189 -1.84 0.06636 . S2DoCurse 0.2619 0.1177 2.23 0.02606 * S2WantScold 0.3582 0.1179 3.04 0.00238 ** S2DoScold 0.9849 0.1228 8.02 1.1e-15 *** S2WantShout 0.8635 0.1214 7.11 1.1e-12 *** S2DoShout 2.0598 0.1466 14.05 < 2e-16 *** C2 0.5024 0.0850 5.91 3.4e-09 *** --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 Log-likelihood: -2480 (df = 12) Number of iterations in BFGS optimization: 19 > > ## visualizations > plot(rsm, type = "profile") > plot(rsm, type = "regions") > plot(rsm, type = "curves") > plot(rsm, type = "information") > plot(rsm, type = "piplot") > > options(digits = o$digits) > > > > cleanEx() > nameEx("subset.itemresp") > ### * subset.itemresp > > flush(stderr()); flush(stdout()) > > ### Name: subset.itemresp > ### Title: Subsetting Item Response Data > ### Aliases: subset.itemresp merge.itemresp c.itemresp [.itemresp > ### Keywords: classes > > ### ** Examples > > ## binary responses to three items, coded as matrix > x <- cbind(c(1, 0, 1, 0), c(1, 0, 0, 0), c(0, 1, 1, 1)) > xi <- itemresp(x) > > ## subsetting/indexing > xi[2] [1] {0,0,1} > xi[-(3:4)] [1] {1,1,0} {0,0,1} > xi[c(TRUE, TRUE, FALSE, FALSE)] [1] {1,1,0} {0,0,1} > subset(xi, items = 1:2) # or xi[, 1:2] [1] {1,1} {0,0} {1,0} {0,0} > subset(xi, items = -2, subjects = 2:3) [1] {0,1} {1,1} > > ## combine two itemresp vectors for different subjects but the same items > xi12 <- xi[1:2] > xi34 <- xi[3:4] > c(xi12, xi34) [1] {1,1,0} {0,0,1} {1,0,1} {0,0,1} > > ## combine two itemresp vectors for the same subjects but different items > ## polytomous responses in a data frame > d <- data.frame(q1 = c(-2, 1, -1, 0), q2 = factor(c(1, 3, 1, 3), + levels = 1:3, labels = c("disagree", "neutral", "agree"))) > di <-itemresp(d) > merge(xi, di) 1 2 3 4 {1,1,0,-2,dsgr} {0,0,1,1,agre} {1,0,1,-1,dsgr} {0,0,1,0,agre} > > ## if subjects have names/IDs, these are used for merging > names(xi) <- c("John", "Joan", "Jen", "Jim") > names(di) <- c("Joan", "Jen", "Jim", "Jo") > merge(xi, di) Joan Jen Jim {0,0,1,-2,dsgr} {1,0,1,1,agre} {0,0,1,-1,dsgr} > merge(xi, di, all = TRUE) John Joan Jen Jim {1,1,0,NA,NA} {0,0,1,-2,dsgr} {1,0,1,1,agre} {0,0,1,-1,dsgr} Jo {NA,NA,NA,0,agre} > > > > cleanEx() > nameEx("subset.paircomp") > ### * subset.paircomp > > flush(stderr()); flush(stdout()) > > ### Name: subset.paircomp > ### Title: Subsetting/Reordering Paired Comparison Data > ### Aliases: subset.paircomp reorder.paircomp > ### Keywords: classes > > ### ** Examples > > pc <- paircomp(rbind( + c(1, 1, 1), # a > b, a > c, b > c + c(1, 1, -1), # a > b, a > c, b < c + c(1, -1, -1), # a > b, a < c, b < c + c(1, 1, 1))) > reorder(pc, c("c", "a")) [1] {c < a} {c < a} {c > a} {c < a} > > > > cleanEx() > nameEx("summary.itemresp") > ### * summary.itemresp > > flush(stderr()); flush(stdout()) > > ### Name: summary.itemresp > ### Title: Summarizing and Visualizing Item Response Data > ### Aliases: summary.itemresp plot.itemresp > ### Keywords: classes > > ### ** Examples > > ## summary/visualization for verbal aggression data > data("VerbalAggression", package = "psychotools") > r <- itemresp(VerbalAggression$resp[, 1:6]) > mscale(r) <- c("no", "perhaps", "yes") > summary(r) no perhaps yes S1WantCurse 91 95 130 S1DoCurse 91 108 117 S1WantScold 126 86 104 S1DoScold 136 97 83 S1WantShout 154 99 63 S1DoShout 208 68 40 > plot(r) > > ## modify formatting of mscale > summary(r, abbreviate = 1) n p y S1WantCurse 91 95 130 S1DoCurse 91 108 117 S1WantScold 126 86 104 S1DoScold 136 97 83 S1WantShout 154 99 63 S1DoShout 208 68 40 > summary(r, mscale = FALSE) 0 1 2 S1WantCurse 91 95 130 S1DoCurse 91 108 117 S1WantScold 126 86 104 S1DoScold 136 97 83 S1WantShout 154 99 63 S1DoShout 208 68 40 > > ## illustration for varying mscale across items > ## merge with additional random binary response > b <- itemresp(rep(c(-1, 1), length.out = length(r)), + mscale = c(-1, 1), labels = "Dummy") > rb <- merge(r[, 1:2], b) > head(rb, 2) [1] {no,prh,-1} {no,no,1} > ## summary has NAs for non-existent response categories > summary(rb) 0 1 2 S1WantCurse (no,perhaps,yes) 91 95 130 S1DoCurse (no,perhaps,yes) 91 108 117 Dummy (-1,1) 158 158 NA > summary(rb, mscale = FALSE) 0 1 2 S1WantCurse 91 95 130 S1DoCurse 91 108 117 Dummy 158 158 NA > plot(rb, srt = 25) > plot(rb, mscale = FALSE) > > > > cleanEx() > nameEx("threshpar") > ### * threshpar > > flush(stderr()); flush(stdout()) > > ### Name: threshpar > ### Title: Extract Threshold Parameters of Item Response Models > ### Aliases: threshpar threshpar.raschmodel threshpar.rsmodel > ### threshpar.pcmodel threshpar.nplmodel threshpar.gpcmodel > ### coef.threshpar print.threshpar > ### Keywords: classes > > ### ** Examples > > o <- options(digits = 4) > > ## load verbal aggression data > data("VerbalAggression", package = "psychotools") > > ## fit a rasch model to dichotomized verbal aggression data > raschmod <- raschmodel(VerbalAggression$resp2) > > ## extract threshold parameters with sum zero restriction > tr <- threshpar(raschmod) > tr Item response threshold parameters (RM, type mode): S1WantCurse-C1 S1DoCurse-C1 S1WantScold-C1 S1DoScold-C1 S1WantShout-C1 -1.3834 -1.3834 -0.7307 -0.5566 -0.2491 S1DoShout-C1 S2WantCurse-C1 S2DoCurse-C1 S2WantScold-C1 S2DoScold-C1 0.6981 -1.9093 -1.0367 -0.8727 -0.1131 S2WantShout-C1 S2DoShout-C1 S3WantCurse-C1 S3DoCurse-C1 S3WantScold-C1 -0.1810 1.3120 -0.6955 0.0403 0.5136 S3DoScold-C1 S3WantShout-C1 S3DoShout-C1 S4WantCurse-C1 S4DoCurse-C1 1.3348 1.3577 2.8709 -1.2450 -0.8727 S4WantScold-C1 S4DoScold-C1 S4WantShout-C1 S4DoShout-C1 0.1779 0.2126 0.8711 1.8402 > > ## compare to item parameters (again with sum zero restriction) > ip <- itempar(raschmod) > ip Item response item parameters (RM): S1WantCurse S1DoCurse S1WantScold S1DoScold S1WantShout S1DoShout -1.3834 -1.3834 -0.7307 -0.5566 -0.2491 0.6981 S2WantCurse S2DoCurse S2WantScold S2DoScold S2WantShout S2DoShout -1.9093 -1.0367 -0.8727 -0.1131 -0.1810 1.3120 S3WantCurse S3DoCurse S3WantScold S3DoScold S3WantShout S3DoShout -0.6955 0.0403 0.5136 1.3348 1.3577 2.8709 S4WantCurse S4DoCurse S4WantScold S4DoScold S4WantShout S4DoShout -1.2450 -0.8727 0.1779 0.2126 0.8711 1.8402 > > all.equal(coef(tr), coef(ip)) [1] "Names: 24 string mismatches" > > ## rating scale model example > rsmod <- rsmodel(VerbalAggression$resp) > trmod <- threshpar(rsmod, type = "mode") > trmed <- threshpar(rsmod, type = "median") > trmn <- threshpar(rsmod, type = "mean") > > ## compare different types of threshold parameters > cbind("Mode" = coef(trmod, type = "vector"), + "Median" = coef(trmod, type = "vector"), + "Mean" = coef(trmn, type = "vector")) Mode Median Mean S1WantCurse-C1 -1.36551 -1.36551 -0.63583 S1WantCurse-C2 -0.78469 -0.78469 1.21667 S1DoCurse-C1 -1.27784 -1.27784 -0.54819 S1DoCurse-C2 -0.69702 -0.69702 1.30434 S1WantScold-C1 -0.95781 -0.95781 -0.22816 S1WantScold-C2 -0.37699 -0.37699 1.62440 S1DoScold-C1 -0.74918 -0.74918 -0.01953 S1DoScold-C2 -0.16836 -0.16836 1.83301 S1WantShout-C1 -0.48394 -0.48394 0.24574 S1WantShout-C2 0.09688 0.09688 2.09825 S1DoShout-C1 0.13116 0.13116 0.86081 S1DoShout-C2 0.71198 0.71198 2.71335 S2WantCurse-C1 -1.57926 -1.57926 -0.84961 S2WantCurse-C2 -0.99845 -0.99845 1.00292 S2DoCurse-C1 -1.11091 -1.11091 -0.38126 S2DoCurse-C2 -0.53009 -0.53009 1.47126 S2WantScold-C1 -1.01776 -1.01776 -0.28811 S2WantScold-C2 -0.43694 -0.43694 1.56439 S2DoScold-C1 -0.41863 -0.41863 0.31102 S2DoScold-C2 0.16219 0.16219 2.16355 S2WantShout-C1 -0.53396 -0.53396 0.19567 S2WantShout-C2 0.04686 0.04686 2.04823 S2DoShout-C1 0.59875 0.59875 1.32841 S2DoShout-C2 1.17957 1.17957 3.18094 S3WantCurse-C1 -0.70132 -0.70132 0.02833 S3WantCurse-C2 -0.12050 -0.12050 1.88086 S3DoCurse-C1 -0.15887 -0.15887 0.57078 S3DoCurse-C2 0.42194 0.42194 2.42328 S3WantScold-C1 0.14953 0.14953 0.87919 S3WantScold-C2 0.73035 0.73035 2.73172 S3DoScold-C1 0.72406 0.72406 1.45372 S3DoScold-C2 1.30488 1.30488 3.30625 S3WantShout-C1 0.77736 0.77736 1.50703 S3WantShout-C2 1.35818 1.35818 3.35956 S3DoShout-C1 1.93477 1.93477 2.66442 S3DoShout-C2 2.51559 2.51559 4.51694 S4WantCurse-C1 -1.05771 -1.05771 -0.32806 S4WantCurse-C2 -0.47689 -0.47689 1.52445 S4DoCurse-C1 -0.85739 -0.85739 -0.12774 S4DoCurse-C2 -0.27657 -0.27657 1.72479 S4WantScold-C1 -0.19072 -0.19072 0.53893 S4WantScold-C2 0.39009 0.39009 2.39144 S4DoScold-C1 -0.13472 -0.13472 0.59493 S4DoScold-C2 0.44610 0.44610 2.44750 S4WantShout-C1 0.26366 0.26366 0.99331 S4WantShout-C2 0.84448 0.84448 2.84584 S4DoShout-C1 1.04642 1.04642 1.77607 S4DoShout-C2 1.62724 1.62724 3.62860 > > if(requireNamespace("mirt")) { + ## fit a partial credit model and a generalized partial credit model + pcmod <- pcmodel(VerbalAggression$resp) + gpcmod <- gpcmodel(VerbalAggression$resp) + + ## extract the threshold parameters with different default restrictions and + ## therefore incompareable scales + tp <- threshpar(pcmod) + tg <- threshpar(gpcmod) + plot(unlist(tp), unlist(tg), xlab = "PCM", ylab = "GPCM") + abline(a = 0, b = 1) + + ## extract the threshold parameters with the first as the reference leading + ## to a compareable scale visualizing the differences due to different + ## discrimination parameters + tp <- threshpar(pcmod, ref = 1) + tg <- threshpar(gpcmod, ref = 1) + plot(unlist(tp), unlist(tg), xlab = "PCM", ylab = "GPCM") + abline(a = 0, b = 1) + + options(digits = o$digits) + } > > > > cleanEx() > nameEx("upperpar") > ### * upperpar > > flush(stderr()); flush(stdout()) > > ### Name: upperpar > ### Title: Extract Upper Asymptote Parameters of Item Response Models > ### Aliases: upperpar upperpar.raschmodel upperpar.rsmodel upperpar.pcmodel > ### upperpar.nplmodel upperpar.gpcmodel coef.upperpar print.upperpar > ### vcov.upperpar > ### Keywords: classes > > ### ** Examples > > if(requireNamespace("mirt")) { + + o <- options(digits = 3) + + ## load simulated data + data("Sim3PL", package = "psychotools") + + ## fit 2PL to data simulated under the 3PLu + twoplmod <- nplmodel(Sim3PL$resp2) + + ## extract the upper asymptote parameters (all fixed at 1) + up1 <- upperpar(twoplmod) + + ## fit 3PLu to data simulated under the 3PLu + threeplmodu <- nplmodel(Sim3PL$resp2, type = "3PLu") + + ## extract the upper asymptote parameters + up2 <- upperpar(threeplmodu) + + ## extract the standard errors + sqrt(diag(vcov(up2))) + + ## extract the upper asymptote parameters on the logit scale + up2_logit <- upperpar(threeplmodu, logit = TRUE) + + ## along with the delta transformed standard errors + sqrt(diag(vcov(up2_logit))) + + options(digits = o$digits) + } > > > > cleanEx() > nameEx("worth") > ### * worth > > flush(stderr()); flush(stdout()) > > ### Name: worth > ### Title: Extract Worth Parameters > ### Aliases: worth > ### Keywords: classes > > ### ** Examples > > o <- options(digits = 4) > > ## data > data("GermanParties2009", package = "psychotools") > > ## Bradley-Terry model > bt <- btmodel(GermanParties2009$preference) > > ## worth parameters > worth(bt) Bradley-Terry model parameters (btmodel): none Linke Gruene SPD CDU/CSU FDP 0.0768 0.0604 0.3658 0.2520 0.1332 0.1118 > > ## or > itempar(bt) Bradley-Terry model parameters (btmodel): none Linke Gruene SPD CDU/CSU FDP 0.0768 0.0604 0.3658 0.2520 0.1332 0.1118 > > options(digits = o$digits) > > > > ### *