tests/abc.R

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

##
## Generate proposals without particles from the previous generation.
##

proposals_exp <- matrix(c(0.788305135443807,    0.4089769218117,
                          0.883017404004931,    0.940467284293845,
                          0.0455564993899316,   0.528105488047004,
                          0.892419044394046,    0.551435014465824,
                          0.456614735303447,    0.956833345349878,
                          0.453334156190977,    0.677570635452867,
                          0.572633401956409,    0.102924682665616,
                          0.899824970401824,    0.24608773435466,
                          0.0420595335308462,   0.327920719282702,
                          0.954503649147227,    0.889539316063747,
                          0.6928034061566,      0.640506813768297,
                          0.994269776623696,    0.655705799115822,
                          0.708530468167737,    0.544066024711356,
                          0.59414202044718,     0.28915973729454,
                          0.147113647311926,    0.963024232536554,
                          0.902299045119435,    0.690705278422683,
                          0.795467417687178,    0.0246136845089495,
                          0.477795971091837,    0.758459537522867,
                          0.216407935833558,    0.318181007634848,
                          0.231625785352662,    0.142800022382289,
                          0.414546335814521,    0.413724326295778,
                          0.368845450924709,    0.152444747742265,
                          0.13880606344901,     0.233034099452198,
                          0.465962450252846,    0.265972640365362,
                          0.857827715342864,    0.0458311666734517,
                          0.442200074205175,    0.798924845643342,
                          0.12189925997518,     0.560947983758524,
                          0.20653138961643,     0.127531650243327,
                          0.753307864302769,    0.895045359153301,
                          0.374462775886059,    0.665115194628015,
                          0.0948406609240919,   0.383969637798145,
                          0.27438364457339,     0.814640038879588,
                          0.448516341391951,    0.810064353048801,
                          0.812389509519562,    0.794342321110889,
                          0.439831687603146,    0.754475158639252,
                          0.629221131559461,    0.710182401351631,
                          0.000624773325398564, 0.475316574098542,
                          0.220118885161355,    0.379816537722945,
                          0.612771003274247,    0.351797909243032,
                          0.111135424347594,    0.243619472719729,
                          0.66805558744818,     0.417646779678762,
                          0.788195834029466,    0.102864644257352,
                          0.434892741497606,    0.984956979984418,
                          0.893051114398986,    0.886469060787931,
                          0.175052650272846,    0.130695691565052,
                          0.653101925039664,    0.343516472261399,
                          0.656758127966896,    0.320373242488131,
                          0.187691119266674,    0.782294301316142,
                          0.0935949867125601,   0.46677904156968,
                          0.511505459900945,    0.59998895926401,
                          0.332823540316895,    0.488613033667207,
                          0.954473827499896,    0.4829023971688,
                          0.890350222121924,    0.914438186911866,
                          0.608734982321039,    0.410689776530489,
                          0.147094690939412,    0.935299803270027,
                          0.301228899974376,    0.0607205715496093,
                          0.947726940037683,    0.720596273429692,
                          0.142294295597821,    0.549284656066447,
                          0.95409123855643,     0.585483353119344,
                          0.404510281747207,    0.64789347932674,
                          0.319820617092773,    0.307720010867342,
                          0.219767631264403,    0.369488865835592,
                          0.984219203470275,    0.154202300822362,
                          0.0910439998842776,   0.141906907781959,
                          0.690007101511583,    0.619256483390927,
                          0.891394117148593,    0.672999092610553,
                          0.737077737925574,    0.521135725779459,
                          0.65983844967559,     0.821805460145697,
                          0.786281551700085,    0.979821917368099,
                          0.439431536244228,    0.31170220207423,
                          0.409474952612072,    0.0104671118315309,
                          0.18384952400811,     0.842729318886995,
                          0.231161782052368,    0.239099955651909,
                          0.0766911653336138,   0.245723678031936,
                          0.73213520552963,     0.847453165100887,
                          0.497527267085388,    0.387909029843286,
                          0.246448994148523,    0.111096461303532,
                          0.389994435245171,    0.571935313986614,
                          0.216892762808129,    0.44476800202392,
                          0.21799066872336,     0.502299563260749,
                          0.353904571849853,    0.64998515881598,
                          0.374713956611231,    0.355445380788296,
                          0.533687945455313,    0.740334360394627,
                          0.221102937823161,    0.41274611861445,
                          0.265686686849222,    0.629973053466529,
                          0.183828490786254,    0.86364411143586,
                          0.746568004135042,    0.668284649727866,
                          0.618017873261124,    0.372238060226664,
                          0.529835685854778,    0.874682342866436,
                          0.581750099780038,    0.839767764788121,
                          0.312448164913803,    0.70829032221809,
                          0.265017806086689,    0.594343194039539,
                          0.481289800489321,    0.26503273146227,
                          0.564590434776619,    0.913188223028556,
                          0.901874389499426,    0.274166621500626,
                          0.321482756407931,    0.985640884377062,
                          0.619993310188875,    0.937314089154825,
                          0.466532702324912,    0.406832593260333,
                          0.659230324206874,    0.152346616843715,
                          0.572867058217525,    0.238726026844233),
                        nrow = 100, ncol = 2, byrow = TRUE,
                        dimnames = list(NULL, c("beta", "gamma")))

