Skip to content

Commit

Permalink
updated simulations vignette
Browse files Browse the repository at this point in the history
  • Loading branch information
jhelvy committed Dec 7, 2020
1 parent 69a04d7 commit e42828d
Show file tree
Hide file tree
Showing 15 changed files with 53 additions and 27 deletions.
1 change: 1 addition & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@
## Summary of larger updates:

- Added support for auto creating interactions amongst variables
- exported `getCoefTable()` function

## Summary of smaller updates:

Expand Down
4 changes: 2 additions & 2 deletions README.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -10,12 +10,12 @@ knitr::opts_chunk$set(
warning = FALSE,
message = FALSE,
comment = "#>",
fig.path = "man/figures/",
fig.path = "man/figs/",
fig.retina = 3
)
```

# logitr <a href='https://jhelvy.github.io/logitr/'><img src='man/figures/logitr-hex.png' align="right" height="139" /></a>
# logitr <a href='https://jhelvy.github.io/logitr/'><img src='man/figs/logitr-hex.png' align="right" height="139" /></a>

<!-- badges: start -->
[![Lifecycle:
Expand Down
8 changes: 4 additions & 4 deletions README.md
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@

<!-- README.md is generated from README.Rmd. Please edit that file -->

# logitr <a href='https://jhelvy.github.io/logitr/'><img src='man/figures/logitr-hex.png' align="right" height="139" /></a>
# logitr <a href='https://jhelvy.github.io/logitr/'><img src='man/figs/logitr-hex.png' align="right" height="139" /></a>

<!-- badges: start -->

Expand Down Expand Up @@ -88,16 +88,16 @@ citation("logitr")
#>
#> To cite logitr in publications use:
#>
#> John Paul Helveston. logitr: Random utility logit models with
#> preference and willingness to pay space parameterizations (2020)
#> John Paul Helveston (2020). logitr: Random utility logit models with
#> preference and willingness to pay space parameterizations.
#>
#> A BibTeX entry for LaTeX users is
#>
#> @Manual{,
#> title = {logitr: Random utility logit models with preference and willingness to pay space parameterizations},
#> author = {John Paul Helveston},
#> year = {2020},
#> note = {R package version 0.0.4},
#> note = {R package version 0.0.5},
#> url = {https://jhelvy.github.io/logitr/},
#> }
```
1 change: 1 addition & 0 deletions _pkgdown.yml
Original file line number Diff line number Diff line change
Expand Up @@ -54,6 +54,7 @@ reference:
contents:
- summary.logitr
- coef.logitr
- getCoefTable
- statusCodes
- title: "Computing and Comparing WTP"
desc: "Functions for computing and comparing WTP from estimated models."
Expand Down
26 changes: 16 additions & 10 deletions inst/example/simulations.R
Original file line number Diff line number Diff line change
Expand Up @@ -49,16 +49,6 @@ sim_mxl_pref
sim_mxl_wtp <- simulateShares(mxl_wtp, alts, priceName = 'price')
sim_mxl_wtp

# Plot simulation results from preference space MNL model:
library(ggplot2)
sim_mnl_pref$alt <- row.names(sim_mnl_pref)
ggplot(sim_mnl_pref, aes(x = alt, y = share_mean)) +
geom_bar(stat = 'identity', width = 0.7, fill = "dodgerblue") +
geom_errorbar(aes(ymin = share_low, ymax = share_high), width = 0.2) +
scale_y_continuous(limits = c(0, 1)) +
labs(x = 'Alternative', y = 'Expected Share') +
theme_bw()

# Save results
saveRDS(sim_mnl_pref,
here::here('inst', 'extdata', 'sim_mnl_pref.Rds'))
Expand All @@ -68,3 +58,19 @@ saveRDS(sim_mxl_pref,
here::here('inst', 'extdata', 'sim_mxl_pref.Rds'))
saveRDS(sim_mxl_wtp,
here::here('inst', 'extdata', 'sim_mxl_wtp.Rds'))

# Plot simulation results from each model:
library(ggplot2)

