tests/density_ratio.R

In stewid/SimInf: A Framework for Data-Driven Stochastic Disease Spread Simulations

## This file is part of SimInf, a framework for stochastic
## disease spread simulations.
##
## Copyright (C) 2015 -- 2022 Stefan Widgren
##
## SimInf is free software: you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation, either version 3 of the License, or
## (at your option) any later version.
##
## SimInf is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
## GNU General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with this program.  If not, see <https://www.gnu.org/licenses/>.

library(SimInf)
library(tools)
source("util/check.R")

## Define a tolerance
tol <- 1e-8

res <- assertError(SimInf:::KLIEP(xnu = 1:5))
check_error(res, "'xnu' must be a numeric matrix.")

res <- assertError(SimInf:::KLIEP(xnu = matrix(letters)))
check_error(res, "'xnu' must be a numeric matrix.")

res <- assertError(SimInf:::KLIEP(xnu = matrix(1:5),
                                  xde = 1:5))
check_error(res, "'xde' must be a numeric matrix.")

res <- assertError(SimInf:::KLIEP(xnu = matrix(1:5),
                                  xde = matrix(letters)))
check_error(res, "'xde' must be a numeric matrix.")

res <- assertError(SimInf:::KLIEP(xnu = matrix(1:5),
                                  xde = matrix(1:10, ncol = 2)))
check_error(res, "'xnu' and 'xde' must have the same dimension.")