attr(proposals_exp, "ancestor") <- rep(NA_integer_, 100)

set.seed(123)
proposals_obs <-
    .Call(SimInf:::SimInf_abc_proposals, ## function
          c("beta", "gamma"),            ## parameter
          c("uniform", "uniform"),       ## distribution
          c(0, 0),                       ## p1
          c(1, 1),                       ## p2
          100L,                          ## n
          NULL,                          ## x
          NULL,                          ## w
          NULL)                          ## sigma

stopifnot(identical(dim(proposals_obs), dim(proposals_exp)))
stopifnot(identical(dimnames(proposals_obs), dimnames(proposals_exp)))
stopifnot(all(abs(proposals_obs - proposals_exp) < tol))
stopifnot(identical(attr(proposals_obs, "ancestor"),
                    attr(proposals_exp, "ancestor")))

##
## Determine weights for the proposals
##

w_exp <- rep(0.01, 100)

w_obs <- .Call(SimInf:::SimInf_abc_weights, ## function
               c("uniform", "uniform"),     ## distribution
               c(0, 0),                     ## p1
               c(1, 1),                     ## p2
               NULL,                        ## x
               proposals_obs,               ## xx
               NULL,                        ## w
               NULL)                        ## sigma

stopifnot(identical(length(w_obs), length(w_exp)))
stopifnot(all(abs(w_obs - w_exp) < tol))

##
## Generate proposals with particles from a previous generation.
##

proposals_exp <- matrix(c(0.40449021397453,    0.209258724620122,
                          0.36482482505885,    0.177208382897285,
                          0.110673292350425,   0.0794986914792483,
                          0.187167868494588,   0.138234511613991,
                          0.0129193391123231,  0.0535672393807684,
                          0.371875050064337,   0.134845566874378,
                          0.247248031392758,   0.126673609970299,
                          0.183642149340511,   0.0731331396573393,
                          0.20911740588746,    0.0948903274398692,
                          0.262342094567642,   0.125179104685734,
                          0.177528318171729,   0.0741054597654854,
                          0.156151696536369,   0.090429058755398,
                          0.2878964747592,     0.144758670272637,
                          0.115570346272429,   0.096959225400175,
                          0.35527286855174,    0.161557776257793,
                          0.0650153072101651,  0.00255140678233257,
                          0.372258330220992,   0.133720658379678,
                          0.402004557396214,   0.190127049086695,
                          0.288281903108544,   0.150967395091388,
                          0.177909054629067,   0.0998662267148997,
                          0.336508383404385,   0.193255960409785,
                          0.493830751357006,   0.235285023981504,
                          0.150045602591045,   0.0978408919339508,
                          0.0991368666223921,  0.114314801264312,
                          0.218399403384471,   0.0989904109886274,
                          0.185099330012481,   0.0892108392300413,
                          0.161944605578993,   0.0604990966997036,
                          0.222789306144925,   0.151835826025647,
                          0.065428159161678,   0.0629737938634062,
                          0.23615906645682,    0.102537558499362,
                          0.0121276214604985,  0.0628933335766671,
                          0.201775823307792,   0.126217268774852,
                          0.137263474185558,   0.112391434285224,
                          0.264624142608849,   0.169454608095463,
                          0.312728091948025,   0.0963945630588326,
                          0.175526458577421,   0.0686229881214495,
                          0.0593637021715585,  0.0522592803469739,
                          0.215230839090112,   0.155696377876435,
                          0.0529094844818739,  0.0320773020404419,
                          0.33619295761988,    0.179355314279367,
                          0.181477854077582,   0.10047336472656,
                          0.21069018904093,    0.14241445146947,
                          0.139211751314129,   0.0689293727497798,
                          0.352694196052565,   0.16279166759017,
                          0.226482666581105,   0.126181747015655,
                          0.269213756712608,   0.134008000696826,
                          0.0819893183892228,  0.0804205926286409,
                          0.316344402602474,   0.141277619454973,
                          0.0415392652110742,  0.064295265585175,
                          0.0578856463374477,  0.087630895538036,
                          0.200832741112366,   0.096648847157614,
                          0.148811803643498,   0.0750742362153645,
                          0.191379030672455,   0.115737154467271,
                          0.161899095545659,   0.0750730031877879,
                          0.309156788420073,   0.168264661165334,
                          0.0859624973882138,  0.030587660584528,
                          0.0603779474270183,  0.0454745455018321,
                          0.350172184371153,   0.176682327720304,
                          0.122998229064858,   0.0882698562573068,
                          0.241334749076453,   0.147564901163679,
                          0.0766590044181838,  0.0434986125841068,
                          0.348278201059334,   0.191013869028047,
                          0.257268077430999,   0.179321515928957,
                          0.223064948567959,   0.0592622522014079,
                          0.427815559979751,   0.175047967508291,
                          0.235672458510888,   0.121165312322979,
                          0.167714899755654,   0.0903647430326278,
                          0.0915963546018915,  0.0651409817705193,
                          0.218331597808469,   0.104343950311149,
                          0.280915332879878,   0.126599331161323,
                          0.106748273493958,   0.0870869332381226,
                          0.267450910188283,   0.165256775670049,
                          0.0903771196756504,  0.0498756856503441,
                          0.258634833807708,   0.134139700799639,
                          0.0295659758705841,  0.0775270276812072,
                          0.227391392219538,   0.0816484593169099,
                          0.130314347249228,   0.029628912819613,
                          0.159126993527458,   0.0856407681638652,
                          0.290396981413321,   0.143042180482158,
                          0.0373833335256739,  0.0680495387444054,
                          0.302136009179183,   0.161372082543716,
                          0.442464566486759,   0.197717305508349,
                          0.220956904210761,   0.132325899715497,
                          0.383435091126591,   0.189195961844464,
                          0.00381862106974051, 0.0320324001946579,
                          0.193629157284585,   0.131457415291685,
                          0.124570282588458,   0.114510381022667,
                          0.247574724494243,   0.146305479285253,
                          0.135945749855924,   0.0830472764106766,
                          0.221986437891198,   0.161642051632531,
                          0.101839500171702,   0.0763136426325731,
                          0.145580556982575,   0.0920176018942565,
                          0.0931858029996674,  0.0538420972542555,
                          0.224730087525381,   0.105317389453258,
                          0.225838257380999,   0.133549398107083,
                          0.306352939853714,   0.188866355047975,
                          0.247124496788588,   0.125364413806328,
                          0.21457415007365,    0.0886153625185365,
                          0.234312573547032,   0.101556928688184,
                          0.352387419464283,   0.16910808806427),
                        nrow = 100, ncol = 2, byrow = TRUE,
                        dimnames = list(NULL, c("beta", "gamma")))

