Skip to content

Commit 697c835

Browse files
author
Nicholas Clark
committed
add tests for shared obs params; add codecov secret directly to yaml
1 parent 50d6551 commit 697c835

File tree

8 files changed

+123
-4
lines changed

8 files changed

+123
-4
lines changed

‎.github/workflows/test-coverage.yaml

+1
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@ jobs:
1313
runs-on: ubuntu-latest
1414
env:
1515
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
16+
CODECOV_TOKEN: ${{ secrets.CODECOV_TOKEN }}
1617

1718
steps:
1819
- uses: actions/checkout@v2

‎R/dynamic.R

+2-2
Original file line numberDiff line numberDiff line change
@@ -55,8 +55,8 @@
5555
#' V = Sigma)
5656
#'}
5757
#'
58-
#'beta <- sim_gp(alpha_gp = 0.75,
59-
#' rho_gp = 10,
58+
#'beta <- sim_gp(alpha = 0.75,
59+
#' rho = 10,
6060
#' c = 0.5,
6161
#' N = N)
6262
#'plot(beta, type = 'l', lwd = 3,

‎R/lv_correlations.R

+13-1
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,19 @@
55
#'
66
#'@importFrom stats cov2cor cov
77
#'@param object \code{list} object returned from \code{mvgam}
8-
#'@return A \code{list} object containing the mean posterior correlations and the full array of posterior correlations
8+
#'@return A \code{list} object containing the mean posterior correlations
9+
#'and the full array of posterior correlations
10+
#'@examples
11+
#'\donttest{
12+
#'simdat <- sim_mvgam()
13+
#'mod <- mvgam(y ~ s(season, bs = 'cc',
14+
#' k = 6),
15+
#' trend_model = AR(),
16+
#' data = simdat$data_train)
17+
#'lvcors <- lv_correlations(mod)
18+
#'names(lvcors)
19+
#'lapply(lvcors, class)
20+
#'}
921
#'@export
1022
lv_correlations = function(object){
1123

‎R/plot_mvgam_factors.R

+11-1
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,17 @@
1313
#'calculating the sum of the factor's 2nd derivatives. A factor that has a larger contribution will have a larger
1414
#'sum due to the weaker penalty on the factor's precision. If
1515
#'\code{plot == TRUE}, the factors are also plotted.
16-
#'@return A \code{dataframe} of factor contributions and, optionally, a series of base \code{R} plots
16+
#'@return A \code{dataframe} of factor contributions and,
17+
#'optionally, a series of base \code{R} plots
18+
#'@examples
19+
#'\donttest{
20+
#'simdat <- sim_mvgam()
21+
#'mod <- mvgam(y ~ s(season, bs = 'cc',
22+
#' k = 6),
23+
#' trend_model = AR(),
24+
#' data = simdat$data_train)
25+
#'plot_mvgam_factors(mod)
26+
#'}
1727
#'@export
1828
plot_mvgam_factors = function(object, plot = TRUE){
1929

‎R/shared_obs_params.R

+11
Original file line numberDiff line numberDiff line change
@@ -92,6 +92,13 @@ shared_obs_params = function(model_file, family){
9292
fixed = TRUE)] <-
9393
"(1 - inv_logit(flat_xs * b)) .* phi);"
9494

95+
model_file[grep("inv_logit(append_col(flat_xs, flat_trends) * append_row(b, 1.0)) .* flat_phis," , model_file,
96+
fixed = TRUE)] <-
97+
"inv_logit(append_col(flat_xs, flat_trends) * append_row(b, 1.0)) .* phi,"
98+
model_file[grep("(1 - inv_logit(append_col(flat_xs, flat_trends) * append_row(b, 1.0))) .* flat_phis);" , model_file,
99+
fixed = TRUE)] <-
100+
"(1 - inv_logit(append_col(flat_xs, flat_trends) * append_row(b, 1.0))) .* phi);"
101+
95102
model_file[grep("phi_vec[1:n,s] = rep_vector(phi[s], n);" , model_file,
96103
fixed = TRUE)] <-
97104
"phi_vec[1:n,s] = rep_vector(phi, n);"
@@ -111,6 +118,10 @@ shared_obs_params = function(model_file, family){
111118
fixed = TRUE)] <-
112119
"shape, shape ./ exp(flat_xs * b));"
113120

121+
model_file[grep("flat_shapes, flat_shapes ./ exp(append_col(flat_xs, flat_trends) * append_row(b, 1.0)));" , model_file,
122+
fixed = TRUE)] <-
123+
"shape, shape ./ exp(append_col(flat_xs, flat_trends) * append_row(b, 1.0)));"
124+
114125
model_file[grep("shape_vec[1:n,s] = rep_vector(shape[s], n);", model_file,
115126
fixed = TRUE)] <-
116127
"shape_vec[1:n,s] = rep_vector(shape, n);"

‎src/mvgam.dll

