Running examples in 'sn-Ex.R' failed
The error most likely occurred in:

> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: extractSECdistr
> ### Title: Extract the SEC error term from an object created by 'selm'
> ### Aliases: extractSECdistr
> ### Keywords: multivariate distribution
> 
> ### ** Examples
> 
> data(ais)
> m2 <- selm(log(Fe) ~ 1, family="ST", data=ais, fixed=list(nu=8))
Warning in model.matrix.default(mt, mf, contrasts) :
  non-list contrasts argument ignored
Warning in if (class(u) == "try-error") { :
  the condition has length > 1 and only the first element will be used
Warning in if (class(u) == "try-error") { :
  the condition has length > 1 and only the first element will be used
Warning in if (class(u) == "try-error") { :
  the condition has length > 1 and only the first element will be used
 ----------- FAILURE REPORT -------------- 
 --- failure: the condition has length > 1 ---
 --- srcref --- 
: 
 --- package (from environment) --- 
sn
 --- call from context --- 
selm.fit(x, y, family = family, start, w = w, fixed.param = fixed.param, 
    offset = offset, selm.control = contr)
 --- call from argument --- 
if (class(u) == "try-error") NULL else u
 --- R stacktrace ---
where 1: selm.fit(x, y, family = family, start, w = w, fixed.param = fixed.param, 
    offset = offset, selm.control = contr)
where 2: selm(log(Fe) ~ 1, family = "ST", data = ais, fixed = list(nu = 8))

 --- value of length: 2 type: logical ---
[1] FALSE FALSE
 --- function from context --- 
function (x, y, family = "SN", start = NULL, w, fixed.param = list(), 
    offset = NULL, selm.control = list()) 
{
    if (!(toupper(family) %in% c("SN", "ST", "SC"))) 
        stop(gettextf("I do not know family '%s'", family), domain = NA)
    family <- toupper(family)
    if (is.null(n <- nrow(x))) 
        stop("'x' must be a matrix")
    if (n == 0L) 
        stop("0 (non-NA) cases")
    if (NROW(y) != n) 
        stop("'x' and 'y' have non-compatible dimensions")
    p <- ncol(x)
    if ((p == 0L) || !(all(data.matrix(x)[, 1] == 1))) 
        stop("first column of model matrix is not all 1's")
    y <- drop(y)
    d <- NCOL(y)
    if (d > 1 && is.null(colnames(y))) 
        colnames(y) <- paste("V", 1:d, sep = "")
    if (is.null(colnames(x))) 
        colnames(x) <- paste("x", 0L:(p - 1), sep = ".")
    if (!is.null(offset)) 
        y <- (y - offset)
    if (NROW(y) != n) 
        stop("incompatible dimensions")
    if (missing(w) || is.null(w)) 
        w <- rep(1, n)
    nw <- sum(w)
    n.obs <- NROW(y)
    contr <- list(method = "MLE", penalty = NULL, trace = FALSE, 
        info.type = "observed", opt.method = "nlminb", opt.control = list())
    control <- selm.control
    contr[(namc <- names(control))] <- control
    symmetr <- FALSE
    if (length(fixed.param) > 0) {
        if (!all(names(fixed.param) %in% c("nu", "alpha"))) 
            stop("Not admissible component of 'fixed.param'")
        if (!is.null(fixed.param$alpha)) {
            if (fixed.param$alpha != 0) 
                stop("'alpha' can only be fixed at 0")
            else symmetr <- TRUE
        }
    }
    zero.weights <- any(w == 0)
    if (zero.weights) {
        save.r <- y
        save.f <- y
        save.w <- w
        ok <- (w != 0)
        nok <- !ok
        w <- w[ok]
        x0 <- x[!ok, , drop = FALSE]
        x <- x[ok, , drop = FALSE]
        n <- nrow(x)
        y0 <- if (d > 1L) 
            y[!ok, , drop = FALSE]
        else y[!ok]
        y <- if (d > 1L) 
            y[ok, , drop = FALSE]
        else y[ok]
    }
    storage.mode(x) <- "double"
    storage.mode(y) <- "double"
    info.type <- contr$info.type
    yInfo <- if (contr$info.type == "observed") 
        y
    else NULL
    penalty <- contr$penalty
    penalty.fn <- if (is.null(penalty)) 
        NULL
    else get(penalty, inherits = TRUE)
    trace <- contr$trace
    if (d == 1) {
        y <- as.vector(y)
        if (family == "SN") {
            npar <- p + 2 - as.numeric(symmetr)
            if (symmetr) {
                ls <- lm.wfit(x, y, w)
                res <- residuals(ls)
                s2 <- sum(w * res^2)/nw
                param <- c(coef(ls), sqrt(s2))
                j <- rbind(cbind(t(x) %*% (w * x)/s2, 0), c(rep(0, 
                  p), 2 * nw/s2))
                j.inv <- pd.solve(j)
                se <- sqrt(diag(j.inv))
                info <- list(dp = param, cp = param, info.dp = j, 
                  info.cp = j, asyvar.dp = j.inv, asyvar.cp = j.inv, 
                  se.dp = se, se.cp = se, aux = NULL)
                logL <- (-0.5 * nw) * (log(2 * pi * s2) + 1)
                fit <- list(cp = param, dp = param, dp.complete = c(param, 
                  0), opt.method = list(ls$qr), logL = logL)
                boundary <- FALSE
                fit$opt.method <- list(method = "least_squares", 
                  called.by = "lm.wfit")
                mu0 <- 0
            }
            else {
                cp <- if (is.null(start)) 
                  NULL
                else dp2cpUv(start, "SN")
                fit <- sn.mple(x, y, cp, w, penalty, trace, contr$opt.method, 
                  contr$control)
                fit$dp <- cp2dpUv(cp = fit$cp, family = "SN")
                boundary <- fit$boundary
                mu0 <- fit$cp[1] - fit$dp[1]
                info <- if (boundary) 
                  NULL
                else sn.infoUv(dp = fit$dp, x = x, y = yInfo, 
                  w = w, penalty = penalty)
            }
        }
        if (family == "ST") {
            fixed.nu <- fixed.param$nu
            npar <- p + 2 + as.numeric(is.null(fixed.nu)) - as.numeric(symmetr)
            fit <- st.mple(x, y, dp = start, w, fixed.nu, symmetr, 
                penalty, trace, contr$opt.method, contr$control)
            dp <- fit$dp
            cp <- st.dp2cp(dp, cp.type = "proper", fixed.nu = fixed.nu, 
                upto = 4 - as.numeric(!is.null(fixed.nu)))
            p_cp <- st.dp2cp(dp, cp.type = "pseudo", fixed.nu = fixed.nu, 
                jacobian = TRUE)
            fit$cp <- cp[1:npar]
            fit$p_cp <- p_cp[1:npar]
            Dpcp.dp <- attr(p_cp, "jacobian")[1:npar, 1:npar]
            attr(p_cp, "jacobian") <- NULL
            boundary <- fit$boundary
            nu <- if (is.null(fixed.nu)) 
                dp[npar]
            else fixed.nu
            mu0 <- if (nu <= 1) 
                NA
            else st.dp2cp(dp, fixed.nu = fixed.nu, upto = 1)[1] - 
                dp[1]
            info <- if (boundary) 
                NULL
            else st.infoUv(dp = fit$dp, NULL, x, yInfo, w, fixed.nu, 
                symmetr, penalty)
        }
        if (family == "SC") {
            npar <- p + 2 - as.numeric(symmetr)
            fit <- st.mple(x, y, dp = start, w, fixed.nu = 1, 
                symmetr, penalty, trace, contr$opt.method, contr$control)
            fit$cp <- NULL
            p_cp0 <- st.dp2cp(fit$dp, cp.type = "pseudo", fixed.nu = 1, 
                jacobian = TRUE)
            fit$p_cp <- p_cp0[1:npar]
            Dpcp.dp <- attr(p_cp0, "jacobian")[1:npar, 1:npar]
            attr(p_cp0, "jacobian") <- NULL
            boundary <- fit$boundary
            mu0 <- NA
            info <- if (boundary) 
                NULL
            else st.infoUv(dp = fit$dp, x = x, y = yInfo, w = w, 
                fixed.nu = 1, symmetr = symmetr)
        }
        if (!boundary && family %in% c("ST", "SC")) {
            u <- try(Dpcp.dp %*% info$asyvar.dp %*% t(Dpcp.dp), 
                silent = TRUE)
            info$asyvar.p_cp <- if (class(u) == "try-error") 
                NULL
            else u
        }
        beta.dp <- fit$dp[1:p]
        dp <- fit$dp
        cp <- fit$cp
    }
    else {
        npar0 <- p * d + d * (d + 1)/2
        if (family == "SN") {
            if (symmetr) {
                npar <- npar0
                ls <- lm.wfit(x, y, w)
                beta <- coef(ls)
                res <- residuals(ls)
                s2 <- t(res) %*% (w * res)/nw
                dp <- dp. <- list(beta = beta, Omega = s2)
                dp.$alpha <- rep(0, d)
                param <- c(beta, vech(s2))
                conc <- solve(s2)
                betaBlock <- conc %x% (t(x) %*% (w * x))
                D <- duplicationMatrix(d)
                varBlock <- (n/2) * t(D) %*% (conc %x% conc) %*% 
                  D
                m0 <- matrix(0, p * d, d * (d + 1)/2)
                j <- rbind(cbind(betaBlock, m0), cbind(t(m0), 
                  varBlock))
                j.inv <- rbind(cbind(solve(betaBlock), m0), cbind(t(m0), 
                  solve(varBlock)))
                diags.dp <- sqrt(diag(j.inv))
                se.beta <- matrix(diags.dp[1:(p * d)], p, d)
                se.diagOmega <- diags.dp[p * d + d * (d + 1)/2 + 
                  1 - rev(cumsum(1:d))]
                se <- list(beta = se.beta, diagOmega = se.diagOmega)
                info <- list(dp = param, cp = param, info.dp = j, 
                  info.cp = j, asyvar.dp = j.inv, asyvar.cp = j.inv, 
                  se.dp = se, se.cp = se, aux = NULL)
                logL <- (-0.5 * nw) * (determinant(2 * pi * s2, 
                  logarithm = TRUE)$modulus + d)
                fit <- list(dp = dp, cp = dp, dp.complete = dp., 
                  logL = logL)
                fit$opt.method <- list(method = "lm.wfit")
                boundary <- FALSE
                mu0 <- rep(0, d)
            }
            else {
                npar <- npar0 + d
                if (is.null(penalty)) {
                  fit <- msn.mle(x, y, start, w, trace = trace, 
                    opt.method = contr$opt.method, control = contr$opt.control)
                  boundary <- ((1 - fit$aux$delta.star) < .Machine$double.eps^(1/4))
                  if (!boundary) 
                    info <- sn.infoMv(fit$dp, x = x, y = yInfo, 
                      w = w)
                }
                else {
                  fit <- msn.mple(x, y, start, w, penalty, trace = trace, 
                    opt.method = contr$opt.method, control = contr$opt.control)
                  boundary <- FALSE
                  info <- sn.infoMv(fit$dp, x = x, y = y, w = w, 
                    penalty = penalty)
                }
                fit$cp <- msn.dp2cp(fit$dp)
                mu0 <- as.vector(fit$cp[[1]][1, ] - fit$dp[[1]][1, 
                  ])
            }
        }
        if (family == "ST") {
            fixed.nu <- fixed.param$nu
            npar <- npar0 + d * as.numeric(!symmetr) + as.numeric(is.null(fixed.nu))
            fit <- mst.mple(x, y, start, w, fixed.nu = fixed.nu, 
                symmetr = symmetr, penalty = penalty, trace = trace, 
                opt.method = contr$opt.method, control = contr$opt.control)
            fit$opt.method$called.by <- "mst.mple"
            boundary <- fit$boundary
            dp <- fit$dp
            nu <- if (is.null(fixed.nu)) 
                dp$nu
            else fixed.nu
            mu0 <- if (nu <= 1) 
                NA
            else as.vector(mst.dp2cp(dp, fixed.nu = fixed.nu, 
                symmetr = symmetr, upto = 1)[[1]][1, ] - dp[[1]][1, 
                ])
            fit$cp <- mst.dp2cp(dp, cp.type = "proper", fixed.nu, 
                symmetr)
            fit$p_cp <- mst.dp2cp(dp, cp.type = "pseudo", fixed.nu, 
                symmetr)
            if (!boundary) 
                info <- st.infoMv(dp, x = x, y = yInfo, w, fixed.nu, 
                  symmetr, penalty)
        }
        if (family == "SC") {
            npar <- npar0 + d * as.numeric(!symmetr)
            if (is.null(start)) {
                fit.sn <- msn.mle(x, y, NULL, w, control = list(rel.tol = 1e-04))
                start <- fit.sn$dp
            }
            fit <- mst.mple(x, y, start, w, fixed.nu = 1, symmetr = symmetr, 
                penalty = penalty, trace = trace, opt.method = contr$opt.method, 
                control = contr$opt.control)
            fit$opt.method$called.by <- "mst.mple"
            npar <- p * d + d * (d + 1)/2 + d * as.numeric(!symmetr)
            boundary <- fit$boundary
            mu0 <- NA
            fit$cp <- NULL
            fit$p_cp <- mst.dp2cp(fit$dp, "pseudo", fixed.nu = 1)
            if (!boundary) 
                info <- st.infoMv(fit$dp, x = x, y = yInfo, w, 
                  fixed.nu = 1, symmetr, penalty)
        }
        beta.dp <- fit$dp[[1]]
    }
    param <- list(dp = fit$dp, cp = fit$cp, `pseudo-cp` = fit$p_cp, 
        boundary = boundary, mu0 = mu0)
    if (!boundary && !is.null(info)) {
        asyvar.dp <- info$asyvar.dp[1:npar, 1:npar]
        asyvar.cp <- info$asyvar.cp[1:npar, 1:npar]
        asyvar.p_cp <- info$asyvar.p_cp[1:npar, 1:npar]
        param.var <- list(info.type = info.type, dp = asyvar.dp, 
            cp = asyvar.cp, `pseudo-cp` = asyvar.p_cp)
    }
    else param.var <- list()
    dn <- colnames(x)
    fv <- drop(x %*% beta.dp)
    if (is.matrix(fv)) 
        colnames(fv) <- colnames(y)
    size <- c(d = d, p = p, n.param = npar, n.obs = n.obs, nw.obs = sum(w))
    z <- list(call = match.call(), logL = fit$logL, param = param, 
        param.var = param.var, fitted.dp = fv, resid.dp = y - 
            fv, size = size, selm.control = contr, opt.method = fit$opt.method)
    r1 <- y - z$resid.dp
    z$weights <- w
    if (zero.weights) {
        f0 <- x0 %*% beta.dp
        if (d > 1) {
            save.r[ok, ] <- z$resid.dp
            save.r[nok, ] <- y0 - f0
            save.f[ok, ] <- z$fitted.dp
            save.f[nok, ] <- f0
        }
        else {
            save.r[ok] <- z$resid.dp
            save.r[nok] <- y0 - f0
            save.f[ok] <- z$fitted.dp
            save.f[nok] <- f0
        }
        z$resid.dp <- save.r
        z$fitted.dp <- save.f
        z$weights <- save.w
    }
    if (!is.null(offset)) {
        z$fitted.dp <- z$fitted.dp + offset
        r1 <- r1 + offset
    }
    if (length(fixed.param) > 0) {
        z$param$fixed <- fixed.param
        z$param$dp.complete <- fit$dp.complete
    }
    else z$param$fixed <- z$param$dp.complete <- list()
    return(z)
}
<bytecode: 0x4bb5720>
<environment: namespace:sn>
 --- function search by body ---
Function selm.fit in namespace sn has this body.
 ----------- END OF FAILURE REPORT -------------- 
Error in if (class(u) == "try-error") NULL else u : 
  the condition has length > 1
Calls: selm -> selm.fit
Execution halted