Nothing
# Define plot() function for class "PerFit":
plot.PerFit <- function (x, #x = an object from 'PerFit' class
cutoff.obj=NULL, #cutoff.obj = an object from 'PerFit.cutoff' class
ModelFit="NonParametric", Nreps=1000,
IP=x$IP, IRT.PModel=x$IRT.PModel, Ability=x$Ability, Ability.PModel=x$Ability.PModel, mu=0, sigma=1,
Blvl = 0.05, Breps = 1000, CIlvl = 0.95,
UDlvl = NA,
#
Type="Density", Both.scale=TRUE, Cutoff=TRUE, Cutoff.int=TRUE, Flagged.ticks = TRUE,
Xlabel=NA, Xcex=1.5, title=NA, Tcex=1.5,
col.area="lightpink", col.hist="lightblue", col.int="darkgreen", col.ticks="red", ...)
{
# Sanity check - Class PerFit:
Sanity.cls(x)
#
upp.PFS <- c("Cstar", "C.Sato", "U3", "ZU3", "G", "Gnormed", "Gpoly", "Gnormed.poly", "U3poly", "D.KB")
low.PFS <- c("r.pbis", "NCI", "Ht", "A.KB", "E.KB", "lz", "lzstar", "lzpoly")
#
pf.scores <- x$PFscores[[1]]
PFS.NA <- is.na(pf.scores)
pf.scores.noNAs <- pf.scores[!PFS.NA]
#
if (is.null(cutoff.obj))
{
cutoff.res <- cutoff(x, ModelFit, Nreps, IP, IRT.PModel, Ability, Ability.PModel, mu, sigma, Blvl, Breps, CIlvl, UDlvl)
} else
{
Sanity.clsPO(cutoff.obj)
cutoff.res <- cutoff.obj
}
#
x.line <- cutoff.res$Cutoff
perc.flagged <- round(100 * cutoff.res$Prop.flagged, 2)
direction <- paste(", ", cutoff.res$Tail, " ", sep = "")
#
PFS.flagged <- flagged.resp(x, cutoff.res, scores = FALSE)[[1]][,2]
# Find correct scale for y-axis:
ymax.hist <- max(hist(pf.scores.noNAs, plot = FALSE)$density)
ymax.dens <- max(density(pf.scores.noNAs)$y)
ymax <- switch(Type,
Density = ymax.dens,
Histogram = ymax.hist,
Both = if (Both.scale == TRUE) {max(ymax.dens,ymax.hist)} else {min(ymax.dens,ymax.hist)})
par(mar=c(4,3.5,2,1)+.1,las=1)
hist(pf.scores.noNAs, freq = FALSE, border = "white", ann = FALSE, ylim = c(0, ymax))
#
if (Cutoff == TRUE)
{
if (any(x$PFStatistic == upp.PFS))
{
rect(x.line, 0, par("usr")[2], par("usr")[4],col = col.area, border = NA)
}
if (any(x$PFStatistic == low.PFS))
{
rect(par("usr")[1], 0, x.line, par("usr")[4], col = col.area, border = NA)
}
}
#
if (Type == "Histogram")
{
par(new = TRUE)
hist(pf.scores.noNAs, freq = FALSE, col = col.hist, ann = FALSE, ylim = c(0, ymax))
}
#
if (Type == "Density")
{
points(density(pf.scores.noNAs), type = "l", lwd = 2, ann = FALSE, ylim = c(0, ymax))
}
#
if (Type == "Both")
{
par(new=TRUE)
hist(pf.scores.noNAs, freq = FALSE, col = col.hist, ann = FALSE, ylim = c(0,ymax))
points(density(pf.scores.noNAs), type = "l",lwd = 2,ann = FALSE,ylim = c(0,ymax))
}
box(col="black")
#
if (Cutoff == FALSE)
{
tmp <- if (is.na(Xlabel)) {x$PFStatistic} else {Xlabel}
mtext(side = 1, text = tmp, line = 2.5, col = "black", cex = 1.5, font = 1)
}
# Add flagged respondents:
if (Flagged.ticks == TRUE)
{
axis(3, at = PFS.flagged, labels = FALSE, tick = TRUE, lwd.ticks = 2, col.ticks = col.ticks)
}
# Add bootstrap CIlvl% CI to x-axis:
if (Cutoff.int == TRUE)
{
segments(x0 = cutoff.res$Cutoff.CI[1], y0 = par("usr")[3],
x1 = cutoff.res$Cutoff.CI[2], y1 = par("usr")[3], lwd = 6, col = col.int, xpd = TRUE)
}
#
if (Cutoff == TRUE)
{
abline(v = x.line, lwd = 2)
tmp <- if (is.na(Xlabel))
{
paste(x$PFStatistic, " (cutoff = ",round(x.line,3),direction,perc.flagged,"%)", sep = "")
} else
{
Xlabel
}
mtext(side = 1, text = tmp, line = 2.5, col = "black", cex = Xcex, font = 1)
}
#
tmp <- if (is.na(title))
{
"Distribution"
} else
{
title
}
mtext(side = 3, text = tmp, line = .5, col = "black", cex = Tcex, font = 2)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.