Nothing
#' @title Generic Plot Function for Class \code{ata}
#' @author Michael Chajewski (mchajewski@hotmail.com)
#' @description Default plotting function for output objects of class ata. The function detects the object's method and renders the appropriate visualizations.
#' @keywords ata visualization test_form "test form" constraints "form constraints"
#' @usage \\method{plot}{ata}(x,
#' conditem=NA,
#' useconst=TRUE,
#' itemorder=NA,
#' itemlab=NA,
#' useitemlab=FALSE,
#' together=FALSE,
#' ...)
#' @method plot ata
#' @aliases plot plot.ata
#' @param x An output object of class ata generated by either \code{wdm()} or \code{atalp()} from the \code{ata} package.
#' @param conditem Provides a conditional or secondary item classification (i.e. content label). If provided, it must be given in the order of \code{final_ids} in the ata output object.
#' @param useconst Indicator whether all constraints from the test assembly process should be visualized or whether only a selection is desired. If a selection is desired, the name of the constraint as given by the \code{constobj} should be provided. Default is \code{TRUE}.
#' @param itemorder Identifies the item order with which to visualize constraints. If \code{NA} the observed order in the ata object will be used. If provided, the new order for the order of \code{final_ids} in the ata output object must be given.
#' @param itemlab Identifies item labels. Default is \code{NA}. If \code{NA}, then the item ids in the \code{final_ids} vector of the ata output object will be used. If provided, ids must be given in the order of \code{final_ids} in the ata output object.
#' @param useitemlab Identifies if items should be labeled. Default is \code{FALSE}. If \code{FALSE} then the item order in the \code{final_ids} vector of the ata output object will be used as labels. If \code{TRUE}, but itemlab is not provided, then the ids from the \code{final_ids} vector will be used.
#' @param together Should progress plots be stacked together in one plot? Default is \code{FALSE}. Not advisable for situations with more than 5 constraints.
#' @param ... Arguments to be passed to methods.
#' @return The function returns plots of the test form constraints and a cumulative additive constraint list for each constraint if assigned to an object.
#' \item{plots}{For each constraint in the test form two visualizations are considered: 1) A cumulative additive progressive plot showing the change in the constraint total value per selected item, and 2) a plot of the constraint item specific value for each selected item.}
#' \item{cumulative}{If \code{plot.ata} is assigned to an object, the object will inherit a list of length equal to the number of constraints each element containing the cumulative constraint value after each selected item.}
#' @import graphics
#' @export
plot.ata <- function(x, # ata class input to be plotted
conditem=NA, # Secondary item classifiation
useconst=TRUE, # Selection of constraints to be visualized
itemorder=NA, # Preferred item order
itemlab=NA, # Item labels to be used in visualization
useitemlab=FALSE, # Boolean indicator whether items are to be labeled
together=FALSE, # Boolean indicator whether progress plots should be stacked
...){ # Additional arguments to be passed to the function
# ----------------------------------------- #
# Assuring generic function parameter reset #
# ----------------------------------------- #
oldpar <- par(no.readonly = TRUE) # Inheriting old parameters
on.exit(par(oldpar)) # Resetting values on exit
# -------------- #
# Evaluate input #
# -------------- #
# Inherit constraint details
names_const <- names(x$evaluation)[-c(1,2)]
# Define constraints to plot
plotconst <- if(useconst[1]==TRUE){names_const}else{useconst}
# Number of constraints
nC <- length(names_const)
plotnC <- length(plotconst)
# Number of items in form
nI <- dim(x$included)[1]
# Creating item order for visualization and aggregation
if(!is.na(itemorder[1])){
if(length(itemorder) < nI){
stop("Provided item order is shorter than number of items in test form.")
}
if(length(itemorder) > nI){
stop("Provided item order longer than number of items in test form.")
}
if(!all(sort(itemorder)==c(1:nI))){
stop("Provided item order does not reflect ordinal item orer. Item order should include integers from 1 to the total number of items in the form in the desired order of display.")
}
# Setting item order if all tests are passed
useorder <- itemorder
}else{
useorder <- 1:nI
}
# Checking item labels
if(useitemlab==TRUE & !is.na(itemlab[1])){
if(length(itemlab) < nI){
stop("The number of provided item labels is shorter than number of items in test form.")
}
if(length(itemlab) > nI){
stop("The number of provided item labels is longer than number of items in test form.")
}
# Setting item order if all tests are passed
itemlabuse <- itemlab[useorder]
}else if(useitemlab==TRUE & is.na(itemlab[1])){
itemlabuse <- x$final_ids[useorder]
}else{
itemlabuse <- 1:nI
}
# Checking conditional item labels
if(!is.na(conditem[1])){
if(length(conditem) < nI){
stop("The number of provided conditional item labels is shorter than number of items in test form.")
}
if(length(conditem) > nI){
stop("The number of provided conditional item labels is longer than number of items in test form.")
}
}
# Too many constraints to combine
if(nC > 5 & isTRUE(together)){
warning("Large number of constraints should be fisualized separately. Set together = FALSE.")
}
# Stop if requested constraint is not avaiable
if(useconst[1]!=TRUE){
# More requests than in object
if(length(useconst) > nC){
stop("More visualizations requested than available constraints.")
}
if(!all(useconst %in% names_const)){
stop("Identified constraint(s) not in ata object.")
}
}
# ------------------ #
# Create cumulatives #
# ------------------ #
# Creating cumulatives by constraint in useorder order
cumulative <- list()
for(i in 1:nC){
constcumtemp <- c()
for(j in 1:nI){
constcumtemp <- c(constcumtemp,
sum(x$included[useorder[1:j],which(names(x$included)==names_const[i])]))
}
cumulative <- c(cumulative, list(constcumtemp))
names(cumulative)[i] <- names_const[i]
}
# ------------------------- #
# Plots dependant on method #
# [ Currently unavailable ] #
# ------------------------- #
# WDM
if(attributes(x)$method=="wdm"){
}
# LP
if(attributes(x)$method=="lp"){
}
# ------------------------ #
# FORM STATE BY CONSTRAINT #
# ------------------------ #
# PLOT #1: CONTRAINT BOUNDS ADEQUACY AFTER ITEM SELECTION
# Plots combined
if(together==TRUE & plotnC>1){
# Plot layout
#par(mfcol=c(plotnC,1))
layout(matrix(c(sort(rep(1:(plotnC-1),3)),rep(plotnC,5)),plotnC*3+2, 1))
# Sequential additive steps in building test
for(j in 1:plotnC){
# Plotting constraint upper bound
pcub <- x$evaluation[2,which(names(x$evaluation)==plotconst[j])] +
min(c(abs(x$evaluation[2,which(names(x$evaluation)==plotconst[j])]-max(cumulative[[which(names(cumulative)==plotconst[j])]]))/2,
max(x$included[,which(names(x$included)==plotconst[j])]))/2)
# Adding plots
if(j==1 & plotnC==1){
par(mar=c(4.5,4.5,1,1))
if(is.na(conditem[1])){
plot(1:nI,cumulative[[which(names(cumulative)==plotconst[j])]],
type="o", lwd=2,
ylab=plotconst[j], xlab="Item", main="",
ylim=c(0,pcub), pch=20, cex=2, xaxt="n")
}else{
plot(1:nI,cumulative[[which(names(cumulative)==plotconst[j])]],
type="b", lwd=2,
ylab=plotconst[j], xlab="Item", main="",
ylim=c(0,pcub), pch=1, cex=3, xaxt="n")
text(1:nI,cumulative[[which(names(cumulative)==plotconst[j])]],conditem[useorder],cex=.8)
}
axis(1, at=1:nI, labels=itemlabuse)
abline(h=c(x$evaluation[1,which(names(x$evaluation)==plotconst[j])],x$evaluation[2,which(names(x$evaluation)==plotconst[j])]), col=c("darkgreen","red3"), lty=3)
}else if(j==1 & plotnC>1){
par(mar=c(0,4.5,1,1))
if(is.na(conditem[1])){
plot(1:nI,cumulative[[which(names(cumulative)==plotconst[j])]],
type="o", lwd=2,
ylab=plotconst[j], xlab="", main="",
ylim=c(0,pcub), pch=20, cex=2, xaxt="n")
}else{
plot(1:nI,cumulative[[which(names(cumulative)==plotconst[j])]],
type="b", lwd=2,
ylab=plotconst[j], xlab="", main="",
ylim=c(0,pcub), pch=1, cex=3, xaxt="n")
text(1:nI,cumulative[[which(names(cumulative)==plotconst[j])]],conditem[useorder],cex=.8)
}
abline(h=c(x$evaluation[1,which(names(x$evaluation)==plotconst[j])],x$evaluation[2,which(names(x$evaluation)==plotconst[j])]), col=c("darkgreen","red3"), lty=3)
}else if(j>1 & j < plotnC){
par(mar=c(0,4.5,0,1))
if(is.na(conditem[1])){
plot(1:nI,cumulative[[which(names(cumulative)==plotconst[j])]],
type="o", lwd=2,
ylab=plotconst[j], xlab="Item", main="",
ylim=c(0,pcub), pch=20, cex=2, xaxt="n")
}else{
plot(1:nI,cumulative[[which(names(cumulative)==plotconst[j])]],
type="b", lwd=2,
ylab=plotconst[j], xlab="Item", main="",
ylim=c(0,pcub), pch=1, cex=3, xaxt="n")
text(1:nI,cumulative[[which(names(cumulative)==plotconst[j])]],conditem[useorder],cex=.8)
}
abline(h=c(x$evaluation[1,which(names(x$evaluation)==plotconst[j])],x$evaluation[2,which(names(x$evaluation)==plotconst[j])]), col=c("darkgreen","red3"), lty=3)
}else if(j==plotnC){
par(mar=c(4.5,4.5,0,1))
if(is.na(conditem[1])){
plot(1:nI,cumulative[[which(names(cumulative)==plotconst[j])]],
type="o", lwd=2,
ylab=plotconst[j], xlab="Item", main="",
ylim=c(0,pcub), pch=20, cex=2, xaxt="n")
}else{
plot(1:nI,cumulative[[which(names(cumulative)==plotconst[j])]],
type="b", lwd=2,
ylab=plotconst[j], xlab="Item", main="",
ylim=c(0,pcub), pch=1, cex=3, xaxt="n")
text(1:nI,cumulative[[which(names(cumulative)==plotconst[j])]],conditem[useorder],cex=.8)
}
axis(1, at=1:nI, labels=itemlabuse)
abline(h=c(x$evaluation[1,which(names(x$evaluation)==plotconst[j])],x$evaluation[2,which(names(x$evaluation)==plotconst[j])]), col=c("darkgreen","red3"), lty=3)
}
}
# Resetting layout
layout(matrix(1,1,1))
}else{ # End of together plot
for(j in 1:plotnC){
# Plotting constraint upper bound
pcub <- x$evaluation[2,which(names(x$evaluation)==plotconst[j])] +
min(c(abs(x$evaluation[2,which(names(x$evaluation)==plotconst[j])]-max(cumulative[[which(names(cumulative)==plotconst[j])]]))/2,
max(x$included[,which(names(x$included)==plotconst[j])]))/2)
# Plot individual constraints separately
par(mar=c(4.5,4.5,1,1))
if(is.na(conditem[1])){
plot(1:nI,cumulative[[which(names(cumulative)==plotconst[j])]],
type="o", lwd=2,
ylab=plotconst[j], xlab="Item", main="",
ylim=c(0,pcub), pch=20, cex=2, xaxt="n")
}else{
plot(1:nI,cumulative[[which(names(cumulative)==plotconst[j])]],
type="b", lwd=2,
ylab=plotconst[j], xlab="Item", main="",
ylim=c(0,pcub), pch=1, cex=3, xaxt="n")
text(1:nI,cumulative[[which(names(cumulative)==plotconst[j])]],conditem[useorder],cex=.8)
}
axis(1, at=1:nI, labels=itemlabuse)
abline(h=c(x$evaluation[1,which(names(x$evaluation)==plotconst[j])],x$evaluation[2,which(names(x$evaluation)==plotconst[j])]), col=c("darkgreen","red3"), lty=3)
}
} # End of Plot #1
# PLOT #2: ITEM CONSTRAINT VALUE
# Plots combined
if(together==TRUE & plotnC>1){
# Plot layout
#par(mfcol=c(plotnC,1))
layout(matrix(c(sort(rep(1:(plotnC-1),3)),rep(plotnC,5)),plotnC*3+2, 1))
# Sequential additive steps in building test
for(j in 1:plotnC){
# Plotting constraint difference value
pcdv <- min(c(abs(x$evaluation[2,which(names(x$evaluation)==plotconst[j])]-max(cumulative[[which(names(cumulative)==plotconst[j])]]))/2,
max(x$included[,which(names(x$included)==plotconst[j])])/2))
# Adding plots
if(j==1 & plotnC==1){
par(mar=c(4.5,4.5,1,1))
if(is.na(conditem[1])){
plot(1:nI,x$included[useorder,which(names(x$included)==plotconst[j])],
type="o", lwd=2, pch=20, cex=2, main="",
ylim=c(min(x$included[,which(names(x$included)==plotconst[j])])-pcdv,max(x$included[,which(names(x$included)==plotconst[j])])+pcdv),
ylab=plotconst[j], xlab="Item", xaxt="n")
axis(1, at=1:nI, labels=itemlabuse)
}else{
plot(1:nI,x$included[useorder,which(names(x$included)==plotconst[j])],
type="b", lwd=2, pch=1, cex=3, main="",
ylim=c(min(x$included[,which(names(x$included)==plotconst[j])])-pcdv,max(x$included[,which(names(x$included)==plotconst[j])])+pcdv),
ylab=plotconst[j], xlab="Item",xaxt="n")
axis(1, at=1:nI, labels=itemlabuse)
text(1:nI,x$included[useorder,which(names(x$included)==plotconst[j])],conditem[useorder],cex=.8)
}
}else if(j==1 & plotnC>1){
par(mar=c(0,4.5,1,1))
if(is.na(conditem[1])){
plot(1:nI,x$included[useorder,which(names(x$included)==plotconst[j])],
type="o", lwd=2, pch=20, cex=2, main="",
ylim=c(min(x$included[,which(names(x$included)==plotconst[j])])-pcdv,max(x$included[,which(names(x$included)==plotconst[j])])+pcdv),
ylab=plotconst[j], xlab="Item", xaxt="n")
}else{
plot(1:nI,x$included[useorder,which(names(x$included)==plotconst[j])],
type="b", lwd=2, pch=1, cex=3, main="",
ylim=c(min(x$included[,which(names(x$included)==plotconst[j])])-pcdv,max(x$included[,which(names(x$included)==plotconst[j])])+pcdv),
ylab=plotconst[j], xlab="Item",xaxt="n")
text(1:nI,x$included[useorder,which(names(x$included)==plotconst[j])],conditem[useorder],cex=.8)
}
}else if(j>1 & j < plotnC){
par(mar=c(0,4.5,0,1))
if(is.na(conditem[1])){
plot(1:nI,x$included[useorder,which(names(x$included)==plotconst[j])],
type="o", lwd=2, pch=20, cex=2, main="",
ylim=c(min(x$included[,which(names(x$included)==plotconst[j])])-pcdv,max(x$included[,which(names(x$included)==plotconst[j])])+pcdv),
ylab=plotconst[j], xlab="Item", xaxt="n")
}else{
plot(1:nI,x$included[useorder,which(names(x$included)==plotconst[j])],
type="b", lwd=2, pch=1, cex=3, main="",
ylim=c(min(x$included[,which(names(x$included)==plotconst[j])])-pcdv,max(x$included[,which(names(x$included)==plotconst[j])])+pcdv),
ylab=plotconst[j], xlab="Item",xaxt="n")
text(1:nI,x$included[useorder,which(names(x$included)==plotconst[j])],conditem[useorder],cex=.8)
}
}else if(j==plotnC){
par(mar=c(4.5,4.5,0,1))
if(is.na(conditem[1])){
plot(1:nI,x$included[useorder,which(names(x$included)==plotconst[j])],
type="o", lwd=2, pch=20, cex=2, main="",
ylim=c(min(x$included[,which(names(x$included)==plotconst[j])])-pcdv,max(x$included[,which(names(x$included)==plotconst[j])])+pcdv),
ylab=plotconst[j], xlab="Item", xaxt="n")
axis(1, at=1:nI, labels=itemlabuse)
}else{
plot(1:nI,x$included[useorder,which(names(x$included)==plotconst[j])],
type="b", lwd=2, pch=1, cex=3, main="",
ylim=c(min(x$included[,which(names(x$included)==plotconst[j])])-pcdv,max(x$included[,which(names(x$included)==plotconst[j])])+pcdv),
ylab=plotconst[j], xlab="Item",xaxt="n")
axis(1, at=1:nI, labels=itemlabuse)
text(1:nI,x$included[useorder,which(names(x$included)==plotconst[j])],conditem[useorder],cex=.8)
}
}
}
# Resetting layout
layout(matrix(1,1,1))
}else{ # End of together plot
for(j in 1:plotnC){
# Plotting constraint difference value
pcdv <- min(c(abs(x$evaluation[2,which(names(x$evaluation)==plotconst[j])]-max(cumulative[[which(names(cumulative)==plotconst[j])]]))/2,
max(x$included[,which(names(x$included)==plotconst[j])])/2))
# Plot individual constraints separately
par(mar=c(4.5,4.5,1,1))
if(is.na(conditem[1])){
plot(1:nI,x$included[useorder,which(names(x$included)==plotconst[j])],
type="o", lwd=2, pch=20, cex=2, main="",
ylim=c(min(x$included[,which(names(x$included)==plotconst[j])])-pcdv,max(x$included[,which(names(x$included)==plotconst[j])])+pcdv),
ylab=plotconst[j], xlab="Item", xaxt="n")
axis(1, at=1:nI, labels=itemlabuse)
}else{
plot(1:nI,x$included[useorder,which(names(x$included)==plotconst[j])],
type="b", lwd=2, pch=1, cex=3, main="",
ylim=c(min(x$included[,which(names(x$included)==plotconst[j])])-pcdv,max(x$included[,which(names(x$included)==plotconst[j])])+pcdv),
ylab=plotconst[j], xlab="Item",xaxt="n")
axis(1, at=1:nI, labels=itemlabuse)
text(1:nI,x$included[useorder,which(names(x$included)==plotconst[j])],conditem[useorder],cex=.8)
}
}
} # End of Plot #2
# Returning invisible object of cumulative constraints
invisible(cumulative)
} # Close of plotting function
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.