CRAN Package Check Results for Package Qtools

Last updated on 2019-11-26 00:52:04 CET.

Check Details

Version: 1.4.1
Check: examples
Result: ERROR
    Running examples in 'Qtools-Ex.R' failed
    The error most likely occurred in:
    
    > base::assign(".ptime", proc.time(), pos = "CheckExEnv")
    > ### Name: predict.rq.counts
    > ### Title: Predictions from rq.counts Objects
    > ### Aliases: predict.rq.counts
    > ### Keywords: predict
    >
    > ### ** Examples
    >
    >
    > # Esterase data
    > data(esterase)
    >
    > # Fit quantiles 0.25 and 0.75
    > fit <- rq.counts(Count ~ Esterase, tau = 0.5, data = esterase, M = 50)
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    Qtools
     --- call from context ---
    rq.counts(Count ~ Esterase, tau = 0.5, data = esterase, M = 50)
     --- call from argument ---
    if (class(tmpInv) != "try-error") {
     d[, , i] <- tmpInv
    } else {
     sel[i] <- FALSE
    }
     --- R stacktrace ---
    where 1: rq.counts(Count ~ Esterase, tau = 0.5, data = esterase, M = 50)
    
     --- value of length: 2 type: logical ---
    [1] TRUE TRUE
     --- function from context ---
    function (formula, data = sys.frame(sys.parent()), tau = 0.5,
     subset, weights, na.action, contrasts = NULL, offset = NULL,
     method = "fn", M = 50, zeta = 1e-05, B = 0.999, cn = NULL,
     alpha = 0.05)
    {
     tsf <- "bc"
     symm <- TRUE
     dbounded <- FALSE
     lambda <- 0
     nq <- length(tau)
     if (nq > 1)
     stop("One quantile at a time")
     if (tsf == "mcjII")
     stop("'mcjII' not available for rq.counts")
     call <- match.call()
     mf <- match.call(expand.dots = FALSE)
     m <- match(c("formula", "data", "subset", "weights", "na.action"),
     names(mf), 0L)
     mf <- mf[c(1L, m)]
     if (method == "model.frame")
     return(mf)
     mf$drop.unused.levels <- TRUE
     mf[[1L]] <- as.name("model.frame")
     mf <- eval(mf, parent.frame())
     mt <- attr(mf, "terms")
     x <- model.matrix(mt, mf, contrasts)
     y <- model.response(mf, "numeric")
     w <- as.vector(model.weights(mf))
     if (!is.null(w) && !is.numeric(w))
     stop("'weights' must be a numeric vector")
     if (is.null(w))
     w <- rep(1, length(y))
     p <- ncol(x)
     n <- nrow(x)
     term.labels <- colnames(x)
     if (is.null(offset))
     offset <- rep(0, n)
     Fn <- function(x, cn) {
     xf <- floor(x)
     df <- x - xf
     if (df < cn & x >= 1) {
     val <- xf - 0.5 + df/(2 * cn)
     }
     if (any(cn <= df & df < (1 - cn), x < 1)) {
     val <- xf
     }
     if (df >= (1 - cn)) {
     val <- xf + 0.5 + (df - 1)/(2 * cn)
     }
     return(val)
     }
     Fvec <- Vectorize(Fn)
     Z <- replicate(M, addnoise(y, centered = FALSE, B = B))
     TZ <- apply(Z, 2, function(x, off, tsf, symm, lambda, tau,
     zeta) {
     z <- ifelse((x - tau) > zeta, x - tau, zeta)
     switch(tsf, mcjI = mcjI(z, lambda, symm, dbounded = dbounded,
     omega = 0.001), bc = bc(z, lambda)) - off
     }, off = offset, tsf = tsf, symm = symm, lambda = lambda,
     tau = tau, zeta = zeta)
     fit <- apply(TZ, 2, function(y, x, weights, tau, method) rq.wfit(x = x,
     y = y, tau = tau, weights = weights, method = method),
     x = x, tau = tau, weights = w, method = method)
     yhat <- sapply(fit, function(obj, x) x %*% obj$coefficients,
     x = x)
     yhat <- as.matrix(yhat)
     linpred <- sweep(yhat, 1, offset, "+")
     zhat <- matrix(NA, n, M)
     for (i in 1:M) {
     zhat[, i] <- tau + switch(tsf, mcjI = invmcjI(linpred[,
     i], lambda, symm, dbounded = dbounded), bc = invbc(linpred[,
     i], lambda))
     }
     if (is.null(cn))
     cn <- 0.5 * log(log(n))/sqrt(n)
     F <- apply(zhat, 2, Fvec, cn = cn)
     Fp <- apply(zhat + 1, 2, Fvec, cn = cn)
     multiplier <- (tau - (TZ <= yhat))^2
     a <- array(NA, dim = c(p, p, M))
     for (i in 1:M) a[, , i] <- t(x * multiplier[, i]) %*% x/n
     multiplier <- tau^2 + (1 - 2 * tau) * (y <= (zhat - 1)) +
     ((zhat - y) * (zhat - 1 < y & y <= zhat)) * (zhat - y -
     2 * tau)
     b <- array(NA, dim = c(p, p, M))
     for (i in 1:M) b[, , i] <- t(x * multiplier[, i]) %*% x/n
     multiplier <- (zhat - tau) * (F <= Z & Z < Fp)
     d <- array(NA, dim = c(p, p, M))
     sel <- rep(TRUE, M)
     for (i in 1:M) {
     tmpInv <- try(solve(t(x * multiplier[, i]) %*% x/n),
     silent = TRUE)
     if (class(tmpInv) != "try-error") {
     d[, , i] <- tmpInv
     }
     else {
     sel[i] <- FALSE
     }
     }
     dad <- 0
     dbd <- 0
     for (i in (1:M)[sel]) {
     dad <- dad + d[, , i] %*% a[, , i] %*% d[, , i]
     dbd <- dbd + d[, , i] %*% b[, , i] %*% d[, , i]
     }
     m.n <- sum(sel)
     if (m.n != 0) {
     V <- dad/(m.n^2) + (1 - 1/m.n) * dbd * 1/m.n
     V <- V/n
     stds <- sqrt(diag(V))
     }
     else {
     stds <- NA
     warning("Standard error not available")
     }
     betahat <- sapply(fit, function(x) x$coefficients)
     betahat <- if (p == 1)
     mean(betahat)
     else rowMeans(betahat)
     linpred <- if (p == 1) {
     mean(linpred[1, ])
     }
     else {
     rowMeans(linpred)
     }
     Fitted <- tau + switch(tsf, mcjI = invmcjI(linpred, lambda,
     symm, dbounded = dbounded), bc = invbc(linpred, lambda))
     lower <- betahat + qt(alpha/2, n - p) * stds
     upper <- betahat + qt(1 - alpha/2, n - p) * stds
     tP <- 2 * pt(-abs(betahat/stds), n - p)
     ans <- cbind(betahat, stds, lower, upper, tP)
     colnames(ans) <- c("Value", "Std. Error", "lower bound",
     "upper bound", "Pr(>|t|)")
     rownames(ans) <- names(betahat) <- term.labels
     fit <- list()
     fit$call <- call
     fit$method <- method
     fit$mf <- mf
     mf <- match.call(expand.dots = FALSE)
     m <- match(c("formula", "data", "subset", "weights", "na.action"),
     names(mf), 0L)
     mf <- mf[c(1L, m)]
     mf[[1L]] <- as.name("get_all_vars")
     fit$data <- eval(mf, parent.frame())
     fit$x <- x
     fit$y <- y
     fit$weights <- w
     fit$offset <- offset
     fit$tau <- tau
     fit$lambda <- lambda
     fit$tsf <- tsf
     attr(fit$tsf, "symm") <- symm
     fit$coefficients <- betahat
     fit$M <- M
     fit$Mn <- m.n
     fit$fitted.values <- Fitted
     fit$tTable <- ans
     fit$Cov <- V
     fit$levels <- .getXlevels(mt, mf)
     fit$terms <- mt
     fit$term.labels <- term.labels
     fit$rdf <- n - p
     class(fit) <- "rq.counts"
     return(fit)
    }
    <bytecode: 0xa0d20c0>
    <environment: namespace:Qtools>
     --- function search by body ---
    Function rq.counts in namespace Qtools has this body.
     ----------- END OF FAILURE REPORT --------------
    Fatal error: the condition has length > 1