attr(proposals_exp, "ancestor") <-
    c(6L, 3L, 9L, 9L, 2L, 6L, 9L, 6L, 3L, 9L, 3L, 6L, 6L, 2L, 9L, 3L,
      3L, 9L, 9L, 6L, 6L, 9L, 6L, 6L, 6L, 6L, 3L, 2L, 9L, 9L, 6L, 6L,
      2L, 3L, 3L, 3L, 3L, 2L, 3L, 3L, 3L, 2L, 3L, 3L, 3L, 9L, 2L, 3L,
      6L, 2L, 6L, 3L, 2L, 6L, 3L, 6L, 2L, 3L, 3L, 9L, 3L, 9L, 9L, 6L,
      3L, 6L, 6L, 6L, 2L, 3L, 3L, 3L, 6L, 3L, 2L, 3L, 6L, 3L, 6L, 2L,
      3L, 9L, 9L, 9L, 2L, 2L, 6L, 3L, 6L, 3L, 2L, 6L, 2L, 3L, 6L, 6L,
      3L, 3L, 9L, 3L)

sigma <- matrix(c(0.0111588476485889,  0.00441287501075721,
                  0.00441287501075721, 0.00237388735640902),
                nrow = 2, ncol = 2, byrow = TRUE,
                dimnames = list(c("beta", "gamma"), c("beta", "gamma")))

w <- c(0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1)

x <- matrix(c(0.100721582304686,  0.0719040972180665,
              0.120237128576264,  0.0883633010089397,
              0.241502250079066,  0.118690322386101,
              0.196719169151038,  0.111476795747876,
              0.0473383399657905, 0.0265292769763619,
              0.142388037405908,  0.0744408417958766,
              0.118218665011227,  0.103439392056316,
              0.246003416366875,  0.0970179655123502,
              0.277967476984486,  0.150379287777469,
              0.126839369302616, 0.0596327660605311),
            nrow = 10, ncol = 2, byrow = TRUE,
            dimnames = list(NULL, c("beta", "gamma")))

set.seed(123)
proposals_obs <-
    .Call(SimInf:::SimInf_abc_proposals, ## function
          c("beta", "gamma"),            ## parameter
          c("uniform", "uniform"),       ## distribution
          c(0, 0),                       ## p1
          c(1, 1),                       ## p2
          100L,                          ## n
          x,                             ## x
          w,                             ## w
          sigma)                         ## sigma

