ips.tools: Tools for IPS

#The CTT IA and bucketing functions

#' @title Flag P-Values
#'
#' @description Flags P-Values in Item Stats table.
#'
#' @details
#' Takes the Item Stats table and add flagging columns
#' based on p-values.
#'
#' @param stats The Item Stats table (see imports.itemstats)
#' @param pvalueflag A vector of p-value flagging breaks
#' @return The Item Stats table with flagging columns.
#' @examples ia.flagp(ItemAnalysis, pvalueflag)
#' @family CTT IA
ia.flagp <- function(stats, pvalueflag){
  stats$Pvalueflag <- ifelse(stats$p < pvalueflag[1],-2,
                                    ifelse((stats$p <= pvalueflag[2] & stats$p >= pvalueflag[1]),-1,
                                           ifelse((stats$p >= pvalueflag[3] & stats$p <= pvalueflag[4]), 1,
                                                  ifelse(stats$p > pvalueflag[4],2,0)))) #### Strings Pvalue tiers for ease of classification

  stats$Too_Hard<- ifelse(stats$Pvalueflag < 0, 1, 0) #Flags based on P Value Teir
  stats$Too_Easy<- ifelse(stats$Pvalueflag > 0, 1, 0) #Flags based on P Value Teir

  if("Comments" %in% colnames(stats)){
    if(stats$Too_Hard == 1){
      stats$Comments <- paste(stats$Comments, "Item too hard;", sep = " ")
    }
    if(stats$Too_Easy == 1){
      stats$Comments <- paste(stats$Comments, "Item too easy;", sep = " ")
    }
  }
  else {
    stats$Comments <- NA
    if(stats$Too_Hard == 1){
      stats$Comments <- "Item too hard;"
    }
    if(stats$Too_Easy == 1){
      stats$Comments <- "Item too easy;"
    }
  }

  return(stats)
}

#' @title Flag Point-Biserial
#'
#' @description Flags Point-Biserial values in Item Stats table.
#'
#' @details
#' Takes the Item Stats table and add flagging columns
#' based on point biserial.
#'
#' @param stats The Item Stats table (see imports.itemstats)
#' @param pbisflag A vector of point-biserial flagging breaks
#' @return The Item Stats table with flagging columns.
#' @examples ia.flagpbis(ItemAnalysis, pbisflag)
#' @family CTT IA
ia.flagpbis <- function(stats, pbisflag){
  stats$PBisflag<- ifelse(is.na(stats$pbis),-2,
                                 ifelse(stats$pbis < pbisflag[1], -1,
                                        ifelse((stats$pbis >= pbisflag[1] & stats$pbis < pbisflag[2]),1,
                                               ifelse(stats$pbis >= pbisflag[2],2,-2)))) #### Strings PBis teirs for ease of classification


  stats$Poor_Discrimination <- ifelse(stats$PBisflag == 1, 1, 0) #Flags based on PBis Teir
  stats$Negative_Discrimination <- ifelse(stats$PBisflag < 0, 1, 0) #Flags based on PBis Teir

  if("Comments" %in% colnames(stats)){
    if(stats$Poor_Discrimination == 1){
      stats$Comments <- paste(stats$Comments, "Item doesn't differentiate between high and low performers;", sep = " ")
    }
    if(stats$Negative_Discrimination == 1){
      stats$Comments <- paste(stats$Comments, "Low performers more likely to get the item correct;", sep = " ")
    }
  }
  else {
    stats$Comments <- NA
    if(stats$Poor_Discrimination == 1){
      stats$Comments <- "Item doesn't differentiate between high and low performers;"
    }
    if(stats$Negative_Discrimination == 1){
      stats$Comments <- "Low performers more likely to get the item correct;"
    }
  }

  return(stats)
}

#' @title Flag Potential Miskeys
#'
#' @description Flags potentially miskeyed items in Item Stats table.
#'
#' @details
#' Takes the Item Stats table and add flagging columns
#' based on the possibility of miskeys.
#'
#' @param stats The Item Stats table (see imports.itemstats)
#' @return The Item Stats table with flagging columns.
#' @examples ia.flagmiskey(ItemAnalysis)
#' @family CTT IA
ia.flagmiskey <- function(stats){
  stats$Miskey_A<- ifelse(is.na(stats$pbis_a), 0,
                                 ifelse(((stats$pbis < stats$pbis_a & stats$p_a >= .10) &
                                           stats$PBisflag < 2), 1, 0))
  stats$Miskey_B<- ifelse(is.na(stats$pbis_b), 0,
                                 ifelse(((stats$pbis < stats$pbis_b & stats$p_b >= .10) &
                                           stats$PBisflag < 2), 1, 0))
  stats$Miskey_C<- ifelse(is.na(stats$pbis_c), 0,
                                 ifelse(((stats$pbis < stats$pbis_c & stats$p_c >= .10) &
                                           stats$PBisflag < 2), 1, 0))
  stats$Miskey_D<- ifelse(is.na(stats$pbis_d), 0,
                                 ifelse(((stats$pbis < stats$pbis_d & stats$p_d >= .10) &
                                           stats$PBisflag < 2), 1, 0))

  #Strings name of the potential miskey in the Check_Options column
  stats$Check_Options<-with(stats, {
    Miskey_A[Miskey_A==1]<-"A;"
    Miskey_A[Miskey_A==0]<-""
    Miskey_B[Miskey_B==1]<-"B;"
    Miskey_B[Miskey_B==0]<-""
    Miskey_C[Miskey_C==1]<-"C;"
    Miskey_C[Miskey_C==0]<-""
    Miskey_D[Miskey_D==1]<-"D;"
    Miskey_D[Miskey_D==0]<-""
    Check_Options<- paste(Miskey_A,Miskey_B,Miskey_C,Miskey_D)

    gsub("\\s", "", Check_Options)
  })

  #Sets an overall Miskey column if any of the 4 miskey columns are 1
  stats$Miskey<-ifelse(stats$Miskey_A==1|stats$Miskey_B==1|stats$Miskey_C==1|stats$Miskey_D==1, 1,0)

  #Removes Extra Miskey Columns
  stats <- subset(stats, select = -c(Miskey_A,Miskey_B,Miskey_C,Miskey_D) )

  if("Comments" %in% colnames(stats)){
    if(stats$Miskey == 1){
      stats$Comments <- paste(stats$Comments, "Item potentially miskeyed please view Check_Options column;", sep = " ")
    }

  }
  else {
    stats$Comments <- NA
    if(stats$Miskey == 1){
      stats$Comments <- "Item potentially miskeyed please view Check_Options column;"
    }

  }

  return(stats)
}