Flavor: r-devel-linux-x86_64-debian-clang

Version: 1.4.1
Check: re-building of vignette outputs
Result: WARN
    Error(s) in re-building vignettes:
     ...
    --- re-building 'Qtools.Rmd' using rmarkdown
    Loading required package: SparseM
    
    Attaching package: 'SparseM'
    
    The following object is masked from 'package:base':
    
     backsolve
    
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    Qtools
     --- call from context ---
    rq.counts(Count ~ Esterase, tau = 0.1, data = esterase, M = 50)
     --- call from argument ---
    if (class(tmpInv) != "try-error") {
     d[, , i] <- tmpInv
    } else {
     sel[i] <- FALSE
    }
     --- R stacktrace ---
    where 1: rq.counts(Count ~ Esterase, tau = 0.1, data = esterase, M = 50)
    where 2: eval(expr, envir, enclos)
    where 3: eval(expr, envir, enclos)
    where 4: withVisible(eval(expr, envir, enclos))
    where 5: withCallingHandlers(withVisible(eval(expr, envir, enclos)), warning = wHandler,
     error = eHandler, message = mHandler)
    where 6: handle(ev <- withCallingHandlers(withVisible(eval(expr, envir,
     enclos)), warning = wHandler, error = eHandler, message = mHandler))
    where 7: timing_fn(handle(ev <- withCallingHandlers(withVisible(eval(expr,
     envir, enclos)), warning = wHandler, error = eHandler, message = mHandler)))
    where 8: evaluate_call(expr, parsed$src[[i]], envir = envir, enclos = enclos,
     debug = debug, last = i == length(out), use_try = stop_on_error !=
     2L, keep_warning = keep_warning, keep_message = keep_message,
     output_handler = output_handler, include_timing = include_timing)
    where 9: evaluate::evaluate(...)
    where 10: evaluate(code, envir = env, new_device = FALSE, keep_warning = !isFALSE(options$warning),
     keep_message = !isFALSE(options$message), stop_on_error = if (options$error &&
     options$include) 0L else 2L, output_handler = knit_handlers(options$render,
     options))
    where 11: in_dir(input_dir(), evaluate(code, envir = env, new_device = FALSE,
     keep_warning = !isFALSE(options$warning), keep_message = !isFALSE(options$message),
     stop_on_error = if (options$error && options$include) 0L else 2L,
     output_handler = knit_handlers(options$render, options)))
    where 12: block_exec(params)
    where 13: call_block(x)
    where 14: process_group.block(group)
    where 15: process_group(group)
    where 16: withCallingHandlers(if (tangle) process_tangle(group) else process_group(group),
     error = function(e) {
     setwd(wd)
     cat(res, sep = "\n", file = output %n% "")
     message("Quitting from lines ", paste(current_lines(i),
     collapse = "-"), " (", knit_concord$get("infile"),
     ") ")
     })
    where 17: process_file(text, output)
    where 18: knitr::knit(knit_input, knit_output, envir = envir, quiet = quiet,
     encoding = encoding)
    where 19: rmarkdown::render(file, encoding = encoding, quiet = quiet, envir = globalenv(),
     ...)
    where 20: vweave_rmarkdown(...)
    where 21: engine$weave(file, quiet = quiet, encoding = enc)
    where 22: doTryCatch(return(expr), name, parentenv, handler)
    where 23: tryCatchOne(expr, names, parentenv, handlers[[1L]])
    where 24: tryCatchList(expr, classes, parentenv, handlers)
    where 25: tryCatch({
     engine$weave(file, quiet = quiet, encoding = enc)
     setwd(startdir)
     output <- find_vignette_product(name, by = "weave", engine = engine)
     if (!have.makefile && vignette_is_tex(output)) {
     texi2pdf(file = output, clean = FALSE, quiet = quiet)
     output <- find_vignette_product(name, by = "texi2pdf",
     engine = engine)
     }
     outputs <- c(outputs, output)
    }, error = function(e) {
     thisOK <<- FALSE
     fails <<- c(fails, file)
     message(gettextf("Error: processing vignette '%s' failed with diagnostics:\n%s",
     file, conditionMessage(e)))
    })
    where 26: tools:::buildVignettes(dir = "/home/hornik/tmp/R.check/r-devel-clang/Work/PKGS/Qtools.Rcheck/vign_test/Qtools",
     ser_elibs = "/tmp/RtmpUhikvP/file6a0d5985fbaf.rds")
    
     --- value of length: 2 type: logical ---
    [1] TRUE TRUE
     --- function from context ---
    function (formula, data = sys.frame(sys.parent()), tau = 0.5,
     subset, weights, na.action, contrasts = NULL, offset = NULL,
     method = "fn", M = 50, zeta = 1e-05, B = 0.999, cn = NULL,
     alpha = 0.05)
    {
     tsf <- "bc"
     symm <- TRUE
     dbounded <- FALSE
     lambda <- 0
     nq <- length(tau)
     if (nq > 1)
     stop("One quantile at a time")
     if (tsf == "mcjII")
     stop("'mcjII' not available for rq.counts")
     call <- match.call()
     mf <- match.call(expand.dots = FALSE)
     m <- match(c("formula", "data", "subset", "weights", "na.action"),
     names(mf), 0L)
     mf <- mf[c(1L, m)]
     if (method == "model.frame")
     return(mf)
     mf$drop.unused.levels <- TRUE
     mf[[1L]] <- as.name("model.frame")
     mf <- eval(mf, parent.frame())
     mt <- attr(mf, "terms")
     x <- model.matrix(mt, mf, contrasts)
     y <- model.response(mf, "numeric")
     w <- as.vector(model.weights(mf))
     if (!is.null(w) && !is.numeric(w))
     stop("'weights' must be a numeric vector")
     if (is.null(w))
     w <- rep(1, length(y))
     p <- ncol(x)
     n <- nrow(x)
     term.labels <- colnames(x)
     if (is.null(offset))
     offset <- rep(0, n)
     Fn <- function(x, cn) {
     xf <- floor(x)
     df <- x - xf
     if (df < cn & x >= 1) {
     val <- xf - 0.5 + df/(2 * cn)
     }
     if (any(cn <= df & df < (1 - cn), x < 1)) {
     val <- xf
     }
     if (df >= (1 - cn)) {
     val <- xf + 0.5 + (df - 1)/(2 * cn)
     }
     return(val)
     }
     Fvec <- Vectorize(Fn)
     Z <- replicate(M, addnoise(y, centered = FALSE, B = B))
     TZ <- apply(Z, 2, function(x, off, tsf, symm, lambda, tau,
     zeta) {
     z <- ifelse((x - tau) > zeta, x - tau, zeta)
     switch(tsf, mcjI = mcjI(z, lambda, symm, dbounded = dbounded,
     omega = 0.001), bc = bc(z, lambda)) - off
     }, off = offset, tsf = tsf, symm = symm, lambda = lambda,
     tau = tau, zeta = zeta)
     fit <- apply(TZ, 2, function(y, x, weights, tau, method) rq.wfit(x = x,
     y = y, tau = tau, weights = weights, method = method),
     x = x, tau = tau, weights = w, method = method)
     yhat <- sapply(fit, function(obj, x) x %*% obj$coefficients,
     x = x)
     yhat <- as.matrix(yhat)
     linpred <- sweep(yhat, 1, offset, "+")
     zhat <- matrix(NA, n, M)
     for (i in 1:M) {
     zhat[, i] <- tau + switch(tsf, mcjI = invmcjI(linpred[,
     i], lambda, symm, dbounded = dbounded), bc = invbc(linpred[,
     i], lambda))
     }
     if (is.null(cn))
     cn <- 0.5 * log(log(n))/sqrt(n)
     F <- apply(zhat, 2, Fvec, cn = cn)
     Fp <- apply(zhat + 1, 2, Fvec, cn = cn)
     multiplier <- (tau - (TZ <= yhat))^2
     a <- array(NA, dim = c(p, p, M))
     for (i in 1:M) a[, , i] <- t(x * multiplier[, i]) %*% x/n
     multiplier <- tau^2 + (1 - 2 * tau) * (y <= (zhat - 1)) +
     ((zhat - y) * (zhat - 1 < y & y <= zhat)) * (zhat - y -
     2 * tau)
     b <- array(NA, dim = c(p, p, M))
     for (i in 1:M) b[, , i] <- t(x * multiplier[, i]) %*% x/n
     multiplier <- (zhat - tau) * (F <= Z & Z < Fp)
     d <- array(NA, dim = c(p, p, M))
     sel <- rep(TRUE, M)
     for (i in 1:M) {
     tmpInv <- try(solve(t(x * multiplier[, i]) %*% x/n),
     silent = TRUE)
     if (class(tmpInv) != "try-error") {
     d[, , i] <- tmpInv
     }
     else {
     sel[i] <- FALSE
     }
     }
     dad <- 0
     dbd <- 0
     for (i in (1:M)[sel]) {
     dad <- dad + d[, , i] %*% a[, , i] %*% d[, , i]
     dbd <- dbd + d[, , i] %*% b[, , i] %*% d[, , i]
     }
     m.n <- sum(sel)
     if (m.n != 0) {
     V <- dad/(m.n^2) + (1 - 1/m.n) * dbd * 1/m.n
     V <- V/n
     stds <- sqrt(diag(V))
     }
     else {
     stds <- NA
     warning("Standard error not available")
     }
     betahat <- sapply(fit, function(x) x$coefficients)
     betahat <- if (p == 1)
     mean(betahat)
     else rowMeans(betahat)
     linpred <- if (p == 1) {
     mean(linpred[1, ])
     }
     else {
     rowMeans(linpred)
     }
     Fitted <- tau + switch(tsf, mcjI = invmcjI(linpred, lambda,
     symm, dbounded = dbounded), bc = invbc(linpred, lambda))
     lower <- betahat + qt(alpha/2, n - p) * stds
     upper <- betahat + qt(1 - alpha/2, n - p) * stds
     tP <- 2 * pt(-abs(betahat/stds), n - p)
     ans <- cbind(betahat, stds, lower, upper, tP)
     colnames(ans) <- c("Value", "Std. Error", "lower bound",
     "upper bound", "Pr(>|t|)")
     rownames(ans) <- names(betahat) <- term.labels
     fit <- list()
     fit$call <- call
     fit$method <- method
     fit$mf <- mf
     mf <- match.call(expand.dots = FALSE)
     m <- match(c("formula", "data", "subset", "weights", "na.action"),
     names(mf), 0L)
     mf <- mf[c(1L, m)]
     mf[[1L]] <- as.name("get_all_vars")
     fit$data <- eval(mf, parent.frame())
     fit$x <- x
     fit$y <- y
     fit$weights <- w
     fit$offset <- offset
     fit$tau <- tau
     fit$lambda <- lambda
     fit$tsf <- tsf
     attr(fit$tsf, "symm") <- symm
     fit$coefficients <- betahat
     fit$M <- M
     fit$Mn <- m.n
     fit$fitted.values <- Fitted
     fit$tTable <- ans
     fit$Cov <- V
     fit$levels <- .getXlevels(mt, mf)
     fit$terms <- mt
     fit$term.labels <- term.labels
     fit$rdf <- n - p
     class(fit) <- "rq.counts"
     return(fit)
    }
    <bytecode: 0xd19d730>
    <environment: namespace:Qtools>
     --- function search by body ---
    Function rq.counts in namespace Qtools has this body.
     ----------- END OF FAILURE REPORT --------------
    Fatal error: the condition has length > 1