sims <- rbind(sim_mnl_pref, sim_mnl_wtp, sim_mxl_pref, sim_mxl_wtp)
sims$model <- c(rep("mnl_pref", 4), rep("mnl_wtp", 4),
rep("mxl_pref", 4), rep("mxl_wtp", 4))
sims$alt <- rep(row.names(alts), 4)

ggplot(sims, aes(x = alt, y = share_mean, fill = model)) +
geom_bar(stat = 'identity', width = 0.7, position = "dodge") +
geom_errorbar(aes(ymin = share_low, ymax = share_high),
width = 0.2, position = position_dodge(width = 0.7)) +
scale_y_continuous(limits = c(0, 1)) +
labs(x = 'Alternative', y = 'Expected Share') +
theme_bw()
Binary file modified inst/extdata/sim_mnl_pref.Rds
Binary file not shown.
Binary file modified inst/extdata/sim_mnl_wtp.Rds
Binary file not shown.
Binary file modified inst/extdata/sim_mxl_pref.Rds
Binary file not shown.
Binary file modified inst/extdata/sim_mxl_wtp.Rds
Binary file not shown.
File renamed without changes.
File renamed without changes
10 changes: 1 addition & 9 deletions next_release.md
Original file line number Diff line number Diff line change
@@ -1,14 +1,6 @@
# logitr 0.0.5
# logitr 0.0.6

## Summary of larger updates:

- Added support for creating interactions amongst variables

## Summary of smaller updates:

- Added new documentation for prepping data:
- overall structure
- dummyCode() function
- handling interactions
- All vignettes proof-read with lots of small changes to examples
- Added a hex sticker
Binary file added vignettes/figs/unnamed-chunk-11-1.png
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
4 changes: 2 additions & 2 deletions vignettes/mnl_models_weighted.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -158,7 +158,7 @@ summary(mnl_wtp_weighted)

# Compare results

Here is a comparison of the coefficients between the weighted and unweighted models. All of the significant coefficients:
Here is a comparison of the coefficients between the weighted and unweighted models. All of the significant coefficients have the same sign, but the magnitudes shift some based on the differential weighting of each individual choice in the weighted model:

```{r}
coef_compare <- data.frame(
Expand All @@ -167,7 +167,7 @@ coef_compare <- data.frame(
coef_compare
```

Compare the log-likelihood between the weighted and unweighted models:
Here is a comparison of the log-likelihood for the weighted and unweighted models:

```{r}
logLik_compare <- c(
Expand Down
26 changes: 26 additions & 0 deletions vignettes/simulations.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@ knitr::opts_chunk$set(
collapse = TRUE,
warning = FALSE,
message = FALSE,
fig.path = "figs/",
fig.retina = 3,
comment = "#>"
)
Expand Down Expand Up @@ -60,6 +61,10 @@ You can also use WTP space models to simulate shares, but you must provide the a
```{r, eval=FALSE}
sim_mnl_wtp <- simulateShares(mnl_wtp, alts, priceName = 'price')
```
```
#> **Using results for model 1 of 10,
#> the best model (largest log-likelihood) from the multistart**
```
```{r}
sim_mnl_wtp
```
Expand All @@ -83,3 +88,24 @@ sim_mxl_wtp <- simulateShares(mxl_wtp, alts, priceName = 'price')
```{r}
sim_mxl_wtp
```

Here is a bar plot of the results from each model:

```{r, fig.width=6, fig.height=4}
library(ggplot2)
sims <- rbind(sim_mnl_pref, sim_mnl_wtp, sim_mxl_pref, sim_mxl_wtp)
sims$model <- c(rep("mnl_pref", 4), rep("mnl_wtp", 4),
rep("mxl_pref", 4), rep("mxl_wtp", 4))
sims$alt <- rep(row.names(alts), 4)
ggplot(sims, aes(x = alt, y = share_mean, fill = model)) +
geom_bar(stat = 'identity', width = 0.7, position = "dodge") +
geom_errorbar(aes(ymin = share_low, ymax = share_high),
width = 0.2, position = position_dodge(width = 0.7)) +
scale_y_continuous(limits = c(0, 1)) +
labs(x = 'Alternative', y = 'Expected Share') +
theme_bw()
```

# References

0 comments on commit e42828d

Please sign in to comment.