Last updated on 2020-02-19 10:48:50 CET.
| Flavor | Version | Tinstall | Tcheck | Ttotal | Status | Flags |
|---|---|---|---|---|---|---|
| r-devel-linux-x86_64-debian-clang | 0.0.15 | 8.69 | 74.33 | 83.02 | ERROR | |
| r-devel-linux-x86_64-debian-gcc | 0.0.15 | 8.14 | 57.96 | 66.10 | ERROR | |
| r-devel-linux-x86_64-fedora-clang | 0.0.15 | 103.38 | ERROR | |||
| r-devel-linux-x86_64-fedora-gcc | 0.0.15 | 98.86 | ERROR | |||
| r-devel-windows-ix86+x86_64 | 0.0.15 | 15.00 | 86.00 | 101.00 | OK | |
| r-devel-windows-ix86+x86_64-gcc8 | 0.0.15 | 25.00 | 118.00 | 143.00 | OK | |
| r-patched-linux-x86_64 | 0.0.15 | 7.30 | 64.14 | 71.44 | OK | |
| r-patched-solaris-x86 | 0.0.15 | 132.70 | OK | |||
| r-release-linux-x86_64 | 0.0.15 | 7.25 | 64.10 | 71.35 | OK | |
| r-release-windows-ix86+x86_64 | 0.0.15 | 14.00 | 77.00 | 91.00 | OK | |
| r-release-osx-x86_64 | 0.0.15 | OK | ||||
| r-oldrel-windows-ix86+x86_64 | 0.0.15 | 10.00 | 69.00 | 79.00 | OK | |
| r-oldrel-osx-x86_64 | 0.0.15 | OK |
Version: 0.0.15
Check: examples
Result: ERROR
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: 0x6538348>
<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
Flavor: r-devel-linux-x86_64-debian-clang
Version: 0.0.15
Check: examples
Result: ERROR
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: 0x5595ac4e4ce0>
<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
Flavor: r-devel-linux-x86_64-debian-gcc
Version: 0.0.15
Check: examples
Result: ERROR
Running examples in ‘DCchoice-Ex.R’ failed
The error most likely occurred in:
> ### 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: 0x596e3e8>
<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
Flavor: r-devel-linux-x86_64-fedora-clang
Version: 0.0.15
Check: examples
Result: ERROR
Running examples in ‘DCchoice-Ex.R’ failed
The error most likely occurred in:
> ### 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: 0x63f14b0>
<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
Flavor: r-devel-linux-x86_64-fedora-gcc