# tests/testthat/test_heterogeneous_calculations.R In xnet: Two-Step Kernel Ridge Regression for Network Predictions

```context("heterogeneous tskrr calculations")

# Create the structures needed. Was saved in a .rdata file

dfile <- system.file("testdata","testdata.rda", package = "xnet")

# Prepare the eigen decompositions
Keig <- eigen(K)
Kmat <- Keig\$vectors
Kvec <- Keig\$values

Geig <- eigen(G)
Gmat <- Geig\$vectors
Gvec <- Geig\$values

# Calculate the hat and map matrices
lambdak <- 0.01
lambdag <- 1.5
Hk <- Kmat %*% diag(Kvec) %*% solve(diag(Kvec) + lambdak*diag(4)) %*% t(Kmat)
Mk <- Kmat %*% solve(diag(Kvec) + lambdak*diag(4)) %*% t(Kmat)
Hg <- Gmat %*% diag(Gvec) %*% solve(diag(Gvec) + lambdag*diag(5)) %*% t(Gmat)
Mg <- Gmat %*% solve(diag(Gvec) + lambdag*diag(5)) %*% t(Gmat)

# Fit the model
mod <- tskrr(Y, K, G, lambda = c(lambdak, lambdag))

# Manual construction of the fits
fits <- Hk %*% Y %*% Hg
wts <- Mk %*% Y %*% Mg

naivewts <- solve(K + lambdak*diag(4)) %*% Y %*%
solve(G + lambdag*diag(5))

test_that("hat and map matrix is calculated correctly",{
expect_equal(Hk, eigen2hat(Kmat, Kvec, lambdak))
expect_equal(Mk, eigen2map(Kmat, Kvec, lambdak))
})

test_that("weights are calculated correctly",{
expect_equal(wts, weights(mod))
expect_equal(naivewts, weights(mod))
})

test_that("Heterogeneous model is fitted correctly",{
expect_equal(fitted(mod, labels = FALSE),fits)
})

test_that("Heterogeneous model object is constructed correctly",{
expect_equal(response(mod), Y)
expect_equal(lambda(mod), c(k = lambdak, g = lambdag))
expect_true(is.na(symmetry(mod)))
expect_equal(get_eigen(mod, "row"), Keig)
expect_equal(get_eigen(mod, "column"), Geig)
expect_false(is_homogeneous(mod))
expect_equal(hat(mod, 'row'), Hk)
expect_equal(hat(mod, 'column'), Hg)
expect_false(has_hat(mod))
})

test_that("Kernel matrices are extracted correctly", {
expect_equal(K, get_kernelmatrix(mod, 'row'))
expect_equal(G, get_kernelmatrix(mod, 'column'))
})

# Check label matching

rlabels <- letters[1:4]
clabels <- letters[1:5]

Yl <- Y
Kl <- K
Gl <- G
rownames(Yl) <- rownames(Kl) <- colnames(Kl) <- rlabels
colnames(Yl) <- rownames(Gl) <- colnames(Gl) <- clabels

set.seed(5432) # Due to small size of matrices, there might be
# significant deviation bcs of differences in the
# decompositions. See eg with seed = 5434 (R3.5.3)

idk <- sample(1:4)
idg <- sample(1:5)
Yl2 <- Yl[sample(1:4), sample(1:5)]
Kl2 <- Kl[idk, idk]
Gl2 <- Gl[idg,idg]

mod1 <- tskrr(Yl,Kl,Gl)
mod2 <- tskrr(Yl2,Kl2,Gl2)

test_that("Labels are correctly processed in fitting tskrr",{
expect_equal(fitted(mod1)[rlabels,clabels],
fitted(mod2)[rlabels,clabels])

})

# update -------------------------
lambdanew <- c(0.001,0.01)
modnew <- tskrr(Y, K, G, lambda = lambdanew)

mod3 <- tskrr(Y, K, G, lambda = c(lambdak, lambdag), keep = TRUE)
modnew3 <- tskrr(Y, K, G, lambda = lambdanew, keep = TRUE)
modnew4 <- tskrr(Y, K, G, lambda = 0.5, keep = TRUE)

test_that("Heterogeneous model gets updated correctly",{
expect_error(update(mod, lambda = numeric(0)))
expect_error(update(mod, lambda = c(1,2,3)))
expect_equal(update(mod, lambdanew), modnew)
expect_equal(update(mod3, lambdanew),modnew3)
expect_equal(update(mod3, 0.5), modnew4)
})

# loss --------------------------

test_that("loss is calculated correctly",{
expect_equal(loss(mod),loss_mse(response(mod), loo(mod)))
expect_equal(loss(mod, exclusion = "column", fun = loss_auc),
loss_auc(response(mod),
loo(mod, exclusion = "column")))
expect_equal(loss(mod, predictions = TRUE),
loss_mse(response(mod), fitted(mod)))
})

# predict ------------------------
predk <- Knew %*% weights(mod) %*% G
colnames(predk) <- paste0("col",1:5)

predall <- Knew %*% weights(mod) %*% t(Gnew)

predg <- K %*% weights(mod) %*% t(Gnew)
rownames(predg) <- paste0("row",1:4)

test_that("predict works as intended",{
expect_equal(predk,
predict(mod, Knew))
expect_equal(predict(mod, g = Gnew),
predg)
expect_equal(predict(mod, Knew, Gnew),
predall)
expect_error(predict(mod, Knew, t(Gnew)),
"The g matrix needs 5 columns")
expect_error(predict(mod, t(Knew), Gnew),
"The k matrix needs 4 columns")
})
```

## Try the xnet package in your browser

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

xnet documentation built on Feb. 4, 2020, 9:10 a.m.