#---------------------------------------------------------------- # Load the package library("equate") #---------------------------------------------------------------- # Preparing score distributions # ACTmath data act.x <- as.freqtab(ACTmath[, 1:2]) act.y <- as.freqtab(ACTmath[, c(1, 3)]) # Summarizing ACTmath head(act.x) rbind(x = summary(act.x), y = summary(act.y)) # KBneat data neat.x <- freqtab(KBneat$x, scales = list(0:36, 0:12)) neat.y <- freqtab(KBneat$y, scales = list(0:36, 0:12)) # PISA data attach(PISA) r3items <- paste(items$itemid[items$clusterid == "r3a"]) r6items <- paste(items$itemid[items$clusterid == "r6"]) r5items <- paste(items$itemid[items$clusterid == "r5"]) r7items <- paste(items$itemid[items$clusterid == "r7"]) pisa <- freqtab(students[students$book == 6, ], items = list(c(r3items, r6items), c(r5items, r7items)), scales = list(0:31, 0:29), design = "sg") round(data.frame(summary(pisa), row.names = c("r3r6", "r5r7")), 2) # Plotting plot(x = act.x, lwd = 2, xlab = "Score", ylab = "Count") plot(neat.x) # Smoothing presmoothing(~ poly(total, 3, raw = T) + poly(anchor, 3, raw = T) + total:anchor, data = neat.x) neat.xsf <- with(as.data.frame(neat.x), cbind(total, total^2, total^3, anchor, anchor^2, anchor^3, total*anchor)) presmoothing(neat.x, smooth = "loglinear", scorefun = neat.xsf) neat.xs <- presmoothing(neat.x, smooth = "log", degrees = list(3, 1)) neat.xsmat <- presmoothing(neat.x, smooth = "loglinear", degrees = list(3, 1), stepup = TRUE) plot(neat.xs) plot(neat.x, neat.xsmat, ylty = 1:4) round(rbind(x = summary(neat.x), xs = summary(neat.xs)), 2) presmoothing(neat.x, smooth = "loglinear", degrees = list(c(3, 3), c(1, 1)), compare = TRUE) #---------------------------------------------------------------- # The equate function # Equating ACTmath equate(act.x, act.y, type = "mean") neat.ef <- equate(neat.x, neat.y, type = "equip", method = "frequency estimation", smoothmethod = "log") # Summarize KBneat equating summary(neat.ef) # Converting scores cbind(newx = c(3, 29, 8, 7, 13), yx = equate(c(3, 29, 8, 7, 13), y = neat.ef)) head(neat.ef$concordance) # Composite equating neat.i <- equate(neat.x, neat.y, type = "ident") neat.lt <- equate(neat.x, neat.y, type = "linear", method = "tucker") neat.comp <- composite(list(neat.i, neat.lt), wc = .5, symmetric = TRUE) # Plot composite equating results plot(neat.comp, addident = FALSE) #---------------------------------------------------------------- # Example 1 # Linking with different scale lengths and item types # Single group equating pisa.i <- equate(pisa, type = "ident", lowp = c(3.5, 2)) pisa.m <- equate(pisa, type = "mean", lowp = c(3.5, 2)) pisa.l <- equate(pisa, type = "linear", lowp = c(3.5, 2)) pisa.c <- equate(pisa, type = "circ", lowp = c(3.5, 2)) pisa.e <- equate(pisa, type = "equip", smooth = "log", lowp = c(3.5, 2)) # Plotting plot(pisa.i, pisa.m, pisa.l, pisa.c, pisa.e, addident = F, xpoints = pisa, morepars = list(ylim = c(0, 31))) #---------------------------------------------------------------- # Example 2 # Linking with multiple anchors pisa.x <- freqtab(totals$b4[1:200, c("r3a", "r2", "s2")], scales = list(0:15, 0:17, 0:18)) pisa.y <- freqtab(totals$b4[201:400, c("r4a", "r2", "s2")], scales = list(0:16, 0:17, 0:18)) pisa.mnom <- equate(pisa.x, pisa.y, type = "mean", method = "nom") pisa.mtuck <- equate(pisa.x, pisa.y, type = "linear", method = "tuck") pisa.mfreq <- equate(pisa.x, pisa.y, type = "equip", method = "freq", smooth = "loglin") pisa.snom <- equate(margin(pisa.x, 1:2), margin(pisa.y, 1:2), type = "mean", method = "nom") pisa.stuck <- equate(margin(pisa.x, 1:2), margin(pisa.y, 1:2), type = "linear", method = "tuck") pisa.sfreq <- equate(margin(pisa.x, 1:2), margin(pisa.y, 1:2), type = "equip", method = "freq", smooth = "loglin") plot(pisa.snom, pisa.stuck, pisa.sfreq, pisa.mnom, pisa.mtuck, pisa.mfreq, col = rep(rainbow(3), 2), lty = rep(1:2, each = 3)) #---------------------------------------------------------------- # Example 3 # Parametric bootstrapping # Smoothed population distributions neat.xp <- presmoothing(neat.x, "loglinear", degrees = list(4, 2)) neat.xpmat <- presmoothing(neat.x, "loglinear", degrees = list(4, 2), stepup = TRUE) neat.yp <- presmoothing(neat.y, "loglinear", degrees = list(4, 2)) neat.ypmat <- presmoothing(neat.y, "loglinear", degrees = list(4, 2), stepup = TRUE) # Plotting smoothed distributions plot(neat.x, neat.xpmat) plot(neat.y, neat.ypmat) # Set seed, replications, bootstrap sample sizes, and criterion set.seed(131031) reps <- 100 xn <- 100 yn <- 100 crit <- equate(neat.xp, neat.yp, "e", "c")$conc$yx # Create equating arguments and run bootstrapping neat.args <- list(i = list(type = "i"), mt = list(type = "mean", method = "t"), mc = list(type = "mean", method = "c"), lt = list(type = "lin", method = "t"), lc = list(type = "lin", method = "c"), ef = list(type = "equip", method = "f", smooth = "log"), ec = list(type = "equip", method = "c", smooth = "log"), ct = list(type = "circ", method = "t"), cc = list(type = "circ", method = "c", chainmidp = "lin")) bootout <- bootstrap(x = neat.xp, y = neat.yp, xn = xn, yn = yn, reps = reps, crit = crit, args = neat.args) # Plot bootstrapping results plot(bootout, addident = F, col = c(1, rainbow(8))) plot(bootout, out = "se", addident = F, col = c(1, rainbow(8)), legendplace = "top") plot(bootout, out = "bias", addident = F, legendplace = "top", col = c(1, rainbow(8)), morepars = list(ylim = c(-.9, 3))) plot(bootout, out = "rmse", addident = F, legendplace = "top", col = c(1, rainbow(8)), morepars = list(ylim = c(0, 3))) # Summarize bootstrapping results round(summary(bootout), 2) #----------------------------------------------------------------