From f7502e21a1c63c58f67efbb68214c19c283adc15 Mon Sep 17 00:00:00 2001 From: jrcpulliam Date: Wed, 12 Dec 2018 17:06:08 +0100 Subject: [PATCH 01/11] add skeleton of test for #28 --- tests/testthat/test-fit.R | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-fit.R b/tests/testthat/test-fit.R index d2af507..b26917e 100644 --- a/tests/testthat/test-fit.R +++ b/tests/testthat/test-fit.R @@ -65,7 +65,7 @@ test_that("internals for fitting", { test_that("fitting results are the same for incidence fits on Dates and POSIXct", { days <- 1:14 dat_cases <- round(exp(.2*(days))) - dat_dates_Date <- rep(as.Date(Sys.Date()+days), days) + dat_dates_Date <- rep(as.Date(Sys.Date()+days), dat_cases) dat_dates_POSIXct <- as.POSIXct(dat_dates_Date) iD <- incidence(dat_dates_Date) @@ -73,3 +73,23 @@ test_that("fitting results are the same for incidence fits on Dates and POSIXct" expect_equal(fit(iP),fit(iD)) }) + +test_that("doubling / halving time makes sense when CI of r crosses 0", { + # estimate of r is negative + days <- 1:14 + dat_cases <- round(20*exp(-.2*(days))) + dat_dates <- rep(as.Date(Sys.Date()+days), dat_cases) + + i <- incidence(dat_dates) + f <- fit(i) + + # estimate of r is positive + days <- 1:14 + dat_cases <- round(exp(.2*(days))) + dat_dates <- rep(as.Date(Sys.Date()+days), dat_cases) + + i <- incidence(dat_dates) + f <- fit(i) + + # add test +}) From 386c73c28a74e7be908da0d88a15e62ad10d6595 Mon Sep 17 00:00:00 2001 From: jrcpulliam Date: Thu, 13 Dec 2018 09:29:02 +0100 Subject: [PATCH 02/11] add test to ensure that CI of doubling / halving times do not have negative values --- tests/testthat/test-fit.R | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-fit.R b/tests/testthat/test-fit.R index b26917e..fefc168 100644 --- a/tests/testthat/test-fit.R +++ b/tests/testthat/test-fit.R @@ -75,21 +75,26 @@ test_that("fitting results are the same for incidence fits on Dates and POSIXct" }) test_that("doubling / halving time makes sense when CI of r crosses 0", { + + set.seed(20181213) # estimate of r is negative - days <- 1:14 - dat_cases <- round(20*exp(-.2*(days))) + days <- 1:10 + dat_cases <- round(20*rexp(-.2*(days))) dat_dates <- rep(as.Date(Sys.Date()+days), dat_cases) i <- incidence(dat_dates) f <- fit(i) + expect_true(all(f$info$halving.conf>0)) + # estimate of r is positive days <- 1:14 - dat_cases <- round(exp(.2*(days))) + dat_cases <- round(rexp(.3*(days))) dat_dates <- rep(as.Date(Sys.Date()+days), dat_cases) i <- incidence(dat_dates) - f <- fit(i) + f <- suppressWarnings(fit(i)) + + expect_true(all(f$info$doubling.conf>0)) - # add test }) From 3acefbcb36f21beaf51aa0d1d2a5be194a808735 Mon Sep 17 00:00:00 2001 From: jrcpulliam Date: Thu, 13 Dec 2018 09:51:15 +0100 Subject: [PATCH 03/11] passes my tests for #28, but breaks other tests (on first run of tests()) and regenerates reference files; passes all tests on second run of tests(); not committing new reference files --- R/extract_info.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/extract_info.R b/R/extract_info.R index d4e73e1..2b3a2b8 100644 --- a/R/extract_info.R +++ b/R/extract_info.R @@ -47,10 +47,12 @@ extract_info <- function(reg, origin, level){ o.names <- colnames(info$doubling.conf) info$doubling.conf <- info$doubling.conf[, rev(seq_along(o.names)), drop = FALSE] + info$doubling.conf[info$doubling.conf<0] <- Inf colnames(info$doubling.conf) <- o.names } else { info$halving <- log(0.5) / r info$halving.conf <- log(0.5) / r.conf + info$halving.conf[info$halving.conf<0] <- Inf } ## We need to store the date corresponding to 'day 0', as this will be used From 134b0c57ffd0e22e4dcaca377c558caf03c62992 Mon Sep 17 00:00:00 2001 From: jrcpulliam Date: Thu, 13 Dec 2018 10:15:36 +0100 Subject: [PATCH 04/11] change all occurrences of expect_equal_to_reference() to expect_known_value() with update=FALSE; note that there is a bug in expect_equal_to_reference() such that update is reset from FALSE to TRUE (see testthat issue 683) --- tests/testthat/test-fit.R | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/tests/testthat/test-fit.R b/tests/testthat/test-fit.R index fefc168..b7d9011 100644 --- a/tests/testthat/test-fit.R +++ b/tests/testthat/test-fit.R @@ -14,10 +14,10 @@ test_that("fit", { expect_warning(fit.i.sex <- fit(i.sex), "3 dates with incidence of 0 ignored for fitting") - expect_equal_to_reference(fit.i, file = "rds/fit.i.rds") - expect_equal_to_reference(fit.i.sex, file = "rds/fit.i.sex.rds") - expect_equal_to_reference(capture.output(fit.i), file = "rds/print.fit.i.rds") - expect_equal_to_reference(capture.output(fit.i.sex), file = "rds/print.fit.sex.rds") + expect_known_value(fit.i, file = "rds/fit.i.rds", update = FALSE) + expect_known_value(fit.i.sex, file = "rds/fit.i.sex.rds", update = FALSE) + expect_known_value(capture.output(fit.i), file = "rds/print.fit.i.rds", update = FALSE) + expect_known_value(capture.output(fit.i.sex), file = "rds/print.fit.sex.rds", update = FALSE) ## errors x <- incidence(c(1, 0, 0, 0), interval = 7) @@ -36,10 +36,10 @@ test_that("fit_optim_split", { i.sex <- incidence(dat, 5L, groups = sex) i.fit <- fit_optim_split(i, plot = FALSE) i.fit.sex <- fit_optim_split(i.sex, plot = FALSE) - expect_equal_to_reference(i.fit, - file = "rds/o.fit.i.rds") - expect_equal_to_reference(i.fit.sex, - file = "rds/o.fit.i.sex.rds") + expect_known_value(i.fit, + file = "rds/o.fit.i.rds", update = FALSE) + expect_known_value(i.fit.sex, + file = "rds/o.fit.i.sex.rds", update = FALSE) expect_is(i.fit$df, "data.frame") expect_is(i.fit$fit, "incidence_fit_list") @@ -97,4 +97,5 @@ test_that("doubling / halving time makes sense when CI of r crosses 0", { expect_true(all(f$info$doubling.conf>0)) + # add test for when groups have different signs for r }) From 07cabe2e11700279f9319d505dc3c7ca51830d53 Mon Sep 17 00:00:00 2001 From: jrcpulliam Date: Thu, 13 Dec 2018 11:48:51 +0100 Subject: [PATCH 05/11] updating test for handling groups for r estimates with different signs; need input from @thibautjombart on what expected behavior should be --- tests/testthat/test-fit.R | 29 ++++++++++++++++------------- 1 file changed, 16 insertions(+), 13 deletions(-) diff --git a/tests/testthat/test-fit.R b/tests/testthat/test-fit.R index b7d9011..cdcfc18 100644 --- a/tests/testthat/test-fit.R +++ b/tests/testthat/test-fit.R @@ -77,25 +77,28 @@ test_that("fitting results are the same for incidence fits on Dates and POSIXct" test_that("doubling / halving time makes sense when CI of r crosses 0", { set.seed(20181213) + days <- 1:14 # estimate of r is negative - days <- 1:10 - dat_cases <- round(20*rexp(-.2*(days))) - dat_dates <- rep(as.Date(Sys.Date()+days), dat_cases) + dat_cases_1 <- round(20*rexp(-.3*(days))) + dat_dates_1 <- rep(as.Date(Sys.Date()+days), dat_cases_1) - i <- incidence(dat_dates) - f <- fit(i) + i1 <- incidence(dat_dates_1) + f <- fit(i1) - expect_true(all(f$info$halving.conf>0)) + expect_true(any(is.infinite(f$info$halving.conf))) # estimate of r is positive - days <- 1:14 - dat_cases <- round(rexp(.3*(days))) - dat_dates <- rep(as.Date(Sys.Date()+days), dat_cases) + dat_cases_2 <- round(rexp(.3*(days))) + dat_dates_2 <- rep(as.Date(Sys.Date()+days), dat_cases_2) - i <- incidence(dat_dates) - f <- suppressWarnings(fit(i)) + i2 <- incidence(dat_dates_2) + f <- suppressWarnings(fit(i2)) - expect_true(all(f$info$doubling.conf>0)) + expect_true(any(is.infinite(f$info$halving.conf))) - # add test for when groups have different signs for r + # groups have different signs for r + grp <- rep(c("grp1","grp2"),c(length(dat_dates_1),length(dat_dates_2))) + i.grp <- incidence(c(dat_dates_1,dat_dates_2), 5L, groups = grp) + fit(i.grp) + # what should be expected behavior? }) From a551b86fbf79b4ac632ae13f26202c3e1b440748 Mon Sep 17 00:00:00 2001 From: jrcpulliam Date: Thu, 13 Dec 2018 14:17:21 +0100 Subject: [PATCH 06/11] have reviewed errors and confirmed that the new values reflect the desired behaviour as a result of the change to doubling / halving interval CIs; committing new reference rds files --- tests/testthat/rds/fit.i.rds | Bin 2815 -> 2812 bytes tests/testthat/rds/fit.i.sex.rds | Bin 4440 -> 4430 bytes tests/testthat/rds/print.fit.i.rds | Bin 356 -> 353 bytes tests/testthat/rds/print.fit.sex.rds | Bin 412 -> 402 bytes 4 files changed, 0 insertions(+), 0 deletions(-) diff --git a/tests/testthat/rds/fit.i.rds b/tests/testthat/rds/fit.i.rds index d08076280282528219375ff58e741fb00b41ce5d..5ac047e5e47bf26aa305dd854f507e410e634c78 100644 GIT binary patch literal 2812 zcmV<5_o#1yl_-jA|hpeVnr_e$+yn58|XW)sDyW*?-Wm6@6!eH&^9Df?!3 z?j3fP#nhLDz2WyeoO9>iy>sTAbI<+HnfqWUhG7IIlj9g6<3yRt^AGYcuB)r3AK>e& znD4_9$jNVf-kZv<$FLxRyN+W)SQn1Vt$GV(=Y$CFWc)>C{AjC#vKgp6M*_U0FzOwY zT{D*xTjA6y_G{BKjnps8UHCf}v3}d*UHJa^(4Rk9z<#DF-}TCPD|z744<~M3=^zh0 zGP3oq$_BD&rgQ1)%WKIN*RlmmRkfu1P2JN+8rK5+$&Ihu_k2!XnwL1S2Sbpj))x<5 zQd3HPzOp!dlh(mDxUwdHF<=DSs6AXoC!As%Uz#mzQWvx5R_xfTzM}{GegE<;P2;NB zmeCW=mM<>k9}#!Mr&7U3z_mz7L_!i01|cCC2`NZOMM4@9bWk9)0|iMdNQr`!BuIk< zDOr$G1SwUJ(gaE8YiL(o{n#`8Obof}?%vTWb%6aP>(K7B@FH?CwRwPMw~IVg$$qQI zm`i?{d^Y>&p;Gdvkq3V+-FJq(TzWih*_^ilwq^I|!iUxY{BXn6B}Jv=C1UuSyc_T;E#Gryb>&z{~ixmmfp8{1M*v7qvY|F9R6 zH|#uVX>{SPRUz~5IM#uouM|Ff6Z^xt*Sc7^cO`fNA6gpV)w?cCuJ{DNkOnZM0siUK z9($TU0Qgr=#Z>f)1^C77{mp3wfRKNia?g~#fau<5Sl7a6K*WyEJo>y15Ce-QSHD>Y zi1cdxV+VTyV(c+<_IV2+rbiX3RW3l#_da$ZsXHJF9n0&oa{;mRpJiqFHGo*r@M7*W z5rBA6QKhRk0-`$Yt-qW}N03O-jgfRJDp3Hx-aMJ-_;3HwOcr*rVmjeQ6=77*~r+}QskzzOm-2Mn`L z3TfJ5gzH8z!ERnb1>_-aOaLie+*gfCLb+}w{HZVmUkDB3ikcAg)XAYXPH)AB8j)db$+oZM1&2*^AqKRS7cFc1N3v-Jl5~+-;gfx&z!= zVbU8MjE$R)@C%oAtBPp5-fmS1fyr4Uo;N`N+$6Gj$L3ISp>5Ha^|L9nKf>(*#>*L- zk+S(j4DN3?8m*Tr3<|MP_B_UFr`nH^`vXL|M@Rb=<3~Jqo{chc&VzpI;l2)EDLr9w zuLt*g+)wzbqp&(Hl#Mp{H#(qy!@=zhTb{>V$ODqHS~ zAwba5p#IwBSprukzuc^Br~us@v)oyj8$`4^pUfHd7Z7=*XV9}`J&3sH%UyLN#sS5} zjQREx&wyZle$pLl+n6|QN<04Jim&HY$&^SB@|2(t4{zYB1&D?`0dnmko~J-Q1abg) zp5fy8aM&IR+hbsRENoAJ?fbvrd3FrXADG4Si7)Vc66~K611)szo)RwsJ|KmZ(cO(* zbEMtk?gVL|XS?hydf;1;E$ChdZUBg4Wk9c)Fh*i6g2+|p@Wkg9f~a-lmQxd2fGT&|nw<5;Kvf(2-WmH^psK1a4%*}ZDosgxpM5<+ z)U;7=EsA>@L}rf7p3&tzh`4P@OURxcAbjhKjj~&_fpYM%mCB@S5b{y^#&J_?LGZH4 zsb)4x&=2e&o-nPkgLHHDzUuKwV92&tlm}l92D;p$`u7Yvkea`41FM+`k`F9=!RZ(X z20fc_$n=OAByD`6@1rB%21x^EFxk!ZAnCS}C9k=2L6ZG+jq8a;NrZ!NNF)mf@J}J~k2S2wuGZ6D{~~5${{6@G3q~=GoTJ z=`F9JP$krJ)V&)=-8t&TktbQiaTL$d-5e!yl*-Xij)rkGf}>21?&oL{N7Fc(=`&|g zTTps;^>9d@d6VGpr*JeF-qWM8!iQvV4k69nBxy`2h4@y<(3k5#OI;kYZnyipYYEx5 zPY;e7%2Yll}5Fb70bWBuwLo!|ppA8QXhrz!dhanEyLfP~5C>4cxKjaq(*#}1*p$4ZX zY8-R{)j?qS93J(muJ-kd+@5Flmi6SAkkrKkyjc$O{VMdm$@|y7E&gG?lcvzjK9&&4 ztzwd11SH5Iy$E=D=iEW17XfKiwlkIVA|Rc>`28}HbOJ*o^vKb>q0)s<%*fPKfYM#$Qy%kFh!^n}N!AB*04wquxQ; zHS;*J4Nk3MzcM}DME$bdg};3f8?Zgzg&&9y{rTes?5CQF-7inDk_SKeVAAH54)Wkb zquTDMY9yOyIhU^fbuHQITDD-Rs*ZHOse9^Z(^`N(vGH~L-p|NO^AjiaVhHl|`jR0_ zYRkyaR+eOJ(mL2iSN4?8?;6QAX^&LX38&en7w5>D)g|n?6+8E-Z|lW=H?U$$^Y|LJ zbox1;94XkA|VM0$w){+LMjr{kdTf99TW)d-GZbQq(nhV5~O57 zN)e<~K}r*(bV1Vj8rl`tFz)OC6GQI4vv2fD9bkXSKD;MAyqH`}ZN5vh$3>p5V!u&j z&Lh7_`61`n;WF~4QHOpm+kck)wd_Rtvbj3|wq?(lq6gLi{7B=pCBub*e_SEQQv%Z)a&z{*drA4`?2isa%xuEL%f3p`; zHtafOX>#GNRUwbucDxfqUoL$3CiaJOuXV9-?@I6lKD0EzYj$6lQu#4}Aq`+i1N@U| zz4o@e5AZLajH&Ds3-F8E2b$9h0U`e;b?DT6fauw8Sofl6K*UbSI`*6m5O)_(sd=*= z5E(W4M-TM@#JJ<;obwhy%!n#dt6YGfhd+8DsV5+c9Lwu-@&K{)pXKERwSZXB_(I;( z5rB9>QLU>n0-`4Ut^?tI^!Hm?n$`tSE7G4`OX1n*sX^n$+wPwd6dstNS*9Gi{XX^Wy`zhFi&jlwuxN9=obk9g#_S}E4N17iSb5B$=`|0!b(^9tq zzjQ7$(iR^Rt9ULN62c8ZNgwv#*fAA>UE$6pGDEQ5Zl`mt9plj(qu#BPJon0LhhobI zkmrXySp9It-+acxq~RThXUuPEURC?rXmLUjEm%3yxWI-s-U6H6iSnU5pDtt^$cGNb z48}ATMe|4vKlC) zomP{q(fWr!<8)jd5EASnVV^Fws3q(pVIK+mbPe9Mu@B+K0saGdvUw3DnVx2?r2xB2Q)#1yIqq=cYs?f zOnQTZv2oK8e&Nz#RT1siJFF@pFgc6F^Ck#@n?yG6+#E_Sv@II5ehy{!N4TB9csXM; zQZ}E6!Ts$fbCJRJr=gd!S+PhzV~yU=fv>*zS%sV^gPce!~Ur;&_Y-5De)5E15!vCJ>A$< zN7_y9E|3O#cgW772fi8U;ZsPDKr3;XZ$gS(rD74xzW_~%v2#I+$qSQH=6@_S#DvBl({qLf$ACrgycL9 zYA+V>MFh6|sPO^q?DgcTH?Z5Pl(GP;#0M*hR!N(G1SV=yVs1x|t4s5?+Vd(>LDkjr z6}X@8$GUu8h5E$~Gb|X8x(vkXPpqjsHW$P$uB^!Z{znk|;@=zgoh=5jyK3J!R=x|w zp1%F17QGzADfUGTF4+v?5;n{(nVSXTvg$8coAW`OH75JMS_gS`;=Ukm^OH>j zO&@@`#?>dvCf*9-TE3mpsH*_#ehXfYUX=>e!?GsdyY&K4Q`5He4etfiPplhpeti{C zZ%iwSu9z?ACp)P~-aFX>f>Ynutu$ys$d)-JeKW#=^8Tv5wlpi~9v<3r=K zhW6+WB3GTm6Q5lOqSlRHPEBkDs=VoIa@UstRbA}6XYFf&s=B5mXp;k|G^H8+_V)%+ z(?`FxDDEi`nKdqFX1DVo;+7??A$xm)@U1U2$!^X8%0b6hDwA?R$cGgh$4{#R!ONzk znb{~oKd_T{+_c6HGR!&qYbGRt!P{O|9(pMl=<s?C2?NK4gbsoH$? zffIpA)#l&5+I%(d^HH3vLM1q<<|Ea7q_Qm5b;`2++|sI)R%Kv)q6Hr=;(aR>Ud0E> zJlh&Nz2!9&s)Txuy7%CyCr5oa@+6Bmj^a7GlcPkA(l{Ez(J+oia+Jlc_FA*9(GB#jBB5Z@{p`f?p;sf$C_?RI~A zH6h#n>A{gl&4OWYo#9dYbPh%{m!k49K73SIyUTwA5`W{hYI1FiGar3e2{Z z+ix7(#C3@6fNwkq;-d$hfr(0QNXEv{tJW1QA16G#C;H0TB^xwXLGIUVo~EzxQn| z-r!LO5D^3c6-7~76cv@Ch>8MAzD=^bB#6~|eD$-N-*1>>-^`nR^X9!bZ{Ff(h+!BT zD@+6%Vt}L7fYwS--o1TQy1T z(vyDxwcWP6*nhdXf;x}0k;}g0fM+X)Z?!g)fG6d@nJSX>K}B|4;8Bw@a4I!+PM}#L zDn3&Au*mZS`u&b`LN~u5=+2mw$l2C|&`ry)Z>I$GM32k^&U~5N20g9p2nHmDq6d5K z=x2{ThxSI@_%7`02;Q}x6fVY37+oL3*mA% zgSyGHjdyjt0ZL~5TJNy$G`P^|`sz}C5xOzr#96DpyHH8u<9pt$VzjA?D{sUBE~?VG zn_&5@3_aeR@6$0JSCgHkASrE2QjO(875G%al`6PV1$U~@pDK7zg#lDyAX#9$^rK5I zbcs)wTz~138(ngzOa1AR2VELKmuMV(8V8@o!KZQXX&ihS2cO2lr*ZIU9DEuFpT^-z z<8Y;MxbihwDx=4t^0harQ&Hoc`C*k#W5KENKME>##-q$>*D z%~HqldqLwb#i_$NnUEzA2~dn1c$QmY(5`S0sDIYaG8#4DI4HLR3v_$tqPX~J#tE6_ zs3_QI*04n0DFJP&+wRzP~un#s@agtJQ60%U)N^%v{;fj8)oG}QpXZ*3HHu4T+)lU4X&c+F{ z!Y=C8XWZf_!oPFR~;*x6}+B<`%GZSIg zDLX);c9pmplp%Zulr0E}RO9FM>g5{$|E&`;Wf*eJcApeW0 zki8*n@PO?RknKEo(KkQuf~>w-$fUOFVZDcMY^dMTByOS0UY46C)PLuY%P0y(O@;NO;KMDCoK zVG)`J1=%K#*4Ru1S-y78i$?wk4uAiW_N3zT2(V{I?`6O0W`Ygl2Kn8OcK|rsFIQ5K zgx2nP04mlmN4o>`^c*`pL5C(T6HlDH8D*xLiiVf;LOIUoQiQQAbaGd6Q9{RysK_Ol zy%G_++IqU%6izBSKcVdNhd#;ROyAD48pU-Wr}S3v=DVT)ZTuN}DmoN?w0~92D3Gj! z%$VzW$aX)-GAK1Y+}jpprR4dfxi0|6oDV1O1rNZntesa=M@|CSK5HF!jL!wxx0Z!( z3F3p}Gw1EyAW8u_ZDZ=!$n`+ZIuS@thyW+t0>1re{w0v>56yo3|5T7$&G%in)fyFU zvk>%7e1r;WKKjvP+J00JIDc}4m*6v$f6|WwzPg6;J@DU#d^R1O+!!_8`x6s%((G%O zQ63vmUcwJmU-TV_a;s7{jk7C6xqjP&d^_Oi#PM|N0Fy>^f`9yM5N8R>S#x%AaJ>V{ zF}~^@diOV!ee>yI$;DeJd%R(^tSBKvK(7B-)%uGdSQ7u;38N9OJh9(x@_YoZl~L-VPCLPU0z6)&Hq|N4o z4Vh1lo*h;Q_StrJsIxBuM}t1T`^{!oko|>ofd2A)kS9S$PnFCBr_a|6>D#LYl!T^7 zb4QJ6VUlw~MB$|9V5=msN`z>Ev>`w!!`*^}W2E&PNoy|l4u8%+T8pM9h>8+Tk-S(d zXh9nYr4qSJ5G5zpm~BA3>V15af!Tz;-;~x=R@ivWl|jzL2ZdeK~ZHK zs4aVDJpRflP}?bCOl)u-xbL<9-lik#HD;+XLsebbpEW41wD#vCslzcX6H03ax)gmQ zWn@V=QYMI|NPnmsA&Qa8DV~>0#bi-OCXh^Pc}f+E3F5VQGv&D2MqH=2NGh#?*c3!4 zuCe4g&5QgJvg?tFp1P+eNmTj`qvQhRQfoD`#o_7!w1}Y}DwTytiv5(JA?f4)!6iRg$$QS#;qa!HDrDVis4LAF^cTA6}=s6Z%} z%9QRlC3jG^It$bOu{3g4D*}{*(R=SX0m`8y06}CYHC10A0h+0$+3y8F>RMZE5z)#U z8WB<_oF^6pxqytYSm~FvL-X~2B1Mh+R%kRYP$iE%D3xf7C<6ngRKzn!3WaRy9_Zf0{uf_s#W2=aV6aSCKZ`<1?VJ zll{u~_oc?6$EEO)Ikml7;)g5}zCL5{702>pviuG=nub) zhHZ!G_J2Bl2sGU4e?Dnscd8%Vzs37d$sPmy@ z-J7hBB#2goH8{ zO7YN8kx+yyElmm)9wiEi7KrKPAwX~;{akJ7tIH;#BDow7;l&8V(KrP_UAVS9M;L{K z@~E*XT+O$wB(7Le(vY}>0N$ENDp7=fuKaW7XO+ ze4e{)4+?yshpN_WN+@k|wF>Q`=8Si)y2h_n=alO7BisLB{1{_Os1d(criAS)ZL^mf z59Hc9{kSH3f7K*CXy1L=C}C_Ww7VE*IJ?vzcH1~_oJrX@Xgl|-gL^*z7C=Y{DG-Mp_SX{lty7Bw9E~to*xqjEus!= zE9}`Bn!A<%5mtW!n%*4oX+!rF(BzW1NH9SkI{9auf4&kr6xuKDf7#gXI_y5}$e&xh z>!F>0zW}r$9Cq{Fbq07Yhql77F^|s-gMkA}2|Is!z2DL-DeSm)?F4u0B52dy z2nTsVu*04kC0UPp!uGzbBjzR*(5mg=0!Qa6Xj!^)>Xsf?pm|D4zp>`Q&@3t1>eKJ{ z&~z{=e{Gl9d4D5pn|}Of_u?{W8XaRecj7&0+UR@vtM>gM*LtSGtjJZ6iS~us= z;VX7IhoBVvHR$e@b@D{OHnhXgZ;~C?}>0a@}&R7yO?Q zxPJq-|*z2KhnP=?0HR-@Fa`-Mb@S)3qP$d)esLmD@$I*RiTW z-tLvqDSrFG`#xu&L)GV3Wd}L1NA0I;$`XrV5835`nGeHYkFo4|jVFR(j~L6u!*_`G z(_y@xtAx-I8@yed9S0qA(i`Fyd<}=jf8)+|4mY9a{UfK(FWU?~hTbc@QLz=eff-c` zT=k(#UV8C&2ZEsUwqZL5FYN&PZ24qM_ugKx*K}#)*1X%WCwo&`WcfYl)b}cZY(8|n zlvd~S$PYT!#O4k0`xrX;#5PSU*ae;HpLFT{ha>2G{m2>%PE*Crw6jY>^~Xe@bDM%0yE{k{2+#2_2Lbq}(IVo8}yGxC;}9#l&I# zTZ9u6hsDHUy-Ci*VKH%7?^;kXaac?o788fX#9=XUSnr2O=3?*Qki*1bF>zRbKMw0{ zT+6j1>Q-bMbMeevJbzdh&rDnC(M#a)6OsB7NqIW*Aks%f8cd{NL>fh;F+}nwQqWuI zPt8N~7}ADF=0xg1q|QX@O^$7(Bnt_{!J6f+<}t>AoRcw;IufZTk@{e&(}bGN8hCV@ z`+tb~gRu?NzgDj^wZadmf6rN36a3BJt~@Vw6beQ8-;p}>Qv>-_Jc!)5|Ij(H8I4@Z zn}*{N%1L8t#jL5^UuP3&^wa*@Lc*g}0i_1nEnrx&8bO0580BzyBPqjvPo&IqRuQ+E z09sa26ZQ%cK+9VafN4b;P-WIaa#_h`d3h*~_FiZs7lq?d5dunwN3~IXuoFY8Ef)2_ zP#CS`Rk4=2>7~O0S9aV0KYnItN;K2 delta 4325 zcmV zc!NhBKvWO}RJ>4I6mNwkIaM`rUu=!AMh<5OJ- z5HWYcXkeX7+QMPqdXr~iYr4Z9_66@Iv398{O%5J-%n|m znfe2$>9*C?&VStv)OwtWUh*9WJYP0!v$dH7JT3ptRFR?&DsmG-4x5yLlj-rZLd=p; z$)Q`1ian2`-|xC4bqgGV?)s)h&$J$dZd!hQCoR|+JvI+M{bgz!^z2qgFd!uYJ=}Fy zKiBUp+8tx(x$Ds~R1sM%4KND=r3E@C@7RdILrdGG-hX@m>bKUl&s*aOp6$^K=W;iK z+6gm_cXYe~N@x69=dkA#xX|hP%JckUbYuAOGgf_epwi?g)jq5ew4sX|Z}>hgs?@oc zWcj=dJ=s~{-!Tzalbxj?DQ!zqjpa%e_*B7-D!5aHepI19Rq&t+1E|74vcPujOP5^f z5}z))(SId(y3~&@^`}c7bZG!xqH*wP9DEuFpT@zbaqwvzd>RLz#=)m?@M#=;8iyN= z!;Qw_#@A%2tR4r-SKp{gM-6x9PQK;j2Tqp%QCP7(5oJ%w{n}D`0@Nh%7P^`lf+tsO z7CVmF4H|waNgu|^hAe?dfa2W2^Sn}nc143gm4AMY(Z~TuLAf26r|X=D5)!8vCuNtT z;xMBb-}-by6|m}@RA&+@@3QLriBscIO~{qX{qZ-@qm}E~Sp&A9yVI85R@j{arx)Ji zcaxn!r+$C1)joF)sMv1lWpzdjo^+aO<850B8rxs-$_S1Fif`lXt5TxC)0CviiID)5 z-G91v-NGpmT(%zdJgM{my8g{n(eYC?n@udX^K8s;yo7L=N;u^#P%# z7mDV;gr(lr=2btzKG2Q{LIZ$j~>3?7l=LH&9{4|GqY!7&zyy#ko_AcPr^kmp| z;x^DAp1sl`(*e|nBtGM{Sp(`u#Rc^n+X*}c(#(&xq=4FPVe*k9764LEL5`wJXwb!U z$X+*j@PMsRknJ*i!8bqefUJXQ=L?hXLzd6J?pD+LLhMYjWWtmvh=tzXzcqL#P=8#| zF}VFxIcU7!e|2KK05rA{d2j=-f#ZMe+F3EDUvaD9GjF{Suo;9aDVWZjHeZ!M}b}2dM)`?Hyf-QJt*)&q65I$fq9a` z6tsHRLr}4HDcTvVr{~z=DLOE2iFn+EjVL?aR5Yx#CpzYGHcc4MLML{l7AJMQh>Bgq z*vk>2tF5QHPvoSdb7RXsf8?JEPWS0Nqd{B?j-9_9w((xXe;a?6o{A1dAAfCDGYTZ@ zAUp1QKC;~latzL!9_(cca?i&hw_ttsQjYOK$KURwqdkg5y}hP8XC|6N5_w5S_hjnpyT|bXF@rP(6Lo#7KYV1 zpku~YeIoAthH`H{J1Dt$8|98MjFlB9WeLdj_fxIE2$J7|in=qSH$%7`yZ zQNCsG<@?8$pu$?GRHq3A=yV9zm*XKsrK8&Vc^WH<0^6AJV7ieNY;a z8Ot3xyqQVP2^U3@qJyoHz$y`<1=5B9p$vBm5{{A9t&-MU?0+4cf3y}&PY@F$nkad> zR?vbr5K1L-nIJ|^tTEey1mtP}n5qDHav3g=N8%EBGsR6~RnLdiN6Mr+CW4w$i^Aet z381Fzx$&4QCqYf8B;WY3eDJ_)Z}o;lYc*!6F+){d*`GBi;e5@{hth{(S|*g%40I{_ zM$5>OZnR7gOMj72H%b&Il~X(~mx{@vj!Yn#()^Sv6cfa2_GZd)wT-w=Z;@151Fyb($9W6=c^V6FqfLPm-wg8^*{5%B9w7WQ!x!185OLKSC;tj1>zAs_Cg8={3jR z1ftc`m^V}sCz44eY9i1)SV!j6YZ{0oLQyy_5mIle>kGys4-C?p-n z16zT$=xyLA+Zpe|TM@}z>>YU*bg0F9i9bPC@$YpXyl|6Y2o!(Y17JivHYU5$Agm;E zWi&k#9I_y@B1-IGO&gHa+_NpiW1^&z82m*Tn#ZZVrK^0On7?Fr?Xja| zcsRj6B6KJ6B3p}=lGsRGCK9$>)l+}7Su-KH~@)#}ihl{27W$RC-UIg6mlUVP{ezl?%yy>eW>x8@(_l(ANPa7xIgIi3H$#_34CVGBy86ZK4kBAr`kds7|Kr4_5$Rq?;A zAheaZOgfcET|KMVZI+r9ZC|qE43&zK7a=3MU@z`E6B5c;D8(ZpL_!g+v@|JHc#J4K zRv>?-mxlnsh4gc^rLQiVM2O^aJe(IN5Xa&a0CnNo{2XBv9>Jr=rf@agwvxEwNl8QE z5(>oPmRLqNQW}nnUv}Q0?(f)|ZZ|f4DfT_j-d?oeNHd!JrBtJDA#~8%6M^;H){aIy zBNi>ZAXx$CJi5{~&}#*6GJpxhux&LHq7Y zMhfH8q20vOv0{HY zihKnG4(RcPJQ`J``HHk4kG0MnlWI;HtTC3D6>D-OP}rr;S$E;!XxRDF>wSM0=SX44&8x@uvo3}<-HmXN9|}9{x>1_**crAD zU>!0yseo2(2NycJR6@)1%O`E>aRr*ErSXOF9frVRm?ziQtXa;>Ku%!pnAxtMvq|IBQ{V zXsrLs(}h+&p~3nq;|w>jpx(2^duQ6+f;vOG1s=8wg{(ER4jlZ_9yEq!hi?AC1JrgY zc@|(=0%}mV5zBn-pi!!0_D7eNLesHT#mC|*A=f?6dfxvTLGD`r6TR3YA@}y|v&l(B z`;&p}-QhzZ_qQd>jn3pku8V)uf-=jUux$#yqTq=T8pC{Un#DzEuz0iRT#7l=%MP2q zva1i|JYT=%$d(Mq3K#WC%N2mS;;Mj^$$6l*U44jI`hJ=YL$?`J`R3I^&xu}D{R9B^ zPuY@jVNf7+n`-cQ)Xh7vZ}naIs;+%upUXzKuiPnyJ&#ll^67UAIwgN@-T%PbX8e$3G5-eJTUvwWZ1)xJ*VM#80-;enSAgr(SB+&&v}IqI%0#jigOd7 z|`QXs0b4xZtkD=8?H!3zmcQCDTo|`^&&Ce|PZeJ*L+2Xx@ z@Zt`z_oh!ab?@Z`drp6qHf+wn1D)9$GNQ|?p;Mo$1hTo%@lr;u|KmXDct1XWNZ`lN z$v?hvO5qOZRQI$?&yN#e&vT7-HouEtZ}y+@mL?OLsWLrEWvEP)*RlLKgd(S1QBx_6 z&54bYy^ejMgs@|75Z_v;0~?O$>*td<%?6HIdBiyLHs{Su707?D(5vX+FN5|tU$&}X zK$dT{_oTAwMOnOMe!cb@Rs92|N{g;$7R7IRG9FzQ-92OIY^?rzCF7^%%IZPZD6NmNp%_Mai_}fQXaPnGd}vyLzSCo(jb1a_NcmK06{_^7 z4oNv%OyzLGEQw@IBxP_+cOp3vsSlBqry~y{eMF?eMDl+o(nuot5-EsCp>Lr-H4n{W zNE;%V6R87{IuofEIku6KEF=sEYm&Q~#~1^0PR2y)NF-+>^~O}E2{oNH@aQ)6{}A;D zV;iV{Ena78g&$C#v$Q1mo4#FnQR*lZit@iBb?B!C@=16oxpDuYb7B)3xs*2r$D@>! z#?*>gQ@MY?$tKX~r~S2sgh#6aN)57`!LZ^rf(A`6%Hhx|DZ_qGq|6Ie5x0o|T2@gb z_8JmE%UcqRX+;@OW!8LhS;=L2btsPZUT7m1MdC400!oLqQGKuzN2@Is^}tXVtK?O= zDDGvlN#j4rsHSeOx$3$xQDRjDgDysMsWyO08JF|x90$rK?{+05AmV_7N ztD+jj@|zU;t-VF;M#wykaA7rCTCrnM>u|g7s1m$N@E)yQs(}60TaUt!VpK(#A1UPj^iNiQ5{1q z#d^u?JZ=}+CoyO!^PTF*H+FysW6z(4X|K=opFaN>Vt6{iiTdGQeK7N)1V_G2`ruU$ z_ik`Ml9ZWIsB^E9xzTIfJvwV|X`zkl3S2)0V~83<^Av8dz=O<`zYC?2l<}Ery7iPbEVIpS*6*>JV znFhK1q`7`=Z&AB@PAv<{Q&6;0v}u?WAWPt~^15`88>&FFn)Z^P9VSYd0%wheTne2r z!9)dmMWK|O%dI^zP3tCYQ|ijJ^Q{;T(}@0ssKq Ca;A>} diff --git a/tests/testthat/rds/print.fit.sex.rds b/tests/testthat/rds/print.fit.sex.rds index c72313efb31314797a8ac20a31c0355bf4b9ead2..cea890afcf1b7674f6184433b9352e7ed2b4f912 100644 GIT binary patch literal 402 zcmV;D0d4*tiwFP!000001C5g3OT#b_$K$UDeG(tWd=L(qGSQVL>C$e9;G_S6ZxY*d zi=>I9aby3z$w=qcCj)7&-1oT8eYy7wgwQcMIXgnfCq6`%{tnS8I`{A3S?W?&LYLyB zmJZD4mnhv!%%b>CMvbY2nu8S!E812X4W>rX$;cgqv@(^~S$P@ZemZxc& zL1>*4N?6{BB61M1e3oOvf+(9(no-=tyY+ZWu2#XIaTf%OJt0(l)9wJT4&2zc;%Z6~ zn&*CYh7*#dl=e-y|LgJ(D+YZZ4m=n{3S1;b!3q*&Z@TWXkr1Z|p5<(MnC*C8J7<6=C@1zG`fBG1&@dleDeYT0Ni7}KL7v# literal 412 zcmV;N0b~9jiwFP!000001C5fwYTPgohTWt+w5O6o$Q}wq*_I8Bg(caNyp%xRBDbL0 z@~(<369l^0M;Hhz0~FjcHTXPJ$M<^^_*}8DF!u4qaepo z&+lc0DohEbtc9b-6pLEGf(=q56rl##q;DQY+o1eGnp3|o@Hz-;;M-BPJjppJ^Q3;1 z@v5q7NUbYE3FC88MovkLw;U6elIn)in&JiC*NC^5=8z29%pzGF389xy(+Tk6jT^76 zxM&EXoX6Q2Mx?GNU7GOyrOSU}L_GxK+})AcjRh9QXj G0ssIp70_k? From 0a7cf4b664b12628bdc520525d1523b9687d45c4 Mon Sep 17 00:00:00 2001 From: jrcpulliam Date: Thu, 13 Dec 2018 17:41:00 +0100 Subject: [PATCH 07/11] throw error if growth rates for groups have different signs but are fit together; add test for this --- R/extract_info.R | 5 +++++ tests/testthat/test-fit.R | 27 ++++++++++++++------------- 2 files changed, 19 insertions(+), 13 deletions(-) diff --git a/R/extract_info.R b/R/extract_info.R index 2b3a2b8..a05f01e 100644 --- a/R/extract_info.R +++ b/R/extract_info.R @@ -14,6 +14,11 @@ extract_info <- function(reg, origin, level){ r <- stats::coef(reg)[to.keep] use.groups <- length(r) > 1 if (use.groups) { + if (all(r >= 0) | all(r <= 0)) { + # continue + } else { + stop("Growth rates of groups have different signs; fit groups separately.") + } names(r) <- reg$xlevels[[1]] # names = levels if groups } else { names(r) <- NULL # no names otherwise diff --git a/tests/testthat/test-fit.R b/tests/testthat/test-fit.R index cdcfc18..f868516 100644 --- a/tests/testthat/test-fit.R +++ b/tests/testthat/test-fit.R @@ -79,26 +79,27 @@ test_that("doubling / halving time makes sense when CI of r crosses 0", { set.seed(20181213) days <- 1:14 # estimate of r is negative - dat_cases_1 <- round(20*rexp(-.3*(days))) - dat_dates_1 <- rep(as.Date(Sys.Date()+days), dat_cases_1) + dat_cases_1 <- rnbinom(14,.5,.1) + dat_dates_1 <- rep(as.Date(Sys.Date() + days), dat_cases_1) i1 <- incidence(dat_dates_1) - f <- fit(i1) + f1 <- suppressWarnings(fit(i1)) - expect_true(any(is.infinite(f$info$halving.conf))) + expect_true(any(is.infinite(f1$info$doubling.conf))) - # estimate of r is positive - dat_cases_2 <- round(rexp(.3*(days))) - dat_dates_2 <- rep(as.Date(Sys.Date()+days), dat_cases_2) + # estimate of r is negative + dat_cases_2 <- rnbinom(14,.5,.1) + dat_dates_2 <- rep(as.Date(Sys.Date() + days), dat_cases_2) i2 <- incidence(dat_dates_2) - f <- suppressWarnings(fit(i2)) + f2 <- suppressWarnings(fit(i2)) - expect_true(any(is.infinite(f$info$halving.conf))) + expect_true(any(is.infinite(f2$info$halving.conf))) # groups have different signs for r - grp <- rep(c("grp1","grp2"),c(length(dat_dates_1),length(dat_dates_2))) - i.grp <- incidence(c(dat_dates_1,dat_dates_2), 5L, groups = grp) - fit(i.grp) - # what should be expected behavior? + grp <- rep(c("grp1", "grp2"), c(length(dat_dates_1), length(dat_dates_2))) + i.grp <- incidence(c(dat_dates_1, dat_dates_2), groups = grp) + + msg <- "Growth rates of groups have different signs; fit groups separately." + expect_error(suppressWarnings(fit(i.grp)), msg) }) From 0549b3158cc9a4cc46dfb5d0478808b7fd45c500 Mon Sep 17 00:00:00 2001 From: jrcpulliam Date: Thu, 13 Dec 2018 18:17:02 +0100 Subject: [PATCH 08/11] adjust data generation for some automated tests so not relying on groups that have growth rates with different signs --- tests/testthat/test-fit.R | 2 +- tests/testthat/test-plot.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-fit.R b/tests/testthat/test-fit.R index f868516..cd11c6e 100644 --- a/tests/testthat/test-fit.R +++ b/tests/testthat/test-fit.R @@ -5,7 +5,7 @@ test_that("fit", { set.seed(1) dat <- c(sample(1:50, 200, replace = TRUE, prob = 1 + exp(1:50 * 0.1)), - sample(51:100, 200, replace = TRUE, prob = rev(1 + exp(1:50 * 0.1)))) + sample(51:100, 200, replace = TRUE, prob = 1 + exp(1:50 * 0.11))) sex <- sample(c("female", "male"), 400, replace = TRUE) i <- incidence(dat, 5L) diff --git a/tests/testthat/test-plot.R b/tests/testthat/test-plot.R index 2451eda..ddb0afc 100644 --- a/tests/testthat/test-plot.R +++ b/tests/testthat/test-plot.R @@ -3,7 +3,7 @@ context("Test plotting") test_that("plot for incidence object", { skip_on_cran() - set.seed(1) + set.seed(12) dat <- sample(1:50, 200, replace = TRUE, prob = 1 + exp(1:50 * 0.1)) dat2 <- as.Date("2016-01-02") + dat dat3 <- as.POSIXct(dat2) From 475f27a6b9d29bf9d459fa505a2e087c8f62c36e Mon Sep 17 00:00:00 2001 From: jrcpulliam Date: Thu, 13 Dec 2018 18:20:51 +0100 Subject: [PATCH 09/11] regenerate reference fits due to change in data used to generate the fits (see previous commit) --- NEWS.md | 2 +- tests/testthat/rds/fit.i.rds | Bin 2812 -> 2889 bytes tests/testthat/rds/fit.i.sex.rds | Bin 4430 -> 4602 bytes tests/testthat/rds/print.fit.i.rds | Bin 353 -> 355 bytes tests/testthat/rds/print.fit.sex.rds | Bin 402 -> 404 bytes 5 files changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 5b274c1..764db84 100644 --- a/NEWS.md +++ b/NEWS.md @@ -16,7 +16,7 @@ incidence 1.5.3 (2018-12-07) * `demo("incidence-demo" package = "incidence")` has been updated to show use of custom colors. -* `incidence()` no longer accepts characters as input for dates, first_date, or last_date argeuments +* `incidence()` no longer accepts characters as input for dates, first_date, or last_date arguments incidence 1.5.2 (2018-11-30) ============================ diff --git a/tests/testthat/rds/fit.i.rds b/tests/testthat/rds/fit.i.rds index 5ac047e5e47bf26aa305dd854f507e410e634c78..ec64fcab9e4c48c9016458b415e098513c5511ad 100644 GIT binary patch literal 2889 zcmV-P3%2whiwFP!000001MM3LSQA%zauFaP0U`=0;#s`1fE+@*&a)nPuD5t~AtVzF zB$JQ>skUCNYwcQbwH~W3idSvjQf;fX+IFyhXsK@Pfws1`R;{H{q#y!gkMr9=|$~>BE zhEpr>bxF$xKC@CxHDuheCFfOBH!BOUXk~Z&=THyLve1%-F4X2{};ywn{+N?t1V0=&}N;?oTu3_E~Y7sy}qI zwhN9?SLXIu7n*dE`elK7uXtyF>c?Kkl#9qK_^!y$#`mp};TKOnBT^&=;|*uh2TY%s zOZ`xt-EGsx4a}NALKqXxQZXzQ%Tj|_ zDvqV%St^005?N|6OR>+0jdm4%aW7R|{%g_8fat54-4{H+ow{*mSWocMEd1;Q>HNZ* zk@#;aav3-*$1A>1fAyokeU9IJrRv(3AI-s=OXmo~8(#p}skn_=#19H!j8RtXNbSIQ|{n9vnG9D!c-)zogGzIL8kN zf}^)JChP!$Z?K=OflmS9mM{8O{aOY@s=^%IaRU(d$vOB_p%)PUI`nqhf&w7f7c}(S z=?TEgdTIHz=+i)&^!BOGWpjbF`Gue{KV!iA*p$?g;(r34mwNsSY>s^_jozsSAykV1 zhBygSNmOy*<$0So+}MMk+Sx^}L;;o|Jttjk@=ksv)n^i8RJD}HKA-~96ZA^3@1 z&yM}2d@BBNQK__|>l*xsDQ5ZE*9!6dOFy@tQ$*ke(~e#sg>$K;)Z!)b4P&W2FBeAR zHJ;*md6 zWu^}mqP<6{vy~kaMDp#_xlF?hq3s3gyGteW1>b7imIRSTXK)d@g29|2-t-W(a0J6~ zkBPO(v3pzxIRf!gSuDCtvbCi;t(RGdYuEmC=)F5f@EftSlb<_1+hr^aFwSv;A@je! zzUhOvMsb4=$EhWV;~XsRb;mN`mfg0tiyQ)F7tB3 zUl4sUn0YAUgu7ZIE*iI9qRvE_w=R{t1hCwOB-gb;l zd3@~moa6Y?-7iamZ-XHYoL~3_|aoFSoHNkQmJx!t7!(0(ZITkiXnzkhhtz zn2e-_Xgx;ao^DDUJX-E*Kis)ZW{Q-0(bC}66$1cL5exWNnQqpE1%sRDu zvyEK&u3Bnlpu;_~C_;9?q#E_gr<_(_NXVDQt$ z3?2d7DX={Tw#UKt1lXSVBZDVLGI&ZlgQsp|@HE(;3j1fILy6tL=D04w7$_S;6n5;s zEic604#GmGR?(XC!krN>F5VjI;aZr7YY*zx;SV6oF8220vfR*UHqKL`5|dM@iy37r z+E^`p9brhRHPg4WOvf_p2S@p-jf7UKQ|k!Fa)=&9SacejO3#Xz9zv+uekLnmXn(EF zY9%zvT$SENpaH1(?3Cvpk)Nn*81ulJ;7iNUBL^lhagsA?jF$vcx5 zwUi>55(O37r1kkmj^R6wWUUPQq>~3Pamk%HUefGtfw9W?$lmC6lMU&FMjcY)%UEvHk!2GB{oJYl3_D0YdrfYsMeH3M7+# zmy|Y;zy~XM_r!@Yz+aIzg1V6l{%qm&&`G~N)4uaR zAoQ6pKm57wR}kLeSU+$i19W-*P-d|pA9UR(Q7QlZ5{M{@mR3z9LAND?(<*9T2a%l% z0*M_>ATncV%=z6~5LqZ{RK_o4<=Lll&9#~_h2V+d(x`(Iu7W3u%Bqy#9RN{-dM{od z7Y3rvZ5nxe=|<4EXx5x0`E}6m(kd;^{ZD<|Tt63n$=bHV|Ow#e^ZxE=dO?!hB=& zgSUgxUblKz`HuzTPgZVuHR3Xu^yw7w2URb(v5k>9W2)yekBE*)Y~nu;g&vX3WWJX` z=@=35m{mBO!4N#{{lw1tfLkaSf|%Q*8U*!~i>i@>J%nKBQF#KS6ECw;Z6viQ^gB{- zl!j}JwhXtKauiPY9yvU{n(1YfgO4i7yjl?YB(a z)y{h<@1>skiC}fOn9(g?2<9H2b1ZY{teR6$j@-*pnRWb|Kmcrq(%=XhJ!y!dVIU23 zs*feo@DvS0X&6bvSQ;kMFpY*;G^Ej>ahX@#VwldA-XDTv?m=)48RP|l6oP}FV8}xT zeCvKDA6|H7c_S!UWZ)z*^M* zKLYM|X;PVKHrh<+QlT*A?L35#%SI*v>hM+D92R8No)hs9Gi|nGrLHFLpO7Q-!$;)2)}7?{2r0jmESb*UfN1j{HB3F nJ@Us#CjRsYe|iMtPmiF%t{`83Z>5<<7H{toAmO=mkZg{NJ literal 2812 zcmV<5_o#1yl_-jA|hpeVnr_e$+yn58|XW)sDyW*?-Wm6@6!eH&^9Df?!3 z?j3fP#nhLDz2WyeoO9>iy>sTAbI<+HnfqWUhG7IIlj9g6<3yRt^AGYcuB)r3AK>e& znD4_9$jNVf-kZv<$FLxRyN+W)SQn1Vt$GV(=Y$CFWc)>C{AjC#vKgp6M*_U0FzOwY zT{D*xTjA6y_G{BKjnps8UHCf}v3}d*UHJa^(4Rk9z<#DF-}TCPD|z744<~M3=^zh0 zGP3oq$_BD&rgQ1)%WKIN*RlmmRkfu1P2JN+8rK5+$&Ihu_k2!XnwL1S2Sbpj))x<5 zQd3HPzOp!dlh(mDxUwdHF<=DSs6AXoC!As%Uz#mzQWvx5R_xfTzM}{GegE<;P2;NB zmeCW=mM<>k9}#!Mr&7U3z_mz7L_!i01|cCC2`NZOMM4@9bWk9)0|iMdNQr`!BuIk< zDOr$G1SwUJ(gaE8YiL(o{n#`8Obof}?%vTWb%6aP>(K7B@FH?CwRwPMw~IVg$$qQI zm`i?{d^Y>&p;Gdvkq3V+-FJq(TzWih*_^ilwq^I|!iUxY{BXn6B}Jv=C1UuSyc_T;E#Gryb>&z{~ixmmfp8{1M*v7qvY|F9R6 zH|#uVX>{SPRUz~5IM#uouM|Ff6Z^xt*Sc7^cO`fNA6gpV)w?cCuJ{DNkOnZM0siUK z9($TU0Qgr=#Z>f)1^C77{mp3wfRKNia?g~#fau<5Sl7a6K*WyEJo>y15Ce-QSHD>Y zi1cdxV+VTyV(c+<_IV2+rbiX3RW3l#_da$ZsXHJF9n0&oa{;mRpJiqFHGo*r@M7*W z5rBA6QKhRk0-`$Yt-qW}N03O-jgfRJDp3Hx-aMJ-_;3HwOcr*rVmjeQ6=77*~r+}QskzzOm-2Mn`L z3TfJ5gzH8z!ERnb1>_-aOaLie+*gfCLb+}w{HZVmUkDB3ikcAg)XAYXPH)AB8j)db$+oZM1&2*^AqKRS7cFc1N3v-Jl5~+-;gfx&z!= zVbU8MjE$R)@C%oAtBPp5-fmS1fyr4Uo;N`N+$6Gj$L3ISp>5Ha^|L9nKf>(*#>*L- zk+S(j4DN3?8m*Tr3<|MP_B_UFr`nH^`vXL|M@Rb=<3~Jqo{chc&VzpI;l2)EDLr9w zuLt*g+)wzbqp&(Hl#Mp{H#(qy!@=zhTb{>V$ODqHS~ zAwba5p#IwBSprukzuc^Br~us@v)oyj8$`4^pUfHd7Z7=*XV9}`J&3sH%UyLN#sS5} zjQREx&wyZle$pLl+n6|QN<04Jim&HY$&^SB@|2(t4{zYB1&D?`0dnmko~J-Q1abg) zp5fy8aM&IR+hbsRENoAJ?fbvrd3FrXADG4Si7)Vc66~K611)szo)RwsJ|KmZ(cO(* zbEMtk?gVL|XS?hydf;1;E$ChdZUBg4Wk9c)Fh*i6g2+|p@Wkg9f~a-lmQxd2fGT&|nw<5;Kvf(2-WmH^psK1a4%*}ZDosgxpM5<+ z)U;7=EsA>@L}rf7p3&tzh`4P@OURxcAbjhKjj~&_fpYM%mCB@S5b{y^#&J_?LGZH4 zsb)4x&=2e&o-nPkgLHHDzUuKwV92&tlm}l92D;p$`u7Yvkea`41FM+`k`F9=!RZ(X z20fc_$n=OAByD`6@1rB%21x^EFxk!ZAnCS}C9k=2L6ZG+jq8a;NrZ!NNF)mf@J}J~k2S2wuGZ6D{~~5${{6@G3q~=GoTJ z=`F9JP$krJ)V&)=-8t&TktbQiaTL$d-5e!yl*-Xij)rkGf}>21?&oL{N7Fc(=`&|g zTTps;^>9d@d6VGpr*JeF-qWM8!iQvV4k69nBxy`2h4@y<(3k5#OI;kYZnyipYYEx5 zPY;e7%2Yll}5Fb70bWBuwLo!|ppA8QXhrz!dhanEyLfP~5C>4cxKjaq(*#}1*p$4ZX zY8-R{)j?qS93J(muJ-kd+@5Flmi6SAkkrKkyjc$O{VMdm$@|y7E&gG?lcvzjK9&&4 ztzwd11SH5Iy$E=D=iEW17XfKiwlkIVA|Rc>`28}HbOJ*r*X?NuC zxWg+Thz(1WU=$MzmS0g+Y!Evlx&);thzPbABQX&RMglevko))Ub{CEkP1MAgz3&_5 z&CZ*$Z{EE3=FMCDH4p@$BMfC4LT6wgLtpv_&$Y3t9$2mf8nSCP#m^W7;v)in{O+(b zS~h>eqJ#C>AokjpJp-=>VkmSBkA^5A>R7JK3yES0F+f+^7=Nf~^C?fn5`?j$MT781 zs^K9bme76s1Pm-f6^027}>4{L0a)?S)vb$*0qkQzmHaxdQSH~x(qF= zzF!zO@h5QOhxv>#UWmXDV6T%!Q@$!y z%PFA?5)wsdonxSDoYhS9m#r=WYqwqKwVryzv(iR^>WpdWm-2dp&7TFOYWAH3YU)fq zH9h-*7cs0+;~iCjWU$k`67S3C;{lmpMAJ-qgX>L(*G`-=1r1eS-wrex19s(GyqI#CD_;hh z1gE?uPDPpn0Wb-`kpPAffD-`>Cje&x7(oCoI6!w8N?u^j^r4Q>i*vt6Fm z`GDZ_s;QvS;%=N(ninXYy7<=lLM`-`a-^vnFB3eos<=C9`Z(}n;?%U$dlEr&_4e4v zFf(v_PH^uNYDwttNr%EWY|=-Y$4`o1>&Havjcz1=r@9fnYgBe*g8>gsW#7MhG+`*n z(U}r&baFJPZ*eF}l3av{vAgT~GY8O`g*M5nY<i_ts!oMxgAY0ZonyCzVeoA|NWo~fWx>-@+4$Jl~rwW;?) z7W$zl)n+8{b=A6IySKIBRQeR>I?&McTkF=fzkwIankUb%6ZRA4rta_PY?2W0GikLh|D-030h3_hdyzr0WDjN8b04+Of8juzSbCPR4>tI7>=dQL5qz(?A(# z%jJ1SzSY`?cWeg*PxeNDJ-Yw(JWsffS?00V1cqBB#?e#L!5Mn6tKa?6;I#hEB}wad zfn%0QYodZm!2ZxGxNYohkV^B-E;%v{ovRh@o}L?k?(od#>Zp%K53Xsk8E`5A&C5wu z`DlGAdiJpO0{3AmXz{+ojpNEiXleTB+0(hV(eeoqVkf2DXoXLvL$2>F^zz3~YdzC? zflGq1Iz@KPps?xDkm zGy5xO$+C&NSm{k@iJDbZrilf5ens=J=P6$3dCl?`pc;vuTe<7Zm-AMk=X4U1Eq~vm!VP=)BR!(gLgNL)6SKcX3pP)ASz@1q7W5rl zpr2lap52Bd&oEI!&-T0Om!2{xFHFWCrf`akKXyTR*(6V1-U$vAO}JRN#~Exh+PAJk z`~wg|kJ`ru{^+_@PRDF-Z$mR0+zm7a3_uV2MekZ*djic{wBq*@SxeC~j|8Wl=gvTj zKA)cKc+L?$Uoa*h`l>ow<}k$Oz%M_dI^;KuLr3 zq8_&vfO2;`-`J(2LB+y?@Q6)gIvgDs;hZR3^w4EeT_%DQP}DFK;((!#<53#mt!n^X zNQq7xWwR=XuvYFp%2kX;2&beU227gbZ(Tq0|jEJ zviX82F*gLGnu@$irQ_&rC<-mL?7es~908vvCj!ZXFYugrO?3`0j1$h{g%NM6>|pO? z@7Pgx@x`Jy^PrGaqnsv`)8vEDB9zmFa+>@dIps8=oF>S7AnYio3FS1QoF%bYvt2KZp|6 zD5U*Lg|p>Y#0$3h^kPB;oRCni%$M7KB1&A2P}DX-U7TWilD3KKDR&TO1RA3FqqWOvT?kbMLhijzLX|;C0F1~sa;kPC0oth5zFjv+@=^~)5z)mP zYGP6+%AOk%%HqCR&x(FUz95_>z$w6Jqm1;e6<3Z!h&`lj1JXKr>IE!eG@mDAb;coi zoY-5+()SVmA;T;79W7vmW9)--PH)K@aEqptVLhcDRVgFV6==y5N3jH)u&#?LayIKA z1pW$V;QL7D6|W(E-c!=`E6H{k?tDb#r{BBw9<5C-zk~X3YT^$tG{JLu86w*c0oQ#( zsA@iUaS&=X47B`I*?cjGMNFNLDdG2 zxx!ylpw8HeumdZVTnCXxYt<(~v4ud$s^;f^^<>+BlY0 z7@x&vbHX?*sYOZ*#S(JD#UWgBc`y`K7+Ehr5y)X}Hb*34h1OC*<_R9$G3Ptb z^6{cGoL6*ae)bJ(&kWnH*itPo#ieWExLxx$g9qe^tZcnqEtI&|Yd;CCG zHZ-y=8CbV_Dm1F?y+0wt8}>eSW;q9Z3i~Xh8D~cJfhI0J_b$793YwY)1l{?l6q>1< zPJO1b8Je}M_q><01NLpytT{1%Ei`XFWy?^b&{VDwsSULvyDX1)t zGmc=DK~?ebZ=PRRd4bvkzp0`W>mC z>8V`>&4E|Sx4zsBBr)#e`(2#^X)n2ge%ZcIiI>>?QPe=FA~6}26Zagduf5?ETjLJ3 zbmCLWo>syho(HV&4r4)G)urdQCa;8ghIe}QaiKxIk1r-ma<@ahPj>o<&-8+N*5wxC zkb0saWo(5iJx%3iOf&`PWlo4ar?v>FmOODlCNv>IlvG$XMQTCIz#$=rV*S_j|E z+qjw!2Th!KTxI-pXglxJkQ}rI+S^rl)kf#Qp$BURXMO1pnd`Qg7sE<8ti&JD%ZZK}D(%sz_$~ypBc5zzhV^ z6&6ca0t|7q;C1X4DTXC=Q~FNBLg+By_SritZ({lcu7B#Wc-LPui{Qu}tm|=uBcOHO zWt(Tl*$e9AI)=#q0kfz}_cx8;K^1{LW_+@Vo~6Dl!mkz17l(2=ya>X`CCc&!iXLy} zZVn8%fr|Ie;j#I|xO@R8g2U^E{k6$3x0%wN)A=C4;6^!6k!@6D8zsW1$Tljn?eEE{ z$Tljn4S5fQ9TnL|MYd6qZB%3%71{RTig{h+9URc8$Tljn?axQHy^RaZURc=>e@0!= zQ&;pK))hS!>qW(SQ5UaoKf0@*gwht2w)oJr1$moE#c#c4{Fby5nBFEDgaD6HCrma>LTcSQ?9^Nm!bSr2s6=#8UWM>Vue1`(uk5mU?2T zH28Y+iBWW7S!5?#%s zo2y-g01e`UqplQ0+t)>%rISP=x%FqH6IrV+`hqnR-{AkyxwCB;5#N3mixn-MG$P+{ z?Tvuf*$A(|Q~V}|XHTjPLS@oB;Lzr@3)z$+=^<}L8qwb~Y1GM@(rY7zf;H8Oyk@8g zNz!0MAp(PdXWyu!x@9Q9=Q3RZNth zhqBx$%boJ`P=21bJC6_B9;f^~l(wL>1?A^?8-5<@J3ZtL)D!ic-XG74G9%t&GlKd~ kkNQrJ`c9AfPLB!*Bq8cMJ?X0d+rHELKjW7Wmd9@Z0ENs3$N&HU literal 4430 zcmV-U5wY$ciwFP!000001MNHsToXt4n}kCy35O_nAtK-vB!DQi&RDB>v{tJW1QA16 zG#C;H0TB^xwXLGIUVo~EzxQn|-r!LO5D^3c6-7~76cv@Ch>8MAzD=^bB#6~|eD$-N z-*1>>-^`nR^X9!bZ{Ff(h+!BTzT<#rD~4~iHj{uS<-eIK zlJr4Ec3j|5lQM8BHFi#*St2SvQu(mR^91_+j&njczai+(n3Txb)`QSZ%dc;z1oT9Y z%mdDRncN0Ft?UQ}B!!{}d+z9Gk3EO>M%j7pdAI^qgx{0;n)!p0e4SIbZA9RKrS0-z zd;l7@*SF7I=Lw$f(+lBpH-oy#vyFFkya7sP{aWv^?=-m3>H6wYei6Dc;>202zPnIK z;^TYXtYWmOiz{!$0WPZ2xtn15tPDNgo$u2z9#@l{r64J7OHz&HLKXN_!IdhwQ3ZFZ z(4Q)JP=x_hVIWyxyY!<=E_8`cmt5(R8(ngzOa1AR2VELKmuMV(8V8@o!KZQXX&ihS z2cO2lr*ZIU9DEuFpT^-z<8Y;MxbihwDx=4t^0harQ&Hoc`C*k#W5KENKME>##-q$> z*D%~HqldqLwb#i_$NnUEzA2~dn1c$QmY(5`S0sMgOi8a3cJ zD7OO(bbIEaxcF(t37O@nDA;J$x89vl1*|?V)tQRQyR0cad3qA64ZKoyF!ly|xOyWy zW570aXU6hd3cJ(b%;LNJZnBf;^zZk#+h@-M6+11xtj>zT<4)6UhS^quruJ97(gI?D z;@epJ>ZAzpBq<>*J{*9u%4^pxoZ`V{>(S2=N)Dmx-%J->Kc0-vh1qWF$(e%EvaY3O zIN|7?wM*adfx}RPZ;egrB5UcRn_bhBZ!~)KQu*}PWV(V%LgBUN+wCbmM+?;*j zS>lpw9ojpCr!x~_*C{(dqj>IWhja(f5E%cI*Jd54A06ZGKA{tM0;K65ZA$`m-Gb$# zMlJ%Rpn@DlmmvR(sgS)PZ18~X5s>XXchNUL?}DtuDWwI8HIU_fpu5$~eh@obB$+%d z0%Ae84sH+F4HOr23~v2Y4w`EEuZ@otfTlJg53b)e@XR*()W(6q;OT(EkO9^epm8kL zkl!E#4Iw-$fUOFVZDcMY^dMTByOS0UY46C)PLuY%P z0y(O@;NO;KMDCoKVG)`J1=%K#*4Ru1S-y78i$?wk4*!z&q~h}kuxCf_WxwiXf(_#a z`Q49q065z(S5lCK*6w)#D%LMYy94y}96LNghbAr)Pn^6NWu}^nhL`k0InL)>07i za#wOuLdT1!$R(J)5)r!Edb-;bPAWP-q3rXAKFQ!r-_Eld#dRR3^j7fZyP^MW{26*G zIuw4iRm~`ntb@#$>v_m_KgcpDH9g$h7G$O5`J}lo0LPpUC+`Ihz_F~IS5rq$0@*%m z9e0e+1=+Wjg>MPsgX1&j?cE?s0Xc1B>etBiK+ZZ5NKS|VC)@(Q{b~Lskn0c4e*FJb zkXz07UAWa66>hT-^iF()3Ti(3(PP?vR1i3FgqPqmlz-BX1HQV3@;&h1hI}?1o!l5T z-TM<0bkgi=mr))YP+r0hRbTWSh;pk^HjT3@M7e(3gM2&S=*01K>j0BRbb^2UY!GJ& z%2{)Ead5o@$}zs`9eVdSlzsE*Vadf?D0{qNw5%v0LqM+oSk?NAAX(2COY*~(yQl6n z#ts8ZP94rlNMDW?%^SY1wrLI8yp7nAmlmSE9cFZHn3;tRU5>Q7u;38N9OJh9(x@_Y zoZl~L-lQvo8WigFe3d&1P4S{e^RY{_=c~CqYL~mCOXE&({p; z+p7kYgr-MxM~!G1i3SSx5j8wjNmxl9lxC)Sv4K>~6$08CW?Jh==P$is1oyoKVXv8v}o>LX=R9TP!q ziA6zCWgMt2duBZT$|+FWDPc@(a2~ktwg29xBkMJ0sWC%UUD=;CD6X{j=Od}ZF)b5H zYX-U$eIsRLNjFj^h^9!W8zG93$|;_gOT}bSM<$R=Yk5i)iV5Picr)d=+D2Tbw@50j zf!Gv8D6X;OI?apx60+-&iJrQrCrMQL4Wr}&X@5TwBU1X|(*!ybv_i z7{>$SczEwM1mk#M91m|JXB-cVl!MWG?>Pa=p(Fr7WG6LMUmyXRsioQP1wiUrTWt~1${QLHQYV}z76jwsHyc^o zHz$>a;4+c|oMy@>-&%X+M3mUWnl~V;rDt1)M@2{_QTX#PG>=nzOIP_mQGdzs+G9t^ z@DPH1NY3e?cmr-RQZnoirB_nPh-@udN}|JYnMl}rRZq=kErh`9a0a=LOkeUE%64-_ z>#wBRVWb03C75l&P2ML>4Fm6i`^)dd?c^ANI&~dl>-PY!9Z^uf>rBsSOTU8#;w|yZ z`qV?ingRKzn!3WaRy9_Zf0{uf_s#W2=aV6aSCKZ`<1?VJll{u~_oc?6$EEO)Ikml7 z;)g5}zCL5{702>pviuG=nub)hHZ!G_J2Bl2sGU4e?Dns zcd8%Vzs37dz|SJFUb0sa&`Wt ztvVk!S)Kck?Y?CDKa8JX3FY=vR#+R$&Z1GUAV zS{Ts^tG#mI*OW5WiVsc+*|end-`6-DsW)sz$#kNgX;7qdD{Zf^MWEqU43jh%VUkyUv7!G8Rhl&`^<3gexsg3KbqD3W*ko z>E$6na3TF%ZRxAaCZQs^91r2e2*lAi1wdW6wme4|g@p2`u_;{5x2+_uSW?oExP$_+ zxHXp14VQ-C;uoDasQWv%rrV88Uy6Otv$q#5I@W?Fe<{`ITL>Mr{-j^Sj`icv?$9NR zFGyB_c@M92_4Aqqw)8hOh_@C=Y{DG-Mp_SX{lty7Bw9E~to*xqjEus!=E9}`Bn!A<%5mtW!n%*4oX+!rF z(BzW1NH9SkI{9auz7jeV+Ar>Z+1Tzn>^|+tpIf}^p`Cxf0JI?-cJtkJ26!%qw!*M6 zkIxK+UFv)4E*=~SJAZn;-_k58?6`I91b6EqXw%&Y2YErT!=4)@S&w?c_P(qm<|Y-; zs_ozcN9QVNS-NuSmL6B2c}hyZvF5?hEGgRR)9?4tbTBGym)UuLBW#;~{Ac&#GH4nd zV>ox>J!snKd-<#O{UFzRropVpRgjCBCyY-z1WkucateCv3r%Vh9p^0W1C8~6d9v85 z7c|&-WuoCG7SwyXbpLF-N~klWo8M8pAjn!b=g{FV?Lkv;X3*9jJV0HS;-|i*#h?~- z8@XbP9W+XI%>3xma%eiCx+o{63Ub|Ytrz^C5#+A-IoX>%3UY7FJ(rk3v_Brm-WxIm za(`R4(&%h9xPJq-|*z2KhnP z=?0HR-@Fa`-Mb@S)3qP$d)esLmD@$I*RiTW-tLvqDSrFG`#xu&L)GV3Wd}L1NA0I; z$`XrV5835`nGeHYkFo4|jVFR(j~L6u!*_`G(_y@xtAx-I8@yed9S0qA(i`Fyd<}=j zlrLj5D5wcgYFO(2= z%njmO3w2<_k^RPc=gzQ!qgNj@PQS%@JyQkpEA%Ql_{g9=&X=vpA27Q{trw{LA23x~ zbv3gne$$ij2!k+`8d>Q#qL_E8KpZ2IOrh*nvZ@Bx_ATqaz=S7FMsjSCBveXamC8g@ zM3NUUx(OYW6{OrF&zt5PakvW;hsDHU{ab_+6NkmbVZBMt#9=XUSnpa;F>zQ-92OIY z#l>aaiw%NakYi;E=<_VKH%7e?JcEZCuN>BkERU8*}l@Ts(hR7tc&&5)+y9Z@Er< z8?i{;6pR*Nw7`d^1?W3HCfeu~qm7hLl~$ojf9jBwv&B>nC(M#a)6OsB7 zNqIW*Aks%f8cd{NL>fh;F+}nwQqWuIPt8N~7}ADF=0xg1q|QX@O^$7(Bnt_{!J6f+ z<}t>AoRcw;IufZTk@{e&(}bGN8hCV@`+tb~gRu?NzgDj^wZadm&ska%{LSC4JTG+= z3Pt(fkvjBK1Nl@uh}^jU&^fUgja+Nn>iotf|~zXA@}j)Bf5*!lP9Ir3Tq8 zU|6vlL4zh3<#2c-DZ_qGq|9?x5x1EDT2@gL_6ia}%UcqFX+;@OW!6G+S;=L2c_@zd zUT7m1h2v2X0!oLqQGKuzL#r(o^}tXVt>jg?DCR}7N#j4rsHSeOx$3%65n@#YgDysM zsWyO08Pve*jCt^1Fb|lozL>ARn6JK=ufFKghZGz~85zu1 UU#gMc)33h%1NgdJ0S9aV0J*4}eE68kpZJhLm{}% zDW|*!y&_Nv#>Cd1s3wid+LC(!M}k}ClFV7_ajM}8HGCcE14U;#^675?JX^|FJF|x90$rK?{+05AmV_7N ztD+jj@|zU;t-VF;M#wykaA7rCTCrnM>u|g7s1m$N@E)yQs(}60TaUt!VpK(#A1UPj^iNiQ5{1q z#d^u?JZ=}+CoyO!^PTF*H+FysW6z(4X|K=opFaN>Vt6{iiTdGQeK7N)1V_G2`ruU$ z_ik`Ml9ZWIsB^E9xzTIfJvwV|X`zkl3S2)0V~83o9)x$OxS=a)+NSFe!K2^6n{;iu zMbbplY{PGFGSa#AWFXDIy!Uv&_vd}wAcO{Jcy)mWLo3m(y%ThauI)R1;j-ivlO_AC zxdFBMVx@WYQRLrw(5Q-uC1|$RtZliHplT3mJwKL%+A$4=H>_9u6mVIqB?#UcD3vq? zmt3yFY#7u^2(@>A+_0uy`jR_kI&6+|m@aLerI1VwU zNkR#U!Rm+*n&CwXJvMNSLJL*H)P4OZTpFf#g*f)RhtosC6dn#L&z$U%JkQ)Uj5D04 z#PueW;wYzGl1Fw)F^%&$TDT;NbCShr4==EImD;X^b7*>0&Sc97Rq@jv5l1~kPVE>) z*n*ObCIBf7Q=C}U>-Bij>mQDc`*xgJG4>>chB&1pacS?e?xLPDio!Ufl$=L9pf?Nj yty#6SbDAQobz!HrTlcqdF3L+|x3Pt3oPb@F_8F*MGO=xBJNpH-slzq;0ssIp=EPk9 literal 402 zcmV;D0d4*tiwFP!000001C5g3OT#b_$K$UDeG(tWd=L(qGSQVL>C$e9;G_S6ZxY*d zi=>I9aby3z$w=qcCj)7&-1oT8eYy7wgwQcMIXgnfCq6`%{tnS8I`{A3S?W?&LYLyB zmJZD4mnhv!%%b>CMvbY2nu8S!E812X4W>rX$;cgqv@(^~S$P@ZemZxc& zL1>*4N?6{BB61M1e3oOvf+(9(no-=tyY+ZWu2#XIaTf%OJt0(l)9wJT4&2zc;%Z6~ zn&*CYh7*#dl=e-y|LgJ(D+YZZ4m=n{3S1;b!3q*&Z@TWXkr1Z|p5<(MnC*C8J7<6=C@1zG`fBG1&@dleDeYT0Ni7}KL7v# From bbda47f242939803403659d1d7b7b189f7304aac Mon Sep 17 00:00:00 2001 From: jrcpulliam Date: Thu, 13 Dec 2018 21:34:46 +0100 Subject: [PATCH 10/11] update NEWS.md to reflect changes; closes #28 --- NEWS.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/NEWS.md b/NEWS.md index 764db84..5474c64 100644 --- a/NEWS.md +++ b/NEWS.md @@ -11,12 +11,17 @@ incidence 1.5.3 (2018-12-07) (See https://github.com/reconhub/incidence/issues/88) * `fit()` now returns correct coefficients when dates is POSIXt by converting to Date. (See https://github.com/reconhub/incidence/issues/91) +* `fit()` now returns Inf for the upper bound of the doubling / halving time if the + confidence interval on the growth rate spans 0. + (See https://github.com/reconhub/incidence/issues/28) ### MISC * `demo("incidence-demo" package = "incidence")` has been updated to show use of custom colors. * `incidence()` no longer accepts characters as input for dates, first_date, or last_date arguments +* `fit()` now returns an error if growth rate estimates for groups have different signs. + (See https://github.com/reconhub/incidence/issues/28) incidence 1.5.2 (2018-11-30) ============================ From d40447806d532fa99412f063cd5799b83d713bcc Mon Sep 17 00:00:00 2001 From: jrcpulliam Date: Thu, 13 Dec 2018 23:08:47 +0100 Subject: [PATCH 11/11] minor; mostly adding more spaces to make tibaut happier --- R/extract_info.R | 4 ++-- tests/testthat/test-fit.R | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/R/extract_info.R b/R/extract_info.R index a05f01e..9ebdb9c 100644 --- a/R/extract_info.R +++ b/R/extract_info.R @@ -52,12 +52,12 @@ extract_info <- function(reg, origin, level){ o.names <- colnames(info$doubling.conf) info$doubling.conf <- info$doubling.conf[, rev(seq_along(o.names)), drop = FALSE] - info$doubling.conf[info$doubling.conf<0] <- Inf + info$doubling.conf[info$doubling.conf < 0] <- Inf colnames(info$doubling.conf) <- o.names } else { info$halving <- log(0.5) / r info$halving.conf <- log(0.5) / r.conf - info$halving.conf[info$halving.conf<0] <- Inf + info$halving.conf[info$halving.conf < 0] <- Inf } ## We need to store the date corresponding to 'day 0', as this will be used diff --git a/tests/testthat/test-fit.R b/tests/testthat/test-fit.R index 058785d..579e765 100644 --- a/tests/testthat/test-fit.R +++ b/tests/testthat/test-fit.R @@ -78,8 +78,8 @@ test_that("doubling / halving time makes sense when CI of r crosses 0", { set.seed(20181213) days <- 1:14 - # estimate of r is negative - dat_cases_1 <- rnbinom(14,.5,.1) + # estimate of r is positive + dat_cases_1 <- rnbinom(14, .5, .1) dat_dates_1 <- rep(as.Date(Sys.Date() + days), dat_cases_1) i1 <- incidence(dat_dates_1) @@ -88,7 +88,7 @@ test_that("doubling / halving time makes sense when CI of r crosses 0", { expect_true(any(is.infinite(f1$info$doubling.conf))) # estimate of r is negative - dat_cases_2 <- rnbinom(14,.5,.1) + dat_cases_2 <- rnbinom(14, .5, .1) dat_dates_2 <- rep(as.Date(Sys.Date() + days), dat_cases_2) i2 <- incidence(dat_dates_2)