R/dichoDif.r

In difR: Collection of Methods to Detect Dichotomous Differential Item Functioning (DIF)

# DIF: COMPARING DIF STATISTICS

dichoDif<-function (Data, group, focal.name, method, anchor = NULL, props = NULL, 
    thrTID = 1.5, alpha = 0.05, MHstat = "MHChisq", correct = TRUE, 
    exact = FALSE, stdWeight = "focal", thrSTD = 0.1, BDstat = "BD", 
    member.type = "group", match = "score", type = "both", criterion = "LRT", 
    model = "2PL", c = NULL, engine = "ltm", discr = 1, irtParam = NULL, 
    same.scale = TRUE, signed = FALSE, purify = FALSE, purType = "IPP1", nrIter = 10, extreme = "constraint", const.range = c(0.001, 0.999), nrAdd = 1,
    p.adjust.method=NULL,save.output = FALSE, output = c("out", "default")) 
{
    internalDicho <- function() {
        mets <- c("TID", "MH", "Std", "Logistic", "BD", "Lord", 
            "Raju", "LRT","SIBTEST")
        prov.met <- rep(0, length(method))
        for (i in 1:length(method)) {
            if (sum(method[i] == mets) == 1) 
                prov.met[i] <- 1
        }
        if (min(prov.met) == 0) {
            ind <- min((1:length(method))[prov.met == 0])
            RES <- list(NULL, method[ind])
            class(RES) <- "dichoDif"
            return(RES)
        }
        else {
            if (length(method) == 1) 
                return(selectDif(Data = Data, group = group, 
                  focal.name = focal.name, method = method, anchor = anchor, 
                  props = props, thrTID = thrTID, alpha = alpha, 
                  MHstat = MHstat, correct = correct, exact = exact, 
                  stdWeight = stdWeight, thrSTD = thrSTD, BDstat = BDstat, 
                  member.type = member.type, match = match, type = type, 
                  criterion = criterion, model = model, c = c, 
                  engine = engine, discr = discr, irtParam = irtParam, 
                  same.scale = same.scale, signed = signed, purify = purify, purType=purType,
                  nrIter = nrIter, extreme = extreme, const.range = const.range, nrAdd = nrAdd, p.adjust.method = p.adjust.method, save.output = save.output, 
                  output = output))
            else {
                mat <- iters <- conv <- anchor.names <- NULL
                for (met in 1:length(method)) {
                  prov <- selectDif(Data = Data, group = group, 
                    focal.name = focal.name, method = method[met], 
                    anchor = anchor, props = props, thrTID = thrTID, 
                    alpha = alpha, MHstat = MHstat, correct = correct, 
                    exact = exact, stdWeight = stdWeight, thrSTD = thrSTD, 
                    BDstat = BDstat, member.type = member.type, 
                    match = match, type = type, criterion = criterion, 
                    model = model, c = c, engine = engine, discr = discr, 
                    irtParam = irtParam, same.scale = same.scale, 
                    signed = signed, purify = purify, purType=purType, nrIter = nrIter, extreme = extreme, const.range = const.range, nrAdd = nrAdd, 
                    p.adjust.method = p.adjust.method)
                  if (method[met] != "LRT") 
                    anchor.names <- prov$anchor.names
                  if (method[met] == "BD" | method[met]=="TID") 
                    mat <- cbind(mat, rep("NoDIF", nrow(prov[[1]])))
                  else mat <- cbind(mat, rep("NoDIF", length(prov[[1]])))
                  if (!is.character(prov$DIFitems)) 
                    mat[prov$DIFitems, met] <- "DIF"
                  rname <- prov$names
                  if (purify) {
                    iters <- c(iters, prov$nrPur)
                    conv <- c(conv, prov$convergence)
                  }
                }
                method2 <- method
                method2[method == "TID"] <- "T.I.D."
                method2[method == "MH"] <- "M-H"
                method2[method == "Std"] <- "Stand."
                method2[method=="SIBTEST" & type=="udif"]<- "SIBTEST"
                method2[method=="SIBTEST" & type!="udif"]<- "CSIBTEST"
                colnames(mat) <- method2
                if (!is.null(rname)) 
                  rownames(mat) <- rname
                else {
                  rname <- NULL
                  for (i in 1:nrow(mat)) rname <- c(rname, paste("Item", 
                    i, sep = ""))
                  rownames(mat) <- rname
                }
                RES <- list(DIF = mat, props = props, thrTID = thrTID, 
                  correct = correct, exact = exact, alpha = alpha, 
                  MHstat = MHstat, stdWeight = stdWeight, thrSTD = thrSTD, 
                  BDstat = BDstat, member.type = member.type, 
                  match = match, type = type, criterion = criterion, 
                  model = model, c = c, engine = engine, discr = discr, 
                  irtParam = irtParam, same.scale = same.scale, 
                  signed = signed, purification = purify, purType=purType, nrPur = iters, 
                  convergence = conv, anchor.names = anchor.names, extreme = extreme, const.range = const.range, nrAdd = nrAdd, 
                  p.adjust.method = p.adjust.method, save.output = save.output, output = output)
                class(RES) <- "dichoDif"
                return(RES)
            }
        }
    }
    resToReturn <- internalDicho()
    if (save.output) {
        if (output[2] == "default") 
            wd <- paste(getwd(), "/", sep = "")
        else wd <- output[2]
        fileName <- paste(wd, output[1], ".txt", sep = "")
        capture.output(resToReturn, file = fileName)
    }
    return(resToReturn)
}




