DC Choice
CHIPINDU, Lovemore (CIMMYT-Zimbabwe)
8/9/2021
library(Icens)## Loading required package: survivallibrary(DCchoice)library(readr)
dbe <- read_csv("C:/Users/LCHIPINDU/OneDrive - CIMMYT/CIMMYT/Dr Paswel/Double Bound Experiment/dbe.csv")##
## -- Column specification --------------------------------------------------------
## cols(
## .default = col_double(),
## IDENTIFIERS = col_logical(),
## ma6 = col_character(),
## district = col_character(),
## a1 = col_character(),
## vcluster = col_character(),
## a3 = col_character(),
## a4 = col_character(),
## a5 = col_character(),
## aa5 = col_character(),
## a7 = col_character(),
## DOUBLEB = col_logical(),
## COVAR = col_logical(),
## sex = col_character(),
## decision = col_character(),
## game = col_character(),
## mf1 = col_character()
## )
## i Use `spec()` for the full column specifications.View(dbe)
attach(dbe)
sex=as.factor(sex)
vcluster=as.factor(vcluster)Single-bounded dichotomous choice CV format
sb_1<-turnbull.sb(yesone~ bidone, data = dbe, timeMessage =TRUE,conf.level = 0.95)
summary(sb_1)## Survival probability:
## Upper Prob.
## 1 0.00 1.0000
## 2 0.25 0.9581
## 3 0.50 0.7387
## 4 0.75 0.3934
## 5 Inf 0.0000
##
## WTP estimates:
## Mean: 0.522569 (Kaplan-Meier)
## Mean: 0.598389 (Spearman-Karber)
## Median in: [ 0.5 , 0.75 ]plot(sb_1)
## or
sb_2<-turnbull.sb(yestwo~ bidone, data = dbe)
summary(sb_2)## Survival probability:
## Upper Prob.
## 1 0.00 1.0000
## 2 0.25 0.1106
## 3 0.50 0.1106
## 4 0.75 0.1106
## 5 Inf 0.0000
##
## WTP estimates:
## Mean: 0.082915 (Kaplan-Meier)
## Mean: 0.194095 (Spearman-Karber)
## Median in: [ 0 , 0.25 ]plot(sb_2)
## or
sb_3<-turnbull.sb(yestwo~ bidtwo, data = dbe)
summary(sb_3)## Survival probability:
## Upper Prob.
## 1 0.000 1.00000
## 2 0.125 0.66667
## 3 0.250 0.28846
## 4 0.500 0.08396
## 5 0.750 0.08396
## 6 1.000 0.08396
## 7 Inf 0.00000
##
## WTP estimates:
## Mean: 0.182357 (Kaplan-Meier)
## Mean: 0.252392 (Spearman-Karber)
## Median in: [ 0.125 , 0.25 ]plot(sb_3)
# Double-bounded dichotomous choice CV format
sb_4<-turnbull.db(yesone+yestwo ~ bidone + bidtwo, data = dbe)
summary(sb_4)## Survival probability:
## Upper Prob.
## 1 0.000 1.00000
## 2 0.125 0.96424
## 3 0.250 0.89273
## 4 0.500 0.40536
## 5 0.750 0.14804
## 6 1.000 0.02056
## 7 Inf 0.00000
##
## WTP estimates:
## Mean: 0.375614 (Kaplan-Meier)
## Mean: 0.491339 (Spearman-Karber)
## Median in: [ 0.25 , 0.5 ]plot(sb_4)
The utility difference function
fmdb <- yesone+yestwo ~ sex + ageresp+agricown+agricwage+nonagric+hhsz+ + totpltsz+decision+mzarea | log(bidone) + log(bidtwo)
NPdb <- dbchoice(fmdb, data = dbe)
NPdb##
## Distribution: log-logistic
## (Intercept)
## -3.84820308
## sexmale
## 0.37066873
## ageresp
## -0.00318159
## agricown
## 1.10875949
## agricwage
## -10.78584801
## nonagric
## 0.12106203
## hhsz
## 0.00428369
## totpltsz
## 0.20213391
## decisionmyself.and.other.houseold.member
## -1.73775628
## decisionmyself.and.spouse
## -0.17071621
## mzarea
## -0.13197739
## log(bid)
## -3.56980616###+vcluster
NPdbs <- summary(NPdb)
NPdbs##
## Call:
## dbchoice(formula = fmdb, data = dbe)
##
## Formula:
## yesone + yestwo ~ sex + ageresp + agricown + agricwage + nonagric + hhsz +
## +totpltsz + decision + mzarea | log(bidone) + log(bidtwo)
##
## Coefficients:
## Estimate Std. Error z value
## (Intercept) -3.848203 1.527047 -2.5200
## sexmale 0.370669 0.394707 0.9391
## ageresp -0.003182 0.013311 -0.2390
## agricown 1.108759 1.240825 0.8936
## agricwage -10.785848 371.820725 -0.0290
## nonagric 0.121062 1.332400 0.0909
## hhsz 0.004284 0.065527 0.0654
## totpltsz 0.202134 0.135296 1.4940
## decisionmyself.and.other.houseold.member -1.737756 1.509304 -1.1514
## decisionmyself.and.spouse -0.170716 0.370319 -0.4610
## mzarea -0.131977 0.146495 -0.9009
## log(bid) -3.569806 0.349201 -10.2228
## Pr(>|z|)
## (Intercept) 0.01174 *
## sexmale 0.34768
## ageresp 0.81108
## agricown 0.37155
## agricwage 0.97686
## nonagric 0.92760
## hhsz 0.94788
## totpltsz 0.13517
## decisionmyself.and.other.houseold.member 0.24958
## decisionmyself.and.spouse 0.64480
## mzarea 0.36764
## log(bid) < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Distribution: log-logistic
## Number of Obs.: 122
## Log-likelihood: -147.557995
##
## LR statistic: 1149.539 on 1e+01 DF, p-value: 0.000
## AIC: 319.115991 , BIC: 352.764243
##
## Iterations: 68 24
## Convergence: TRUE
##
## WTP estimates:
## Mean : 0.5075517
## Mean : 0.4864977 (truncated at the maximum bid)
## Mean : 0.5134222 (truncated at the maximum bid with adjustment)
## Median: 0.4445276The confidence intervals for these WTPs are calculated using the
function krCI() or bootCI() as follows:
#krCI(NPdb)
#bootCI(NPdb)plot(NPdb)
## The range of bid can be limited (e.g., [log(10), log(20)]):
plot(NPdb, bid = c(log(10), log(20)))
fmks <- yesone ~ bidone
NPks <- kristrom(fmks, data = dbe)
NPks##
## Probability:
## Upper Prob.
## 1 0.00 1.0000
## 2 0.25 0.9581
## 3 0.50 0.7387
## 4 0.75 0.3934
## 5 Inf 0.0000NPkss <- summary(NPks)
NPkss## Survival probability:
## Upper Prob.
## 1 0.00 1.0000
## 2 0.25 0.9581
## 3 0.50 0.7387
## 4 0.75 0.3934
## 5 Inf 0.0000
##
## WTP estimates:
## Mean: 0.522569 (Kaplan-Meier)
## Mean: 0.654434 (Spearman-Karber)
## Median: 0.672841plot(NPks)
District Extension methods
demo<-subset(dbe, game=="DEMO")
dm_1<-turnbull.sb(yesone ~ bidtwo, data =demo)
summary(dm_1)## Survival probability:
## Upper Prob.
## 1 0.000 1.00
## 2 0.125 0.75
## 3 0.250 0.75
## 4 0.500 0.75
## 5 0.750 0.75
## 6 1.000 0.75
## 7 Inf 0.00
##
## WTP estimates:
## Mean: 0.750000 (Kaplan-Meier)
## Mean: 0.765625 (Spearman-Karber)
## Median in: [ 1 , NA ]plot(dm_1)
Seed packs
sp<-subset(dbe, game=="SEED PACK")
dm_2<-turnbull.sb(yesone ~ bidtwo, data =sp)
summary(dm_2)## Survival probability:
## Upper Prob.
## 1 0.000 1.0000
## 2 0.125 0.6806
## 3 0.250 0.6806
## 4 0.500 0.6806
## 5 0.750 0.6806
## 6 1.000 0.6806
## 7 Inf 0.0000
##
## WTP estimates:
## Mean: 0.680556 (Kaplan-Meier)
## Mean: 0.700521 (Spearman-Karber)
## Median in: [ 1 , NA ]plot(dm_2)
NEIGHBORS FARM
nf<-subset(dbe, game=="NEIGHBORS FARM")
dm_3<-turnbull.sb(yesone ~ bidone, data =nf)
summary(dm_3)## Survival probability:
## Upper Prob.
## 1 0.00 1.0000
## 2 0.25 0.9623
## 3 0.50 0.8000
## 4 0.75 0.3800
## 5 Inf 0.0000
##
## WTP estimates:
## Mean: 0.535566 (Kaplan-Meier)
## Mean: 0.613066 (Spearman-Karber)
## Median in: [ 0.5 , 0.75 ]plot(dm_3)
NONE
nn<-subset(dbe, game=="NONE")
dm_4<-turnbull.sb(yesone ~ bidone, data =nn)
summary(dm_4)## Survival probability:
## Upper Prob.
## 1 0.00 1.0000
## 2 0.25 0.9565
## 3 0.50 0.7447
## 4 0.75 0.3488
## 5 Inf 0.0000
##
## WTP estimates:
## Mean: 0.512510 (Kaplan-Meier)
## Mean: 0.593905 (Spearman-Karber)
## Median in: [ 0.5 , 0.75 ]plot(dm_4)