Flavor: r-devel-linux-x86_64-debian-clang

Version: 1.4.1
Check: examples
Result: ERROR
    Running examples in ‘Qtools-Ex.R’ failed
    The error most likely occurred in:
    
    > base::assign(".ptime", proc.time(), pos = "CheckExEnv")
    > ### Name: predict.rq.counts
    > ### Title: Predictions from rq.counts Objects
    > ### Aliases: predict.rq.counts
    > ### Keywords: predict
    >
    > ### ** Examples
    >
    >
    > # Esterase data
    > data(esterase)
    >
    > # Fit quantiles 0.25 and 0.75
    > fit <- rq.counts(Count ~ Esterase, tau = 0.5, data = esterase, M = 50)
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    Qtools
     --- call from context ---
    rq.counts(Count ~ Esterase, tau = 0.5, data = esterase, M = 50)
     --- call from argument ---
    if (class(tmpInv) != "try-error") {
     d[, , i] <- tmpInv
    } else {
     sel[i] <- FALSE
    }
     --- R stacktrace ---
    where 1: rq.counts(Count ~ Esterase, tau = 0.5, data = esterase, M = 50)
    
     --- value of length: 2 type: logical ---
    [1] TRUE TRUE
     --- function from context ---
    function (formula, data = sys.frame(sys.parent()), tau = 0.5,
     subset, weights, na.action, contrasts = NULL, offset = NULL,
     method = "fn", M = 50, zeta = 1e-05, B = 0.999, cn = NULL,
     alpha = 0.05)
    {
     tsf <- "bc"
     symm <- TRUE
     dbounded <- FALSE
     lambda <- 0
     nq <- length(tau)
     if (nq > 1)
     stop("One quantile at a time")
     if (tsf == "mcjII")
     stop("'mcjII' not available for rq.counts")
     call <- match.call()
     mf <- match.call(expand.dots = FALSE)
     m <- match(c("formula", "data", "subset", "weights", "na.action"),
     names(mf), 0L)
     mf <- mf[c(1L, m)]
     if (method == "model.frame")
     return(mf)
     mf$drop.unused.levels <- TRUE
     mf[[1L]] <- as.name("model.frame")
     mf <- eval(mf, parent.frame())
     mt <- attr(mf, "terms")
     x <- model.matrix(mt, mf, contrasts)
     y <- model.response(mf, "numeric")
     w <- as.vector(model.weights(mf))
     if (!is.null(w) && !is.numeric(w))
     stop("'weights' must be a numeric vector")
     if (is.null(w))
     w <- rep(1, length(y))
     p <- ncol(x)
     n <- nrow(x)
     term.labels <- colnames(x)
     if (is.null(offset))
     offset <- rep(0, n)
     Fn <- function(x, cn) {
     xf <- floor(x)
     df <- x - xf
     if (df < cn & x >= 1) {
     val <- xf - 0.5 + df/(2 * cn)
     }
     if (any(cn <= df & df < (1 - cn), x < 1)) {
     val <- xf
     }
     if (df >= (1 - cn)) {
     val <- xf + 0.5 + (df - 1)/(2 * cn)
     }
     return(val)
     }
     Fvec <- Vectorize(Fn)
     Z <- replicate(M, addnoise(y, centered = FALSE, B = B))
     TZ <- apply(Z, 2, function(x, off, tsf, symm, lambda, tau,
     zeta) {
     z <- ifelse((x - tau) > zeta, x - tau, zeta)
     switch(tsf, mcjI = mcjI(z, lambda, symm, dbounded = dbounded,
     omega = 0.001), bc = bc(z, lambda)) - off
     }, off = offset, tsf = tsf, symm = symm, lambda = lambda,
     tau = tau, zeta = zeta)
     fit <- apply(TZ, 2, function(y, x, weights, tau, method) rq.wfit(x = x,
     y = y, tau = tau, weights = weights, method = method),
     x = x, tau = tau, weights = w, method = method)
     yhat <- sapply(fit, function(obj, x) x %*% obj$coefficients,
     x = x)
     yhat <- as.matrix(yhat)
     linpred <- sweep(yhat, 1, offset, "+")
     zhat <- matrix(NA, n, M)
     for (i in 1:M) {
     zhat[, i] <- tau + switch(tsf, mcjI = invmcjI(linpred[,
     i], lambda, symm, dbounded = dbounded), bc = invbc(linpred[,
     i], lambda))
     }
     if (is.null(cn))
     cn <- 0.5 * log(log(n))/sqrt(n)
     F <- apply(zhat, 2, Fvec, cn = cn)
     Fp <- apply(zhat + 1, 2, Fvec, cn = cn)
     multiplier <- (tau - (TZ <= yhat))^2
     a <- array(NA, dim = c(p, p, M))
     for (i in 1:M) a[, , i] <- t(x * multiplier[, i]) %*% x/n
     multiplier <- tau^2 + (1 - 2 * tau) * (y <= (zhat - 1)) +
     ((zhat - y) * (zhat - 1 < y & y <= zhat)) * (zhat - y -
     2 * tau)
     b <- array(NA, dim = c(p, p, M))
     for (i in 1:M) b[, , i] <- t(x * multiplier[, i]) %*% x/n
     multiplier <- (zhat - tau) * (F <= Z & Z < Fp)
     d <- array(NA, dim = c(p, p, M))
     sel <- rep(TRUE, M)
     for (i in 1:M) {
     tmpInv <- try(solve(t(x * multiplier[, i]) %*% x/n),
     silent = TRUE)
     if (class(tmpInv) != "try-error") {
     d[, , i] <- tmpInv
     }
     else {
     sel[i] <- FALSE
     }
     }
     dad <- 0
     dbd <- 0
     for (i in (1:M)[sel]) {
     dad <- dad + d[, , i] %*% a[, , i] %*% d[, , i]
     dbd <- dbd + d[, , i] %*% b[, , i] %*% d[, , i]
     }
     m.n <- sum(sel)
     if (m.n != 0) {
     V <- dad/(m.n^2) + (1 - 1/m.n) * dbd * 1/m.n
     V <- V/n
     stds <- sqrt(diag(V))
     }
     else {
     stds <- NA
     warning("Standard error not available")
     }
     betahat <- sapply(fit, function(x) x$coefficients)
     betahat <- if (p == 1)
     mean(betahat)
     else rowMeans(betahat)
     linpred <- if (p == 1) {
     mean(linpred[1, ])
     }
     else {
     rowMeans(linpred)
     }
     Fitted <- tau + switch(tsf, mcjI = invmcjI(linpred, lambda,
     symm, dbounded = dbounded), bc = invbc(linpred, lambda))
     lower <- betahat + qt(alpha/2, n - p) * stds
     upper <- betahat + qt(1 - alpha/2, n - p) * stds
     tP <- 2 * pt(-abs(betahat/stds), n - p)
     ans <- cbind(betahat, stds, lower, upper, tP)
     colnames(ans) <- c("Value", "Std. Error", "lower bound",
     "upper bound", "Pr(>|t|)")
     rownames(ans) <- names(betahat) <- term.labels
     fit <- list()
     fit$call <- call
     fit$method <- method
     fit$mf <- mf
     mf <- match.call(expand.dots = FALSE)
     m <- match(c("formula", "data", "subset", "weights", "na.action"),
     names(mf), 0L)
     mf <- mf[c(1L, m)]
     mf[[1L]] <- as.name("get_all_vars")
     fit$data <- eval(mf, parent.frame())
     fit$x <- x
     fit$y <- y
     fit$weights <- w
     fit$offset <- offset
     fit$tau <- tau
     fit$lambda <- lambda
     fit$tsf <- tsf
     attr(fit$tsf, "symm") <- symm
     fit$coefficients <- betahat
     fit$M <- M
     fit$Mn <- m.n
     fit$fitted.values <- Fitted
     fit$tTable <- ans
     fit$Cov <- V
     fit$levels <- .getXlevels(mt, mf)
     fit$terms <- mt
     fit$term.labels <- term.labels
     fit$rdf <- n - p
     class(fit) <- "rq.counts"
     return(fit)
    }
    <bytecode: 0x55bbd20b35d0>
    <environment: namespace:Qtools>
     --- function search by body ---
    Function rq.counts in namespace Qtools has this body.
     ----------- END OF FAILURE REPORT --------------
    Fatal error: the condition has length > 1
