Running examples in ‘APIS-Ex.R’ failed
The error most likely occurred in:

> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: APIS
> ### Title: APIS function that assigns with observed data
> ### Aliases: APIS
> ### Keywords: APIS assignment
> 
> ### ** Examples
> 
> data("APIS_offspring")
> data("APIS_sire")
> data("APIS_dam")
> 
> result <- APIS(off.genotype = APIS_offspring[1:50, ],
+                sire.genotype = APIS_sire,
+                dam.genotype = APIS_dam,
+                error = 0.05,
+                verbose = FALSE)
 ----------- FAILURE REPORT -------------- 
 --- failure: the condition has length > 1 ---
 --- srcref --- 
: 
 --- package (from environment) --- 
APIS
 --- call from context --- 
assignmentFortran(offspring = off.genotype, sire = sire.genotype, 
    dam = dam.genotype, thresh = exclusion.threshold, preselect.Parent = preselect.Parent, 
    nb.cores = nb.cores, verbose = verbose)
 --- call from argument --- 
if (class(recode.off) != "matrix") {
    recode.off <- t(as.matrix(recode.off))
} else {
}
 --- R stacktrace ---
where 1: assignmentFortran(offspring = off.genotype, sire = sire.genotype, 
    dam = dam.genotype, thresh = exclusion.threshold, preselect.Parent = preselect.Parent, 
    nb.cores = nb.cores, verbose = verbose)
where 2: APIS(off.genotype = APIS_offspring[1:50, ], sire.genotype = APIS_sire, 
    dam.genotype = APIS_dam, error = 0.05, verbose = FALSE)

 --- value of length: 2 type: logical ---
[1] FALSE  TRUE
 --- function from context --- 
