tests/testthat/test_find_best_reconstruction_QP.R

In mSigTools: Mutational Signature Analysis Tools

test_that("find_best_reconstruction_QP", {
  set.seed(888)

  sig.u <-
    do.call(
      cbind,
      lapply(1:6, function(x) {
        col <- runif(n = 96)
        col / sum(col)
      })
    )
  rr <- find_best_reconstruction_QP(
    target.sig = sig.u[, 1, drop = FALSE],
    sig.universe = sig.u[, 2:6]
  )
  expect_equal(
    rr,
    list(
      optimized.exposure = c(
        v1 = 0.15100782248532,
        v2 = 0.216715787651364,
        v3 = 0.190986121767107,
        v4 = 0.14072657060392,
        v5 = 0.300563697492289
      ), similarity = 0.847331210949624,
      method = "cosine",
      reconstruction = structure(c(
        0.0114301662612459,
        0.00930436510859448,
        0.0074161436170659,
        0.0112616507496499,
        0.0142365233046149,
        0.00947023062560497,
        0.0118021507152194,
        0.0125194374366477,
        0.0129260361840166,
        0.0121205485784564,
        0.010491790982315,
        0.0104834605880442,
        0.0105645559676245,
        0.00878452831437535,
        0.0126896398110211,
        0.0101899205376878,
        0.00741185519389706,
        0.00698592001858054,
        0.0128991828112455,
        0.0132914656757937,
        0.011600903212254,
        0.00536991644041083,
        0.0144778106835582,
        0.00953147285904634,
        0.00985185323466777,
        0.0144713532991607,
        0.00948832295323217,
        0.00690009978121278,
        0.0119508121964186,
        0.0104972742364501,
        0.0102638006148984,
        0.0138873314899848,
        0.0105839266279803,
        0.00866885650161204,
        0.00676645922656508,
        0.00348195211337881,
        0.0127799429718048,
        0.00862274905146506,
        0.0106942170440089,
        0.00862956093497951,
        0.00567884042557004,
        0.00876632060998466,
        0.0121672853029233,
        0.0124422815248175,
        0.0101161441667255,
        0.00573371022378743,
        0.0162842556698925,
        0.0118803279503694,
        0.00382185550276588,
        0.00832062913448072,
        0.0124614098460189,
        0.0097107613579708,
        0.011909626790727,
        0.0105012761484405,
        0.00989692651174801,
        0.010076048958225,
        0.011447909703729,
        0.0133516888304257,
        0.013623531220678,
        0.0118797394773824,
        0.00988570503383117,
        0.00852771123995669,
        0.00883927400252175,
        0.0089887892729293,
        0.00970027497555247,
        0.00950280040328765,
        0.00694460555824382,
        0.0117795801886014,
        0.0133743291903742,
        0.00910092927322117,
        0.00901008290842858,
        0.00375733664535858,
        0.00796874516310526,
        0.0136151912782524,
        0.0130762559200139,
        0.0143103176979921,
        0.0147036902622388,
        0.00900468467080779,
        0.015480426443105,
        0.00764010252394804,
        0.0109516673986416,
        0.0123181852710029,
        0.00906527020041983,
        0.00862919066174099,
        0.00598805037626349,
        0.0114947802491387,
        0.00867268141617396,
        0.0113116101254132,
        0.0138281309934426,
        0.0130075749741592,
        0.00735643639507294,
        0.014818450208473,
        0.0109799099080076,
        0.00835375535725459,
        0.0132274792249734,
        0.00991723727659945
      ), dim = c(96L, 1L))
    )
  )


  rr <- find_best_reconstruction_QP(
    target.sig = sig.u[, 1, drop = FALSE],
    sig.universe = sig.u[, 2:6],
    max.subset.size = 3
  )
  expect_equal(
    rr,
    list(
      optimized.exposure = c(
        v2 = 0.267215342016367,
        v3 = 0.289072108160467,
        v5 = 0.443712549823166
      ), similarity = 0.839743758070699,
      method = "cosine",
      reconstruction = structure(c(
        0.0131794861258625,
        0.00983448295983261,
        0.00572335151157299,
        0.0134853032917738,
        0.0145384043596867,
        0.0113391644097275,
        0.0116559384109017,
        0.0101975953713167,
        0.0130467058223496,
        0.0117855684217141,
        0.0107120316740257,
        0.011460306330195,
        0.00890558832043344,
        0.00514048533430389,
        0.0116381105909288,
        0.0116404811186833,
        0.00546142115930562,
        0.00674022268552827,
        0.0118256881451552,
        0.0142289332725277,
        0.0105109295734019,
        0.00359371611560218,
        0.0165412230201609,
        0.00773111457785127,
        0.011508466221684,
        0.0148090609171795,
        0.00968210084529323,
        0.00708867254189799,
        0.0126776022787511,
        0.0135235876223755,
        0.0126313870149844,
        0.01452302525738,
        0.00743079187299465,
        0.00868588177860022,
        0.00692856025127275,
        0.00318813745932332,
        0.0122814028359799,
        0.00734434351773129,
        0.0103045141723694,
        0.00764417408733278,
        0.00469108995897255,
        0.00838542450703732,
        0.0131499241040397,
        0.0104828017715111,
        0.00743894934184092,
        0.00467034718383408,
        0.018538468111786,
        0.0127896178314182,
        0.00356449123536001,
        0.00954055037221101,
        0.0111041713011115,
        0.0127383962453531,
        0.0131742013702727,
        0.0117257752747923,
        0.0107927538299954,
        0.00728249789203264,
        0.0104853666881542,
        0.0151965432386596,
        0.0113997342479826,
        0.0121331317608839,
        0.013143569877489,
        0.00912447835163267,
        0.0096319331775115,
        0.00972497426328114,
        0.00940840913077881,
        0.0102198917063494,
        0.0083145860724812,
        0.0105713092099967,
        0.0152150496683584,
        0.00745275361534201,
        0.00815435774752824,
        0.00326598410337081,
        0.00949323391029848,
        0.0123585322734344,
        0.0120070027531501,
        0.0149072370173705,
        0.0145304826652495,
        0.00701690069924947,
        0.0167812435389489,
        0.0070727176776673,
        0.0116089761771863,
        0.0135476994570963,
        0.00705429200073626,
        0.00673989796253599,
        0.00442985508832294,
        0.0112589604590027,
        0.00795252795882955,
        0.0116317605492334,
        0.0138727370719682,
        0.0136995458759461,
        0.00963151925833436,
        0.0152843062480631,
        0.0134253750132936,
        0.00863341724734529,
        0.0144420159979179,
        0.00794026862945921
      ), dim = c(96L, 1L))
    )
  )
})