stopifnot(identical(dim(proposals_obs), dim(proposals_exp)))
stopifnot(identical(dimnames(proposals_obs), dimnames(proposals_exp)))
stopifnot(all(abs(proposals_obs - proposals_exp) < tol))
stopifnot(identical(attr(proposals_obs, "ancestor"),
                    attr(proposals_exp, "ancestor")))

##
## Determine particle weights with particles from a previous
## generation.
##

w <- c(0.0887036508782177, 0.166359113528729, 0.0837072024175504,
       0.0744001632010883, 0.135889593166249, 0.0855856292642815,
       0.0982428712389774, 0.108701885332761, 0.0751630561589793,
       0.0832468348131658)

sigma <- matrix(c(0.00492214698840636, 0.00214848981388495,
                  0.00214848981388495, 0.00148131946857759),
                nrow = 2, ncol = 2, byrow = TRUE,
                dimnames = list(c("beta", "gamma"), c("beta", "gamma")))

x <- matrix(c(0.181656674010934, 0.088313908707635,
              0.13237129296898,  0.0653391855550409,
              0.13237129296898,  0.0653391855550409,
              0.13237129296898,  0.0653391855550409,
              0.164534995786719, 0.102338963629853,
              0.253254773828567, 0.0945404905257672,
              0.164534995786719, 0.102338963629853,
              0.181656674010934, 0.088313908707635,
              0.164534995786719, 0.102338963629853,
              0.253254773828567, 0.0945404905257672),
            nrow = 10, ncol = 2, byrow = TRUE,
            dimnames = list(NULL, c("beta", "gamma")))

xx <- matrix(c(0.207941308990465,  0.110336421309656,
               0.123214899415275,  0.0707943094184964,
               0.106876498007091,  0.0521419601364841,
               0.0817667562688388, 0.0384318357782007,
               0.13190369503059,   0.0784629457261605,
               0.231164237650949,  0.0977418120716123,
               0.187665128906516,  0.0899812114257998,
               0.17464412045458,   0.0826845340300653,
               0.178604586453451,  0.120632356669452,
               0.208363762292826, 0.105931947092043),
             nrow = 10, ncol = 2, byrow = TRUE,
             dimnames = list(NULL, c("beta", "gamma")))

w_exp <- c(0.0923963866851073, 0.0836785669165191, 0.100309975935471,
           0.139249040595048, 0.08154757535186, 0.122518476357057,
           0.0807798908697413, 0.0785544941015971, 0.13056926565214,
           0.0903963275354594)

w_obs <- .Call(SimInf:::SimInf_abc_weights, ## function
               c("uniform", "uniform"),     ## distribution
               c(0, 0),                     ## p1
               c(1, 1),                     ## p2
               x,                           ## x
               xx,                          ## xx
               w,                           ## w
               sigma)                       ## sigma

stopifnot(identical(length(w_obs), length(w_exp)))
stopifnot(all(abs(w_obs - w_exp) < tol))

##
## Check that an invalid 'distribution' is detected.
##
res <- assertError(
    .Call(SimInf:::SimInf_abc_weights, ## function
          "a",                         ## distribution (invalid)
          0,                           ## p1
          0,                           ## p2
          x,                           ## x
          xx,                          ## xx
          w,                           ## w
          sigma))                      ## sigma
check_error(res, "Unknown distribution.")

##
## Check that it works to use a gamma distribution for the proposals.
##
set.seed(123)
proposals_exp <- matrix(
    c(121.276958026798, 135.226111526571, 50.0608928839561,
      99.026703921349, 155.215472878808, 109.737500944335,
      60.0091438721518, 49.2206033058395, 136.474675481633,
      106.413871945226, 107.754150099189, 98.4420970793161,
      78.6402240451908, 139.098313398995, 122.148636952499,
      93.29139417767, 80.9864194166459, 88.4630763817778,
      66.0081318785976, 92.3853209979804, 50.1249564939848,
      62.4717320740012, 63.158652859414, 85.3912889151501,
      86.1229540420162, 91.0531624988248, 122.010318305364,
      117.410881625831, 112.839950617046, 93.1013355716318,
      104.037295209279, 61.1054179733021, 88.6996330858316,
      90.0144916130854, 135.879819760401, 63.5369008383957,
      107.848052867766, 69.6426105934016, 92.447768799244,
      82.1477056461401, 93.6832384540696, 103.698087374237,
      65.4192775797346, 53.2608207538562, 64.8808971531191,
      101.772343053721, 107.0615900602, 80.1481734870256,
      172.820347168567, 58.3237080596067, 104.585705127255,
      109.316983192402, 96.6407236074985, 125.552635673176,
      168.694971762368, 80.4681820354317, 69.2642980395984,
      74.3983787452227, 115.046380711507, 94.8090527724932,
      61.1003325370593, 72.4062993620932, 95.1777472059826,
      107.246241967593, 83.9189626963106, 72.7904320016698,
      105.501405100422, 131.814488410219, 108.886651704555,
      85.2196923468244, 101.467307888719, 80.5279999858835,
      102.500688357744, 76.6323000623859, 139.006679836589,
      81.2494406295684, 148.110470354515, 87.8741136774812,
      100.7456878299, 157.734303060981, 96.1650133533107,
      134.712273479757, 78.5646757768523, 93.6172210533339,
      109.443334449738, 111.932724563851, 88.0353929988547,
      78.0941759541126, 110.556760626146, 86.9859186312889,
      111.683664814931, 104.508903382769, 98.2850776999855,
      76.2783750257764, 126.957683883533, 123.141669446248,
      108.346657967421, 105.767089522976, 114.27236205513,
      161.436490159227),
    nrow = 100, ncol = 1, dimnames = list(NULL, "beta"))

