tests/testthat/test_pickAndChangeParams.R

library(uGMAR)
context("pick and change parameters")

params11 <- c(1, 0.9, 1, 10) # StMAR
params12 <- c(0.8, 0.5, 0.5, 2, -1, 0.1, 0.6)
params12_2 <- c(2, -1, 0.1, 0.8, 0.5, 0.5, 0.4, 12, 30) #StMAR
params22 <- c(0.2, 0.1, 0.2, 0.2, 0.3, 0.2, 0.2, 0.2, 0.49)
params13 <- c(0.1, 0.99, 0.1, 0.2, -0.99, 0.2, 0.3, 0.01, 0.3, 0.5, 0.5)
params23 <- c(0.1, 0.1, 0.1, 0.1, 0.2, 0.5, 0.5, 0.2, 0.3, 0.3, 0.3, 0.3, 0.8, 0.05, 11, 12, 13) # StMAR

params12r <- c(0.1, 0.2, 0.9, 0.1, 0.2, 0.6, 11, 12) # StMAR
params22r <- c(0.1, 0.2, 0.89, 0.01, 0.1, 0.2, 0.05)
params23r <- c(0.1, 0.3, 0.4, -0.4, 0.3, 1, 2, 3, 0.5, 0.1, 100, 112, 130) # StMAR
params13r <- c(1, 2, 3, 0.999, 1, 2, 3, 0.2, 0.15)

params13gs <- c(1, 0.1, 1, 2, 0.2, 2, 3, 0.3, 3, 0.4, 0.2, 10, 20) # M1=1, M2=2
params23gs <- c(1, 0.1, 0.1, 1, 2, 0.2, 0.2, 2, 3, 0.3, 0.3, 3, 0.2, 0.3, 10) # M1=2, M2=1
params14gs <- c(1, 0.1, 1, 2, 0.2, 2, 3, 0.3, 3, 4, 0.4, 4, 0.4, 0.3, 0.2, 11, 12) # M1=2, M2=2
params22gsr <- c(1, 2, 0.1, 0.2, 1, 2, 0.1, 10) # M1=1, M2=1
params13gsr <- c(1, 2, 3, 0.5, 1, 2, 3, 0.1, 0.1, 11, 12) # M1=1, M2=2
params14gsr <- c(1, 2, 3, 4, 0.5, 1, 2, 3, 4, 0.1, 0.2, 0.3, 10) # M1=3, M2=1


test_that("pick_pars works correctly", {
  expect_equal(pick_pars(p=1, M=1, params=params11, model="StMAR"), matrix(c(1, 0.9, 1), ncol=1))
  expect_equal(pick_pars(p=1, M=2, params=params12, model="GMAR"), matrix(c(0.8, 0.5, 0.5, 2, -1, 0.1), ncol=2))
  expect_equal(pick_pars(p=2, M=2, params=params22, model="GMAR"), matrix(c(0.2, 0.1, 0.2, 0.2, 0.3, 0.2, 0.2, 0.2), ncol=2))
  expect_equal(pick_pars(p=1, M=3, params=params13gs, model="G-StMAR"), matrix(c(1, 0.1, 1, 2, 0.2, 2, 3, 0.3, 3), ncol=3))
  expect_equal(pick_pars(p=2, M=3, params=params23gs, model="G-StMAR"), matrix(c(1, 0.1, 0.1, 1, 2, 0.2, 0.2, 2, 3, 0.3, 0.3, 3) , ncol=3))
})


