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

> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: hapPowerAsymp
> ### Title: Asymptotic power calculations for genetic association analyses
> ###   with Haplin
> ### Aliases: hapPowerAsymp
> 
> ### ** Examples
> 
> 
> ## Calculate the asymptotic power for a triad design 
> ## when the minor allele increases the fetal risk by twofold.
> ## Assumes a multiplicative dose-response relationship.
> hapPowerAsymp(nall = c(2), n.strata = 1, cases = list(c(mfc=120)), 
+ haplo.freq = c(0.1,0.9), RR = c(2,1), RRstar = c(1,1))
 ----------- FAILURE REPORT -------------- 
 --- failure: the condition has length > 1 ---
 --- srcref --- 
: 
 --- package (from environment) --- 
Haplin
 --- call from context --- 
f.check.pars0(.mcall, .defaults.hap)
 --- call from argument --- 
if (class(mcall$data) == "gwaa.data") {
    if (.info$model$design == "triad") {
        if (.xchrom) {
            .info$variables$sex <- 7
        }
    }
    if (.info$model$design == "cc.triad") {
        .info$variables$ccvar <- 10
        if (.xchrom) {
            .info$variables$sex <- 7
        }
    }
    if (.info$model$design == "cc") {
        .info$variables$ccvar <- 4
        if (.xchrom) {
            .info$variables$sex <- 3
        }
    }
}
 --- R stacktrace ---
where 1: f.check.pars0(.mcall, .defaults.hap)
where 2: f.catch0(cur.call, formals())
where 3: haplin0(n.vars = 0, design = "triad", ccvar = NULL, xchrom = FALSE, 
    sex = NULL, verbose = FALSE, use.missing = TRUE, threshold = 0, 
    reference = 2L, data.out = "prelim", data = c("1", "2", "1", 
    "2", "1", "2", "1", "2", "1", "2", "1", "2", "1", "2", "1", 
    "2", "1", "1", "2", "2", "1", "1", "2", "2", "1", "1", "2", 
    "2", "1", "1", "2", "2", "1", "1", "1", "1", "2", "2", "2", 
    "2", "1", "1", "1", "1", "2", "2", "2", "2", "1", "1", "1", 
    "1", "1", "1", "1", "1", "2", "2", "2", "2", "2", "2", "2", 
    "2", "1", "1", "2", "2", "1", "1", "2", "2", "1", "1", "2", 
    "2", "1", "1", "2", "2", "1", "1", "1", "1", "1", "1", "1", 
    "1", "2", "2", "2", "2", "2", "2", "2", "2"))