k_exp <- list(
    centers = matrix(
        c(0.15866887259293, 0.0678276402346609, 0.140392419061464,
          0.297264725500235, 0.194414701474047, 0.136348568491747,
          0.40738289937909, 0.226893928121722, 0.0957028661881928,
          0.199255825468578, 0.0906202016799841, 0.0651901007465582,
          0.340891146381286, 0.0221757252037811, 0.251443293760272,
          0.233696373688884, 0.245285345806801, 0.282122243710531,
          0.183996980651875, 0.155587801061997, 0.23623719736897,
          0.385624453117312, 0.0766884886471079, 0.217190288594464,
          0.272087625521246, 0.191005160486847, 0.176291185042765,
          0.26645299522167, 0.199366909494725, 0.188687665150672,
          0.209050540274438, 0.162332143633923, 0.110247814369777,
          0.174723745274005, 0.192941180078945, 0.156050020488564,
          0.17262122101169, 0.219429265228376, 0.187264664691927,
          0.292336619686751, 0.168645667329794, 0.38603919086155,
          0.142122083866479, 0.0759774352533857, 0.367529364474216,
          0.283510749608552, 0.0863755850544872, 0.315267500971573,
          0.283288311869081, 0.252267470851217, 0.143901238832785,
          0.225396271939338, 0.195764515532828, 0.241329396487559,
          0.38610864675768, 0.273746592096926, 0.236746772291844,
          0.253719705914935, 0.130797636094235, 0.121662679370646,
          0.0978921887152071, 0.319063856330577, 0.137441608707457,
          0.244879577694815, 0.130278292557011, 0.294239291713624,
          0.540738920164133, 0.0745158238185157, 0.0409575255349674,
          0.161926402244349, 0.30689095927618, 0.188308468635559,
          0.207801353962278, 0.141861815352828, 0.312800316971911,
          0.407610355082073, 0.106205843062612, 0.208626668653456,
          0.221705712061752, 0.37907914771765, 0.205768084249932,
          0.143259161148373, 0.148219068865941, 0.124138278373792,
          0.207149312653065, 0.317870994771287, 0.245488958190045,
          0.261707136592386, 0.219646257028471, 0.0753423072309183,
          0.0888801775603571, 0.164757366465784, 0.132298971172881,
          0.186812090357893, 0.183962194121917, 0.228458906250619,
          0.0964876847601211, 0.52094974480679, 0.124497981806903,
          0.191842811335265, 0.0515374062088796, 0.0423087931492029,
          0.136021344641827, 0.211539205414427, 0.124575203763823,
          0.104910939380527, 0.255662481689383, 0.111622455964317,
          0.0590789151177758, 0.0890987214162981, 0.0656564189872087,
          0.0325122458500823, 0.148133093093331, 0.0285428832857261,
          0.108433186961055, 0.123193738499165, 0.119879169818851,
          0.134116543632999, 0.159979420406585, 0.160031744169813,
          0.102443013589625, 0.195547459676763, 0.0366325308080599,
          0.0884917758507539, 0.100595819168217, 0.0648211116294286,
          0.101022618623991, 0.0938443848302465, 0.0820824998035653,
          0.1384129854365, 0.0981588345971509, 0.0780951004908632,
          0.0532600339311397, 0.0754266654215426, 0.0766432975610597,
          0.0756280593781778, 0.105486651851484, 0.119046449484794,
          0.0810388139483554, 0.0747910886165144, 0.0849266860385628,
          0.164388920883296, 0.117010024068742, 0.0674909409846359,
          0.199433752166282, 0.172688651087249, 0.0851615424568608,
          0.162002743603335, 0.234356325079822, 0.0932027534341367,
          0.0961431960412654, 0.195109847073779, 0.0957595833538713,
          0.152480371229507, 0.225506427061178, 0.149819862536592,
          0.0990468959517521, 0.0845553147391475, 0.0893564012949097,
          0.0836900287340116, 0.0642620155669707, 0.157536904523274,
          0.114683945022786, 0.0774623906378795, 0.046271964584089,
          0.0968015628314825, 0.267913675484394, 0.034055638151969,
          0.0611366869107128, 0.0821267584650991, 0.164231315677943,
          0.110397951208684, 0.101164994119577, 0.0762658768913305,
          0.164155964134603, 0.276974860176674, 0.0648854876513018,
          0.0746397850171394, 0.197673097768591, 0.20059932293895,
          0.062554986150949, 0.058377381226075, 0.106652092554706,
          0.0807704115256616, 0.0766435024075708, 0.201904889647503,
          0.1302722829521, 0.163767058143673, 0.112078157618444,
          0.0646474146538829, 0.0536435978452884, 0.110937935009356,
          0.0875181065146079, 0.0665930697567526, 0.117516037265074,
          0.127155750461157, 0.0415853024057675, 0.234418314627975,
          0.103126229751343, 0.110674595150279),
        nrow = 100,
        ncol = 2,
        dimnames = list(NULL, c("beta", "gamma"))),
    sigma = 0.0900000000000001,
    weights = matrix(
        c(0.0380537949460922, 0, 0.00953022456724182, 0,
          0.0545506417191683, 0.0136099531913631, 0,
          0.0599194032745142, 0, 0.0744886113269028, 0, 0, 0, 0,
          0.0453889492172151, 0.0459055541634079, 0.040275497981034,
          0, 0.0215211596779569, 0.00916479725954, 0.0615642382007064,
          0, 0, 0.0759996060092404, 0.0313696976511586,
          0.0719362066942132, 0.0588367276404031, 0.0424801950121562,
          0.0759451255085902, 0.042012366822696, 0.0726088654384141,
          0.04832300333276, 0, 0.0609241805582585, 0.073794155461691,
          0.0405468793392079, 0.0544007225250696, 0.0569824911748279,
          0.0704443800108572, 0.027828374312413, 0.0551391150842738,
          0, 0.0185721709838352, 0, 0, 0, 0, 0, 0, 0.0559589196006985,
          0.0248420024758804, 0, 0.0713512514177033,
          0.0074609129698774, 0, 0, 0.0634950734680829,
          0.0595572971595476, 0.00617316370837994, 0, 0, 0,
          0.0132836792304521, 0.0686726369931549, 0,
          0.00972054508183379, 0, 0, 0, 0.0480090390852202, 0,
          0.0619245756093922, 0.0711300391256782, 0.0213162016924589,
          0, 0, 0, 0.078801044543807, 0, 0, 0.0777348268894596,
          0.0193836921456208, 0.0287989442758535, 0,
          0.0784328304940592, 0, 0.0293327943203392, 0,
          0.0624487923252231, 0, 0, 0.0454635927920055,
          0.00831508026277209, 0.0695836586138719, 0.0558604197545034,
          0.045317672280211, 0, 0, 0, 0.0631340319234454),
        nrow = 100,
        ncol = 1))