attr(proposals_exp, "ancestor") <- rep(NA_integer_, 100)

proposals_obs <- .Call(SimInf:::SimInf_abc_proposals, ## function
                       "beta",                        ## parameter
                       "gamma",                       ## distribution
                       10,                            ## p1
                       0.1,                           ## p2
                       100L,                          ## n
                       NULL,                          ## x
                       NULL,                          ## w
                       NULL)                          ## sigma

stopifnot(all(abs(proposals_obs - proposals_exp) < tol))

proposals_exp <- matrix(
    c(195.005336846255, 140.901856658208, 154.907184516442,
      141.727518910812, 38.8627963471009, 97.4310586052267,
      77.9025517251395, 161.553738349774, 14.6661883074001,
      138.538188048932, 135.791097877793, 26.8124231064739,
      58.2166821923673, 88.9042366085132, 125.392952230297,
      36.4609319468952, 87.3801617715897, 44.450678744187,
      121.338336949295, 81.7396336435478, 85.8797448305749,
      65.9594817591945, 119.222178557239, 88.7666717784036,
      161.215764012589, 144.907147873647, 93.1307406434064,
      128.658939113042, 106.441515784153, 97.5774119114729,
      47.0868669053793, 38.6724597152766, 60.0168467240897,
      127.171904393379, 25.6809402954593, 107.766033910909,
      47.0098212565299, 66.8680237581495, 73.3515474282523,
      106.457640635664, 110.921501906587, 205.691203703484,
      156.995403049369, 156.271004316669, 62.4625040304671,
      82.9020590751595, 121.916803758159, 96.378331880152,
      185.349514517733, 80.596742844214, 92.3981388259838,
      94.0004606629752, 66.0515508010587, 37.3968637643038,
      38.1447180927324, 118.130218920069, 145.276845109855,
      67.7079233919813, 91.3783382695343, 22.210128875797,
      44.2076870110467, 195.260355686186, 74.6184146825141,
      177.573584431022, 140.835447969089, 126.947780191398,
      61.5761331369285, 144.305281196236, 39.3401179774552,
      112.535377741002, 146.891864943471, 3.69622962315792,
      39.4318184166903, 33.317670867482, 29.30667571148,
      144.360016400905, 140.576403248937, 108.256040447012,
      4.96692849268332, 75.4542720813571, 134.799250355623,
      141.590525114084, 31.6742831157865, 122.63568014853,
      143.086340668081, 138.252218077257, 48.2821523236046,
      57.4456206901338, 36.0037611028634, 121.776246615544,
      112.778325036825, 61.3014719001834, 60.6066480472759,
      121.09400043126, 103.265776758772, 60.5899765586154,
      90.830668022743, 105.691068362283, 88.0208565279985,
      69.5282553651992),
    nrow = 100, ncol = 1, dimnames = list(NULL, "beta"))

attr(proposals_exp, "ancestor") <-
    c(79L, 41L, 89L, 95L, 4L, 51L, 89L, 54L, 44L, 95L, 44L, 66L, 57L,
      10L, 89L, 23L, 4L, 32L, 95L, 89L, 69L, 63L, 99L, 66L, 69L, 54L,
      60L, 29L, 13L, 95L, 89L, 69L, 1L, 48L, 76L, 23L, 32L, 23L, 13L,
      41L, 41L, 35L, 16L, 13L, 23L, 48L, 26L, 86L, 4L, 44L, 79L, 13L,
      57L, 19L, 13L, 76L, 89L, 66L, 10L, 38L, 26L, 82L, 44L, 82L, 82L,
      79L, 44L, 76L, 63L, 73L, 1L, 48L, 23L, 38L, 60L, 35L, 10L, 23L,
      66L, 41L, 79L, 10L, 44L, 99L, 89L, 89L, 16L, 13L, 66L, 35L, 66L,
      32L, 19L, 79L, 10L, 48L, 51L, 60L, 32L, 48L)