test_that("pick_alphas works correctly", {
  expect_equal(pick_alphas(p=1, M=1, params=params11, model="StMAR"), 1)
  expect_equal(pick_alphas(p=1, M=2, params=params12, model="GMAR"), c(0.6, 0.4))
  expect_equal(pick_alphas(p=1, M=2, params=params12_2, model="StMAR"), c(0.4, 0.6))
  expect_equal(pick_alphas(p=2, M=2, params=params22, model="GMAR"), c(0.49, 0.51))
  expect_equal(pick_alphas(p=1, M=3, params=params13, model="GMAR"), c(0.5, 0.5, 0.0))
  expect_equal(pick_alphas(p=2, M=3, params=params23, model="StMAR"), c(0.8, 0.05, 0.15))

  expect_equal(pick_alphas(p=1, M=2, params=params12r, model="StMAR", restricted=TRUE), c(0.6, 0.4))
  expect_equal(pick_alphas(p=2, M=2, params=params22r, model="GMAR", restricted=TRUE), c(0.05, 0.95))
  expect_equal(pick_alphas(p=2, M=3, params=params23r, model="StMAR", restricted=TRUE), c(0.5, 0.1, 0.4))
  expect_equal(pick_alphas(p=1, M=3, params=params13r, model="GMAR", restricted=TRUE), c(0.2, 0.15, 0.65))

  expect_equal(pick_alphas(p=1, M=c(1, 2), params=params13gs, model="G-StMAR"), c(0.4, 0.2, 0.4))
  expect_equal(pick_alphas(p=2, M=c(2, 1), params=params23gs, model="G-StMAR"), c(0.2, 0.3, 0.5))
  expect_equal(pick_alphas(p=1, M=c(2, 2), params=params14gs, model="G-StMAR"), c(0.4, 0.3, 0.2, 0.1))
  expect_equal(pick_alphas(p=2, M=c(1, 1), params=params22gsr, model="G-StMAR", restricted=TRUE), c(0.1, 0.9))
  expect_equal(pick_alphas(p=1, M=c(1, 2), params=params13gsr, model="G-StMAR", restricted=TRUE), c(0.1, 0.1, 0.8))
  expect_equal(pick_alphas(p=1, M=c(3, 1), params=params14gsr, model="G-StMAR", restricted=TRUE), c(0.1, 0.2, 0.3, 0.4))
})


test_that("pick_dfs works correctly", {
  expect_equal(pick_dfs(p=1, M=1, params=params11, model="StMAR"), 10)
  expect_equal(pick_dfs(p=1, M=2, params=params12, model="GMAR"), numeric(0))
  expect_equal(pick_dfs(p=1, M=2, params=params12_2, model="StMAR"), c(12, 30))
  expect_equal(pick_dfs(p=2, M=3, params=params23, model="StMAR"), c(11, 12, 13))

  expect_equal(pick_dfs(p=1, M=2, params=params12r, model="StMAR"), c(11, 12))
  expect_equal(pick_dfs(p=2, M=3, params=params23r, model="StMAR"), c(100, 112, 130))

  expect_equal(pick_dfs(p=1, M=c(1, 2), params=params13gs, model="G-StMAR"), c(10, 20))
  expect_equal(pick_dfs(p=2, M=c(2, 1), params=params23gs, model="G-StMAR"), c(10))
  expect_equal(pick_dfs(p=1, M=c(2, 2), params=params14gs, model="G-StMAR"), c(11, 12))
  expect_equal(pick_dfs(p=2, M=c(1, 1), params=params22gsr, model="G-StMAR"), c(10))
  expect_equal(pick_dfs(p=1, M=c(1, 2), params=params13gsr, model="G-StMAR"), c(11, 12))
  expect_equal(pick_dfs(p=1, M=c(3, 1), params=params14gsr, model="G-StMAR"), c(10))
})


test_that("pick_phi0 works correctly", {
  expect_equal(pick_phi0(p=1, M=1, params=params11, model="StMAR"), 1)
  expect_equal(pick_phi0(p=1, M=2, params=params12, model="GMAR"), c(0.8, 2))
  expect_equal(pick_phi0(p=1, M=2, params=params12_2, model="StMAR"), c(2, 0.8))
  expect_equal(pick_phi0(p=2, M=2, params=params22, model="GMAR"), c(0.2, 0.3))
  expect_equal(pick_phi0(p=1, M=3, params=params13, model="GMAR"), c(0.1, 0.2, 0.3))
  expect_equal(pick_phi0(p=2, M=3, params=params23, model="StMAR"), c(0.1, 0.2, 0.3))

  expect_equal(pick_phi0(p=1, M=2, params=params12r, model="StMAR", restricted=TRUE), c(0.1, 0.2))
  expect_equal(pick_phi0(p=2, M=2, params=params22r, model="GMAR", restricted=TRUE), c(0.1, 0.2))
  expect_equal(pick_phi0(p=2, M=3, params=params23r, model="StMAR", restricted=TRUE), c(0.1, 0.3, 0.4))
  expect_equal(pick_phi0(p=1, M=3, params=params13r, model="GMAR", restricted=TRUE), c(1, 2, 3))

  expect_equal(pick_phi0(p=1, M=c(1, 2), params=params13gs, model="G-StMAR"), c(1, 2, 3))
  expect_equal(pick_phi0(p=2, M=c(2, 1), params=params23gs, model="G-StMAR"), c(1, 2, 3))
  expect_equal(pick_phi0(p=1, M=c(2, 2), params=params14gs, model="G-StMAR"), c(1, 2, 3, 4))
  expect_equal(pick_phi0(p=2, M=c(1, 1), params=params22gsr, model="G-StMAR", restricted=TRUE), c(1, 2))
  expect_equal(pick_phi0(p=1, M=c(1, 2), params=params13gsr, model="G-StMAR", restricted=TRUE), c(1, 2, 3))
  expect_equal(pick_phi0(p=1, M=c(3, 1), params=params14gsr, model="G-StMAR", restricted=TRUE), c(1, 2, 3, 4))
})


