Introduction
For many applications, we need to deal with multivariate data. In this vignette, we will introduce the bivariate model which supports modeling two (non-Gaussian) fields and their correlation jointly. The main reference is Bolin and Wallin (2020) Multivariate Type G Matérn Stochastic Partial Differential Equation Random Fields.
The f function specification is similar to ordinary
model (See e.g. Ngme2 AR(1) model), but
with two more fields to help identify the variables. Extra arguments for
the f are:
group: a vector of labels to indicate the group of different observations. For example,group = c("field1", "field1", "field2", "field2", "field2). Ifgroupis provided inngme()function, no need to provide inf()function again.sub_models: characters of length 2 with names equal to one of the labels ingroup, specifying the sub-models for the two fields. e.g.sub_models=c(field1="rw1", field2="ar1").
We will see more examples in the following.
Model structure
The bivariate model can model two fields \(\mathbf{X}(s) = (X_1(s), X_2(s))\) jointly. To model their correlation, we use dependence matrix \(D(\theta, \rho)\) to correlate them (See Bolin and Wallin, 2020, section 2.2).
Remember that, for the univariate model, it can be written as: \[ \mathcal{L} \mathbf{X}(s) = \mathcal{M},\] where \(\mathcal{L}\) is some operator, \(\mathcal{M}\) represents the noise (Gaussian or non-Gaussian).
The bivariate model is similar, but with one more term to correlate the two fields: \[ \mathbf{D(\theta, \rho)} diag(\mathcal{L_1}, \mathcal{L_2}) \mathbf{X}(s) = \mathcal{M},\] where \(\mathbf{D}\) is the dependence matrix. The noise can be classified into 4 types by their complexity, we will discuss them later.
The dependence matrix is defined as \[ D(\theta, \rho) = \begin{pmatrix} \cos(\theta) + \rho \sin(\theta) & -\sin(\theta) \sqrt{1+\rho^2} \\ \sin(\theta) - \rho \cos(\theta) & \cos(\theta) \sqrt{1+\rho^2} \end{pmatrix}, \] where \(\theta \in [-\pi/4, \pi/4]\) and \(\rho \in \mathbb{R}\). The \(\theta\) controls the angle (rotation) of the bivariate model, and \(\rho\) represents the cross-correlation between the two fields.
One simple example
It’s eaiser to understand with one exmaple. Say we have a time series model over 5 year from 2001 to 2005, with 2 fields temperature and precipitation. You want to model the two fields jointly. The data look like the following:
library(fmesher)
library(ngme2)
temp <- c(32, 33, 35.5, 36); year_temp <- c(2001, 2002, 2003, 2004)
precip <- c(0.1, 0.2, 0.5, 1, 0.2); year_pre <- c(2001, 2002, 2003, 2004, 2005)
# bind 2 fields in one vector, and make labels for them
y <- c(temp, precip); year <- c(year_temp, year_pre)
labels <- c(rep("temp", 4), rep("precip", 5)) # group is label for 2 fields
x1 <- 1:9
data <- data.frame(y, year, x1, labels)
data
#> y year x1 labels
#> 1 32.0 2001 1 temp
#> 2 33.0 2002 2 temp
#> 3 35.5 2003 3 temp
#> 4 36.0 2004 4 temp
#> 5 0.1 2001 5 precip
#> 6 0.2 2002 6 precip
#> 7 0.5 2003 7 precip
#> 8 1.0 2004 8 precip
#> 9 0.2 2005 9 precipNext we need to specify the model using f() function.
Notice the way to specify 2 sub-models, and also 2 types of noises for
each sub-model.
Notice that if we choose the Gaussian noise, we need to specify the model type as “bv_normal” so that the rotation is fixed to 0 (no rotation). If we choose the non-Gaussian noise, we can use “bv” model type.
# 1st way: simply put model types, using both c() and list() are ok
# Choose model="bv_normal" if use Gaussian noise,
bv1 <- f(
year, model = "bv_normal",
theta = pi / 8, rho = 0.5,
sub_models = list(precip="ar1", temp="rw1"),
group = labels, # can be inherited from ngme() function
noise = list(
precip=noise_normal(),
temp=noise_normal()
)
)
bv1
#> Model type: Bivariate model (normal noise)
#> theta = 0
#> rho = 0
#> precip: AR(1)
#> rho = 0
#> temp: Random walk (order 1)
#> No parameter.
#> Bivariate type-G4 noise:
#> precip: NORMAL
#> Noise parameters:
#> sigma = 1
#> temp: NORMAL
#> Noise parameters:
#> sigma = 1
# 2nd way: allow more argument for sub_models
bv_normal <- f(
year, model = "bv",
sub_models = list(
precip=list(model="ar1", rho=0.5), # specify correlation parameter for ar1 model
temp=list(model="rw1")
),
group = labels,
noise = list(
precip=noise_nig(),
temp=noise_nig()
)
)
bv_normal
#> Model type: Bivariate model (non-Gaussian noise)
#> theta = 0
#> rho = 0
#> precip: AR(1)
#> rho = 0.5
#> temp: Random walk (order 1)
#> No parameter.
#> Bivariate type-G4 noise:
#> precip: NIG
#> Noise parameters:
#> mu = 0
#> sigma = 1
#> nu = 1
#> temp: NIG
#> Noise parameters:
#> mu = 0
#> sigma = 1
#> nu = 1Four increasing construction of noise
In bivariate models, we can have more detailed control over the noise of the model. The noise can be classified into 4 category (See Bolin and Wallin, 2020, section 3.1 for details):
Type-G1: single mixing variable V, share V over 2 fileds.
Type-G2: single V, different V for each field.
Type-G3: general V, share V.
Type-G4: general V, different V.
We can specify the type of noise by the following:
t1 <- f(
year, model = "bv",
sub_models = list(precip="ar1", temp="rw1"),
group = labels,
noise = list(
precip=noise_nig(single_V=TRUE),
temp=noise_nig(single_V=TRUE),
share_V = TRUE
)
)
t1
#> Model type: Bivariate model (non-Gaussian noise)
#> theta = 0
#> rho = 0
#> precip: AR(1)
#> rho = 0
#> temp: Random walk (order 1)
#> No parameter.
#> Bivariate type-G1 noise (single_V && share_V):
#> precip: NIG
#> Noise parameters:
#> mu = 0
#> sigma = 1
#> nu = 1
#> temp: NIG
#> Noise parameters:
#> mu = 0
#> sigma = 1
#> nu = 1
t2 <- f(
year, model = "bv",
sub_models = list(precip="ar1", temp="rw1"),
group = labels,
noise = list(
precip=noise_nig(single_V=TRUE),
temp=noise_nig(single_V=TRUE)
)
)
t2
#> Model type: Bivariate model (non-Gaussian noise)
#> theta = 0
#> rho = 0
#> precip: AR(1)
#> rho = 0
#> temp: Random walk (order 1)
#> No parameter.
#> Bivariate type-G2 noise (single_V):
#> precip: NIG
#> Noise parameters:
#> mu = 0
#> sigma = 1
#> nu = 1
#> temp: NIG
#> Noise parameters:
#> mu = 0
#> sigma = 1
#> nu = 1
t3 <- f(
year, model = "bv",
sub_models = list(precip="ar1", temp="rw1"),
group = labels,
noise = list(
precip=noise_nig(),
temp=noise_nig(),
share_V = TRUE
)
)
t3
#> Model type: Bivariate model (non-Gaussian noise)
#> theta = 0
#> rho = 0
#> precip: AR(1)
#> rho = 0
#> temp: Random walk (order 1)
#> No parameter.
#> Bivariate type-G3 noise (share_V):
#> precip: NIG
#> Noise parameters:
#> mu = 0
#> sigma = 1
#> nu = 1
#> temp: NIG
#> Noise parameters:
#> mu = 0
#> sigma = 1
#> nu = 1
t4 <- f(
year, model = "bv",
sub_models = list(precip="ar1", temp="rw1"),
group = labels,
noise = list(
precip=noise_nig(),
temp=noise_nig()
)
)
t4
#> Model type: Bivariate model (non-Gaussian noise)
#> theta = 0
#> rho = 0
#> precip: AR(1)
#> rho = 0
#> temp: Random walk (order 1)
#> No parameter.
#> Bivariate type-G4 noise:
#> precip: NIG
#> Noise parameters:
#> mu = 0
#> sigma = 1
#> nu = 1
#> temp: NIG
#> Noise parameters:
#> mu = 0
#> sigma = 1
#> nu = 1Interaction with other fields (e.g. fixed effects)
When it involves more than one field, things get complicated. When we
have fixed effects but only for 1 field, we can use the special syntax
fe(<formula>, which_group=<group_name>). The
argument which_group will tell which field we have fixed
effects on. It works similar for modeling using f()
function.
Here is one example, we have different fixed effects on different fields (Intercept for both fields, and x1 for only precip field).
m1 <- ngme(
y ~ 0 + fe(~1, which_group = "temp") +
fe(~1+x1, which_group = "precip") +
f(year, model="rw1", which_group = "temp") +
f(year,
model = "bv",
sub_models = list(precip="ar1", temp="rw1"),
noise = list(
precip = noise_nig(),
temp = noise_nig()
)
),
data = data,
group = data$labels,
control_opt = control_opt(estimation = FALSE)
)
# examine the design matrix
m1$replicates[[1]]$X
#> (Intercept)_temp (Intercept)_precip x1_precip
#> 1 1 0 0
#> 2 1 0 0
#> 3 1 0 0
#> 4 1 0 0
#> 5 0 1 5
#> 6 0 1 6
#> 7 0 1 7
#> 8 0 1 8
#> 9 0 1 9The correlated measurement noise
Now since we are taking measures of 2 different fields, there is some situation that we might want to assume the measurement of 2 fields have some correlation.
It can be written as \(Y = X \beta + A W + \epsilon\), here \(W\) is the bivariate model, and \(\epsilon | V_{\epsilon} \sim N(0, \Sigma)\), \(\Sigma_{i j} \neq 0\) if \(Y_i\) and \(Y_j\) are 2 different fields but measured at same location.
Now we need to modify the family argument in
ngme function, we need to set corr_measurement
and give the index_corr to indicate which observations are
correlated.
We will see how to estimate it in the next example.
Put it all together (Simulation + Estimation example)
In this example, we will first use simulate function to
simulate the hidden bivariate process. Notice that we need to provide
the labels for the 2 fields. Then we will generate the measurement noise
\(\epsilon\) with some correlation.
Finally, we will use the ngme function to estimate the
model.
Ex1. Fixed effects + Bivariate model (AR1, Normal) + Correlated measurement noise
n_obs <- 2000
n_each <- n_obs / 2
group <- c(rep("W1", n_each), rep("W2", n_each))
reorder_loc = sample(1:n_each)
sim_fields <- simulate(
f(c(reorder_loc, reorder_loc),
model="bv_normal",
rho=5,
sub_models = list(
W1 = list(model="ar1", rho=0.6),
W2 = list(model="ar1", rho=-0.4)
),
group=group,
noise=list(
W1 = noise_normal(sigma = 3),
W2 = noise_normal(sigma = 2)
)
)
)[[1]]
# Here we assume f1 and f2 have positive correlated measurement error
# if they are measured at same index.
# Meaning Y(i) and Y(j) have correlated measurement noise
# if they represent underlying W1(index=k) and W2(index=k)
# Generate covariance matrix for measurement noise
Cov_same_idx <- matrix(c(1, 0.7, 0.7, 1), nrow=2)
Cov_measurement <- Cov_same_idx %x% diag(n_obs / 2)
# e ~ N(0, Cov_measurement)
L <- t(chol(Cov_measurement))
e <- L %*% rnorm(n_obs)
# fixed effects
x1 <- rexp(n_obs)
x2 <- rnorm(n_obs)
feff <- c(-3, 1.5)
Y <- sim_fields + x1 * feff[1] + x2 * feff[2] + as.numeric(e)
out <- ngme(
Y ~ 0 + x1 + x2 +
f(c(reorder_loc, reorder_loc),
model="bv_normal",
name = "bv",
sub_models = list(W1 = "ar1", W2 = "ar1"),
noise=list(
W1 = noise_normal(),
W2 = noise_normal()
)
),
group = group,
family = noise_normal(
corr_measurement = TRUE,
index_corr = c(1:n_each, 1:n_each)
),
data = data.frame(Y, x1, x2),
control_opt = control_opt(
n_parallel_chain = 4,
optimizer = adam(stepsize = 0.01),
iterations = 10000,
preconditioner = "none",
rao_blackwellization = TRUE,
precond_by_diff_chain = FALSE,
seed = 7
)
)
#> Starting estimation...
#>
#> Starting posterior sampling...
#> Posterior sampling done!
#> Note:
#> 1. Use ngme_post_samples(..) to access the posterior samples.
#> 2. Use ngme_result(..) to access different latent models.
out
#> *** Ngme object ***
#>
#> Fixed effects:
#> x1 x2
#> -2.99 1.53
#>
#> Models:
#> $bv
#> Model type: Bivariate model (normal noise)
#> theta = 0
#> rho = 2.82
#> W1: AR(1)
#> rho = 0.577
#> W2: AR(1)
#> rho = -0.397
#> Bivariate type-G4 noise:
#> W1: NORMAL
#> Noise parameters:
#> sigma = 2.97
#> W2: NORMAL
#> Noise parameters:
#> sigma = 2.46
#>
#>
#> Measurement noise:
#> Noise type: NORMAL
#> Noise parameters:
#> sigma = 0.715
#> correlation(rho) = 0.654
#>
#>
#> Number of replicates is 1
# comparing with simulated value
traceplot(
out, "bv",
hline=c(5, 0.6, -0.4, 3, 2)
)
Ex2. Fixed effects + Bivariate model (AR1, NIG) + Correlated measurement noise
set.seed(125)
n_obs <- 1000
n_each <- n_obs / 2
group <- c(rep("W1", n_each), rep("W2", n_each))
theta = pi/8; rho = 2; rho_1 = 0.6; rho_2 = 0.4
mu_1 = -2; sigma_1 = 1; nu_1 = 1
mu_2 = 2; sigma_2 = 2; nu_2 = 0.5
reorder_loc = sample(1:n_each)
sim_fields <- simulate(
f(c(reorder_loc, reorder_loc),
model="bv",
theta = theta,
rho = rho,
sub_models = list(
W1 = list(model="ar1", rho=rho_1),
W2 = list(model="ar1", rho=rho_2)
),
group=group,
noise=list(
W1 = noise_nig(mu=mu_1, sigma=sigma_1, nu=nu_1),
W2 = noise_nig(mu=mu_2, sigma=sigma_2, nu=nu_2)
)
)
)[[1]]
# Same as previous
Cov_same_idx <- matrix(c(1, 0.7, 0.7, 1), nrow=2)
Cov_measurement <- Cov_same_idx %x% diag(n_obs / 2)
# e ~ N(0, Cov_measurement)
L <- t(chol(Cov_measurement))
e <- L %*% rnorm(n_obs)
# fixed effects
x1 <- rexp(n_obs)
x2 <- rnorm(n_obs)
feff <- c(-3, 1.5)
Y <- sim_fields + x1 * feff[1] + x2 * feff[2] + as.numeric(e)
out <- ngme(
Y ~ 0 + x1 + x2 +
f(c(reorder_loc, reorder_loc),
model="bv",
name = "bv",
sub_models = list(W1 = "ar1", W2 = "ar1"),
noise=list(
W1 = noise_nig(),
W2 = noise_nig()
)
),
group = group,
family = noise_normal(
corr_measurement = TRUE,
index_corr = c(1:n_each, 1:n_each)
),
data = data.frame(Y, x1, x2),
control_opt = control_opt(
optimizer = adam(),
iterations = 500,
n_parallel_chain = 4,
seed = 113
)
)
#> Starting estimation...
#>
#> Starting posterior sampling...
#> Posterior sampling done!
#> Note:
#> 1. Use ngme_post_samples(..) to access the posterior samples.
#> 2. Use ngme_result(..) to access different latent models.
out
#> *** Ngme object ***
#>
#> Fixed effects:
#> x1 x2
#> -3.00 1.46
#>
#> Models:
#> $bv
#> Model type: Bivariate model (non-Gaussian noise)
#> theta = 0.383
#> rho = 1.9
#> W1: AR(1)
#> rho = 0.594
#> W2: AR(1)
#> rho = 0.375
#> Bivariate type-G4 noise:
#> W1: NIG
#> Noise parameters:
#> mu = -1.42
#> sigma = 1.14
#> nu = 0.623
#> W2: NIG
#> Noise parameters:
#> mu = 2.19
#> sigma = 2.13
#> nu = 0.527
#>
#>
#> Measurement noise:
#> Noise type: NORMAL
#> Noise parameters:
#> sigma = 0.955
#> correlation(rho) = 0.714
#>
#>
#> Number of replicates is 1
# comparing with simulated value
traceplot(
out, "bv",
hline=c(theta, rho, rho_1, rho_2,
mu_1, mu_2, sigma_1, sigma_2, nu_1, nu_2)
)
# fixed effects and measurement noise
# traceplot(out, hline=c(1, 0.7, -3, 1.5))
#
# ngme2:::build_D(0, 5)
# ngme2:::build_D(theta, 1)
# ngme2:::build_D(-0.43, 1.37)
# ngme2:::build_D(theta, 0.5)Ex3. Fixed effects + Bivariate model (Matérn, Normal) + iid measurement noise
Next, we consider a spatial bivariate model.
pl01 <- cbind(c(0, 1, 1, 0, 0) * 10, c(0, 0, 1, 1, 0) * 5)
mesh <- fmesher::fm_mesh_2d(
loc.domain = pl01,
cutoff = 0.2,
max.edge = c(0.5, 10)
)
mesh$n
#> [1] 835
n_obs <- 1000
# generate random locations (same for two fields)
long <- runif(n_obs/2, 0, 10); lat <- runif(n_obs/2, 0, 5)
long <- c(long, long); lat <- c(lat, lat)
group <- c(rep("W1", n_obs/2), rep("W2", n_obs/2))
# plot the mesh
plot(mesh); points(long, lat)
# parameters of the bivariate model
theta = 0; rho = 1;
theta_K_1 = log(2); theta_K_2 = log(5);
mu_1 = -2; sigma_1 = 0.5; nu_1 = 1
mu_2 = 2; sigma_2 = 0.3; nu_2 = 0.5
true_model <- f(
~ long + lat,
theta = theta,
rho = rho,
mesh = mesh,
model = "bv_normal",
sub_models = list(
W1 = list(model = "matern", theta_K = theta_K_1),
W2 = list(model = "matern", theta_K = theta_K_2)
),
group = group,
noise = list(
W1 = noise_normal(sigma = sigma_1),
W2 = noise_normal(sigma = sigma_2)
# W1 = noise_nig(mu = mu_1, sigma = sigma_1, nu=nu_1),
# W2 = noise_nig(mu = mu_2, sigma = sigma_2, nu=nu_2)
)
)
W <- simulate(true_model)[[1]]
Y <- W + rnorm(n_obs, sd=0.2)
out <- ngme(
Y ~ 0 + f(
~ long + lat,
mesh = mesh,
model = "bv_normal",
name = "bv",
sub_models = list(
W1 = list(model = "matern"),
W2 = list(model = "matern")
),
# debug=T,
noise = list(
# W1 = noise_nig(),
# W2 = noise_nig()
W1 = noise_normal(),
W2 = noise_normal()
)
),
group = group,
data = data.frame(Y, long, lat),
control_opt = control_opt(
iterations = 500,
n_parallel_chain = 4,
rao_blackwellization = TRUE,
verbose = T,
print_check_info = F,
seed = 50
),
debug = F
)
#> Starting estimation...
#>
#> Starting posterior sampling...
#> Posterior sampling done!
#> Note:
#> 1. Use ngme_post_samples(..) to access the posterior samples.
#> 2. Use ngme_result(..) to access different latent models.
out
#> *** Ngme object ***
#>
#> Fixed effects:
#> None
#>
#> Models:
#> $bv
#> Model type: Bivariate model (normal noise)
#> theta = 0
#> rho = -1.31
#> W1: Matern
#> kappa = 2.19
#> W2: Matern
#> kappa = 3.62
#> Bivariate type-G4 noise:
#> W1: NORMAL
#> Noise parameters:
#> sigma = 0.382
#> W2: NORMAL
#> Noise parameters:
#> sigma = 0.0671
#>
#>
#> Measurement noise:
#> Noise type: NORMAL
#> Noise parameters:
#> sigma = 0.204
#>
#>
#> Number of replicates is 1
# comparing with simulated value
traceplot(
out, "bv",
hline=c(theta, rho, exp(theta_K_1), exp(theta_K_2),
sigma_1, sigma_2)
)
Helper tool to build correlation index between two fields
Sometimes it’s tedious to provide to index_corr argument
to indicate which observations are correlated, we can use the helper
function compute_index_corr_from_map to reduce the
work.
It can helps to compute the distance (both 1d or 2d distance) given the location we want to use. If some of them are close enough, then we will correlate them.
# provide the x,y coordinate (2d locations)
x_coord <- c(1.11, 2.5, 1.12, 2, 1.3, 1.31)
y_coord <- c(1.11, 3.3, 1.11, 2, 1.3, 1.3)
coords <- data.frame(x_coord, y_coord)
# here we can see 2 pairs (1 and 3, 5 and 6) of observations are close enough
compute_index_corr_from_map(coords, eps = 0.1)
#> [1] 2 1 2 3 4 4