x <- proposals_obs
sigma <- 2 * cov(x)
set.seed(123)
proposals_obs <- .Call(SimInf:::SimInf_abc_proposals, ## function
                       "beta",                        ## parameter
                       "gamma",                       ## distribution
                       10,                            ## p1
                       0.1,                           ## p2
                       100L,                          ## n
                       x,                             ## x
                       rep(0.01, 100),                ## w
                       sigma)                         ## sigma

stopifnot(all(abs(proposals_obs - proposals_exp) < tol))

w_exp <-
    c(0.00651534674717087, 0.00984796740883172, 0.00837633901987569,
      0.00974951167168201, 0.00278220798043043, 0.0155575235280236,
      0.0152955767286177, 0.00782971162134828, 1.08450996490866e-05,
      0.0101374234187459, 0.0104874043706198, 0.000471362147479918,
      0.010039155098466, 0.015946517384311, 0.0119218523425067,
      0.00212726267952287, 0.0159435097489079, 0.00463101738461317,
      0.0125123478192166, 0.0156975911661324, 0.0159153946288713,
      0.0127043058985561, 0.0128227314478057, 0.0159472657242274,
      0.00785514716156604, 0.00938364135901829, 0.0158323412720233,
      0.0114557332641912, 0.0146082203934316, 0.0155457556084599,
      0.00562342343268247, 0.00272692808985884, 0.0107118965247735,
      0.0116665764386191, 0.000371884012831849, 0.0144388327309886,
      0.00559364440093777, 0.012971812046599, 0.0145495783097439,
      0.0146061930791147, 0.0140152650272004, 0.00660209791824104,
      0.00819402858322751, 0.00825617118399543, 0.0115789747602285,
      0.0157804696048089, 0.0124276183858865, 0.0156377738844014,
      0.00665373930369284, 0.0155987993282588, 0.0158641257942813,
      0.015788585386551, 0.0127319040306528, 0.00237129878282316,
      0.00257663423008185, 0.0129827571322452, 0.00934249530924648,
      0.0132093694191666, 0.0159003122141, 0.000160671246114197,
      0.00454270566789663, 0.00651439471946911, 0.0147873168565003,
      0.00690693996069261, 0.00985594685087353, 0.0116985669592717,
      0.011271619423175, 0.00945125415014257, 0.00292329993088291,
      0.0137900519504907, 0.00916621317183316, 2.13578824730994e-10,
      0.0029508041752752, 0.00141656611045132, 0.000754289856796076,
      0.00944507326311541, 0.00988715841702764, 0.0143747856285377,
      2.5354782960133e-09, 0.0149314073605162, 0.0106171613156254,
      0.00976575058511817, 0.00111263535838425, 0.0123224815498804,
      0.00959055004797866, 0.0101731901822058, 0.00609012404850771,
      0.00974356928499434, 0.00201338985696298, 0.0124481970836683,
      0.0137557517117914, 0.0111747332836431, 0.0109263230245733,
      0.0125481621414489, 0.0149882002226354, 0.0109203059677858,
      0.0159157334572017, 0.0147015558158957, 0.0159478292853504,
      0.0136910878586874)

x <- x[attr(proposals_obs, "ancestor"), , drop = FALSE]
xx <- proposals_obs
w_obs <- .Call(SimInf:::SimInf_abc_weights, ## function
               "gamma",                    ## distribution
               10,                          ## p1
               0.1,                         ## p2
               x,                           ## x
               xx,                          ## xx
               rep(0.01, 100),              ## w
               sigma)                       ## sigma

stopifnot(all(abs(w_obs - w_exp) < tol))