calc_mu <- function(p, M, params, model=c("GMAR", "StMAR", "G-StMAR"), restricted=FALSE, constraints=NULL) {
  model <- match.arg(model)
  params <- reform_constrained_pars(p=p, M=M, params=params, model=model, restricted=restricted, constraints=constraints)
  pars <- reform_parameters(p=p, M=M, params=params, model=model, restricted=restricted)$pars
  M <- sum(M)
  vapply(1:M, function(m) pars[1, m]/(1 - sum(pars[(2:(nrow(pars) - 1)), m])), numeric(1))
}

params11_mu <- change_parametrization(p=1, M=1, params=params11, model="StMAR", change_to="mean")
params12_mu <- change_parametrization(p=1, M=2, params=params12, model="GMAR", change_to="mean")
params22_mu <- change_parametrization(p=2, M=2, params=params22, model="GMAR", change_to="mean")
params23gs_mu <- change_parametrization(p=2, M=c(2, 1), params=params23gs, model="G-StMAR", change_to="mean")

params12r_mu <- change_parametrization(p=1, M=2, params=params12r, model="StMAR", restricted=TRUE, change_to="mean")
params22r_mu <- change_parametrization(p=2, M=2, params=params22r, model="GMAR", restricted=TRUE, change_to="mean")
params13gsr_mu <- change_parametrization(p=1, M=c(1, 2), params=params13gsr, model="G-StMAR", restricted=TRUE, change_to="mean")

test_that("change_parametrization works correctly for non-constrained models", {
  expect_equal(calc_mu(p=1, M=1, params=params11, model="StMAR"), pick_phi0(p=1, M=1, params=params11_mu, model="StMAR"))
  expect_equal(change_parametrization(p=1, M=1, params=params11_mu, model="StMAR", change_to="intercept"), params11)

  expect_equal(calc_mu(p=1, M=2, params=params12, model="GMAR"), pick_phi0(p=1, M=2, params=params12_mu, model="GMAR"))
  expect_equal(change_parametrization(p=1, M=2, params=params12_mu, model="GMAR", change_to="intercept"), params12)

  expect_equal(calc_mu(p=2, M=2, params=params22, model="GMAR"), pick_phi0(p=2, M=2, params=params22_mu, model="GMAR"))
  expect_equal(change_parametrization(p=2, M=2, params=params22_mu, model="GMAR", change_to="intercept"), params22)

  expect_equal(calc_mu(p=2, M=c(2, 1), params=params23gs, model="G-StMAR"), pick_phi0(p=2, M=c(2, 1), params=params23gs_mu, model="G-StMAR"))
  expect_equal(change_parametrization(p=2, M=c(2, 1), params=params23gs_mu, model="G-StMAR", change_to="intercept"), params23gs)

  expect_equal(calc_mu(p=1, M=2, params=params12r, model="StMAR", restricted=TRUE), pick_phi0(p=1, M=2, params=params12r_mu, model="StMAR", restricted=TRUE))
  expect_equal(change_parametrization(p=1, M=2, params=params12r_mu, model="StMAR", restricted=TRUE, change_to="intercept"), params12r)

  expect_equal(calc_mu(p=2, M=2, params=params22r, model="GMAR", restricted=TRUE), pick_phi0(p=2, M=2, params=params22r_mu, model="GMAR", restricted=TRUE))
  expect_equal(change_parametrization(p=2, M=2, params=params22r_mu, model="GMAR", restricted=TRUE, change_to="intercept"), params22r)

  expect_equal(calc_mu(p=1, M=c(1, 2), params=params13gsr, model="G-StMAR", restricted=TRUE),
               pick_phi0(p=1, M=c(1, 2), params=params13gsr_mu, model="G-StMAR", restricted=TRUE))
  expect_equal(change_parametrization(p=1, M=c(1, 2), params=params13gsr_mu, model="G-StMAR", restricted=TRUE, change_to="intercept"), params13gsr)
})


