问题
I have followed the instructions in section 13.5.1 of R for Marketing Research and Analytics, transforming a set of data into the required format and running the following commands. I want the part worths to be calculated between the levels of an attribute, i.e., that sum of the levels per attribute should equal zero. Could anyone help me with this?
> library(bayesm)
> library(MASS)
> library(lattice)
> library(Matrix)
> library(ChoiceModelR)
> Test <- data.frame(ChoiceData)
> dput(Test)
structure(list(ID = c(22L, 22L, 22L, 22L, 22L, 22L, 22L, 22L,
22L, 22L, 22L, 22L, 22L, 22L, 22L, 22L, 22L, 22L, 22L, 22L, 22L,
22L, 22L, 22L, 22L, 22L, 22L, 22L, 22L, 22L, 31L, 31L, 31L, 31L,
31L, 31L, 31L, 31L, 31L, 31L, 31L, 31L, 31L, 31L, 31L, 31L, 31L,
31L, 31L, 31L, 31L, 31L, 31L, 31L, 31L, 31L, 31L, 31L, 31L, 31L
), Question = c(1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L, 4L, 4L, 4L,
5L, 5L, 5L, 6L, 6L, 6L, 7L, 7L, 7L, 8L, 8L, 8L, 9L, 9L, 9L, 10L,
10L, 10L, 1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L, 4L, 4L, 4L, 5L,
5L, 5L, 6L, 6L, 6L, 7L, 7L, 7L, 8L, 8L, 8L, 9L, 9L, 9L, 10L,
10L, 10L), Alt = c(1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L,
3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L,
1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L,
2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L,
3L), FormatBottle = c(0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 1L, 0L,
0L, 1L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 1L, 1L,
0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L,
0L, 0L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 0L, 1L, 0L,
1L, 0L), FormatTube = c(1L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L,
1L, 0L, 0L, 0L, 1L, 1L, 0L, 0L, 1L, 0L, 0L, 0L, 1L, 0L, 0L, 0L,
0L, 0L, 0L, 1L, 1L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
1L, 0L, 0L, 0L, 0L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L,
0L, 1L), FormatDispenser = c(0L, 1L, 1L, 0L, 1L, 0L, 0L, 0L,
0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L,
0L, 0L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L,
0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 0L, 1L, 0L, 0L, 0L,
0L, 0L, 0L, 0L), FormatJar = c(0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L,
0L, 1L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 1L, 0L, 1L,
0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 1L, 0L,
1L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L,
0L, 1L, 0L, 0L), ShapeBrand = c(1L, 0L, 0L, 1L, 0L, 1L, 1L, 0L,
0L, 1L, 0L, 1L, 0L, 1L, 1L, 1L, 0L, 0L, 1L, 1L, 0L, 0L, 1L, 0L,
0L, 1L, 0L, 1L, 1L, 0L, 0L, 0L, 1L, 1L, 1L, 0L, 0L, 0L, 1L, 1L,
0L, 1L, 0L, 1L, 1L, 1L, 0L, 1L, 1L, 0L, 1L, 1L, 0L, 0L, 0L, 0L,
1L, 0L, 1L, 0L), ShapeGeneric = c(0L, 1L, 1L, 0L, 1L, 0L, 0L,
1L, 1L, 0L, 1L, 0L, 1L, 0L, 0L, 0L, 1L, 1L, 0L, 0L, 1L, 1L, 0L,
1L, 1L, 0L, 1L, 0L, 0L, 1L, 1L, 1L, 0L, 0L, 0L, 1L, 1L, 1L, 0L,
0L, 1L, 0L, 1L, 0L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 1L, 1L, 1L,
1L, 0L, 1L, 0L, 1L), ColourBlue = c(0L, 0L, 1L, 0L, 0L, 0L, 1L,
0L, 0L, 1L, 1L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 1L, 0L, 0L, 1L, 0L,
0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L,
0L, 1L, 1L, 0L, 1L, 0L, 1L, 0L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 1L,
0L, 1L, 0L, 1L, 0L), ColourWhite = c(0L, 1L, 0L, 1L, 0L, 0L,
0L, 0L, 1L, 0L, 0L, 0L, 1L, 0L, 1L, 0L, 0L, 0L, 0L, 1L, 1L, 0L,
0L, 1L, 0L, 1L, 0L, 0L, 1L, 0L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 1L,
1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 0L, 0L, 1L, 1L, 0L, 0L,
0L, 0L, 0L, 0L, 0L, 1L), ColourPink = c(1L, 0L, 0L, 0L, 1L, 1L,
0L, 1L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 1L, 0L, 1L, 0L, 0L, 0L, 0L,
1L, 0L, 1L, 0L, 1L, 1L, 0L, 0L, 0L, 0L, 1L, 1L, 0L, 1L, 1L, 0L,
0L, 1L, 0L, 0L, 1L, 0L, 1L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 1L,
0L, 1L, 0L, 1L, 0L, 0L), LogoWith = c(1L, 0L, 1L, 0L, 1L, 1L,
0L, 0L, 0L, 1L, 1L, 0L, 0L, 1L, 1L, 0L, 0L, 1L, 0L, 0L, 1L, 0L,
1L, 1L, 0L, 1L, 1L, 0L, 1L, 0L, 1L, 0L, 0L, 1L, 1L, 0L, 1L, 0L,
1L, 0L, 1L, 0L, 1L, 0L, 0L, 1L, 1L, 0L, 0L, 0L, 1L, 1L, 1L, 0L,
0L, 1L, 1L, 0L, 0L, 1L), LogoWithout = c(0L, 1L, 0L, 1L, 0L,
0L, 1L, 1L, 1L, 0L, 0L, 1L, 1L, 0L, 0L, 1L, 1L, 0L, 1L, 1L, 0L,
1L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 1L, 0L, 1L, 1L, 0L, 0L, 1L, 0L,
1L, 0L, 1L, 0L, 1L, 0L, 1L, 1L, 0L, 0L, 1L, 1L, 1L, 0L, 0L, 0L,
1L, 1L, 0L, 0L, 1L, 1L, 0L), Choice = c(3L, 0L, 0L, 3L, 0L, 0L,
3L, 0L, 0L, 3L, 0L, 0L, 3L, 0L, 0L, 2L, 0L, 0L, 3L, 0L, 0L, 2L,
0L, 0L, 1L, 0L, 0L, 3L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 1L, 0L,
0L, 1L, 0L, 0L, 3L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 3L, 0L, 0L,
3L, 0L, 0L, 2L, 0L, 0L)), .Names = c("ID", "Question", "Alt",
"FormatBottle", "FormatTube", "FormatDispenser", "FormatJar",
"ShapeBrand", "ShapeGeneric", "ColourBlue", "ColourWhite", "ColourPink",
"LogoWith", "LogoWithout", "Choice"), row.names = c(NA, -60L), class = "data.frame")
> hb.post <- choicemodelr(data=Test, xcoding=rep(1, 11), mcmc=list(R=10000, use=5000),
options=list(save=TRUE))
Logit Data
==================================================
Attribute Type Levels
-----------------------------------
Attribute 1 Linear 1
Attribute 2 Linear 1
Attribute 3 Linear 1
Attribute 4 Linear 1
Attribute 5 Linear 1
Attribute 6 Linear 1
Attribute 7 Linear 1
Attribute 8 Linear 1
Attribute 9 Linear 1
Attribute 10 Linear 1
Attribute 11 Linear 1
11 parameters to be estimated.
2 total units.
Average of 3 alternatives in each of 10 sets per unit.
20 tasks in total.
Table of choice data pooled across units:
Choice Count Pct.
--------------------
1 7 35%
2 3 15%
3 10 50%
MCMC Inference for Hierarchical Logit
==================================================
Total Iterations: 10000
Draws used in estimation: 5000
Units: 2
Parameters per unit: 11
Constraints not in effect.
Draws are to be saved.
Prior degrees of freedom: 5
Prior variance: 2
MCMC Iteration Beginning...
Iteration Acceptance RLH Pct. Cert. Avg. Var. RMS Time to End
100 0.395 0.526 0.361 6.28 1.15 0:30
200 0.315 0.683 0.617 5.97 2.79 0:26
300 0.310 0.750 0.720 6.09 3.83 0:25
400 0.315 0.775 0.757 6.35 5.59 0:26
500 0.305 0.760 0.739 6.88 7.35 0:26
600 0.320 0.749 0.729 7.26 8.24 0:25
700 0.300 0.790 0.776 7.10 8.67 0:25
800 0.295 0.777 0.766 7.02 9.02 0:25
900 0.315 0.770 0.753 7.78 9.63 0:25
1000 0.300 0.851 0.847 8.25 10.83 0:25
1100 0.320 0.798 0.788 7.30 11.10 0:24
1200 0.330 0.815 0.810 7.55 9.99 0:24
1300 0.325 0.778 0.766 7.18 9.54 0:23
1400 0.335 0.800 0.793 8.70 9.61 0:23
1500 0.300 0.787 0.776 6.94 9.59 0:22
1600 0.345 0.701 0.667 7.24 10.88 0:22
1700 0.310 0.777 0.759 7.20 11.61 0:22
1800 0.335 0.771 0.757 7.19 12.12 0:22
1900 0.300 0.844 0.838 8.66 12.27 0:21
2000 0.305 0.902 0.902 9.56 12.31 0:21
2100 0.320 0.901 0.902 9.30 12.38 0:21
2200 0.315 0.892 0.893 8.61 12.00 0:21
2300 0.320 0.833 0.829 7.43 11.07 0:21
2400 0.315 0.813 0.808 6.79 11.08 0:21
2500 0.335 0.801 0.796 6.97 10.66 0:21
2600 0.310 0.804 0.795 7.14 10.24 0:21
2700 0.320 0.803 0.795 7.35 9.83 0:21
2800 0.320 0.760 0.745 6.75 9.71 0:20
2900 0.320 0.805 0.796 7.98 9.56 0:20
3000 0.325 0.798 0.789 7.72 9.85 0:20
3100 0.285 0.763 0.747 6.83 8.54 0:20
3200 0.290 0.846 0.840 7.49 8.38 0:20
3300 0.315 0.851 0.847 7.30 9.34 0:20
3400 0.350 0.880 0.879 9.17 10.06 0:19
3500 0.310 0.868 0.866 9.54 10.22 0:19
3600 0.345 0.907 0.908 10.08 10.66 0:19
3700 0.330 0.881 0.882 8.01 10.73 0:19
3800 0.315 0.840 0.837 8.14 11.25 0:19
3900 0.315 0.818 0.812 8.51 11.10 0:19
4000 0.280 0.840 0.837 8.34 10.87 0:18
4100 0.325 0.869 0.867 9.70 11.35 0:18
4200 0.295 0.881 0.882 10.34 11.95 0:18
4300 0.315 0.850 0.848 9.31 12.20 0:18
4400 0.335 0.898 0.899 12.03 12.74 0:18
4500 0.320 0.822 0.810 10.79 12.66 0:17
4600 0.320 0.878 0.873 9.21 11.67 0:17
4700 0.320 0.863 0.861 11.02 12.19 0:17
4800 0.300 0.848 0.845 9.69 13.76 0:17
4900 0.365 0.851 0.850 7.95 14.14 0:17
5000 0.305 0.815 0.809 7.43 13.76 0:17
5100 0.290 0.835 0.832 7.61 13.90 0:16
5200 0.315 0.821 0.817 7.08 13.52 0:16
5300 0.315 0.783 0.772 7.20 13.71 0:16
5400 0.350 0.755 0.738 7.40 13.62 0:15
5500 0.320 0.770 0.758 6.42 12.94 0:15
5600 0.330 0.837 0.833 6.76 12.85 0:15
5700 0.325 0.834 0.832 7.13 13.76 0:15
5800 0.365 0.850 0.850 7.39 15.56 0:14
5900 0.305 0.872 0.873 7.75 16.34 0:14
6000 0.300 0.885 0.886 12.10 17.85 0:14
6100 0.290 0.887 0.888 10.45 17.49 0:14
6200 0.310 0.882 0.883 8.58 16.52 0:14
6300 0.320 0.793 0.778 7.42 16.25 0:13
6400 0.320 0.790 0.779 6.81 15.68 0:13
6500 0.315 0.828 0.824 7.13 15.92 0:13
6600 0.300 0.816 0.808 6.94 17.08 0:12
6700 0.340 0.847 0.845 7.76 17.64 0:12
6800 0.305 0.831 0.829 8.83 17.03 0:12
6900 0.305 0.799 0.791 7.18 16.70 0:12
7000 0.325 0.816 0.812 7.03 16.29 0:11
7100 0.345 0.799 0.792 6.87 17.43 0:11
7200 0.310 0.785 0.777 6.56 18.22 0:11
7300 0.325 0.732 0.711 6.66 17.52 0:10
7400 0.335 0.821 0.814 7.23 18.32 0:10
7500 0.280 0.824 0.821 6.91 18.55 0:10
7600 0.300 0.821 0.817 7.34 19.74 0:09
7700 0.335 0.805 0.798 7.84 20.71 0:09
7800 0.295 0.771 0.757 7.84 20.98 0:09
7900 0.340 0.771 0.756 7.68 22.60 0:08
8000 0.305 0.779 0.768 7.18 23.22 0:08
8100 0.365 0.779 0.769 8.01 24.37 0:08
8200 0.315 0.791 0.782 8.96 25.21 0:07
8300 0.305 0.803 0.795 7.85 23.95 0:07
8400 0.285 0.756 0.741 7.58 22.80 0:07
8500 0.340 0.822 0.818 7.51 21.42 0:06
8600 0.295 0.837 0.836 7.46 19.89 0:06
8700 0.290 0.848 0.847 6.95 18.63 0:05
8800 0.325 0.872 0.873 7.96 17.39 0:05
8900 0.295 0.891 0.893 7.82 16.30 0:05
9000 0.325 0.891 0.890 9.22 17.79 0:04
9100 0.315 0.862 0.856 8.80 18.25 0:04
9200 0.325 0.833 0.826 9.29 18.26 0:03
9300 0.295 0.782 0.770 8.34 16.97 0:03
9400 0.325 0.807 0.801 8.25 17.51 0:03
9500 0.315 0.828 0.825 8.22 17.14 0:02
9600 0.315 0.880 0.879 7.92 16.89 0:02
9700 0.295 0.895 0.895 9.14 16.41 0:01
9800 0.335 0.884 0.883 9.79 17.15 0:01
9900 0.300 0.907 0.909 11.95 17.25 0:00
10000 0.310 0.809 0.801 9.58 16.38 0:00
Total Time Elapsed: 0:44
Writing estimated unit-level betas to Rbetas.csv in the working directory
> names(hb.post)
[1] "betadraw" "compdraw" "loglike"
> hb.post$compdraw[[1]]$mu
[1] 12.968273 -2.910196 -3.918684 -18.195898 -7.391889 -11.120094 9.027483
[8] 5.318799 10.470909 23.447956 18.273067
> crossprod(hb.post$compdraw[[1]]$rooti)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0.269202120 -0.131369181 -0.00750423 0.05677799 0.07353783 -0.001719181
[2,] -0.131369181 0.398585223 -0.05972400 0.18054662 -0.13884476 0.001989741
[3,] -0.007504230 -0.059723996 0.18131261 -0.16032548 0.07125643 0.054428162
[4,] 0.056777991 0.180546622 -0.16032548 0.32889988 -0.05003134 -0.100237796
[5,] 0.073537829 -0.138844758 0.07125643 -0.05003134 0.24988274 -0.016004613
[6,] -0.001719181 0.001989741 0.05442816 -0.10023780 -0.01600461 0.298190022
[7,] 0.081636043 0.112820601 -0.02220723 0.06293524 -0.11789463 0.134168823
[8,] 0.103541947 -0.023174420 -0.05402454 0.10914559 0.15388200 -0.083138284
[9,] 0.125425320 0.061912218 -0.07956797 0.16981461 0.01032007 -0.073627847
[10,] 0.087741814 -0.160231990 0.09670889 -0.08723735 0.13004753 0.106413327
[11,] -0.118962885 0.079213611 0.03730569 -0.06608473 -0.10926189 0.070595462
[,7] [,8] [,9] [,10] [,11]
[1,] 0.08163604 0.10354195 0.12542532 0.08774181 -0.11896288
[2,] 0.11282060 -0.02317442 0.06191222 -0.16023199 0.07921361
[3,] -0.02220723 -0.05402454 -0.07956797 0.09670889 0.03730569
[4,] 0.06293524 0.10914559 0.16981461 -0.08723735 -0.06608473
[5,] -0.11789463 0.15388200 0.01032007 0.13004753 -0.10926189
[6,] 0.13416882 -0.08313828 -0.07362785 0.10641333 0.07059546
[7,] 0.41527878 -0.09874701 0.02946641 -0.19291910 0.05424860
[8,] -0.09874701 0.54676212 -0.09581227 0.04483254 -0.03985814
[9,] 0.02946641 -0.09581227 0.75490521 -0.18253217 -0.17888569
[10,] -0.19291910 0.04483254 -0.18253217 0.75185563 -0.15559705
[11,] 0.05424860 -0.03985814 -0.17888569 -0.15559705 0.55371966
> beta.post.mean <- apply(hb.post$betadraw, 1:2, mean)
> head(beta.post.mean)
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,] 14.09509 1.699958 -3.758005 -16.82691 -11.149724 -5.634989 26.92577 23.70962
[2,] 12.03705 6.524403 -5.680688 -17.22764 -6.854921 -10.280702 28.82568 22.41429
[,9] [,10] [,11]
[1,] 25.94871 12.61363 10.77954
[2,] 26.78210 15.16685 8.84741
> beta.post.q05 <- apply(hb.post$betadraw, 1:2, quantile, probs=c(0.05))
> beta.post.q95 <- apply(hb.post$betadraw, 1:2, quantile, probs=c(0.95))
> rbind(q05=beta.post.q05[1,], mean=beta.post.mean[1,], q95=beta.post.q95[1,])
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
q05 3.945165 -9.651987 -15.405028 -25.606785 -20.123767 -16.489890 8.005764 7.283777
mean 14.095090 1.699958 -3.758005 -16.826907 -11.149724 -5.634989 26.925768 23.709617
q95 24.561224 12.886290 10.012030 -6.616857 -1.135777 10.952166 40.529771 38.938681
[,9] [,10] [,11]
q05 9.650313 4.308683 0.8074844
mean 25.948705 12.613631 10.7795415
q95 42.514774 22.041031 18.9729086
来源：https://stackoverflow.com/questions/41793592/choicemodelr-part-worths