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

> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: dbchoice
> ### Title: Parametric approach to analyze double-bounded dichotomous choice
> ###   contingent valuation data
> ### Aliases: dbchoice print.dbchoice vcov.dbchoice logLik.dbchoice
> ### Keywords: DCchoice double-bounded nonlinear
> 
> ### ** Examples
> 
> ## Examples are based on a data set NaturalPark in the package 
> ## Ecdat (Croissant 2011): DBDCCV style question for measuring 
> ## willingness to pay for the preservation of the Alentejo Natural 
> ## Park. The data set (dataframe) contains seven variables: 
> ## bid1 (bid in the initial question), bidh (higher bid in the follow-up 
> ## question), bidl (lower bid in the follow-up question), answers 
> ## (response outcomes in a factor format with four levels of "nn", 
> ## "ny", "yn", "yy"), respondents' characteristic variables such 
> ## as age, sex and income (see NaturalPark for details).
> data(NaturalPark, package = "Ecdat")
> head(NaturalPark)
  bid1 bidh bidl answers age    sex income
1    6   18    3      yy   1 female      2
2   48  120   24      yn   2   male      1
3   48  120   24      yn   2 female      3
4   24   48   12      nn   5 female      1
5   24   48   12      ny   6 female      2
6   12   24    6      nn   4   male      2
> 
> ## The variable answers are converted into a format that is suitable for the 
> ## function dbchoice() as follows:
> NaturalPark$R1 <- ifelse(substr(NaturalPark$answers, 1, 1) == "y", 1, 0)
> NaturalPark$R2 <- ifelse(substr(NaturalPark$answers, 2, 2) == "y", 1, 0)
> 
> ## We assume that the error distribution in the model is a 
> ## log-logistic; therefore, the bid variables bid1 is converted 
> ## into LBD1 as follows:
> NaturalPark$LBD1 <- log(NaturalPark$bid1)
> 
> ## Further, the variables bidh and bidl are integrated into one 
> ## variable (bid2) and the variable is converted into LBD2 as follows:
> NaturalPark$bid2 <- ifelse(NaturalPark$R1 == 1, NaturalPark$bidh, NaturalPark$bidl)
> NaturalPark$LBD2 <- log(NaturalPark$bid2)
> 
> ## The utility difference function is assumed to contain covariates (sex, age, and 
> ## income) as well as two bid variables (LBD1 and LBD2) as follows:
> fmdb <- R1 + R2 ~ sex + age + income | LBD1 + LBD2
> 
> ## Not run: 
> ##D ## The formula may be alternatively defined as
> ##D fmdb <- R1 + R2 ~ sex + age + income | log(bid1) + log(bid2)
> ## End(Not run)
> 
> ## The function dbchoice() with the function fmdb and the dataframe 
> ## NP is executed as follows:
> NPdb <- dbchoice(fmdb, data = NaturalPark)
> NPdb

Distribution: log-logistic 
(Intercept)   sexfemale         age      income    log(bid) 
   3.490541   -0.267775   -0.351578    0.277374   -1.133728 
> NPdbs <- summary(NPdb)
 ----------- FAILURE REPORT -------------- 
 --- failure: the condition has length > 1 ---
 --- srcref --- 
: 
 --- package (from environment) --- 
DCchoice
 --- call from context --- 
wtp(object = X, b = coef, bid = bid, dist = dist)
 --- call from argument --- 
if (class(object) == "sbchoice" | class(object) == "dbchoice") {
    X <- object$covariates
    b <- object$coefficients
    bid <- object$bid
    dist <- object$dist
} else {
    X <- object
}
 --- R stacktrace ---
where 1: wtp(object = X, b = coef, bid = bid, dist = dist)
where 2: summary.dbchoice(NPdb)
where 3: summary(NPdb)

 --- value of length: 2 type: logical ---
[1] FALSE FALSE
 --- function from context --- 
