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

> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: algo.hhh
> ### Title: Fit a Classical HHH Model (DEPRECATED)
> ### Aliases: algo.hhh print.ah coef.ah
> ### Keywords: ts regression
> 
> ### ** Examples
> 
> 
> # univariate time series: salmonella agona cases 
> data(salmonella.agona)
> 
> model1 <- list(lambda=TRUE, linear=TRUE, 
+                nseason=1, negbin="single")
>                
> algo.hhh(salmonella.agona, control=model1)
 ----------- FAILURE REPORT -------------- 
 --- failure: the condition has length > 1 ---
 --- srcref --- 
: 
 --- package (from environment) --- 
surveillance
 --- call from context --- 
algo.hhh(salmonella.agona, control = model1)
 --- call from argument --- 
if (class(cov) == "try-error") {
    if (verbose) {
        cat("Fisher info singular \t loglik=", loglik, " \n")
        cat("theta", round(thetahat, 2), "\n")
        cat("Results are not reliable! Try different starting values. \n")
    }
    res <- list(convergence = FALSE)
    class(res) <- "ah"
    return(res)
}
 --- R stacktrace ---
where 1: algo.hhh(salmonella.agona, control = model1)

 --- value of length: 2 type: logical ---
[1] FALSE FALSE
 --- function from context --- 
