Skip to content

Commit 44f571b

Browse files
author
Nicholas Clark
committed
reduce final vignettes for resubmission
1 parent d4a6f3d commit 44f571b

14 files changed

+924
-915
lines changed

‎R/add_nmixture.R

+1-1
Original file line numberDiff line numberDiff line change
@@ -705,7 +705,7 @@ add_nmix_posterior = function(model_output,
705705
function(x) paste0('lv_coefs[',
706706
x[1], ',',
707707
x[2], ']'))
708-
lv_coef_samps <- as.matrix(replicate(NROW(ps), as.vector(t(Z))))
708+
lv_coef_samps <- t(as.matrix(replicate(NROW(ps), as.vector(t(Z)))))
709709
model_output <- add_samples(model_output = model_output,
710710
names = lv_coef_names,
711711
samples = lv_coef_samps,

‎inst/doc/data_in_mvgam.R

+76-39
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
## ----echo = FALSE-------------------------------------------------------------
1+
## ----echo = FALSE------------------------------------------------------
22
NOT_CRAN <- identical(tolower(Sys.getenv("NOT_CRAN")), "true")
33
knitr::opts_chunk$set(
44
collapse = TRUE,
@@ -7,10 +7,11 @@ knitr::opts_chunk$set(
77
eval = NOT_CRAN
88
)
99

10-
## ----setup, include=FALSE-----------------------------------------------------
10+
11+
## ----setup, include=FALSE----------------------------------------------
1112
knitr::opts_chunk$set(
1213
echo = TRUE,
13-
dpi = 150,
14+
dpi = 100,
1415
fig.asp = 0.8,
1516
fig.width = 6,
1617
out.width = "60%",
@@ -19,45 +20,54 @@ library(mvgam)
1920
library(ggplot2)
2021
theme_set(theme_bw(base_size = 12, base_family = 'serif'))
2122

22-
## -----------------------------------------------------------------------------
23+
24+
## ----------------------------------------------------------------------
2325
simdat <- sim_mvgam(n_series = 4, T = 24, prop_missing = 0.2)
2426
head(simdat$data_train, 16)
2527

26-
## -----------------------------------------------------------------------------
28+
29+
## ----------------------------------------------------------------------
2730
class(simdat$data_train$series)
2831
levels(simdat$data_train$series)
2932

30-
## -----------------------------------------------------------------------------
33+
34+
## ----------------------------------------------------------------------
3135
all(levels(simdat$data_train$series) %in% unique(simdat$data_train$series))
3236

33-
## -----------------------------------------------------------------------------
37+
38+
## ----------------------------------------------------------------------
3439
summary(glm(y ~ series + time,
3540
data = simdat$data_train,
3641
family = poisson()))
3742

38-
## -----------------------------------------------------------------------------
43+
44+
## ----------------------------------------------------------------------
3945
summary(gam(y ~ series + s(time, by = series),
4046
data = simdat$data_train,
4147
family = poisson()))
4248

43-
## -----------------------------------------------------------------------------
49+
50+
## ----------------------------------------------------------------------
4451
gauss_dat <- data.frame(outcome = rnorm(10),
4552
series = factor('series1',
4653
levels = 'series1'),
4754
time = 1:10)
4855
gauss_dat
4956

50-
## -----------------------------------------------------------------------------
57+
58+
## ----------------------------------------------------------------------
5159
gam(outcome ~ time,
5260
family = betar(),
5361
data = gauss_dat)
5462

55-
## ----error=TRUE---------------------------------------------------------------
63+
64+
## ----error=TRUE--------------------------------------------------------
5665
mvgam(outcome ~ time,
5766
family = betar(),
5867
data = gauss_dat)
5968

60-
## -----------------------------------------------------------------------------
69+
70+
## ----------------------------------------------------------------------
6171
# A function to ensure all timepoints within a sequence are identical
6272
all_times_avail = function(time, min_time, max_time){
6373
identical(as.numeric(sort(time)),
@@ -81,18 +91,21 @@ if(any(checked_times$all_there == FALSE)){
8191
cat('All series have observations at all timepoints :)')
8292
}
8393

84-
## -----------------------------------------------------------------------------
94+
95+
## ----------------------------------------------------------------------
8596
bad_times <- data.frame(time = seq(1, 16, by = 2),
8697
series = factor('series_1'),
8798
outcome = rnorm(8))
8899
bad_times
89100

90-
## ----error = TRUE-------------------------------------------------------------
101+
102+
## ----error = TRUE------------------------------------------------------
91103
get_mvgam_priors(outcome ~ 1,
92104
data = bad_times,
93105
family = gaussian())
94106

95-
## -----------------------------------------------------------------------------
107+
108+
## ----------------------------------------------------------------------
96109
bad_times %>%
97110
dplyr::right_join(expand.grid(time = seq(min(bad_times$time),
98111
max(bad_times$time)),
@@ -101,12 +114,14 @@ bad_times %>%
101114
dplyr::arrange(time) -> good_times
102115
good_times
103116

104-
## ----error = TRUE-------------------------------------------------------------
117+
118+
## ----error = TRUE------------------------------------------------------
105119
get_mvgam_priors(outcome ~ 1,
106120
data = good_times,
107121
family = gaussian())
108122

109-
## -----------------------------------------------------------------------------
123+
124+
## ----------------------------------------------------------------------
110125
bad_levels <- data.frame(time = 1:8,
111126
series = factor('series_1',
112127
levels = c('series_1',
@@ -115,85 +130,100 @@ bad_levels <- data.frame(time = 1:8,
115130

116131
levels(bad_levels$series)
117132

118-
## ----error = TRUE-------------------------------------------------------------
133+
134+
## ----error = TRUE------------------------------------------------------
119135
get_mvgam_priors(outcome ~ 1,
120136
data = bad_levels,
121137
family = gaussian())
122138

123-
## -----------------------------------------------------------------------------
139+
140+
## ----------------------------------------------------------------------
124141
setdiff(levels(bad_levels$series), unique(bad_levels$series))
125142

126-
## -----------------------------------------------------------------------------
143+
144+
## ----------------------------------------------------------------------
127145
bad_levels %>%
128146
dplyr::mutate(series = droplevels(series)) -> good_levels
129147
levels(good_levels$series)
130148

131-
## ----error = TRUE-------------------------------------------------------------
149+
150+
## ----error = TRUE------------------------------------------------------
132151
get_mvgam_priors(outcome ~ 1,
133152
data = good_levels,
134153
family = gaussian())
135154

136-
## -----------------------------------------------------------------------------
155+
156+
## ----------------------------------------------------------------------
137157
miss_dat <- data.frame(outcome = rnorm(10),
138158
cov = c(NA, rnorm(9)),
139159
series = factor('series1',
140160
levels = 'series1'),
141161
time = 1:10)
142162
miss_dat
143163

144-
## ----error = TRUE-------------------------------------------------------------
164+
165+
## ----error = TRUE------------------------------------------------------
145166
get_mvgam_priors(outcome ~ cov,
146167
data = miss_dat,
147168
family = gaussian())
148169

149-
## -----------------------------------------------------------------------------
170+
171+
## ----------------------------------------------------------------------
150172
miss_dat <- list(outcome = rnorm(10),
151173
series = factor('series1',
152174
levels = 'series1'),
153175
time = 1:10)
154176
miss_dat$cov <- matrix(rnorm(50), ncol = 5, nrow = 10)
155177
miss_dat$cov[2,3] <- NA
156178

157-
## ----error=TRUE---------------------------------------------------------------
179+
180+
## ----error=TRUE--------------------------------------------------------
158181
get_mvgam_priors(outcome ~ cov,
159182
data = miss_dat,
160183
family = gaussian())
161184

162-
## ----fig.alt = "Plotting time series features for GAM models in mvgam"--------
185+
186+
## ----fig.alt = "Plotting time series features for GAM models in mvgam"----
163187
plot_mvgam_series(data = simdat$data_train,
164188
y = 'y',
165189
series = 'all')
166190

167-
## ----fig.alt = "Plotting time series features for GAM models in mvgam"--------
191+
192+
## ----fig.alt = "Plotting time series features for GAM models in mvgam"----
168193
plot_mvgam_series(data = simdat$data_train,
169194
y = 'y',
170195
series = 1)
171196

172-
## ----fig.alt = "Plotting time series features for GAM models in mvgam"--------
197+
198+
## ----fig.alt = "Plotting time series features for GAM models in mvgam"----
173199
plot_mvgam_series(data = simdat$data_train,
174200
newdata = simdat$data_test,
175201
y = 'y',
176202
series = 1)
177203

178-
## -----------------------------------------------------------------------------
204+
205+
## ----------------------------------------------------------------------
179206
data("all_neon_tick_data")
180207
str(dplyr::ungroup(all_neon_tick_data))
181208

182-
## -----------------------------------------------------------------------------
209+
210+
## ----------------------------------------------------------------------
183211
plotIDs <- c('SCBI_013','SCBI_002',
184212
'SERC_001','SERC_005',
185213
'SERC_006','SERC_012',
186214
'BLAN_012','BLAN_005')
187215

188-
## -----------------------------------------------------------------------------
216+
217+
## ----------------------------------------------------------------------
189218
model_dat <- all_neon_tick_data %>%
190219
dplyr::ungroup() %>%
191220
dplyr::mutate(target = ixodes_scapularis) %>%
192221
dplyr::filter(plotID %in% plotIDs) %>%
193222
dplyr::select(Year, epiWeek, plotID, target) %>%
194223
dplyr::mutate(epiWeek = as.numeric(epiWeek))
195224

196-
## -----------------------------------------------------------------------------
225+
226+
## ----------------------------------------------------------------------
197227
model_dat %>%
198228
# Create all possible combos of plotID, Year and epiWeek;
199229
# missing outcomes will be filled in as NA
@@ -207,7 +237,8 @@ model_dat %>%
207237
dplyr::select(siteID, plotID) %>%
208238
dplyr::distinct()) -> model_dat
209239

210-
## -----------------------------------------------------------------------------
240+
241+
## ----------------------------------------------------------------------
211242
model_dat %>%
212243
dplyr::mutate(series = plotID,
213244
y = target) %>%
@@ -216,33 +247,39 @@ model_dat %>%
216247
dplyr::select(-target, -plotID) %>%
217248
dplyr::arrange(Year, epiWeek, series) -> model_dat
218249

219-
## -----------------------------------------------------------------------------
250+
251+
## ----------------------------------------------------------------------
220252
model_dat %>%
221253
dplyr::ungroup() %>%
222254
dplyr::group_by(series) %>%
223255
dplyr::arrange(Year, epiWeek) %>%
224256
dplyr::mutate(time = seq(1, dplyr::n())) %>%
225257
dplyr::ungroup() -> model_dat
226258

227-
## -----------------------------------------------------------------------------
259+
260+
## ----------------------------------------------------------------------
228261
levels(model_dat$series)
229262

230-
## ----error=TRUE---------------------------------------------------------------
263+
264+
## ----error=TRUE--------------------------------------------------------
231265
get_mvgam_priors(y ~ 1,
232266
data = model_dat,
233267
family = poisson())
234268

235-
## -----------------------------------------------------------------------------
269+
270+
## ----------------------------------------------------------------------
236271
testmod <- mvgam(y ~ s(epiWeek, by = series, bs = 'cc') +
237272
s(series, bs = 're'),
238273
trend_model = 'AR1',
239274
data = model_dat,
240275
backend = 'cmdstanr',
241276
run_model = FALSE)
242277

243-
## -----------------------------------------------------------------------------
278+
279+
## ----------------------------------------------------------------------
244280
str(testmod$model_data)
245281

246-
## -----------------------------------------------------------------------------
282+
283+
## ----------------------------------------------------------------------
247284
code(testmod)
248285

‎inst/doc/data_in_mvgam.Rmd

+1-1
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,7 @@ knitr::opts_chunk$set(
2424
```{r setup, include=FALSE}
2525
knitr::opts_chunk$set(
2626
echo = TRUE,
27-
dpi = 150,
27+
dpi = 100,
2828
fig.asp = 0.8,
2929
fig.width = 6,
3030
out.width = "60%",

0 commit comments

Comments
 (0)