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

> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: heritability-package
> ### Title: Marker-Based Estimation of Heritability Using Individual Plant
> ###   or Plot Data.
> ### Aliases: heritability-package heritability
> ### Keywords: heritability mixed model
> 
> ### ** Examples
> 
> # A) marker-based estimation of heritability, given individual plant-data
> # and a marker-based relatedness matrix:
> data(LDV)
> data(K_atwell)
> # This may take up to 30 sec.
> #out1 <- marker_h2(data.vector=LDV$LDV,geno.vector=LDV$genotype,
> #                  covariates=LDV[,4:8],K=K_atwell)
> #
> # B) marker-based estimation of heritability, given genotypic means
> # and a marker-based relatedness matrix:
> data(means_LDV)
> data(R_matrix_LDV)
> data(K_atwell)
> out2 <- marker_h2_means(data.vector=means_LDV$LDV,geno.vector=means_LDV$genotype,
+                         K=K_atwell,Dm=R_matrix_LDV)
 ----------- FAILURE REPORT -------------- 
 --- failure: the condition has length > 1 ---
 --- srcref --- 
: 
 --- package (from environment) --- 
heritability
 --- call from context --- 
AI_algorithm_weights(Y = data.frame(genotype = her.frame$genotype, 
    VALUE), K = K, Dm = Dm, eps = eps, max.iter = max.iter, fix.h2 = fix.h2, 
    h2 = h2)
 --- call from argument --- 
if (!(class(K) %in% c("matrix", "data.frame"))) {
    stop("K should be of class matrix or data.frame")
}
 --- R stacktrace ---
where 1: AI_algorithm_weights(Y = data.frame(genotype = her.frame$genotype, 
    VALUE), K = K, Dm = Dm, eps = eps, max.iter = max.iter, fix.h2 = fix.h2, 
    h2 = h2)
where 2: marker_h2_means(data.vector = means_LDV$LDV, geno.vector = means_LDV$genotype, 
    K = K_atwell, Dm = R_matrix_LDV)

 --- value of length: 2 type: logical ---
[1] FALSE  TRUE
 --- function from context --- 