function (offspring, sire, dam, thresh = ncol(offspring), preselect.Parent = FALSE, 
    nb.cores = 2, verbose = TRUE) 
{
    if (ncol(offspring) != ncol(sire) & ncol(offspring) != ncol(dam)) 
        stop("Genotypes must have the same number of markers")
    offspring.name <- rownames(offspring)
    genotyped.mrk <- as.numeric(apply(offspring, 1, function(X) {
        length(X[X != "NA/NA"])
    }))
    e <- 0.01
    i <- NULL
    off <- NULL
    P <- NULL
    if (verbose) {
        cat("Estimation of allele frequencies \n")
    }
    Freq <- allFreq(offspring)
    x.col <- ncol(offspring)
    iterations <- nrow(offspring)
    parent.genotype <- rbind(sire, dam)
    parent.sex <- c(rep("M", times = nrow(sire)), rep("F", times = nrow(dam)))
    if (verbose) {
        cat("Recoding datasets \n")
    }
    recodeFortran <- function(mrk, list.mrk) {
        tmp <- unlist(strsplit(mrk, "/"))
        all1 <- list.mrk[which(list.mrk[, 1] == tmp[1]), 2]
        all2 <- list.mrk[which(list.mrk[, 1] == tmp[2]), 2]
        return(c(all1, all2))
    }
    recodeFreq <- function(name.col, list.mrk) {
        tmp <- unlist(strsplit(name.col, "_"))[2]
        return(list.mrk[which(list.mrk[, 1] == tmp), 2])
    }
    variant <- unique(unlist(strsplit(as.vector(rbind(offspring, 
        sire, dam)), "/")))
    variant <- variant[-which(variant == "NA")]
    variant.corres <- data.frame(variant = as.character(variant), 
        recode = c(1:length(variant)))
    variant.corres$variant <- as.character(variant.corres$variant)
    variant.corres <- rbind(variant.corres, c(as.character("NA"), 
        0))
    if (verbose) {
        cat("Number of cores used :", nb.cores, "\n")
    }
    cl <- parallel::makeCluster(nb.cores)
    doParallel::registerDoParallel(cl)
    if (verbose) {
        f_recode_off_verbose <- function() {
            pb <- txtProgressBar(min = 0, max = iterations, char = "><> ", 
                style = 3)
            count <- 1
            function(...) {
                count <<- count + length(list(...)) - 1
                setTxtProgressBar(pb, count)
                Sys.sleep(0.01)
                flush.console()
                rbind(...)
            }
        }
        recode.off <- foreach(i = 1:iterations, .combine = f_recode_off_verbose()) %dopar% 
            {
                tmp <- as.numeric(as.vector(sapply(offspring[i, 
                  , drop = FALSE], recodeFortran, list.mrk = variant.corres)))
            }
    }
    else {
        recode.off <- foreach(i = 1:iterations, .combine = rbind) %dopar% 
            {
                tmp <- as.numeric(as.vector(sapply(offspring[i, 
                  , drop = FALSE], recodeFortran, list.mrk = variant.corres)))
            }
    }
    if (verbose) {
        cat("\n")
    }
    if (verbose) {
        f_recode_sire_verbose <- function() {
            pb <- txtProgressBar(min = 0, max = nrow(sire), char = "><> ", 
                style = 3)
            count <- 1
            function(...) {
                count <<- count + length(list(...)) - 1
                setTxtProgressBar(pb, count)
                Sys.sleep(0.01)
                flush.console()
                rbind(...)
            }
        }
        recode.sire <- foreach(i = 1:nrow(sire), .combine = f_recode_sire_verbose()) %dopar% 
            {
                tmp <- as.numeric(as.vector(sapply(sire[i, , 
                  drop = FALSE], recodeFortran, list.mrk = variant.corres)))
            }
    }
    else {
        recode.sire <- foreach(i = 1:nrow(sire), .combine = rbind) %dopar% 
            {
                tmp <- as.numeric(as.vector(sapply(sire[i, , 
                  drop = FALSE], recodeFortran, list.mrk = variant.corres)))
            }
    }
    if (verbose) {
        cat("\n")
    }
    if (verbose) {
        f_recode_dam_verbose <- function() {
            pb <- txtProgressBar(min = 0, max = nrow(dam), char = "><> ", 
                style = 3)
            count <- 1
            function(...) {
                count <<- count + length(list(...)) - 1
                setTxtProgressBar(pb, count)
                Sys.sleep(0.01)
                flush.console()
                rbind(...)
            }
        }
        recode.dam <- foreach(i = 1:nrow(dam), .combine = f_recode_dam_verbose()) %dopar% 
            {
                tmp <- as.numeric(as.vector(sapply(dam[i, , drop = FALSE], 
                  recodeFortran, list.mrk = variant.corres)))
            }
    }
    else {
        recode.dam <- foreach(i = 1:nrow(dam), .combine = rbind) %dopar% 
            {
                tmp <- as.numeric(as.vector(sapply(dam[i, , drop = FALSE], 
                  recodeFortran, list.mrk = variant.corres)))
            }
    }
    parallel::stopCluster(cl)
    if (verbose) {
        cat("\n")
    }
    if (class(recode.off) != "matrix") {
        recode.off <- t(as.matrix(recode.off))
    }
    else {
    }
    if (class(recode.sire) != "matrix") {
        recode.sire <- t(as.matrix(recode.sire))
    }
    else {
    }
    if (class(recode.dam) != "matrix") {
        recode.dam <- t(as.matrix(recode.dam))
    }
    else {
    }
    rownames(recode.off) <- rownames(offspring)
    rownames(recode.sire) <- rownames(sire)
    rownames(recode.dam) <- rownames(dam)
    Freq <- Freq[, -which(colnames(Freq) == "Freq_NA")]
    Freq <- Freq[, c((floor(ncol(Freq)/2) + 2):ncol(Freq))]
    colnames(Freq) <- sapply(colnames(Freq), recodeFreq, list.mrk = variant.corres)
    Freq <- rbind(colnames(Freq), Freq)
    add.freq <- as.numeric(variant.corres$recode[-which(variant.corres$recode %in% 
        Freq[1, ])])
    add.freq <- add.freq[-which(add.freq == 0)]
    add.freqMatrix <- matrix(data = c(add.freq, rep(0, times = length(add.freq) * 
        (nrow(Freq) - 1))), ncol = length(add.freq), nrow = nrow(Freq), 
        byrow = TRUE)
    Freq <- apply(Freq, 2, as.numeric)
    Freq <- cbind(Freq, add.freqMatrix)
    Freq <- Freq[, order(Freq[1, ])]
    Freq <- Freq[-1, ]
    if (verbose) {
        cat("Assignment \n")
    }
    cl <- parallel::makeCluster(nb.cores)
    doParallel::registerDoParallel(cl)
    if (verbose) {
        f_assign_verbose <- function() {
            pb <- txtProgressBar(min = 1, max = iterations, char = "><(((*> ", 
                style = 3)
            count <- 1
            function(...) {
                count <<- count + length(list(...)) - 1
                setTxtProgressBar(pb, count)
                Sys.sleep(0.01)
                flush.console()
                rbind(...)
            }
        }
        A <- foreach(off = 1:iterations, .combine = f_assign_verbose()) %dopar% 
            {
                tmp <- recode.off[off, ]
                if (!preselect.Parent) {
                  potential.sire <- rownames(sire)
                  potential.dam <- rownames(dam)
                }
                else {
                  potential.parents <- selectParents(offspring[off, 
                    ], parent.genotype = parent.genotype, parent.sex = parent.sex, 
                    n.Parent = preselect.Parent)
                  potential.sire <- potential.parents$sire_toKeep
                  potential.dam <- potential.parents$dam_toKeep
                }
                tmp.sire <- recode.sire[which(rownames(recode.sire) %in% 
                  potential.sire), ]
                tmp.dam <- recode.dam[which(rownames(recode.dam) %in% 
                  potential.dam), ]
                res <- matrix(NA, nrow = (length(potential.sire) * 
                  length(potential.dam)), ncol = 4)
                colnames(res) <- c("sire", "dam", "score_exclu", 
                  "P_mendel")
                res[, 1] <- rep(potential.sire, each = length(potential.dam))
                res[, 2] <- rep(potential.dam, times = length(potential.sire))
                nMrk = as.integer(x.col)
                nSires = as.integer(length(potential.sire))
                nDams = as.integer(length(potential.dam))
                nVariant = as.integer(ncol(Freq))
                output_sires = vector(mode = "integer", length = nSires * 
                  nDams)
                output_dams = vector(mode = "integer", length = nSires * 
                  nDams)
                output_score = vector(mode = "numeric", length = nSires * 
                  nDams)
                output_miss = vector(mode = "numeric", length = nSires * 
                  nDams)
                outputFortran <- .Fortran("likelihoodCalculation", 
                  as.integer(tmp), as.integer(tmp.sire), as.integer(tmp.dam), 
                  as.integer(nMrk), as.integer(nVariant), as.integer(nSires), 
                  as.integer(nDams), as.double(Freq), output_sires, 
                  output_dams, as.double(output_score), as.integer(output_miss))
                res[, 3] <- as.integer(outputFortran[[12]])
                res[, 4] <- exp(as.numeric(as.numeric(outputFortran[[11]]))/genotyped.mrk[off])
                res <- as.data.frame(res)
                res$sire <- as.character(res$sire)
                res$dam <- as.character(res$dam)
                res$score_exclu <- as.numeric(as.character(res$score_exclu))
                res$P_mendel <- as.numeric(as.character(res$P_mendel))
                res2 <- res[order(res[, 4], res[, 3], decreasing = TRUE), 
                  ]
                delta_P12 <- res2[1, 4] - res2[2, 4]
                delta_P23 <- res2[2, 4] - res2[3, 4]
                p_fin <- res2[1, 1]
                m_fin <- res2[1, 2]
                out.log <- unlist(c(offspring.name[off], genotyped.mrk[off], 
                  p_fin, m_fin, res2[1, 3:4], res2[2, 1:4], delta_P12, 
                  res2[3, 1:4], delta_P23))
                res2 <- res[order(res[, 3], -res[, 4], decreasing = FALSE), 
                  ]
                out.exclu <- unlist(c(offspring.name[off], genotyped.mrk[off], 
                  res2[1, 1:3], res2[2, 1:3], res2[3, 1:3]))
                return(c(out.log, out.exclu))
            }
    }
    else {
        A <- foreach(off = 1:iterations, .combine = rbind) %dopar% 
            {
                tmp <- recode.off[off, ]
                if (!preselect.Parent) {
                  potential.sire <- rownames(sire)
                  potential.dam <- rownames(dam)
                }
                else {
                  potential.parents <- selectParents(offspring[off, 
                    ], parent.genotype = parent.genotype, parent.sex = parent.sex, 
                    n.Parent = preselect.Parent)
                  potential.sire <- potential.parents$sire_toKeep
                  potential.dam <- potential.parents$dam_toKeep
                }
                tmp.sire <- recode.sire[which(rownames(recode.sire) %in% 
                  potential.sire), ]
                tmp.dam <- recode.dam[which(rownames(recode.dam) %in% 
                  potential.dam), ]
                res <- matrix(NA, nrow = (length(potential.sire) * 
                  length(potential.dam)), ncol = 4)
                colnames(res) <- c("sire", "dam", "score_exclu", 
                  "P_mendel")
                res[, 1] <- rep(potential.sire, each = length(potential.dam))
                res[, 2] <- rep(potential.dam, times = length(potential.sire))
                nMrk = as.integer(x.col)
                nSires = as.integer(length(potential.sire))
                nDams = as.integer(length(potential.dam))
                nVariant = as.integer(ncol(Freq))
                output_sires = vector(mode = "integer", length = nSires * 
                  nDams)
                output_dams = vector(mode = "integer", length = nSires * 
                  nDams)
                output_score = vector(mode = "numeric", length = nSires * 
                  nDams)
                output_miss = vector(mode = "numeric", length = nSires * 
                  nDams)
                outputFortran <- .Fortran("likelihoodCalculation", 
                  as.integer(tmp), as.integer(tmp.sire), as.integer(tmp.dam), 
                  as.integer(nMrk), as.integer(nVariant), as.integer(nSires), 
                  as.integer(nDams), as.double(Freq), output_sires, 
                  output_dams, as.double(output_score), as.integer(output_miss))
                res[, 3] <- as.integer(outputFortran[[12]])
                res[, 4] <- exp(as.numeric(as.numeric(outputFortran[[11]]))/genotyped.mrk[off])
                res <- as.data.frame(res)
                res$sire <- as.character(res$sire)
                res$dam <- as.character(res$dam)
                res$score_exclu <- as.numeric(as.character(res$score_exclu))
                res$P_mendel <- as.numeric(as.character(res$P_mendel))
                res2 <- res[order(res[, 4], res[, 3], decreasing = TRUE), 
                  ]
                delta_P12 <- res2[1, 4] - res2[2, 4]
                delta_P23 <- res2[2, 4] - res2[3, 4]
                p_fin <- res2[1, 1]
                m_fin <- res2[1, 2]
                out.log <- unlist(c(offspring.name[off], genotyped.mrk[off], 
                  p_fin, m_fin, res2[1, 3:4], res2[2, 1:4], delta_P12, 
                  res2[3, 1:4], delta_P23))
                res2 <- res[order(res[, 3], -res[, 4], decreasing = FALSE), 
                  ]
                out.exclu <- unlist(c(offspring.name[off], genotyped.mrk[off], 
                  res2[1, 1:3], res2[2, 1:3], res2[3, 1:3]))
                return(c(out.log, out.exclu))
            }
    }
    parallel::stopCluster(cl)
    if (verbose) {
        cat("\n")
    }
    ped.log <- as.data.frame(A[, 1:16])
    colnames(ped.log) <- c("offspring", "mrk_genotype", "sire1", 
        "dam1", "mismatch1", "mendel1", "sire2", "dam2", "mismatch2", 
        "mendel2", "delta_Pmendel12", "sire3", "dam3", "mismatch3", 
        "mendel3", "delta_Pmendel23")
    rownames(ped.log) <- c(1:nrow(ped.log))
    ped.log[, ] <- sapply(ped.log[, c(1:ncol(ped.log))], as.character)
    ped.log[, c(2, 5:6, 9:11, 14:16)] <- sapply(ped.log[, c(2, 
        5:6, 9:11, 14:16)], as.numeric)
    ped.exclu <- as.data.frame(A[, 17:ncol(A)])
    colnames(ped.exclu) <- c("off", "mrk_genotype", "sire1", 
        "dam1", "mismatch1", "sire2", "dam2", "mismatch2", "sire3", 
        "dam3", "mismatch3")
    rownames(ped.exclu) <- c(1:nrow(ped.exclu))
    ped.exclu[, c(2, 5, 8, 11)] <- sapply(ped.exclu[, c(2, 5, 
        8, 11)], as.numeric)
    ped <- ped.log[, c(1, 3:4)]
    return(list(pedigree = ped, log.mendel = ped.log, log.exclu = ped.exclu, 
        nb.mrk = ncol(offspring)))
}
<bytecode: 0x564916a167a8>
<environment: namespace:APIS>
 --- function search by body ---
Function assignmentFortran in namespace APIS has this body.
 ----------- END OF FAILURE REPORT -------------- 
Fatal error: the condition has length > 1