xnu <- matrix(
    c(0.209050540274438, 0.0745158238185157, 0.195764515532828,
      0.221705712061752, 0.124138278373792, 0.207801353962278,
      0.106205843062612, 0.407610355082073, 0.15866887259293,
      0.0753423072309183, 0.26645299522167, 0.319063856330577,
      0.162332143633923, 0.244879577694815, 0.192941180078945,
      0.199255825468578, 0.164757366465784, 0.148219068865941,
      0.283510749608552, 0.0759774352533857, 0.245285345806801,
      0.0409575255349674, 0.191005160486847, 0.38610864675768,
      0.176291185042765, 0.132298971172881, 0.137441608707457,
      0.30689095927618, 0.156050020488564, 0.236746772291844,
      0.0221757252037811, 0.155587801061997, 0.183996980651875,
      0.174723745274005, 0.130797636094235, 0.208626668653456,
      0.124497981806903, 0.217190288594464, 0.283288311869081,
      0.187264664691927, 0.205768084249932, 0.0863755850544872,
      0.253719705914935, 0.194414701474047, 0.540738920164133,
      0.312800316971911, 0.188308468635559, 0.0957028661881928,
      0.233696373688884, 0.17262122101169, 0.385624453117312,
      0.315267500971573, 0.142122083866479, 0.143259161148373,
      0.219429265228376, 0.23623719736897, 0.183962194121917,
      0.0906202016799841, 0.136348568491747, 0.191842811335265,
      0.292336619686751, 0.340891146381286, 0.0964876847601211,
      0.294239291713624, 0.251443293760272, 0.317870994771287,
      0.226893928121722, 0.282122243710531, 0.143901238832785,
      0.207149312653065, 0.121662679370646, 0.0651901007465582,
      0.367529364474216, 0.140392419061464, 0.37907914771765,
      0.273746592096926, 0.110247814369777, 0.252267470851217,
      0.168645667329794, 0.0766884886471079, 0.40738289937909,
      0.188687665150672, 0.161926402244349, 0.0978921887152071,
      0.225396271939338, 0.219646257028471, 0.199366909494725,
      0.0678276402346609, 0.0888801775603571, 0.38603919086155,
      0.241329396487559, 0.52094974480679, 0.141861815352828,
      0.297264725500235, 0.228458906250619, 0.245488958190045,
      0.186812090357893, 0.130278292557011, 0.261707136592386,
      0.272087625521246, 0.0981588345971509, 0.034055638151969,
      0.0957595833538713, 0.197673097768591, 0.0807704115256616,
      0.101164994119577, 0.0648854876513018, 0.276974860176674,
      0.0515374062088796, 0.0646474146538829, 0.0938443848302465,
      0.157536904523274, 0.0780951004908632, 0.0774623906378795,
      0.0766432975610597, 0.0890987214162981, 0.110937935009356,
      0.106652092554706, 0.172688651087249, 0.0674909409846359,
      0.119879169818851, 0.0611366869107128, 0.0648211116294286,
      0.225506427061178, 0.101022618623991, 0.0875181065146079,
      0.114683945022786, 0.164231315677943, 0.0756280593781778,
      0.0990468959517521, 0.0285428832857261, 0.160031744169813,
      0.159979420406585, 0.0754266654215426, 0.0893564012949097,
      0.0746397850171394, 0.103126229751343, 0.0884917758507539,
      0.234356325079822, 0.0810388139483554, 0.062554986150949,
      0.0851615424568608, 0.0845553147391475, 0.124575203763823,
      0.267913675484394, 0.164155964134603, 0.110397951208684,
      0.0590789151177758, 0.123193738499165, 0.105486651851484,
      0.195547459676763, 0.162002743603335, 0.117010024068742,
      0.058377381226075, 0.119046449484794, 0.102443013589625,
      0.117516037265074, 0.0656564189872087, 0.104910939380527,
      0.110674595150279, 0.0747910886165144, 0.148133093093331,
      0.0415853024057675, 0.0968015628314825, 0.108433186961055,
      0.201904889647503, 0.111622455964317, 0.134116543632999,
      0.0961431960412654, 0.0766435024075708, 0.0836900287340116,
      0.0325122458500823, 0.199433752166282, 0.136021344641827,
      0.20059932293895, 0.149819862536592, 0.0532600339311397,
      0.0932027534341367, 0.0849266860385628, 0.0366325308080599,
      0.255662481689383, 0.1384129854365, 0.0821267584650991,
      0.0642620155669707, 0.195109847073779, 0.112078157618444,
      0.0820824998035653, 0.0423087931492029, 0.0536435978452884,
      0.164388920883296, 0.152480371229507, 0.234418314627975,
      0.0762658768913305, 0.211539205414427, 0.127155750461157,
      0.1302722829521, 0.0665930697567526, 0.046271964584089,
      0.163767058143673, 0.100595819168217),
    nrow = 100,
    ncol = 2,
    dimnames = list(NULL, c("beta", "gamma")))

