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