## 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)
## 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
if (FALSE) {
## The formula may be alternatively defined as
fmdb <- R1 + R2 ~ sex + age + income | log(bid1) + log(bid2)
}
## The function dbchoice() with the function fmdb and the dataframe
## NP is executed as follows:
NPdb <- dbchoice(fmdb, data = NaturalPark)
NPdb
NPdbs <- summary(NPdb)
NPdbs
## The confidence intervals for these WTPs are calculated using the
## function krCI() or bootCI() as follows:
if (FALSE) {
krCI(NPdb)
bootCI(NPdb)
}
## The WTP of a female with age = 5 and income = 3 is calculated
## using function krCI() or bootCI() as follows:
if (FALSE) {
krCI(NPdb, individual = data.frame(sex = "female", age = 5, income = 3))
bootCI(NPdb, individual = data.frame(sex = "female", age = 5, income = 3))
}
## The variable age and income are deleted from the fitted model,
## and the updated model is fitted as follows:
update(NPdb, .~. - age - income |.)
## The bid design used in this example is created as follows:
bid.design <- unique(NaturalPark[, c(1:3)])
bid.design <- log(bid.design)
colnames(bid.design) <- c("LBD1", "LBDH", "LBDL")
bid.design
## Respondents' utility and probability of choosing Yes-Yes, Yes-No,
## No-Yes, and No-No under the fitted model and original data are
## predicted as follows:
head(predict(NPdb, type = "utility", bid = bid.design))
head(predict(NPdb, type = "probability", bid = bid.design))
## Utility and probability of choosing Yes for a female with age = 5
## and income = 3 under bid = 10 are predicted as follows:
predict(NPdb, type = "utility",
newdata = data.frame(sex = "female", age = 5, income = 3, LBD1 = log(10)))
predict(NPdb, type = "probability",
newdata = data.frame(sex = "female", age = 5, income = 3, LBD1 = log(10)))
## Plot of probabilities of choosing yes is drawn as drawn as follows:
plot(NPdb)
## The range of bid can be limited (e.g., [log(10), log(20)]):
plot(NPdb, bid = c(log(10), log(20)))
Run the code above in your browser using DataLab