xde <- matrix(
    c(0.183272171962524, 0.286665854223967, 0.479837846249473,
      0.15601028828712, 0.210449104820306, 0.783545816658709,
      0.20797940639307, 0.356683426219085, 0.174441339991796,
      0.311472528406188, 0.312618137380801, 0.0764995733272139,
      0.445794125231028, 0.181688103349505, 0.232886057681369,
      0.283768372036866, 0.136282146610161, 0.130875140564847,
      0.396320561618403, 0.241626604403328, 0.231073853690387,
      0.250068793970613, 0.0562589357124645, 0.233741831667209,
      0.0768013963609406, 0.416998012704813, 0.321633596667585,
      0.274946732909724, 0.492343227281947, 0.234760541331245,
      0.0351504294300505, 0.00462768118336318, 0.0549215455189399,
      0.168813987089903, 0.548363336740293, 0.3373051316121,
      0.285282623594898, 0.502790385072833, 0.305245346654149,
      0.209850450558834, 0.203891991490068, 0.251780046254595,
      0.135496909941293, 0.358540661201862, 0.434559157406459,
      0.267177639704822, 0.110925026213855, 0.172477486884074,
      0.389471792384217, 0.0475096473225209, 0.592008618510323,
      0.0637834715323238, 0.351755175160943, 0.532296078329972,
      0.142965758271128, 0.0798802260203365, 0.358967523980154,
      0.0610254436494506, 0.056619739579847, 0.28894717625466,
      0.541032702513395, 0.353258909142117, 0.118184847740171,
      0.0207455042648753, 0.366648262596299, 0.35258359702782,
      0.231298963794709, 0.73859718912455, 0.437310232535087,
      0.0268394414426883, 0.0439902222869838, 0.239840969915543,
      0.426775966522104, 0.162472728645736, 0.418788595043238,
      0.0443641413560885, 0.164514549442556, 0.276091283834601,
      0.00331618899316374, 0.0614586408797554, 0.211634019686239,
      0.272021910006331, 0.0286906399781307, 0.195913973197248,
      0.243870747037428, 0.084509092537688, 0.156602956261581,
      0.48830001923963, 0.393990923407287, 0.279027935004963,
      0.306421507881298, 0.451536031671576, 0.358163801994629,
      0.470943230882583, 0.293392541192592, 0.250669697018224,
      0.331150464295294, 0.110199032567371, 0.294061514519004,
      0.11314871862894, 0.164885570883981, 0.347195849130311,
      0.257499279206768, 0.138463692230449, 0.102678219062226,
      0.491185912902041, 0.182903902689719, 0.267972456314478,
      0.0788761659332474, 0.224842131926287, 0.142627875968024,
      0.15057723513501, 0.319577154865769, 0.111643597522549,
      0.0876810863434334, 0.265308620596188, 0.0767476628197823,
      0.18711334426653, 0.173775718516814, 0.128033395103158,
      0.0758075168228626, 0.16828057083199, 0.0401116317192869,
      0.0715031228906515, 0.157456291177569, 0.233224805571622,
      0.306633945820197, 0.088383999557897, 0.432319573117717,
      0.0807740526515329, 0.0182882702152279, 0.0141829165881729,
      0.0189098241003207, 0.0974922622343302, 0.358440922746488,
      0.195073677830819, 0.161261414165878, 0.203945348967322,
      0.0997170568342017, 0.130186595008833, 0.166832857126262,
      0.140843092109321, 0.068682860907081, 0.190780880742505,
      0.364803478566964, 0.161017679173967, 0.0437058713706013,
      0.0735456293352288, 0.152536232301707, 0.116827591730613,
      0.23819803120759, 0.0432207498853736, 0.159725795711559,
      0.286682454237269, 0.0597053540590569, 0.215466962204395,
      0.20396405150408, 0.0322257280624139, 0.0456879729855247,
      0.127343771245382, 0.416697666000963, 0.20967964395221,
      0.0616185025223351, 0.0103845548040148, 0.264579874016758,
      0.180492900785837, 0.136746194538531, 0.448328820930334,
      0.299207524915843, 0.0279952094744666, 0.0256522139211944,
      0.193761077397201, 0.194230298812302, 0.0804125031635778,
      0.343782538933508, 0.0525677626216369, 0.0573410031198289,
      0.184950750217791, 0.021153881397456, 0.172437288231969,
      0.0863828398130232, 0.172160387428454, 0.0200048840605435,
      0.112990049529548, 0.150022327520234, 0.0579606391142452,
      0.0913381637972474, 0.278382953069656, 0.202267792334234,
      0.144094255439136, 0.204313686321642, 0.193647935188636,
      0.207302861287417, 0.235093953556966, 0.139972345981802,
      0.105469221608851, 0.235051656339251, 0.0974422975213154,
      0.0644462895894134, 0.130574863299273),
    nrow = 100,
    ncol = 2,
    dimnames = list(NULL, c("beta", "gamma")))

set.seed(22)
k_obs <- SimInf:::KLIEP(xnu, xde)

stopifnot(all(abs(k_exp$centers - k_obs$centers) < tol))
stopifnot(all(abs(k_exp$sigma - k_obs$sigma) < tol))
stopifnot(all(abs(k_exp$weights - k_obs$weights) < tol))