function (disProgObj, control = list(lambda = TRUE, neighbours = FALSE, 
    linear = FALSE, nseason = 0, negbin = c("none", "single", 
        "multiple"), proportion = c("none", "single", "multiple"), 
    lag.range = NULL), thetastart = NULL, verbose = TRUE) 
{
    if (class(disProgObj) == "sts") 
        disProgObj <- sts2disProg(disProgObj)
    if (is.null(control[["linear", exact = TRUE]])) 
        control$linear <- FALSE
    if (is.null(control[["nseason", exact = TRUE]])) 
        control$nseason <- 0
    if (is.null(control[["neighbours", exact = TRUE]])) 
        control$neighbours <- NA
    if (is.null(control[["negbin", exact = TRUE]])) 
        control$negbin <- "none"
    if (is.null(control[["lambda", exact = TRUE]])) 
        control$lambda <- 1
    if (is.null(control[["proportion", exact = TRUE]])) 
        control$proportion <- "none"
    control$negbin <- match.arg(control$negbin, c("single", "multiple", 
        "none"))
    control$proportion <- match.arg(control$proportion, c("single", 
        "multiple", "none"))
    if (is.logical(control[["lambda", exact = TRUE]])) {
        control$lambda <- as.numeric(control$lambda)
        control$lambda[control$lambda == 0] <- NA
    }
    if (is.logical(control[["neighbours", exact = TRUE]])) {
        control$neighbours <- as.numeric(control$neighbours)
        control$neighbours[control$neighbours == 0] <- NA
    }
    if (is.null(control[["lag.range", exact = TRUE]])) {
        lags <- c(control$lambda, control$neighbours)
        control$lag.range <- c(max(c(lags, 1), na.rm = TRUE), 
            max(c(-lags, 0), na.rm = TRUE))
    }
    if (is.vector(disProgObj$observed)) 
        disProgObj$observed <- as.matrix(disProgObj$observed)
    n <- nrow(disProgObj$observed)
    nareas <- ncol(disProgObj$observed)
    if (nareas == 1) {
        control$neighbours <- NA
        control$proportion <- "none"
        control$nseason <- control$nseason[1]
    }
    if (control$proportion != "none") {
        control$neighbours <- NA
        if (sum(!is.na(control$lambda)) == 0 | sum(!is.na(control$lambda)) != 
            nareas) 
            control$lambda <- 1
    }
    if (sum(!is.na(control$neighbours)) > 0 | control$proportion != 
        "none") {
        if (is.null(disProgObj$neighbourhood)) 
            stop("No neighbourhood matrix is provided\n")
        if (any(is.na(disProgObj$neighbourhood))) 
            stop("No correct neighbourhood matrix given\n")
    }
    designRes <- make.design(disProgObj = disProgObj, control = control)
    if (designRes$dim$phi > 0) {
        nOfNeighbours <- designRes$nOfNeighbours
        if ((designRes$dim$phi == 1) & (sum(nOfNeighbours) == 
            0)) 
            stop("Specified model is not in line with neighbourhood matrix\n")
        if ((length(control$neighbours) == nareas) & (any(nOfNeighbours[!is.na(control$neighbours)] == 
            0))) 
            stop("Specified model is not in line with neighbourhood matrix\n")
    }
    else if (designRes$dim$proportion > 0) {
        nOfNeighbours <- designRes$nOfNeighbours
        if ((designRes$dim$proportion == 1) & (sum(nOfNeighbours) == 
            0)) 
            stop("Specified model is not in line with neighbourhood matrix\n")
        if ((designRes$dim$proportion == nareas) & (any(nOfNeighbours == 
            0))) 
            stop("Specified model is not in line with neighbourhood matrix\n")
    }
    dimtheta <- designRes$dimTheta$dim
    dimLambda <- designRes$dimTheta$lambda
    dimPhi <- designRes$dimTheta$phi
    areastart <- log(colMeans(designRes$Y)/designRes$populationFrac[1, 
        ])
    if (!is.null(thetastart)) {
        if (all(length(thetastart) != c(dimtheta, dimtheta - 
            nareas))) {
            cat("thetastart must be of length", dimtheta, "or ", 
                dimtheta - nareas, "\n")
            return(NULL)
        }
        theta <- thetastart
        if (length(theta) == dimtheta) 
            areastart <- NULL
    }
    else {
        theta <- c(rep(log(0.5), designRes$dimTheta$lambda), 
            rep(log(0.1), designRes$dimTheta$phi), rep(0.5, designRes$dimTheta$proportion), 
            rep(0, designRes$dimTheta$trend + designRes$dimTheta$season), 
            rep(2, designRes$dimTheta$negbin))
    }
    if (!is.null(areastart)) {
        if (dimLambda + dimPhi > 0) {
            Lambda <- getLambda(theta[1:(dimLambda + dimPhi)], 
                designRes)
            expAlpha <- expAlpha.mm(Lambda, designRes$Y)
            expAlpha[expAlpha <= 0] <- (colMeans(designRes$Y)/designRes$populationFrac[1, 
                ])[expAlpha <= 0]
            areastart <- log(expAlpha)
        }
        theta <- c(areastart, theta)
    }
    mu <- meanResponse(theta, designRes)$mean
    if (any(mu == 0) | any(!is.finite(mu))) 
        stop("invalid initial values\n")
    mycontrol <- list(fnscale = -1, type = 3, maxit = 1000)
    suppressWarnings(myoptim <- optim(theta, fn = loglikelihood, 
        gr = gradient, control = mycontrol, method = "BFGS", 
        hessian = TRUE, designRes = designRes))
    if (myoptim$convergence == 0) {
        convergence <- TRUE
    }
    else {
        if (verbose) 
            cat("Algorithm has NOT converged. \n")
        res <- list(convergence = FALSE)
        class(res) <- "ah"
        return(res)
    }
    loglik <- myoptim$value
    if (loglik == 0) {
        if (verbose) {
            cat("loglikelihood = 0\n")
            cat("Results are not reliable! Try different starting values. \n")
        }
        res <- list(convergence = FALSE)
        class(res) <- "ah"
        return(res)
    }
    thetahat <- myoptim$par
    fisher <- -myoptim$hessian
    fitted <- meanResponse(thetahat, designRes)$mean
    D <- jacobian(thetahat, designRes)$D
    thetahat <- jacobian(thetahat, designRes)$theta
    cov <- try(D %*% solve(fisher) %*% t(D), silent = TRUE)
    if (class(cov) == "try-error") {
        if (verbose) {
            cat("Fisher info singular \t loglik=", loglik, " \n")
            cat("theta", round(thetahat, 2), "\n")
            cat("Results are not reliable! Try different starting values. \n")
        }
        res <- list(convergence = FALSE)
        class(res) <- "ah"
        return(res)
    }
    if (any(!is.finite(diag(cov))) | any(diag(cov) < 0)) {
        if (verbose) {
            cat("infinite or negative cov\t loglik=", loglik, 
                "\n")
            cat("theta", round(thetahat, 2), "\n")
            cat("Results are not reliable! Try different starting values. \n")
        }
        res <- list(convergence = FALSE)
        class(res) <- "ah"
        return(res)
    }
    se <- sqrt(diag(cov))
    if (convergence & verbose) 
        cat("Algorithm claims to have converged \n")
    result <- list(coefficients = thetahat, se = se, cov = cov, 
        call = match.call(), loglikelihood = loglik, convergence = convergence, 
        fitted.values = fitted, control = control, disProgObj = disProgObj, 
        lag = designRes$lag, nObs = designRes$nObs)
    class(result) <- "ah"
    return(result)
}
<bytecode: 0xcb189b8>
<environment: namespace:surveillance>
 --- function search by body ---
Function algo.hhh in namespace surveillance has this body.
 ----------- END OF FAILURE REPORT -------------- 
Fatal error: the condition has length > 1