tests/testthat/test-GroupEff_par.R

In MUGS: Multisource Graph Synthesis with EHR Data

library(testthat)
library(parallel)
library(doSNOW)
library(glmnet)
library(Matrix)

testthat::test_that("GroupEff_par works with multiple groups in both sites", {
  set.seed(123)

  # Parameters
  n.MGB <- 10
  n.BCH <- 10
  p <- 5
  n.group <- 4
  n.core <- 2
  lambda <- 0

  # Create name list
  name.list <- paste0("code_", 1:(n.MGB + n.BCH))

  # MGB and BCH codes
  MGB.codes <- name.list[1:n.MGB]
  BCH.codes <- name.list[(n.MGB + 1):(n.MGB + n.BCH)]

  # S.MGB and S.BCH
  S.MGB <- matrix(rnorm(n.MGB^2), nrow = n.MGB)
  S.MGB <- (S.MGB + t(S.MGB)) / 2
  rownames(S.MGB) <- MGB.codes
  colnames(S.MGB) <- MGB.codes

  S.BCH <- matrix(rnorm(n.BCH^2), nrow = n.BCH)
  S.BCH <- (S.BCH + t(S.BCH)) / 2
  rownames(S.BCH) <- BCH.codes
  colnames(S.BCH) <- BCH.codes

  # U and V
  U.MGB <- matrix(rnorm(n.MGB * p), nrow = n.MGB)
  U.BCH <- matrix(rnorm(n.BCH * p), nrow = n.BCH)
  V.MGB <- matrix(rnorm(n.MGB * p), nrow = n.MGB)
  V.BCH <- matrix(rnorm(n.BCH * p), nrow = n.BCH)

  # Define groups
  group.names <- c("group_1", "group_2", "group_3", "group_4")

  X.MGB.group <- matrix(0, nrow = n.MGB, ncol = n.group,
                        dimnames = list(MGB.codes, group.names))
  X.MGB.group[, "group_1"] <- 1
  X.MGB.group[n.MGB - 1, "group_3"] <- 1
  X.MGB.group[n.MGB, "group_4"] <- 1

  X.BCH.group <- matrix(0, nrow = n.BCH, ncol = n.group,
                        dimnames = list(BCH.codes, group.names))
  X.BCH.group[, "group_2"] <- 1
  X.BCH.group[n.BCH - 1, "group_3"] <- 1
  X.BCH.group[n.BCH, "group_4"] <- 1

  beta.int <- matrix(0, nrow = n.group, ncol = p,
                     dimnames = list(group.names, NULL))

  # Run the function
  result <- MUGS::GroupEff_par(
    S.MGB = S.MGB, S.BCH = S.BCH, n.MGB = n.MGB, n.BCH = n.BCH,
    U.MGB = U.MGB, U.BCH = U.BCH, V.MGB = V.MGB, V.BCH = V.BCH,
    X.MGB.group = X.MGB.group, X.BCH.group = X.BCH.group,
    n.group = n.group, name.list = name.list,
    beta.int = beta.int, lambda = lambda, p = p, n.core = n.core
  )

  # Checks
  testthat::expect_type(result, "list")
  testthat::expect_true(all(c("beta", "dif_F", "V.MGB.new", "V.BCH.new") %in% names(result)))
  testthat::expect_equal(dim(result$beta), c(n.group, p))
  testthat::expect_true(is.numeric(result$dif_F))
  testthat::expect_equal(dim(result$V.MGB.new), c(n.MGB, p))
  testthat::expect_equal(dim(result$V.BCH.new), c(n.BCH, p))
})