shiluoye 运行下面的代码即可。标出了需要修改的地方。其实就是把源代码里的函数重写一下,修改里面的相应内容。
library(CDM)
# 重写函数
plot_din <- function(x, items = c(1:ncol(x$data)), pattern = "", uncertainty = 0.1,
top.n.skill.classes = 6, pdf.file = "", hide.obs = FALSE,
display.nr = 1:4, ask = TRUE, ...)
{
hide.idi <- FALSE
if ((pattern[1] != "") & (length(pattern) > 1)) {
pattern <- paste(pattern, collapse = "")
}
suc <- which(unique(x$pattern[, "pattern"]) == pattern)
if (pdf.file != "")
try(pdf(file = pdf.file, ...))
try(if (uncertainty < 0 || uncertainty > 0.5 || top.n.skill.classes <
0 || top.n.skill.classes > 2^length(x$skill.patt))
warning("check your plot parameter specifications. See Help-files."))
old.par <- graphics::par(no.readonly = TRUE)
on.exit(graphics::par(old.par))
if (1 %in% display.nr) {
errors <- rbind(x$guess[, 1], x$slip[, 1])[, items]
colnames(errors) <- items
errors[2, ] <- 1 - errors[2, ]
graphics::barplot(errors,
ylim = c(0, 1.5),
beside = TRUE,
col = c("gray", "darkred"), xlab = "Item index",
ylab = "Probability", cex.lab = 1.3)
if (!hide.idi) {
if (FALSE) {
}
else {
# 若修改图例,则需修改下面这个函数的参数
graphics::legend("topright", c("Guessing probability",
"Non-Slipping probability"), lty = c(1, 1),
pch = c(NA, NA), lwd = c(2, 2), col = c("gray",
"darkred"), bty = 'n')
}
}
else {
graphics::legend("topright", c("guessing parameter",
"slipping parameter"), lty = c(1, 1), lwd = c(2,
2), col = c("gray", "darkred"), bg = "gray97")
}
if (pdf.file == "" & ask)
graphics::par(ask = TRUE)
if (1 == display.nr[length(display.nr)])
graphics::par(ask = FALSE)
}
if (2 %in% display.nr) {
skill.patterns <- x$skill.patt[length(x$skill.patt):1,
]
ind <- match(apply(x$item.patt.split, 1, paste, collapse = ""),
unique(x$pattern)[, "pattern"])
EAP <- ifelse(unique(x$pattern)[ind, grep("post.attr",
colnames(x$pattern))] > 0.5 + uncertainty, 1, NA)
master <- colSums(apply(EAP, 2, function(y) y * x$item.patt.freq),
na.rm = TRUE)
master <- (master/nrow(x$data))[length(x$skill.patt):1]
graphics::par(yaxt = "n")
graphics::barplot(skill.patterns, horiz = TRUE, ylim = c(0,
length(skill.patterns) * 1.2), xlim = c(0, 1), xlab = "Skill mastery probability",
axes = F, cex.lab = 1.3, col = "gray")
graphics::axis(1, at = seq(0, 1, 0.2))
graphics::axis(3, at = seq(0, 1, 0.2))
if (is.null(attributes(x$q.matrix)$skill.labels)) {
attr(x$q.matrix, "skill.labels") <- colnames(x$q.matrix)
}
graphics::text(attributes(x$q.matrix)$skill.labels[length(x$skill.patt):1],
x = c(rep(0.01, length(skill.patterns))), y = seq(0.7,
0.7 + 1.2 * (length(skill.patterns) - 1), 1.2),
col = "black", pos = 4, cex = 1.3)
if (!hide.obs) {
}
if (pdf.file == "" & ask)
graphics::par(ask = TRUE)
if (2 == display.nr[length(display.nr)])
graphics::par(ask = FALSE)
graphics::par(yaxt = "s")
}
if (3 %in% display.nr) {
patt.fq <- x$attribute.patt[, 1]
main.effects <- which(rownames(x$attribute.patt) %in%
rownames(x$attribute.patt[order(x$attribute.patt[,
1], decreasing = TRUE), ][1:min(top.n.skill.classes,
2^length(x$skill.patt)), ]))
graphics::par(xaxt = "n")
graphics::par(mar = c(6, 4, 4, 2) + 0.1)
graphics::plot(c(0:(length(patt.fq) + 1)), c(0, t(patt.fq),
0), type = "h", ylab = "Skill class probability",
xlab = "", ylim = c(0, max(patt.fq) + 0.02), cex.lab = 1.3,
col = c(NA, rep("black", length(patt.fq)), NA))
graphics::par(xaxt = "s")
graphics::axis(1, at = main.effects, las = 2, labels = rownames(x$attribute.patt)[main.effects],
cex.axis = 0.8)
eps <- 0.2
PP <- length(patt.fq)
if (PP < 65) {
for (pp in 1:PP) {
graphics::rect(xleft = pp - eps, ybottom = 0,
xright = pp + eps, ytop = patt.fq[pp], col = "black")
}
}
graphics::par(mar = c(5, 4, 4, 2) + 0.1)
if (pdf.file == "" & ask)
graphics::par(ask = TRUE)
if (3 == display.nr[length(display.nr)])
graphics::par(ask = FALSE)
}
if (4 %in% display.nr) {
if (pattern != "") {
if (length(suc) == 0)
warning("The specified pattern was not achieved.")
post.skill <- as.matrix(unique(x$pattern)[suc, grep("post.attr",
colnames(x$pattern))])[nrow(x$skill.patt):1]
names(post.skill) <- colnames(x$q.matrix)[nrow(x$skill.patt):1]
graphics::par(mar = c(5, 4, 4, 2) + 0.1)
graphics::par(mgp = c(3.5, 1, 0))
graphics::par(yaxt = "n")
graphics::barplot(post.skill, horiz = TRUE, xlab = paste("Skill probabilities conditional on response pattern\n",
pattern, sep = ""), xlim = c(0, 1), axes = FALSE,
cex.lab = 1.3, col = "gray")
graphics::axis(1, at = seq(0, 1, 0.2))
graphics::abline(v = c(0.5 - uncertainty, 0.5 +
uncertainty), lty = 1, col = "darkred", lwd = 2)
graphics::axis(3, at = c((0.5 - uncertainty)/2,
0.5, 0.5 + uncertainty + (1 - (0.5 + uncertainty))/2),
tick = F, labels = c("not mastered", "unclassified",
"mastered"), cex.axis = 1.3, mgp = c(3, 0,
0))
if (is.null(attributes(x$q.matrix)$skill.labels)) {
attr(x$q.matrix, "skill.labels") <- colnames(x$q.matrix)
}
graphics::text(attributes(x$q.matrix)$skill.labels[length(x$skill.patt):1],
x = c(rep(0.01, length(row.names(x$skill.patt)))),
y = seq(0.7, 0.7 + 1.2 * (length(row.names(x$skill.patt)) -
1), 1.2), col = "black", pos = 4, cex = 1.3)
graphics::par(yaxt = "s")
graphics::par(mar = c(5, 4, 4, 2) + 0.1)
graphics::par(mgp = c(3, 1, 0))
if (4 == display.nr[length(display.nr)])
graphics::par(ask = FALSE)
}
}
if (pdf.file != "")
try(dev.off())
graphics::par(old.par)
invisible()
}
# 运行
ecpe <- din(data.ecpe$data[,-1], data.ecpe$q.matrix)
par(mfrow=c(2,2))
plot_din(ecpe, pattern=data.ecpe$data[1,-1])