R/confusioncvfNB.R

In jchitpin/blistR:

confusioncvfNB <- function(nbOutput, nameColTF){

    ## Initialize list of matrices (confusion matrix for each feature combination)
    confusion <- matrix(data = 0, nrow = 2, ncol = 2,
                        dimnames = list(c("Pred.True", "Pred.False"), c("True", "False")))
    confusion <- lapply(seq_along(nbOutput[[1]]), function(x) confusion)

    ## Initialize list of vectors (number of non-classified assignments for each
    ## feature combination)
    noclass <- matrix(data = 0, nrow=1, ncol = 1)
    noclass <- lapply(seq_len(length(nbOutput[[1]])), function(x) noclass)

    ## Error checking 'nameColTF'
    if(any(grepl(nameColTF, colnames(nbOutput[[1]][[1]]))) == F){
        stop(paste0("Could not find the column name ", nameColTF, ". Valid options include: 'dupMAP', 'nodupMAP', or 'MWBM'"))
    } else{
        evalNameColTF <- parse(text=nameColTF)
    }

    ## Loop over each fold
    for(i in seq_along(nbOutput)){
        ## Loop over each feature combination
        for(j in seq_along(nbOutput[[i]])){

            ## Special 'noClass' column case for MWBM
            if(nameColTF == "MWBM"){

                ## True positives
                confusion[[j]][1,1] <- confusion[[j]][1,1] +
                    nrow(nbOutput[[i]][[j]][eval(evalNameColTF) == T &
                                                Actual_choice == T &
                                                NoClass == F])
                ## False positives
                confusion[[j]][1,2] <- confusion[[j]][1,2] +
                    nrow(nbOutput[[i]][[j]][eval(evalNameColTF) == T &
                                                Actual_choice == F &
                                                NoClass == F])
                ## False negatives
                confusion[[j]][2,1] <- confusion[[j]][2,1] +
                    nrow(nbOutput[[i]][[j]][eval(evalNameColTF) == F &
                                                Actual_choice == T &
                                                (is.na(NoClass) == T | NoClass == F)])
                ## True negatives
                confusion[[j]][2,2] <- confusion[[j]][2,2] +
                    nrow(nbOutput[[i]][[j]][eval(evalNameColTF) == F &
                                                Actual_choice == F &
                                                (is.na(NoClass) == T | NoClass == F)])

                ## Non-classified
                noclass[[j]][1] <- noclass[[j]][1] + nrow(nbOutput[[i]][[j]]) -
                    nrow(nbOutput[[i]][[j]][eval(evalNameColTF) == T &
                                                Actual_choice == T &
                                                NoClass == F]) -
                    nrow(nbOutput[[i]][[j]][eval(evalNameColTF) == T &
                                                Actual_choice == F &
                                                NoClass == F]) -
                    nrow(nbOutput[[i]][[j]][eval(evalNameColTF) == F &
                                                Actual_choice == T &
                                                (is.na(NoClass) == T | NoClass == F)]) -
                    nrow(nbOutput[[i]][[j]][eval(evalNameColTF) == F &
                                                Actual_choice == F &
                                                (is.na(NoClass) == T | NoClass == F)])
            } else {
                ## True positives
                confusion[[j]][1,1] <- confusion[[j]][1,1] +
                    nrow(nbOutput[[i]][[j]][eval(evalNameColTF) == TRUE &
                                                Actual_choice == TRUE])

                ## False positives
                confusion[[j]][1,2] <- confusion[[j]][1,2] +
                    nrow(nbOutput[[i]][[j]][eval(evalNameColTF) == TRUE &
                                                Actual_choice == FALSE])

                ## False negatives
                confusion[[j]][2,1] <- confusion[[j]][2,1] +
                    nrow(nbOutput[[i]][[j]][eval(evalNameColTF) == FALSE &
                                                Actual_choice == TRUE])

                ## True negatives
                confusion[[j]][2,2] <- confusion[[j]][2,2] +
                    nrow(nbOutput[[i]][[j]][eval(evalNameColTF) == FALSE &
                                                Actual_choice == FALSE])

                ## Non-classified
                noclass[[j]][1] <- noclass[[j]][1] + nrow(nbOutput[[i]][[j]]) -
                    nrow(nbOutput[[i]][[j]][eval(evalNameColTF) == TRUE & Actual_choice == TRUE]) -
                    nrow(nbOutput[[i]][[j]][eval(evalNameColTF) == TRUE & Actual_choice == FALSE]) -
                    nrow(nbOutput[[i]][[j]][eval(evalNameColTF) == FALSE & Actual_choice == TRUE]) -
                    nrow(nbOutput[[i]][[j]][eval(evalNameColTF) == FALSE & Actual_choice == FALSE])
            }
        }
    }

    confusionMat <- list(confusion, noclass)
    names(confusionMat) <- c("confusion", "noclass")

    return(confusionMat)

}