R1 <- matrix(c(1, 0, 0, 0, 0, 1), ncol=2)
R2 <- diag(1, ncol=3, nrow=3)
R3 <- matrix(c(0.5, 0.5), ncol=1)
R4 <- diag(1, ncol=2, nrow=2)

params32c <- c(1, 0.1, -0.1, 1, 2, 0.2, -0.2, 2, 0.6, 11, 12) # model="StMAR", constraints=list(R1, R1)
params33c <- c(1, 0.1, 0.1, 0.1, 1, 2, 0.2, 0.2, 0.2, 2, 3, 0.3, -0.3, 3, 0.5, 0.4) #  constraints=list(R2, R2, R1)
params21c <- c(1, 0.1, 1, 3) # model="StMAR", constraints=list(R3)
params23gsc <- c(1, 0.1, 1, 2, 0.2, 2, 3, 0.3, 0.3, 3, 0.3, 0.4, 20, 30) # M1=1, M2=2, model="G-StMAR", constraints=list(R3, R3, R4)
params21cr <- c(1, 0.1, 1) # restricted=TRUE, constraints=R3
params22cr <- c(1, 2, 0.8, 1, 2, 0.7, 11, 12) #  model="StMAR", restricted=TRUE, constraints=R3

params32c_mu <- change_parametrization(p=3, M=2, params=params32c, model="StMAR", constraints=list(R1, R1), change_to="mean")
params33c_mu <- change_parametrization(p=3, M=3, params=params33c, constraints=list(R2, R2, R1), change_to="mean")
params21c_mu <- change_parametrization(p=2, M=1, params=params21c, constraints=list(R3), change_to="mean")
params23gsc_mu <- change_parametrization(p=2, M=c(1, 2), params=params23gsc, model="G-StMAR", constraints=list(R3, R3, R4), change_to="mean")
params21cr_mu <- change_parametrization(p=2, M=1, params=params21cr, restricted=TRUE, constraints=R3, change_to="mean")
params22cr_mu <- change_parametrization(p=2, M=2, params=params22cr, model="StMAR", restricted=TRUE, constraints=R3, change_to="mean")

test_that("change_parametrization works correctly for constrained models", {
  expect_equal(calc_mu(p=3, M=2, params=params32c, model="StMAR", constraints=list(R1, R1)),
               pick_phi0(p=3, M=2, params=params32c_mu, model="StMAR", constraints=list(R1, R1)))
  expect_equal(change_parametrization(p=3, M=2, params=params32c_mu, model="StMAR", change_to="intercept", constraints=list(R1, R1)), params32c)

  expect_equal(calc_mu(p=3, M=3, params=params33c, model="GMAR", constraints=list(R2, R2, R1)),
               pick_phi0(p=3, M=3, params=params33c_mu, model="GMAR", constraints=list(R2, R2, R1)))
  expect_equal(change_parametrization(p=3, M=3, params=params33c_mu, model="GMAR", change_to="intercept", constraints=list(R2, R2, R1)), params33c)

  expect_equal(calc_mu(p=2, M=1, params=params21c, model="GMAR", constraints=list(R3)),
               pick_phi0(p=2, M=1, params=params21c_mu, model="GMAR", constraints=list(R3)))
  expect_equal(change_parametrization(p=2, M=1, params=params21c_mu, model="GMAR", constraints=list(R3), change_to="intercept"), params21c)

  expect_equal(calc_mu(p=2, M=c(1, 2), params=params23gsc, model="G-StMAR", constraints=list(R3, R3, R4)),
               pick_phi0(p=2, M=c(1, 2), params=params23gsc_mu, model="G-StMAR", constraints=list(R3, R3, R4)))
  expect_equal(change_parametrization(p=2, M=c(1, 2), params=params23gsc_mu, model="G-StMAR", constraints=list(R3, R3, R4), change_to="intercept"), params23gsc)

  expect_equal(calc_mu(p=2, M=1, params=params21cr, model="GMAR", restricted=TRUE, constraints=R3),
               pick_phi0(p=2, M=1, params=params21cr_mu, model="GMAR", restricted=TRUE, constraints=R3))
  expect_equal(change_parametrization(p=2, M=1, params=params21cr_mu, model="GMAR", restricted=TRUE, constraints=R3, change_to="intercept"), params21cr)

  expect_equal(calc_mu(p=2, M=2, params=params22cr, model="StMAR", restricted=TRUE, constraints=R3),
               pick_phi0(p=2, M=2, params=params22cr_mu, model="StMAR", restricted=TRUE, constraints=R3))
  expect_equal(change_parametrization(p=2, M=2, params=params22cr_mu, model="StMAR", restricted=TRUE, constraints=R3, change_to="intercept"), params22cr)
})