# METHODS
print.dichoDif<-function (x, ...) 
{
    res <- x
    if (is.null(res[[1]])) 
        cat("Error: '", res[[2]], "' is not a correct method!", 
            "\n", "\n", sep = "")
    else {
        cat("Comparison of DIF detection results using", ncol(res$DIF), 
            "methods", "\n", "\n")
        methods <- colnames(res$DIF)
        methods2 <- methods
        methods2[methods == "T.I.D."] <- "Transformed item difficulties (TID)"
        methods2[methods == "M-H"] <- "Mantel-Haenszel"
        methods2[methods == "Stand."] <- "Standardization"
        methods2[methods == "Logistic"] <- "Logistic regression"
        methods2[methods == "BD"] <- "Breslow-Day"
        methods2[methods == "Raju"] <- "Raju's area"
        methods2[methods == "Lord"] <- "Lord's chi-square test"
        methods2[methods == "LRT"] <- "Likelihood ratio test"
        methods2[methods == "CSIBTEST"] <- "Crossing-SIBTEST"
        cat("Methods used:", "\n")
        for (i in 1:length(methods2)) cat(" ", methods2[i], "\n", 
            sep = "")
        cat("\n")
    if (res$match[1] == "score") 
        cat("Matching variable: test score", "\n", "\n")
    else cat("Matching variable: specified matching variable", 
        "\n", "\n")
        if (is.null(res$anchor.names)) {
            itk <- 1:nrow(res$DIF)
            cat("No set of anchor items was provided", "\n", 
                "\n")
        }
        else {
            if (is.numeric(res$anchor.names)) {
                itk <- res$anchor.names
                itk.names <- rownames(res$DIF)[itk]
            }
            else {
                itk <- NULL
                for (tt in 1:length(res$anchor.names)) itk[tt] <- (1:nrow(res$DIF))[rownames(res$DIF) == 
                  res$anchor.names[tt]]
                itk.names <- res$anchor.names
            }
            cat("Anchor items (provided by the user):", "\n")
            mm <- cbind(itk.names)
            rownames(mm) <- rep("", nrow(mm))
            colnames(mm) <- ""
            print(mm, quote = FALSE)
            cat("\n", "\n")
        }
        cat("Parameters:", "\n")
        cat(" Significance level: ", res$alpha, "\n", sep = "")
        if (sum(methods == "T.I.D.") == 1) 
            cat(" TID threshold:", res$thrTID, "\n")
        if (sum(methods == "Stand.") == 1) 
            cat(" Standardization threshold:", res$thrSTD, "\n")
        if (sum(methods == "M-H") == 1) {
            if (res$MHstat == "MHChisq") 
                MHmet <- "Chi-square statistic"
            else MHmet <- "Log odds-ratio statistic"
            cat(" Mantel-Haenszel DIF statistic:", MHmet, "\n")
            if (res$correct) 
                corr <- "Yes"
            else corr <- "No"
            cat(" Mantel-Haenszel continuity correction:", corr, 
                "\n")
            if (res$exact) 
                cat(" Type of Mantel-Haenszel test: exact test", 
                  "\n")
            else cat(" Type of Mantel-Haenszel test: asymptotic test", 
                "\n")
        }
        if (sum(methods == "Stand.") == 1) {
            stdw <- ifelse(res$stdWeight == "total", "both groups", 
                ifelse(res$stdWeight == "focal", "the focal group", 
                  "the reference group"))
            cat(" Weights for standardized P-DIF statistic: based on", 
                stdw, "\n")
        }
        if (sum(methods == "BD") == 1) {
            if (res$BDstat == "BD") 
                BDmet <- "Breslow-Day statistic"
            else BDmet <- "trend test statistic"
            cat(" Breslow-Day DIF statistic:", BDmet, "\n")
        }
        if (sum(methods == "Logistic") == 1) {
            cat(" Logistic regression DIF statistic:", res$criterion, 
                "statistic", "\n")
            resLog <- ifelse(res$type == "both", "both", ifelse(res$type == 
                "udif", "uniform", "non uniform"))
            resLog2 <- ifelse(res$type == "both", "effects", 
                "effect")
            cat(" DIF effect(s) tested by logistic regression:", 
                resLog, "DIF", resLog2, "\n")
        }
        if (sum(methods == "Lord" | methods == "Raju") >= 1) {
            cat(" Item response model:", res$model, "\n")
            if (res$model != "1PL" | res$engine == "ltm") 
                cat(" Engine 'ltm' for item parameter estimation", 
                  "\n")
            else cat(" Engine 'lme4' for item parameter estimation", 
                "\n")
            if (res$model == "1PL" & res$engine == "ltm") {
                if (is.null(res$discr)) 
                  cat(" Common discrimination parameter: estimated from 'ltm'", 
                    "\n")
                else cat(" Common discrimination parameter: fixed to ", 
                  res$discr, "\n", sep = "")
            }
            if (!is.null(res$c)) {
                if (length(res$c) == 1) 
                  cat(" Common pseudo-guessing value: ", res$c, 
                    "\n", sep = "")
                else {
                  pg <- cbind(res$c)
                  rownames(pg) <- res$names
                  colnames(pg) <- "c"
                  cat(" Common pseudo-guessing values:", "\n")
                  print(pg)
                  cat("\n")
                }
            }
        }
        if (sum(methods == "Raju") == 1) {
            if (res$signed) 
                cat(" Type of Raju's Z statistic: signed area", 
                  "\n")
            else cat(" Type of Raju's Z statistic: unsigned area", 
                "\n")
        }
        if (res$purification & is.null(res$anchor.names)) {
            cat(" Item purification: Yes", "\n", "\n")
            cat(" Item purification results:", "\n", "\n")
            co <- rep("Yes", length(res$convergence))
            co[!res$convergence] <- "No"
            resConv <- data.frame(rbind(co, res$nrPur))
            colnames(resConv) <- colnames(res$DIF)
            rownames(resConv) <- c("Convergence", "Iterations")
            print(format(resConv, justify = "centre"))
            cat("\n")
        }
        else cat(" Item purification: No", "\n", "\n")
    if (is.null(res$p.adjust.method)) 
        cat(" No p-value adjustment for multiple comparisons", 
            "\n", "\n")
    else {
        pAdjMeth <- switch(res$p.adjust.method, bonferroni = "Bonferroni", 
            holm = "Holm", hochberg = "Hochberg", hommel = "Hommel", 
            BH = "Benjamini-Hochberg", BY = "Benjamini-Yekutieli")
        cat(" Multiple comparisons made with", pAdjMeth, "adjustement of p-values", 
            "\n", "\n")
    }
        cat("Comparison of DIF detection results:", "\n", "\n")
        nr <- NULL
        for (i in 1:nrow(res$DIF)) nr[i] <- paste(length(res$DIF[i, 
            ][res$DIF[i, ] == "DIF"]), "/", ncol(res$DIF), sep = "")
        MAT <- cbind(res$DIF, nr)
        colnames(MAT)[ncol(MAT)] <- "#DIF"
        print(format(MAT, justify = "centre"), quote = FALSE)
    }
    if (!x$save.output) 
        cat("\n", "Output was not captured!", "\n")
    else {
        if (x$output[2] == "default") 
            wd <- paste(getwd(), "/", sep = "")
        else wd <- x$output[2]
        fileName <- paste(wd, x$output[1], ".txt", sep = "")
        cat("\n", "Output was captured and saved into file", 
            "\n", " '", fileName, "'", "\n", "\n", sep = "")
    }
}