##
## Check that it works to use a normal distribution for the proposals.
##
set.seed(123)
proposals_exp <- matrix(
    c(10.0800554282007, 10.1190206626991, 9.83104443359712,
      10.1239495885998, 9.98910340276845, 9.9882758038212,
      10.0183082613838, 10.1280554878202, 9.82727293711329,
      10.1690184353646, 10.0503812447155, 10.2528336550704,
      10.0549096735636, 10.0238212920794, 9.89511068564135,
      10.1294763254584, 10.0825539843874, 9.99443139882799,
      9.92156177824118, 9.92664967774085, 9.97841346059533,
      9.96650872422866, 9.89143008646971, 9.99145767355659,
      10.1070610538271, 9.98546064490073, 9.883445515211,
      9.91814842774869, 10.0684936077925, 9.96799435807232,
      9.86884775886032, 9.9400391672056, 9.98705893109928,
      10.0886736147004, 9.98486040376642, 10.0329791200758,
      9.67726771702325, 9.92282082287538, 10.0286548567354,
      9.87794880176339, 10.0434550377113, 10.0800176865835,
      9.9836069031357, 10.1242918774937, 9.90656149419448,
      10.0393708652216, 10.0403631455697, 9.91135632835832,
      9.86810623964634, 10.0028843908516, 9.95678702065287,
      10.1689872518646, 10.1228392782136, 10.0276023478266,
      9.89510244955269, 9.94791306561671, 10.1623202521731,
      9.89299317706557, 10.1685887244205, 9.9758310232261,
      9.95317995213595, 9.92270217718191, 10.2149919335756,
      9.86656463717927, 10.0495870479997, 10.1233976240157,
      10.0634362124806, 10.0412022274758, 10.0793585307679,
      9.98475893669352, 9.97711041848692, 9.90992082494195,
      9.92649738442157, 9.85723142164066, 10.0619283534849,
      9.99938017377304, 9.9314293154307, 9.97206664723628,
      9.92172697247167, 9.92210027602678, 9.96251999068716,
      9.96806061911706, 10.0084543768051, 9.92315263970603,
      9.93740890869283, 9.90991291447621, 10.0663728669675,
      10.030027911812, 10.0074856823862, 10.0206372695351,
      9.95110771647057, 9.93720483421767, 9.99530832735717,
      10.0162618115322, 10.1292305914973, 9.953644349848,
      10.0305463227482, 9.99160112867597, 10.0410363449162,
      10.0183678240529),
    nrow = 100, ncol = 1, dimnames = list(NULL, "beta"))

attr(proposals_exp, "ancestor") <- rep(NA_integer_, 100)

proposals_obs <- .Call(SimInf:::SimInf_abc_proposals, ## function
                       "beta",                        ## parameter
                       "normal",                      ## distribution
                       10,                            ## p1
                       0.1,                           ## p2
                       100L,                          ## n
                       NULL,                          ## x
                       NULL,                          ## w
                       NULL)                          ## sigma

stopifnot(all(abs(proposals_obs - proposals_exp) < tol))

proposals_exp <- matrix(
    c(10.249416561216, 10.207608519523, 10.1616680108471,
      10.1805772834956, 9.91479236877152, 9.93191420178626,
      9.89396473893688, 10.1527586225798, 9.99011930878491,
      10.1694897128394, 10.4112048126883, 9.96355706675316,
      10.1239136939972, 10.1081469462128, 10.059063060151,
      9.79861661562053, 10.0834608890643, 9.88213968735834,
      10.1096951751754, 9.90730418809612, 9.99937601512637,
      10.1134158987824, 10.0582441676788, 10.1789383298931,
      10.2612784240681, 10.0948874715195, 9.96999644377345,
      10.1234876364007, 10.1515596606107, 10.0270913480332,
      9.78683534485534, 9.83526193230731, 9.4443095703895,
      9.86708730357155, 10.0748322929171, 9.80619868825253,
      10.0465057153763, 9.891036435502, 9.90432555379842,
      10.036523818283, 10.0878646938157, 10.103383114257,
      10.2275566574943, 10.3509405541753, 10.3247897200789,
      9.8890099552063, 9.92093009237337, 10.0927567574681,
      9.85583874175354, 10.4240471022101, 10.2193240271061,
      9.89270707977462, 10.1083088711292, 10.1511512754972,
      9.82209594339388, 9.91412880041124, 10.1275946027116,
      10.1281885528548, 9.65709650665204, 10.1057285028862,
      10.1167480535188, 9.7579238538185, 9.82260437758685,
      10.178553405421, 10.1985406280894, 10.1170661109179,
      9.98934757012056, 10.0128174121219, 10.1531997009741,
      10.2185910734405, 10.0208748331058, 9.96138254760106,
      10.1691045430748, 9.64557445557514, 9.80894477380542,
      9.79653874264101, 9.74811484536115, 10.014341440229,
      10.2877829963427, 10.0482092018837, 9.88761215054977,
      9.98008282535699, 10.040112708211, 10.2913085470995,
      10.0492472140046, 10.0701110581701, 10.1205733590029,
      10.1037677411139, 9.97300364487065, 9.98122755264019,
      9.9955103553499, 9.93582994235593, 10.2624138028386,
      9.94072074019406, 9.90278375356397, 9.99246700023077,
      10.1580742187487, 9.84336310352742, 9.90896822969643,
      10.0136618792768),
    nrow = 100, ncol = 1, dimnames = list(NULL, "beta"))