Flavor: r-devel-linux-x86_64-debian-gcc

Version: 1.4.1
Check: re-building of vignette outputs
Result: WARN
    Error(s) in re-building vignettes:
     ...
    --- re-building ‘Qtools.Rmd’ using rmarkdown
    Loading required package: SparseM
    
    Attaching package: 'SparseM'
    
    The following object is masked from 'package:base':
    
     backsolve
    
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    Qtools
     --- call from context ---
    rq.counts(Count ~ Esterase, tau = 0.1, data = esterase, M = 50)
     --- call from argument ---
    if (class(tmpInv) != "try-error") {
     d[, , i] <- tmpInv
    } else {
     sel[i] <- FALSE
    }
     --- R stacktrace ---
    where 1: rq.counts(Count ~ Esterase, tau = 0.1, data = esterase, M = 50)
    where 2: eval(expr, envir, enclos)
    where 3: eval(expr, envir, enclos)
    where 4: withVisible(eval(expr, envir, enclos))
    where 5: withCallingHandlers(withVisible(eval(expr, envir, enclos)), warning = wHandler,
     error = eHandler, message = mHandler)
    where 6: handle(ev <- withCallingHandlers(withVisible(eval(expr, envir,
     enclos)), warning = wHandler, error = eHandler, message = mHandler))
    where 7: timing_fn(handle(ev <- withCallingHandlers(withVisible(eval(expr,
     envir, enclos)), warning = wHandler, error = eHandler, message = mHandler)))
    where 8: evaluate_call(expr, parsed$src[[i]], envir = envir, enclos = enclos,
     debug = debug, last = i == length(out), use_try = stop_on_error !=
     2L, keep_warning = keep_warning, keep_message = keep_message,
     output_handler = output_handler, include_timing = include_timing)
    where 9: evaluate::evaluate(...)
    where 10: evaluate(code, envir = env, new_device = FALSE, keep_warning = !isFALSE(options$warning),
     keep_message = !isFALSE(options$message), stop_on_error = if (options$error &&
     options$include) 0L else 2L, output_handler = knit_handlers(options$render,
     options))
    where 11: in_dir(input_dir(), evaluate(code, envir = env, new_device = FALSE,
     keep_warning = !isFALSE(options$warning), keep_message = !isFALSE(options$message),
     stop_on_error = if (options$error && options$include) 0L else 2L,
     output_handler = knit_handlers(options$render, options)))
    where 12: block_exec(params)
    where 13: call_block(x)
    where 14: process_group.block(group)
    where 15: process_group(group)
    where 16: withCallingHandlers(if (tangle) process_tangle(group) else process_group(group),
     error = function(e) {
     setwd(wd)
     cat(res, sep = "\n", file = output %n% "")
     message("Quitting from lines ", paste(current_lines(i),
     collapse = "-"), " (", knit_concord$get("infile"),
     ") ")
     })
    where 17: process_file(text, output)
    where 18: knitr::knit(knit_input, knit_output, envir = envir, quiet = quiet,
     encoding = encoding)
    where 19: rmarkdown::render(file, encoding = encoding, quiet = quiet, envir = globalenv(),
     ...)
    where 20: vweave_rmarkdown(...)
    where 21: engine$weave(file, quiet = quiet, encoding = enc)
    where 22: doTryCatch(return(expr), name, parentenv, handler)
    where 23: tryCatchOne(expr, names, parentenv, handlers[[1L]])
    where 24: tryCatchList(expr, classes, parentenv, handlers)
    where 25: tryCatch({
     engine$weave(file, quiet = quiet, encoding = enc)
     setwd(startdir)
     output <- find_vignette_product(name, by = "weave", engine = engine)
     if (!have.makefile && vignette_is_tex(output)) {
     texi2pdf(file = output, clean = FALSE, quiet = quiet)
     output <- find_vignette_product(name, by = "texi2pdf",
     engine = engine)
     }
     outputs <- c(outputs, output)
    }, error = function(e) {
     thisOK <<- FALSE
     fails <<- c(fails, file)
     message(gettextf("Error: processing vignette '%s' failed with diagnostics:\n%s",
     file, conditionMessage(e)))
    })
    where 26: tools:::buildVignettes(dir = "/home/hornik/tmp/R.check/r-devel-gcc/Work/PKGS/Qtools.Rcheck/vign_test/Qtools",
     ser_elibs = "/home/hornik/tmp/scratch/Rtmph7tQLH/file688844aec9ca.rds")
    
     --- value of length: 2 type: logical ---
    [1] TRUE TRUE
     --- function from context ---
    function (formula, data = sys.frame(sys.parent()), tau = 0.5,
     subset, weights, na.action, contrasts = NULL, offset = NULL,
     method = "fn", M = 50, zeta = 1e-05, B = 0.999, cn = NULL,
     alpha = 0.05)
    {
     tsf <- "bc"
     symm <- TRUE
     dbounded <- FALSE
     lambda <- 0
     nq <- length(tau)
     if (nq > 1)
     stop("One quantile at a time")
     if (tsf == "mcjII")
     stop("'mcjII' not available for rq.counts")
     call <- match.call()
     mf <- match.call(expand.dots = FALSE)
     m <- match(c("formula", "data", "subset", "weights", "na.action"),
     names(mf), 0L)
     mf <- mf[c(1L, m)]
     if (method == "model.frame")
     return(mf)
     mf$drop.unused.levels <- TRUE
     mf[[1L]] <- as.name("model.frame")
     mf <- eval(mf, parent.frame())
     mt <- attr(mf, "terms")
     x <- model.matrix(mt, mf, contrasts)
     y <- model.response(mf, "numeric")
     w <- as.vector(model.weights(mf))
     if (!is.null(w) && !is.numeric(w))
     stop("'weights' must be a numeric vector")
     if (is.null(w))
     w <- rep(1, length(y))
     p <- ncol(x)
     n <- nrow(x)
     term.labels <- colnames(x)
     if (is.null(offset))
     offset <- rep(0, n)
     Fn <- function(x, cn) {
     xf <- floor(x)
     df <- x - xf
     if (df < cn & x >= 1) {
     val <- xf - 0.5 + df/(2 * cn)
     }
     if (any(cn <= df & df < (1 - cn), x < 1)) {
     val <- xf
     }
     if (df >= (1 - cn)) {
     val <- xf + 0.5 + (df - 1)/(2 * cn)
     }
     return(val)
     }
     Fvec <- Vectorize(Fn)
     Z <- replicate(M, addnoise(y, centered = FALSE, B = B))
     TZ <- apply(Z, 2, function(x, off, tsf, symm, lambda, tau,
     zeta) {
     z <- ifelse((x - tau) > zeta, x - tau, zeta)
     switch(tsf, mcjI = mcjI(z, lambda, symm, dbounded = dbounded,
     omega = 0.001), bc = bc(z, lambda)) - off
     }, off = offset, tsf = tsf, symm = symm, lambda = lambda,
     tau = tau, zeta = zeta)
     fit <- apply(TZ, 2, function(y, x, weights, tau, method) rq.wfit(x = x,
     y = y, tau = tau, weights = weights, method = method),
     x = x, tau = tau, weights = w, method = method)
     yhat <- sapply(fit, function(obj, x) x %*% obj$coefficients,
     x = x)
     yhat <- as.matrix(yhat)
     linpred <- sweep(yhat, 1, offset, "+")
     zhat <- matrix(NA, n, M)
     for (i in 1:M) {
     zhat[, i] <- tau + switch(tsf, mcjI = invmcjI(linpred[,
     i], lambda, symm, dbounded = dbounded), bc = invbc(linpred[,
     i], lambda))
     }
     if (is.null(cn))
     cn <- 0.5 * log(log(n))/sqrt(n)
     F <- apply(zhat, 2, Fvec, cn = cn)
     Fp <- apply(zhat + 1, 2, Fvec, cn = cn)
     multiplier <- (tau - (TZ <= yhat))^2
     a <- array(NA, dim = c(p, p, M))
     for (i in 1:M) a[, , i] <- t(x * multiplier[, i]) %*% x/n
     multiplier <- tau^2 + (1 - 2 * tau) * (y <= (zhat - 1)) +
     ((zhat - y) * (zhat - 1 < y & y <= zhat)) * (zhat - y -
     2 * tau)
     b <- array(NA, dim = c(p, p, M))
     for (i in 1:M) b[, , i] <- t(x * multiplier[, i]) %*% x/n
     multiplier <- (zhat - tau) * (F <= Z & Z < Fp)
     d <- array(NA, dim = c(p, p, M))
     sel <- rep(TRUE, M)
     for (i in 1:M) {
     tmpInv <- try(solve(t(x * multiplier[, i]) %*% x/n),
     silent = TRUE)
     if (class(tmpInv) != "try-error") {
     d[, , i] <- tmpInv
     }
     else {
     sel[i] <- FALSE
     }
     }
     dad <- 0
     dbd <- 0
     for (i in (1:M)[sel]) {
     dad <- dad + d[, , i] %*% a[, , i] %*% d[, , i]
     dbd <- dbd + d[, , i] %*% b[, , i] %*% d[, , i]
     }
     m.n <- sum(sel)
     if (m.n != 0) {
     V <- dad/(m.n^2) + (1 - 1/m.n) * dbd * 1/m.n
     V <- V/n
     stds <- sqrt(diag(V))
     }
     else {
     stds <- NA
     warning("Standard error not available")
     }
     betahat <- sapply(fit, function(x) x$coefficients)
     betahat <- if (p == 1)
     mean(betahat)
     else rowMeans(betahat)
     linpred <- if (p == 1) {
     mean(linpred[1, ])
     }
     else {
     rowMeans(linpred)
     }
     Fitted <- tau + switch(tsf, mcjI = invmcjI(linpred, lambda,
     symm, dbounded = dbounded), bc = invbc(linpred, lambda))
     lower <- betahat + qt(alpha/2, n - p) * stds
     upper <- betahat + qt(1 - alpha/2, n - p) * stds
     tP <- 2 * pt(-abs(betahat/stds), n - p)
     ans <- cbind(betahat, stds, lower, upper, tP)
     colnames(ans) <- c("Value", "Std. Error", "lower bound",
     "upper bound", "Pr(>|t|)")
     rownames(ans) <- names(betahat) <- term.labels
     fit <- list()
     fit$call <- call
     fit$method <- method
     fit$mf <- mf
     mf <- match.call(expand.dots = FALSE)
     m <- match(c("formula", "data", "subset", "weights", "na.action"),
     names(mf), 0L)
     mf <- mf[c(1L, m)]
     mf[[1L]] <- as.name("get_all_vars")
     fit$data <- eval(mf, parent.frame())
     fit$x <- x
     fit$y <- y
     fit$weights <- w
     fit$offset <- offset
     fit$tau <- tau
     fit$lambda <- lambda
     fit$tsf <- tsf
     attr(fit$tsf, "symm") <- symm
     fit$coefficients <- betahat
     fit$M <- M
     fit$Mn <- m.n
     fit$fitted.values <- Fitted
     fit$tTable <- ans
     fit$Cov <- V
     fit$levels <- .getXlevels(mt, mf)
     fit$terms <- mt
     fit$term.labels <- term.labels
     fit$rdf <- n - p
     class(fit) <- "rq.counts"
     return(fit)
    }
    <bytecode: 0x55849291e4e0>
    <environment: namespace:Qtools>
     --- function search by body ---
    Function rq.counts in namespace Qtools has this body.
     ----------- END OF FAILURE REPORT --------------
    Fatal error: the condition has length > 1