where 4: do.call("haplin0", args = .haparg)
where 5: (function (nall, n.strata = 1, cases, controls, haplo.freq, RR, 
    RRcm, RRcf, RRstar, RR.mat, RRstar.mat, xchrom = F, sim.comb.sex = "double", 
    BR.girls, response = "mult", ...) 
{
    .sim.maternal <- FALSE
    if (!missing(RR.mat) | !missing(RRstar.mat)) 
        .sim.maternal <- TRUE
    .sim.poo <- FALSE
    if (!missing(RRcm) | !missing(RRcf)) 
        .sim.poo <- TRUE
    if (.sim.poo && !missing(RR)) 
        stop("RR cannot be present at the same time as RRcm and RRcf", 
            call. = F)
    .nhaplo <- prod(nall)
    .nloci <- length(nall)
    .RR.controls <- rep(1, .nhaplo)
    .missing.controls <- FALSE
    if (missing(controls)) 
        .missing.controls <- TRUE
    if (.missing.controls) 
        controls <- c(mfc = 0)
    if (xchrom & sim.comb.sex %in% c("females", "males")) 
        BR.girls <- 1
    if ((n.strata == 1 && length(cases) > 1) | any(sapply(cases, 
        length) > 1)) 
        stop("Each element of list cases can only have length 1", 
            call. = F)
    if (!.missing.controls && (n.strata == 1 && length(controls) > 
        1) | any(sapply(controls, length) > 1)) 
        stop("Each element of list controls can only have length 1", 
            call. = F)
    .arg <- list(nall = nall, n.strata = n.strata, cases = cases, 
        controls = controls, haplo.freq = haplo.freq, sim.maternal = .sim.maternal, 
        sim.poo = .sim.poo, xchrom = xchrom, sim.comb.sex = sim.comb.sex, 
        nhaplo = .nhaplo, nloci = .nloci, n.sim = 10)
    if (.sim.poo) 
        .RR.arg <- list(RRcm = RRcm, RRcf = RRcf, RRstar = RRstar)
    else .RR.arg <- list(RR = RR, RRstar = RRstar)
    if (.sim.maternal) 
        .RR.arg <- c(.RR.arg, list(RR.mat = RR.mat, RRstar.mat = RRstar.mat))
    if (xchrom) 
        .RR.arg <- c(.RR.arg, list(BR.girls = BR.girls))
    .arg <- c(.arg, .RR.arg)
    .strat.arg <- do.call(f.hapArg, args = .arg)
    .f.prob.arg <- .strat.arg[, -which(colnames(.strat.arg) %in% 
        c("cases", "controls", "n.sim")), drop = FALSE]
    lapply(1:n.strata, function(x) {
        do.call(f.hapTests, args = .strat.arg[x, ])
    })
    if (xchrom & sim.comb.sex == "males") 
        message("The males are simulated assuming no contribution from fathers to sons")
    .design <- sapply(1:n.strata, function(x) {
        if (all(.strat.arg[, "control.mat"][[x]] == 0) | .missing.controls) {
            if (all(.strat.arg[, "case.design"][[x]] == "c")) 
                stop("Only case children are given. No controls are available", 
                  call. = F)
            if (all(.strat.arg[, "case.design"][[x]] == "fc") & 
                xchrom) 
                stop("No controls are available", call. = F)
            .design <- "triad"
        }
        else if (all(.strat.arg[, "case.design"][[x]] == "c") & 
            all(.strat.arg[, "control.design"][[x]] == "c")) 
            .design <- "cc"
        else .design <- "cc.triad"
        return(.design)
    })
    if (length(unique(.design)) == 1) 
        .design <- unique(.design)
    else stop("Unable to specify haplin design due to the combination of arguments \"cases\" and \"controls\"", 
        call. = F)
    if (.design == "cc" & xchrom) 
        stop("Design \"cc\" and xchrom is not yet implemented ", 
            call. = F)
    .n.vars <- 0
    .ccvar <- NULL
    .sex = NULL
    if (xchrom) 
        .n.vars <- .n.vars + 1
    if (.design != "triad") 
        .n.vars <- .n.vars + 1
    if (.design != "triad" & !xchrom) 
        .ccvar <- .n.vars
    else if (.design == "triad" & xchrom) 
        .sex <- .n.vars
    else if (.design != "triad" & xchrom) {
        .ccvar <- .n.vars - 1
        .sex <- .n.vars
    }
    if (is.list(haplo.freq)) 
        .haplo.freq <- haplo.freq[[which.max(unlist(lapply(haplo.freq, 
            max)))]]
    else .haplo.freq <- haplo.freq
    .ref.cat <- which.max(.haplo.freq)
    .lu <- list(...)
    if ("reference" %in% names(.lu)) 
        .ref.cat <- .lu$reference
    .response <- response
    .haparg <- list(n.vars = .n.vars, design = .design, ccvar = .ccvar, 
        xchrom = xchrom, sex = .sex, verbose = FALSE, use.missing = TRUE, 
        threshold = 0, reference = .ref.cat, data.out = "prelim")
    .f.prob.arg <- .f.prob.arg[, -which(colnames(.f.prob.arg) %in% 
        c("gen.missing.cases", "gen.missing.controls", "nloci", 
            "nhaplo", "case.des", "control.des", "case.mat", 
            "control.mat", "case.design", "control.design", "nall", 
            "sim.poo")), drop = FALSE]
    colnames(.f.prob.arg)[which(colnames(.f.prob.arg) == "xchrom")] <- "sim.xchrom"
    if (!.sim.poo) {
        .f.prob.arg.RRcmcf <- cbind(.f.prob.arg[, "RR"], .f.prob.arg[, 
            "RR"])
        colnames(.f.prob.arg.RRcmcf) <- c("RRcm", "RRcf")
        .f.prob.arg <- cbind(.f.prob.arg, .f.prob.arg.RRcmcf)
        .f.prob.arg <- .f.prob.arg[, -which(colnames(.f.prob.arg) == 
            "RR"), drop = FALSE]
    }
    .var.covar <- list()
    for (i in 1:n.strata) {
        .tmp.strat.arg <- .strat.arg[i, ]
        .RR <- as.data.frame(.tmp.strat.arg[which(grepl("RR", 
            names(.tmp.strat.arg)))])
        .RRstar <- .RR[, which(grepl("star", names(.RR))), drop = F]
        if (.response == "mult") {
            if (any(apply(.RRstar, 2, sum) != .nhaplo)) 
                stop("Arguments RRstar and/or RRstar.mat do not correspond to a multiplicative dose-response model", 
                  call. = F)
            .RR <- .RR[, -which(grepl("star", names(.RR))), drop = F]
        }
        .names <- names(.RR)
        .RR.ref <- .RR[.ref.cat, , drop = F]
        .RR <- lapply(1:ncol(.RR), function(x) .RR[, x] <- .RR[, 
            x]/.RR.ref[, x])
        .RR <- lapply(1:length(.RR), function(x) {
            if (!grepl("star", .names[x])) 
                .RR <- .RR[[x]][-.ref.cat]
            else if (grepl("star", .names[x]) & .nhaplo <= 2) 
                .RR <- .RR[[x]][-.ref.cat]
            else .RR <- .RR[[x]]
            .RR
        })
        .RR.beta <- as.vector(log(unlist(.RR)))
        .haplo.coef <- .tmp.strat.arg$haplo.freq
        .haplo.beta <- f.beta.haplo.freq.asymp(haplo.freq = .haplo.coef)
        .beta <- c(.haplo.beta, .RR.beta)
        .k <- 0
        if (.design != "triad") {
            .k <- .tmp.strat.arg$controls/.tmp.strat.arg$cases
            .beta <- c(0, .beta)
        }
        if (xchrom) 
            .beta <- c(-log(1/BR.girls), .beta)
        .design.matrix <- f.design.get(n.all = .nhaplo, design = .design, 
            xchrom = xchrom, maternal = .sim.maternal, poo = .sim.poo, 
            hwe = T, comb.sex = sim.comb.sex, ref.cat = .ref.cat, 
            response = .response, ret.characteristics = F, mc.int = F)
        .info <- attr(.design.matrix, "info")
        .X <- as.matrix(.design.matrix)
        names(.beta) <- colnames(.X)
        .prob <- f.prob.asymp(beta = .beta, design = .design, 
            X = .X, k = .k)
        .design.grid <- f.design.get(n.all = .nhaplo, design = .design, 
            xchrom = xchrom, maternal = .sim.maternal, poo = .sim.poo, 
            hwe = T, comb.sex = sim.comb.sex, ref.cat = .ref.cat, 
            response = .response, ret.characteristics = T, mc.int = F)
        .grid <- expand.grid(lapply(.design.grid, function(x) {
            1:x
        }))
        .case.design = .tmp.strat.arg$case.design
        .control.design = .tmp.strat.arg$control.design
        .grid <- f.grid.asymp(pos = nrow(.grid), design = .design, 
            xchrom = xchrom, n.vars = .n.vars, nall = nall, case.design = .case.design, 
            control.design = .control.design)
        .ncells <- nrow(.grid)
        .haparg$data <- .grid
        .data <- do.call("haplin0", args = .haparg)
        if (.design != "triad") {
            .data$cc[.data$cc == "case"] <- 2
            .data$cc[.data$cc == "control"] <- 1
            mode(.data$cc) <- "numeric"
        }
        if (xchrom) {
            .data$sex[.data$sex == "girl"] <- 2
            .data$sex[.data$sex == "boy"] <- 1
            mode(.data$sex) <- "numeric"
        }
        .orig <- sort(unique(.data$orig.lines))
        if (!identical(.orig, 1:.ncells)) 
            stop()
        .norig <- length(.orig)
        .var.covar.strat <- f.var.covar.asymp(X = .X, data = .data, 
            pred = .prob, ncells = .ncells, norig = .norig, orig = .orig, 
            info = .info)
        if (xchrom | .design != "triad") 
            .beta <- .beta[-which(names(.beta) %in% c("cc", "sex"))]
        .var.covar.strat <- .var.covar.strat[names(.beta), names(.beta)]/(.strat.arg[i, 
            "cases"]$cases + .strat.arg[i, "controls"]$controls)
        if (.sim.poo) 
            .var.covar.strat <- f.post.poo.diff(list(as.matrix(.beta)), 
                list(as.matrix(.var.covar.strat)))
        else .var.covar.strat <- f.post.diff(list(.beta), list(.var.covar.strat))
        .var.covar[[i]] <- .var.covar.strat
    }
    .coef <- sapply(.var.covar, function(x) x$coeff)
    .covar <- sapply(.var.covar, function(x) x$covar)
    .asymp <- list(coef = .coef, cov = .covar)
    attr(.asymp, "ref.cat") <- .ref.cat
    return(.asymp)
})(nall = 2, n.strata = 1, cases = list(c(mfc = 120)), controls = , 
    haplo.freq = c(0.1, 0.9), RR = c(2, 1), RRcm = , RRcf = , 
    RRstar = c(1, 1), RR.mat = , RRstar.mat = , xchrom = FALSE, 
    sim.comb.sex = "double", BR.girls = , response = "mult", 
    alpha = 0.05)