attr(proposals_exp, "ancestor") <-
    c(79L, 41L, 89L, 95L, 4L, 51L, 89L, 54L, 44L, 95L, 44L, 66L, 57L,
      10L, 89L, 23L, 4L, 32L, 95L, 89L, 69L, 63L, 99L, 66L, 69L, 54L,
      60L, 29L, 13L, 95L, 89L, 69L, 79L, 1L, 48L, 76L, 23L, 32L, 23L,
      13L, 41L, 41L, 35L, 16L, 13L, 23L, 48L, 26L, 86L, 4L, 44L, 79L,
      13L, 57L, 19L, 13L, 76L, 89L, 38L, 66L, 10L, 38L, 26L, 82L, 44L,
      82L, 82L, 79L, 44L, 76L, 63L, 73L, 1L, 48L, 23L, 38L, 60L, 35L,
      10L, 23L, 66L, 41L, 79L, 10L, 44L, 99L, 89L, 89L, 16L, 13L, 66L,
      35L, 66L, 32L, 19L, 79L, 10L, 48L, 51L, 60L)

x <- proposals_obs
sigma <- 2 * cov(x)
set.seed(123)
proposals_obs <- .Call(SimInf:::SimInf_abc_proposals, ## function
                       "beta",                        ## parameter
                       "normal",                      ## distribution
                       10,                            ## p1
                       0.1,                           ## p2
                       100L,                          ## n
                       x,                             ## x
                       rep(0.01, 100),                ## w
                       sigma)                         ## sigma

stopifnot(all(abs(proposals_obs - proposals_exp) < tol))

w_exp <-
    c(0.000142318649743074, 0.00579600739030807, 0.00521010488029535,
      0.0165539935379971, 0.00172895512773806, 0.0140048724453806,
      0.00888657462900812, 0.00749296302718984, 0.00512353136012425,
      0.0164045467559143, 0.0034692201875978, 0.00368085124683484,
      0.0135665386787454, 0.0115382622999379, 0.0109993286318955,
      0.0213240392591689, 0.0120365872070376, 0.0152173041076391,
      0.013686467402762, 0.0096297749493388, 0.00905993715711376,
      0.00842245374843249, 0.0123677530593766, 0.0160396979463799,
      0.00647004757375468, 0.0106877125112904, 0.0130034348006057,
      0.0125367112467912, 0.010223394143662, 0.00731372071440856,
      0.00320829921000589, 0.00123451323762445, 0.000203430658368934,
      0.00203082608980474, 0.00337865836650964, 0.00474672289135411,
      0.00373028711065374, 0.0152326925857242, 0.0159847854575654,
      0.0121396094574977, 0.0119484439807612, 0.0114489276857043,
      0.00135077302681736, 0.00772632809892925, 0.00170492307554806,
      0.0173489562342237, 0.0149667748648686, 0.0074986382601814,
      0.0181847424556568, 0.00289572448163313, 0.0153933717284334,
      0.0163302426547517, 0.0120472217505778, 0.0161782108795572,
      0.0163845462220557, 0.0057351981162584, 0.006504438466244,
      0.00715726804137168, 0.00554456349043892, 0.0135771081805756,
      0.012437515912019, 0.0126350733628201, 0.00710539406351158,
      0.0020376794150082, 0.0159574787319664, 0.00470310241470761,
      0.0123331881474831, 0.00816167932410601, 0.0157587662712092,
      0.00217622297865884, 0.00187329469995823, 0.0124872852168028,
      0.0119426597105867, 0.00666924543834568, 0.0213177343576396,
      0.0150601089567754, 0.00410673993607958, 0.0118248989047837,
      0.0214930835596806, 0.00363721209302184, 0.00108469621550827,
      0.0104620062458924, 0.00613617592913788, 0.0213476067899275,
      0.00938821961969724, 0.0122272869750957, 0.00761776670233406,
      0.00862798022767443, 0.00380709274766305, 0.00973035169542611,
      0.00552821133025288, 0.0126413903108567, 0.0130108587964331,
      0.0140347426335291, 0.0159479734612046, 0.0097851155898044,
      0.0167082434400863, 0.0181775098321298, 0.0140845927002193,
      0.0115004838257942)

x <- x[attr(proposals_obs, "ancestor"), , drop = FALSE]
xx <- proposals_obs
w_obs <- .Call(SimInf:::SimInf_abc_weights, ## function
               "normal",                    ## distribution
               10,                          ## p1
               0.1,                         ## p2
               x,                           ## x
               xx,                          ## xx
               rep(0.01, 100),              ## w
               sigma)                       ## sigma

stopifnot(all(abs(w_obs - w_exp) < tol))

res <- assertError(
    .Call(SimInf:::SimInf_abc_weights, ## function
          "normal",                    ## distribution
          10,                          ## p1
          -0.1,                        ## p2
          x,                           ## x
          xx,                          ## xx
          rep(0.01, 100),              ## w
          sigma))                      ## sigma
check_error(res, "Invalid weight detected (non-finite or < 0.0).")

Try the SimInf package in your browser

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

SimInf documentation built on Jan. 23, 2023, 5:43 p.m.