Merge pull request #103 from RSGInc/63-vignette-trip-rates-by-interes…

…ting-factors

63 vignette trip rates by interesting factors

data-raw/create_test_data.R

@@ -73,6 +73,7 @@ keep_cols = c(
   'gender',
   'employment',
   'education',
+  'job_type',
 
   # Day variables:
   'day_id',

vignettes/trip_rates.Rmd

@@ -0,0 +1,129 @@
+---
+title: "Creating summaries of trip rates"
+description: >
+output: html_vignette
+vignette: >
+  %\VignetteIndexEntry{Creating summaries of trip rates}
+  %\VignetteEngine{knitr::rmarkdown}
+  %\VignetteEncoding{UTF-8}
+---
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(echo = TRUE, message = FALSE)
+
+```
+
+To calculate trip rates we first need to prepare the data. We can do this using `hts_prep_triprate`
+
+```{r, prep_triprate, echo=TRUE}
+
+library(travelSurveyTools)
+
+data("test_data")
+data("variable_list")
+data("value_labels")
+
+DT = hts_prep_triprate(variables_dt = variable_list,
+                   trip_name = 'trip',
+                   day_name = 'day',
+                   hts_data = test_data)
+
+```
+
+
+After preparing the data we can create a summary using `hts_summary`.
+
+```{r, hts_summary, echo=TRUE}
+
+hts_summary(
+  prepped_dt = DT$num,
+  summarize_var = 'num_trips_wtd',
+  summarize_vartype = 'numeric'
+)
+
+
+```
+
+We can also summarize trip rates by one or more variables. 
+
+```{r, trip_rate_job_type, echo=TRUE, fig.width=8, fig.height=6, warning=FALSE}
+
+DT = hts_prep_triprate(variables_dt = variable_list,
+                       summarize_by = 'job_type',
+                   trip_name = 'trip',
+                   day_name = 'day',
+                   hts_data = test_data)
+
+num_trips_job_type = hts_summary(
+  prepped_dt = DT$num,
+  summarize_by = 'job_type',
+  summarize_var = 'num_trips_wtd',
+  summarize_vartype = 'numeric',
+  wtname = 'day_weight',
+  weighted = TRUE
+)$summary$wtd
+
+library(ggplot2)
+
+# Label job_type
+num_trips_job_type_labeled = factorize_df(num_trips_job_type,
+                                            value_labels,
+                                            value_label_colname = 'label')
+
+
+# Create a plot
+ggplot(num_trips_job_type_labeled, 
+       aes(x = median, y = job_type)) + 
+  geom_bar(stat = 'identity') +
+  scale_y_discrete(labels = function(x) stringr::str_wrap(x, width = 50),
+                   limits = rev) + 
+  labs(x = 'Median number of trips',
+       y = 'Job Type')
+
+```
+
+
+```{r, trip_rate_race_ethnicity, fig.width=8, fig.height=6, warning=FALSE}
+
+DT = hts_prep_triprate(variables_dt = variable_list,
+                       summarize_by = c('race', 'ethnicity'),
+                   trip_name = 'trip',
+                   day_name = 'day',
+                   hts_data = test_data)
+
+num_trips_race_ethnicity = hts_summary(
+  prepped_dt = DT$num,
+  summarize_by = c('race', 'ethnicity'),
+  summarize_var = 'num_trips_wtd',
+  summarize_vartype = 'numeric',
+  wtname = 'day_weight',
+  weighted = TRUE,
+  se = TRUE
+)$summary$wtd
+
+# label data
+num_trips_race_ethnicity_labeled = factorize_df(num_trips_race_ethnicity,
+                                            value_labels,
+                                            value_label_colname = 'label')
+
+# Create a plot
+ggplot(num_trips_race_ethnicity_labeled, 
+       aes(x = mean, y = race, fill = ethnicity)) +
+  scale_y_discrete(labels = function(x) stringr::str_wrap(x, width = 30),
+                   limits = rev) + 
+  geom_bar(stat = 'identity', position = position_dodge2(preserve = 'single', width = 0)) + 
+  geom_errorbar(
+    aes(xmin = (mean - mean_se), 
+        xmax = (mean + mean_se)),
+    position = position_dodge2(preserve = 'single', width = 0)
+  ) +
+  labs(x = 'Mean number of trips',
+       y = 'Race',
+       fill = 'Ethnicity') 
+
+
+
+```
+
+
+