R: Parametric approach to analyze single-bounded dichotomous...
sbchoice
R Documentation
Parametric approach to analyze single-bounded dichotomous choice contingent valuation data
Description
This function analyzes single-bounded dichotomous choice contingent valuation (CV) data
on the basis of the utility difference approach.
Usage
sbchoice(formula, data, subset, dist = "log-logistic", ...)
## S3 method for class 'sbchoice'
print(x, digits = max(3, getOption("digits") - 1), ...)
## S3 method for class 'sbchoice'
vcov(object, ...)
## S3 method for class 'sbchoice'
logLik(object, ...)
Arguments
formula
an S3 class object "formula" and specifies the model structure.
data
a data frame containing the variables in the model formula.
subset
an optional vector specifying a subset of observations.
dist
a character string setting the error distribution in the model, which takes one
of "logistic", "normal", "log-logistic", "log-normal" or
"weibull".
x
an object of class "sbchoice".
digits
a number of digits to display.
object
an object of class "dbchoice".
...
optional arguments. Currently not in use.
Details
The function sbchoice() implements an analysis of single-bounded dichotomous choice
contingent valuation (CV) data on the basis of the utility difference approach
(Hanemann, 1984).
The extractor function summary() is available for a "sbchoice" class object.
See summary.sbchoice for details.
There are two functions available for computing the confidence intervals for the estimates of WTPs.
krCI implements simulations to construct empirical distributions of the WTP while
bootCI carries out nonparametric bootstrapping.
Most of the details of sbchoice() is the same as those of dbchoice(), a double-bounded
analogue of sbchoice. See the section Details in dbchoice. Differences between
the two functions are as follows:
In the model formula, the first part contains only one response variable (e.g., R1)
and the third part contains only one bid variable (e.g., BD1) because respondents are
requested to answer a CV question in the single-bounded dichotomous choice CV. The following
is a typical structure of the formula: R1 ~ (the names of the covariates) | BD1
The function sbchoice() analyzes the responses to single-bounded dichotomous choice CV
questions internally using the function glm() with the argument family = binomial(link = "logit")
or family = binomial(link = "probit").
When dist = "weibull", optimization is carried out using the optim() function
with a hard-coded log-likelihood function.
Outputs from sbchoice() are slightly different from those from dbchoice()
because the analysis in sbchoice() internally depends on the function glm()
for the (log-) normal or (log-) logistic distributions. (see the Value section).
Nonparametric analysis of single-bounded dichotomous choice data can be done by turnbull.sb
or by kristrom.
Value
This function returns an object of S3 class "sbchoice" that is a list with the following components.
coefficients
a named vector of estimated coefficients.
call
the matched call.
formula
the formula supplied.
glm.out
a list of components returned from glm() with the data set and the formula. In case
of the Weibull distribution, a list of components from the optim() is saved.
glm.null
a list of components returned from glm() with the data set and a formula
containing only constant (null model). In case of the Weibull distribution, a list of
components from the optim() is saved.
distribution
a character string showing the error distribution used.
nobs
a number of observations.
covariates
a named matrix of the covariates used in the model.
bid
a named matrix of the bids used in the model.
yn
a named matrix of the responses to the CV question used in the model.
data.name
the data matrix.
terms
terms
contrast
contrasts used for factors
xlevels
levels used for factors
References
Bateman IJ, Carson RT, Day B, Hanemann M, Hanley N, Hett T, Jones-Lee M, Loomes
G, Mourato S, "Ozdemiro=glu E, Pearce DW, Sugden R, Swanson J (eds.) (2002).
Economic Valuation with Stated Preference Techniques: A Manual.
Edward Elger, Cheltenham, UK.
Boyle KJ, Welsh MP, Bishop RC (1988).
“Validation of Empirical Measures of Welfare Change: Comment.”
Land Economics, 64(1), 94–98.
Carson RT, Hanemann WM (2005).
“Contingent Valuation.”
in KG M"aler, JR Vincent (eds.), Handbook of Environmental Economics.
Elsevier, New York.
Hanemann, WM (1984).
“Welfare Evaluations in Contingent Valuation Experiments with Discrete Responses”,
American Journal of Agricultural Economics,
66(2), 332–341.
Hanemann M, Kanninen B (1999).
“The Statistical Analysis of Discrete-Response CV Data.”,
in IJ Bateman, KG Willis (eds.),
Valuing Environmental Preferences: Theory and Practice of the Contingent
Valuation Methods in the US, EU, and Developing Countries,
302–441.
Oxford University Press, New York.
## Examples for sbchoice() are also based on a data set NaturalPark
## in the package Ecdat (Croissant 2011): so see the section Examples
## in the dbchoice() for details.
data(NaturalPark, package = "Ecdat")
## The variable answers are converted into a format that is suitable for
## the function sbchoice() 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)
## The utility difference function is assumed to contain covariates
## (sex, age, and income) as well as the bid variable (LBD1) as follows
## (R2 is not used because of single-bounded dichotomous choice CV format):
fmsb <- R1 ~ sex + age + income | LBD1
## Not run:
## The formula may be alternatively defined as
fmsb <- R1 ~ sex + age + income | log(bid1)
## End(Not run)
## The function sbchoice() with the function fmsb and the data frame NP
## is executed as follows:
NPsb <- sbchoice(fmsb, data = NaturalPark)
NPsb
NPsbs <- summary(NPsb)
NPsbs
## Not run:
## Generic functions such as summary() and coefficients() work for glm.out
summary(NPsb$glm.out)
coefficients(NPsb$glm.out)
## The confidence intervals for these WTPs are calculated using the
## function krCI() or bootCI() as follows:
krCI(NPsb)
bootCI(NPsb)
## The WTP of a female with age = 5 and income = 3 is calculated
## using function krCI() or bootCI() as follows:
krCI(NPsb, individual = data.frame(sex = "female", age = 5, income = 3))
bootCI(NPsb, individual = data.frame(sex = "female", age = 5, income = 3))
## End(Not run)
## The variable age and income are deleted from the fitted model,
## and the updated model is fitted as follows:
update(NPsb, .~. - age - income |.)
## Respondents' utility and probability of choosing Yes under
## the fitted model and original data are predicted as follows:
head(predict(NPsb, type = "utility"))
head(predict(NPsb, type = "probability"))
## Utility and probability of choosing Yes for a female with age = 5
## and income = 3 under bid = 10 are predicted as follows:
predict(NPsb, type = "utility",
newdata = data.frame(sex = "female", age = 5, income = 3, LBD1 = log(10)))
predict(NPsb, 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(NPsb)
## The range of bid can be limited (e.g., [log(10), log(20)]):
plot(NPsb, bid = c(log(10), log(20)))
Results
R version 3.3.1 (2016-06-21) -- "Bug in Your Hair"
Copyright (C) 2016 The R Foundation for Statistical Computing
Platform: x86_64-pc-linux-gnu (64-bit)
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.
R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.
Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.
> library(DCchoice)
Loading required package: MASS
Loading required package: interval
Loading required package: survival
Loading required package: perm
Loading required package: Icens
Loading required package: MLEcens
Loading required package: Formula
> png(filename="/home/ddbj/snapshot/RGM3/R_CC/result/DCchoice/sbchoice.Rd_%03d_medium.png", width=480, height=480)
> ### Name: sbchoice
> ### Title: Parametric approach to analyze single-bounded dichotomous choice
> ### contingent valuation data
> ### Aliases: sbchoice print.sbchoice vcov.sbchoice logLik.sbchoice
> ### Keywords: DCchoice nonlinear
>
> ### ** Examples
>
> ## Examples for sbchoice() are also based on a data set NaturalPark
> ## in the package Ecdat (Croissant 2011): so see the section Examples
> ## in the dbchoice() for details.
> data(NaturalPark, package = "Ecdat")
>
> ## The variable answers are converted into a format that is suitable for
> ## the function sbchoice() 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)
>
> ## The utility difference function is assumed to contain covariates
> ## (sex, age, and income) as well as the bid variable (LBD1) as follows
> ## (R2 is not used because of single-bounded dichotomous choice CV format):
> fmsb <- R1 ~ sex + age + income | LBD1
>
> ## Not run:
> ##D ## The formula may be alternatively defined as
> ##D fmsb <- R1 ~ sex + age + income | log(bid1)
> ## End(Not run)
>
> ## The function sbchoice() with the function fmsb and the data frame NP
> ## is executed as follows:
> NPsb <- sbchoice(fmsb, data = NaturalPark)
> NPsb
Distribution: log-logistic
(Intercept) sexfemale age income log(bid)
2.3518393 -0.6102508 -0.3709046 0.2603811 -0.4624407
> NPsbs <- summary(NPsb)
> NPsbs
Call:
sbchoice(formula = fmsb, data = NaturalPark)
Formula:
R1 ~ sex + age + income | LBD1
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 2.35184 0.64755 3.632 0.000281 ***
sexfemale -0.61025 0.25045 -2.437 0.014827 *
age -0.37090 0.08546 -4.340 1.42e-05 ***
income 0.26038 0.10566 2.464 0.013730 *
log(bid) -0.46244 0.16212 -2.852 0.004338 **
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Distribution: log-logistic
Number of Obs.: 312
log-likelihood: -190.2891
pseudo-R^2: 0.1142 , adjusted pseudo-R^2: 0.0909
LR statistic: 49.057 on 4 DF, p-value: 0.000
AIC: 390.578240 , BIC: 409.293256
Iterations: 4
Convergence: TRUE
WTP estimates:
Mean : Inf (because of |beta_bid| < 1)
Mean : 26.3269 (truncated at the maximum bid)
Mean : 46.8923 (truncated at the maximum bid with adjustment)
Median : 28.13794
>
> ## Not run:
> ##D ## Generic functions such as summary() and coefficients() work for glm.out
> ##D summary(NPsb$glm.out)
> ##D coefficients(NPsb$glm.out)
> ##D
> ##D ## The confidence intervals for these WTPs are calculated using the
> ##D ## function krCI() or bootCI() as follows:
> ##D krCI(NPsb)
> ##D bootCI(NPsb)
> ##D ## The WTP of a female with age = 5 and income = 3 is calculated
> ##D ## using function krCI() or bootCI() as follows:
> ##D krCI(NPsb, individual = data.frame(sex = "female", age = 5, income = 3))
> ##D bootCI(NPsb, individual = data.frame(sex = "female", age = 5, income = 3))
> ## End(Not run)
>
> ## The variable age and income are deleted from the fitted model,
> ## and the updated model is fitted as follows:
> update(NPsb, .~. - age - income |.)
Distribution: log-logistic
(Intercept) sexfemale log(bid)
1.5634784 -0.6437818 -0.3529223
>
> ## Respondents' utility and probability of choosing Yes under
> ## the fitted model and original data are predicted as follows:
> head(predict(NPsb, type = "utility"))
[1] 1.062863546 0.080210259 -0.009278378 -1.322214876 -1.432738361
[6] 0.239861144
> head(predict(NPsb, type = "probability"))
[1] 0.7432374 0.5200418 0.4976804 0.2104500 0.1926724 0.5596794
> ## Utility and probability of choosing Yes for a female with age = 5
> ## and income = 3 under bid = 10 are predicted as follows:
> predict(NPsb, type = "utility",
+ newdata = data.frame(sex = "female", age = 5, income = 3, LBD1 = log(10)))
[1] -0.3966003
> predict(NPsb, type = "probability",
+ newdata = data.frame(sex = "female", age = 5, income = 3, LBD1 = log(10)))
[1] 0.4021294
>
> ## Plot of probabilities of choosing yes is drawn as drawn as follows:
> plot(NPsb)
> ## The range of bid can be limited (e.g., [log(10), log(20)]):
> plot(NPsb, bid = c(log(10), log(20)))
>
>
>
>
>
> dev.off()
null device
1
>