Flavor: r-devel-linux-x86_64-debian-gcc

Version: 1.4.1
Check: re-building of vignette outputs
Result: WARN
    Error(s) in re-building vignettes:
     ...
    --- re-building ‘Qtools.Rmd’ using rmarkdown
    Warning in engine$weave(file, quiet = quiet, encoding = enc) :
     Pandoc (>= 1.12.3) and/or pandoc-citeproc not available. Falling back to R Markdown v1.
    Quitting from lines 124-146 (Qtools.Rmd)
    Error: processing vignette 'Qtools.Rmd' failed with diagnostics:
    argument is of length zero
    --- failed re-building ‘Qtools.Rmd’
    
    SUMMARY: processing the following file failed:
     ‘Qtools.Rmd’
    
    Error: Vignette re-building failed.
    Execution halted
Flavors: r-patched-solaris-x86, r-release-osx-x86_64

Version: 1.4.1
Check: re-building of vignette outputs
Result: WARN
    Error in re-building vignettes:
     ...
    Warning in engine$weave(file, quiet = quiet, encoding = enc) :
     Pandoc (>= 1.12.3) and/or pandoc-citeproc not available. Falling back to R Markdown v1.
    Quitting from lines 124-146 (Qtools.Rmd)
    Error: processing vignette 'Qtools.Rmd' failed with diagnostics:
    argument is of length zero
    Execution halted
Flavor: r-oldrel-osx-x86_64