function (Y, K, Dm, eps = 1e-09, max.iter = 100, escape = 0.3, 
    fix.h2 = FALSE, h2 = 0.5) 
{
    if (escape < 0 | escape >= 0.5) {
        escape <- 0
    }
    if (!(class(K) %in% c("matrix", "data.frame"))) {
        stop("K should be of class matrix or data.frame")
    }
    if (class(K) == "data.frame") {
        class(K) <- "matrix"
    }
    if (is.null(colnames(K)) | is.null(rownames(K))) {
        stop("K should have column and row names")
    }
    if (!(class(Dm) %in% c("matrix", "data.frame"))) {
        stop("Dm should be of class matrix or data.frame")
    }
    if (class(Dm) == "data.frame") {
        class(Dm) <- "matrix"
    }
    if (is.null(colnames(Dm)) | is.null(rownames(Dm))) {
        stop("Dm should have column and row names")
    }
    if (class(Y) != "data.frame") {
        stop("Y should be of class data.frame")
    }
    if (ncol(Y) < 1) {
        stop("Y should be a data.frame with at least two columns: \n The first column of Y should contain the genotype labels, and should be of class factor or character. \n The second column should contain the phenotypic values.")
    }
    if (!(class(Y[, 1]) %in% c("factor", "character"))) {
        stop("The first column of Y should contain the genotype labels, and should be of class factor or character.")
    }
    if (sum(unlist(lapply(Y, class)) %in% c("integer", "numeric")) < 
        (ncol(Y) - 1)) {
        stop("The first column of Y should contain the genotype labels; \n All other columns should be of type numeric or integer.")
    }
    if (max(table(Y[, 1])) > 1) {
        stop("The first column of Y should contain the genotype labels, and each genotype should occur at most once.")
    }
    if (ncol(Y) == 2) {
        Y <- cbind(Y, rep(1, nrow(Y)))
    }
    var.cols <- apply(as.data.frame(Y[, -(1:2)]), 2, var)
    if (sum(var.cols == 0) == 0) {
        Y <- cbind(Y, rep(1, nrow(Y)))
    }
    if (sum(var.cols == 0) > 1) {
        first.intercept <- which(var.cols == 0)[1] + 2
        Y <- Y[, -((which(var.cols == 0)[1] + 2)[-1])]
    }
    Y <- Y[!is.na(Y[, 2]), ]
    Y <- Y[!is.na(Y[, 1]), ]
    names(Y)[1:2] <- c("genotype", "value")
    if (ncol(Y) > 2) {
        Y <- Y[apply(as.data.frame(Y[, -(1:2)]), 1, function(x) {
            sum(is.na(x))
        }) == 0, ]
    }
    if (!all(Y$genotype %in% colnames(K))) {
        no.kinship <- unique(Y$genotype[!(Y$genotype %in% colnames(K))])
        Y <- Y[Y$genotype %in% colnames(K), ]
        if (nrow(Y) == 0) {
            stop("Kinship information is not available for any of the genotypes in Y")
        }
        warning(paste("K does not contain kinship information for genotypes", 
            no.kinship, "; these genotypes are removed from Y."))
    }
    if (!all(Y$genotype %in% colnames(Dm))) {
        no.Dm <- unique(Y$genotype[!(Y$genotype %in% colnames(Dm))])
        Y <- Y[Y$genotype %in% colnames(Dm), ]
        if (nrow(Y) == 0) {
            stop("Weights are not available for any of the genotypes in Y")
        }
        warning(paste("The Dm (weight) matrix does not contain information for genotypes", 
            no.Dm, "; these genotypes are removed from Y."))
    }
    y <- as.matrix(Y[, 2])
    X <- as.matrix(Y[, -(1:2)])
    K <- K[as.character(Y$genotype), as.character(Y$genotype)]
    Dm <- Dm[as.character(Y$genotype), as.character(Y$genotype)]
    Dm_inv <- ginv(Dm)
    N <- nrow(Y)
    n.iter <- 0
    converge <- TRUE
    if (!fix.h2) {
        varcomp.old <- c(0, 0)
        varcomp <- rep(var(as.numeric(y))/2, 2)
        while (sum((varcomp.old - varcomp)^2) > eps & n.iter < 
            max.iter) {
            Vinv <- ginv(varcomp[1] * K + varcomp[2] * Dm)
            P <- Vinv - (Vinv %*% X %*% ginv(t(X) %*% Vinv %*% 
                X) %*% t(X) %*% Vinv)
            deltaL <- -0.5 * c(sum(diag(P %*% K)) - t(y) %*% 
                P %*% K %*% P %*% y, sum(diag(P %*% Dm)) - t(y) %*% 
                P %*% Dm %*% P %*% y)
            AI <- matrix(0, 2, 2)
            AI[1, 2] <- AI[2, 1] <- 0.5 * as.numeric(t(y) %*% 
                P %*% K %*% P %*% Dm %*% P %*% y)
            AI[1, 1] <- 0.5 * as.numeric(t(y) %*% P %*% K %*% 
                P %*% K %*% P %*% y)
            AI[2, 2] <- 0.5 * as.numeric(t(y) %*% P %*% Dm %*% 
                P %*% Dm %*% P %*% y)
            varcomp.old <- varcomp
            varcomp <- varcomp + as.numeric(ginv(AI) %*% deltaL)
            if (sum(varcomp < 0) == 2) {
                guess <- runif(n = 1)
                varcomp <- c(guess * var(as.numeric(y)), (1 - 
                  guess) * var(as.numeric(y)))
            }
            if (escape > 0) {
                guess <- runif(1, 0, escape)
                if (varcomp[1] < 0) {
                  varcomp <- c(guess * var(as.numeric(y)), (1 - 
                    guess) * var(as.numeric(y)))
                }
                if (varcomp[2] < 0) {
                  varcomp <- c((1 - guess) * var(as.numeric(y)), 
                    guess * var(as.numeric(y)))
                }
            }
            if (escape == 0) {
                if (varcomp[1] < 0) {
                  varcomp <- c(0.001 * var(as.numeric(y)), 0.999 * 
                    var(as.numeric(y)))
                }
                if (varcomp[2] < 0) {
                  varcomp <- c(0.999 * var(as.numeric(y)), 0.001 * 
                    var(as.numeric(y)))
                }
            }
            n.iter <- n.iter + 1
            cat("Iteration: ", n.iter, "\t", varcomp, "\n")
        }
        if (sum((varcomp.old - varcomp)^2) > eps & n.iter == 
            max.iter) {
            warning("No convergence in AI-algorithm.")
            converge <- FALSE
        }
        Vinv <- ginv(varcomp[1] * K + varcomp[2] * Dm)
        P <- Vinv - (Vinv %*% X %*% ginv(t(X) %*% Vinv %*% X) %*% 
            t(X) %*% Vinv)
        AI <- matrix(0, 2, 2)
        AI[1, 2] <- AI[2, 1] <- 0.5 * as.numeric(t(y) %*% P %*% 
            K %*% P %*% Dm %*% P %*% y)
        AI[1, 1] <- 0.5 * as.numeric(t(y) %*% P %*% K %*% P %*% 
            K %*% P %*% y)
        AI[2, 2] <- 0.5 * as.numeric(t(y) %*% P %*% Dm %*% P %*% 
            Dm %*% P %*% y)
    }
    else {
        VunscaledInv <- ginv(h2 * K + (1 - h2) * Dm)
        betaHat <- ginv(t(X) %*% VunscaledInv %*% X) %*% t(X) %*% 
            VunscaledInv %*% y
        sigma2 <- (1/ncol(VunscaledInv)) * t(y - X %*% betaHat) %*% 
            VunscaledInv %*% (y - X %*% betaHat)
        varcomp <- c(h2 * sigma2, (1 - h2) * sigma2)
        Vinv <- ginv(varcomp[1] * K + varcomp[2] * Dm)
        P <- Vinv - (Vinv %*% X %*% ginv(t(X) %*% Vinv %*% X) %*% 
            t(X) %*% Vinv)
        deltaL <- -0.5 * c(sum(diag(P %*% K)) - t(y) %*% P %*% 
            K %*% P %*% y, sum(diag(P %*% Dm)) - t(y) %*% P %*% 
            Dm %*% P %*% y)
        AI <- matrix(0, 2, 2)
        AI[1, 2] <- AI[2, 1] <- 0.5 * as.numeric(t(y) %*% P %*% 
            K %*% P %*% Dm %*% P %*% y)
        AI[1, 1] <- 0.5 * as.numeric(t(y) %*% P %*% K %*% P %*% 
            K %*% P %*% y)
        AI[2, 2] <- 0.5 * as.numeric(t(y) %*% P %*% Dm %*% P %*% 
            Dm %*% P %*% y)
    }
    W <- cbind(X, diag(N))
    tX_Z <- t(X) %*% Dm_inv
    Cm <- rbind(cbind(t(X) %*% Dm_inv %*% X, tX_Z), cbind(t(tX_Z), 
        Dm_inv + (varcomp[2]/varcomp[1]) * ginv(K)))
    Pnew <- Dm_inv - Dm_inv %*% W %*% ginv(Cm) %*% t(W) %*% Dm_inv
    AInew <- AI
    AInew[1, 2] <- AInew[2, 1] <- 0.5 * as.numeric(t(y) %*% Pnew %*% 
        K %*% Pnew %*% y)/(varcomp[2])^2
    AInew[1, 1] <- 0.5 * as.numeric(t(y) %*% Pnew %*% K %*% Pnew %*% 
        K %*% Pnew %*% y)/(varcomp[2])
    AInew[2, 2] <- 0.5 * as.numeric(t(y) %*% Pnew %*% y)/(varcomp[2])^3
    V <- varcomp[1] * K + varcomp[2] * Dm
    loglik <- -0.5 * (2 * sum(log(diag(chol(V)))) + log(det(t(X) %*% 
        Vinv %*% X)) + t(y) %*% P %*% y)
    return(list(varcomp = varcomp, inv.ai = ginv(AI), inv.ai.new = ginv(AInew), 
        n.iter = n.iter, eps = eps, loglik = loglik, converge = converge))
}
<bytecode: 0x564b9140ed38>
<environment: namespace:heritability>
 --- function search by body ---
Function AI_algorithm_weights in namespace heritability has this body.
 ----------- END OF FAILURE REPORT -------------- 
Fatal error: the condition has length > 1