# cat(gsub("(\\d),", "\\1,\n", foo, perl = TRUE))

test_that("find_best_reconstruction_QP boundary tests", {
  set.seed(888)
  sig.u <-
    do.call(
      cbind,
      lapply(1:6, function(x) {
        col <- runif(n = 96)
        col / sum(col)
      })
    )

  rr <- find_best_reconstruction_QP(
    target.sig = sig.u[, 1, drop = FALSE],
    sig.universe = sig.u
  )
  expect_equal(rr$optimized.exposure, c(v1 = 1))

  rr <- find_best_reconstruction_QP(
    target.sig = sig.u[, 1, drop = FALSE],
    sig.universe = sig.u,
    max.subset.size = 2
  )
  expect_equal(rr$optimized.exposure, c(v1 = 1))

  rr <- find_best_reconstruction_QP(
    target.sig = sig.u[, 1, drop = FALSE],
    sig.universe = sig.u[, 1, drop = FALSE]
  )
  expect_equal(rr$optimized.exposure, c(v1 = 1))

  rr <- find_best_reconstruction_QP(
    target.sig = sig.u[, 1, drop = FALSE],
    sig.universe = sig.u * 2
  )
  expect_equal(rr$optimized.exposure, numeric())

  expect_error( # not positive definite matrix error
    find_best_reconstruction_QP(
      target.sig = sig.u[, 3, drop = FALSE],
      sig.universe = cbind(
        sig.u[, 1, drop = FALSE],
        sig.u[, 1:2, drop = FALSE]
      )
    )
  )

  su <- matrix(c(1, 0, 0, 1, 0.5, 0.5), nrow = 2)
  expect_error( # not positive definite matrix error
    find_best_reconstruction_QP(target.sig = c(10, 10), sig.universe = su)
  )
})