From e9fea0f2da14831bf352af6e68573ddfcd529067 Mon Sep 17 00:00:00 2001 From: MThomas91 Date: Mon, 6 Jan 2025 17:49:59 +0100 Subject: [PATCH 1/3] added additional tests --- NAMESPACE | 1 + tests/testthat/Rplots.pdf | Bin 0 -> 40701 bytes tests/testthat/test-DesignMCPModApp.R | 4 + tests/testthat/test-MCPMod.R | 38 +++++ tests/testthat/test-Mods.R | 92 ++++++++++++ tests/testthat/test-bFitMod.R | 109 ++++++++++++++ tests/testthat/test-guesst.R | 29 ++++ tests/testthat/test-optContr.R | 85 +++++++++++ tests/testthat/test-optDesign.R | 131 ++++++++++++++++ tests/testthat/test-planMod.R | 63 ++++++++ tests/testthat/test-powMCT.R | 100 +++++++++++++ tests/testthat/test-sampSize.R | 206 ++++++++++++++++++++++++++ 12 files changed, 858 insertions(+) create mode 100644 tests/testthat/Rplots.pdf create mode 100644 tests/testthat/test-DesignMCPModApp.R create mode 100644 tests/testthat/test-MCPMod.R create mode 100644 tests/testthat/test-Mods.R create mode 100644 tests/testthat/test-bFitMod.R create mode 100644 tests/testthat/test-powMCT.R create mode 100644 tests/testthat/test-sampSize.R diff --git a/NAMESPACE b/NAMESPACE index d066384..fedbbce 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -49,6 +49,7 @@ S3method(gAIC, DRMod) S3method(predict, bFitMod) S3method(plot, bFitMod) S3method(print, bFitMod) +S3method(coef, bFitMod) S3method(plot, targN) diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf new file mode 100644 index 0000000000000000000000000000000000000000..95ede8133ec21dfae696e23abf1e80f202cec9ee GIT binary patch literal 40701 zcma&N2UJsCw}KX-YiHrkq3P-2;^_g9y>NqAdRkbyk)Zd5#DzqGxxca?q^Wx}U@(o9 zvn5FjvH#MBL-@6?ixr2kqM3)8BgBS7_=TB`l{<$xfS|?k-vpBX2LTC>gzaYK?C~$U zup-3S1GshPkorq5tYzg6@pQ8Q_}%~C_>mC);|_HzXB!V&jtA0`QXIlh?HoM-3xuCK z0?tvgvVd4xk@R-=0DR^|2R})ohNP9kA z{+DQ{uD67P^vltfdv+#K**_#OBJ!cSmV4i0k}dCWu^|*%_O|v+gwK}F8c$A^s}zU_ zvjLva)4gSxq74}gLIHM4T&{w%7W9vu!QT6vTp(PItjXwlNOgQNw5JO{jRGNXeS1e$ z!tjG51A}p6{Fs5mo{U5JheB~1iM>`y1>)*V8)oP3mcZWKqs^b!`$r2P1iCQ*f<&;* zo|V7z-u4D%cx<=s5C>pR%g33Ca6;9h4Dt9%X|B*872*w7SvKxBY;c1*EHe(?h#BjL6gpXteHbf*6dK{D4~Q$1 z-!pEPdimh9+LNqNt?~{#<`~a3u47KThZIecRf>9bck=cslQV@#?w-(`3;%DaeeI@s zBaRO)MF*P5_Xg(=)GYYtc7=BHwrV@vhq*j^k5ae%4#nklU_nM9mL`?*!@z(FZ#-Xu zVcnE5#tB4K%$kmgCKqg0NY)X}85)zFqqfG+wzK`m`R<1Fy~bUcz18zJx^capfZLcs z(?UA}P*;lZJNgTrRA9CG?dFEI?UqczG24dg^X?l*U)zQ#@GlnDK2EF2nUpecXB18} zw4w6Hh4-wGFP&N(X^PILo_L&@eu(blIMHXkpYNTBiVup?DNp9tIH1C-+l{z?sVe<> z_S>}Cct>ne55oNLC1fbm539HHwFqR=*y7J`s2pk-l35AroBX{bNIah){2KJHIya*f}0!k`Gxfba1xumyA~RM-!*;%br*mUXSj6 z{&V-Q`WDFua&jt<9(Cym4`bg#YGp^1jWc-X&4%&V<=KM4lXmEfk9mbP9X<$yXFoJ#)M7pgA;}*pES_Y(8fN2Z@u1_yC?jq|5_p5HRdUqwN(O%}`w}q_*mIpRX z*yMN}gE%j(Uq2nK?ZXA$w;Ugk$+p{lvsj^f!(03`sKX);X?-QHysYr({%>KW5IxF) z%}eeU38MvHEl0)9J$O*rQywNF)o*`k;;w_ZEt8&O*u-a=n_`mY{h}NTi+%F@<)KdJ z*1gav7EygKOhw$Mt%Rr^3y?!i>6)LP$K*cFMu_PRz&bB+iH`T*l&awCJqt>{Ve{R+ z|8dQ(U88^C?FX<^+G!EB78+sd*&fp+H-Q_(2u4sroVe*^UzRLg&bP?s2z}~n!NP~# zy$Fw%M|ve^48fo&)1bZJZ+{5pbq|$-yYGoh*(!_&ePNy7C%hTX3&eA5he?^TUbmM~ zyPeJbKBXk-EmI?C_cwk&dB8C6E3`_WR!3i?-l9H~K=@=lYyKj`=YCY^ZVi z_=orkge9&iNLEBJ=p_^TVT&?VN8Ra$>GlaL0|2 z<*7ndsPcsdO|#MB6|M+zZ<+2k+((x0%;sS(Z!bK`qHei-;lj#l%X$sx-o?ni+Tu+v zJS%e?o$iQm(nYE5@WqN{9X{6upKo%tW`*MUh`2u(Va%AJCSBWlkzl9G<)QQEqMpl* z!)WNDD<6)4^2ZNFo^rjQ26(3Rhi* z@qET~`NUQHUrntnqg^dH zuT*3Y<5#DvvLByKT+_WYq}|fmRC06FPlV+HYI1tMIk%}IWwCA?e!#a|@PP{%l799i z4M*$_rtD=rha|(&ASc*b5jWY(bGr4e_r_AjYaSMV_}*<(I}RqCXX|=mIIiH%=2H5h z0>;Nr#?VkS)R*GWIBw!jm$+jpgjDpuUO?4W_b~s6R#_ypB7rD`u30DGvYhQbzpU8P=wa|=vys0)-VGFK% zPCnUwj`zf%^$qGGJY8?A_4Cb=QGU9wwqqT{IYs-iVLOG3fs>MUr=fv?_&Wu{bRLX7 znP0im^)TY)%gDx$TMX=qf$r{dS4tMBIKN`d_EFbp&`ZriD8sVOTCRTyRafP8@Z)c1_>3`t`yyczC+mZR;=O*#YmmJME+Pgp94W zwWQ&D=B7*Aa*W~~7Y_W%T4y8g_`bd?o$l60LvJES=x6b23LVdS`1{UXc)6Gd-PT1KQE_qjs{edVa5R{@qK2RaU zeX9F8KFG6^F(7xVKGc|mvNI?ToP>u3zSmo3W>AhkYwoy3^b(;X<7X!;Q&7oeNRr0y z?73V82`_w|w17qe48@J#(rwrml>|hEd_TsLF7^_w=+gwm z@T+?+uW@M4{{7>s9pWzA>`b(JJL7s&*sIh#1;t)<5-s|qew7a$d zwz!t$!f%Q(t|X(cBKss8{xA%rxnN;SKE}^6A%kq(6{9JXcOIa6~)Q=N-kXem(R6{pXS1))xe*7yNUCI9i>(U z#+^Td67%N4-YWsjRFw9^Mr7q+fbqBUw0&sU1tJqRu- zn?mV!D2C;zEdn*Vq9oC$QHotv&gj-oKN9)Ny+@-HWzv?fEK9}FALfC@O-kX$%XgAc z;@;=W3V&<#6q$4up=!U)tkyxSVU=4b8%=HO*V+DW66vnaUNAz-E5kN3ISoqiLfZ?k zcVMrrmn#RIw}QsfZCwvHSYo#FgnW;Wwx0|YRUSbxYM!8zf|4vXJT5iY1mVJ!=!l>z z;^3Jn@UU1P`f;!Z1^c{7^SmXP4I@1EvKd*9_H6JMJ<4-}Zxi-`8X6#=VKYLa++|GL z6wo`dTnMOeR1dIk92<5|MSB1;MUM_xO18=hla6uQskxa>s8!f645|7iZ0b5Ylh{_u zuVx3_#@c3}pGc~aM?CdjYs=s;Gz66V*LT9ElY)sb)rFDf}IOC8PLQW$XB zV;aC!+zlevP=*P}D4aJ=#|P{(d9go(8AtVNW^sUd-(_BGlL1L9m?5vHE3k$!&V9qQ zX?*HgV<$psmr3=~pVN&~CAUWDcRr8&`~N7f^3rX{QNX@kjx_*ej+dyezGRyc7sWM` z7?gPsTOWxtZa~*hm2Sdjs1yd0r$&9paABKJHFAZQNd>=g-N4Q1v)XbAx8FEHK+)#p z)wTCV!yJWSdZ$WWu-k!|KihDe*AxO5m3W2Z&a6>tcUE~ngL2zSecM(yub(OjEmY0D zx(q6{35_{mswC^Q$$H3pLA{a0E2%4-9L9Nfu?3TsDWZ- zvk|uF3FDLnB{pd)nNLF8fN^F58Ot?WJFnsFQ?`YWO&@|S6l z=Pz#zU9m!R;ldVh@5ur4Z7O*Gr8xNF`F%2RR=6L2XO}5336q+ZdG`raNA*s38YSg5 z1yOMg>QklL*#w?dUe$O4&n{DR4KGRFHy3-aX>ZzFx*8!|_`Ze8U+5tN%H@#lrOcG-~uR6L?RO&bmEx+lI=dE)TB*u zdDapU8batta+Aha(28;bZT~$#Y0?do|0cPLy7Cu)Rw53b=M3O?10pXo!~?=GKTi$Z z@lWJl6E!gCgId@p)8XKVr7Z}QO|WiLoK|(VN1@a+gnNN4Q$AH875LDIUntsGD&DKumBsXjvgm{vo zirH9=&FhBEhM~>`n2u>CPFc(k70@R|Uk^*POCBIzp3D-~@DSo|YhBEV!Vo?unW<=B zTIcMR^GQ(qrrGqZ{_4xapl$l1E3}X&abvaN>h;V6FR?;mdq!<#Kk_u71$vQ7zi#2W*$$(okzPOe6MBe6Vh<8lA8#h$hweQxXGiSX+CR?K^*Wh{IC6M3OjsRf-^ zb9y<&$2XsxZe#csnyvZwBkh@8Ts?L3-bS##Dj-|gN~yg1ZhGg6k7pe6AIDO^^g(~0 zel^8d%g>0XK)9<%_zrThACA~hPQK`zXEp;9hlpyg_M^OI9z77z&?^@Tm8j_U>u1%= zE97eQf0buy6!~c^WsDE#~-7!4!#u8D5t)$ zlIJxjS(jO;ldPb5_Az6-Ht{YaTyh{=M<3N-V(h(x4SGWnK+Ry!9CJ;rfUNtQz>~1= z8U>{p{1Xxz|4>oKZ4|O{zdP_|az-du@~WY6yT3M? zm$l;kD6xn^39ced|P-ds}e!PdU(o#*%h-R9RcTb}wc|Nc`Cy4ygb z=WfiKXiSkMJwdsq9kX4o*+A2uT;C(qK=WAS)sw-zx4S&et@&8h3jkj2t{V+V|rl7fmD1`}Tt#UvOjV%>+9!i|bz zJPM#|+Jl3TXGJX=7Y32LFrnfOUI5=|?WKqS{q@Be~S(c>)L^UkTp!FK1?RH`eZ zDL*%=0x}+e*RE$b^sMG1>NGHvOdO$DDm5i}$NBh2CPUF@+t~ z^cfJYzhk`({eLmC?qyZI{3fQ+I1RY$X67NE-P!{{(sn99K)e zf9V5y@58266qB9Na>Up63*~R#Hdwa{ewN}#3&fyj#slXaC`p&j}|_@!K2GO+PV)`5d2utv>i5c?#4Rsg>Q;*&i_l8W!EZ>bfL z<>QTO86FEXbUo0FvKY!^R3k}-YHs+&mmkWIj<3WvlCO$pZy#jj z7^N-YdM@f@ND?>5`6<{hdCLxUI}-@lGr}2%zHh++h-mnBe;>~J(Nq$6G4OAX{ohvv z(*M<=|IaIe|FPpQD)Rr=^8btRzxVtlq{RNOdj2SOpy!W3m`6@1T8GRojfCInB%}WP z>>>RldfEcAd^71VW)2)~?U%jVu@9&#=7`e2ILq$?n}oEbWL+&=22roTr z^vCa`qs~sfXK(F*8x2=IjgZ7uq_;xjDF*Vr0*>EN4$V>c4Qde`6Tk8297KT)euO+b zJ|;>c(K{x@m94SJ;s#7n)xd)1sO<$Kn|`*194zR}9b}IGPs{%g(DLuAgnigJUL))Y zBcl{{<~j)5eN2lpr`w>dF`dXWU)&g6ws0{@c>cJ7fF-DXF+1D+HsB{?AOmLOPHT`l znU|V5Ui|DxhIJ3|59&bZTxc$M6oKnCd*ISZX>xGBC^O(8F?rzza-c}u*3~I~b#h_a zWKg=z%ec&&us$Q0&gHv9tZ4YY70Es!n>L2>ZkG(0lIgz;ipG;gCyXcj&v5;xRtgnP)9mPyvl_^B z>+?s_jz78+eSYduO04A=#YrAVM5PFVx3cQnw|`{Z`jI3~Jn7ZepTCPhvCJxQ{5;dU8^~HSX27+B~T`g`FfZ1 z$4mYUITh?rxkk>Ec(z~GL!l=s8z1{sy}=9L@{XTiu~~vueSYJxiJKBUYOI?Ev*4G; zx5kn-6yPNm&Ij~@Ls8=&Do2uKO+pv#CPokX0~GKyYt!~yi2HP+cym>3UGVT53)HG} zE_Qlr)X*hKsyUVX*mjNco`=S+iS%n(&a!WU8G2bh`T)Wi$s5Lx2*PKOU>NntmiqEkk#pxoO)Ceg%<^H zGdtc4+RDGkduhYIxV3>iJSzUv*5de8H%2z=$V+jtH_<8NsgE(bpF%aRy0y|=p8Q3Q z|7O?`-S2#XIhEJMioGTK1*gz?N?I6wdqO0n(5CWU9A|2u(>O2P$`SwU)V!#onW}}0 zDUyo(LDFR*go)w!PRsO%U-N7%u1#3#2lMFj$g)Y(2a6Kt(tQ5pY4VS2bD>=-GJY`j z7$h+~C5HtHhh0b2D{?s>t5(kr&yNeSHe*06qJ~B)N=cYcW%H&_3+TL_jSTc|M%}&c z6TviFbcwx~X<{}qVe1ClsTx6i^s3&$B?|OS=f{}q>~3QEJ9*=GcWt5%sH=8{-6_AC z%9gJMToaIycjAe3dnF|gh0~3fH_1`nemdn9*hTM;got2TX1!530l$K9%*PDz1! zEH=Fui*dnBw{p$k&k;Ii zSi==p;mFH7n~dEs**OAdHcJzAQM!*y{(ArP-p{s^#)Lr6wtR9dRd0`M@d_le-B6&oLma6kv`|Q7etzwS#@tDY zMc5~)+<=f&io!IARWao#u2Au1>6c_P^4f>_2h_^qp`PqZwr_8Q{;}oTp$f#b3|uuY z5N6ZhOdwz{eLsMvSeQK>g%U&kgQVPG7onf@HbOde!;S(jpNN<tL3ttHrPO_lOmb z4za1!htiJGMrJWpg(-8fw*;p})aVxobAH*rPHcR7((N+fbL;F}g2H1)wzf%-3we5# zIIgHUPqcVN*5}hXozsUL>TMCmQsYKdvbd;6NGbt%xSo_xUbMpRX7U6DrTh7{{BH6g zvsKn|H`4BkAQ%{)bFAQfMTBNztJyQA$PS>U7GqD<&sshig!;~u?D^;(5u!dVdDnj3 z<2w~}h9+i6l2guIXN!8Cc38j2agL<{-ZV?*j&PrkasFJ6Dr@wK(pNE z0v+&rVO5-u-A!N0cp-#p6ssfGCN`j;+}5g;fAm6*d?kRJ=gMHy3H!&8rb$R>$fxSp z$nT80^N--+sK=Y?LGwave;`4~?>~J)QP~9G?Lb(N$l~qdM%`>Kic#WgIr4rc@x`@T zhDKkF>=WtPL$`Y0manoKqO3M)@2H$V-svo^*@4Gs)n6ju7KI-i;^u^r-d|>6+F!}A zSJV8Bgqyk>&UQo20gbxXsb*ELeo#y>t|XPz zPtjha3fk$?=N&{{Md`JSj!1KHcq==kmv3FkADKS#Y2=VHeDv^|Y=LyDy0N>&gpUTK zG!*z_N;M%$n}nePOkK8q7xLhTGa*0H`2!jg+26=b zt1}2@Y-cyLA8Z}|URZ(I zp!UOl&@*&DY{`AqfMr4!IsB^XDZ$IY3Rdfbnm(Svg-fA5m~W}>*EF(7HcA>9{y0kO zDLqF2Q>!k0p4{1LVfPl?bv>kwu$VHp16aW1NA8=#2!X9 z^;IW-Xw4i9FqTwA&-l^FS%v!5Me6yX~8pk*SqVrw9JBbv8@<+Pfw$ro~k%z2tB) zBSyd8eAj(}SkAA?{_$&M;^L8=9#qm6GjiWaux^jfYdYrB?*W=QF7I2i_tY4ncZ>kg zoRB}|_G6CIxEuF|DCUvs_c@20+Pd4~*4~{P?z@#-_=yD<7MQ$7wvipFKGso2es{>& zs`d`K9fR2P^C{aRfcLxZw9jkT_GehOw6oRTF=Fn#RN}aptbfO*EcZVzp>SrTIbH6krBZ<__)JZ|q5 z0ASX)Zc{J^4>Gz(1D3elDNFslMj!8G7X=`GwoK7_z1Js1-CG_5*#Fdj@9WU~`z(>9 z_RU`FkNL09$C5-ndciXpu3mL{!=G=6;*rV<*Sz8{vadV2>MTCLjV)^fxv2v*t!g<0 zl5yOYwds1Zuabovu9Zth$D9kyC1E8c`##QQ)gQj=C$y%mVt$25Z2D2}`b({B+Q+fI zRJ*&SA)8j&wCX&(X7fxN9KA{;6VfcVPrWGBSLE*vanGyxe_oT&QSCeheAi?tqm})g z{JiQ4U^n-9RsYW^6y{)MC-G(KyZr1&%%$qR0&xZTZN>HppLduSZu{5rNh|g~=F2+w zD5=yu-f>~Ks@h{<#&?UJDDUusoA;MMeAB6pd4Q$}0#`V7M+6ZT&l-SwW6d3+u38$_ zH2Y?J0Gscm=mj{)_#D2FZTKWy=nZBk{J!ssfsO|Pg;Z=B9Osh|lsV#59 z8IaEFUx~6WRL;e-btp~=yyM%B2&wijj)}d>KoBC6v((h(=H+K!SXuZBchKv)_c0_l z?{qrd?s;g)uO$)o>x6Ye#I=t-!Rp2`?z5CSWdm|BqKEBWjxEI>_49MJU+`pf&Hij5rkQ*Ilv`5Sw`lbt5ReeSME_hblJi}JIt ze0hCI(qxiJcsj0OA5g75O$^|nC|VW~B3){!#8WQqWgSgYkPNxh{ze*-KyQ{me*~WZ&0Mi9$G3gpcik zXxR;ty&Tpg<0L?-l#6Ch<;wSBdicZ^%($)Pls*KiKHpbm6XBE2z01xi`-mGUvN+#s zqNObd<+eU98y?}c?Lja~o=yxPg4sH>DU{E6Lg2?kQ9Eb5LwSR(2vfo<`k6XtBnU?F zNqoG4JwZ%dcSK9lYQ?@}cT|Zvrmm~afayoAcWl@WkFmFb#@4)XpieJI_nq`2fBd%f9y1O<=dJ zI9kU#$pE*=)J>)nYi^lN_4f{j3_WACEe*0UmHYfeli-PI31=enS=l>p<%`eP4pMee z={Q~H;92y7S*jd*KB{hM;u?JF4hnO;$Ub2?Pc-!fxwn*chy>4-wI720nTk+_Jlg>n z9-({s8dG>j4eJrOMDmOcWFdHBq^$upy2RW*&%rcQNKcijmm|ma+C0_InX2mH6#O&I z6rR)&zv=3dG*)pEZAWTtTP+;q8nnU~Dz{Z#U2LopKL!bGyyBfO{knxmheYA?4QGm^B?KF>&no z+!eXLaaYI;bIKh`jcHW>GFDf_-J4;7cdzQfZ+j_pb|jCzF7*u{^BEUbQ;B>YC`RMtN7q*gv9XOZPk*f3PB>x!3N@OZ|koJ=2N|>atPg zT9XR(x4t_V*$NS#|Lntdzs_T2$+zj3ctb3d?M}_r^|+`YCQuc0Dyjt-HS-*C;-oIx zi&4cy1;KfuZ{wuatUlIvDQDknieY526e;8BLN*h`?j=ImhJ~cbx{$Gn$wpv$PMrle zYv+sehWuSfmG4?VHD=NT?md_VI38MJ?&74Rp7WFe99!<_0_?A=Xh{M$E_Y(@;G~X~ zgz}dbvuMq-mKH59NDEPsPbljs?Yp{oKiYTcFm>^au~7xn3-vG0^zt+psASy3`J~** z>_NIRL>ubwySkag!0X0BUl~8gNfj@}#YDAo1>fUcJXrpQxV|vc_7z5_FcNuprzqKk_TAW)kB=*VNDP9_giMjy5mIv<;48imQ z{@jTd5*h#-dtw{@rRq9T>F@g}T@CI^<_1v#z@9)n0F27vUQIBhC+SA-`~ssYL}i$5 zc>1fYRM$<~B}B+32g;_0SwEowSb{WvRS1%F`mXEH^uRb3$~L~d8uyRf&LNl0@0*+1xu6t15m;K9&O^RFh zxI1GHJ^n?V`Uw!E8QRGw{L5_nHAzvDGF034s4L(a?XH1)AXMyqPn=YZ&Llrhs#<3P zxE7;(>{%A-|D(in=Y%co*GP?r|4?hcM#Xvn6x%eV-ZSPazOm3Wpydqk#oqz(W)t{+ zU6AamxCi20IR=K_T~#+Y!=y7luD6vd@4K4f9GFMKq~Tpi_g&7=9%R@9_T|O4n6k2; z8N9ih`>y6)b^5QVB4gYSzNyy(cKTj&!AX@YO$+>DQX^{kesrH#13%Blz68@7O5mhK zw?G@)Sx34rZ|S*Nb|J$g0o6YqssFs-TBg42&YykRwAOK<9So#AD@*A)|!|V_r*NxTm_FWe=z|Z9(0gv_HjC$f} z-qn7C!51A@U%w%gV%YZ8=UFc{_b0vjm07?HAaZ&eMLy3AqX6{L6Mpt9YQ(;8G9?{A zWmJ1!^i4)|OINOq0N?kb5FhQFTf<(0}6jKNQ$&Q>Hr3a4x6JzqAYG7+z-aJq*!IominC3>G7eIM2o z+hzGPiL~(#MTgE3j`xI#M8w$|_H2LA`)qg1gs`1B`gxeB{i}dI^E;UNR%U}g^Vu<8 zfe>Z*RdCS4}!R`T?Ieb$sF7`J)WH< z9>8%@U?R}~cZ^;|DM0z@H)jJBoyPX`Pmocd09a-0FbE8Wsd@QMy0JI&Cc|AYD7>M< zxn#IV5h~^WTXlt>POuCv*uz2iuA1Mm&r$K&^tw$t$O4*?qd-9L`C+n8GCv1oK>dku zc>h8RQaC}r$L5w0zGowS%l*sDiJFyztitMY>6ZK`@!M_jLe#;+Il^Ah>k__(y6yq6 zKXqg0VNecaqXza+j4pMWMP&*bW%ffmUMDod0}qFWyj2FRHHjbjt`W3O?C%@P;9Jy~A%Y*V>!CH3rs1(d_hv5p46Ve5L9PW79C^=!jWBmzc zUg?B5-u6Jl_NH+O@I3-`6=9)HTRG}AI=0ACk3@Dk~~eHa9n}9o&W5{@#R6Y@Yw1Iw{FMk#RAeKHG|uY z4a&15@I5VmM`G}=ed(y5onhpehGg&AF4}7Bf-()9yKW^;oU^Bho{L2<=V=I8OwU!> z5J%|FM4#Ct{<86t`;g8Y_-wa};$e5RO96Fb%`DeaZB^WxbYPDAW~Ws?>uFg4xKgMY zF3>OiW4+|=qSk-(xntEYH*EF-mTakJ;~!EBHOA2Ca31Ad>E2D zZ7(gYQxjwu8PG|R0BZmngiDL}F4;Ym29#2}|G7sGo4e638AVv(dS`)v8#`>uMkB%1 zYcWnD!VMU7_Hc|J#KU^wN81ngQ*ijorAWi`MHQl@XPNI%7_72kl{!`bdd6Zi! zfM+yt53}3IR9LwTiHp*OnurIja5*Wy-gWOUk)Va7T=mMPiD_hvc10QzMoIEfGgjUHtyP2y1KRi9wi86OBh|cV)8SUi2s~+t{Eg3pkGUA7g94x!7@^_jK)VIdwZrJUPUwJ@@Qrrw$UH9FMxbO1@Ucj^| zFG7jhwA<|^-joxMxU?)b8W8W*IG4%QtWZP_QZoKwL=9ekmL`0Ry6N1k;P8%tvuM!% zon}phC;VjEnCoB&K4qxJpIw)AG;CDaEIv5+)(u#Yu#>)Yh2@O+ronY3*vZ@#4YhDe zyFN_>dSM+|AZx9udG>Q{4RmyL7?r|)yt!r;d26nj~<8w4Ad^oGW2%tnHRRbjqWx5u$|5AJgfnB zeJQaxgVwTey2{PG71FrA0UFV@@Vz6qa3Rl9rJY8F+iD@5y>z+b&4pSuftc4-$4%T5 z5&n=Kfy%r@v{x7x;)475bX_?96Gk4s_9?3anL*Ml+4`#aZm2jrE`_PdnU*@HtZR+Kx$nAf~J2DPTHuVn&H9CSG$*)N_1aaB)yi_(R~Jj2lJ3Pjzo-#hV7dpWrE5^z5VKS%cXPeu z(1>_R>Bz_rM=iI+#BZhI*>I+$(yH~g^r(z?`ni+S?ab=Csji4gH`|fx+!T%chtu3+ z-a7^{j~7oP^(c+TO;*IZ za-FE3f)n-PK2c1JR94dYd3Nid-_rpi)I|0z21a^lu`F1r#%g5plm${*rWV=A#y-u3 zn`d8LVMlJWgEn5p`lnrw_K14!v>gpy_~zI_aEnTmF#Wz%N#Rlb(=IiCz9k!D+S(qi ziB;CuN~|<1!y7vJ8cwO#)_IwKcivA#H=0zNs1@5p34=7Hwm*06+0=ik5=RjT_hAG=mjx;K=LgLnK2&K;%Tk&lHZlGZHX zRwa_#N8S5#xxkVy5L`lvJ0At(t&o%c(m1`k@-#;q1sVH z=wsE|D6E^-X>rjaY#vr&1&t&eQ z;zC75@IPj!;8zoC6e?@rPVQ$XV%Q?5?I@@1Op_HDdIdJU0waiFHzcrV2`uV9w#fdH zIIFRg$?HMK5uHMeuaS=(P#843H_E(6OOF!~&8i7;8y!XZ3np*49VA@VD1%MDJMV>s z|J}GY6rM%~1~RinUyJZIw??Q)d&e{$a8o*ZKcW-%VN;wFJ$Q*UI~U{F(NMMAxat4g zIb5(n?T^3Q>*SaJuYFFqXms0OVbOAplC(1a+2;FtTQ4gs$1}WX0}Po;8q2LY+5eLl z)Y=^r99t8Pa{J!DsjLkBPwv?{kDU?5aN8dB9JuL?mHoTQ6JAF--HE?H+yB||=c;PQ%S6bg+otpmGpYu zu7vj!n{*3@@Z-b}l|4WrNrfjj-V>O8@5G8LtSI1`eF~PRA?XCY2Qk6F{_Hx9aV!3Vc-sxOLgG0-2D;@iR!HHMJXsWE8o`1{f8b>=otEFw;e zy8`-H{>*gfwc0%C*71<{9D7iwCy5iq>>LE+M-tfaB3*90XJXLICr6*gLoT!LCn~ED ze;~oVDUZZ)i3@mvK_hd}Q_onCxMe>JkU~;?t8@(VS_sNd-UFpR* z_uQ=!wCQn@M%M|hN}!c}=V#D^9caWjcz9p9GTQ`vj#M)YAx0C3huBJX*)n*^gMh*5 zS>hAuf=n4adfQ2UC6TA{NH6ecF6C#7pG)8CMfdp8*GujVPxQ44WviA`FxIRRyBKe+ ziB8!WeJjPToMlo%DD8Sh#W`5C>Ga&G8J#w%<-x-_`55-ad*WeX`lEP5B7H$69l9vI zGGhG3YlBW+t-opA-oOCQ*Nl-n97zZ`M@rnXqo27eDlyvcwtTzHH;ik?MjO|isRKH# zr-~|;?+c)(;Kox4MfcBYPjCEm+KxrlXy_N-S+$o|E7mL<{o%AmS%C}K|EKr~D@QfZ z#-}x&HQBh+&8E%)D;EC*D(Br5^F}s^FZYjR_qB*;>&CJ{zf%9%+iwhNr~MmrXL@+B z*-ZDLMQL>!*Azx0v87$|`V&4w`8_-e62$`3UnFFo!s=DBt8T0T8|d!v3D{&* zjpbx@J}L&grX{OoVxN{ubrf`VQaOM1)J{>*QpISpA^ghDldf+pKUlBAKGnAWo8OKD z-xUbLiun$4UB7-pY+;n_`(g2=S+zRfUM_^tJRV(r^Cz>yUaTKlUMBQj{i4>WNb}y&RcOjOkx6WOh*2pRT=Dh!JGST1s#8qXbgJ%BRII;Pq z@;?O%NI(5f$uJ@HQfxV@|DS9^%I!ervon@;f0e;2D`dx-*g#hz#+Z9+K}NkR(4`>v zGD`etCdlx~>Z3fST#5yUG94y!<$8iNk9juisok7E9|QA7Ul) zKi;VQEZ_S(cv~@t|37Lu=v``nJ?XM4dLf#B%C1D0XHaA!n%}uv{8b?L>sZmc8oH{sU7%;bL3w%2}d?qEY?!7m_J|MQS_Ao3~^?RE`a9S=so z)yux}??aguQY@b>NHYHxa+Sgzx#z!DuNeW^m&O1h5Gy^urAM*VOGym}r;gZ^Otyoi zorA#P-*%&Sn**M8N%-&4O>0oS0V?Nz>VfpQck1b>yC86h-Q@YZ_E(?lYiW!Le9Jl! z+_aL6%#wAM;I4De&-nZ|g!=*6!*S@Ul%HFe*6jSv$nQVfI15|j(wKgy+%)4Iv$$c` zv-F#Wv*Mv)(|5y`lbbpwwcnhK1}Y0}|EED+3&wA<$K#R|B&Dzi^}Wl(NCtm7I~wFg+0{*4iz!|S|&8fyyl7I3sc;FTAC_1ZEtegQ{Gz%qzQ*>vu_6D&cY>m9 z!Mvq2TJVy$$1<3Tlm=uj1Nlc7tLK>`pnB@y`$u-m&|=toecWR1cBbAvwO{Mj`d*m< zUF=@|0v@1R!)u3G9w#z@Avy-pT{36r*?~(TkOZn?LmV&JABGcS&)nB-;&yjH~KWn29WIo;i zFMmXAy>bYneUl&i&-t%a_~h^>8R8nJ_H_5_mt%>So6jYlyRH1~Pgy9909)Wvq+RCK zTxO+rnnD8)fde=ds^IQ9z9fwEBkexaZt1sc$oJGihV%@b?avmV`a!Gufd$RtPjAYl z2{`OVL{mm}S>?-~+O3E-OR_>Kp^~ESOv)KJk4YMR6TIK*ASO5ZWH%)FX)~y_`5l8Z zoi}g9(_YZj-j{Z(NS?rLOAktn;)&^N#=@Wx~cJZJE=A`f?NuQ#9d! zE|h10tD$qBxk?-bXrZk}ZqDa^cuwezQvY>n-|lL8N&IgRJNHw9UQF1z=-;tD1LviA zzjy>@Hjcj^u6HbB;M+S3PLn$qq)t}T?EI!BdfWNJ*X8o%8xB$xJ{DVZ=e13|m`<)N zEDVu}g`jBu$d;R07$L~YX>!Z&;J-Sffo1g>H zKK$*QO_Y`7Qv4^rb0$@h4ZwHpLO*K>+syp6i!m%_pK0If8vinKZB?UyT?lexNia-| zjM^)g-KgJx7Xi4{+42KfLzdmGvcu$2t`(-x&96;H)_1J$m0NQSZ8fX(BhEc@fO5P@ zpSyBtNo;gl5qDzdU5tF@usAq0nUvb(;AH6MR@{ZA-x3i_9C7IM#HI{SRy1VE_+xTO z{gsk4uVUrDKP0-Ded6yALgjDy_g8;wGy3muZ=^W`CMVSlpGn#FIaw`E7uO-@Z02P- zcTbr!@^;>r3FDY0`}HC5evZ6J86W*z{rcZNS&!^SQ5*y^{mD8+}M(^L*184hMp7OsKdk?6lns0AdMMOXh zf^?-ykq#nA7my+dNRcj)ru5!RkPcEpM-f9+Kzi@J_bNyYz4rhCLf|_=pXdJXeZTiz zcdc+p&Y3f_XJ*gdGkfpfOwPfKY{g4`u6)OIEseZ{CvqPg(+G$Mnd7W0{yGd6mpLm*q~2-j zoEN8t2;RzMpguSV&2WAMuexxX>KuEn6iJ%0H`Qtk=EpeItC;gvzha%=@f-eOSUJp`Z=)P^{D?$O<|6d>4|~y|yAdTn#7S zu3jwP3Xm{4Y^4~-;d@yhg_W}Amai{{W zwM)ztSi~K^lV3nXeoj2n-OwEg%kVn!kfTV?p=p7v^`JVKZkQ$q@!M{HiW(AwzU5o(*r_TAm!h(%W#<`33WrkChLpUu)s2r2eJ zlPlz0k1iZ8FkO)I-ue00-Ez>{iI>Z&m&RmI$I<%n#|q@W7qe+El0x9-w82zYTp;Km zQ+!}Our)L4$i?gYZIjM8YUJ)S>V*3HA7L4pBe!qv57q}4Et-kkuyx85Zf{6#5jb;{ zg=qXH7EhF=JaRi1&Q#8{K`zU{l@=rEcbG1kT281lsMbSPw=c@XE_Ru=588arywVpO zTTX1WSl{6HKcC#>sys30Te_!nxn$T(@2Wl=+2CZ9o|M6CW^=iC>3J^jTNuUXJmc=c zO^K7HEWZ4KFKsZ1U@`juuYZCYW*)w)xYNK|uJ_GZq`Z@H+ttzm7zRx0nVv%kcp#{w{_{J$NAe9#PPnCo7Sx98lpg0NeVt_HG-fQeJKSG z*x#Lbf4F@y4LsT9SE>=~dHr#9_c+U0++(2>xw^Q^3PUcV4RT%#&(c5}gymd@Jr!ze z#VzNhDbG$H<~PC6$K$o5vU-7tJ+r`n=1Fjs}!?gE`U1&okL0D|meMQ`HNxt<81pBtYwt!FAO;5-@u?G;l~2*DUb z+Qi>RZJheWrDHX8rfwX?bPhKqXJ{Rryzc4o0XjHZ@Jxhi!HmH(ca@aOV z$b<0h)+-v(`=RHK$DQa+=JoZhRMfcg@W_M_vP1b`QMvqLyt9gs7c_pE zmvW)9Fm%co+K3*mTR6+HJ_xv9Ol1wTHkkOdT|jhmJwdE>SJR8FwqXyjUdA$((VxqP z*wD(6s+@oKz&_QSS;Bv8EC3igHBv55;yQe9d)2=oJ(AA7Y?Kl!l8hh4L((wT(=ciK zA13UO?1P%4Pb^j^S)j6#5Mu@0<%*eXyBGOK)AW2o4?mlv{BbemH-b zZoL< zN7nu$%Rb8`4_M^-^WKC`5FsMq{Kv_xS!>??>t`_mp=~JKEi#RwyJ65QnTs!+(J5c~FdC%>k zRt``n2k23#NA6b-OLPDxsjqeH$%WJ%HSfF#gXwslpWV(p8V#>C)V1p>U+Hd;K_jUK z9@DS2JKPliGJ4#M-bj#p8X4AHr-wI;+gcK8iM4O3%U>HyLV}AEz5cW3J8kxJ-nYx{ zU-S8z9@orYEU3EXJ}vWpkOMwnGe1;FvJ8jNiNjFO4z{uZ>sn>+Pe_xA#*spjO*rJb zcVDESK4A6FeRNaBew8Qi1y&IsY?p^gETP?n+K7!rA~wk_jBe)n+RiSIOug+lx3FdZ zn`U?G;!kTc%T^#dE1AOj7CV_HVkYC$-W&)wWs5#^X|J+N?bx((k7u`aWkVRxOsKq( zdK7!n+nyjq-_pb^b{sZ!nx~wwGqM7)o?e7PSULn)Q$iMd3t2noyb(CPcH7n(>fuumo=tX)C{}LOH-r=M%>vBo( z3Jb4&oeD4~n2?bGpQPLUlkea|iaTilFXt>vzfv-c)Db?`jE@neLfel{bIE!kdsG~h zdtn|1TLtWL@{woX$ELZ;>QUc+z&>sTQdyZD<9e@z-BMXd*#G*CxHh)vBNg@Ibcqr< z9LAIK-4bJIX&FD3{oI>$o2!bFF2;QSxD$XODT5V9%jR=PXXLY?OF`ft!Sk3z$+hwFGLv#kFtTY({oDV8DYf24l4MQJoR(AIi# zSdzs9S**4A$9Mopi2pk^G`o^xPe}cDI!y`xwHajqWZI{q^Pv>@rFJ#El!Q=>&q(Fo zF^jy2qe`c{R{G#W1L!|?nK6K#=h(0>A15PAKE~yR-D;KOe5V@mLhp^?bzb7vcLnjY zoJ{!MeOnNs>|)GC73%yUrZpB3hRwsskS_5`d++HtIyP2b$`>Ix?YFfDvf$2k|-P8f7gp60z z5bfSauG~lx5}?!!0}2Uk@rir?kvpV}5mW33M!B<{=*=1=gbu8AMT&pSzSh)ygvgn7 zWlnHE)lS$S3qS#*7Qhxn1M-ADv;dtw89=-Bu$IrEd0!MqioE z!8<&EXu3_dOo87V05GMk-CPe^LPOn{uXD$t44VS~FZ+P4QGic^qlrFUBG$FFn!E&7 zMBDBNP{;$SU%~nhe*X83zg9$`k@#{}+)X6feff~k3m8gvpu{UeWTfMw+c)>-5GhbM ztB|l;L!<|b6cuO9=whSox}+BxzNS525@OiWB}$ijdtP>P;-Bj%(X&Z(Qo9LO0W{CZ z>MO|u_M59l#pR$o8Y0sFbOPBb059RQ87EXwpf<^hiTo`G3Y>vF{&p~=4~^)VrkR>< z0K6n#Ur^)x$PU0C!sXCl<@a{7w0`icTZYE2}ixye=g53;}7$PU96fkyID z^5Gi``FWGI1_$P5RVvx zxNQKTOF^Ix)Hk|qhG<V2FwQkMW+H1#~teEbjULf94+;BgKGCXuvv8 z?txBQ<+W7+-jnD4%D9O#P8G&9&Jt)QsQ?iGI6%9Be6T1}{u@L8kv&h+=r;fDE1FMG zJAE$9gaE_RPgZy?MT{hR2LLJ%WPtp+qUT9x2~n#aW+;&XW2X1bfuIynU!YBoO?Hx} zFwIH>ct?I;IY^FSs7`spV#Wb9AVD@b-FDOfshh}!p_6ijyd(Dmdoa&K3IfAkzk<_i zf9OAl$%gR&%wWXMOWBI?i2U1_xU(x+|3?M(xL|R#p2X!=OEqKV5uQ}1hb+JprC~+E z4JB{PD2HG??FNeOOITuiT=RaQM-$+kM6NE){IFYQ^^d?Wfu<+>s+V7(xMNXIYa|g? z1XR`N&bdhpDv=9d7)n26B3I`>(g6~NMtK4bIbZ-A_k24K1*ks*#=+cmaktndFz^lI z2_b9vPW)%MLwX|x0hc0%tFt-EL1mMMyVE%w?#y5-v#&0>Ul~7d&%~?P>-NV_HET^} z|LY3D@J&}78lRW6HPNgdjen|x@r2}JgwOj+Uj_2ing(>}NvqTQ%jhSRt<_9G@|XX5 zLhb{Nsfb-arh6rSnu||oItzV(A!=!C%y*kg{^Ip?s474czaTGV26zH+g7{VlUX2~y zM(~=VGu?Q93c!UDrEOdt(z-y6N(0VQSspsn+S*vX1mxMxDa2q$7`BiypdJ3oXbTH4 z<8N33d-=|H53B8*o%lfoj1tzBk@5Td2I!lKw&L@NZqvvubM5p`#X2whf7!>sOMaiH zFojVu8BSKZq7s+^fNAd76E7Q4s@9zG5KH-`YoLDa3+HDp<%ap_&T8m4*3yR+L?jF9~ghPXMpN$+yY~U z8H6C`kG!D`j05im8vwG(P%CP{0PF9_beE-!)*O(EF94g#fxWKg#TdzwLSzgGqJN~^ zpM?fS_64QIvh$M4U8%}0GF42cVFvYo*Q}W8K25vQCNHMRjWF5-qwjcb)kjJ?x71ab zd~<&D@_Wcfv84BJyf#a7{w`#cYGgu^wc^;7O5~A3+dr%S)zg`YKj3A0>7{F1z>T#H3r+YhQ_D6u3{rz3ZV6>ipk}Lm* z@~;5Dis&AkP6Nujc}+HihCtDIQLcK?P@`D5V*?kMyH;R2m;L$s8|G5|H#EwD5ffUO zA7@Vs%9P3gPo%*o3DIRseKoBj0K|JUvf`akN3@JA0Yi&_V|*r2*IbDeTxzW~EZ z64{dF&HH3^nf)`4QCxZ$S$K9e;gIbK`LIZVzc2wPch~YIM3odqxd)fK0xCANW9SoR z7GsKkB8h30i+GF>da1}6K!JbARK!cUrYPlE8}M3Vbl?7QuRNiRg^T@TKsnZK&vbp4 z1BSc(5zu5DQ|%jM#_YFU9#9Z8zm1{kX^WcG272}x1&Ez^XRX_-o|n>J7z?a)6Ic}{ zc!Xid1@}lL|06~Lx5m{($QU`1klS&A_lGmZtF|wi`xJ1D3~$QH1EZo%(Mv;(nUlEx z=Wp!CITCe=l6k@nY=l)k(Vtp@3^P%ZV=Ys_?9z(R$?vNEz-084AkCkwDGNkarw*^a z%_Opf2^Y!>eaAX)lK&%e5;^>KSekoOvEEh!sEfJ6BjI2oecIIe2nGAxf&v9cj<%t@ zxv|@i&yL69vBrhIHm6p6_b?HC4J@C@faP-m59t?BnlZi1jYGN`V6xr?@|Qi&f8D&@ z&!D6!Gfs|phQrg|-f6^c_^6efiUG;GhysX<(%}bYsUMio>}XO8hhPq7Tk-ZS%W_H&`9)WS+5k6({7LfX1tLO zqXd8IoQR6zpzC9$!AU}0aB#0c9=!^#Qik+8Cxm~2^yhKNK?oh-45;>LXellavI&^c zSz{J`qqwY1N+pMMqP`ot6U3NheVnD{t3wYPd|oE!Efx(HvdSY*~#K)))$)YrLeV? zXvMzn9KsfV&%1QpLS?FKS=T~pX+v(}sn-^>73$lE+_R_Hn+@zNO!2)th4+TpkTWIC zLE8A*9sBEr%wKB{*t1gJ@k{J98vBmPm8A$ljqM*N6z#N_eb)_+CRU5`;x5+KrXWiL zb$+0EUC!ouKCMVv%$#u{JTTp`YF*rUCE1bXdQl#9@|E2FVoRF9gbwYC5k=$WS+xr? zIclAM5U@mcv_J@|~Xx2*YN6PSbMc46o`R=bFh_!3EueF(7m>SfO+tVty|B`zW9=Li|sKD5r&XZK{ zIME~}U9qUaL;yOnOi&j(ko8!zsc9YtURc(^i#D6S9WZUX7+*iOwvt-8ZPE8g^o#7w z{^aB1`5^tfYr;Gi%#vLdyoCh9_vEW5WO)avVPi zZM#$K(jZQo)#pNA?s`}QCU8j%T@R0IzX|YmJN`yED`kwW6|P!6=zQ$Z469ICl9+)B z)HEqTH_iy3wW$?7o9&<@8MGdldKRS>n5`WKOPPUH@I>k?`it5uN}7N1d3|U#4N$Gl zVf8BP^18=tK32BLtt~gej*hi`T&vyt8%qqnuTPym3$%>&VXMjAiq-86IgXZ5j_rdi zFIaWkzSzZpS`RmuYRMoQkogo{O+>*&Ay{a^r3v^^*Ih6Zf#j6qaA<;6bif}1DX6v= zFMo(OP-%z=Y>zKqat;=*B11-bU+IlnyF9{VI7`-kspxTWQge&)`1}|xsob}4w(2v= zE3jRKeev9!_%}kE`{K)|?|q*}d1H>JBdR{`4300Pz&h_B_;Nt*8al`Z{fzJvEL-L5UPAaZ%*CUvPK^HOrTF=Aa3=q{ zl1s+ev&f%6XzF7RM;Q}Fq_Up^X+kyeC%4_i&oi7dsCnFdojqnjP>!u^DLt^@o?vDp z45=Eay}$Z0Rzx5NO#(@R{`h^(sA(ek~2fQq{J9Rv8l$YSRc0B)uo%Mi+Xp~Oi zrb;^V+I2Km_EX9&w*oTN9=_iQ{nM_T78p_}O6Ldg&zZLD&Uktq2{0;t{+wl1?EyGt zmU6+^3HT?3`Q?z#Y+A88LmEhue3oKETh@!~Ftq@>;QfchL%?-?F=q+^etguTd<%B@#0~dCoYDKFYw|LB3skP|R?TbTebVBM zTHL+dq4EB84gwl%muVuUQ{ZzjjERaZ^|P z-ZzMEuHq(h+PLy(EoKOj;~B1fa&B_4zWC`=VkeQFZ}VLQOwI~PhdO&$9+!dae38B4pJD85kZZi?M#bS^n#l7bouB*Pe`ri$RaKN9Fb`>6JgU$TS8+Is8P!L> zAQ)3t4Lyx9<@Ju9I)AlmtPgRA(G<8r-Z`A_jXZ5(Ku(EV=A;Q)cYDW|*2#*iHD*A; zoMEkEOy>hxZfC?J3mT6L{LhlS&Af^DTwhJXz@5A+$&Ez$$%Fs?|B*aM)UIqyflz*jJFaX>F`^8K z+hT|h8`u$k^9@HsqC~TBvlY!eAPH=v`N$Ig*sTVkt2;MaS&A)4^ad=TKDR3yO9i_Y z{TJtgL1d5!kFx)i7D!N^>w;(fJj*9z`)QXK$=!)Tp|Dh!Wcaqs<~&B`9x0e&fGbxR z5rGq};zuWKYAG+{xLANFn?A9oYnaG{v<;6mJWr}H`yiU7Gz|R7*T zugF{G%?yIRm>%=wnw%ivVB(yBa-qE7R5ZbVVrWF1vR+{)C~Ex_5>>m#b^|CC|6?qJ z-3GTWp2*9OOCn!jrTpI*)&2%xpx4QyD_;A+pA5$AvAek|DS}In?l&zX0v?2Zbne24y~M9tYdLiwUoo=*7KkPd(|#r0TYf;9P#@Td0-H_KU#~qHr(UtMpS= zahuEKXRoX`Yon)x1bU>bEAzx+rdYo&Kfb7vHoD};Pb=~cidy)M^G}_>Mo{MtIp=1I zTjp=BL%Eqf&*s|K#NwCDhE#eu%SJ6YkY-abv8tZCp zT^Uw;(50cu$v#jd?gf7ko5U;_KbAId^0OpkLjDR00=wm0fg0F=OrY(VYrs1RGh8n2 z^~-X^^VMMI2Bf4r>jS6QCe1~ru^}EP=ui$onqwmxr+v{I%M;10Brsn)5cJjEd z$(AmED!jwG#}%uS?LLT|XT-qdr%^RWL=A-7AV-(CQ=U3)tE#_xTO&-OmZ0f3Hd?2X zSiSg4Edl8}_G!e@^3}}5@aXb)AlWJ}KM-;Q_gmfB1z;(2*`frnNw8n$v4|@W)8*n# z04w>?G~z)iQrB>6z>wGZz8k-0-P?NR?zFe`%)RKDV~$S2!#R5ue&o?qoi_E> zrg@k1nNXNQxmvoy|u7Uj{?6N8?n;OQ5C5KOyzuZ4P$s=ZwrT5jyX{=~t zT-E;hy=;>_eB)+r9XO7zF(kdC#5TyyX(V` z#z(@07zT?sZVHTbx=a+^sQ(5pZ46o*-EUy2IoN17FIVQgCzw?7^DeF&+E)eKm1VR6vv}brLcr-ya#PDw{tNKv)Gx@uhFgb1E zx>83!0D|&2+*{DPjRH!f2T!YSp4Q6x2Qi~su@ENP_1*Hp9TNx;(rd5V%7rJpa}|0| zX_3ydFCB6C27H-SPuasTe+6b?)sR#1y}uEC^yc+igtY3v-VENayeTpvG?9_@A!Dm*NqqG;MY|LVzx^yohnwZ(> z@n*-Nq|5lE@CH+IrP4P^@#vjVQq-9zbea@3yS44&bzC-4FJ@0h{1^V>>x+4QYz6=H z*aCm&zGU+z25MjtI2rlJP( z!T;2zL#yi0@E&7D@>Jx*uMj*LXUmNl`YrNPa;a!Wk`RNmn;(uJZLaG`x;zRD`8Uje z%T#A((lDsOeQlE(seE)4jL-51GDOnG7)&JYO0SKYZ1~R}DSF%FVG;T;Or%&0b=I)4 z`1N(OLt7RefE&>dOf!D>_PO@uAxU+OWH(@AzXI}T>i&$61Y&RJB;o7KZ`I-1Z;bzh zX|nEI%HsAfzZ|n!4%(@_r1|Ue0&f;6m<^>ZwTCSxni{s-_1)LTGE|fn8`q5u|E2Af z*P$dHLqD;@%=Eox6Psy+NnGPyNxf}@r-^3b42$4Ac)dUd;+(<{ektZfXVT&jUk4`a zVLR<+TaP$@)}^VR1AYXA@Omzfj#-vgp128!QYBH3mgG!+3;&=XmMm}NkV>43m*+vz1RF*6}_c} z7=aAWjBOdtECqRSU_c0@;)?aB@;Z`dn7{6{aMWJh5*PTh4!_gtGq(rAHQD8Ndf%6u zurNrJnk-FlPK2R)gidEs%SoMTy;Zxi2Sz(IlWkCpW#hQ`47<9bO1v;)Wg59S%!3>_ zT4}FRzCxb7*X0ynwdVJBW@z|61~Py7 zrj8??#N67dsLTo1tAxIl=U-tlnhJ=!Dw{(p zrCIC0$TX+Tbhp?!>U$;}I?ewPC|}WLNW67ltIsTe6s5NSG0K0TazE=(*f>K{Ksd_{45nv+wF;c!@fEe$ zbLB;|akvCHVApB~eC7Uuz^~v&C|(TE2nD#;#;d>$zn7{fFrTwFrt!Y34}e3lzWP9l zx|~WdpCe&@iVrY*UC!D*6*vHZ8T$uTl>H-^M`fWSS(4P_*>K<NI^uQ9Ygp^%Z>J ztq7lXcI$WMuRv}6P#&Oz6RLD>%}jYVq2;^W=Y|I#`Y8S*-Yml04o?#l%O9?r#8}C? zPb@7$rk0G3`~d*Orn%($Pa#-MI>%OSUi*dT;2uxJK!%yr>?ARK+zICOqdyP zMoC{?D5jdt0l0wZ6gJ`u!id0ba%25UfI3&z_5F)l>wRzYpo(L}C`S%{cv$o=U={;p zGC89wiagpJOs#qGLiE>P`0J!<2je9XJSGK&I78;I!7=X@z6A9gFj5 z0CjUE%>aOjS_fWwtI^~Oarj-y#ksMrW^(2whdV0qquDJ1DhsIVbelt#k}e|x8-J%T zXiB4s*|s!ecYnP;@dnO&h?36k_H)K$qu}BUYwZb^ePLoV&#^&8b1I`h+OLiSO0er- zf$tk3m%L5W3rt~l$gZGz@~wsHUGsL3$Dw-T!*%usIsc*ubJmL0W7V}JCyQ<=$O)5n zDK4-vXkP_7!pbP@3iyQa0~v)AP2#V$XutVY5mAhH6(FK&m-tlv zTE{V;^)`6gI*lVXP9J&yQ0$>9=qUVrWpJ9keW9)+gB zfK5k~`fBk$?({_vpjZj{387#hj=M(X_uvx`_bwo61!6YlpxfZMS!WvReHm8XiX1Y< zKi!|6DjpoHJ5tzx1l<%2i%uS4@o0$r!>CBIE!Zk>NwFYMLsTcJ>$e0$k;Glm<^`vQ z`;KFtMa1Dx*2VM@j3=#cMmzyBCyUKN{CV@;8woyCmYWaLchK~Z+=mM8U$ZCu!hwL1EA&tQ=I-xziHR7T#$brVW;1N8iGeDgXOeUR}UaP2~6Pi(<~{Mr5vEb zV6k&g49?{eUa`I(qKsYNPeJX`ZR7Js|Crgpi2!O0%ui@yAB0G)$7sJs*U~IohKiN? z?j@%w+4}?nD~MYS?V_9{CtmE?2VZr5vh3L5-m1KLTad^O8j9T}aDzqDljft2!t|oy zws)oRX`l19v*CICWj@DBZRs6pPiSh7x_} z+AZH|+}A;ja=hnzw0ckc`>zlYC#W$S;776EyXW+@X%|Ki`jh>~n)<)HWPB1E&uScD z{y8o}5Px;gb1(tpcH`PvjkwH!PUod{;|ohH78F=-Guj~Rxm z&*HWdbnEIe#YbNxx{2kbG|@y<>~JC&zZ%v`>G$VcWFdm0h_n>z)mNk_`i}0>|(|$9Lg&*1g~T z0L%pv6n^a=d(yg>9(D^e|FY7QcI22E757i#t0K-;M>KO8D?9ew%r~Vn$1e7^C58i6 z)@bVI8NT&_K?GiIkC+;gOrop`%sU>3A2uRDg2J;A91+{UEZxsg5dn45jRFnN7K$^i z68Rs^yLARDEb(|mJ^w8S`r_rriq!yFS>n?)&v4jnv9ywkUk%a|kd*6h>7%Orb+?zF zQL|F?agdF?(7NoDm-u9tn(WWUhsU2R9#z)6n5~dcPql|9f2jE2gfj0Lw|!Lg+HvP_ zZoE9$G5>Ax0vRhadNU$Vpy_D){bk~EM#pin)dyR2HaTv-w-KV{zS5a|i=3@!Wn?%6 z$|y!5X+=A_f4J4l|1fE@tMfTL1zlQeljnC#I4%=2punnjZcP{Y4W^XrT+w4nLl^Jd z1G0JbB9Pxby8c@|cMLN7jQ{DbriAir8Z3MTUsG7ft{bq{jaMiNCMaI4d zSUOQ*kQNb{F$q-thCgej^tip}o$++h1<5FCwl_GQ9P;W%~Ir0*}Sf$}~5;MlfHl~2kuT=U(LoFpi?PP`@=f%GRn5rsa|d_nmE59?Ar2oAq3q8jzM zQF1QOI)jt%-~@&lCq;plsp4;)T@`S1&8w{6Qj z0D)MBGm6j!UtZXEyysg%EK8u1+IOkiy))6(=e3zb%n)zZM_60qQUk&xEw_G-L?G=P z$i_7;&bb;a=J^i$v^)g8JdX7<>qK3ej-4~>DlK#pDQ2d@T-7Zw9^%*`;^fL9nhFo~ zOt0E$DLNK8Fo5qoJ{IAGMmceVZ5niU=^odLLK7@99$vEFbH#CV8n7y@_`v_WB%+r> zMp?wWH)uWeKC#zE@%1gg89%1&?Jstz*N*MasGZU>J@!hTAV%!oox6lJn13*Mjyiwh zZtdvAWnKCKCX{#=m$qbli05KGadYvqKb*SogWk$$3)y2Oj}X((lM5Jnvj|5!Yu6_@@Q;sQkUv-a|FrmJ{(WRk=CLw< zQvy}|kbNob-%88JuabAx#hj|EhmWT?tiV>6o@aiSr&~uO190^Ic(N6^)nv8wzV2O z9r*R!)-2LtLZO=Srm^3uXXBzUO{BN(EMmI7h*>dz;6Sj#71<$@WDkcT){nO`Yqm!g z*7v6~O9~>QP8}zqyZN7#&nm5Up0ugD*I>(ge6mT1sGizJ5_1xGwjFy~5ZamzPQl`D zUAG~ym#_GB?kqe%+~@+=qr6%B^kivy=s;}hJ(feBvZLoYbD~iNDhSabp42O#+Td|U z!S>`7DUVbZH!@jC-#WTj|B%~jS+6mc+0ejy=>pS<-|6(yz0^miV38>boA^#c88{wZ*>elbJHt%CBRj(29|_p+P7!t9_o3 z7mF5Rfz@?h8#wx7#HI(E%$F76eMSh89TuZ61gk>yQ=tf1DIrI7XSONhu!s#9f`3yC zFA~aOoh2p9EN;a*D7pw!l!_qR|P!#q;{Vre$DFMgfU_q<)kx-zkk8^aaUE`SO=rc)miy30(e)od7V zsJq(QQe$qGjAPe~eA&0R{Sh%+TcQ!k^wFw7EP}K}9_IH6FpBH5@d!wpf72bYn|g9a z<+0iN5R4mA(ANkHh%OLUG878@8S2fs8!SZ`7C zONg$*_k{y@MZw&ejg&S&wZ`P`f9lwO;cdj_4sMZrSx@_%?aa|VG4h*aFroDW&T6A2czdvutv z53+5R#O7q!vjh(D&`)&p?St{(g*3=$;EbJ!7P)@H*6@aDZAge5dP+r0XU9BifN9w? z^Ow=cl{AJg9<|y7$CT{KoOQwCiM(-!7!9|TA0@ubMW?*LdPQ%T*5ukb(uhrrpL;5u z#$(t<+No6kUeH}K3DfLNl=Us%sh7Pb4poM&y`gG9CjhczGm|Ra_f}QurHH2 z+LKVTpNy!Bc83}E%@t3RdQ7Cx9MbeL;MwfBTfURtFL0nDPiMP$Z)lxgr{^;)CgU$()qS@N?P|rz^~C2)%Ka1zD&_Hs12qMPYawuj*nw)t zU}3Ky=i6VldWs9&I_pV|!^q&Eb(YJ~fjuAfKRFaqfGb1dAjzH!Q@Og1&v;qzeW4grj{x_&npfq%=1K z@WYCy?N(3Pf`B6hoK!pY!@eLO#gRNe>l@(sjs>ZAc>;R|%=sL9xvh$>yzqq* z!j5~b`-Dop6^~C?LP7fzrPNJ9e$Q|L8jtGmh#wb@Wu6dLCXt_#n%rCPI*KM5Tl8BS zIo|N8B<)Bov1{V26fRY@_$+pOWMfWH@w@?r=(u%OiOAf3lGNiJ=^G-1jnZGnj@Y!B zgz###%HT#%orf)C1Pt<|jpm%xUr?4ALnlo$1FNh5->7sXi5u>ml%#^dR zzn_c<@P`ST;m~nBp|e_4nyk{vm1-DwwpNT!g@+1j#yG7(6NXvSMD!J0IH);))R2NS zM_wDwcI)}NAOTCIMP z;|<+BZ-PxosvB8z0oNnPw*Y;O)KG*l$dDqyno(muO_FTYjdYA6ARifY7O?+w5c|DB zlFFKryv!q5F6J4D5Q`&KQSj>k&VFQU{y~bN4?^^50`SO{1s0+njHt(B0E*o$A?#yu z6fVN!0e)PDR;sMId+YB$YR>_vco8l+jzXMea_f^+k7AL7@Ma{YDGKo3u3cwMdcCI6 zt&g+#CRM@f+Wu#y;6WTMtxwh410B7o9IKU^&VNy?#Xo^mMuJ zNxE;%e|W7WO3vkz7%zkoNa*9H|>w7!BKoRXg5E{bXkv>`2DN?OOW zS`k733CirBY)@=W&_IsB^m4kVqD_&))~l*R1o94DHI$h-V_wx%y~N47(`^>6%^PQ_Sy6H&&)`R zg_ab^+!Z+gJVnyT$3bsUW=$nTHp3&!agA~Cji|wJV@FiFV+>bJlB|l!{bc~kSlj!a2?1o=1Zj!ofHi{%?-6q0)w=V zpdkMjZBH1NocDpp8hCC?Ez!~b({y6&b1l-9!uSf_VV+uzK{1~(SEAw0phiM_WxCvt zAgSMmwR2Lq%F+Nm_|l$QNuV5mW=s+Cx9I^QQvHdqetf2*iGS7hSyB%4p!vpW;YScL z&uL-SpwH|JG4?N?2ny?&PYQ=ZB!J?iD%BUdON?jtuEl`xPY981g7ujQ8h<^IpXcp6 zbeaa&5i&TkcQBczHBiEdJ+*?ng0MYjH^da+?oBEw z!tJk@gL$vFb*TmM+t+{|Mn)7U=4$T+HQ#4=DMhn|Rx728W&M37V70c{;DuO0*nrg^ zp3w}6$IdN8fx4u)=DeEcAsIbIDv9~3q#fnY5%`0iTFL-VT8d==`kRjRfHy9bjSpgnFF z6xGZj-q=bG_4Dl$+af^?!n{>Vep_izbHvE9okQY8bQX}IOGA_mV204Q?2yW0DD%9U zp$LKDhtMaeT*U?V6?3AA4^~71-I_7L9%eC!;ayAn_sL~1r+f4i=~3*8VzYd=@&*S2 zGcE26(+(sRhfAz4-czmTx$Tx~YW%>@y5oj)KaVH>7*%nEgh@{wlwS6@!Zf z;C8PHkR6-;+xRKB70`c6>-KM2=ozoWe(?iYuPh%fYE_!U9J5}zl4nrYN_*Iy-w8HIf5*cyExnHw-_%f7-h$DKSRax2%> zNn7c$p=E+wZ+|NZaJTAn2dyHD{+EuABn7=jk*rw~0d9Am^&0YFi2Tw)Yw{q}?GC20 zz^g#NjHUutHd)gH18OXoxiUga@F|r0Z_;o~HY{LC%Bv|Ju6pc&OSoEJC!{(?kpr3S$OiY$eOs zlHJ&&F*L=D%*a><*)xb1OWD_uPeQgvWY4~&lu{HTOHrn=eP_I1@B3EY{C@MB-?`>F z_jTXTGk;vqede6&MaJRfM1KmuVb2z^2-!no%w6MX#$jj&WX0An=W3LHobBeI22xg0 zXldkGu}mazJT3pWc$Y_7-35`O&OPWRSr#BSS%TowNDO8x*IzdOLAM6-{u(fIj)DNi zREq!obiYKP_+*gbG<32Jm=<+4>*kN{Y-k;qv`9CRqti!n7e`|Ji===I7j=D$koUKM zA9s}>umtDRh5?#n|9HQPO)$|efT%KM4mltKMBOPwF25CEdz{)4Gjj!45DI-N<8VdK z`42#3Do~ItLFh+f>e6t=VFl&K3fFlc(@>Y*C$z*`uM}X3Rv;%Ol7CSAF1F5H53-e4 z%mA_gJ)v=1luVxkK-i@uE}3eP*BBsyI!cf&QQ04$P~M)@IiJ=*Dgw&5@&vy55 z@$06A*9%G!f}4oNijItsJAwCM&_Jq7iZ<;oe(PJv@^vbNhMMpT*W48B@p*a-~L!TaKfV4z)Qf^oyTYU4>@2Zrac zvVs!h?F2q~k`o|gG}!*#XfyM{qb)H+umi+Q7YTIoFeIWACj^NHLTP9~kT5V5zC!?< z4bdYJ^(~36L=5m1BOE~KiTAPec17yB z{Y;2)^s|?E+LMU!!7)f6x|l0iG=>orauy6YNBqx60;a4A|G!N^Mo#}TX(pv-B>P!e zjvb8dr>aoRZg9um8n|@9g4tj{)gVd!IFy6is40<29Ik8St!tiCxCbWvE;LUksX{z9 za+i6<{BDr$$YpPSp=3k1GSI|h|E1o$6QXOum$In+Z#| ze?QX}6HoDQVc)fHnTf@d>793FrS?G@k~xhz=w+N|8XrxNT7LliWBvH>skmmQ?W|jM zcH&Sbv(&hmue32okYE==6O}GmW7?JaNXev6!KhE%E(~UKlkip6A?SM=hD&t?7NG&^ zCiG2WmOqS3O~tG7HpV5nfCOju(CT1~$I#(K!zitG;Qkg+&{;T>^o?=(X@aGjryTl* zG%QSR%Ae_-LD#wEA&6~HKVLWSKcpUed0vU47|=0C%c%I9e3bY7{U$S%wjPB8D)C1r zp)b=wcEay{nB4m}?D+k?Ko7;$Um{cy3SM$vjnX3_P8)Y`tX)ZVjtE%<>59@?zN3QE z_A@;w#8i*bqrI>KOiuH=%o;YMdtD$*u@4)450Ed5)CW0Rv`)%;oG2X!9umJR>yiv) zc8Q*KAVlX}P`^dvo28Ggq?Mb98$_s%vkJ~VpisB9vv1P-$G+*TXqqVdmaoV`o(+k{ z7|1O>-R{CO;4{h94xM~4tZCX&TC}V?G_IDd{IR;^Yp-ZL1If0`1!9M_f<>65kMn>z z0^LpwERpxN>$Cjmr3|K}W~}#zZIMy6XSO;IN`xe!^>tyjyyktM?`+sJD}kBxv{>e} zgl1Xznsz^G;;CigddI?iS~_O;Wf$nXF#g0{x?n;6(CX|%x5CO?r0%i#X7eb8!@Um? zucF^6A=u@wcDw8z-({h2ATv~EnX^ZWJ0h}^Tfick2-fKoei&(+DD;7aRfoq+_|_gt z9c=?<0j>FLi+jQ)QFA%&vktS;#KZMW`*muv%`foM1p?TQDsU7w+dts(WUX{DMeIoc zZWirYh9N}d!)lstd$R;_FGiTQq`c#?wo>c^0fGs=+9S2P~6mmxRm_Q|SC8$zpI6*ZM z)E?(rSYdl#ZB%$Zc7L1CgY%xyN1TD&fxLmN>IvlVqmxAMM~HKd8fRlpv|7Kj_m=WT zdGpnR9`nBCUW(&tTUqY@f}tUUxPtebO2`tE=8NO_PlSQ?aaXyV8v{s$ajh}wv;^fVhd6k;%~&M;G11YH!dFyyEAXKamTX6 zCZwL2XCJpczFT^k-{!=KH1W8jIjJxPrDU~g<#<1}+%|`#d)eSiF|Tu%!L_nhbNd3T zJfhX7sG%yD^%zpsN>#_d(ueYu^`kz&Y+KBv&U^D%>2+xjX|z>Di7CdiZp3#4IcGPA z*sr5l$U0zwEvUj@2(OY6h>guKsxrznihp)lK;}q}&>+j~r&So;mF`Pdx0bUuwQig{ z_8k8FL`nJc>3jb7zC1S?dG#DQ^0ruUggi1lQd8_#JTa_=O~poB`f%~{AfogO@qkxC zxA0>64b|wG@zDt7UZtZ-s0)k3!UO4}L!)1ZpAD4^spWmMy8EAnoQx8x&U(c6`~%h< zCi>ZxIy3ow=qS#Xn@N55+*YB5L}lMiU&;D!_2Ko30qp_i0g(X<0c)!qblFXb%_DRw z-I7g>O^l6|t&FW^|CcD)7XB8esLiPI__+AAL6=P^AR0tN`d!&bTx}i5(Zs6eAgW41}iqIL};hSkKo|pvt zA-Qn5y>bn*S#}`XHV3cDxf=QfFMI~>%>{Bt)Oo%OmKTQ6E2U*=axWgWe}Cop)p4S( zbmmGw8RvoPsCkX{8_v8adj3gsgZUr-RGc}KLiB}jqey!y7TU zbrvo%SEl~Wj)f$CQo zt9kDCtp6=OazZAgDkO0mzAd!Ne%E;DbZD_wN7L=As`9Sl3B~esp8$@ zOS);ghPeTG0(pG7ck|A5kUDO47@*6}quQNghhz9!eLK)oc~f^Miv;Pi<8|H|%_nmZ z@9E-Gdj1r7*-_i{MjDN`O)_0lpLg&Y^qSnYCDojCw!YP&(1L2?qFT>I`9;1=c04=& z#?mv$jHyK3vD;FbMpsPUW@@BOW?CeDwQ4$OwKubfUNl#XlGn#ZV`EGbE; zm#qwV3OUwc)ru>y=*phT*vkCw^ppihxFjd9GDc^N^01*zX{>)Fv{m<^GwjY(vgOT{ zV=8KE2AMvY3V4^gv9BiGQeVj{Pn@sXH#-eFWIH@~!hPvaVCw|h~y&yio9Kh~I{$jS=7=;(z8@m`TI3;> zz>e1MN=Q*p`TW?-6=hySd0_m|*dF9K=7ce;uAU?N8htZ}N0|hcxi1vHdePwDQ2zPL z%VC=$Yn1&OuH0p*H{c1qk1a1MmYhmfT^E5PRlbMx((CIC^NOoJwE&MS`gAphh1{Fa z+befR4pZh`n(zD7FB`g4-%@#9yBK} z_UgQRzB$LYs?To^NiHPJi<~@60xm}v6io$oFRh6VYuXSTKa$2co?gr4%Q`!qm45QJ z@7$+PABNFX;4IOx4F)VY!Le%|~A{;ff+7`3b6 z$E*##Y^H{Q>mRox2$E|)WDZed*YB(e1uJb_^;}}^Aa>|)T+AtiwnO4+x>cqC=de4V3zbB*(n1X=1@|NT3#&G%F zbN8OS+#XuQED>L>ZlXZt?#?NX%|i(91`rdEyQm1B3!%*VPN42DJAM>0e_E zFrHU1L@e4Bkl{ab+R4}AU&5Z`gK_6n07F$c75;vK;mXR2%3yc!-xv&Vdt|RxMDpqKAgbj z2V#j0zyR|Mh8W`9@nD919>Wd~k0*i|#&O5O-EYNdbm{aY{<+nIbv=3&<0w ARsaA1 literal 0 HcmV?d00001 diff --git a/tests/testthat/test-DesignMCPModApp.R b/tests/testthat/test-DesignMCPModApp.R new file mode 100644 index 0000000..ff8e9fe --- /dev/null +++ b/tests/testthat/test-DesignMCPModApp.R @@ -0,0 +1,4 @@ + +test_that("DesignMCPModApp works", { + expect_no_error(DesignMCPModApp()) +}) diff --git a/tests/testthat/test-MCPMod.R b/tests/testthat/test-MCPMod.R new file mode 100644 index 0000000..0feb70e --- /dev/null +++ b/tests/testthat/test-MCPMod.R @@ -0,0 +1,38 @@ + +# Generating test data +data(biom) +models <- Mods(linear = NULL, emax=c(0.05,0.2), linInt=c(1, 1, 1, 1), doses=c(0,0.05,0.2,0.6,1)) +MM <- MCPMod(dose, resp, biom, models, Delta=0.5) + +test_that("MCPMod object can be printed", { + expect_output(print(MM), "MCPMod\\n") + expect_output(print(MM), "Multiple Contrast Test:\\n") + expect_output(print(MM), "Estimated Dose Response Models:") +}) + +test_that("summary.MCPMod summarizes and prints an MCPMod object", { + expect_output( summary(MM), "MCP part \\n") + expect_output( summary(MM), "Mod part \\n") + expect_output( summary(MM), "Model selection criteria \\(AIC\\):") + expect_output( summary(MM), "Estimated TD\\, Delta=0\\.5\\n") +}) + +test_that("plot.MCPMod plots the fitted dose-response model", { + expect_silent(plot(MM, plotData = "meansCI")) + expect_silent(plot(MM, plotData = "means")) + expect_silent(plot(MM, plotData = "raw")) + expect_silent(plot(MM, plotData = "none")) +}) + +test_that("predict.MCPMod provides predictions from the fitted dose-response model", { + pred <- predict(MM, se.fit = TRUE, doseSeq = c(0,0.2,0.4, 0.9, 1), predType="ls-means") + expect_true(is.list(pred)) + expect_true(is.list(pred[[1]])) # Ensure each model provides a list +}) + +test_that("plot.MCPMod stops with appropriate error when no models significant", { + # Create a scenario where no models are significant + models_no_sig <- Mods(linear = NULL, doses=c(0,0.05,0.2,0.6,1)) + MM_no_sig <- MCPMod(dose, resp, biom, models_no_sig, Delta=0.5, critV = 9999) + expect_error(plot(MM_no_sig)) +}) \ No newline at end of file diff --git a/tests/testthat/test-Mods.R b/tests/testthat/test-Mods.R new file mode 100644 index 0000000..3c835f2 --- /dev/null +++ b/tests/testthat/test-Mods.R @@ -0,0 +1,92 @@ +test_that("Mods function requires dose levels", { + expect_error(Mods(linear = NULL), "Need to specify dose levels") +}) + +test_that("Mods function ensures dose levels include placebo and are non-negative", { + expect_error(Mods(linear = NULL, doses = c(0.05, 0.2)), "Need to include placebo dose") + expect_error(Mods(linear = NULL, doses = c(-0.05, 0, 0.2)), "Only dose-levels >= 0 allowed") +}) + +test_that("Mods function checks addArgs parameters for validity", { + expect_error(Mods(linear = NULL, doses = c(0, 0.05, 0.2), addArgs = list(scal = 0.1, off = 0.01)), + "\"scal\" parameter needs to be ") + expect_error(Mods(linear = NULL, doses = c(0, 0.05, 0.2), addArgs = list(scal = 1.2, off = -0.1)), + "\"off\" parameter needs to be positive") +}) + +test_that("Mods function generates an object of class Mods", { + models <- Mods(linear = NULL, emax = 0.05, doses = c(0, 0.05, 0.2, 0.6, 1), addArgs = list(scal = 1.2, off = 0.1)) + expect_s3_class(models, "Mods") + expect_true(!is.null(attr(models, "placEff"))) + expect_true(!is.null(attr(models, "maxEff"))) + expect_true(!is.null(attr(models, "direction"))) + expect_true(!is.null(attr(models, "doses"))) + expect_true(!is.null(attr(models, "scal"))) + expect_true(!is.null(attr(models, "off"))) +}) + +test_that("Mods function calculates responses correctly", { + doses <- c(0, 10, 25, 50, 100, 150) + fmodels <- Mods(linear = NULL, emax = 25, + logistic = c(50, 10.88111), exponential = 85, + betaMod = rbind(c(0.33, 2.31), c(1.39, 1.39)), + linInt = rbind(c(0, 1, 1, 1, 1), c(0, 0, 1, 1, 0.8)), + doses = doses, placEff = 0.5, maxEff = -0.4, + addArgs = list(scal = 200)) + responses <- getResp(fmodels, doses) + expect_equal(nrow(responses), length(doses)) +}) + +test_that("Mods function can specify all model parameters (fullMod = TRUE)", { + fmods <- Mods(emax = c(0, 1, 0.1), linear = cbind(c(-0.4, 0), c(0.2, 0.1)), + sigEmax = c(0, 1.1, 0.5, 3), + doses = 0:4, fullMod = TRUE) + responses <- getResp(fmods, doses = seq(0, 4, length = 11)) + expect_equal(nrow(responses), 11) + expect_equal(ncol(responses), length(attr(fmods, "maxEff"))) +}) + + +## test plotting functions +test_that("plotMods function basic functionality", { + models <- Mods(linear = NULL, emax = 0.05, doses = c(0, 0.05, 0.2, 0.6, 1), + addArgs = list(scal = 1.2, off = 0.1)) + p <- plotMods(models) + + expect_s3_class(p, "ggplot") + expect_true("GeomLine" %in% sapply(p$layers, function(layer) class(layer$geom)[1])) + expect_true("GeomPoint" %in% sapply(p$layers, function(layer) class(layer$geom)[1])) + + p_superpose <- plotMods(models, superpose = TRUE) + expect_s3_class(p_superpose, "ggplot") + expect_true("GeomLine" %in% sapply(p_superpose$layers, function(layer) class(layer$geom)[1])) +}) + +test_that("plot.Mods function basic functionality", { + models <- Mods(linear = NULL, emax = 0.05, doses = c(0, 0.05, 0.2, 0.6, 1), + addArgs = list(scal = 1.2, off = 0.1)) + + p <- plot(models) + + expect_s3_class(p, "trellis") +}) + +test_that("plotMods handles customizations correctly", { + models <- Mods(linear = NULL, emax = 0.05, doses = c(0, 0.05, 0.2, 0.6, 1), + addArgs = list(scal = 1.2, off = 0.1)) + + p_custom <- plotMods(models, xlab = "Custom X Label", ylab = "Custom Y Label") + + expect_s3_class(p_custom, "ggplot") + expect_equal(p_custom$labels$x, "Custom X Label") + expect_equal(p_custom$labels$y, "Custom Y Label") +}) + +test_that("plot.Mods handles customizations correctly", { + models <- Mods(linear = NULL, emax = 0.05, doses = c(0, 0.05, 0.2, 0.6, 1), + addArgs = list(scal = 1.2, off = 0.1)) + + p_custom <- plot(models, lwd = 3, pch = 3, cex = 1.2, col = "red") + + expect_s3_class(p_custom, "trellis") +}) \ No newline at end of file diff --git a/tests/testthat/test-bFitMod.R b/tests/testthat/test-bFitMod.R new file mode 100644 index 0000000..d0ace07 --- /dev/null +++ b/tests/testthat/test-bFitMod.R @@ -0,0 +1,109 @@ +# Setting up some test data +doses <- c(0, 0.5, 1, 2, 4) +drFit <- c(1, 2, 3, 4, 5) # Example response +S <- diag(5) # Covariance matrix for simplicity + +test_that("bFitMod errors with invalid inputs", { + expect_error(bFitMod(dose = doses, resp = drFit, model = "invalidModel", S = S), + "invalid model selected") + expect_error(bFitMod(dose = doses, resp = drFit[1:4], model = "linear", S = S), + "dose and resp need to be of the same size") + expect_error(bFitMod(dose = doses, resp = drFit, model = "linear", S = diag(4)), + "S and dose have non-conforming size") +}) + + +test_that("bFitMod correctly fits a 'linear' model with Bayes", { + prior <- list(norm = c(0, 10), norm = c(0, 100)) + fit <- bFitMod(dose = doses, resp = drFit, model = "linear", S = S, + type = "Bayes", nSim = 100, prior = prior) + expect_s3_class(fit, "bFitMod") + expect_equal(attr(fit, "model"), "linear") + expect_equal(attr(fit, "type"), "Bayes") + expect_true(!is.null(fit$samples)) +}) + +test_that("bFitMod correctly fits a 'linear' model with bootstrap", { + fit <- bFitMod(dose = doses, resp = drFit, model = "linear", S = S, + type = "bootstrap", nSim = 100) + expect_s3_class(fit, "bFitMod") + expect_equal(attr(fit, "model"), "linear") + expect_equal(attr(fit, "type"), "bootstrap") + expect_true(!is.null(fit$samples)) +}) + +test_that("print.bFitMod does not throw an error", { + prior <- list(norm = c(0, 10), norm = c(0, 100)) + fit <- bFitMod(dose = doses, resp = drFit, model = "linear", S = S, + type = "Bayes", nSim = 100, prior = prior) + + expect_output(print(fit), regexp = "Dose Response Model") + expect_output(print(fit), regexp = "Summary of posterior draws") +}) + +test_that("bFitMod handles placebo adjustment appropriately", { + prior <- list(norm = c(0, 10), norm = c(0, 100)) + expect_error(bFitMod(dose = doses, resp = drFit, model = "linlog", S = S, + placAdj = TRUE, type = "Bayes", nSim = 100, prior = prior), + "logistic and linlog models can only be fitted with placAdj") +}) + +test_that("bFitMod correctly handles 'linInt' model", { + fit <- bFitMod(dose = doses, resp = drFit, model = "linInt", S = S, + type = "bootstrap", nSim = 100) + expect_s3_class(fit, "bFitMod") + expect_equal(attr(fit, "model"), "linInt") + expect_true(!is.null(attr(fit, "nodes"))) + expect_true(!is.null(fit$samples)) +}) + +test_that("bFitMod correctly handles additional arguments", { + prior <- list(norm = c(0, 10), norm = c(0, 100), beta=c(0, 1.5, 0.45, 1.7), beta=c(0, 1.5, 0.45, 1.7)) + fit <- bFitMod(dose = doses, resp = drFit, model = "betaMod", S = S, + type = "Bayes", nSim = 100, prior = prior, + addArgs = list(scal = 1.2*max(doses))) + expect_s3_class(fit, "bFitMod") + expect_equal(attr(fit, "model"), "betaMod") + expect_equal(attr(fit, "scal"), 1.2 * max(doses)) + expect_true(!is.null(fit$samples)) +}) + +# Assuming the `biom` dataset is available in the environment for examples +data(biom) +anMod <- lm(resp ~ factor(dose) - 1, data = biom) +drFit <- coef(anMod) +S <- vcov(anMod) +dose <- sort(unique(biom$dose)) + +# Assuming normal priors for test example +prior <- list(norm = c(0, 10), norm = c(0, 100), beta = c(0, 1.5, 0.45, 1.7)) + +# Fit a model +gsample <- bFitMod(dose, drFit, S, model = "emax", start = c(0, 1, 0.1), nSim = 1000, prior = prior) + +test_that("predict.bFitMod returns correct quantiles", { + doseSeq <- c(0, 0.5, 1) + pred <- predict(gsample, doseSeq = doseSeq) + expect_true(is.matrix(pred)) + expect_equal(nrow(pred), 5) # Expecting rows for different quantiles + expect_equal(length(unique(doseSeq)), ncol(pred)) # One column per dose in doseSeq +}) + +test_that("plot.bFitMod generates a plot", { + expect_error(plot(gsample), NA) + # Check for plotting is a little tricky, one way to check if some plot is generated + expect_true(is.null(dev.list()) || length(dev.list()) > 0) +}) + +test_that("coef.bFitMod returns model coefficients", { + coefs <- coef(gsample) + expect_true(is.numeric(coefs)) + expect_equal(length(coefs), length(gsample$samples)) +}) + +# To ensure the appropriate methods are defined, use methods(...) to list them: +test_that("appropriate methods for bFitMod are defined", { + expect_true("predict.bFitMod" %in% methods("predict")) + expect_true("plot.bFitMod" %in% methods("plot")) + expect_true("coef.bFitMod" %in% methods("coef")) +}) \ No newline at end of file diff --git a/tests/testthat/test-guesst.R b/tests/testthat/test-guesst.R index e2c8d16..5288428 100644 --- a/tests/testthat/test-guesst.R +++ b/tests/testthat/test-guesst.R @@ -70,3 +70,32 @@ test_that("sigEmax local", { tolerance = 0.001) }) + +## test error conditions + + +test_that("Error conditions for guesst function", { + + # Test for invalid percentage values (negative or greater than 1) + expect_error(guesst(d = 0.5, p = -0.2, model = "emax"), "must have 0 < p <= 1") + expect_error(guesst(d = 0.5, p = 1.2, model = "emax"), "must have 0 < p <= 1") + + # Test for logistic model needing at least two pairs + expect_error(guesst(d = 0.2, p = 0.5, model = "logistic"), "logistic model needs at least two pairs") + + # Test for local version of emax with p <= d/Maxd + expect_error(guesst(d = 0.3, p = 0.2, model = "emax", local = TRUE, Maxd = 1), "must have p > d/Maxd, for local version") + + # Test for exponential model needing p < d/Maxd + expect_error(guesst(d = 0.8, p = 0.9, model = "exponential", Maxd = 1), "must have p < d/Maxd") + + # Test for betaMod model needing scal > dMax + expect_error(guesst(d = 0.4, p = 0.8, model = "betaMod", dMax = 0.8, scal = 0.8, Maxd = 1), "scal needs to be larger than dMax to calculate guesstimate") + + # Test for betaMod model needing dMax <= Maxd + expect_error(guesst(d = 0.4, p = 0.8, model = "betaMod", dMax = 1.2, scal = 1.5, Maxd = 1), "dose with maximum effect \\(dMax\\) needs to be smaller than maximum dose \\(Maxd\\)") + + # Test for sigmoid Emax model needing at least two pairs + expect_error(guesst(d = 0.2, p = 0.5, model = "sigEmax"), "sigmoid Emax model needs at least two pairs") + +}) diff --git a/tests/testthat/test-optContr.R b/tests/testthat/test-optContr.R index 75f0e01..97805fe 100644 --- a/tests/testthat/test-optContr.R +++ b/tests/testthat/test-optContr.R @@ -135,3 +135,88 @@ calculate optimal contrasts for this shape.") expect_message(optContr(modlist2, w=1, doses=c(0, 0.05, 0.5), placAdj=FALSE, type = "c"), "The linInt2 model has a constant shape, cannot calculate optimal contrasts for this shape.") }) + +test_that("optContr errors when invalid inputs are provided", { + expect_error(optContr(models = list(), doses = c(0, 10), w = c(1, 1)), + "models needs to be of class Mods") + models <- Mods(linear = NULL, emax = 25, direction = c("increasing", "decreasing"), doses = c(0, 10)) + models <- Mods(linear = NULL, doses = c(0, 10)) + expect_error(optContr(models, doses = c(0, 10)), + "Need to specify exactly one of \"w\" or \"S\"") + expect_error(optContr(models, doses = c(0, 10), w = c(1, 1), S = diag(2)), + "Need to specify exactly one of \"w\" or \"S\"") + expect_error(optContr(models, doses = c(0, 10), w = c(1, 1), placAdj = TRUE), + "If placAdj == TRUE there should be no placebo group in \"doses\"") + expect_error(optContr(models, doses = c(0, 10), w = c(1, 1, 1)), + "w needs to be of length 1 or of the same length as doses") + expect_error(optContr(models, doses = c(0, 10), S = c(1, 1)), + "S needs to be a matrix") +}) + +models <- Mods(linear = NULL, doses = c(0, 10)) + +test_that("print.optContr prints contrast matrix", { + contMat <- optContr(models, doses = c(0, 10), w = c(1, 1)) + expect_output(print(contMat), "Optimal contrasts\n.*") +}) + +test_that("summary.optContr summarizes and prints an optContr object", { + contMat <- optContr(models, doses = c(0, 10), w = c(1, 1)) + expect_output(summary(contMat), "Optimal contrasts\n.*") + expect_output(summary(contMat), "Contrast Correlation Matrix:.*") +}) + +test_that("plot.optContr plots contrast coefficients", { + contMat <- optContr(models, doses = c(0, 10), w = c(1, 1)) + expect_silent(plot(contMat, plotType = "contrasts")) + expect_silent(plot(contMat, plotType = "means")) +}) + +test_that("plotContr creates a ggplot object for the contrast coefficients", { + contMat <- optContr(models, doses = c(0, 10), w = c(1, 1)) + expect_s3_class(plotContr(contMat), "ggplot") +}) + +test_that("plotContr creates a ggplot object with the correct data", { + contMat <- optContr(models, doses = c(0, 10), w = c(1, 1)) + plot <- plotContr(contMat) + + # Ensure all dose levels are present in the plot + expect_true(all(levels(as.factor(plot$data$dose)) %in% c(0, 10))) + # Ensure all models are present in the plot + expect_true(all(levels(as.factor(plot$data$model)) %in% c("linear"))) + # Check y-axis label + expect_equal(plot$labels$y, "Contrast coefficients") + # Check x-axis label + expect_equal(plot$labels$x, "Dose") +}) + +test_that("lattice plot for optContr with superpose options works correctly", { + contMat <- optContr(models, doses = c(0, 10), w = c(1, 1)) + expect_no_error(plot(contMat, plotType = "contrasts", superpose = TRUE)) +}) + +test_that("lattice plot for optContr without superpose options works correctly", { + contMat <- optContr(models, doses = c(0, 10), w = c(1, 1)) + expect_no_error(plot(contMat, plotType = "contrasts", superpose = FALSE)) +}) + +# Additional test to ensure plotContr produces the correct ggplot2 plot +test_that("plotContr returns a ggplot2 plot with correct elements", { + models <- Mods(linear = NULL, doses = c(0, 10, 25, 50, 100, 150)) + contMat <- optContr(models, doses = c(0, 10, 25, 50, 100, 150), w = rep(50, 6)) + p <- plotContr(contMat) + expect_s3_class(p, "ggplot") + expect_equal(p$theme$legend.position, "top") +}) + +# Additional test to ensure plot.optContr correctly sets y-axis labels +test_that("plot.optContr sets correct y-axis labels", { + contMat <- optContr(models, doses = c(0, 10), w = c(1, 1)) + + p1 <- plot(contMat, plotType = "contrasts", ylab = "Contrast coefficients") + expect_equal(p1$ylab, "Contrast coefficients") + + p2 <- plot(contMat, plotType = "means", ylab = "Normalized model means") + expect_equal(p2$ylab, "Normalized model means") +}) diff --git a/tests/testthat/test-optDesign.R b/tests/testthat/test-optDesign.R index 6575b0a..e4ae328 100644 --- a/tests/testthat/test-optDesign.R +++ b/tests/testthat/test-optDesign.R @@ -183,3 +183,134 @@ test_that("there are no instabilities for numerical gradients", { des <- optDesign(mm, probs=1, designCrit="TD", Delta=0.5) expect_equal(des$design, c(0.4895, 0.3552, 0.1448, 0, 0.0105), tolerance = 1e-4) }) + +## test error conditions +# Create sample Mods object for testing +doses <- c(0, 10, 25, 50, 100) +models <- Mods(emax = 15, doses = doses, placEff = 0, maxEff = 1) + +# Define some allocation weights for testing +design <- c(0.2, 0.2, 0.2, 0.2, 0.2) + +test_that("optDesign errors when wrong inputs are supplied", { + expect_error(optDesign(models = list(dummy = 1), probs = 1), "\"models\" needs to be of class Mods") + expect_error(optDesign(probs = 1, doses = c(0, 5, 20, 100)), "either \"models\" or \"userCrit\" need to be specified") + expect_error(optDesign(models, probs = 1, optimizer = "exact"), "need to specify sample size via n argument") + expect_error(optDesign(models, probs = 1, nold = c(1, 2, 3)), "need to specify sample size for next cohort via n argument") + expect_error(optDesign(models, probs = 1, designCrit = "TD"), "need to specify target difference \"Delta\"") + expect_error(optDesign(models, probs = 1, designCrit = "Dopt&TD"), "need to specify target difference \"Delta\"") + expect_error(optDesign(models, probs = 1, designCrit = "TD", Delta = -0.5), "\"Delta\" needs to be > 0") + expect_error(optDesign(models, probs = 1, weights = c(1, 1)), "weights and doses need to be of equal length") + expect_error(optDesign(models, probs = 1, lowbnd = rep(0.3, length(doses))), "Infeasible lower bound specified") + expect_error(optDesign(models, probs = 1, uppbnd = rep(0.1, length(doses))), "Infeasible upper bound specified") + expect_error(optDesign(models, probs = 1, lowbnd = c(0.1, 0.2)), "lowbnd needs to be of same length as doses") + expect_error(optDesign(models, probs = 1, uppbnd = c(0.8, 0.9)), "uppbnd needs to be of same length as doses") + expect_error(optDesign(models, probs = 1, doses = c(0, 10), designCrit = "Dopt"), "need at least as many dose levels as there are parameters to calculate Dopt design.") +}) + + + +# Combine all tests in one testthat call +test_that("calcCrit function error handling", { + + expect_error(calcCrit(design = design, models = list(dummy = 1), probs = 1, doses = doses), + "\"models\" needs to be of class Mods", + info = "models argument needs to be of class Mods") + + expect_error(calcCrit(design = list(1, 2, 3), models = models, probs = 1, doses = doses), + "design needs to be numeric", + info = "design needs to be numeric") + + expect_error(calcCrit(design = c(0.5, 0.5), models = models, probs = 1, doses = doses), + "design and doses should be of the same length", + info = "design and doses should be of the same length") + + expect_error(calcCrit(design = c(0.5, 0.4, 0, 0, 0), models = models, probs = 1, doses = doses), + "design needs to sum to 1", + info = "design needs to sum to 1") + + expect_error(calcCrit(design = design, models = models, probs = 1, doses = doses, n = c(1, 2)), + "n needs to be of length 1", + info = "n needs to be of length 1") + + expect_error(calcCrit(design = design, models = models, probs = 1, doses = doses, weights = c(1, 2)), + "weights and doses need to be of equal length", + info = "weights and doses need to be of equal length") + + expect_error(calcCrit(design = design, models = models, probs = 1, doses = doses, designCrit = "TD"), + "need to specify clinical relevance parameter", + info = "Delta needs to be specified for TD designCrit values") + + expect_error(calcCrit(design = design, models = models, probs = 1, doses = doses, designCrit = "Dopt", standDopt = "string"), + "standDopt needs to contain a logical value", + info = "standDopt needs to be logical") + + models_with_invalid_probs <- Mods(emax = 15, doses = doses, placEff = 0, maxEff = 1) + probs_invalid <- c(0.5, 0.5) # Probs length not matching models length + expect_error(calcCrit(design = design, models = models_with_invalid_probs, probs = probs_invalid, doses = doses), + "Probs of wrong length", + info = "probs length should match models length") + expect_error(calcCrit(design = c(0.5, 0.5), models = models, probs = 1, doses = doses[1:2]), + "need more dose levels to calculate Dopt design.", + info = "D-optimality requires enough doses") +}) + +## rndDesign testing +design <- optDesign(models, probs = 1) +design_vector <- design$design + +test_that("rndDesign function error handling and functionality", { + + # Error tests + expect_error(rndDesign(design = design_vector), + "total sample size \"n\" needs to be specified", + info = "total sample size n needs to be specified") + + expect_error(rndDesign(design = list(1, 2, 3), n = 100), + "design needs to be a numeric vector.", + info = "design needs to be a numeric vector") + + # General functionality tests + result <- rndDesign(design = design_vector, n = 100) + expect_equal(sum(result), 100, + info = "sum of rounded design should equal n") + + design_with_small_values <- c(0.1, 0.2, 0.00001, 0.1, 0.6) + result_with_small_values <- rndDesign(design = design_with_small_values, n = 50) + expect_equal(sum(result_with_small_values), 50, + info = "sum of rounded design with small values should equal n") + expect_equal(result_with_small_values[3], 0, + info = "elements of design below eps should be regarded as 0") + + # Test with an actual DRdesign object + result_from_DRdesign <- rndDesign(design = design, n = 100) + expect_equal(sum(result_from_DRdesign), 100, + info = "sum of rounded design from DRdesign object should equal n") + + # Test edge case where design elements sum to exactly 1 + design_exact <- c(0.2, 0.3, 0.5) + result_exact <- rndDesign(design = design_exact, n = 90) + expect_equal(sum(result_exact), 90, + info = "sum of rounded design with exact sum to 1 should equal n") +}) + +## plot testing +test_that("plot.DRdesign function error handling and functionality", { + + # Error test + expect_error(plot.DRdesign(x = design), + info = "models argument needs to be specified") + + # General functionality tests + expect_silent(plot(design, models = models)) + + # Custom line width and color + expect_silent(plot(design, models = models, lwdDes = 5, colDes = "blue")) + + # Test with additional plot arguments + expect_silent(plot(design, models = models, main = "Optimal Design Plot", xlab = "Dose", ylab = "Response")) + + # Verify that plot produces expected output + # Note: This is a visual inspection step, automated checking of graphical output would typically involve visual inspection. + # Ensure that calling plot function does not produce errors or warnings +}) \ No newline at end of file diff --git a/tests/testthat/test-planMod.R b/tests/testthat/test-planMod.R index f1bf56e..aeee34e 100644 --- a/tests/testthat/test-planMod.R +++ b/tests/testthat/test-planMod.R @@ -76,3 +76,66 @@ test_that("negative values for Delta lead to an error", { expect_error(summary(pObj,Delta=-1.1), "\"Delta\" needs to be > 0") }) + + +## error testing +doses <- c(0, 10, 25, 50, 100, 150) +fmodels <- Mods(linear = NULL, emax = 25, logistic = c(50, 10.88111), exponential = 85, betaMod = rbind(c(0.33, 2.31), c(1.39, 1.39)), doses = doses) +sigma <- 1 +n <- rep(62, 6) * 2 + +test_that("planMod errors when wrong or incomplete arguments supplied", { + expect_error(planMod("linInt", fmodels, n, sigma, doses = doses), "planMod works for all built-in models but not linInt") + expect_error(planMod(c("linear", "quadratic"), fmodels, n, sigma, doses = doses, asyApprox = TRUE, simulation = FALSE), "\"asyApprox\" needs to be FALSE for multiple models") + expect_error(planMod("linear", fmodels, doses = doses, asyApprox = TRUE, simulation = FALSE), "either S or n and sigma need to be specified") + expect_error(planMod("linear", fmodels, c(62, 62), sigma, doses = doses, asyApprox = TRUE, simulation = FALSE), "\"n\" and \"doses\" need to be of same length") + expect_error(planMod("linear", fmodels, n, sigma, doses = doses, asyApprox = FALSE, simulation = FALSE), "Need to select either \"asyApprox = TRUE\" or \"simulation = TRUE\"") + +}) + +## test print and plot methods +# Mock some inputs for the planMod function to use in the tests +doses <- c(0, 10, 25, 50, 100, 150) +fmodels <- Mods(linear = NULL, emax = 25, logistic = c(50, 10.88111), exponential = 85, betaMod = rbind(c(0.33, 2.31), c(1.39, 1.39)), doses = doses) +sigma <- 1 +n <- rep(62, 6) * 2 + +# Generate a planMod object to use in tests +pObj <- planMod("linear", fmodels, n, sigma, doses = doses, asyApprox = TRUE, simulation = TRUE, nSim = 10) + +# Test cases +test_that("print.planMod works without errors", { + expect_output(print(pObj), "Fitted Model: linear", fixed = TRUE) +}) + +test_that("plot.planMod dose-response plot works without errors", { + expect_silent(plot(pObj, type = "dose-response")) +}) + +test_that("plot.planMod ED plot works without errors", { + expect_silent(plot(pObj, type = "ED", p = 0.5)) +}) + +test_that("plot.planMod TD plot works without errors", { + expect_silent(plot(pObj, type = "TD", Delta = 0.3)) +}) + +test_that("print.planMod for multiple models works without errors", { + pObj_multi <- planMod(c("linear", "quadratic"), fmodels, n, sigma, doses = doses, asyApprox = FALSE, simulation = TRUE, nSim = 10) + expect_output(print(pObj_multi), "Fitted Models: linear quadratic", fixed = TRUE) +}) + +test_that("plot.planMod for multiple models dose-response plot works without errors", { + pObj_multi <- planMod(c("linear", "quadratic"), fmodels, n, sigma, doses = doses, asyApprox = FALSE, simulation = TRUE, nSim = 10) + expect_silent(plot(pObj_multi, type = "dose-response")) +}) + +test_that("plot.planMod for multiple models ED plot works without errors", { + pObj_multi <- planMod(c("linear", "quadratic"), fmodels, n, sigma, doses = doses, asyApprox = FALSE, simulation = TRUE, nSim = 10) + expect_silent(plot(pObj_multi, type = "ED", p = 0.5)) +}) + +test_that("plot.planMod for multiple models TD plot works without errors", { + pObj_multi <- planMod(c("linear", "quadratic"), fmodels, n, sigma, doses = doses, asyApprox = FALSE, simulation = TRUE, nSim = 10) + expect_silent(plot(pObj_multi, type = "TD", Delta = 0.3)) +}) diff --git a/tests/testthat/test-powMCT.R b/tests/testthat/test-powMCT.R new file mode 100644 index 0000000..da2c6c0 --- /dev/null +++ b/tests/testthat/test-powMCT.R @@ -0,0 +1,100 @@ +# create contrast matrix + +doses <- c(0, 10, 25, 50, 100, 150) +fmodels <- Mods(linear = NULL, emax = 25, logistic = c(50, 10.88111), + exponential = 85, betaMod = rbind(c(0.33, 2.31), c(1.39, 1.39)), + doses = doses, addArgs = list(scal = 200), placEff = 0, maxEff = 0.4) +contMat <- optContr(fmodels, w = 1) + + +######################################################## +## General tests: does powMCT work in various scenarios +######################################################## +test_that("powMCT computes with default values", { + power <- powMCT(contMat, altModels = fmodels, n = 50, sigma = 1) + expect_true(is.numeric(power)) + expect_true(all(power > 0 & power <= 1)) +}) + +test_that("powMCT works with specified covariance matrix S", { + doses <- c(0, 10, 25, 50, 100, 150) + S <- 1^2 / 50 * diag(length(doses)) + power <- powMCT(contMat, altModels = fmodels, S = S, df = 50 * length(doses) - length(doses), alpha = 0.05) + expect_true(is.numeric(power)) + expect_true(all(power > 0 & power <= 1)) +}) + +test_that("powMCT works with placebo adjusted estimates", { + doses <- c(10, 25, 50, 100, 150) + fmodels <- Mods(linear = NULL, emax = 25, logistic = c(50, 10.88111), + exponential = 85, betaMod = rbind(c(0.33, 2.31), c(1.39, 1.39)), + doses = c(0, doses), addArgs = list(scal = 200), placEff = 0, maxEff = 0.4) + contMat <- optContr(fmodels, doses = doses, w = 1, placAdj = TRUE) + power <- powMCT(contMat, altModels = fmodels, n = 50, sigma = 1, placAdj = TRUE) + expect_true(is.numeric(power)) + expect_true(all(power > 0 & power <= 1)) +}) + +test_that("powMCT works with two-sided alternative", { + power <- powMCT(contMat, altModels = fmodels, n = 50, alpha = 0.05, sigma = 1, alternative = "two.sided") + expect_true(is.numeric(power)) + expect_true(all(power > 0 & power <= 1)) +}) + +######################################################## +## Error testing +######################################################## + +test_that("powMCT errors when required arguments are missing", { + expect_error(powMCT(contMat, altModels = fmodels), "Either S or both n and sigma need to be specified") + expect_error(powMCT(contMat, n = 50, sigma = 1), "altModels argument needs to be specified") +}) + +test_that("powMCT detects invalid inputs", { + expect_error(powMCT(list(contMat), altModels = fmodels, n = 50, sigma = 1), "contMat needs to be a matrix") + expect_error(powMCT(contMat, altModels = fmodels, n = rep(50, 2), sigma = 1), "n needs to be of length nrow") + expect_error(powMCT(contMat, altModels = fmodels, n = 1, sigma = 1), "cannot compute power: specified \"n\" and dose vector result in df = 0") + + S <- matrix(1, nrow = 6, ncol = 6) + badS1 <- matrix(1, nrow = 3, ncol = 3) + badS2 <- matrix(1, nrow = 5, ncol = 6) + expect_error(powMCT(contMat, altModels = fmodels, S = S), "need to specify degrees of freedom in \"df\", when specifying \"S\"") + expect_error(powMCT(contMat, altModels = fmodels, S = S, n = 50), "Need to specify either \"S\" or both \"n\" and \"sigma\"") + expect_error(powMCT(contMat, altModels = fmodels, S = badS1, df = 45), "S needs to have as many rows&cols as there are doses") + expect_error(powMCT(contMat, altModels = fmodels, S = badS2, df = 45), "S needs to be a square matrix") + + fmodels2 <- Mods(linear = NULL, emax = 25, logistic = c(50, 10.88111), + exponential = 85, betaMod = rbind(c(0.33, 2.31), c(1.39, 1.39)), + doses = c(0, 10, 25, 50, 100), placEff = 0, maxEff = 0.4) + expect_error(powMCT(contMat, altModels = fmodels2, n = 50, sigma = 1), "Incompatible contMat and muMat") + +}) + +######################################################## +## Test power calculations +######################################################## + +test_that("powMCT gives same result as power.t.test", { + doses <- c(0, 1) + fmodels <- Mods(linear = NULL, doses = doses, placEff = 0, maxEff = 0.4) + contMat <- optContr(fmodels, w = 1) + power1 <- powMCT(contMat, altModels = fmodels, n = 50, sigma = 1) + power2 <- powMCT(contMat, altModels = fmodels, n = 50, sigma = 1, alpha = 0.05, alternative = "two.sided") + expect_equal(as.numeric(power1), power.t.test(n = 50, delta = 0.4, sd = 1, sig.level = 0.025, alternative = "one.sided")$power, tolerance = 0.001) + expect_equal(as.numeric(power2), power.t.test(n = 50, delta = 0.4, sd = 1, sig.level = 0.05, alternative = "two.sided")$power, tolerance = 0.001) + +}) + +## compare power to externally calculated power values +test_that("powMCT calculates power correctly", { + doses <- c(0, 25, 100, 300) + fmodels <- Mods(emax = 45, sigEmax = c(100,3 ), logistic = c(45, 15), + exponential = 60, quadratic = -0.0022, + doses = doses, placEff = 0, maxEff = 1) + contMat <- optContr(fmodels, w = 1) + power <- powMCT(contMat, altModels = fmodels, n = 100, sigma = 3) + expect_equal(as.numeric(power), c(0.672, 0.754, 0.817, 0.757, 0.635), tolerance = 0.01) +}) + + + diff --git a/tests/testthat/test-sampSize.R b/tests/testthat/test-sampSize.R new file mode 100644 index 0000000..34a161e --- /dev/null +++ b/tests/testthat/test-sampSize.R @@ -0,0 +1,206 @@ +# create contrast matrix + +doses <- c(0, 10, 25, 50, 100, 150) +fmodels <- Mods(linear = NULL, emax = 25, logistic = c(50, 10.88111), + exponential = 85, betaMod = rbind(c(0.33, 2.31), c(1.39, 1.39)), + doses = doses, addArgs = list(scal = 200), placEff = 0, maxEff = 0.4) +contMat <- optContr(fmodels, w = 1) + +tFunc <- function(n) { + powVals <- powMCT(contMat, altModels = fmodels, n = n, sigma = 1) + mean(powVals) +} + + +######################################################### +## General tests: does sampSize work as expected +######################################################### + +test_that("sampSize and sampSizeMCT work correctly", { + result1 <- sampSize(upperN = 80, targFunc = tFunc, target = 0.8, alRatio = rep(1, 6)) + result2 <- sampSizeMCT(upperN = 80, power = 0.8, alRatio = rep(1, 6), contMat = contMat, + altModels = fmodels, sigma = 1) + expect_true(is.list(result1)) + expect_true(all(result1$samp.size > 0)) + expect_true(result1$target > 0) + expect_true(is.list(result2)) + expect_true(all(result2$samp.size > 0)) + expect_true(result2$target > 0) + expect_equal(result1$samp.size, result2$samp.size, tolerance = 1) +}) + +test_that("sampSize and sampSizeMCT work correctly with Ntype = total", { + + result1 <- sampSize(upperN = 80, targFunc = tFunc, target = 0.8, alRatio = rep(1, 6), Ntype = "total") + result2 <- sampSizeMCT(upperN = 80, power = 0.8, alRatio = rep(1, 6), contMat = contMat, + altModels = fmodels, sigma = 1, Ntype = "total") + expect_true(is.list(result1)) + expect_true(all(result1$samp.size > 0)) + expect_true(result1$target > 0) + expect_true(is.list(result2)) + expect_true(all(result2$samp.size > 0)) + expect_true(result2$target > 0) + expect_equal(result1$samp.size, result2$samp.size, tolerance = 6) +}) + +test_that("sampSize and sampSizeMCT work correctly with sumFct = min", { + + result1 <- sampSize(upperN = 80, targFunc = tFunc, target = 0.8, alRatio = rep(1, 6), Ntype = "total") + result2 <- sampSizeMCT(upperN = 80, power = 0.8, alRatio = rep(1, 6), contMat = contMat, + altModels = fmodels, sigma = 1, Ntype = "total", sumFct = min) + expect_true(is.list(result1)) + expect_true(all(result1$samp.size > 0)) + expect_true(result1$target > 0) + expect_true(is.list(result2)) + expect_true(all(result2$samp.size > 0)) + expect_true(result2$target > 0) + expect_equal(result1$samp.size, result2$samp.size, tolerance = 6) +}) + +test_that("sampSizeMCT handles S matrix correctly", { + S <- 6 * diag(6) + result <- sampSizeMCT(upperN = 500, contMat = contMat, S = S, altModels = fmodels, + power = 0.8, alRatio = rep(1, 6), Ntype = "total") + + expect_true(is.list(result)) + expect_true(all(result$samp.size > 0)) + expect_true(result$target > 0) +}) + +test_that("print.sampSize prints correct output", { + sSize_obj <- sampSize(upperN = 80, targFunc = tFunc, target = 0.8, alRatio = rep(1, 6), Ntype = "total") + + expect_output(print(sSize_obj), "Sample size calculation\n\n", fixed = TRUE) + expect_output(print(sSize_obj), "alRatio: ", fixed = TRUE) + expect_output(print(sSize_obj), paste("Total sample size:", sum(sSize_obj$samp.size)), fixed = TRUE) + expect_output(print(sSize_obj), paste("Sample size per arm:", paste(sSize_obj$samp.size, collapse = " ")), fixed = TRUE) + expect_output(print(sSize_obj), paste("targFunc:", sSize_obj$target), fixed = TRUE) +}) + + +######################################################## +## Error testing +######################################################## + +test_that("sampSize errors with invalid inputs", { + expect_error(sampSize(upperN = 80, targFunc = NULL, target = 0.8, alRatio = rep(1, 6)), + "targFunc") + expect_error(sampSize(upperN = 80, targFunc = function(n) { n }, target = 0.8), + "allocation ratios need to be specified") + expect_error(sampSize(upperN = 80, targFunc = function(n) { n }, target = 0.8, alRatio = c(1, -1, 1)), + "all entries of alRatio need to be positive") +}) + +test_that("sampSizeMCT errors with invalid inputs", { + expect_error(sampSizeMCT(upperN = 80, contMat = contMat, altModels = fmodels, + power = 0.8, alRatio = rep(1, 6), alpha = 0.025, placAdj = TRUE), + "placAdj needs to be FALSE") + expect_error(sampSizeMCT(upperN = 80, contMat = contMat, altModels = fmodels, + power = 0.8, alRatio = rep(1, 6), sigma = 1, n = 50), + "n is not allowed to be specified") + expect_error(sampSizeMCT(upperN = 80, contMat = contMat, altModels = fmodels, + power = 0.8, alRatio = rep(1, 6)), + "need sigma if S is not specified") +}) + + +######################################################## +## Compare results to powMCT +######################################################## + +# Tests for sampSizeMCT function +test_that("sampSizeMCT results are consistent with powMCT", { + result <- sampSizeMCT(upperN = 80, contMat = contMat, sigma = 1, altModels = fmodels, + power = 0.8, alRatio = rep(1, 6), alpha = 0.025) + power <- powMCT(contMat, altModels = fmodels, sigma = 1, n = result$samp.size[1]) + + expect_equal(result$target, mean(power), tolerance = 0.01) +}) + +######################################################## +## Testing targN and powN +######################################################## +tFunc <- function(n) { + powVals <- powMCT(contMat, altModels = fmodels, n = n, sigma = 1) + powVals +} + +test_that("targN calculates target function values correctly", { + + # Perform targN calculations + result <- targN(upperN = 100, lowerN = 10, step = 10, targFunc = tFunc, alRatio = rep(1, 6)) + power <- powMCT(contMat, altModels = fmodels, n = 50, sigma = 1) + power <- c(power, min(power), mean(power), max(power)) + expect_true(is.matrix(result)) + expect_true(nrow(result) > 0) + expect_true(ncol(result) > 0) + expect_true(all(result > 0 & result <= 1)) + expect_true(all(c("min", "mean", "max") %in% colnames(result))) + expect_equal(as.numeric(power), as.numeric(result[5, ]), tolerance = 0.01) +}) + +test_that("powN calculates power correctly", { + + # Perform targN calculations + result <- powN(upperN = 100, lowerN = 10, step = 10, alRatio = rep(1, 6), contMat = contMat, sigma = 1, altModels = fmodels) + power <- powMCT(contMat, altModels = fmodels, n = 50, sigma = 1) + power <- c(power, min(power), mean(power), max(power)) + expect_true(is.matrix(result)) + expect_true(nrow(result) > 0) + expect_true(ncol(result) > 0) + expect_true(all(result > 0 & result <= 1)) + expect_true(all(c("min", "mean", "max") %in% colnames(result))) + expect_equal(as.numeric(power), as.numeric(result[5, ]), tolerance = 0.01) +}) + + +test_that("targN errors with invalid inputs", { + + expect_error(targN(upperN = 100, lowerN = 10, step = 10, targFunc = tFunc), + "allocation ratios need to be specified") + expect_error(targN(upperN = 100, lowerN = 10, step = 10, targFunc = tFunc, alRatio = c(1, 0, 1)), + "all entries of alRatio need to be positive") + expect_error(targN(upperN = 100, lowerN = 10, step = 10, targFunc = tFunc, alRatio = rep(1, 6), sumFct = mean), + "sumFct needs to be a character vector") +}) + + +test_that("powN errors with invalid inputs", { + + expect_error(powN(upperN = 100, lowerN = 10, step = 10, alRatio = rep(1, 6), contMat = contMat, sigma = 1, altModels = fmodels, placAdj = TRUE), + "placAdj needs to be FALSE for powN") + expect_error(powN(upperN = 100, lowerN = 10, step = 10, alRatio = rep(1, 6), contMat = contMat, sigma = 1, n = 50, altModels = fmodels), + "n is not allowed to be specified for sample size calculation") + expect_error(powN(upperN = 100, lowerN = 10, step = 10, alRatio = rep(1, 6), contMat = contMat, altModels = fmodels), + "need sigma if S is not specified") +}) + +test_that("powN handles S matrix correctly", { + S <- 6 * diag(6) + result <- powN(upperN = 100, lowerN = 10, step = 10, contMat = contMat, S = S, altModels = fmodels, + alRatio = rep(1, 6), Ntype = "total") + expect_true(is.matrix(result)) + expect_true(nrow(result) > 0) + expect_true(ncol(result) > 0) + expect_true(all(result > 0 & result <= 1)) + expect_true(all(c("min", "mean", "max") %in% colnames(result))) +}) + +# Tests for plot.targN function +tn <- targN(upperN = 100, lowerN = 10, step = 10, targFunc = tFunc, alRatio = rep(1, 6)) + +test_that("plot.targN works as expected", { + expect_error(plot(tn), NA) + # Test with superpose = TRUE + expect_error(plot(tn, superpose = TRUE), NA) + # Test with superpose = FALSE + expect_error(plot(tn, superpose = FALSE), NA) + # Test with line.at specified + expect_error(plot(tn, line.at = 0.8), NA) + # Test with line.at as NULL + expect_error(plot(tn, line.at = NULL), NA) + # Test with custom xlab and ylab + expect_error(plot(tn, xlab = "Sample Size", ylab = "Power"), NA) + # Test with default xlab and ylab + expect_error(plot(tn, xlab = NULL, ylab = NULL), NA) +}) From 5de7861a8912cdbff6fb1f7583711e52f9f8ba93 Mon Sep 17 00:00:00 2001 From: MThomas91 Date: Mon, 6 Jan 2025 17:51:40 +0100 Subject: [PATCH 2/3] added github action for test coverage --- .github/workflows/test-coverage.yaml | 61 ++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) create mode 100644 .github/workflows/test-coverage.yaml diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml new file mode 100644 index 0000000..e050312 --- /dev/null +++ b/.github/workflows/test-coverage.yaml @@ -0,0 +1,61 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, master] + pull_request: + +name: test-coverage.yaml + +permissions: read-all + +jobs: + test-coverage: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::covr, any::xml2 + needs: coverage + + - name: Test coverage + run: | + cov <- covr::package_coverage( + quiet = FALSE, + clean = FALSE, + install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") + ) + covr::to_cobertura(cov) + shell: Rscript {0} + + - uses: codecov/codecov-action@v4 + with: + # Fail if error if not on PR, or if on PR and token is given + fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }} + file: ./cobertura.xml + plugin: noop + disable_search: true + token: ${{ secrets.CODECOV_TOKEN }} + + - name: Show testthat output + if: always() + run: | + ## -------------------------------------------------------------------- + find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true + shell: bash + + - name: Upload test results + if: failure() + uses: actions/upload-artifact@v4 + with: + name: coverage-test-failures + path: ${{ runner.temp }}/package From 260c63d45bc86289e81b3dfbcf963e7627103122 Mon Sep 17 00:00:00 2001 From: MThomas91 Date: Tue, 14 Jan 2025 10:43:40 +0100 Subject: [PATCH 3/3] remove github action for test coverage --- .github/workflows/test-coverage.yaml | 61 ---------------------------- 1 file changed, 61 deletions(-) delete mode 100644 .github/workflows/test-coverage.yaml diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml deleted file mode 100644 index e050312..0000000 --- a/.github/workflows/test-coverage.yaml +++ /dev/null @@ -1,61 +0,0 @@ -# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples -# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help -on: - push: - branches: [main, master] - pull_request: - -name: test-coverage.yaml - -permissions: read-all - -jobs: - test-coverage: - runs-on: ubuntu-latest - env: - GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} - - steps: - - uses: actions/checkout@v4 - - - uses: r-lib/actions/setup-r@v2 - with: - use-public-rspm: true - - - uses: r-lib/actions/setup-r-dependencies@v2 - with: - extra-packages: any::covr, any::xml2 - needs: coverage - - - name: Test coverage - run: | - cov <- covr::package_coverage( - quiet = FALSE, - clean = FALSE, - install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") - ) - covr::to_cobertura(cov) - shell: Rscript {0} - - - uses: codecov/codecov-action@v4 - with: - # Fail if error if not on PR, or if on PR and token is given - fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }} - file: ./cobertura.xml - plugin: noop - disable_search: true - token: ${{ secrets.CODECOV_TOKEN }} - - - name: Show testthat output - if: always() - run: | - ## -------------------------------------------------------------------- - find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true - shell: bash - - - name: Upload test results - if: failure() - uses: actions/upload-artifact@v4 - with: - name: coverage-test-failures - path: ${{ runner.temp }}/package