0 Bytes
Binary file not shown.

‎tests/testthat/Rplots.pdf

-53 Bytes
Binary file not shown.

‎tests/testthat/test-mvgam.R

+85
Original file line numberDiff line numberDiff line change
@@ -155,6 +155,91 @@ test_that("series levels must match unique entries in series", {
155155
run_model = FALSE))
156156
})
157157

158+
test_that("share_obs_params working", {
159+
# Standard beta
160+
mod <- mvgam(y ~ s(season, by = series),
161+
trend_model = RW(cor = TRUE),
162+
family = betar(),
163+
data = beta_data$data_train,
164+
share_obs_params = TRUE,
165+
run_model = FALSE)
166+
expect_true(inherits(mod, 'mvgam_prefit'))
167+
expect_true(any(grepl('real<lower=0>phi;',
168+
gsub(' ', '', mod$model_file), fixed = TRUE)))
169+
expect_true(any(grepl('phi_vec[1:n,s]=rep_vector(phi,n);',
170+
gsub(' ', '', mod$model_file), fixed = TRUE)))
171+
172+
# State-space beta
173+
mod <- mvgam(y ~ -1,
174+
trend_formula = ~ s(season, by = trend),
175+
trend_model = RW(cor = TRUE),
176+
family = betar(),
177+
data = beta_data$data_train,
178+
share_obs_params = TRUE,
179+
run_model = FALSE)
180+
expect_true(inherits(mod, 'mvgam_prefit'))
181+
expect_true(any(grepl('real<lower=0>phi;',
182+
gsub(' ', '', mod$model_file), fixed = TRUE)))
183+
expect_true(any(grepl('phi_vec[1:n,s]=rep_vector(phi,n);',
184+
gsub(' ', '', mod$model_file), fixed = TRUE)))
185+
186+
# Standard gaussian
187+
mod <- mvgam(y ~ s(season, by = series),
188+
trend_model = RW(cor = TRUE),
189+
family = gaussian(),
190+
data = gaus_data$data_train,
191+
share_obs_params = TRUE,
192+
run_model = FALSE)
193+
expect_true(inherits(mod, 'mvgam_prefit'))
194+
expect_true(any(grepl('real<lower=0>sigma_obs;',
195+
gsub(' ', '', mod$model_file), fixed = TRUE)))
196+
expect_true(any(grepl('sigma_obs_vec[1:n,s]=rep_vector(sigma_obs,n);',
197+
gsub(' ', '', mod$model_file), fixed = TRUE)))
198+
199+
# State-space gaussian
200+
mod <- mvgam(y ~ -1,
201+
trend_formula = ~ s(season, by = trend),
202+
trend_model = RW(cor = TRUE),
203+
family = gaussian(),
204+
data = gaus_data$data_train,
205+
share_obs_params = TRUE,
206+
run_model = FALSE)
207+
expect_true(inherits(mod, 'mvgam_prefit'))
208+
expect_true(any(grepl('real<lower=0>sigma_obs;',
209+
gsub(' ', '', mod$model_file), fixed = TRUE)))
210+
expect_true(any(grepl('sigma_obs_vec[1:n,s]=rep_vector(sigma_obs,n);',
211+
gsub(' ', '', mod$model_file), fixed = TRUE)))
212+
213+
214+
# Standard Gamma
215+
simdat <- sim_mvgam(family = Gamma())
216+
mod <- mvgam(y ~ s(season, by = series),
217+
trend_model = RW(cor = TRUE),
218+
family = Gamma(),
219+
data = simdat$data_train,
220+
share_obs_params = TRUE,
221+
run_model = FALSE)
222+
expect_true(inherits(mod, 'mvgam_prefit'))
223+
expect_true(any(grepl('real<lower=0>shape;',
224+
gsub(' ', '', mod$model_file), fixed = TRUE)))
225+
expect_true(any(grepl('shape_vec[1:n,s]=rep_vector(shape,n);',
226+
gsub(' ', '', mod$model_file), fixed = TRUE)))
227+
228+
# State-space Gamma
229+
mod <- mvgam(y ~ -1,
230+
trend_formula = ~ s(season, by = trend),
231+
trend_model = RW(cor = TRUE),
232+
family = Gamma(),
233+
data = simdat$data_train,
234+
share_obs_params = TRUE,
235+
run_model = FALSE)
236+
expect_true(inherits(mod, 'mvgam_prefit'))
237+
expect_true(any(grepl('real<lower=0>shape;',
238+
gsub(' ', '', mod$model_file), fixed = TRUE)))
239+
expect_true(any(grepl('shape_vec[1:n,s]=rep_vector(shape,n);',
240+
gsub(' ', '', mod$model_file), fixed = TRUE)))
241+
})
242+
158243
test_that("trend_map is behaving propoerly", {
159244
sim <- sim_mvgam(n_series = 3)
160245
mod_data <- sim$data_train

0 commit comments

Comments
 (0)