Skip to content

Commit bf48868

Browse files
james-clark-rsgjames-clark-rsg
authored
Merge pull request #161 from RSGInc/bug_fixes_06_2024
Bug fixes 06 2024
2 parents 1f3ff6b + 360131c commit bf48868

282 files changed

Lines changed: 1175 additions & 902 deletions

File tree

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

‎.gitignore‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@
55
# Session Data files
66
.RData
77
.RDataTmp
8-
.Rproj
8+
*.Rproj
99

1010
# User-specific files
1111
.Ruserdata

‎DESCRIPTION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
Package: travelSurveyTools
22
Title: travelSurveyTools
3-
Version: 2.4.2
3+
Version: 2.4.3
44
Authors@R: c(
55
person("RSG", "Inc.", , "rsg@rsginc.com", role = c("aut", "cre")),
66
person("Ashley", "Asmus", , "ashley.asmus@rsginc.com", role = "aut"),

‎NEWS.md‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,9 @@
1+
# travelSurveyTools 2.4.3
2+
3+
- Resolve bugs and updated function syntax in `hts_prep_triprate` and `hts_prep_variable`
4+
- Updated `remove_outliers` parameter to default to FALSE in `hts_prep_triprate`
5+
- Added a warning message in `hts_remove_outliers`
6+
17
# travelSurveyTools 2.4.2
28

39
- Add summarize_var and summarize_by to output. Select weight automatically in `hts_summary_wrapper`

‎R/hts_prep_triprate.R‎

Lines changed: 131 additions & 125 deletions
Original file line numberDiff line numberDiff line change
@@ -55,10 +55,16 @@ hts_prep_triprate = function(summarize_by = NULL,
5555
day_name = "day",
5656
ids = c("hh_id", "person_id", "day_id", "trip_id", "vehicle_id"),
5757
wts = c("hh_weight", "person_weight", "day_weight", "trip_weight", "hh_weight"),
58-
remove_outliers = TRUE,
58+
remove_outliers = FALSE,
5959
threshold = 0.975,
6060
weighted = TRUE,
61-
hts_data) {
61+
hts_data = list(
62+
"hh" = hh,
63+
"person" = person,
64+
"day" = day,
65+
"trip" = trip,
66+
"vehicle" = vehicle)) {
67+
6268
# Check variable_list first
6369
variables_dt = hts_validate_variable_list(variables_dt, hts_data)
6470

@@ -135,151 +141,151 @@ hts_prep_triprate = function(summarize_by = NULL,
135141
shared_name %in% summarize_by &
136142
get(day_name) == 1 &
137143
get(trip_name) == 1, shared_name]
138-
139-
if (length(day_trip_vars) > 0) {
140-
141-
setnames(variables_dt, trip_name, 'trip_table')
142-
143-
variables_dt[shared_name %in% day_trip_vars, trip_table := 0]
144-
145-
setnames(variables_dt, 'trip_table', trip_name)
146-
147-
}
148-
149-
if (length(summarize_by) > 0) {
150-
byvar_dt = hts_prep_byvar(summarize_by,
151-
variables_dt = variables_dt,
152-
hts_data = hts_data,
153-
byvar_ids = ids,
154-
byvar_wts = wts
155-
)
156-
157-
merge_cols = names(byvar_dt)[names(byvar_dt) %in% names(trip_control)]
158144

159-
triprate_dt = merge(trip_control, byvar_dt, by = merge_cols, all.x = TRUE)
160-
161-
triprate_cols = intersect(names(triprate_dt), c(ids, wts))
162-
163-
triprate_cols = triprate_cols[!triprate_cols %in% c(trip_id, trip_wt)]
164-
165-
triprate_cols_all = c(triprate_cols, summarize_by)
166-
167-
if (weighted) {
168-
triprate_dt = triprate_dt[, .(num_trips = sum(get(trip_wt))),
169-
by = triprate_cols_all
170-
]
171-
}
172-
173-
if (!weighted) {
174-
triprate_dt = triprate_dt[, .(num_trips = sum(!is.na(get(trip_id)))),
175-
by = triprate_cols_all
176-
]
145+
if (length(day_trip_vars) > 0) {
146+
147+
setnames(variables_dt, trip_name, 'trip_table')
148+
149+
variables_dt[shared_name %in% day_trip_vars, trip_table := 0]
150+
151+
setnames(variables_dt, 'trip_table', trip_name)
152+
177153
}
178154

179-
# fill in with zeros for zero trips on a given day:
180-
triprate_dt[, `:=`(
181-
num_trips = nafill(num_trips, fill = 0)
182-
)]
183-
184-
# If one of the by-variables is in trip table, need to expand to
185-
# include all levels of the variable for every trip, and fill with zeros:
186-
if (trip_id %in% names(byvar_dt)) {
187-
# fill in with zeros for zero trips for a given level of xt_var using dcast:
188-
dcast_formula =
189-
paste0(
190-
paste0(triprate_cols, collapse = " + "),
191-
" ~ ",
192-
paste0(summarize_by, collapse = " + ")
193-
)
194-
195-
triprate_cast = dcast(triprate_dt,
196-
dcast_formula,
197-
value.var = "num_trips",
198-
fill = 0
155+
if (length(summarize_by) > 0) {
156+
byvar_dt = hts_prep_byvar(summarize_by,
157+
variables_dt = variables_dt,
158+
hts_data = hts_data,
159+
byvar_ids = ids,
160+
byvar_wts = wts
199161
)
200162

201-
# Remove columns where NA levels of factors were generated during dcast:
202-
na_filled_cols = names(triprate_cast)[names(triprate_cast) %like% "_NA"]
163+
merge_cols = names(byvar_dt)[names(byvar_dt) %in% names(trip_control)]
203164

204-
if (length(na_filled_cols) > 0) {
205-
triprate_cast[, c(na_filled_cols) := NULL]
206-
}
165+
triprate_dt = merge(trip_control, byvar_dt, by = merge_cols, all.x = TRUE)
207166

208-
# transform back to long format, with separate cols for weighted & unwt. trip rates:
209-
triprate_dt = data.table::melt(
210-
triprate_cast,
211-
id.vars = triprate_cols,
212-
value.name = "num_trips"
213-
)
167+
triprate_cols = intersect(names(triprate_dt), c(ids, wts))
168+
169+
triprate_cols = triprate_cols[!triprate_cols %in% c(trip_id, trip_wt)]
170+
171+
triprate_cols_all = c(triprate_cols, summarize_by)
214172

215-
# Relabel xtab trip vars after melting:
216-
if (length(summarize_by) > 1) {
217-
triprate_dt[, c(summarize_by) := tstrsplit(variable, "_")]
218-
triprate_dt[, variable := NULL]
173+
if (weighted) {
174+
triprate_dt = triprate_dt[, .(num_trips = sum(get(trip_wt))),
175+
by = triprate_cols_all
176+
]
219177
}
220178

221-
if (length(summarize_by) == 1) {
222-
setnames(triprate_dt, old = "variable", new = summarize_by)
179+
if (!weighted) {
180+
triprate_dt = triprate_dt[, .(num_trips = sum(!is.na(get(..trip_id)))),
181+
by = triprate_cols_all
182+
]
223183
}
224184

225-
triprate_dt = triprate_dt[]
185+
# fill in with zeros for zero trips on a given day:
186+
triprate_dt[, `:=`(
187+
num_trips = nafill(num_trips, fill = 0)
188+
)]
189+
190+
# If one of the by-variables is in trip table, need to expand to
191+
# include all levels of the variable for every trip, and fill with zeros:
192+
if (trip_id %in% names(byvar_dt)) {
193+
# fill in with zeros for zero trips for a given level of xt_var using dcast:
194+
dcast_formula =
195+
paste0(
196+
paste0(triprate_cols, collapse = " + "),
197+
" ~ ",
198+
paste0(summarize_by, collapse = " + ")
199+
)
200+
201+
triprate_cast = dcast(triprate_dt,
202+
dcast_formula,
203+
value.var = "num_trips",
204+
fill = 0
205+
)
206+
207+
# Remove columns where NA levels of factors were generated during dcast:
208+
na_filled_cols = names(triprate_cast)[names(triprate_cast) %like% "_NA" | names(triprate_cast) == "NA"]
209+
210+
if (length(na_filled_cols) > 0) {
211+
triprate_cast[, c(na_filled_cols) := NULL]
212+
}
213+
214+
# transform back to long format, with separate cols for weighted & unwt. trip rates:
215+
triprate_dt = data.table::melt(
216+
triprate_cast,
217+
id.vars = triprate_cols,
218+
value.name = "num_trips"
219+
)
220+
221+
# Relabel xtab trip vars after melting:
222+
if (length(summarize_by) > 1) {
223+
triprate_dt[, c(summarize_by) := tstrsplit(variable, "_")]
224+
triprate_dt[, variable := NULL]
225+
}
226+
227+
if (length(summarize_by) == 1) {
228+
setnames(triprate_dt, old = "variable", new = summarize_by)
229+
}
230+
231+
triprate_dt = triprate_dt[]
232+
}
233+
234+
if (weighted) {
235+
# calculate trip rate
236+
triprate_dt[, trip_rate :=
237+
ifelse(num_trips == 0, 0, num_trips / get(day_wt))]
238+
239+
# Save counts of trips under a different name
240+
setnames(triprate_dt, "num_trips", "trip_count_wtd")
241+
242+
setnames(triprate_dt, "trip_rate", "num_trips")
243+
}
226244
}
227245

228-
if (weighted) {
229-
# calculate trip rate
230-
triprate_dt[, trip_rate :=
231-
ifelse(num_trips == 0, 0, num_trips / get(day_wt))]
246+
# remove outliers
247+
if (remove_outliers) {
248+
out = hts_remove_outliers(triprate_dt,
249+
numvar = "num_trips",
250+
threshold = threshold
251+
)
232252

233-
# Save counts of trips under a different name
234-
setnames(triprate_dt, "num_trips", "trip_count_wtd")
253+
triprate_dt = out[["dt"]]
235254

236-
setnames(triprate_dt, "trip_rate", "num_trips")
255+
outlier_table = out[["outlier_description"]]
237256
}
238-
}
239-
240-
# remove outliers
241-
if (remove_outliers) {
242-
out = hts_remove_outliers(triprate_dt,
243-
numvar = "num_trips",
244-
threshold = threshold
245-
)
246257

247-
triprate_dt = out[["dt"]]
258+
# Bin trips:
259+
triprate_binned = hts_bin_var(
260+
prepped_dt = triprate_dt,
261+
numvar = "num_trips",
262+
nbins = 7
263+
)
248264

249-
outlier_table = out[["outlier_description"]]
250-
}
251-
252-
# Bin trips:
253-
triprate_binned = hts_bin_var(
254-
prepped_dt = triprate_dt,
255-
numvar = "num_trips",
256-
nbins = 7
257-
)
258-
259-
if (weighted) {
260-
setnames(triprate_dt, "num_trips", "num_trips_wtd", skip_absent = TRUE)
261-
setnames(triprate_binned, "num_trips", "num_trips_wtd", skip_absent = TRUE)
262-
} else {
263-
setnames(triprate_dt, "num_trips", "num_trips_unwtd", skip_absent = TRUE)
264-
setnames(triprate_binned, "num_trips", "num_trips_unwtd", skip_absent = TRUE)
265-
}
266-
prepped_dt_ls = list(
267-
"num" = triprate_dt,
268-
"cat" = triprate_binned
269-
)
270-
271-
# Append outliers:
272-
if (remove_outliers) {
265+
if (weighted) {
266+
setnames(triprate_dt, "num_trips", "num_trips_wtd", skip_absent = TRUE)
267+
setnames(triprate_binned, "num_trips", "num_trips_wtd", skip_absent = TRUE)
268+
} else {
269+
setnames(triprate_dt, "num_trips", "num_trips_unwtd", skip_absent = TRUE)
270+
setnames(triprate_binned, "num_trips", "num_trips_unwtd", skip_absent = TRUE)
271+
}
273272
prepped_dt_ls = list(
274-
"cat" = triprate_binned,
275273
"num" = triprate_dt,
276-
"outliers" = outlier_table
274+
"cat" = triprate_binned
277275
)
278-
}
279-
280-
281-
return(prepped_dt_ls)
276+
277+
# Append outliers:
278+
if (remove_outliers) {
279+
prepped_dt_ls = list(
280+
"cat" = triprate_binned,
281+
"num" = triprate_dt,
282+
"outliers" = outlier_table
283+
)
284+
}
285+
286+
287+
return(prepped_dt_ls)
282288
}
283289

284290
## quiets concerns of R CMD check
285-
utils::globalVariables(c("trip_weight", "num_trips", "trip_rate", "day_weight", "trip_table"))
291+
utils::globalVariables(c("..trip_id","trip_weight", "num_trips", "trip_rate", "day_weight", "trip_table"))

0 commit comments

Comments
 (0)