params11t <- c(-2, 0.8, 1, 12) # StMAR
params23 <- c(2.7, 0.8, -0.06, 0.3, 3.5, 0.8, -0.07, 2.6, 7.2, 0.3, -0.01, 0.1, 0.6, 0.25)
params23t <- c(1.8, 0.9, -0.06, 0.4, 7.2, 0.3, -0.009, 0.1, 3.1, 0.83, -0.05, 3.7, 0.7, 0.2, 11, 339, 198) # StMAR
params13gsr <- c(1.3, 1, 1.4, 0.8, 0.4, 2, 0.2, 0.25, 0.15, 20) # M1=2, M2=1

stmar11 <- GSMAR(p=1, M=1, params=params11t, model="StMAR")
gmar23 <- GSMAR(p=2, M=3, params=params23, model="GMAR")
stmar23 <- GSMAR(p=2, M=3, params=params23t, model="StMAR")
gstmar13r <- GSMAR(p=1, M=c(2, 1), params=params13gsr, model="G-StMAR", restricted=TRUE)


test_that("get_ar_roots works correctly", {
  expect_equal(get_ar_roots(stmar11)[[1]], 1.25, tolerance=1e-5)
  expect_equal(get_ar_roots(gmar23)[[3]], c(3.81966, 26.18034), tolerance=1e-5)
  expect_equal(get_ar_roots(stmar23)[[2]], c(3.756722, 29.576611), tolerance=1e-5)
  expect_equal(get_ar_roots(gstmar13r)[[3]], 1.25, tolerance=1e-5)
})

pars11t <- c(1, 0.9, 1, 10)
pars12t <- c(2, 0.9, 0.1, 0.8, 0.5, 0.5, 0.4, 12, 30)
pars23t <- c(0.1, 0.1, 0.1, 0.1, 0.2, 0.5, 0.5, 0.2, 0.3, 0.3, 0.3, 0.3, 0.8, 0.05, 11, 12, 13)
pars12tr <- c(0.1, 0.2, 0.9, 0.1, 0.2, 0.6, 14, 12)
pars23tr <- c(0.1, 0.3, 0.4, -0.4, 0.3, 1, 2, 3, 0.5, 0.1, 1000, 112, 130)

R1 <- matrix(c(1, 0, 0, 0, 0, 1), ncol=2)
R2 <- diag(1, ncol=3, nrow=3)
R3 <- matrix(c(0.5, 0.5), ncol=1)

pars32tc <- c(1, 0.1, -0.1, 1, 2, 0.2, -0.2, 2, 0.6, 11, 12) #constraints=list(R1, R1)
pars33tc <- c(1, 0.1, 0.1, 0.1, 1, 2, 0.2, 0.2, 0.2, 2, 3, 0.3, -0.3, 3, 0.3, 0.4, 13, 12, 11) #  constraints=list(R2, R2, R1)
pars22tcr <- c(1, 2, 0.8, 1, 2, 0.7, 11, 12) # restricted=TRUE, constraints=R3
pars21tcr <- c(1, 0.1, 1, 10) # restricted=TRUE, constraints=R3

