fitMetaDPrime expecting participants as integers

[elisafilevich]

Thanks Manuel for this toolbox, which works great.

fitMetaDPrime requires participant to be an integer. When it's a character string, the function outputs all dprimes=0
I also was not able to run it with .parallel=FALSE.

I could not figure out myself what the problem was, so I used LLM-help. It seems to be an interaction between how apply, subset, and jobs work. I have a modified version of the function that solves both problems.

I am not sure about a pull request because these are AI-fulled changes, but perhaps I can give you the new code and you decide what to do with it, or if you'd like to update other functions in the package, too?

[ManuelRausch]

Hi Elisa! Thanks for checking out the package ;-). It would be great if you shared your code and I will double-check if the proposed changes don't break anything.

[elisafilevich]

Sure, here is chatGPT's updated version

fitMetaDprime <- function (
    data,
    model = "ML",
    nInits = 5,
    nRestart = 3,
    .parallel = FALSE,
    n.cores = NULL
) {
    # --- Basic input checks ---
    if (!all(model %in% c("ML", "F"))) {
        stop("model must be either 'ML' or 'F'")
    }

    if (length(unique(data$stimulus)) != 2) {
        stop("There must be exactly two different possible values of stimulus")
    }

    if (!is.factor(data$stimulus)) {
        data$stimulus <- factor(data$stimulus)
        warning("stimulus was converted to a factor")
    }

    if (!is.factor(data$rating)) {
        data$rating <- factor(data$rating)
        warning("rating was converted to a factor")
    }

    if (!all(data$correct %in% c(0, 1))) {
        stop("correct should be 1 or 0")
    }
    if (!any(data$correct == 0)) stop("There must be at least one erroneous response")
    if (!any(data$correct == 1)) stop("There must be at least one correct response")

    if (nrow(data) < 400)
        warning("At least 400 trials per subject are recommended for stable metacognitive estimates")

    # --- Setup constants ---
    data$participant <- as.character(data$participant)  # ensure string-safe
    nRatings <- length(levels(data$rating))
    abj_f <- 1 / (nRatings * 2)
    outnames <- c("model", "participant", "dprime", "c", "metaD", "Ratio")

    # --- Core fitting function ---
    call_fitfct <- function(X) {
        cur_model <- model[as.integer(X[1])]   # FIXED: numeric index
        cur_sbj   <- as.character(X[2])        # ensure character ID

        # subset robustly
        data_part <- data[data$participant == cur_sbj, , drop = FALSE]

        if (nrow(data_part) == 0) {
            warning(sprintf("No rows found for participant '%s' (model %s)", cur_sbj, cur_model))
            res <- as.data.frame(matrix(NA, nrow = 1, ncol = length(outnames)))
            names(res) <- outnames
            res$model <- cur_model
            res$participant <- cur_sbj
            return(res)
        }

        # run metadprime fit
        res <- int_fitMetaDprime(
            ratings = data_part$rating,
            stimulus = data_part$stimulus,
            correct = data_part$correct,
            ModelVersion = cur_model,
            nInits = nInits,
            nRestart = nRestart,
            nRatings = nRatings,
            abj_f = abj_f
        )

        res$model <- cur_model
        res$participant <- cur_sbj
        res[outnames[!(outnames %in% names(res))]] <- NA
        res <- res[, outnames, drop = FALSE]
        return(res)
    }

    # --- Prepare jobs ---
    subjects <- unique(as.character(data$participant))
    nJobs <- length(model) * length(subjects)
    jobs <- expand.grid(model = seq_along(model), sbj = subjects, stringsAsFactors = FALSE)

    # --- Run jobs (parallel or sequential) ---
    if (.parallel) {
        listjobs <- lapply(seq_len(nrow(jobs)), function(i) {
            c(model = jobs$model[i], sbj = jobs$sbj[i])
        })
        if (is.null(n.cores)) {
            n.cores <- min(nJobs, parallel::detectCores() - 1)
        }
        cl <- parallel::makeCluster(type = "SOCK", n.cores)
        parallel::clusterExport(
            cl,
            c("data", "model", "outnames", "call_fitfct", "nInits", "nRestart", "nRatings", "abj_f"),
            envir = environment()
        )
        on.exit(try(parallel::stopCluster(cl), silent = TRUE))
        res <- parallel::clusterApplyLB(cl, listjobs, fun = call_fitfct)
        parallel::stopCluster(cl)
    } else {
        # safer loop instead of apply()
        res <- lapply(seq_len(nrow(jobs)), function(i) {
            X <- c(jobs$model[i], jobs$sbj[i])
            call_fitfct(X)
        })
    }

    # --- Combine results ---
    res <- do.call(rbind, res)
    res <- res[, apply(res, 2, function(X) any(!is.na(X))), drop = FALSE]
    return(res)
}

[elisafilevich]

I did the absolute most basic test, and compared the Mratio values with the "ML" model. This new version spat out the same values as yours. But I did no further testing!

[ManuelRausch]

Thanks a lot!