where 6: do.call(hapCovar, args = .asymp.arg)
where 7: hapPowerAsymp(nall = c(2), n.strata = 1, cases = list(c(mfc = 120)), 
    haplo.freq = c(0.1, 0.9), RR = c(2, 1), RRstar = c(1, 1))

 --- value of length: 2 type: logical ---
[1] FALSE FALSE
 --- function from context --- 
function (mcall, defaults) 
{
    params <- defaults
    params[names(mcall)] <- mcall
    .info <- list(filename = params[["filename"]], filespecs = params[c("markers", 
        "n.vars", "sep", "allele.sep", "na.strings", "subset")], 
        model = params[c("design", "use.missing", "xchrom", "comb.sex", 
            "maternal", "poo", "test.maternal", "scoretest")], 
        variables = params[c("ccvar", "covar", "strata", "sex")], 
        haplos = params[c("reference", "response", "threshold", 
            "max.haplos", "haplo.file")], control = params[c("resampling", 
            "max.EM.iter", "data.out", "verbose", "printout")])
    class(.info) <- "info"
    .xchrom <- .info$model$xchrom
    .ccdesign <- .info$model$design %in% c("cc.triad", "cc")
    .allowed <- .info
    .allowed$model$scoretest <- c("yes", "no", "only")
    .allowed$model$design <- c("triad", "cc.triad", "cc")
    .allowed$haplos$response <- c("mult", "free")
    .allowed$control$data.out <- c("no", "basic", "prelim", "null", 
        "full")
    .allowed$control$resampling <- c("no", "jackknife")
    .allowed$model$comb.sex <- c("males", "females", "single", 
        "double")
    for (i in seq(along = .info)[-1]) {
        for (j in seq(along = .info[[i]])) {
            if (length(.info[[c(i, j)]]) == 1) {
                if (!is.element(.info[[c(i, j)]], .allowed[[c(i, 
                  j)]])) {
                  stop(paste("The argument ", names(.info[[i]])[j], 
                    " has an invalid value. \nIt should be one of: \n", 
                    paste(.allowed[[c(i, j)]], collapse = ", "), 
                    sep = ""), call. = F)
                }
            }
        }
    }
    if (.info$model$design %in% c("triad", "cc.triad")) {
        .info$model$fam <- "mfc"
    }
    if (.info$model$design == "cc") {
        .info$model$fam <- "c"
    }
    if (!is.name(.info$filename)) {
        .filetest.f <- file_test("-f", .info$filename)
        if (!.filetest.f) 
            stop(paste(.info$filename, " is not a file.", sep = ""), 
                call. = F)
    }
    if (class(mcall$data) == "gwaa.data") {
        if (.info$model$design == "triad") {
            if (.xchrom) {
                .info$variables$sex <- 7
            }
        }
        if (.info$model$design == "cc.triad") {
            .info$variables$ccvar <- 10
            if (.xchrom) {
                .info$variables$sex <- 7
            }
        }
        if (.info$model$design == "cc") {
            .info$variables$ccvar <- 4
            if (.xchrom) {
                .info$variables$sex <- 3
            }
        }
    }
    if (.xchrom && !is.null(.info$model$comb.sex) && .info$model$comb.sex == 
        "males") {
        if (.info$haplos$response != "mult") {
            warning("Can only use response = \"mult\" with comb.sex = \"males\". Has been changed to \"mult\".", 
                call. = F)
            .info$haplos$response <- "mult"
        }
        if (.info$model$poo) {
            stop("parent-of-origin estimation not possible when comb.sex = \"males\".", 
                call. = F)
        }
    }
    if (.info$model$poo) {
        if (.info$model$design == "cc") {
            stop("parent-of-origin effects not available when design = \"cc\"", 
                call. = F)
        }
        if (.info$haplos$reference == "reciprocal") {
            warning("Can only (for the time being) use reference = \"ref.cat\" or \"population\" when poo == TRUE. Has been changed to \"ref.cat\".", 
                call. = F)
            .info$haplos$reference <- "ref.cat"
        }
    }
    if (.ccdesign) {
        if (is.null(.info$variables$ccvar)) {
            stop("Parameter \"ccvar\" must be specified when using design \"cc.triad\" or \"cc\"!", 
                call. = F)
        }
        if (.info$filespecs$n.vars == 0) 
            stop("Parameter \"n.vars\" must be specified when using design \"cc.triad\" or \"cc\"!", 
                call. = F)
        if (.info$variables$ccvar > .info$filespecs$n.vars) 
            stop("Parameter \"n.vars\" must be at least as large as parameter \"ccvar\"!", 
                call. = F)
    }
    else {
        if (!is.null(.info$variables$ccvar)) 
            stop("Parameter \"ccvar\" should only be specified when using design \"cc.triad\" or \"cc\"!", 
                call. = F)
    }
    if (!is.logical(.xchrom)) {
        stop("Argument \"xchrom\" must be a logical ( either \"TRUE\" or \"FALSE\" )", 
            call. = F)
    }
    if (.xchrom) {
        if (.info$filespecs$n.vars == 0) {
            stop("Argument \"n.vars\" must be at least 1 to allow for a sex variable when \"xchrom = TRUE\"", 
                call. = F)
        }
        if (!is.numeric(.info$variables$sex)) {
            stop("Argument \"sex\" should be a numeric value ( the column number of the sex variable ) when \"xchrom = TRUE\"", 
                call. = F)
        }
        if (.info$variables$sex > .info$filespecs$n.vars) {
            stop("Argument \"sex\" cannot be larger than \"n.vars\"", 
                call. = F)
        }
    }
    if (F) {
        if (!.xchrom & !is.null(.info$model$comb.sex)) 
            warning("Argument \"comb.sex\" is only implemented for models where \"xchrom = TRUE\"", 
                call. = F)
    }
    if (identical(.info$model$comb.sex, "males")) 
        .info$variables$sel.sex <- 1
    if (identical(.info$model$comb.sex, "females")) 
        .info$variables$sel.sex <- 2
    if (.info$model$scoretest == "only" & (.info$control$data.out == 
        "full")) {
        warning("Since data.out = \"full\", scoretest argument is changed from \"only\" to \"no\"", 
            call. = F)
        .info$control$scoretest <- "no"
    }
    if (!is.numeric(.info$filespecs$markers) & !identical(.info$filespecs$markers, 
        "ALL")) 
        stop("\"markers\" argument must be either \"ALL\" ( default ) or an integer value.", 
            call. = F)
    if ((.info$model$design == "cc") & (.info$model$maternal)) 
        stop("Cannot use maternal = TRUE with design = \"cc\"", 
            call. = F)
    if ((.info$haplos$response %in% c("mult")) & is.element(.info$haplos$reference, 
        c("reciprocal", "population"))) {
        warning("response = \"mult\" must be used with reference category ( numeric or \"ref.cat\" ). Has been changed to reference = \"ref.cat\"", 
            call. = F)
        .info$haplos$reference <- "ref.cat"
    }
    if (.info$model$test.maternal) 
        .info$model$maternal <- TRUE
    return(.info)
}
<bytecode: 0x98bc380>
<environment: namespace:Haplin>
 --- function search by body ---
Function f.check.pars0 in namespace Haplin has this body.
 ----------- END OF FAILURE REPORT -------------- 
Error in if (class(mcall$data) == "gwaa.data") { : 
  the condition has length > 1
Calls: hapPowerAsymp ... <Anonymous> -> do.call -> haplin0 -> f.catch0 -> f.check.pars0
Execution halted