# G-StMAR
params13gs2 <- c(1, 0.1, 1, 2, 0.2, 2, 3, 0.3, 3, 0.5, 0.2, 10, 20) # M1=1, M2=2, alpha3=0.3
params13gs3 <- c(1, 0.1, 1, 2, 0.2, 2, 3, 0.3, 3, 0.5, 0.2, 20, 10) # M1=1, M2=2, alpha3=0.3
params23gs1 <- c(1, 0.1, 0.1, 1, 2, 0.2, 0.2, 2, 3, 0.3, 0.3, 3, 0.2, 0.3, 10) # M1=2, M2=1, alpha3=0.5
params23gs2 <- c(1, 0.1, 0.1, 1, 2, 0.2, 0.2, 2, 3, 0.3, 0.3, 3, 0.2, 0.3, 10, 4) # M1=1, M2=2, alpha3=0.5
params14gs1 <- c(1, 0.1, 1, 2, 0.2, 2, 3, 0.3, 3, 4, 0.4, 4, 0.4, 0.3, 0.2, 11, 13) # M1=2, M2=2, alpha4=0.1
params14gs2 <- c(1, 0.1, 1, 2, 0.2, 2, 3, 0.3, 3, 4, 0.4, 4, 0.3, 0.4, 0.2, 13, 11, 13) # M1=1, M2=3, alpha4=0.1
params22gsr1 <- c(1, 2, 0.1, 0.2, 1, 2, 0.1, 10) # M1=1, M2=1, restricted, alpha2=0.9
params13gsr1 <- c(1, 2, 3, 0.5, 1, 2, 3, 0.2, 0.1, 11, 13) # M1=1, M2=2, restricted, alpha3=0.7

R3 <- matrix(c(0.5, 0.5), ncol=1)
R4 <- diag(1, ncol=2, nrow=2)
params23gsc1 <- c(1, 0.1, 1, 2, 0.2, 2, 3, 0.3, 0.3, 3, 0.3, 0.5, 30, 10) # M1=1, M2=2, model="G-StMAR", constraints=list(R3, R3, R4)
params23gsc2 <- c(1, 0.1, 1, 2, 0.2, 2, 3, 0.3, 0.3, 3, 0.3, 0.5, 10, 30) # M1=1, M2=2, model="G-StMAR", constraints=list(R3, R3, R4)
params23gscr1 <- c(1, 2, 3, 0.1, 1, 2, 3, 0.3, 0.2, 10, 30) # M1=1, M2=2, model="G-StMAR", restricted=TRUE, constraints=R3

