R/plot.ata.R

In ata: Automated Test Assembly

#' @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