function (object, b = NULL, bid = NULL, dist = NULL) 
{
    if (class(object) == "sbchoice" | class(object) == "dbchoice") {
        X <- object$covariates
        b <- object$coefficients
        bid <- object$bid
        dist <- object$dist
    }
    else {
        X <- object
    }
    coef <- b
    names(coef) <- NULL
    npar <- length(coef)
    b <- coef[npar]
    Xb <- sum(colMeans(X) * coef[-npar])
    if (dist == "log-logistic") {
        func <- function(x) plogis(-(Xb + b * log(x)), lower.tail = FALSE)
        medianWTP <- exp(-Xb/b)
        meanWTP <- ifelse(abs(b) > 1, integrate(func, 0, Inf, 
            stop.on.error = FALSE)$value, Inf)
        trunc.meanWTP <- integrate(func, 0, exp(max(bid)), stop.on.error = FALSE)$value
        adj.trunc.meanWTP <- integrate(func, 0, exp(max(bid)), 
            stop.on.error = FALSE)$value/plogis(-(Xb + b * max(bid)))
    }
    else if (dist == "log-normal") {
        func <- function(x) pnorm(-(Xb + b * log(x)), lower.tail = FALSE)
        medianWTP <- exp(-Xb/b)
        meanWTP <- integrate(func, 0, Inf, stop.on.error = FALSE)$value
        trunc.meanWTP <- integrate(func, 0, exp(max(bid)), stop.on.error = FALSE)$value
        adj.trunc.meanWTP <- integrate(func, 0, exp(max(bid)), 
            stop.on.error = FALSE)$value/pnorm(-(Xb + b * max(bid)))
    }
    else if (dist == "logistic") {
        func <- function(x) plogis(-(Xb + b * x), lower.tail = FALSE)
        medianWTP <- -Xb/b
        meanWTP <- integrate(func, 0, Inf, stop.on.error = FALSE)$value
        trunc.meanWTP <- integrate(func, 0, max(bid), stop.on.error = FALSE)$value
        adj.trunc.meanWTP <- integrate(func, 0, max(bid), stop.on.error = FALSE)$value/plogis(-(Xb + 
            b * max(bid)))
    }
    else if (dist == "normal") {
        func <- function(x) pnorm(-(Xb + b * x), lower.tail = FALSE)
        medianWTP <- -Xb/b
        meanWTP <- integrate(func, 0, Inf, stop.on.error = FALSE)$value
        trunc.meanWTP <- integrate(func, 0, max(bid), stop.on.error = FALSE)$value
        adj.trunc.meanWTP <- integrate(func, 0, max(bid), stop.on.error = FALSE)$value/pnorm(-(Xb + 
            b * max(bid)))
    }
    else if (dist == "weibull") {
        func <- function(x) pweibull(exp(-Xb - b * log(x)), shape = 1, 
            lower.tail = FALSE)
        medianWTP <- exp(-Xb/b) * (log(2))^(-1/b)
        meanWTP <- ifelse(abs(b) > 1, exp(-Xb/b) * gamma(1 - 
            1/b), Inf)
        trunc.meanWTP <- integrate(func, 0, exp(max(bid)), stop.on.error = FALSE)$value
        adj.trunc.meanWTP <- integrate(func, 0, exp(max(bid)), 
            stop.on.error = FALSE)$value/pweibull(exp(-Xb - b * 
            max(bid)), shape = 1)
    }
    output <- list(meanWTP = meanWTP, trunc.meanWTP = trunc.meanWTP, 
        adj.trunc.meanWTP = adj.trunc.meanWTP, medianWTP = medianWTP)
    return(output)
}
<bytecode: 0x82a1fa0>
<environment: namespace:DCchoice>
 --- function search by body ---
Function wtp in namespace DCchoice has this body.
 ----------- END OF FAILURE REPORT -------------- 
Error in if (class(object) == "sbchoice" | class(object) == "dbchoice") { : 
  the condition has length > 1
Calls: summary -> summary.dbchoice -> wtp
Execution halted