test_that("stmarpars_to_gstmar works correctly", {
  ret23gscr1 <- stmarpars_to_gstmar(p=2, M=c(1, 2), params=params23gscr1, model="G-StMAR", restricted=TRUE, constraints=R3, maxdf=25)
  expect_equal(ret23gscr1$M, c(2, 1))
  expect_equal(ret23gscr1$reg_order, c(3, 1, 2))
  expect_equal(ret23gscr1$params, c(3, 1, 2, 0.1, 3, 1, 2, 0.5, 0.3, 10))

  ret23gsc2 <- stmarpars_to_gstmar(p=2, M=c(1, 2), params=params23gsc2, model="G-StMAR", constraints=list(R3, R3, R4), maxdf=25)
  expect_equal(ret23gsc2$M, c(2, 1))
  expect_equal(ret23gsc2$reg_order, c(1, 3, 2))
  expect_equal(ret23gsc2$params, c(1, 0.1, 1, 3, 0.3, 0.3, 3, 2, 0.2, 2, 0.3, 0.2, 10))

  ret23gsc1 <- stmarpars_to_gstmar(p=2, M=c(1, 2), params=params23gsc1, model="G-StMAR", constraints=list(R3, R3, R4), maxdf=25)
  expect_equal(ret23gsc1$M, c(2, 1))
  expect_equal(ret23gsc1$reg_order, c(2, 1, 3))
  expect_equal(ret23gsc1$params, c(2, 0.2, 2, 1, 0.1, 1, 3, 0.3, 0.3, 3, 0.5, 0.3, 10))

  ret13gsr2 <- suppressWarnings(stmarpars_to_gstmar(p=1, M=c(1, 2), params=params13gsr1, model="G-StMAR", restricted=TRUE, maxdf=100))
  expect_equal(ret13gsr2$M, c(1, 2))
  expect_equal(ret13gsr2$reg_order, c(1, 2, 3))
  expect_equal(ret13gsr2$params, params13gsr1)

  ret13gsr1 <- stmarpars_to_gstmar(p=1, M=c(1, 2), params=params13gsr1, model="G-StMAR", restricted=TRUE, maxdf=12)
  expect_equal(ret13gsr1$M, c(2, 1))
  expect_equal(ret13gsr1$reg_order, c(3, 1, 2))
  expect_equal(ret13gsr1$params, c(3, 1, 2, 0.5, 3, 1, 2, 0.7, 0.2, 11))

  ret22gsr1 <- stmarpars_to_gstmar(p=2, M=c(1, 1), params=params22gsr1, model="G-StMAR", restricted=TRUE, maxdf=5)
  expect_equal(ret22gsr1$M, c(2, 0))
  expect_equal(ret22gsr1$reg_order, c(2, 1))
  expect_equal(ret22gsr1$params, c(2, 1, 0.1, 0.2, 2, 1, 0.9))

  ret14gs2 <- stmarpars_to_gstmar(p=1, M=c(1, 3), params=params14gs2, model="G-StMAR", maxdf=12)
  expect_equal(ret14gs2$M, c(3, 1))
  expect_equal(ret14gs2$reg_order, c(2, 1, 4, 3))
  expect_equal(ret14gs2$params, c(2, 0.2, 2, 1, 0.1, 1, 4, 0.4, 4, 3, 0.3, 3, 0.4, 0.3, 0.1, 11))

  ret14gs1 <- stmarpars_to_gstmar(p=1, M=c(2, 2), params=params14gs1, model="G-StMAR", maxdf=12)
  expect_equal(ret14gs1$M, c(3, 1))
  expect_equal(ret14gs1$reg_order, c(1, 2, 4, 3))
  expect_equal(ret14gs1$params, c(1, 0.1, 1, 2, 0.2, 2, 4, 0.4, 4, 3, 0.3, 3, 0.4, 0.3, 0.1, 11))

  ret23gs2 <- stmarpars_to_gstmar(p=2, M=c(1, 2), params=params23gs2, model="G-StMAR", maxdf=5)
  expect_equal(ret23gs2$M, c(2, 1))
  expect_equal(ret23gs2$reg_order, c(2, 1, 3))
  expect_equal(ret23gs2$params, c(2, 0.2, 0.2, 2, 1, 0.1, 0.1, 1, 3, 0.3, 0.3, 3, 0.3, 0.2, 4))

  ret23gs1 <- stmarpars_to_gstmar(p=2, M=c(2, 1), params=params23gs1, model="G-StMAR", maxdf=5)
  expect_equal(ret23gs1$M, c(3, 0))
  expect_equal(ret23gs1$reg_order, c(3, 2, 1))
  expect_equal(ret23gs1$params, c(3, 0.3, 0.3, 3, 2, 0.2, 0.2, 2, 1, 0.1, 0.1, 1, 0.5, 0.3))

  ret13gs3 <- stmarpars_to_gstmar(p=1, M=c(1, 2), params=params13gs3, model="G-StMAR", maxdf=15)
  expect_equal(ret13gs3$M, c(2, 1))
  expect_equal(ret13gs3$reg_order, c(1, 2, 3))
  expect_equal(ret13gs3$params, c(1, 0.1, 1, 2, 0.2, 2, 3, 0.3, 3, 0.5, 0.2, 10))

  ret13gs2 <- stmarpars_to_gstmar(p=1, M=c(1, 2), params=params13gs2, model="G-StMAR", maxdf=15)
  expect_equal(ret13gs2$M, c(2, 1))
  expect_equal(ret13gs2$reg_order, c(1, 3, 2))
  expect_equal(ret13gs2$params, c(1, 0.1, 1, 3, 0.3, 3, 2, 0.2, 2, 0.5, 0.3, 10))


  expect_equal(stmarpars_to_gstmar(p=1, M=1, params=pars11t, model="StMAR", maxdf=4)$M, c(1, 0))
  expect_equal(stmarpars_to_gstmar(p=1, M=1, params=pars11t, model="StMAR", maxdf=4)$reg_order, 1)
  expect_equal(stmarpars_to_gstmar(p=1, M=1, params=pars11t, model="StMAR", maxdf=4)$params, c(1, 0.9, 1))
  expect_equal(stmarpars_to_gstmar(p=1, M=2, params=pars12t, model="StMAR", maxdf=12)$M, c(1, 1))
  expect_equal(stmarpars_to_gstmar(p=1, M=2, params=pars12t, model="StMAR", maxdf=12)$reg_order, c(2, 1))
  expect_equal(stmarpars_to_gstmar(p=1, M=2, params=pars12t, model="StMAR", maxdf=12)$params, c(0.8, 0.5, 0.5, 2, 0.9, 0.1, 0.6, 12))
  expect_equal(stmarpars_to_gstmar(p=2, M=3, params=pars23t, model="StMAR", maxdf=11)$M, c(2, 1))
  expect_equal(stmarpars_to_gstmar(p=2, M=3, params=pars23t, model="StMAR", maxdf=11)$reg_order, c(3, 2, 1))
  expect_equal(stmarpars_to_gstmar(p=2, M=3, params=pars23t, model="StMAR", maxdf=11)$params, c(0.3, 0.3, 0.3, 0.3, 0.2, 0.5, 0.5, 0.2, 0.1, 0.1, 0.1, 0.1, 0.15, 0.05, 11))
  expect_equal(stmarpars_to_gstmar(p=1, M=2, params=pars12tr, model="StMAR", restricted=TRUE, maxdf=13)$M, c(1, 1))
  expect_equal(stmarpars_to_gstmar(p=1, M=2, params=pars12tr, model="StMAR", restricted=TRUE, maxdf=13)$reg_order, c(1, 2))
  expect_equal(stmarpars_to_gstmar(p=1, M=2, params=pars12tr, model="StMAR", restricted=TRUE, maxdf=13)$params, c(0.1, 0.2, 0.9, 0.1, 0.2, 0.6, 12))
  expect_equal(stmarpars_to_gstmar(p=2, M=3, params=pars23tr, model="StMAR", restricted=TRUE, maxdf=120)$M, c(2, 1))
  expect_equal(stmarpars_to_gstmar(p=2, M=3, params=pars23tr, model="StMAR", restricted=TRUE, maxdf=120)$reg_order, c(1, 3, 2))
  expect_equal(stmarpars_to_gstmar(p=2, M=3, params=pars23tr, model="StMAR", restricted=TRUE, maxdf=120)$params, c(0.1, 0.4, 0.3, -0.4, 0.3, 1, 3, 2, 0.5, 0.4, 112))
  expect_equal(stmarpars_to_gstmar(p=3, M=2, params=pars32tc, model="StMAR", constraints=list(R1, R1), maxdf=11)$M, c(1, 1))
  expect_equal(stmarpars_to_gstmar(p=3, M=2, params=pars32tc, model="StMAR", constraints=list(R1, R1), maxdf=11)$reg_order, c(2, 1))
  expect_equal(stmarpars_to_gstmar(p=3, M=2, params=pars32tc, model="StMAR", constraints=list(R1, R1), maxdf=11)$params, c(2, 0.2, -0.2, 2, 1, 0.1, -0.1, 1, 0.4, 11))
  expect_equal(stmarpars_to_gstmar(p=3, M=3, params=pars33tc, model="StMAR", constraints=list(R2, R2, R1), maxdf=11)$M, c(2, 1))
  expect_equal(stmarpars_to_gstmar(p=3, M=3, params=pars33tc, model="StMAR", constraints=list(R2, R2, R1), maxdf=11)$reg_order, c(2, 1, 3))
  expect_equal(stmarpars_to_gstmar(p=3, M=3, params=pars33tc, model="StMAR", constraints=list(R2, R2, R1), maxdf=11)$params,
               c(2, 0.2, 0.2, 0.2, 2, 1, 0.1, 0.1, 0.1, 1, 3, 0.3, -0.3, 3, 0.4, 0.3, 11))
  expect_equal(stmarpars_to_gstmar(p=2, M=2, params=pars22tcr, model="StMAR", restricted=TRUE, constraints=R3, maxdf=11)$M, c(1, 1))
  expect_equal(stmarpars_to_gstmar(p=2, M=2, params=pars22tcr, model="StMAR", restricted=TRUE, constraints=R3, maxdf=11)$reg_order, c(2, 1))
  expect_equal(stmarpars_to_gstmar(p=2, M=2, params=pars22tcr, model="StMAR", restricted=TRUE, constraints=R3, maxdf=11)$params, c(2, 1, 0.8, 2, 1, 0.3, 11))
  expect_equal(stmarpars_to_gstmar(p=2, M=1, params=pars21tcr, model="StMAR", restricted=TRUE, constraints=R3, maxdf=4)$M, c(1, 0))
  expect_equal(stmarpars_to_gstmar(p=2, M=1, params=pars21tcr, model="StMAR", restricted=TRUE, constraints=R3, maxdf=4)$reg_order, 1)
  expect_equal(stmarpars_to_gstmar(p=2, M=1, params=pars21tcr, model="StMAR", restricted=TRUE, constraints=R3, maxdf=4)$params, c(1, 0.1, 1))
})

Try the uGMAR package in your browser

Any scripts or data that you put into this service are public.

uGMAR documentation built on Aug. 19, 2023, 5:10 p.m.