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

```context("homogeneous tskrr calculations")

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

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

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

# Calculate the hat and map matrices
lambdak <- 0.01

Hk <- Kmat %*% diag(Kvec) %*% solve(diag(Kvec) + lambdak*diag(5)) %*% t(Kmat)
Mk <- Kmat %*% solve(diag(Kvec) + lambdak*diag(5)) %*% t(Kmat)

# Fit the model
modh <- tskrr(Yh, Kh, lambda = lambdak)

# Manual construction of the fits
fits <- Hk %*% Yh %*% Hk
wts <- Mk %*% Yh %*% Mk

naivewts <- solve(Kh + lambdak*diag(5)) %*% Yh %*%
solve(Kh + lambdak*diag(5))

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

test_that("Symmetric model object is constructed correctly",{
expect_equal(response(modh), Yh)
expect_equal(lambda(modh), c(k = lambdak))
expect_equal(symmetry(modh), "symmetric")
expect_equal(get_eigen(modh, "row"), Keig)
expect_equal(get_eigen(modh, "column"), Keig)
expect_true(is_homogeneous(modh))
expect_equal(hat(modh, 'row'), Hk)
expect_equal(hat(modh, 'column'), Hk)
expect_false(has_hat(modh))
})

test_that("Kernel matrices are extracted correctly", {
expect_equal(Kh, get_kernelmatrix(modh, 'row'))
expect_equal(Kh, get_kernelmatrix(modh, 'column'))
})

# Skewed networks ----------------------------------------------

mods <- tskrr(Ys, Kh, lambda = lambdak)
# Manual construction of the fits
fits <- Hk %*% Ys %*% Hk
wts <- Mk %*% Ys %*% Mk

naivewts <- solve(Kh + lambdak*diag(5)) %*% Ys %*%
solve(Kh + lambdak*diag(5))

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

test_that("Skewed model object is constructed correctly",{
expect_equal(response(mods), Ys)
expect_equal(lambda(mods), c(k = lambdak))
expect_equal(symmetry(mods), "skewed")
expect_equal(get_eigen(mods, "row"), Keig)
expect_equal(get_eigen(mods, "column"), Keig)
expect_true(is_homogeneous(mods))
expect_equal(hat(mods, 'row'), Hk)
expect_equal(hat(mods, 'column'), Hk)
expect_false(has_hat(mods))
})

# test labels

# Check label matching

hlabels <- letters[1:5]

Ylh <- Yh
Yls <- Ys
Klh <- Kh

rownames(Ylh) <- colnames(Ylh) <- hlabels
colnames(Yls) <- rownames(Yls) <- hlabels
rownames(Klh) <- colnames(Klh) <- hlabels

idk <- sample(1:5)
idy <- sample(1:5)
Ylh2 <- Ylh[idy, idk]
Klh2 <- Klh[idk, idk]
Yls2 <- Yls[idy, idy]

test_that("Labels are correctly processed in fitting tskrr",{
mod1 <- tskrr(Ylh, Klh)
mod2 <- tskrr(Ylh2, Klh2)
expect_equal(fitted(mod1)[hlabels,hlabels],
fitted(mod2)[hlabels,hlabels])

mod1 <- tskrr(Yls, Klh)
mod2 <- tskrr(Yls2, Klh2)
expect_equal(fitted(mod1)[hlabels,hlabels],
fitted(mod2)[hlabels,hlabels])

})

## Error testing ---------------------------------
Yhwrong <- Yh
Yhwrong[4,5] <- 1
Yswrong <- Ys
Yswrong[4,5] <- Yswrong[5,4] <- 1

test_that("Asymmetry in Y is detected",{
expect_error(tskrr(Yhwrong, Kh),
"The Y matrix is not symmetric")
expect_error(tskrr(Yswrong, Kh),
"The Y matrix is not .* skewed symmetric")
})

## Update --------------------------------------
lambdanew <- 0.001
modhnew <- tskrr(Yh, Kh, lambda = lambdanew)
modsnew <- tskrr(Ys, Kh, lambda = lambdanew)

mod3 <- tskrr(Yh,Kh, lambda = lambdak, keep = TRUE)
modnew3 <- mod3 <- tskrr(Yh,Kh, lambda = lambdanew, keep = TRUE)

test_that("Homogeneous model gets updated correctly",{
expect_error(update(modh, lambda = numeric(0)))
expect_error(update(mods, lambda = c(1,2,3)))
expect_error(update(mods, lambda = c(0.01,0.01)))
expect_equal(update(modh, lambdanew), modhnew)
expect_equal(update(mods, lambdanew), modsnew)
expect_equal(update(mod3, lambdanew), modnew3)

})

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

test_that("loss is calculated correctly",{
expect_equal(loss(modh),loss_mse(response(modh), loo(modh)))
expect_equal(loss(mods, exclusion = "interaction", fun = loss_auc,
replaceby0 = TRUE),
loss_auc(response(mods),
loo(mods, replaceby0 = TRUE)))
expect_equal(loss(modh, predictions = TRUE),
loss_mse(response(modh), fitted(modh)))
})

# predict ------------------------
predh <- Khnew %*% weights(modh) %*% Kh
colnames(predh) <- paste0("row",1:5)

predall <- Khnew %*% weights(modh) %*% t(Khnew)

preds <- Khnew %*% weights(mods) %*% Kh
colnames(preds) <- paste0("row",1:5)

test_that("predict works as intended",{
expect_equal(predh,
predict(modh, Khnew))
expect_equal(preds,
predict(mods, Khnew))
expect_equal(predict(modh, g = Khnew),
t(predh))
expect_equal(predict(modh, Khnew, Khnew),
predall)
})
```

## 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.