#' @title Flag Misfits
#'
#' @description Flags misfitting items in Item Stats table.
#'
#' @details
#' Takes the Item Stats table and add flagging columns
#' based on the possibility of misfits.
#'
#' @param stats The Item Stats table (see imports.itemstats)
#' @return The Item Stats table with flagging columns.
#' @examples ia.flagmisfits(ItemAnalysis)
#' @family CTT IA
ia.flagmisfits <- function(stats){
    stats$Misfit<- ifelse(is.na(stats$outfit_msq), 0,
                                 ifelse(stats$outfit_msq < .5 | stats$outfit_msq > 2, 1, 0))

    if("Comments" %in% colnames(stats)){
      if(stats$Misfit == 1){
        stats$Comments <- paste(stats$Comments, "Misfitting item;", sep = " ")
      }

    }
    else {
      stats$Comments <- NA
      if(stats$Misfit == 1){
        stats$Comments <- "Misfitting item;"
      }

    }

    return(stats)
}

#' @title Item Analysis Bucketing
#'
#' @description Adds bucketing columns to Item Stats table.
#'
#' @details
#' Takes the Item Stats table and adds bucketing columns.
#' Must be called after 'ia.flagp' and 'ia.flagpbis'
#'
#' @param stats The Item Stats table (see imports.itemstats)
#' @return The Item Stats table with bucketing.
#' @examples ia.bucket(ItemAnalysis)
#' @family CTT IA
ia.bucket <- function(stats){
  statsTemp<-subset(stats, ExamFirstTime=="First-Timers", select = c("Item", "ExamFirstTime", "PBisflag", "Pvalueflag"))

  #create column "Bucket"
  statsTemp$Bucket<-NA
  statsTemp$Scored_Temp<-NA


  #Sets bucket based on PValue flag and PBis NEED IF here##
  statsTemp$Bucket<- ifelse((statsTemp$PBisflag==2 & statsTemp$Pvalueflag==0), "Operational",
                                   ifelse(((statsTemp$PBisflag==1 & abs(statsTemp$Pvalueflag)==1) |
                                             (statsTemp$PBisflag==2 & statsTemp$Pvalueflag !=0) |
                                             (statsTemp$PBisflag==1 & statsTemp$Pvalueflag==0)), "Needs Content Review",
                                          ifelse((statsTemp$PBisflag < 0| (statsTemp$PBisflag==1 & abs(statsTemp$Pvalueflag)==2)),"Retire", "Bucket Error")))
  #Suggest to Score Operational Items
  statsTemp$Scored_Temp<- ifelse((statsTemp$PBisflag==2 & statsTemp$Pvalueflag==0),1,0)
  #merge subset data frame to stats by item value
  stats<-merge(x=stats, y=statsTemp[ , c("Item", "Bucket", "Scored_Temp")], by = "Item", all.x=TRUE)

  return(stats)
}

#' @title Run Item Analysis Flagging
#'
#' @description Runs all Item Analysis flagging and bucketing.
#'
#' @details
#' Takes the Item Stats table and adds flagging and bucketing columns.
#' Uses the standard order
#'
#' @param stats The Item Stats table (see imports.itemstats)
#' @param windowed boolean, is form windowed (true) or on-demand (false) (default is TRUE)
#' @param pvalueflag A vector of p-value flagging breaks (default is c(.25,.40,.95,.98))
#' @param pbisflag A vector of point-biserial flagging breaks (default is c(0,.15))
#' @return The Item Stats table with flagging and bucketing.
#' @examples ia.run(ItemAnalysis)
#' @family CTT IA
ia.run <- function(stats, windowed, pvalueflag, pbisflag){
  if (missing(pvalueflag)){
    pvalueflag <- c(.25,.40,.95,.98)
  }
  if (missing(pbisflag)){
    pvalueflag <- c(0,.15)
  }
  if(missing(windowed)){
    windowed <- TRUE
  }
  stats <- ia.flagmiskey(ia.flagpbis(ia.flagp(stats, pvalueflag), pbisflag))
  if(!windowed){
    stats <- flagmisfits(stats)
  }
  return(ia.bucket(stats))
}