etm/0000755000176200001440000000000013725704663011054 5ustar liggesusersetm/NAMESPACE0000755000176200001440000000210313234166562012265 0ustar liggesusersuseDynLib(etm, .registration = TRUE) importFrom(Rcpp, evalCpp) import(parallel, data.table) importFrom("survival", "Surv", "survfit", "is.Surv") importFrom("lattice", "xyplot") importFrom("graphics", "axis", "box", "close.screen", "lines", "par", "plot", "screen", "split.screen", "segments") importFrom("stats", "qnorm", "quantile", "model.extract", "terms", "model.frame") export(etm, clos, tra_ill, tra_ill_comp, tra_comp, tra_surv, prepare.los.data, trprob, trcov, etmCIF, etmprep, closPseudo) S3method(etm, data.frame) S3method(clos, msfit) S3method(clos, etm) S3method(print, clos.etm) S3method(plot, clos.etm) S3method(xyplot, etm) S3method(print, etm) S3method("[", etm) S3method(summary, etm) S3method(print, summary.etm) S3method(plot, etm) S3method(lines, etm) S3method(trprob, etm) S3method(trcov, etm) S3method(print, etmCIF) S3method(plot, etmCIF) S3method(summary, etmCIF) S3method(print, summary.etmCIF) ## useDynLib(etm, .registration = TRUE) ## exportPattern("^[[:alpha:]]+") etm/LICENSE0000755000176200001440000000005413057751334012056 0ustar liggesusersYEAR: 2016 COPYRIGHT HOLDER: Arthur Allignoletm/README.md0000755000176200001440000000022113057751334012324 0ustar liggesusers# etm Non-parametric estimation of the matrix of transition probabilities for any time-inhomogeneous multistate model with finite state space. etm/data/0000755000176200001440000000000013647151730011757 5ustar liggesusersetm/data/abortion.txt.gz0000644000176200001440000001100413647151730014750 0ustar liggesusersU[umO1q&rDi"o_0ƒ?L ۬???5_1O?}-oܿqϿȿm_׏G_1$?gه| }}\lgyZo Kƚ<3w?,sv9V5$׻:uv w4Gc)4A{%Ht_{M _z\vo$u{!U @c_gv݆uy{pjB؍7yyR2G0u{|㞭o0TFusi%)T\H j6w~L7;@󴫭jv m)Qf? &q/TՃ;9xJ8ЗasYb\`Vcm~OEJ#{k m{ۀzߎ ;@wN/w! xzpz%I=!HoC"ľ}zdǂT]g%sq/ ^އ"4' XO&W}aNH3݅#3nNύ#Qq_?:3(j⢼4 `Z^Vz<#-llry\ȥdQO׻@wIk;ږo[ J&L>!z @I)*L\.:pqX^WO˻7"WWp1u\ GB%\m=&>5Yhtm9?B^b:bqW4Nxb=/CF?(SOßD@YC`a}u`u !^[n$Z2% S;v]\`~/Do0D8wp O'qrIIiS܀y wp L!69(Vh!p >ߪ@=_4&|K)m=RP@E ew 5F6j`A}L&x>.iנnφS<<Qn B2w5 igCQ"x+)pxBw%i4$ ̼ՔQy6!~~B)fI: 4A|x~mx(=-}6QNxxM(늜P}'1a,ή'-z'T{-RBQ ~ H<"`QΠF6 @'i08)m1Xn)T(Ùsx3 lˈHoGy/OI9ꍟxgF707+}N 8aL F>K w+1~0p2aqᨾ)ČrEC =/hh$y+'za'|^u9 rh@9E(Ȅ#\7-mYE4 YyIL\JǷxg ?QY\|kgX+AuБ9KH*H #pK0*qԫ#2s<Gear, !oȒ /#PJNDBN N Ig[YзyEp}@&-UI:ď@zn>ZādvڱbBV;EE幾L|(▨*V*eq{]uToY3k㢆q>KR\;yT8$ JQeL7֪2/'-$FYÆlKk d5uh`F[+6` LC۩c7B]Xm@/:~3ݥ׻. CC*V;`홪MP{Tx[^x:}pI3~r]^=]QuV4*&AYdb:0"xeL)CQyǥoWeNt1F3 _A)L'>d]e@~AbAHQ0NP&](BuM+)>>] zW *|j:! ssgLj%(b.T-v_=~[k BقC(rZ!"@ ;56"YYbϚrL5+؁b#ke6a Y5}>kё:ޫIнw!e|v$˺x\hc\0 82䞆$lwRF 7F/ӟg:\|@Em %<5Ӎ0p9|'ASN:qf:g.֊Nglg(!.[ 0693U:Cጕ˳ү@\ߐ3(cPwz6:#tMWD)W C7:|?am-"3fS+T7|↋#_xVeٽ:+,)$'!|g*Th8FXxC| @mcŃhBJ =r 0h D |iÐ<:b;i{)%:ph-c \ZI(wn 1ER7JDG5=YAsC%) '%)&OGn7 )i< &@`Ĩ/0X#rzi&BCHǑCS(Z@a."3 )P؄<&Q #+G%h]'ϒ B0x6/Y! bd v?MA8PmJ^&x0s%G! |PlU`a0v>]VPm? gI)G[kO/H{AԔKH`SoN|fJyCw :ťEFٖa:_zyRR-e)}[y=.ޠXRK=aJetm/data/sir.cont.txt.gz0000644000176200001440000002456113647151730014706 0ustar liggesusers}]%{@0z;pmG?;K$rd6 BwϿW~_R?s-)RF]Ŀd)=%.?ErNOmImm%*ss_e|RjWJ}V7/C"-kגQATsUZsj|\+R1<e__$FX:?kt=.BT'Rh{COv1%-pje꣭~Zƣy;#Xܫ̙9%X.tct݆[^btnr{~p.OsOS~}t}ry|e87_NOQhJ~ycOVGLrPgmI#Քd_AdT}nL lͫz n/n'cCԢ2%Bu$0VS0~Ӑ<)Se6')K3Qz"R Jckq2\ڶ6:kTb6J?+kZK^/Ο]C:F`kg6hRbpj.#˨}Ko tgƇ tpT}F]Y*u}3:C;5, 6nrc~.82ZU<>ۡ::v o>2'>S>m6|}FNN)'n yZp6^qU+q8x!>~;nN hwWFy*EP&\=Ĉ"1eTIqWҨC޾u5֓yOg0Ŷ]i}_ އ6\a;*nz󖀤svӞ2^Ѓb.|WOv Z㜺(/ v vb%_WXHl I| ; ufQ-3*o]@@.U-=}%*'>u: 56+Jc# A&C1|+ ]r{ NE8_kviNaq `}vs&c9!GX- #h Z /FN^Z&,m cH{ص,o+ǒ5Q/cf'^ZB{;t!*q+p0Niv𧨨MylBLIdA$5GBg *J`ߘ[^vgyet N%2aat3Md NκD!-MC!}ʯGz/inݶ;Eʙu0q 8oC&P55Iu2nj*c |Ÿ"ڶnNm}ӷ?+)omD t?R1Z\Z''To` xm£)w#mST?M}D*OyAH^k+d;brG VbUEq|Cht(8LMuJ !3]c$w?|G H#wy\r]=tY{ :+`a1iMja۞>e&@xE^2V31$ qo\\&5+-`7Jz2tj;~G rO,%/jV ml>[hrqWK)J(DЫt@ln<62I4 T+rPr,C?^rJrajNMO  /=(.ԔNM"z T`m1`*g z|:3Bx owMtЫY6|poS,G!ɗ" gJIR#2諛Rk6*FT{rL!k`<D7DMv@HWʩ`l>̃Q'܅pELQD=W7Gk8C`kyS{j.z *_ͱ\7D㭓azA\TZV' q C wa|w[}b9aJƆ$p_4+b!Z ;q>qXa xcukQʦFTҮ<>q `S_1ӴWݲ 㔀{|*1@˖V ';bDUv-H`)j,8wkX\ :Ȁn:G4BrCz|6 Fh K~ Ⓥ-'{- (5T\1DiLQM JHyT?ݧ BճnǰDaBkjNXoDeTsx8nAx 8xDDkYܤ2Հ9_ 0uECKL>`Kw)1x"SJ!Ɔ ^0 <`F8d4,{oZ6c Ge*X3vl;kFQMS"O}lʼZx N+oݕ혋j7w ޳#mAzErYn9s>ޓְw pݐF||Wt8) 1nl ݔ=R %d@p t4$WX(ms5cĕ,- }1\Yux↲I|jvz֐Biie Qw=f/R +A0bS[ !'3 >u,:!oEj1?¸!tq!H3 ZI.w@:eTNGi=V xaaֲ[K@3#·/ʐa>;:NVW˚XljRD$;~!C>E-Q#.SJ ,eiw.MV~=\ p`FxKx8ǫ/(a+gCĈa]lg+b+ H]#a` @;D6@878DΌO ?]ԋMC 锸fcw w/rXSc{͟8idMj2MX>pfpx[GR0\4_QX:R{T`D:ր%QZbq~G T0p=G$-I@xp:rb,Z$]wD `{Įޏ441G#8RI D5m!68o;n]=XDCf idJ3@vxY3U pĕ+L<7e2+"0Xs K=jҺ .ew_nZ}{X:%kx N9Jzڮ!m ZQ#R UY۱5= $ [Wk:WV m+>c٪LS)gBDSl:g9y8(K quT~0YaQ"ZrnU@.7'!N?: MV/O"`Zٹu~w2`uJc|s븧!XeP2U&`c/_<$TX@z)HD18rki>CۏE"`dϰ=NA3P!8h̑l}nÇU b,ɱʶbi=͇zMyDJ9J** *7@ޚAAGU7b_~A(@@G!&]p(%e}*b3૆Hi/tV?…Ɩm@ Jg/7 -m1. u;Wۜ\G9 *Qm:bPy`a!# J=TlGkz>[Ѝ=@7mn[j|=DzbUs莦7đWh@x((Q5$DvW)Bqy'>Gel*>t{v)]hjH1&?p"j^$>[2@LhH0Z 8bgdw`#CZ",CJ|,3Y7W) vӂ`/+`-& "Ԃ` ٽf k]<HC׳D)z >aYL[;LpW47{AeܿУ|zb 5"PCJZu}HQoN~XarL) 9x{,69gU& w@?G:꛴+B|EV#tu͸#h41)ƏÕCK[X~XS2:zxh5SݯWZ#mU)w=Ab9[:?;ş#֤m4ؔgeyXi w%QQ*Og6aoQc5C#2i]!:R߲v2o.T%B^M==%R mrv1@?"A飑*::\q\`H;pGH$3  `{c µ?wwz dWS0r-wK)Z.5Z#-,&=PlZȞ9򎐣35nXcRqۧ6_TM""VϝmF6da@xꊐC ֬ wD*oZtpJxZX2n;1ζn$]B姯i{BfuVZ -XqLkΖ1)?HcHphQX;z`yQ6P\ ^POW\847b)g"ؽKHb3E(*5ޒKVOtt I#Q'  #?1zD qH|FL;*DH q\$og ;#,D )ៀB]kKBnXJ#Ĭ,.>]W9>13RqZ@j!VCyv5 10WSp= 9>CY{Eh-%pw0W;_ptKwDH2HC)i9;!QSN]X!soPDX{Qܙ5 %PpyB G̳UH3 |ۀWQՉcB$+/&7@䙚rboƫswsG}!(G[2ntOf pS˻#< Y-։X_|GPAr d8}z<~GxSQ0R-$| G` h\Q@?H6W%fXQ#ISW,`h6{lE؂S+NIXXrO46߯+`Dު prEtgedw֌"EG|8N锑>3GBazk2C! C#PDti|q4@9'o5ّuvĚpp4TW@=vztopFqE'JxJ" "hχDQ_}A#`w<~Nی<~y$(+3~|!96#)Ou'(Fn=RJ[Ǜ5E#/dp93@ǕM-'"yEC(ӧjt$t bʡ!T\Ӗ`;&j*h't#p.vVDa:_Q#A2ԡ*4ZSk3ixG6wVWZ̅٭I \ MU&9pz#%khuO vyi3iwfW<68~O^;U)3v048DV|jfWph8It~NbwGS,TՄ ~E r';>U{|djTfj~>ᶻ"5m8<ڋ/@>EO]֦_9"bhG#*G֖1чmfSЛDNp,cbkCiP&*nUgIPK.,]v1._'Ing!<_̫[WD֭vFrGC1HY}7DoضPXKu..ڵ8ĩ .A &c"m1@zt]CJPDKn`c!އh4XLɳ c+}z+N -F *V)J8"VTU,C{L օQm>wڮieg&@r&qv=Zz]!rXYB⽨ҵa;?x##4K*EHvI\mHzxΜd8ޠoZ\F7#m[8iO9,' G?Ђx9Xl͖Gcд9x ^3(lԃÃ%]f HbV(Yw(n@w@vDOUW(5HHL`HcfΡJU  E^0vN<%gxpvEDslmֹKo. 9uK}k^,㻗 j:v׎ѱpgqfh;#E5厨G *X7c dP%_j U`<kǁ}#FNZ>*☀ppi4U/$?VRmzw-R2Vj>&}VD8dV-/ ̚I3crr--FF3RV7i3LO[>{;±/E!:d6~ߙ-]ӴUɢ9QEN>a;awxFg^o)K6<9VS[wD%j3͈ySe$MYz8'cвǤ69ylvgy4ǸevtܾfɗjXb[p LMMdLGh}NZbrn+T7 M;(wl],_o۟Q%vEP9 m4Jޡv|PλߋSɁ8VZЗ 8[qjYutZM~Yw1ʴ,k=C#c%)Y7;`[kcT=h-,ch_Fs{#Fl8yےz{MC=F[mG wn[Z{;n\<J4G a5탆yp54{pܷgT~ ou̷C5VdfF|"^F]梇ʅ溅PjY. {@#W. pk BZP0)[+M͠='z Z!(N>4=E[${tFh'Ra (.Y_"Jlד:K:Χ -U[49*AHw+D(`aNWJ2%[ ܳ 8 Ly`(14"mԯ.MX& 4dEe;緭y!g$ǹa 1b(R@vX6z5G7&"%DzbB9,VqeOul1@q2 t *`OYc彨PXquJD{pژR 9pw62gE5zWۈ/U$2D:,O(aփB,}jɇ>ZKd j, 0rHz ĝ墔Z6&Y(W"(P2I!(lAJf{,6 $MB:q$W2IY1|*ҤREj |Z*-FDɇ3&vR<WE_<}EIDR6K%,8DNy!TdŚ,! o,5J+Ǜ_ǝ5-Ш*>}b" !;yaU>}!:Gbh :e BHPL>Uw *-(A<+M:58WLqKTW+,H/ g# *@8&FG,1ĪGg>e3Yd10i/癆|&AʌG؞֋|:aLܜ..h= !eP$zQYШK8MHSpeX"]T_DM4qܺZ9j12x,YCq7V8kE!8a̞΃%*1OpgP%A:Qa<Pgr/PR*D7'*yF]Fu@8UFO _$a7 @gDTQEGmqbWZ[,Ң6*SexQܧ'}ǹb>"X nWC;b"uXC;Xd1/ m,^ չbRΑVݎ' x+*rE{DоKx J *j(A7]D1N>D6θY)h[()<,a<؟,1?رnlc|j֮"nаذذݮPb"pc[9[  3G=b_Ioi-h2U~ ! >?T_@HGwŰӍsPúbTGhV57g yh9 쌛@B2mG߰ݐ&PW<ͦ454$Xбvi,͡Q-IE~6v 8O `5-E6Pu ژCh#5ߺ) A, D?0i+sC&`ޤllT(?& u9]d 1*g^KLiE G',$f6_ Letm/data/fourD.rda0000755000176200001440000002237313057751334013541 0ustar liggesusers}xTE&$F$Ά"tBvs((*WQXQT@HRDK"MQz!Λ99^A>!^=ڦA{oLn A1"no`IBPmXFowitc3s`0 X,ˁZ`=  ~~CI"p\l b!dc+ `87 偊@U @pck 426@[a# t݁@_`0x0`40 oM | |f3Y|`mڶ6pll(p߶S<mpns{ @/vnh$Pv/ ~ 4́@+^pk< }80xtl |C;8C;8/G;xzK;j @vg@j? ;9Ck?t?G;s n:*UjtH<tpH:[tpph :p _G::^[u@[:S|:>G8x<;uw<pov+Ь|;|;Ъp?8r,؀ Ν pBX|;a2t?8+ک ^'tKg:Np8:;@g^N :f N'xuNx '8 NNZvs'8ws'vs)ue'/8; NNx넞 Opc' M;Npc'. 낞]в xuT.x uo]]Ьn]Y|]  ܺЫ Zu  |^ >.h&uOtOs[]ouC8tA. zuA.hN]+Zl ZuC.~+W.Q%d` g_%x|+/KUο$/KYξ.%.O \J5)K zW \JRp%p'; :С$KУ" $hP%hPot'KNgҧζ/$hO$L?t&!IP Y$hN$hN:@wt'Awη>%! ~*S J7q˴E78uS7 \Р\=7ҍv'7?ng7γ~@~wC{npgnc7< t# mrtCGnFq߹F`3.X{Xku㬹7Z8kM2tu%Nܐ5%cM@2j2>kJ'?w2:g$&|$#qC2wUwsݻ'Ns2ݝ_sɝUۑk Gw׭{wwafzݍww:qwUyw4u7;κ?SXw̿v9=K Ǎ O{oO7Ԝ{@ hPGg-Ƣm^]Mų>Gg-E߼ؚ~1_ G̣uE\|RġD~Ѧ7ljPm Ʈ#m"b1*x)7r1nXW^[3o&5^紅XC=O#LGѾ@1VMDLĜzu{MӾ4b|}z&j*[b&b<]OĺbtѮS+h5Ƭoxϫm-wYw yxo⬁ؗ@+1~.,Ϻ&/1WtSΥ΋"m5SMųzb=n$7hf!mq*ZHywG1NcS-@7uMkV?y&ELEyq5ycό_;/M dttgj[SG\Ȇn3}Z']-f_KFb>}ͭD3>bB>z&1V6us"Ϛ u}ZdX翴A-y1^hV}2;w/T UCP5T UCP5T UCP5T UCP5T UCP5T UCP5T UCP5T UCP5T UCPwWXƒ= ~b)x? 7}fͯx /1qCAߦ|=̼YGsx;N<^A zf1y-A}o׷ <Y Mci1o /x?p#.5.8.=XoA|t * m멠x_tW~WAGg,xmvq믂2xq=7Gssg1 `}Ծ53a)ݟ]1 y(h٥{Cq{D_:ɋ}dt vn/}®2f%ri[E|An\YnA%;Kv\;<)=_ቍʟ whKSr'ߘдFk؎/Jxna%}ay۝s]ȭ'c }Oo+<Mefd'vst0dWr%mk/{[>g=^_ɭc<6rk& sZܕm^s&/'na)wOx ٩w9n}N{W0r踽2YOɍyg |GTxrۗ:lm%nU3fW\c_/6 /^tG=ɋ[gL.ݤaۖ$O+>y4i՘KeN|YtV\6?Y-gvܺ~s$.:(nzѲ襏~#ܴL",Ź>}x $sB_EX~wv­e?9Z3 ԣ3B)]>}IƂnZ[&qS?0ǥoOiXQ_ʲ&_V}ugxRz֝ãセxlys:ۯnN=nΗ}Q]^_V#Ǟ`mxM>~=b[˛Xzڿ;Z@cء{#_w(ļLfۗɚm{f ݕ]/c@8v۝<5-ŭKr~{ٕ*P-1ٲkrZ Ցu|hDzg/ej(v9[w}cN<3>=ةs-xӤdžF7^_rq&vyY#&dKKnyfߖb׮#l8 >ѥGhv[ѨCgn w{֋򢵴gk|βRaskTrUW.<\[ =w3R;|sSؕLJD K&yXT6%(ŋ_}}i߱j|Ζ~&n,OzVqp&3V㱬#2]rYoٕT-<>vy{=w2͸um3Ī-lb?Cߎ-aԁmzکn%)CX Uo^*ϋD[KZg [fcqNu=D=RjOvekz뇰)F^mCrs֩ ƽ6|Wԑjm^?M,w>K9]gxSfLrŽA쌮ӣOH`H7eG); _$r=d>.CfV$Ȫq?hc{º>Xw?',ڜ׆4,䋕FBgP7v 'mIy5Cښ=~e]< k*=3+,S>yu;`n|iɃ~} Pxun}el}^r54$UA^=܊'e6rcOs"6t_ec~-P˱wG~[C6U|{x;/MӸs;3kvfra{c1W;쫑[yzt.no][~|O~~?1[2ihQyQ_s+輌]t>cqI8aWU܂EjSyTV㎩<]g.~'lc:zju6V'=7=WG$|Mڹ}Xn5kӟ8ڪŁßbn;i8vE/!7zwϠly <bxG<]=8y4s"^| ~ԎGm/rmGs!WNJ=yܨzC;~~9u[c~`uUF\YˎU9Q9cv,j%92p})==0۸CKWWVnw|/y"7}kq<*nꂺlxqrBY)qrSKKRg݅v{Uzx̂M;>:^ že9?Rȇϯi}2umcx'_1垫yQirzcNp)x=FǷh7G<_|5Aշع#"zOݿs˒]3W}]ev>Og/ϮG>{]߸𭯬3Lϣ>w7Z;1ۜٗxؕ]1uUnּϰ,E_-][0#@X~dpP嬟~V>_.oxN||; ?!M6l3vH~xydWNv߼Syx ӗ#%niO3svg;׷ o{+y.mG]ى:hË~fn쇾cxϿfb.l=ۍ짬 _Mo4ؚ]\o5Y.٭Cу{_,+}Ckr,~֢&,[| =KNvOɥ#,l?'_5_ϓ9Į5zʚOv[q~_auSWķ=ZcV`v-f^m0vߏw?1 B+ B+ B+ B+ BW'2v`(RL|޳(u^Obvҳs00s1g_mf%hN1mGz#RE6F_7y~b=bP#.`SXTcd=TfЌ94\ēJEe**T4uӌFx"n^j륉FfR7u>GmeLn2i6?S[?E'JnB#(M j[f  =@1h\ڪV*hbVzS=TRQBEcbJT4."ulڒJ>%xI0^i6F xeO$xI;^?@2iWHQ^B'yIF^%xUR7$xI;^ҎW4M4lG*J|y#iK|F*y=Tټ*|$ ڒJ|J|'S[IGi G^#jK"5|u#Tࣝk5|>r rL!d҃ꧢ1Lz5dLV!dLERdkD&/I%2D&i$ !4dF ȲMLҐ*dLҐZ&PY)ɤ9@vd2#vdd$dJI2يL"4يL"tq$#?ي?֘OyO2?eOEQ7O*J2u#'I%~?V$?يҌ'I0~r?iǯFU`$?O*4*u#I~|Ow?%,HۊBQH0 !|G!(dA $RB[dB2RȍB2RHF BFۊB2RHF BI!E)dA ]\RB((dBwҗBw,HLҙB:SHg L!)3,H!q)r# q(Hg2,j!@ x,@: $%yTnW qȮQW qȣFN2Yn6rYP H%$@* Pv t M&`y>Ϋ*JG%/QiUn*$[KJ;$DuFWiUyG#è$FC*A%0*9J9K%QlTҎJK%QI;*JfètQIF*J_T%*lTdTJJ%i%F@4r ĥQH\)J#i4F)I#id e'd4r .9iG#54҃F;kh~S[ D4D#ihd+IC#iht(id6FH;D#hd6 F#hT*2+{Me,~SY1McW61c^S ^S{i.C?yes_Ӽ>S_g+MkMMsM1M+1Ә)6ăbS1ͥ b0QM}US jG3L1hhq4S<I^SY1M=6S~<&xL5c҉Ǥ e6b3yk4Ic^Ƽ&ye&ѯyeӘ&zM:ߓʦL:ߑʦ&}2t%s`fJ[yƧetm/man/0000755000176200001440000000000013723773427011631 5ustar liggesusersetm/man/summary.etmCIF.Rd0000755000176200001440000000236213226505116014713 0ustar liggesusers\name{summary.etmCIF} \alias{summary.etmCIF} \alias{print.summary.etmCIF} \title{ Summary function for cifETM } \description{ Summary function for objects of class \code{cifETM} } \usage{ \S3method{summary}{etmCIF}(object, ci.fun = "cloglog", level = 0.95, ...) \S3method{print}{summary.etmCIF}(x, ...) } \arguments{ \item{object}{An object of class \code{etmCIF}} \item{ci.fun}{Transformation applied to the pointwise confidence intervals. On of \code{"linear", "log", "log-log", "cloglog"}. Default is \code{"cloglog"}.} \item{level}{Level of the confidence intervals. Default is 0.95.} \item{x}{An object of class \code{cifETM}.} \item{\dots}{Further arguments} } \value{ A data.frame per covariate level and competing event \item{P}{Transition probability estimates} \item{var}{Variance estimates} \item{lower}{Lower confidence limit} \item{upper}{Upper confidence limit} \item{time}{Transition times} \item{n.risk}{Number of individuals at risk of experiencing a transition just before time \eqn{t}{t}} \item{n.event}{Number of events at time \eqn{t}{t}} } \author{ Arthur Allignol \email{arthur.allignol@gmail.com} } \seealso{ \code{\link{etmCIF}} } \keyword{method} \keyword{print} \keyword{survival} etm/man/xyplot.etm.Rd0000755000176200001440000000341713226505116014235 0ustar liggesusers\name{xyplot.etm} \alias{xyplot.etm} \title{xyplot method for object of class 'etm'} \description{ xyplot function for objects of class \code{etm}. Estimates of the transition probabilities are plotted as a function of time for all the transitions specified by the user. } \usage{ \S3method{xyplot}{etm}(x, data = NULL, tr.choice, col = c(1, 1, 1), lty = c(1, 3, 3), xlab = "Time", ylab = "Transition probability", conf.int = TRUE, ci.fun = "linear", level = 0.95, ...) } \arguments{ \item{x}{An object of class \code{etm}.} \item{data}{\emph{Useless}.} \item{tr.choice}{A character vector of the form c("from to", "from to", ...) specifying the transition probabilities to be plotted. By default, all the direct transition probabilities are displayed.} \item{col}{Vector of colours for the curves.} \item{lty}{Vector of line types.} \item{xlab}{x-axis label. Default is "Time".} \item{ylab}{y-axis label. Default is "Estimated transition probability".} \item{conf.int}{Logical. Whether to draw pointwise confidence intervals. Default is TRUE.} \item{ci.fun}{A character vector specifying the transformation to be applied to the pointwise confidence intervals. It could be different for each transition probability, though if \code{length(ci.fun) != length(tr.choice)}, only \code{ci.fun[1]} will be used. The possible transformations are "linear", "log", "log-log" and "cloglog". Default is "linear".} \item{level}{Level of the two-sided confidence intervals. Default is 0.95.} \item{\dots}{Further arguments for \code{xyplot}.} } \value{ An object of class \code{trellis}. } \author{Arthur Allignol, \email{arthur.allignol@gmail.com}} \seealso{\code{\link{etm}}, \code{\link[lattice]{xyplot}}} \keyword{hplot} etm/man/etm.Rd0000755000176200001440000002162613723773620012712 0ustar liggesusers\name{etm} \alias{etm} \alias{etm.data.frame} \title{Computation of the empirical transition matrix} \description{ This function computes the empirical transition matrix, also called Aalen-Johansen estimator, of the transition probability matrix of any multistate model. The covariance matrix is also computed. } \usage{ \S3method{etm}{data.frame}(data, state.names, tra, cens.name, s, t = "last", covariance = TRUE, delta.na = TRUE, modif = FALSE, c = 1, alpha = NULL, strata, ...) } \arguments{ \item{data}{data.frame of the form data.frame(id,from,to,time) or (id,from,to,entry,exit) \describe{ \item{id:}{patient id} \item{from:}{the state from where the transition occurs} \item{to:}{the state to which a transition occurs} \item{time:}{time when a transition occurs} \item{entry:}{entry time in a state} \item{exit:}{exit time from a state} } This data.frame is transition-oriented, \emph{i.e.} it contains one row per transition, and possibly several rows per patient. Specifying an entry and exit time permits to take into account left-truncation. } \item{state.names}{A vector of characters giving the states names.} \item{tra}{A quadratic matrix of logical values describing the possible transitions within the multistate model. } \item{cens.name}{ A character giving the code for censored observations in the column 'to' of \code{data}. If there is no censored observations in your data, put 'NULL'.} \item{s}{Starting value for computing the transition probabilities.} \item{t}{Ending value. Default is "last", meaning that the transition probabilities are computed over \eqn{(s, t]}{(s, t]}, \eqn{t}{t} being the last time in the data set.} \item{covariance}{Logical. Decide whether or not computing the covariance matrix. May be useful for, say, simulations, as the variance computation is a bit long. Default is TRUE.} \item{delta.na}{Logical. Whether to export the array containing the increments of the Nelson-Aalen estimator. Default is \code{TRUE}.} \item{modif}{Logical. Whether to apply the modification of Lai and Ying for small risk sets} \item{c}{Constant for the Lai and Ying modification. Either \code{c} contains only one value that will be used for all the states, otherwise \code{c} should be the same length as \code{state.names}.} \item{alpha}{Constant for the Lai and Ying modification. If NULL (the default) then only \code{c} is used and the Lai and Ying modification discards the event times for which \eqn{Y(t) \geq t}{Y(t) >= t}. Otherwise \eqn{cn^\alpha}{cn^alpha} is used. It is recommanded to let \code{alpha} equal NULL for multistate models.} \item{strata}{Character vector giving variables on which to stratify the analysis.} \item{...}{Not used} } \details{ Data are considered to arise from a time-inhomogeneous Markovian multistate model with finite state space, and possibly subject to independent right-censoring and left-truncation. The matrix of the transition probabilities is estimated by the Aalen-Johansen estimator / empirical transition matrix (Andersen et al., 1993), which is the product integral over the time period \eqn{(s, t]}{(s, t]} of I + the matrix of the increments of the Nelson-Aalen estimates of the cumulative transition hazards. The \eqn{(i, j)-th}{(i, j)-th} entry of the empirical transition matrix estimates the transition probability of being in state \eqn{j}{j} at time \eqn{t}{t} given that one has been in state j at time \eqn{s}{s}. The covariance matrix is computed using the recursion formula (4.4.19) in Anderson et al. (1993, p. 295). This estimator of the covariance matrix is an estimator of the Greenwood type. If the multistate model is not Markov, but censorship is entirely random, the Aalen-Johansen estimator still consistently estimates the state occupation probabilities of being in state \eqn{i}{i} at time \eqn{t}{t} (Datta & Satten, 2001; Glidden, 2002) Recent versions of R have changed the \code{data.frame} function, where the default for the \code{stringsAsFactors} argument from \code{TRUE} to \code{FALSE}. \code{etm} currently depends on the states being factors, so that the user should use \code{data.frame(..., stringsAsFactors=TRUE)}. } \value{ \item{est}{Transition probability estimates. This is a 3 dimension array with the first dimension being the state from where transitions occur, the second the state to which transitions occur, and the last one being the event times.} \item{cov}{Estimated covariance matrix. Each cell of the matrix gives the covariance between the transition probabilities given by the rownames and the colnames, respectively.} \item{time}{Event times at which the transition probabilities are computed. That is all the observed times between \eqn{(s, t]}{(s, t]}.} \item{s}{Start of the time interval.} \item{t}{End of the time interval.} \item{trans}{A \code{data.frame} giving the possible transitions.} \item{state.names}{A vector of character giving the state names.} \item{cens.name}{How the censored observation are coded in the data set.} \item{n.risk}{Matrix indicating the number of individuals at risk just before an event} \item{n.event}{Array containing the number of transitions at each times} \item{delta.na}{A 3d array containing the increments of the Nelson-Aalen estimator.} \item{ind.n.risk}{When \code{modif} is true, risk set size for which the indicator function is 1} If the analysis is stratified, a list of \code{etm} objects is returned. } \references{ Beyersmann J, Allignol A, Schumacher M: Competing Risks and Multistate Models with R (Use R!), Springer Verlag, 2012 (Use R!) Allignol, A., Schumacher, M. and Beyersmann, J. (2011). Empirical Transition Matrix of Multi-State Models: The etm Package. \emph{Journal of Statistical Software}, 38. Andersen, P.K., Borgan, O., Gill, R.D. and Keiding, N. (1993). \emph{Statistical models based on counting processes}. Springer Series in Statistics. New York, NY: Springer. Aalen, O. and Johansen, S. (1978). An empirical transition matrix for non-homogeneous Markov chains based on censored observations. \emph{Scandinavian Journal of Statistics}, 5: 141-150. Gill, R.D. and Johansen, S. (1990). A survey of product-integration with a view towards application in survival analysis. \emph{Annals of statistics}, 18(4): 1501-1555. Datta, S. and Satten G.A. (2001). Validity of the Aalen-Johansen estimators of stage occupation probabilities and Nelson-Aalen estimators of integrated transition hazards for non-Markov models. \emph{Statistics and Probability Letters}, 55(4): 403-411. Glidden, D. (2002). Robust inference for event probabilities with non-Markov data. \emph{Biometrics}, 58: 361-368. } \author{Arthur Allignol, \email{arthur.allignol@gmail.com}} \note{Transitions into a same state, mathematically superfluous, are not allowed. If transitions into the same state are detected in the data, the function will stop. Equally, \code{diag(tra)} must be set to FALSE, see the example below.} \seealso{\code{\link{print.etm}}, \code{\link{summary.etm}}, \code{\link{sir.cont}}, \code{\link{xyplot.etm}}} \examples{ data(sir.cont) # Modification for patients entering and leaving a state # at the same date # Change on ventilation status is considered # to happen before end of hospital stay sir.cont <- sir.cont[order(sir.cont$id, sir.cont$time), ] for (i in 2:nrow(sir.cont)) { if (sir.cont$id[i]==sir.cont$id[i-1]) { if (sir.cont$time[i]==sir.cont$time[i-1]) { sir.cont$time[i-1] <- sir.cont$time[i-1] - 0.5 } } } ### Computation of the transition probabilities # Possible transitions. tra <- matrix(ncol=3,nrow=3,FALSE) tra[1, 2:3] <- TRUE tra[2, c(1, 3)] <- TRUE # etm tr.prob <- etm(sir.cont, c("0", "1", "2"), tra, "cens", 1) tr.prob summary(tr.prob) # plotting if (require("lattice")) { xyplot(tr.prob, tr.choice=c("0 0", "1 1", "0 1", "0 2", "1 0", "1 2"), layout=c(2, 3), strip=strip.custom(bg="white", factor.levels= c("0 to 0", "1 to 1", "0 to 1", "0 to 2", "1 to 0", "1 to 2"))) } ### example with left-truncation data(abortion) # Data set modification in order to be used by etm names(abortion) <- c("id", "entry", "exit", "from", "to") abortion$to <- abortion$to + 1 ## computation of the matrix giving the possible transitions tra <- matrix(FALSE, nrow = 5, ncol = 5) tra[1:2, 3:5] <- TRUE ## etm fit <- etm(abortion, as.character(0:4), tra, NULL, s = 0) ## plot xyplot(fit, tr.choice = c("0 0", "1 1", "0 4", "1 4"), ci.fun = c("log-log", "log-log", "cloglog", "cloglog"), strip = strip.custom(factor.levels = c("P(T > t) -- control", "P(T > t) -- exposed", "CIF spontaneous abortion -- control", "CIF spontaneous abortion -- exposed"))) } \keyword{survival} etm/man/trprob_trcov.Rd0000755000176200001440000000411213226505116014630 0ustar liggesusers\name{trprob.etm} \Rdversion{1.1} \alias{trprob.etm} \alias{trprob} \alias{trcov} \alias{trcov.etm} \title{ Function to extract transition probabilities and (co)variance } \description{ The \code{trprob} method is used to extract transition probabilities, while \code{trcov} is used to obtain the (co)variance. } \usage{ \S3method{trprob}{etm}(x, tr.choice, timepoints, ...) \S3method{trcov}{etm}(x, tr.choice, timepoints, ...) } \arguments{ \item{x}{An object of class \code{etm}.} \item{tr.choice}{A character vector of the form "from to" describing for which transition one wishes to obtain the transition probabilities or covariance estimates. For \code{trprob}, \code{tr.choice} must be of length 1, while it can be of length 2 for \code{trcov}.} \item{timepoints}{Time points at which one want the estimates. When missing, estimates are obtained for all event times.} \item{\dots}{Further arguments.} } \value{ A vector containing the transition probabilities or covariance estimates either at the time specified in \code{timepoints} or at all transition times. } \author{ Arthur Allignol, \email{arthur.allignol@gmail.com} } \seealso{ \code{\link{etm}} } \examples{ data(sir.cont) # Modification for patients entering and leaving a state # at the same date # Change on ventilation status is considered # to happen before end of hospital stay sir.cont <- sir.cont[order(sir.cont$id, sir.cont$time), ] for (i in 2:nrow(sir.cont)) { if (sir.cont$id[i]==sir.cont$id[i-1]) { if (sir.cont$time[i]==sir.cont$time[i-1]) { sir.cont$time[i-1] <- sir.cont$time[i-1] - 0.5 } } } ### Computation of the transition probabilities # Possible transitions. tra <- matrix(ncol=3,nrow=3,FALSE) tra[1, 2:3] <- TRUE tra[2, c(1, 3)] <- TRUE # etm fit.etm <- etm(sir.cont, c("0", "1", "2"), tra, "cens", 0) ## extract P_01(0, t) and variance p01 <- trprob(fit.etm, "0 1") var.p01 <- trcov(fit.etm, "0 1") ## covariance between P_00 and P_01 cov.00.01 <- trcov(fit.etm, c("0 0", "0 1")) ## P_01 at some time points trprob(fit.etm, "0 1", c(0, 15, 50, 100)) } \keyword{methods}etm/man/tra.Rd0000755000176200001440000000302013226505116012666 0ustar liggesusers\name{tra} \alias{tra} \alias{tra_ill} \alias{tra_ill_comp} \alias{tra_comp} \alias{tra_surv} \title{ Matrix of possible transitions } \description{ Miscellaneous functions that compute the matrix of possible transitions used as argument in the \code{etm} function. } \usage{ tra_ill(state.names = c("0", "1", "2")) tra_ill_comp(nComp = 2, state.names = as.character(seq(0, nComp + 1, 1))) tra_comp(nComp = 2, state.names = as.character(seq(0, nComp))) tra_surv(state.names = c("0", "1")) } \arguments{ \item{state.names}{A vector of characters giving the states names} \item{nComp}{For the competing risks models, the number of competing events} } \details{ These functions compute the matrix of possible transitions that is used as argument in, e.g., the \code{etm} function. \code{tra_surv} is for the usual survival model, \code{tra_comp} for the competing risks model, \code{tra_ill} for the illness-death model and \code{tra_ill_comp} for the illness-death model with competing terminal events. By default, state names are from 0 to \dots } \value{ A quadratic matrix with \code{TRUE} if a transition is possible, \code{FALSE} otherwise. } \author{ Arthur Allignol \email{arthur.allignol@gmail.com} } \seealso{ \code{\link{etm}} } \examples{ tra_ill() ## competing risks model with 4 competing events non-default state names tra_comp(4, state.names = c("healthy", "Cardiac problems", "Cancer", "Rhenal failure", "Other")) } \keyword{survival} \keyword{miscellaneous} etm/man/print.clos.etm.Rd0000755000176200001440000000067413226505116014773 0ustar liggesusers\name{print.clos.etm} \alias{print.clos.etm} \title{ Print function for 'clos.etm' objects } \description{ Print method for object of class \code{clos.etm} } \usage{ \S3method{print}{clos.etm}(x, ...) } \arguments{ \item{x}{An object of class \code{clos.etm}} \item{\dots}{Further arguments} } \value{ No value returned } \author{ Arthur Allignol, \email{arthur.allignol@gmail.com} } \seealso{ \code{\link{clos}} } \keyword{print}etm/man/prepare.los.data.Rd0000755000176200001440000000221313226505116015245 0ustar liggesusers\name{prepare.los.data} \alias{prepare.los.data} \title{Prepare the data for clos} \description{Prepare data to be passed to clos() in package etm.} \usage{prepare.los.data(x) } \arguments{ \item{x}{data.frame of the form data.frame(id, j.01, j.02, j.03, j.12, j.13, cens): \describe{ \item{id:}{id (patient id, admision id)} \item{j.01:}{observed time for jump from 0 to 1} \item{j.02:}{observed time for jump from 0 to 2} \item{j.03:}{observed time for jump from 0 to 3} \item{j.12:}{observed time for jump from 1 to 2} \item{j.13:}{observed time for jump from 1 to 3} \item{cens:}{censoring time (either in initial or intermediate state)} } } } \value{ a data.frame of the form data.frame(id, from, to, time, oid): \item{id:}{ id (patient id, admision id)} \item{from:}{ the state from where a transition occurs} \item{to:}{ the state to which a transition occurs} \item{time:}{ time of the transition} \item{oid:}{ the observation id} } \author{ Matthias Wangler} \seealso{ \code{\link[etm]{clos}}} \examples{ data(los.data) my.observ <- prepare.los.data(x=los.data) } \keyword{datasets} \keyword{manip} etm/man/print.etmCIF.Rd0000755000176200001440000000070413226505116014350 0ustar liggesusers\name{print.etmCIF} \alias{print.etmCIF} \title{ Print function for \code{cifETM} objects } \description{ Print method for \code{cifETM} objects } \usage{ \S3method{print}{etmCIF}(x, ...) } \arguments{ \item{x}{An object of class \code{etmCIF}} \item{\dots}{Further arguments} } \value{ No value returned } \author{ Arthur Allignol \email{arthur.allignol@gmail.com} } \seealso{ \code{\link{etmCIF}} } \keyword{survival} \keyword{print} etm/man/etmprep.Rd0000755000176200001440000000707713723774574013616 0ustar liggesusers\name{etmprep} \Rdversion{1.1} \alias{etmprep} \title{ Data transformation function for using etm } \description{ The function transforms a data set in the wide format (i.e., one raw per subject) into the long format (i.e., one raw per transition, and possibly several raws per subjects) in a suitable way for using the \code{etm} function } \usage{ etmprep(time, status, data, tra, state.names, cens.name = NULL, start = NULL, id = NULL, keep) } \arguments{ \item{time}{A character vector giving the name of the columns containing the transition times or last follow-up times. The length of \code{time} have to be equal to the number of states, some elements may be NA. See Details.} \item{status}{A character vector giving the name of the columns indicating whether a state has been visited (0 if not, 1 otherwise).} \item{data}{A data frame in which to look for the columns specified in \code{time} and \code{status}.} \item{tra}{A quadratic matrix of logical values describing the possible transitions within the multistate model. The \eqn{(i, j)}{(i, j)}th element of \code{tra} is TRUE if a transition from state \eqn{i}{i} to state \eqn{j}{j} is possible, FALSE otherwise. The diagonal must be set to FALSE.} \item{state.names}{A vector of characters giving the states names. If missing, state names are set to be 0:(number of states).} \item{cens.name}{A character string specifying how censored observations will be indicated in the new data set. Default is NULL, i.e., no censored observation.} \item{start}{A list containing two elements, \code{state} and \code{time}, giving the starting states and times for all individuals. Default is NULL, in which case all individuals are considered to start in the initial state at time 0.} \item{id}{A character string specifying in which column of \code{data} the user ids are. Default is NULL, and the ids will be \code{1:n}.} \item{keep}{A character vector indicating the column names of the covariate one might want to keep in the new data.frame.} } \details{ This function only works for irreversible acyclic Markov processes. Therefore, the multistate model will have initial states, into which no transition are possible. For these, NAs are allowed in \code{time} and \code{status}. } \value{ The function returns a data.frame suitable for using the \code{etm} function. The data frame contains the following components: \item{id}{Individual id number} \item{entry}{Entry time into a state} \item{exit}{Exit time from a state} \item{from}{State from which a transition occurs} \item{to}{State into which a transition occurs} \item{\dots}{Further columns specified in \code{keep}} } \author{ Arthur Allignol, \email{arthur.allignol@gmail.com} } \seealso{ \code{\link{etm}} } \examples{ ### creation of fake data in the wild format, following an illness-death model ## transition times tdisease <- c(3, 4, 3, 6, 8, 9) tdeath <- c(6, 9, 8, 6, 8, 9) ## transition status stat.disease <- c(1, 1, 1, 0, 0, 0) stat.death <- c(1, 1, 1, 1, 1, 0) ## a covariate that we want to keep in the new data cova <- rbinom(6, 1, 0.5) dat <- data.frame(tdisease, tdeath, stat.disease, stat.death, cova, stringsAsFactors = TRUE) ## Possible transitions tra <- matrix(FALSE, 3, 3) tra[1, 2:3] <- TRUE tra[2, 3] <- TRUE ## data preparation newdat <- etmprep(c(NA, "tdisease", "tdeath"), c(NA, "stat.disease", "stat.death"), data = dat, tra = tra, cens.name = "cens") } \keyword{datagen} \keyword{manip} etm/man/sir.cont.Rd0000755000176200001440000000301713226505116013645 0ustar liggesusers\name{sir.cont} \docType{data} \alias{sir.cont} \title{Ventilation status in intensive care unit patients} \description{ Time-dependent ventilation status for intensive care unit (ICU) patients, a random sample from the SIR-3 study. } \usage{ data(sir.cont) } \format{ A data frame with 1141 rows and 6 columns: \describe{ \item{id:}{Randomly generated patient id} \item{from:}{State from which a transition occurs} \item{to:}{State to which a transition occurs} \item{time:}{Time when a transition occurs} \item{age:}{Age at inclusion} \item{sex:}{Sex. \code{F} for female and \code{M} for male} } The possible states are: 0: No ventilation 1: Ventilation 2: End of stay And \code{cens} stands for censored observations. } \details{ This data frame consists in a random sample of the SIR-3 cohort data. It focuses on the effect of ventilation on the length of stay (combined endpoint discharge/death). Ventilation status is considered as a transcient state in an illness-death model. The data frame is directly formated to be used with the \code{etm} function, i.e. it is transition-oriented with one row per transition. } \references{ Beyersmann, J., Gastmeier, P., Grundmann, H., Baerwolff, S., Geffers, C., Behnke, M., Rueden, H., and Schumacher, M. Use of multistate models to assess prolongation of intensive care unit stay due to nosocomial infection. \emph{Infection Control and Hospital Epidemiology}, 27:493-499, 2006. } \examples{ data(sir.cont) } \keyword{datasets}etm/man/plot.etmCIF.Rd0000755000176200001440000000653413226505116014201 0ustar liggesusers\name{plot.etmCIF} \alias{plot.etmCIF} \title{ Plot cumulative incidence functions } \description{ Plot function for \code{etmCIF} objects. The function plots cumulative incidence curves, possibly with pointwise confidence intervals. } \usage{ \S3method{plot}{etmCIF}(x, which.cif, xlim, ylim, ylab = "Cumulative Incidence", xlab = "Time", col = 1, lty, lwd = 1, ci.type = c("none", "bars", "pointwise"), ci.fun = "cloglog", ci.col = col, ci.lty = 3, legend = TRUE, legend.pos, curvlab, legend.bty = "n", pos.ci = 27, ci.lwd = 3, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{A \code{etmCIF} object} \item{which.cif}{A numeric vector indicating which CIFs should be plotted. When missing, only the CIF of interest is plotted (determined through the \code{failcode} argument in \code{\link{etmCIF}}.)} \item{xlim}{x-axis limits for the plot. By default, \code{c(0, max(time))}} \item{ylim}{y-axis limits. Default is \code{c(0, 1)}} \item{ylab}{Label for y-axis. Default is \code{"Cumulative Incidence"}} \item{xlab}{Label for x-axis. Default is "Time"} \item{col}{Vector describing colours used for the CIF curves. Default is black} \item{lty}{Vector of line type} \item{lwd}{Thickness of the lines} \item{ci.type}{One of \code{c("none", "bars", "pointwise")}. \code{none} plots no confidence interval, \code{bars} plots the confidence intervals in the form of a segment for one time point, and \code{pointwise} draws pointwise confidence intervals for the whole follow-up period.} \item{ci.fun}{Transformation used for the confidence intervals. Default is "clolog", and is a better choice for cumulative incidences. Other choices are "log" and "log-log"} \item{ci.col}{Colour for the pointwise confidence interval curves. Default is same as the CIF curves} \item{ci.lty}{Line type for the confidence intervals. Default is 3} \item{legend}{Logical. Whether to draw a legend. Default is \code{TRUE}} \item{legend.pos}{A vector giving the legend's position. See \code{\link{legend}} for further details} \item{curvlab}{A character or expression vector to appear in the legend. Default is CIF + event label} \item{legend.bty}{Box type for the legend. Default is none ("n")} \item{pos.ci}{If \code{ci.type = "bars"}, vector of integers indicating at which time point to put the confidence interval bars. Default is 27} \item{ci.lwd}{Thickness of the confidence interval segment (for \code{ci.type = "bars"})} \item{\dots}{Further graphical arguments} } \details{ The function relies on \code{plot.etm} and \code{lines.etm} with more or less the same options. Exception is the drawing of the confidence intervals, for which several displays are possible. } \value{ No value returned } \author{ Arthur Allignol \email{arthur.allignol@gmail.com} } \seealso{ \code{\link{etmCIF}}, \code{\link{plot.etm}}, \code{\link{lines.etm}} } \examples{ data(abortion) cif.ab <- etmCIF(survival::Surv(entry, exit, cause != 0) ~ group, abortion, etype = cause, failcode = 3) cif.ab plot(cif.ab, ci.type = "bars", pos.ci = 24, col = c(1, 2), lty = 1, curvlab = c("Control", "Exposed")) plot(cif.ab, which = c(1, 2)) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{hplot} \keyword{survival} etm/man/plot.clos.etm.Rd0000755000176200001440000000357013226505116014613 0ustar liggesusers\name{plot.clos.etm} \Rdversion{1.1} \alias{plot.clos.etm} \title{ Plot method for 'clos.etm' objects } \description{ Plot method for objects of class \code{clos.etm}. } \usage{ \S3method{plot}{clos.etm}(x, xlab = "Time", ylab.e = "Expected LOS", ylab.w = "Weights", xlim, ylim.e, ylim.w, col.e = c(1, 2), col.w = 1, lty.e = c(1, 1), lty.w = 1, legend = TRUE, legend.pos, curvlab, legend.bty = "n", ...) } \arguments{ \item{x}{An object of class \code{clos.etm}} \item{xlab}{Label for the x-axis} \item{ylab.e}{Label for the y-axis in the plot of the expected LOS} \item{ylab.w}{Label for the y-axis in the plot of the weights} \item{xlim}{Limits of x-axis for the plots} \item{ylim.e}{Limits of the y-axis for the expected LOS plot} \item{ylim.w}{Limits of the y-axis for the weights plot} \item{col.e}{Vector of colours for the plot of expected LOS} \item{col.w}{Vector of colours for the plot of the weights} \item{lty.e}{Vector of line type for the plot of expected LOS} \item{lty.w}{Vector of line type for the plot of the weights} \item{legend}{Logical. Whether to draw a legend for the plot of expected LOS} \item{legend.pos}{A vector giving the legend's position. See \code{\link{legend}} for details} \item{curvlab}{Character or expression vector to appear in the legend. Default is \code{c("Intermediate event by time t", "No intermediate event by time t")}} \item{legend.bty}{Box type for the legend} \item{\dots}{Further arguments for plot} } \details{ Two graphs are drawn. The lower graph displays the expected LOS for patients who have experienced the intermediate event and for those who have not. The upper graph displays the weights used to compute the weighted average. } \value{ No value returned } \author{ Arthur Allignol \email{arthur.allignol@gmail.com}, Matthias Wangler } \seealso{ \code{\link{clos}} } \keyword{hplot}etm/man/etmCIF.Rd0000755000176200001440000000456113226505116013222 0ustar liggesusers\name{etmCIF} \alias{etmCIF} \title{ Cumulative incidence functions of competing risks } \description{ \code{etmCIF} is a wrapper around the \code{etm} function for facilitating the computation of the cumulative incidence functions in the competing risks framework. } \usage{ etmCIF(formula, data, etype, subset, na.action, failcode = 1) } \arguments{ \item{formula}{A \code{formula} object, that must have a \code{Surv} object on the left of ~ operator, and a discrete covariate (or 1) on the right. The status indicator should be 1 (or TRUE) for an event (whatever the type of this event, 0 (or FALSE) for censored observations.)} \item{data}{A data.frame in which to interpret the terms of the formula} \item{etype}{Competing risks event indicator. When the status indicator is 1 (or TRUE) in the formula, \code{etype} describes the type of event, otherwise, for censored observation, the value of \code{etype} is ignored} \item{subset}{Expression saying that only a subset of the data should be used.} \item{na.action}{Missing-data filter function. Default is \code{options()$na.action}.} \item{failcode}{Indicates the failure type of interest. Default is one. This option is only relevant for some options of the \code{plot} function.} } \details{ This function computes the cumulative incidence functions in a competing risks setting using the \code{etm} machinery, without having to specify the matrix of possible transitions and using the more usual formula specification with \code{Surv} } \value{ Returns a list of \code{etm} objects (1 per covariate level) plus additional informations: \item{failcode}{As in function call} \item{call}{Function call} \item{X}{A matrix giving the name of the covariate (if present) and the levels of this covariate.} } \author{ Arthur Allignol \email{arthur.alignol@gmail.com} } \seealso{ \code{\link{etm}}, \code{\link{print.etmCIF}}, \code{\link{summary.etmCIF}}, \code{\link{plot.etmCIF}} } \examples{ data(abortion) cif.ab <- etmCIF(survival::Surv(entry, exit, cause != 0) ~ group, abortion, etype = cause, failcode = 3) cif.ab plot(cif.ab, ci.type = "bars", pos.ci = 24, col = c(1, 2), lty = 1, curvlab = c("Control", "Exposed")) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{survival}etm/man/abortion.Rd0000755000176200001440000000237213226505116013726 0ustar liggesusers\name{abortion} \alias{abortion} \docType{data} \title{Pregnancies exposed to coumarin derivatives} \description{ Outcomes of pregnancies exposed to coumarin derivatives. The aim is to investigate whether exposition to coumarin derivatives increases the probability of spontaneous abortions. Apart from spontaneous abortion, pregnancy may end in induced abortion or live birth, leading to a competing risks situation. Moreover, data are left-truncated as women usually enter the study several weeks after conception. } \usage{data(abortion)} \format{ A data frame with 1186 observations on the following 5 variables. \describe{ \item{\code{id}}{Identification number} \item{\code{entry}}{Entry times into the cohort} \item{\code{exit}}{Event times} \item{\code{group}}{Group. 0: control, 1: exposed to coumarin derivatives} \item{\code{cause}}{Cause of failure. 1: induced abortion, 2: life birth, 3: spontaneous abortion} } } \source{ Meiester, R. and Schaefer, C (2008). Statistical methods for estimating the probability of spontaneous abortion in observational studies -- Analyzing pregnancies exposed to coumarin derivatives. Reproductive Toxicology, 26, 31--35 } \examples{ data(abortion) } \keyword{datasets} etm/man/los.data.Rd0000755000176200001440000000144013226505116013611 0ustar liggesusers\name{los.data} \docType{data} \alias{los.data} \title{Length of hospital stay} \description{ The \code{los.data} data frame has 756 rows, one row for each patient, and 7 columns. } \usage{data(los.data)} \format{A data frame with the following columns: \describe{ \item{adm.id}{ admision id of the patient} \item{j.01}{ observed time for jump from 0 (initial state) to 1 (intermediate state)} \item{j.02}{ observed time for jump from 0 to 2 (discharge)} \item{j.03}{ observed time for jump from 0 to 3 (death)} \item{j.12}{ observed time for jump from 1 to 2} \item{j.13}{ observed time for jump from 1 to 3} \item{cens}{ censoring time (either in initial or intermediate state) } } } \examples{ data(los.data) my.data <- prepare.los.data(los.data) } \keyword{datasets} etm/man/plot.etm.Rd0000755000176200001440000000621313233706725013660 0ustar liggesusers\name{plot.etm} \alias{plot.etm} \title{Plot method for an etm object} \description{ Plot method for an object of class 'etm'. It draws the estimated transition probabilities in a basic scatterplot. } \usage{ \S3method{plot}{etm}(x, tr.choice, xlab = "Time", ylab = "Transition Probability", col = 1, lty, xlim, ylim, conf.int = FALSE, level = 0.95, ci.fun = "linear", ci.col = col, ci.lty = 3, legend = TRUE, legend.pos, curvlab, legend.bty = "n", ...) } \arguments{ \item{x}{An object of class 'etm'} \item{tr.choice}{ character vector of the form 'c("from to","from to")' specifying which transitions should be plotted. Default, all the transition probabilities are plotted} \item{xlab}{x-axis label. Default is "Time"} \item{ylab}{y-axis label. Default is "Transition Probability"} \item{col}{Vector of colour. Default is black} \item{lty}{Vector of line type. Default is 1:number of transitions} \item{xlim}{Limits of x-axis for the plot} \item{ylim}{Limits of y-axis for the plot} \item{conf.int}{Logical. Whether to display pointwise confidence intervals. Default is FALSE.} \item{level}{Level of the conficence intervals. Default is 0.95.} \item{ci.fun}{Transformation applied to the confidence intervals. It could be different for all transition probabilities, though if \code{length(ci.fun) != number of transitions}, only \code{ci.fun[1]} will be used. Possible choices are "linear", "log", "log-log" and "cloglog". Default is "linear".} \item{ci.col}{Colour of the confidence intervals. Default is \code{col}.} \item{ci.lty}{Line type of the confidence intervals. Default is 3.} \item{legend}{A logical specifying if a legend should be added} \item{legend.pos}{A vector giving the legend's position. See \code{\link{legend}} for further details} \item{curvlab}{A character or expression vector to appear in the legend. Default is the name of the transitions} \item{legend.bty}{Box type for the legend} \item{\dots}{Further arguments for plot} } \details{ By default, if the argument \code{strata} was used for creating the \code{etm} object, the first transition probability for all strata will be plotted. If there is no strata, all transition probabilities are plotted by default. In any case, a legend with be created by the labels are likely to be ugly. Please use the \code{curvlab} argument to control the test or use \code{legend = FALSE} and build your own legend. } \value{ No value returned } \author{Arthur Allignol, \email{arthur.allignol@gmail.com}} \seealso{\code{\link{plot.default}}, \code{\link{legend}}, \code{\link{etm}} } \examples{ data(sir.cont) # Modification for patients entering and leaving a state # at the same date sir.cont <- sir.cont[order(sir.cont$id, sir.cont$time), ] for (i in 2:nrow(sir.cont)) { if (sir.cont$id[i]==sir.cont$id[i-1]) { if (sir.cont$time[i]==sir.cont$time[i-1]) { sir.cont$time[i-1] <- sir.cont$time[i-1] - 0.5 } } } tra <- matrix(ncol=3,nrow=3,FALSE) tra[1, 2:3] <- TRUE tra[2, c(1, 3)] <- TRUE my.etm <- etm(sir.cont,c("0","1","2"),tra,"cens", s = 0) plot(my.etm, tr.choice = c("0 0")) } \keyword{hplot} etm/man/lines.etm.Rd0000755000176200001440000000306113226505116014003 0ustar liggesusers\name{lines.etm} \alias{lines.etm} \title{ Lines method for 'etm' objects } \description{ Lines method for \code{etm} objects } \usage{ \S3method{lines}{etm}(x, tr.choice, col = 1, lty, conf.int = FALSE, level = 0.95, ci.fun = "linear", ci.col = col, ci.lty = 3, ...) } \arguments{ \item{x}{An object of class \code{etm}.} \item{tr.choice}{character vector of the form \code{c("from to","from to")} specifying which transitions should be plotted. By default, all the direct transition probabilities are plotted} \item{col}{Vector of colours. Default is black.} \item{lty}{Vector of line type. Default is 1:number of transitions} \item{conf.int}{Logical specifying whether to plot confidence intervals. Default is FALSE.} \item{level}{Level of the confidence interval. Default is 0.95.} \item{ci.fun}{Transformation applied to the confidence intervals. It could be different for all transition probabilities, though if \code{length(ci.fun) != number of transitions}, only \code{ci.fun[1]} will be used. Possible choices are "linear", "log", "log-log" and "cloglog". Default is "linear".} \item{ci.col}{Colours of the confidence intervals. Default value is the same as \code{col}.} \item{ci.lty}{Line types for the confidence intervals. Default is 3.} \item{\dots}{Further arguments for \code{lines}.} } \value{ No value returned. } \author{ Arthur Allignol, \email{arthur.allignol@gmail.com} } \seealso{ \code{\link{etm}}, \code{\link{plot.etm}}, \code{\link{xyplot.etm}} } \keyword{hplot} \keyword{survival} etm/man/clos.Rd0000755000176200001440000001344013226505116013047 0ustar liggesusers\name{clos} \alias{clos} \alias{clos.etm} \alias{clos.msfit} \title{Change in Length of Stay} \description{ The function estimates the expected change in length of stay (LOS) associated with an intermediate event. } \usage{ clos(x, aw, ratio, ...) \S3method{clos}{etm}(x, aw = FALSE, ratio = FALSE, ...) \S3method{clos}{msfit}(x, aw = FALSE, ratio = FALSE, cox_model, ...) } \arguments{ \item{x}{An object of class \code{etm}. Argument \code{delta.na} in \code{\link{etm}} must be set to \code{TRUE} in order to use this function.} \item{aw}{Logical. Whether to compute the expected change of LOS using alternative weighting. Default is \code{FALSE}.} \item{ratio}{Logical. Compute the ratio of the expected length-of-stay given instermediate event status instead of a difference. Default value is \code{FALSE}} \item{cox_model}{TODO} \item{...}{Further arguments} } \details{ The approach for evaluating the impact of an intermediate event on the expected change in length of stay is based on Schulgen and Schumacher (1996). They suggested to consider the difference of the expected subsequent stay given infectious status at time s. Extensions to the methods of Schulgen and Schumacher and the earlier implementation in the \pkg{changeLOS} include the possibility to compute the extra length of stay both for competing endpoints and the more simple case of one absorbing state, as well as the possibility to compute this quantity for left-truncated data. } \value{ An object of class \code{clos.etm} with the following components: \item{e.phi}{Change in length of stay} \item{phi.case}{Estimates of \eqn{E(\mbox{LOS} | X_s = \mbox{intermediate event})}{E(LOS | X_s = intermediate event)} for all observed transition times \eqn{s}{s}, where \eqn{X_s}{X_s}denotes the state by time \eqn{s}{s}} \item{phi.control}{Estimates of \eqn{E(\mbox{LOS} | X_s = \mbox{initial state})}{E(LOS|X_s = initial state)} for all observed transition times \eqn{s}{s}.} \item{e.phi2}{Weighted average of the difference between \code{phi2.case} and \code{phi2.control}.} \item{phi2.case}{Estimates of \eqn{E(\mbox{LOS} \mathbf{1}(X_{\mbox{LOS}} = \mbox{discharge}) | X_s = \mbox{intermediate event})}{E(LOS \strong{1}(X_LOS = discharge)|X_s = intermediate event)}, where \eqn{\mathbf{1}}{\strong{1}} denotes the indicator function.} \item{phi2.control}{\eqn{E(\mbox{LOS} \mathbf{1}(X_{\mbox{LOS}} = \mbox{discharge}) | X_s = \mbox{initial state})}{E(LOS \strong{1}(X_LOS = discharge)|X_s = initial state)}.} \item{e.phi3}{Weighted average of the difference between \code{phi3.case} and \code{phi3.control}.} \item{phi3.case}{Estimates of \eqn{E(\mbox{LOS} \mathbf{1}(X_{\mbox{LOS}} = \mbox{death}) | X_s = \mbox{intermediate event})}{E(LOS \strong{1}(X_LOS = death)|X_s = intermediate event)}.} \item{phi3.control}{\eqn{E(\mbox{LOS} \mathbf{1}(X_{\mbox{LOS}} = \mbox{death}) | X_s = \mbox{initial state})}{E(LOS \strong{1}(X_LOS = death)|X_s = initial state)}.} \item{weights}{Weights used to compute the weighted averages.} \item{w.time}{Times at which the weights are computed.} \item{time}{All transition times.} \item{e.phi.weights.1}{Expected change in LOS using \code{weights.1}} \item{e.phi.weights.other}{Expected change in LOS using \code{weights.other}} \item{weights.1}{Weights corresponding to the conditional waiting time in the intial state given one experiences the intermediate event.} \item{weights.other}{Weights corresponding to the conditional waiting time given one does not experience the intermediate event.} } \references{ G Schulgen and M Schumacher (1996). Estimation of prolongation of hospital stay attributable to nosocomial infections. \emph{Lifetime Data Analysis} 2, 219-240. J Beyersmann, P Gastmeier, H Grundmann, S Baerwolf, C Geffers, M Behnke, H Rueden, and M Schumacher (2006). Use of Multistate Models to Assess Prolongation of Intensive Care Unit Stay Due to Nosocomial Infection. \emph{Infection Control and Hospital Epidemiology} 27, 493-499. Allignol A, Schumacher M, Beyersmann J: Estimating summary functionals in multistate models with an application to hospital infection data. \emph{Computation Stat}, 2011; 26: 181-197. M Wrangler, J Beyersmann and M Schumacher (2006). changeLOS: An R-package for change in length of hospital stay based on the Aalen-Johansen estimator. \emph{R News} 6(2), 31--35. } \author{Arthur Allignol \email{arthur.allignol@gmail.com}, Matthias Wangler, Jan Beyersmann} \seealso{\code{\link{etm}}} \examples{ data(los.data) ## putting los.data in the long format my.observ <- prepare.los.data(x=los.data) tra <- matrix(FALSE, 4, 4) tra[1, 2:4] <- TRUE tra[2, 3:4] <- TRUE tr.prob <- etm(my.observ, c("0","1","2","3"), tra, NULL, 0) cLOS <- etm::clos(tr.prob) plot(cLOS) ### Compute bootstrapped SE ## function that performs the bootstrap ## nboot: number of bootstrap samples. Other arguments are as in etm() boot.clos <- function(data, state.names, tra, cens.name, s = 0, nboot) { res <- double(nboot) for (i in seq_len(nboot)) { index <- sample(unique(data$id), replace = TRUE) inds <- new.id <- NULL for (j in seq_along(index)){ ind <- which(data$id == index[j]) new.id <- c(new.id, rep(j, length(ind))) inds <- c(inds, ind) } dboot <- cbind(data[inds, ], new.id) dboot[, which(names(dboot) == "id")] dboot$id <- dboot$new.id tr.prob <- etm(dboot, state.names, tra, cens.name, s, cova = FALSE) res[i] <- etm::clos(tr.prob)$e.phi } res } ## bootstrap se <- sqrt(var(boot.clos(my.observ, c("0","1","2","3"), tra, NULL, 0, nboot = 10))) } \keyword{survival} etm/man/print.etm.Rd0000755000176200001440000000154413226505116014031 0ustar liggesusers\name{print.etm} \alias{print.etm} \title{Print method for object of class 'etm'} \description{ Print method for objects of class \code{etm}. } \usage{ \S3method{print}{etm}(x, covariance = FALSE, whole = TRUE, ...) } \arguments{ \item{x}{An object of class \code{etm}.} \item{covariance}{Whether print the covariance matrix. Default is TRUE} \item{whole}{Whether to plot the entire covariance matrix. If set to FALSE, rows and columns containing only 0 will be removed for printing.} \item{\dots}{Further arguments for print or summary.} } \details{ The function prints a matrix giving the possible transitions, along with the estimates of \eqn{P(s, t)}{P(s, t)} and \eqn{cov(P(s, t))}{cov(P(s, t))}. } \value{ No value returned } \author{Arthur Allignol, \email{arthur.allignol@gmail.com}} \seealso{\code{\link{etm}}} \keyword{print} etm/man/closPseudo.Rd0000755000176200001440000001134113725360636014237 0ustar liggesusers\name{closPseudo} \alias{closPseudo} \title{ Pseudo Value Regression for the Extra Length-of-Stay } \description{ Pseudo Value Regression for the Extra Length-of-Stay } \usage{ closPseudo(data, state.names, tra, cens.name, s = 0, formula, na.action, aw = FALSE, ratio = FALSE, ncores = 1, trick_ties = FALSE) } \arguments{ \item{data}{ data.frame of the form data.frame(id,from,to,time) or (id,from,to,entry,exit) \describe{ \item{id:}{patient id} \item{from:}{the state from where the transition occurs} \item{to:}{the state to which a transition occurs} \item{time:}{time when a transition occurs} \item{entry:}{entry time in a state} \item{exit:}{exit time from a state} } } \item{state.names}{A vector of characters giving the states names.} \item{tra}{A quadratic matrix of logical values describing the possible transitions within the multistate model.} \item{cens.name}{ A character giving the code for censored observations in the column 'to' of \code{data}. If there is no censored observations in your data, put 'NULL'.} \item{s}{Starting value for computing the transition probabilities.} \item{formula}{A formula with the covariates at the right of a \code{~} operator. Leave the left part empty.} \item{na.action}{A function which indicates what should happen when the data contain 'NA's. The default is set by the 'na.action' setting of 'options', and is 'na.fail' if that is unset. The 'factory-fresh' default is 'na.omit'.} \item{aw}{Logical. Whether to compute the expected change of LOS using alternative weighting. Default is \code{FALSE}.} \item{ratio}{Logical. Compute the ratio of the expected length-of-stay given instermediate event status instead of a difference. Default value is \code{FALSE}} \item{ncores}{Number of cores used if doing parallel computation using the \pkg{parallel} package} \item{trick_ties}{If \code{TRUE}, pseudo values are computed only one per subject sharing the same entry, exit times / transition types.} } \details{ The function calculates the pseudo-observations for the extra length-of-stay for each individual. These pseudo-observations can then be used to fit a direct regression model using generalized estimating equation (e.g., package \pkg{geepack}). Computation of the pseudo-observations can be parallelised using the \code{mclapply} function of the \pkg{parallel} package. See argument \code{ncores}. Recent versions of R have changed the \code{data.frame} function, where the default for the \code{stringsAsFactors} argument from \code{TRUE} to \code{FALSE}. \code{etm} currently depends on the states being factors, so that the user should use \code{data.frame(..., stringsAsFactors=TRUE)}. } \value{ An object of class \code{closPseudo} with the following components: \item{pseudoData}{a data.frame containing \code{id}, computed pseudo values (see details) and the covariates as specified in the formula} \item{theta}{Estimates of excess LoS in the whole sample} \item{aw}{like in the function call} \item{call}{Function call} } \references{ Andersen, P.K, Klein, J.P, Rosthoj, S. (2003). Generalised linear models for correlated pseudo-observations, with applications to multi-state models. \emph{Biometrika}, 90(1):15--27. } \author{ Arthur Allignol \email{arthur.allignol@gmail.com} } \seealso{ \code{\link{mclapply}}, \code{\link[etm]{clos}} } \examples{ if(require("kmi", quietly = TRUE)) { ## data in kmi package data(icu.pneu) my.icu.pneu <- icu.pneu my.icu.pneu <- my.icu.pneu[order(my.icu.pneu$id, my.icu.pneu$start), ] masque <- diff(my.icu.pneu$id) my.icu.pneu$from <- 0 my.icu.pneu$from[c(1, masque) == 0] <- 1 my.icu.pneu$to2 <- my.icu.pneu$event my.icu.pneu$to2[my.icu.pneu$status == 0] <- "cens" my.icu.pneu$to2[c(masque, 1) == 0] <- 1 my.icu.pneu$to <- ifelse(my.icu.pneu$to2 \%in\% c(2, 3), 2, my.icu.pneu$to2) my.icu.pneu <- my.icu.pneu[, c("id", "start", "stop", "from", "to", "to2", "age", "sex")] names(my.icu.pneu)[c(2, 3)] <- c("entry", "exit") ## computation of the pseudo-observations \dontrun{ ps.icu.pneu <- closPseudo(my.icu.pneu, c("0", "1", "2"), tra_ill(), "cens", formula = ~ sex + age) ## regression model using geepack require(geepack) fit <- geeglm(ps.e.phi ~ sex + age, id = id, data = ps.icu.pneu$pseudoData, family = gaussian) summary(fit) } } else { print("This example requires the kmi package") } } \keyword{survival} etm/man/summary.etm.Rd0000755000176200001440000000407613226505116014375 0ustar liggesusers\name{summary.etm} \alias{summary.etm} \alias{print.summary.etm} \title{Summary methods for an 'etm' object} \description{ Summary method for objects of class \code{etm} } \usage{ \S3method{summary}{etm}(object, tr.choice, ci.fun = "linear", level = 0.95, times, ...) \S3method{print}{summary.etm}(x, ...) } \arguments{ \item{object}{An object of class \code{etm}.} \item{tr.choice}{Character vector of the form 'c("from to","from to")' specifying which transitions should be summarized. Default to all the transition probabilities} \item{ci.fun}{A character vector specifying the transformation to be applied to the pointwise confidence intervals. It could be different for each transition probability, though if \code{length(ci.fun) != number of transitions}, only \code{ci.fun[1]} will be used. The function displays the transition probabilities in the following order: first the direct transitions in alphabetical order, e.g., 0 to 1, 0 to 2, 1 to 2, ..., then the state occupation probabilities in alphabetical order, e.g., 0 to 0, 1 to 1, ... The possible transformations are "linear", "log", "log-log" and "cloglog". Default is "linear".} \item{level}{Level of the two-sided confidence intervals. Default is 0.95.} \item{x}{A \code{summary.cpf} object} \item{times}{Time points for which estimates should be returned. Default to all transition times.} \item{\dots}{Further arguments} } \value{ A list of data.frames giving the transition probability and stage occupation probability estimates. List items are named after the possible transition. \item{P}{Transition probability estimates} \item{var}{Variance estimates} \item{lower}{Lower confidence limit} \item{upper}{Upper confidence limit} \item{time}{Transition times} \item{n.risk}{Number of individuals at risk of experiencing a transition just before time \eqn{t}{t}} \item{n.event}{Number of events at time \eqn{t}{t}} } \author{Arthur Allignol \email{arthur.allignol@gmail.com}} \seealso{\code{\link{etm}}} \keyword{methods} \keyword{print} etm/man/fourD.Rd0000755000176200001440000000310413226505116013162 0ustar liggesusers\name{fourD} \alias{fourD} \docType{data} \title{ Placebo data from the 4D study } \description{ Data from the placebo group of the 4D study. This study aimed at comparing atorvastatin to placebo for patients with type 2 diabetes and receiving hemodialysis in terms of cariovascular events. The primary endpoint was a composite of death from cardiac causes, stroke and non-fatal myocardial infarction. Competing event was death from other causes. } \usage{data(fourD)} \format{ A data frame with 636 observations on the following 7 variables. \describe{ \item{\code{id}}{Patients' id number} \item{\code{sex}}{Patients' gender} \item{\code{age}}{Patients' age} \item{\code{medication}}{Character vector indicating treatment affiliation. Here only equal to \code{"Placebo"}} \item{\code{status}}{Status at the end of the follow-up. 1 for the event of interest, 2 for death from other causes and 0 for censored observations} \item{\code{time}}{Survival time} \item{\code{treated}}{Numeric vector indicated whether patients are treated or not. Here always equal to zero} } } \source{ Wanner, C., Krane, V., Maerz, W., Olschewski, M., Mann, J., Ruf, G., Ritz, E (2005). Atorvastatin in patients with type 2 diabetes mellitus undergoing hemodialysis. New England Journal of Medicine, 353(3), 238--248. } \references{ Allignol, A., Schumacher, M., Wanner, C., Dreschler, C. and Beyersmann, J. (2010). Understanding competing risks: a simulation point of view. Research report. } \examples{ data(fourD) } \keyword{datasets} etm/DESCRIPTION0000755000176200001440000000217313725704663012570 0ustar liggesusersPackage: etm Type: Package Title: Empirical Transition Matrix Version: 1.1.1 Authors@R: c(person("Mark", "Clements", role = c("aut", "cre"), email = "mark.clements@ki.se"), person("Arthur", "Allignol", role="aut")) Description: The etm (empirical transition matrix) package permits to estimate the matrix of transition probabilities for any time-inhomogeneous multi-state model with finite state space using the Aalen-Johansen estimator. Functions for data preparation and for displaying are also included (Allignol et al., 2011 ). Functionals of the Aalen-Johansen estimator, e.g., excess length-of-stay in an intermediate state, can also be computed (Allignol et al. 2011 ). Maintainer: Mark Clements License: MIT + file LICENSE Depends: R (>= 3.0.0) Imports: survival, lattice, data.table, Rcpp (>= 0.11.4) Suggests: ggplot2, kmi, geepack LinkingTo: Rcpp, RcppArmadillo NeedsCompilation: yes Packaged: 2020-09-08 06:24:32 UTC; marcle Repository: CRAN Date/Publication: 2020-09-08 13:40:03 UTC Author: Mark Clements [aut, cre], Arthur Allignol [aut] etm/tests/0000755000176200001440000000000013725356675012224 5ustar liggesusersetm/tests/tests.etm.R0000644000176200001440000002050613725355601014264 0ustar liggesusersrequire(etm) ## Print with a bit less precision to avoid lots of notes in the comparison old <- options(digits = 4) ### Simple test time <- id <- 1:10 from <- rep(0, 10) to <- rep(1, 10) data1 <- data.frame(id, from, to, time) tra1 <- matrix(FALSE, 2, 2) tra1[1, 2] <- TRUE etm1 <- etm(data1, c("0", "1"), tra1, NULL, 0) all.equal(as.vector(trprob(etm1, "0 0")), cumprod((10:1 - 1) / (10:1))) etm1$cov["0 0", "0 0", ] all.equal(etm1$cov["0 0", "0 0",], trcov(etm1, "0 0")) ### A simple test from AHR's author, where the first time is censored if (!require(survival)) { stop("This test requires the survival package") } data <- data.frame(id=1:10, time=1:10, from=0, to=1, status=TRUE) tra <- matrix(FALSE, nrow=2, ncol=2) tra[1, 2] <- TRUE data$to[1] <- "cens" data$status[1] <- FALSE fit.km <- survfit(Surv(time, status) ~ 1, data=data) fit.etm <- etm(data, c("0","1"), tra, "cens", s=0, t="last", covariance=FALSE) all.equal(fit.km$surv[data$status], fit.etm$est[1,1,], check.attributes = FALSE) data$to[2] <- "cens" data$status[2] <- FALSE fit.km <- survfit(Surv(time, status) ~ 1, data=data) fit.etm <- etm(data, c("0","1"), tra, "cens", s=0, t="last", covariance=FALSE) all.equal(fit.km$surv[data$status], fit.etm$est[1,1,], check.attributes = FALSE) ### a bit more complicated time <- id <- 1:10 from <- rep(0, 10) to <- rep(c(1, 2), 5) data2 <- data.frame(id, from, to, time) tra2 <- matrix(FALSE, 3, 3) tra2[1, 2:3] <- TRUE etm2 <- etm(data2, c("0", "1", "2"), tra2, NULL, 0) aa <- table(time, to) cif1 <- cumsum(aa[, 1] / 10) cif2 <- cumsum(aa[, 2] / 10) surv <- cumprod((10:1 - 1) / (10:1)) all.equal(trprob(etm2, "0 1"), cif1) all.equal(trprob(etm2, "0 2"), cif2) all.equal(as.vector(trprob(etm2, "0 0")), surv) ## a test on id data2$id <- letters[1:10] etm3 <- etm(data2, c("0", "1", "2"), tra2, NULL, 0) all.equal(trprob(etm2, "0 1"), trprob(etm3, "0 1")) all.equal(trprob(etm2, "0 2"), trprob(etm3, "0 2")) all.equal(trprob(etm2, "0 0"), trprob(etm3, "0 0")) ### Test on sir.cont data(sir.cont) ## Modification for patients entering and leaving a state ## at the same date ## Change on ventilation status is considered ## to happen before end of hospital stay sir.cont <- sir.cont[order(sir.cont$id, sir.cont$time), ] for (i in 2:nrow(sir.cont)) { if (sir.cont$id[i]==sir.cont$id[i-1]) { if (sir.cont$time[i]==sir.cont$time[i-1]) { sir.cont$time[i-1] <- sir.cont$time[i-1] - 0.5 } } } ### Computation of the transition probabilities ## Possible transitions. tra <- matrix(ncol=3,nrow=3,FALSE) tra[1, 2:3] <- TRUE tra[2, c(1, 3)] <- TRUE ## etm prob.sir <- etm(sir.cont, c("0", "1", "2"), tra, "cens", 1) prob.sir summ.sir <- summary(prob.sir) all.equal(summ.sir[['0 1']]$P, as.vector(trprob(prob.sir, "0 1"))) subset(summ.sir[[3]],time<183) # issue with precision on different architectures ## gonna play a bit with the state names dd <- sir.cont dd$from <- ifelse(dd$from == 0, "initial state", "ventilation") dd$to <- as.character(dd$to) for (i in seq_len(nrow(dd))) { dd$to[i] <- switch(dd$to[i], "0" = "initial state", "1" = "ventilation", "2" = "end of story", "cens" = "cens" ) } test <- etm(dd, c("initial state", "ventilation", "end of story"), tra, "cens", 1) all.equal(test$est["initial state", "initial state", ], prob.sir$est["0", "0", ]) all.equal(trprob(test, "initial state initial state"), trprob(prob.sir, "0 0")) all.equal(trprob(test, "initial state ventilation"), trprob(prob.sir, "0 1")) all.equal(trprob(test, "initial state end of story"), trprob(prob.sir, "0 2")) all.equal(trcov(test, "initial state end of story"), trcov(prob.sir, "0 2")) aa <- summary(test) all.equal(summ.sir[[6]], aa[[6]]) all.equal(summ.sir[[4]], aa[[4]]) ### Test on abortion data data(abortion) from <- rep(0, nrow(abortion)) to <- abortion$cause entry <- abortion$entry exit <- abortion$exit id <- 1:nrow(abortion) data <- data.frame(id, from, to, entry, exit, group = abortion$group) ## Computation of the CIFs tra <- matrix(FALSE, 4, 4) tra[1, 2:4] <- TRUE cif.control <- etm(data[data$group == 0, ], c("0", "1", "2", "3"), tra, NULL, 0) cif.exposed <- etm(data[data$group == 1, ], c("0", "1", "2", "3"), tra, NULL, 0) all.equal(trprob(cif.control, "0 1"), cif.control$est["0", "1", ]) all.equal(trcov(cif.control, c("0 1", "0 2")), cif.control$cov["0 1", "0 2", ]) trprob(cif.control, "0 1") trprob(cif.control, "0 2") trprob(cif.control, "0 0") trcov(cif.control, "0 1") trcov(cif.control, "0 2") trcov(cif.control, "0 0") aa <- summary(cif.control) aa$"0 1" all.equal(aa$"0 1"$P, as.vector(trprob(cif.control, "0 1"))) ### test on los data data(los.data) # in package changeLOS ## putting los.data in the long format (see changeLOS) my.observ <- prepare.los.data(x=los.data) tra <- matrix(FALSE, 4, 4) tra[1, 2:4] <- TRUE tra[2, 3:4] <- TRUE tr.prob <- etm(my.observ, c("0","1","2","3"), tra, NULL, 0) tr.prob summary(tr.prob) cLOS <- etm::clos(tr.prob, aw = TRUE) cLOS ### Tests on pseudo values t_pseudo <- closPseudo(my.observ, c("0","1","2","3"), tra, NULL, formula = ~ 1, aw = TRUE) cLOS$e.phi == t_pseudo$theta[, "e.phi"] cLOS$e.phi.weights.1 == t_pseudo$theta[, "e.phi.weights.1"] cLOS$e.phi.weights.other == t_pseudo$theta[, "e.phi.weights.other"] mean(t_pseudo$pseudoData$ps.e.phi) ### tests on etmprep ### creation of fake data in the wild format, following an illness-death model ## transition times tdisease <- c(3, 4, 3, 6, 8, 9) tdeath <- c(6, 9, 8, 6, 8, 9) ## transition status stat.disease <- c(1, 1, 1, 0, 0, 0) stat.death <- c(1, 1, 1, 1, 1, 0) ## a covariate that we want to keep in the new data set.seed(1313) cova <- rbinom(6, 1, 0.5) dat <- data.frame(tdisease, tdeath, stat.disease, stat.death, cova) ## Possible transitions tra <- matrix(FALSE, 3, 3) tra[1, 2:3] <- TRUE tra[2, 3] <- TRUE ## data preparation newdat <- etmprep(c(NA, "tdisease", "tdeath"), c(NA, "stat.disease", "stat.death"), data = dat, tra = tra, cens.name = "cens", keep = "cova") newdat ref <- data.frame(id = c(1, 1, 2, 2, 3, 3, 4, 5, 6), entry = c(0, 3, 0, 4, 0, 3, 0, 0, 0), exit = c(3, 6, 4, 9, 3, 8, 6, 8, 9), from = c(0, 1, 0, 1, 0, 1, 0, 0, 0), to = c(rep(c(1, 2), 3), 2, 2, "cens"), cova = c(1, 1, 0, 0, 1, 1, 0, 1, 1)) ref$from <- factor(as.character(ref$from), levels = c("0", "1", "2", "cens")) ref$to <- factor(as.character(ref$to), levels = c("0", "1", "2", "cens")) all.equal(ref, newdat) ###################################### ### Test the stratified calls ###################################### if (require("kmi", quietly = TRUE)) { library(etm) data(icu.pneu) my.icu.pneu <- icu.pneu my.icu.pneu <- my.icu.pneu[order(my.icu.pneu$id, my.icu.pneu$start), ] masque <- diff(my.icu.pneu$id) my.icu.pneu$from <- 0 my.icu.pneu$from[c(1, masque) == 0] <- 1 my.icu.pneu$to2 <- my.icu.pneu$event my.icu.pneu$to2[my.icu.pneu$status == 0] <- "cens" my.icu.pneu$to2[c(masque, 1) == 0] <- 1 my.icu.pneu$to <- ifelse(my.icu.pneu$to2 %in% c(2, 3), 2, my.icu.pneu$to2) my.icu.pneu <- my.icu.pneu[, c("id", "start", "stop", "from", "to", "to2", "age", "sex")] names(my.icu.pneu)[c(2, 3)] <- c("entry", "exit") bouh_strat <- etm(my.icu.pneu, c("0", "1", "2"), tra_ill(), "cens", 0, strata = "sex") bouh_female <- etm(my.icu.pneu[my.icu.pneu$sex == "F", ], c("0", "1", "2"), tra_ill(), "cens", 0) all(bouh_strat[[1]]$est == bouh_female$est) ## Test the summary the_summary <- summary(bouh_strat) the_summary ## Test trprob all(trprob(bouh_strat, "0 1")[[1]] == trprob(bouh_female, "0 1")) all(trprob(bouh_strat, "0 1", c(0, 5, 10, 15))[[1]] == trprob(bouh_female, "0 1", c(0, 5, 10, 15))) ## Test trcov all(trcov(bouh_strat, "0 1")[[1]] == trcov(bouh_female, "0 1")) all(trcov(bouh_strat, c("0 1", "0 2"))[[1]] == trcov(bouh_female, c("0 1", "0 2"))) all(trcov(bouh_strat, "0 1", c(0, 5, 10, 15))[[1]] == trcov(bouh_female, "0 1", c(0, 5, 10, 15))) } else { print("These tests require the kmi package") } options(old) etm/tests/test.etmCIF.R0000644000176200001440000001127413473044204014417 0ustar liggesusers### test file for etmCIF. ### Really simple tests and comparison with etm old <- options(digits = 5) require(etm) if (!require(survival, quietly = TRUE)) { print("The following tests require the 'survival' package") } else { data(abortion) from <- rep(0, nrow(abortion)) to <- abortion$cause entry <- abortion$entry exit <- abortion$exit id <- 1:nrow(abortion) data <- data.frame(id, from, to, entry, exit, group = abortion$group) ## Computation of the CIFs with etm tra <- matrix(FALSE, 4, 4) tra[1, 2:4] <- TRUE cif.control <- etm(data[data$group == 0, ], c("0", "1", "2", "3"), tra, NULL, 0) cif.exposed <- etm(data[data$group == 1, ], c("0", "1", "2", "3"), tra, NULL, 0) ## Computation of the CIFs with etmCIF netm <- etmCIF(Surv(entry, exit, cause != 0) ~ group, abortion, etype = cause, failcode = 3) ### let's do some comparisons :-) all.equal(trprob(cif.control, "0 3"), netm[[1]]$est["0", "3", ]) all.equal(trprob(cif.control, "0 2"), netm[[1]]$est["0", "2", ]) all.equal(trprob(cif.control, "0 1"), netm[[1]]$est["0", "1", ]) all.equal(trprob(cif.exposed, "0 3"), netm[[2]]$est["0", "3", ]) all.equal(trprob(cif.exposed, "0 2"), netm[[2]]$est["0", "2", ]) all.equal(trprob(cif.exposed, "0 1"), netm[[2]]$est["0", "1", ]) all.equal(trcov(cif.control, "0 3"), netm[[1]]$cov["0 3", "0 3", ]) all.equal(trcov(cif.control, "0 2"), netm[[1]]$cov["0 2", "0 2", ]) all.equal(trcov(cif.control, "0 1"), netm[[1]]$cov["0 1", "0 1", ]) all.equal(trcov(cif.exposed, "0 3"), netm[[2]]$cov["0 3", "0 3", ]) all.equal(trcov(cif.exposed, "0 2"), netm[[2]]$cov["0 2", "0 2", ]) all.equal(trcov(cif.exposed, "0 1"), netm[[2]]$cov["0 1", "0 1", ]) netm ## test on the summary snetm <- summary(netm) snetm all.equal(unname(trprob(cif.control, "0 3")), snetm[[1]][[3]]$P) all.equal(unname(trprob(cif.control, "0 2")), snetm[[1]][[2]]$P) all.equal(unname(trprob(cif.control, "0 1")), snetm[[1]][[1]]$P) all.equal(unname(trprob(cif.exposed, "0 3")), snetm[[2]][[3]]$P) all.equal(unname(trprob(cif.exposed, "0 2")), snetm[[2]][[2]]$P) all.equal(unname(trprob(cif.exposed, "0 1")), snetm[[2]][[1]]$P) scif.control <- summary(cif.control, ci.fun = "cloglog") scif.exposed <- summary(cif.exposed, ci.fun = "cloglog") all.equal(scif.control[[4]]$lower, snetm[[1]][[3]]$lower) all.equal(scif.control[[4]]$upper, snetm[[1]][[3]]$upper) all.equal(scif.exposed[[4]]$lower, snetm[[2]][[3]]$lower) all.equal(scif.exposed[[4]]$upper, snetm[[2]][[3]]$upper) } ### test with factors in the input abortion$status <- with(abortion, ifelse(cause == 2, "life birth", ifelse(cause == 1, "ETOP", "spontaneous abortion"))) abortion$status <- factor(abortion$status) netm.factor <- etmCIF(Surv(entry, exit, status != "cens") ~ group, abortion, etype = status, failcode = "spontaneous abortion") all.equal(trprob(cif.control, "0 3"), netm.factor[[1]]$est["0", "spontaneous abortion", ]) all.equal(trprob(cif.control, "0 2"), netm.factor[[1]]$est["0", "life birth", ]) netm.factor summary(netm.factor) ### test with group as a character vector abortion$ttt <- with(abortion, ifelse(group == 0, "control", "exposed")) abortion$ttt <- factor(abortion$ttt) netm.ttt <- etmCIF(Surv(entry, exit, status != "cens") ~ ttt, abortion, etype = status, failcode = "spontaneous abortion") all.equal(trprob(cif.control, "0 3"), netm.ttt[[1]]$est["0", "spontaneous abortion", ]) all.equal(trprob(cif.control, "0 2"), netm.ttt[[1]]$est["0", "life birth", ]) netm.ttt summary(netm.ttt) ### A couple of comparisons with simulated data set.seed(1313) time <- rexp(100) to <- rbinom(100, 2, prob = c(1/3, 1/3, 1/3)) from <- rep(11, 100) id <- 1:100 cov <- rbinom(100, 1, 0.5) dat.s <- data.frame(id, time, from, to, cov) traa <- matrix(FALSE, 3, 3) traa[1, 2:3] <- TRUE aa0 <- etm(dat.s[dat.s$cov == 0, ], c("11", "1", "2"), traa, "0", 0) aa1 <- etm(dat.s[dat.s$cov == 1, ], c("11", "1", "2"), traa, "0", 0) aa <- etm(dat.s, c("11", "1", "2"), traa, "0", 0) test <- etmCIF(Surv(time, to != 0) ~ 1, dat.s, etype = to) test.c <- etmCIF(Surv(time, to != 0) ~ cov, dat.s, etype = to) all.equal(trprob(aa, "11 1"), test[[1]]$est["0", "1", ]) all.equal(trprob(aa, "11 2"), test[[1]]$est["0", "2", ]) all.equal(trprob(aa0, "11 1"), test.c[[1]]$est["0", "1", ]) all.equal(trprob(aa0, "11 2"), test.c[[1]]$est["0", "2", ]) all.equal(trprob(aa1, "11 1"), test.c[[2]]$est["0", "1", ]) all.equal(trprob(aa1, "11 2"), test.c[[2]]$est["0", "2", ]) test test.c summary(test) summary(test.c) options(old) etm/tests/tests.etm.Rout.save0000644000176200001440000005746113725356670015772 0ustar liggesusers R version 3.6.3 (2020-02-29) -- "Holding the Windsock" Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > require(etm) > > ## Print with a bit less precision to avoid lots of notes in the comparison > old <- options(digits = 4) > > ### Simple test > > time <- id <- 1:10 > from <- rep(0, 10) > to <- rep(1, 10) > > data1 <- data.frame(id, from, to, time) > tra1 <- matrix(FALSE, 2, 2) > tra1[1, 2] <- TRUE > > etm1 <- etm(data1, c("0", "1"), tra1, NULL, 0) > > all.equal(as.vector(trprob(etm1, "0 0")), cumprod((10:1 - 1) / (10:1))) [1] TRUE > > etm1$cov["0 0", "0 0", ] 1 2 3 4 5 6 7 8 9 10 0.009 0.016 0.021 0.024 0.025 0.024 0.021 0.016 0.009 0.000 > > all.equal(etm1$cov["0 0", "0 0",], trcov(etm1, "0 0")) [1] TRUE > > ### A simple test from AHR's author, where the first time is censored > if (!require(survival)) { + stop("This test requires the survival package") + } > > data <- data.frame(id=1:10, time=1:10, from=0, to=1, status=TRUE) > > tra <- matrix(FALSE, nrow=2, ncol=2) > tra[1, 2] <- TRUE > > data$to[1] <- "cens" > data$status[1] <- FALSE > > fit.km <- survfit(Surv(time, status) ~ 1, data=data) > fit.etm <- etm(data, c("0","1"), tra, "cens", s=0, t="last", covariance=FALSE) > > all.equal(fit.km$surv[data$status], fit.etm$est[1,1,], check.attributes = FALSE) [1] TRUE > > data$to[2] <- "cens" > data$status[2] <- FALSE > > fit.km <- survfit(Surv(time, status) ~ 1, data=data) > fit.etm <- etm(data, c("0","1"), tra, "cens", s=0, t="last", covariance=FALSE) > > all.equal(fit.km$surv[data$status], fit.etm$est[1,1,], check.attributes = FALSE) [1] TRUE > > ### a bit more complicated > > time <- id <- 1:10 > from <- rep(0, 10) > to <- rep(c(1, 2), 5) > data2 <- data.frame(id, from, to, time) > > tra2 <- matrix(FALSE, 3, 3) > tra2[1, 2:3] <- TRUE > > etm2 <- etm(data2, c("0", "1", "2"), tra2, NULL, 0) > > aa <- table(time, to) > > cif1 <- cumsum(aa[, 1] / 10) > cif2 <- cumsum(aa[, 2] / 10) > surv <- cumprod((10:1 - 1) / (10:1)) > > all.equal(trprob(etm2, "0 1"), cif1) [1] TRUE > all.equal(trprob(etm2, "0 2"), cif2) [1] TRUE > all.equal(as.vector(trprob(etm2, "0 0")), surv) [1] TRUE > > ## a test on id > data2$id <- letters[1:10] > > etm3 <- etm(data2, c("0", "1", "2"), tra2, NULL, 0) > > all.equal(trprob(etm2, "0 1"), trprob(etm3, "0 1")) [1] TRUE > all.equal(trprob(etm2, "0 2"), trprob(etm3, "0 2")) [1] TRUE > all.equal(trprob(etm2, "0 0"), trprob(etm3, "0 0")) [1] TRUE > > > ### Test on sir.cont > > data(sir.cont) > > ## Modification for patients entering and leaving a state > ## at the same date > ## Change on ventilation status is considered > ## to happen before end of hospital stay > sir.cont <- sir.cont[order(sir.cont$id, sir.cont$time), ] > for (i in 2:nrow(sir.cont)) { + if (sir.cont$id[i]==sir.cont$id[i-1]) { + if (sir.cont$time[i]==sir.cont$time[i-1]) { + sir.cont$time[i-1] <- sir.cont$time[i-1] - 0.5 + } + } + } > > ### Computation of the transition probabilities > ## Possible transitions. > tra <- matrix(ncol=3,nrow=3,FALSE) > tra[1, 2:3] <- TRUE > tra[2, c(1, 3)] <- TRUE > > ## etm > prob.sir <- etm(sir.cont, c("0", "1", "2"), tra, "cens", 1) > > prob.sir Multistate model with 2 transient state(s) and 1 absorbing state(s) Possible transitions: from to 0 1 0 2 1 0 1 2 Estimate of P(1, 183) 0 1 2 0 0 0 1 1 0 0 1 2 0 0 1 > > summ.sir <- summary(prob.sir) > all.equal(summ.sir[['0 1']]$P, as.vector(trprob(prob.sir, "0 1"))) [1] TRUE > subset(summ.sir[[3]],time<183) # issue with precision on different architectures P time var lower upper n.risk n.event 1.5 0.0000 1.5 0.000e+00 0.00000 0.0000 394 0 2 0.1187 2.0 2.641e-04 0.08683 0.1505 396 47 2.5 0.1187 2.5 2.641e-04 0.08683 0.1505 364 0 3 0.2454 3.0 4.465e-04 0.20398 0.2868 365 54 3.5 0.2454 3.5 4.465e-04 0.20398 0.2868 328 0 4 0.3806 4.0 5.416e-04 0.33501 0.4262 331 62 4.5 0.3806 4.5 5.416e-04 0.33501 0.4262 280 0 5 0.4792 5.0 5.480e-04 0.43333 0.5251 283 48 5.5 0.4792 5.5 5.480e-04 0.43333 0.5251 248 0 6 0.5693 6.0 5.141e-04 0.52482 0.6137 249 47 7 0.6350 7.0 4.665e-04 0.59266 0.6773 212 36 8 0.6795 8.0 4.202e-04 0.63931 0.7197 195 27 8.5 0.6795 8.5 4.202e-04 0.63931 0.7197 172 0 9 0.7325 9.0 3.580e-04 0.69541 0.7696 173 34 10 0.7647 10.0 3.141e-04 0.72992 0.7994 148 21 10.5 0.7647 10.5 3.141e-04 0.72992 0.7994 135 0 11 0.7895 11.0 2.790e-04 0.75674 0.8222 136 18 12 0.8138 12.0 2.420e-04 0.78330 0.8443 129 18 12.5 0.8138 12.5 2.420e-04 0.78330 0.8443 117 0 13 0.8294 13.0 2.182e-04 0.80045 0.8584 118 13 14 0.8452 14.0 1.938e-04 0.81789 0.8725 115 14 15 0.8625 15.0 1.670e-04 0.83714 0.8878 106 15 16 0.8723 16.0 1.522e-04 0.84807 0.8964 93 9 17 0.8852 17.0 1.330e-04 0.86256 0.9078 86 12 17.5 0.8852 17.5 1.330e-04 0.86256 0.9078 77 0 18 0.8960 18.0 1.168e-04 0.87484 0.9172 76 9 19 0.9029 19.0 1.070e-04 0.88261 0.9232 71 7 20 0.9125 20.0 9.367e-05 0.89356 0.9315 64 10 21 0.9161 21.0 8.878e-05 0.89768 0.9346 57 4 22 0.9226 22.0 7.996e-05 0.90504 0.9401 55 6 23 0.9261 23.0 7.537e-05 0.90904 0.9431 51 4 23.5 0.9261 23.5 7.537e-05 0.90904 0.9431 49 0 24 0.9354 24.0 6.292e-05 0.91982 0.9509 50 9 25 0.9385 25.0 5.878e-05 0.92352 0.9536 42 3 26 0.9429 26.0 5.326e-05 0.92863 0.9572 39 5 27 0.9477 27.0 4.749e-05 0.93417 0.9612 35 6 27.5 0.9477 27.5 4.749e-05 0.93417 0.9612 29 0 28 0.9531 28.0 4.093e-05 0.94059 0.9657 30 5 29 0.9567 29.0 3.668e-05 0.94485 0.9686 31 4 30 0.9592 30.0 3.384e-05 0.94779 0.9706 28 3 30.5 0.9592 30.5 3.384e-05 0.94779 0.9706 29 0 31 0.9642 31.0 2.821e-05 0.95383 0.9746 30 6 32 0.9649 32.0 2.752e-05 0.95458 0.9751 25 1 33 0.9669 33.0 2.533e-05 0.95708 0.9768 24 2 34 0.9685 34.0 2.368e-05 0.95900 0.9781 26 2 35 0.9697 35.0 2.252e-05 0.96036 0.9790 28 2 36 0.9702 36.0 2.194e-05 0.96104 0.9794 26 1 37 0.9718 37.0 2.043e-05 0.96290 0.9806 26 2 38 0.9739 38.0 1.831e-05 0.96555 0.9823 25 4 38.5 0.9739 38.5 1.831e-05 0.96555 0.9823 21 0 39 0.9760 39.0 1.643e-05 0.96802 0.9839 23 3 40 0.9769 40.0 1.558e-05 0.96918 0.9847 19 1 41 0.9774 41.0 1.512e-05 0.96981 0.9851 22 1 42 0.9779 42.0 1.476e-05 0.97032 0.9854 22 0 43 0.9798 43.0 1.308e-05 0.97271 0.9869 22 3 44 0.9803 44.0 1.265e-05 0.97333 0.9873 21 1 45 0.9817 45.0 1.157e-05 0.97499 0.9883 19 1 46 0.9822 46.0 1.116e-05 0.97561 0.9887 17 1 47 0.9831 47.0 1.037e-05 0.97683 0.9895 18 2 48 0.9836 48.0 9.987e-06 0.97743 0.9898 17 1 49 0.9841 49.0 9.669e-06 0.97796 0.9901 17 0 50 0.9845 50.0 9.297e-06 0.97856 0.9905 17 1 50.5 0.9845 50.5 9.297e-06 0.97856 0.9905 16 0 51 0.9860 51.0 8.214e-06 0.98037 0.9916 17 3 52 0.9870 52.0 7.513e-06 0.98159 0.9923 14 2 53 0.9879 53.0 6.875e-06 0.98276 0.9930 12 1 54 0.9889 54.0 6.214e-06 0.98397 0.9937 12 2 55 0.9903 55.0 5.254e-06 0.98581 0.9948 10 3 56 0.9913 56.0 4.667e-06 0.98703 0.9955 6 1 57 0.9917 57.0 4.364e-06 0.98765 0.9958 5 1 58 0.9922 58.0 4.064e-06 0.98828 0.9962 4 1 59 0.9927 59.0 3.769e-06 0.98891 0.9965 3 1 60 0.9932 60.0 3.488e-06 0.98953 0.9969 3 1 62 0.9937 62.0 3.230e-06 0.99016 0.9972 2 0 63 0.9942 63.0 2.956e-06 0.99079 0.9975 2 1 68 0.9942 68.0 2.956e-06 0.99079 0.9975 1 0 70 0.9946 70.0 2.694e-06 0.99143 0.9979 2 1 78 0.9951 78.0 2.442e-06 0.99207 0.9982 1 0 80 0.9951 80.0 2.442e-06 0.99207 0.9982 1 0 85 0.9966 85.0 1.695e-06 0.99404 0.9991 2 0 89 0.9966 89.0 1.695e-06 0.99404 0.9991 2 0 90 0.9966 90.0 1.695e-06 0.99404 0.9991 1 0 95 0.9971 95.0 1.448e-06 0.99472 0.9994 2 0 100 0.9976 100.0 1.203e-06 0.99542 0.9997 3 0 101 0.9981 101.0 9.592e-07 0.99613 1.0000 3 1 108 0.9985 108.0 7.169e-07 0.99688 1.0000 2 1 113 0.9990 113.0 4.764e-07 0.99767 1.0000 1 0 116 0.9990 116.0 4.764e-07 0.99767 1.0000 1 0 124 0.9990 124.0 4.764e-07 0.99767 1.0000 2 0 164 0.9990 164.0 4.764e-07 0.99767 1.0000 0 0 > > ## gonna play a bit with the state names > dd <- sir.cont > dd$from <- ifelse(dd$from == 0, "initial state", "ventilation") > dd$to <- as.character(dd$to) > for (i in seq_len(nrow(dd))) { + dd$to[i] <- switch(dd$to[i], + "0" = "initial state", + "1" = "ventilation", + "2" = "end of story", + "cens" = "cens" + ) + } > > test <- etm(dd, c("initial state", "ventilation", "end of story"), tra, "cens", 1) > > all.equal(test$est["initial state", "initial state", ], + prob.sir$est["0", "0", ]) [1] TRUE > all.equal(trprob(test, "initial state initial state"), trprob(prob.sir, "0 0")) [1] TRUE > all.equal(trprob(test, "initial state ventilation"), trprob(prob.sir, "0 1")) [1] TRUE > all.equal(trprob(test, "initial state end of story"), trprob(prob.sir, "0 2")) [1] TRUE > > all.equal(trcov(test, "initial state end of story"), trcov(prob.sir, "0 2")) [1] TRUE > > aa <- summary(test) > all.equal(summ.sir[[6]], aa[[6]]) [1] TRUE > all.equal(summ.sir[[4]], aa[[4]]) [1] TRUE > > ### Test on abortion data > > data(abortion) > > from <- rep(0, nrow(abortion)) > to <- abortion$cause > entry <- abortion$entry > exit <- abortion$exit > id <- 1:nrow(abortion) > data <- data.frame(id, from, to, entry, exit, group = abortion$group) > > ## Computation of the CIFs > tra <- matrix(FALSE, 4, 4) > tra[1, 2:4] <- TRUE > > cif.control <- etm(data[data$group == 0, ], c("0", "1", "2", "3"), + tra, NULL, 0) > cif.exposed <- etm(data[data$group == 1, ], c("0", "1", "2", "3"), + tra, NULL, 0) > > all.equal(trprob(cif.control, "0 1"), cif.control$est["0", "1", ]) [1] TRUE > all.equal(trcov(cif.control, c("0 1", "0 2")), cif.control$cov["0 1", "0 2", ]) [1] TRUE > > trprob(cif.control, "0 1") 6 7 8 9 10 11 12 13 0.000000 0.007401 0.014881 0.026509 0.033208 0.037694 0.037694 0.038955 14 17 19 21 24 25 26 30 0.040159 0.040159 0.040159 0.040159 0.040159 0.040159 0.040159 0.040159 31 32 33 34 35 36 37 38 0.040159 0.040159 0.040159 0.040159 0.040159 0.040159 0.040159 0.040159 39 40 41 42 43 0.040159 0.040159 0.040159 0.040159 0.040159 > trprob(cif.control, "0 2") 6 7 8 9 10 11 12 13 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 14 17 19 21 24 25 26 30 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.003657 31 32 33 34 35 36 37 38 0.006371 0.008175 0.013543 0.023317 0.031260 0.053197 0.084529 0.179163 39 40 41 42 43 0.322016 0.563121 0.742227 0.793893 0.799059 > trprob(cif.control, "0 0") 6 7 8 9 10 11 12 13 0.965812 0.932508 0.887628 0.862433 0.838989 0.822538 0.813099 0.810578 14 17 19 21 24 25 26 30 0.806964 0.805874 0.803810 0.802804 0.801837 0.800883 0.799937 0.796280 31 32 33 34 35 36 37 38 0.793565 0.791762 0.786394 0.776620 0.768677 0.745862 0.714531 0.619897 39 40 41 42 43 0.477043 0.235938 0.056832 0.005167 0.000000 > > trcov(cif.control, "0 1") 6 7 8 9 10 11 12 13 0.000e+00 2.719e-05 4.533e-05 6.665e-05 7.698e-05 8.304e-05 8.304e-05 8.444e-05 14 17 19 21 24 25 26 30 8.571e-05 8.571e-05 8.571e-05 8.571e-05 8.571e-05 8.571e-05 8.571e-05 8.571e-05 31 32 33 34 35 36 37 38 8.571e-05 8.571e-05 8.571e-05 8.571e-05 8.571e-05 8.571e-05 8.571e-05 8.571e-05 39 40 41 42 43 8.571e-05 8.571e-05 8.571e-05 8.571e-05 8.571e-05 > trcov(cif.control, "0 2") 6 7 8 9 10 11 12 13 0.000e+00 0.000e+00 0.000e+00 0.000e+00 0.000e+00 0.000e+00 0.000e+00 0.000e+00 14 17 19 21 24 25 26 30 0.000e+00 0.000e+00 0.000e+00 0.000e+00 0.000e+00 0.000e+00 0.000e+00 3.338e-06 31 32 33 34 35 36 37 38 5.784e-06 7.401e-06 1.216e-05 2.072e-05 2.758e-05 4.619e-05 7.202e-05 1.461e-04 39 40 41 42 43 2.470e-04 3.880e-04 4.702e-04 4.903e-04 4.922e-04 > trcov(cif.control, "0 0") 6 7 8 9 10 11 12 13 2.822e-04 3.821e-04 4.527e-04 4.748e-04 4.875e-04 4.927e-04 4.941e-04 4.942e-04 14 17 19 21 24 25 26 30 4.941e-04 4.940e-04 4.936e-04 4.933e-04 4.931e-04 4.928e-04 4.926e-04 4.914e-04 31 32 33 34 35 36 37 38 4.905e-04 4.899e-04 4.880e-04 4.846e-04 4.816e-04 4.729e-04 4.601e-04 4.176e-04 39 40 41 42 43 3.425e-04 1.865e-04 4.797e-05 4.441e-06 0.000e+00 > > aa <- summary(cif.control) > aa$"0 1" P time var lower upper n.risk n.event 6 0.000000 6 0.000e+00 0.000000 0.00000 117 0 7 0.007401 7 2.719e-05 0.000000 0.01762 261 2 8 0.014881 8 4.533e-05 0.001685 0.02808 374 3 9 0.026509 9 6.665e-05 0.010508 0.04251 458 6 10 0.033208 10 7.698e-05 0.016011 0.05040 515 4 11 0.037694 11 8.304e-05 0.019834 0.05555 561 3 12 0.037694 12 8.304e-05 0.019834 0.05555 610 0 13 0.038955 13 8.444e-05 0.020944 0.05697 645 1 14 0.040159 14 8.571e-05 0.022014 0.05830 673 1 17 0.040159 17 8.571e-05 0.022014 0.05830 740 0 19 0.040159 19 8.571e-05 0.022014 0.05830 781 0 21 0.040159 21 8.571e-05 0.022014 0.05830 799 0 24 0.040159 24 8.571e-05 0.022014 0.05830 830 0 25 0.040159 25 8.571e-05 0.022014 0.05830 841 0 26 0.040159 26 8.571e-05 0.022014 0.05830 846 0 30 0.040159 30 8.571e-05 0.022014 0.05830 875 0 31 0.040159 31 8.571e-05 0.022014 0.05830 880 0 32 0.040159 32 8.571e-05 0.022014 0.05830 880 0 33 0.040159 33 8.571e-05 0.022014 0.05830 885 0 34 0.040159 34 8.571e-05 0.022014 0.05830 885 0 35 0.040159 35 8.571e-05 0.022014 0.05830 880 0 36 0.040159 36 8.571e-05 0.022014 0.05830 876 0 37 0.040159 37 8.571e-05 0.022014 0.05830 857 0 38 0.040159 38 8.571e-05 0.022014 0.05830 823 0 39 0.040159 39 8.571e-05 0.022014 0.05830 716 0 40 0.040159 40 8.571e-05 0.022014 0.05830 554 0 41 0.040159 41 8.571e-05 0.022014 0.05830 274 0 42 0.040159 42 8.571e-05 0.022014 0.05830 66 0 43 0.040159 43 8.571e-05 0.022014 0.05830 6 0 > all.equal(aa$"0 1"$P, as.vector(trprob(cif.control, "0 1"))) [1] TRUE > > ### test on los data > > data(los.data) # in package changeLOS > > ## putting los.data in the long format (see changeLOS) > my.observ <- prepare.los.data(x=los.data) > > tra <- matrix(FALSE, 4, 4) > tra[1, 2:4] <- TRUE > tra[2, 3:4] <- TRUE > > tr.prob <- etm(my.observ, c("0","1","2","3"), tra, NULL, 0) > > tr.prob Multistate model with 2 transient state(s) and 2 absorbing state(s) Possible transitions: from to 0 1 0 2 0 3 1 2 1 3 Estimate of P(0, 82) 0 1 2 3 0 0 0 0.7474 0.2526 1 0 0 0.7073 0.2927 2 0 0 1.0000 0.0000 3 0 0 0.0000 1.0000 > summary(tr.prob) Transition 0 0 P time var lower upper n.risk n.event 0.882275 3 1.374e-04 0.8593018 0.905248 756 0 0.112434 15 1.320e-04 0.0899155 0.134952 90 0 0.031746 27 4.066e-05 0.0192484 0.044244 26 0 0.006614 41 8.690e-06 0.0008359 0.012392 5 0 0.002646 61 3.490e-06 0.0000000 0.006307 3 0 0.000000 82 0.000e+00 0.0000000 0.000000 1 0 Transition 0 1 P time var lower upper n.risk n.event 0.017196 3 2.235e-05 0.0079289 0.02646 756 13 0.063492 15 7.865e-05 0.0461099 0.08087 90 0 0.030423 27 3.902e-05 0.0181805 0.04267 26 1 0.015873 41 2.066e-05 0.0069637 0.02478 5 0 0.005291 61 6.962e-06 0.0001197 0.01046 3 0 0.000000 82 0.000e+00 0.0000000 0.00000 1 0 Transition 0 2 P time var lower upper n.risk n.event 0.08466 3 0.0001025 0.06481 0.1045 756 64 0.62302 15 0.0003107 0.58847 0.6576 90 4 0.69841 27 0.0002786 0.66570 0.7311 26 1 0.72751 41 0.0002622 0.69578 0.7593 5 0 0.74074 61 0.0002540 0.70950 0.7720 3 1 0.74735 82 0.0002498 0.71638 0.7783 1 1 Transition 0 3 P time var lower upper n.risk n.event 0.01587 3 2.066e-05 0.006964 0.02478 756 12 0.20106 15 2.125e-04 0.172489 0.22963 90 1 0.23942 27 2.409e-04 0.208999 0.26984 26 0 0.25000 41 2.480e-04 0.219133 0.28087 5 0 0.25132 61 2.489e-04 0.220402 0.28224 3 0 0.25265 82 2.498e-04 0.221671 0.28362 1 0 Transition 1 1 P time var lower upper n.risk n.event 1.00000 3 0.000e+00 1.00000 1.00000 0 0 0.38661 15 2.358e-03 0.29143 0.48179 51 0 0.12119 27 7.842e-04 0.06630 0.17607 23 0 0.04593 41 2.405e-04 0.01554 0.07633 14 0 0.01531 61 6.579e-05 0.00000 0.03121 4 0 0.00000 82 0.000e+00 0.00000 0.00000 0 0 Transition 1 2 P time var lower upper n.risk n.event 0.0000 3 0.000000 0.0000 0.0000 0 0 0.4107 15 0.002590 0.3110 0.5104 51 2 0.6082 27 0.002254 0.5151 0.7012 23 1 0.6652 41 0.002064 0.5761 0.7542 14 2 0.6920 61 0.002000 0.6043 0.7796 4 0 0.7073 82 0.001984 0.6200 0.7946 0 0 Transition 1 3 P time var lower upper n.risk n.event 0.0000 3 0.000000 0.0000 0.0000 0 0 0.2027 15 0.001784 0.1199 0.2855 51 1 0.2706 27 0.001968 0.1837 0.3576 23 0 0.2889 41 0.001982 0.2016 0.3761 14 0 0.2927 61 0.001984 0.2054 0.3800 4 0 0.2927 82 0.001984 0.2054 0.3800 0 0 > > cLOS <- etm::clos(tr.prob, aw = TRUE) > > cLOS The expected change in length of stay is: 1.975 Alternative weighting: Expected change in LOS with weight.1: 2.097 Expected change in LOS with weight.other: 1.951 > > > ### Tests on pseudo values > t_pseudo <- closPseudo(my.observ, c("0","1","2","3"), tra, NULL, + formula = ~ 1, aw = TRUE) > > cLOS$e.phi == t_pseudo$theta[, "e.phi"] [,1] [1,] TRUE > cLOS$e.phi.weights.1 == t_pseudo$theta[, "e.phi.weights.1"] [,1] [1,] TRUE > cLOS$e.phi.weights.other == t_pseudo$theta[, "e.phi.weights.other"] [,1] [1,] TRUE > > mean(t_pseudo$pseudoData$ps.e.phi) [1] 1.968 > > ### tests on etmprep > > ### creation of fake data in the wild format, following an illness-death model > ## transition times > tdisease <- c(3, 4, 3, 6, 8, 9) > tdeath <- c(6, 9, 8, 6, 8, 9) > > ## transition status > stat.disease <- c(1, 1, 1, 0, 0, 0) > stat.death <- c(1, 1, 1, 1, 1, 0) > > ## a covariate that we want to keep in the new data > set.seed(1313) > cova <- rbinom(6, 1, 0.5) > > dat <- data.frame(tdisease, tdeath, + stat.disease, stat.death, + cova) > > ## Possible transitions > tra <- matrix(FALSE, 3, 3) > tra[1, 2:3] <- TRUE > tra[2, 3] <- TRUE > > ## data preparation > newdat <- etmprep(c(NA, "tdisease", "tdeath"), + c(NA, "stat.disease", "stat.death"), + data = dat, tra = tra, + cens.name = "cens", keep = "cova") > > newdat id entry exit from to cova 1 1 0 3 0 1 1 2 1 3 6 1 2 1 3 2 0 4 0 1 0 4 2 4 9 1 2 0 5 3 0 3 0 1 1 6 3 3 8 1 2 1 7 4 0 6 0 2 0 8 5 0 8 0 2 1 9 6 0 9 0 cens 1 > > ref <- data.frame(id = c(1, 1, 2, 2, 3, 3, 4, 5, 6), + entry = c(0, 3, 0, 4, 0, 3, 0, 0, 0), + exit = c(3, 6, 4, 9, 3, 8, 6, 8, 9), + from = c(0, 1, 0, 1, 0, 1, 0, 0, 0), + to = c(rep(c(1, 2), 3), 2, 2, "cens"), + cova = c(1, 1, 0, 0, 1, 1, 0, 1, 1)) > ref$from <- factor(as.character(ref$from), levels = c("0", "1", "2", "cens")) > ref$to <- factor(as.character(ref$to), levels = c("0", "1", "2", "cens")) > > all.equal(ref, newdat) [1] TRUE > > > ###################################### > ### Test the stratified calls > ###################################### > > if (require("kmi", quietly = TRUE)) { + library(etm) + + data(icu.pneu) + my.icu.pneu <- icu.pneu + + my.icu.pneu <- my.icu.pneu[order(my.icu.pneu$id, my.icu.pneu$start), ] + masque <- diff(my.icu.pneu$id) + + my.icu.pneu$from <- 0 + my.icu.pneu$from[c(1, masque) == 0] <- 1 + + my.icu.pneu$to2 <- my.icu.pneu$event + my.icu.pneu$to2[my.icu.pneu$status == 0] <- "cens" + my.icu.pneu$to2[c(masque, 1) == 0] <- 1 + + + my.icu.pneu$to <- ifelse(my.icu.pneu$to2 %in% c(2, 3), 2, + my.icu.pneu$to2) + + my.icu.pneu <- my.icu.pneu[, c("id", "start", "stop", "from", "to", + "to2", "age", "sex")] + names(my.icu.pneu)[c(2, 3)] <- c("entry", "exit") + + bouh_strat <- etm(my.icu.pneu, c("0", "1", "2"), tra_ill(), "cens", 0, strata = "sex") + + bouh_female <- etm(my.icu.pneu[my.icu.pneu$sex == "F", ], + c("0", "1", "2"), tra_ill(), "cens", 0) + + all(bouh_strat[[1]]$est == bouh_female$est) + + ## Test the summary + the_summary <- summary(bouh_strat) + the_summary + + ## Test trprob + all(trprob(bouh_strat, "0 1")[[1]] == trprob(bouh_female, "0 1")) + all(trprob(bouh_strat, "0 1", c(0, 5, 10, 15))[[1]] == trprob(bouh_female, "0 1", c(0, 5, 10, 15))) + + ## Test trcov + all(trcov(bouh_strat, "0 1")[[1]] == trcov(bouh_female, "0 1")) + all(trcov(bouh_strat, c("0 1", "0 2"))[[1]] == trcov(bouh_female, c("0 1", "0 2"))) + all(trcov(bouh_strat, "0 1", c(0, 5, 10, 15))[[1]] == trcov(bouh_female, "0 1", c(0, 5, 10, 15))) + } else { + print("These tests require the kmi package") + } [1] TRUE > > options(old) > etm/tests/test.etmCIF.Rout.save0000644000176200001440000003655013473045116016113 0ustar liggesusers R version 3.6.0 (2019-04-26) -- "Planting of a Tree" Copyright (C) 2019 The R Foundation for Statistical Computing Platform: x86_64-apple-darwin18.5.0 (64-bit) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ### test file for etmCIF. > ### Really simple tests and comparison with etm > > old <- options(digits = 5) > > require(etm) Loading required package: etm > > if (!require(survival, quietly = TRUE)) { + print("The following tests require the 'survival' package") + } else { + + data(abortion) + + from <- rep(0, nrow(abortion)) + to <- abortion$cause + entry <- abortion$entry + exit <- abortion$exit + id <- 1:nrow(abortion) + data <- data.frame(id, from, to, entry, exit, group = abortion$group) + + ## Computation of the CIFs with etm + tra <- matrix(FALSE, 4, 4) + tra[1, 2:4] <- TRUE + + cif.control <- etm(data[data$group == 0, ], c("0", "1", "2", "3"), + tra, NULL, 0) + cif.exposed <- etm(data[data$group == 1, ], c("0", "1", "2", "3"), + tra, NULL, 0) + + + ## Computation of the CIFs with etmCIF + netm <- etmCIF(Surv(entry, exit, cause != 0) ~ group, abortion, + etype = cause, failcode = 3) + + ### let's do some comparisons :-) + + all.equal(trprob(cif.control, "0 3"), netm[[1]]$est["0", "3", ]) + all.equal(trprob(cif.control, "0 2"), netm[[1]]$est["0", "2", ]) + all.equal(trprob(cif.control, "0 1"), netm[[1]]$est["0", "1", ]) + + all.equal(trprob(cif.exposed, "0 3"), netm[[2]]$est["0", "3", ]) + all.equal(trprob(cif.exposed, "0 2"), netm[[2]]$est["0", "2", ]) + all.equal(trprob(cif.exposed, "0 1"), netm[[2]]$est["0", "1", ]) + + + all.equal(trcov(cif.control, "0 3"), netm[[1]]$cov["0 3", "0 3", ]) + all.equal(trcov(cif.control, "0 2"), netm[[1]]$cov["0 2", "0 2", ]) + all.equal(trcov(cif.control, "0 1"), netm[[1]]$cov["0 1", "0 1", ]) + + all.equal(trcov(cif.exposed, "0 3"), netm[[2]]$cov["0 3", "0 3", ]) + all.equal(trcov(cif.exposed, "0 2"), netm[[2]]$cov["0 2", "0 2", ]) + all.equal(trcov(cif.exposed, "0 1"), netm[[2]]$cov["0 1", "0 1", ]) + + + netm + + ## test on the summary + snetm <- summary(netm) + + snetm + + all.equal(unname(trprob(cif.control, "0 3")), snetm[[1]][[3]]$P) + all.equal(unname(trprob(cif.control, "0 2")), snetm[[1]][[2]]$P) + all.equal(unname(trprob(cif.control, "0 1")), snetm[[1]][[1]]$P) + + all.equal(unname(trprob(cif.exposed, "0 3")), snetm[[2]][[3]]$P) + all.equal(unname(trprob(cif.exposed, "0 2")), snetm[[2]][[2]]$P) + all.equal(unname(trprob(cif.exposed, "0 1")), snetm[[2]][[1]]$P) + + scif.control <- summary(cif.control, ci.fun = "cloglog") + scif.exposed <- summary(cif.exposed, ci.fun = "cloglog") + + all.equal(scif.control[[4]]$lower, snetm[[1]][[3]]$lower) + all.equal(scif.control[[4]]$upper, snetm[[1]][[3]]$upper) + + all.equal(scif.exposed[[4]]$lower, snetm[[2]][[3]]$lower) + all.equal(scif.exposed[[4]]$upper, snetm[[2]][[3]]$upper) + } [1] TRUE > > ### test with factors in the input > abortion$status <- with(abortion, ifelse(cause == 2, "life birth", + ifelse(cause == 1, "ETOP", "spontaneous abortion"))) > > abortion$status <- factor(abortion$status) > > netm.factor <- etmCIF(Surv(entry, exit, status != "cens") ~ group, abortion, + etype = status, failcode = "spontaneous abortion") > > > all.equal(trprob(cif.control, "0 3"), netm.factor[[1]]$est["0", "spontaneous abortion", ]) [1] TRUE > all.equal(trprob(cif.control, "0 2"), netm.factor[[1]]$est["0", "life birth", ]) [1] TRUE > > netm.factor Call: etmCIF(formula = Surv(entry, exit, status != "cens") ~ group, data = abortion, etype = status, failcode = "spontaneous abortion") Covariate: group levels: 0 1 group = 0 time P se(P) n.event CIF ETOP 43 0.040159 0.0092578 20 CIF life birth 43 0.799059 0.0221865 924 CIF spontaneous abortion 43 0.160781 0.0213261 69 group = 1 time P se(P) n.event CIF ETOP 42 0.28511 0.042493 38 CIF life birth 42 0.35257 0.042139 92 CIF spontaneous abortion 42 0.36232 0.049473 43 > > summary(netm.factor) group=0 CIF ETOP P time var lower upper n.risk n.event 0.000000 6 0.0000e+00 0.000000 0.000000 117 0 0.038955 13 8.4440e-05 0.024488 0.061694 645 1 0.040159 26 8.5707e-05 0.025513 0.062939 846 0 0.040159 36 8.5707e-05 0.025513 0.062939 876 0 0.040159 40 8.5707e-05 0.025513 0.062939 554 0 0.040159 43 8.5707e-05 0.025513 0.062939 6 0 CIF life birth P time var lower upper n.risk n.event 0.000000 6 0.0000e+00 0.000000 0.000000 117 0 0.000000 13 0.0000e+00 0.000000 0.000000 645 0 0.000000 26 0.0000e+00 0.000000 0.000000 846 0 0.053197 36 4.6195e-05 0.041379 0.068268 876 25 0.563121 40 3.8801e-04 0.524924 0.602021 554 280 0.799059 43 4.9224e-04 0.753969 0.840613 6 6 CIF spontaneous abortion P time var lower upper n.risk n.event 0.034188 6 0.00028222 0.01297 0.088523 117 4 0.150468 13 0.00045513 0.11360 0.197901 645 1 0.159904 26 0.00045498 0.12274 0.206925 846 1 0.160781 36 0.00045480 0.12360 0.207757 876 1 0.160781 40 0.00045480 0.12360 0.207757 554 0 0.160781 43 0.00045480 0.12360 0.207757 6 0 group=1 CIF ETOP P time var lower upper n.risk n.event 0.00000 6 0.0000000 0.00000 0.00000 35 0 0.26048 13 0.0017854 0.18795 0.35425 90 0 0.28115 21 0.0018028 0.20742 0.37423 93 1 0.28511 34 0.0018057 0.21116 0.37806 89 0 0.28511 39 0.0018057 0.21116 0.37806 59 0 0.28511 42 0.0018057 0.21116 0.37806 6 0 CIF life birth P time var lower upper n.risk n.event 0.000000 6 0.0000e+00 0.000000 0.000000 35 0 0.000000 13 0.0000e+00 0.000000 0.000000 90 0 0.000000 21 0.0000e+00 0.000000 0.000000 93 0 0.023073 34 9.0514e-05 0.010252 0.051504 89 2 0.180156 39 8.0126e-04 0.131765 0.243663 59 13 0.352565 42 1.7757e-03 0.276882 0.441775 6 6 CIF spontaneous abortion P time var lower upper n.risk n.event 0.057143 6 0.0015394 0.014605 0.20968 35 2 0.333246 13 0.0025280 0.245337 0.44216 90 4 0.350702 21 0.0024827 0.262769 0.45762 93 0 0.358492 34 0.0024593 0.270627 0.46448 89 0 0.358492 39 0.0024593 0.270627 0.46448 59 0 0.362323 42 0.0024476 0.274499 0.46785 6 0 > > ### test with group as a character vector > abortion$ttt <- with(abortion, ifelse(group == 0, "control", "exposed")) > abortion$ttt <- factor(abortion$ttt) > > netm.ttt <- etmCIF(Surv(entry, exit, status != "cens") ~ ttt, abortion, + etype = status, failcode = "spontaneous abortion") > > all.equal(trprob(cif.control, "0 3"), netm.ttt[[1]]$est["0", "spontaneous abortion", ]) [1] TRUE > all.equal(trprob(cif.control, "0 2"), netm.ttt[[1]]$est["0", "life birth", ]) [1] TRUE > > netm.ttt Call: etmCIF(formula = Surv(entry, exit, status != "cens") ~ ttt, data = abortion, etype = status, failcode = "spontaneous abortion") Covariate: ttt levels: control exposed ttt = control time P se(P) n.event CIF ETOP 43 0.040159 0.0092578 20 CIF life birth 43 0.799059 0.0221865 924 CIF spontaneous abortion 43 0.160781 0.0213261 69 ttt = exposed time P se(P) n.event CIF ETOP 42 0.28511 0.042493 38 CIF life birth 42 0.35257 0.042139 92 CIF spontaneous abortion 42 0.36232 0.049473 43 > > summary(netm.ttt) ttt=control CIF ETOP P time var lower upper n.risk n.event 0.000000 6 0.0000e+00 0.000000 0.000000 117 0 0.038955 13 8.4440e-05 0.024488 0.061694 645 1 0.040159 26 8.5707e-05 0.025513 0.062939 846 0 0.040159 36 8.5707e-05 0.025513 0.062939 876 0 0.040159 40 8.5707e-05 0.025513 0.062939 554 0 0.040159 43 8.5707e-05 0.025513 0.062939 6 0 CIF life birth P time var lower upper n.risk n.event 0.000000 6 0.0000e+00 0.000000 0.000000 117 0 0.000000 13 0.0000e+00 0.000000 0.000000 645 0 0.000000 26 0.0000e+00 0.000000 0.000000 846 0 0.053197 36 4.6195e-05 0.041379 0.068268 876 25 0.563121 40 3.8801e-04 0.524924 0.602021 554 280 0.799059 43 4.9224e-04 0.753969 0.840613 6 6 CIF spontaneous abortion P time var lower upper n.risk n.event 0.034188 6 0.00028222 0.01297 0.088523 117 4 0.150468 13 0.00045513 0.11360 0.197901 645 1 0.159904 26 0.00045498 0.12274 0.206925 846 1 0.160781 36 0.00045480 0.12360 0.207757 876 1 0.160781 40 0.00045480 0.12360 0.207757 554 0 0.160781 43 0.00045480 0.12360 0.207757 6 0 ttt=exposed CIF ETOP P time var lower upper n.risk n.event 0.00000 6 0.0000000 0.00000 0.00000 35 0 0.26048 13 0.0017854 0.18795 0.35425 90 0 0.28115 21 0.0018028 0.20742 0.37423 93 1 0.28511 34 0.0018057 0.21116 0.37806 89 0 0.28511 39 0.0018057 0.21116 0.37806 59 0 0.28511 42 0.0018057 0.21116 0.37806 6 0 CIF life birth P time var lower upper n.risk n.event 0.000000 6 0.0000e+00 0.000000 0.000000 35 0 0.000000 13 0.0000e+00 0.000000 0.000000 90 0 0.000000 21 0.0000e+00 0.000000 0.000000 93 0 0.023073 34 9.0514e-05 0.010252 0.051504 89 2 0.180156 39 8.0126e-04 0.131765 0.243663 59 13 0.352565 42 1.7757e-03 0.276882 0.441775 6 6 CIF spontaneous abortion P time var lower upper n.risk n.event 0.057143 6 0.0015394 0.014605 0.20968 35 2 0.333246 13 0.0025280 0.245337 0.44216 90 4 0.350702 21 0.0024827 0.262769 0.45762 93 0 0.358492 34 0.0024593 0.270627 0.46448 89 0 0.358492 39 0.0024593 0.270627 0.46448 59 0 0.362323 42 0.0024476 0.274499 0.46785 6 0 > > > ### A couple of comparisons with simulated data > set.seed(1313) > time <- rexp(100) > to <- rbinom(100, 2, prob = c(1/3, 1/3, 1/3)) > from <- rep(11, 100) > id <- 1:100 > cov <- rbinom(100, 1, 0.5) > > dat.s <- data.frame(id, time, from, to, cov) > > traa <- matrix(FALSE, 3, 3) > traa[1, 2:3] <- TRUE > > aa0 <- etm(dat.s[dat.s$cov == 0, ], c("11", "1", "2"), traa, "0", 0) > aa1 <- etm(dat.s[dat.s$cov == 1, ], c("11", "1", "2"), traa, "0", 0) > aa <- etm(dat.s, c("11", "1", "2"), traa, "0", 0) > > test <- etmCIF(Surv(time, to != 0) ~ 1, dat.s, etype = to) > > test.c <- etmCIF(Surv(time, to != 0) ~ cov, dat.s, etype = to) > > all.equal(trprob(aa, "11 1"), test[[1]]$est["0", "1", ]) [1] TRUE > all.equal(trprob(aa, "11 2"), test[[1]]$est["0", "2", ]) [1] TRUE > > all.equal(trprob(aa0, "11 1"), test.c[[1]]$est["0", "1", ]) [1] TRUE > all.equal(trprob(aa0, "11 2"), test.c[[1]]$est["0", "2", ]) [1] TRUE > > all.equal(trprob(aa1, "11 1"), test.c[[2]]$est["0", "1", ]) [1] TRUE > all.equal(trprob(aa1, "11 2"), test.c[[2]]$est["0", "2", ]) [1] TRUE > > test Call: etmCIF(formula = Surv(time, to != 0) ~ 1, data = dat.s, etype = to) time P se(P) n.event CIF 1 4.9088 0.809108 0.079680 45 CIF 2 4.9088 0.096618 0.032905 8 > > test.c Call: etmCIF(formula = Surv(time, to != 0) ~ cov, data = dat.s, etype = to) Covariate: cov levels: 0 1 cov = 0 time P se(P) n.event CIF 1 2.1708 0.70246 0.105797 19 CIF 2 2.1708 0.11144 0.053384 4 cov = 1 time P se(P) n.event CIF 1 4.9088 0.80787 0.094051 26 CIF 2 4.9088 0.08436 0.040769 4 > > summary(test) CIF 1 P time var lower upper n.risk n.event 0.01000 0.0092099 0.0000990 0.0014147 0.068863 100 1 0.11430 0.2663096 0.0010542 0.0649454 0.196993 81 1 0.23451 0.7303091 0.0020436 0.1591107 0.337736 54 1 0.40425 1.4299939 0.0032996 0.3020445 0.525741 29 1 0.54593 2.0647206 0.0040836 0.4269008 0.673605 16 1 0.80911 4.9087561 0.0063489 0.6359544 0.933733 2 1 CIF 2 P time var lower upper n.risk n.event 0.000000 0.0092099 0.00000000 0.000000 0.000000 100 0 0.031657 0.2663096 0.00032353 0.010320 0.094942 81 0 0.067029 0.7303091 0.00070366 0.030598 0.143503 54 0 0.096618 1.4299939 0.00108275 0.049082 0.185474 29 0 0.096618 2.0647206 0.00108275 0.049082 0.185474 16 0 0.096618 4.9087561 0.00108275 0.049082 0.185474 2 0 > summary(test.c) cov=0 CIF 1 P time var lower upper n.risk n.event 0.022222 0.0092099 0.00048285 0.0031605 0.14747 45 1 0.092222 0.2982439 0.00193603 0.0355971 0.22762 36 0 0.226684 0.7021938 0.00450954 0.1241760 0.39250 24 1 0.378128 1.4299939 0.00760870 0.2337884 0.57145 13 1 0.505736 1.6148774 0.00895330 0.3388425 0.69885 10 1 0.702465 2.1708375 0.01119294 0.4944890 0.88399 3 1 CIF 2 P time var lower upper n.risk n.event 0.000000 0.0092099 0.0000000 0.000000 0.00000 45 0 0.048441 0.2982439 0.0011168 0.012337 0.18013 36 1 0.076411 0.7021938 0.0018104 0.025202 0.21928 24 0 0.111440 1.4299939 0.0028499 0.042676 0.27392 13 0 0.111440 1.6148774 0.0028499 0.042676 0.27392 10 0 0.111440 2.1708375 0.0028499 0.042676 0.27392 3 0 cov=1 CIF 1 P time var lower upper n.risk n.event 0.018182 0.066692 0.00032457 0.0025813 0.12214 55 1 0.112392 0.263808 0.00187215 0.0520925 0.23333 45 1 0.241023 0.730309 0.00374499 0.1440057 0.38685 31 1 0.401201 1.066913 0.00570788 0.2714008 0.56421 19 1 0.592334 2.366275 0.00775985 0.4286230 0.76273 8 1 0.807871 4.908756 0.00884554 0.6023185 0.94771 2 1 CIF 2 P time var lower upper n.risk n.event 0.000000 0.066692 0.00000000 0.000000 0.00000 55 0 0.037434 0.263808 0.00067458 0.009494 0.14152 45 0 0.059341 0.730309 0.00111295 0.019447 0.17351 31 0 0.084360 1.066913 0.00166213 0.032211 0.21119 19 0 0.084360 2.366275 0.00166213 0.032211 0.21119 8 0 0.084360 4.908756 0.00166213 0.032211 0.21119 2 0 > > options(old) > > proc.time() user system elapsed 1.487 0.119 1.389 etm/src/0000755000176200001440000000000013725621640011634 5ustar liggesusersetm/src/init.c0000644000176200001440000000136613234166764012757 0ustar liggesusers#include #include #include // for NULL #include /* FIXME: Check these declarations against the C/Fortran source code. */ /* .Call calls */ extern SEXP cov_aj(SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP gen_msm(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP los_cp(SEXP, SEXP, SEXP); extern SEXP los_nocp(SEXP, SEXP, SEXP); static const R_CallMethodDef CallEntries[] = { {"cov_aj", (DL_FUNC) &cov_aj, 5}, {"gen_msm", (DL_FUNC) &gen_msm, 7}, {"los_cp", (DL_FUNC) &los_cp, 3}, {"los_nocp", (DL_FUNC) &los_nocp, 3}, {NULL, NULL, 0} }; void R_init_etm(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } etm/src/Makevars0000755000176200001440000000016113057751334013333 0ustar liggesusers## PKG_LIBS = $(LAPACK_LIBS) -lprofiler $(BLAS_LIBS) $(FLIBS) PKG_LIBS = $(LAPACK_LIBS) -g $(BLAS_LIBS) $(FLIBS) etm/src/gen_msm.cpp0000755000176200001440000000432113646546656014007 0ustar liggesusers// #define ARMA_NO_DEBUG #include // #include using namespace arma; cube prodint(const cube & dna, int nstate, int ltimes); cube deltaNA(const cube & nev, const mat & nrisk, int nstate, int ltimes); cube deltaNA_LY(const cube & nev, const mat & nrisk, const mat & which_compute, int nstate, int ltimes); RcppExport SEXP gen_msm(SEXP _times, SEXP _entry, SEXP _exit, SEXP _from, SEXP _to, SEXP _nstate, SEXP _const_modif) { Rcpp::NumericVector __entry(_entry), __exit(_exit), times(_times); Rcpp::IntegerVector __from(_from), __to(_to); Rcpp::IntegerMatrix __const_modif(_const_modif); // ProfilerStart("/tmp/gen_msm.prof"); vec entry(__entry.begin(), __entry.size(), false); vec exit(__exit.begin(), __exit.size(), false); ivec from(__from.begin(), __from.size(), false); ivec to(__to.begin(), __to.size(), false); imat const_modif(__const_modif.begin(), __const_modif.nrow(), __const_modif.ncol(), false); const int lt = times.size(); const int n = entry.size(); const int nstate = Rcpp::as(_nstate); // define the matrices we need mat y(lt, nstate, fill::zeros); cube nev(nstate, nstate, lt); nev.zeros(); cube dna(nstate, nstate, lt); dna.zeros(); for (int j = 0; j < n; ++j) { for (int i = 0; i < lt; ++i) { if (entry(j) < times(i) && exit(j) >= times(i)) { y(i, from(j) - 1) += 1; } if (exit(j) == times(i) && to(j) != 0) { nev(from(j) - 1, to(j) - 1, i) += 1; break; } } } // Rcpp::Rcout << "The value of y : \n" << y << "\n"; irowvec cc = const_modif.row(0); if (any(cc)) { umat tmp = (y >= const_modif); mat which_compute = conv_to::from(tmp); // Nelson-Aalen (the increments) Lai and Ying dna = deltaNA_LY(nev, y, which_compute, nstate, lt); } else { // Nelson-Aalen (the increments) original dna = deltaNA(nev, y, nstate, lt); } cube est = prodint(dna, nstate, lt); // ProfilerStop(); return Rcpp::List::create(Rcpp::Named("n.risk") = y, Rcpp::Named("n.event") = nev, Rcpp::Named("dna") = dna, Rcpp::Named("est") = est, Rcpp::Named("time") = times); } etm/src/cov_aj.cc0000755000176200001440000000316413321454505013407 0ustar liggesusers#include // #include using namespace arma; mat cov_dna(const mat & dna, const vec & nrisk, int d, int D); RcppExport SEXP cov_aj(SEXP __time, SEXP __est, SEXP __nrisk, SEXP __nevent, SEXP __dna) { Rcpp::NumericVector _time(__time), _est(__est), _nevent(__nevent), _dna(__dna); Rcpp::IntegerVector dims = _est.attr("dim"); Rcpp::NumericMatrix _nrisk(__nrisk); const int lt = _time.size(); const int nstate = dims(0); const int D = nstate * nstate; // to appease Solaris compiler cube est(_est.begin(), nstate, nstate, lt, false); cube nevent(_nevent.begin(), nstate, nstate, lt, false); cube dna(_dna.begin(), nstate, nstate, lt, false); mat nrisk(_nrisk.begin(), lt, nstate, false); vec time(_time.begin(), _time.size(), false); cube cov_etm(D, D, lt); cov_etm.zeros(); mat I(nstate, nstate, fill::eye); mat II(D, D, fill::eye); mat cov_deltaNA(D, D, fill::zeros); // first iteration cov_deltaNA = cov_dna(nevent.slice(0), nrisk.row(0).t(), nstate, D); cov_etm.slice(0) = II * cov_deltaNA * II; for (int t = 1; t < lt; ++t) { mat temp_dna(dna.slice(t).begin(), nstate, nstate, false); mat temp_est(est.slice(t - 1).begin(), nstate, nstate, false); cov_deltaNA = cov_dna(nevent.slice(t), nrisk.row(t).t(), nstate, D); cov_etm.slice(t) = kron((I + temp_dna).t(), I) * cov_etm.slice(t - 1) * kron((I+temp_dna),I) + kron(I, temp_est) * cov_deltaNA * kron(I, temp_est.t()); } return(Rcpp::wrap(cov_etm)); } etm/src/Makevars.win0000755000176200001440000000006112466106677014135 0ustar liggesusers PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) etm/src/utils.cpp0000755000176200001440000000743113057751334013512 0ustar liggesusers#include using namespace arma; vec my_diff(const vec bouh) { int lbouh = bouh.size(); vec res(lbouh - 1); res.zeros(); for (int i = 0; i < (lbouh - 1); ++i) { res[i] = bouh[i+1] - bouh[i]; } return res; } cube prodint(const cube & dna, int nstate, int ltimes) { cube aj(dna.begin(), nstate, nstate, ltimes); mat I = eye(nstate, nstate); aj.slice(0) = aj.slice(0) + I; for (int i = 1; i < ltimes; ++i) { aj.slice(i) = aj.slice(i-1) * (I + aj.slice(i)); } return aj; } cube deltaNA(const cube & nev, const mat & nrisk, int nstate, int ltimes) { cube dna(nstate, nstate, ltimes); dna.zeros(); for (int t=0; t < ltimes; ++t) { for (int i=0; i < nstate; ++i) { if (nrisk.at(t, i) != 0) { for (int j=0; j< nstate; ++j) { dna.at(i, j, t) = nev.at(i, j, t) / nrisk.at(t, i); } } } mat tmp(dna.slice(t).begin(), nstate, nstate, false); vec d = sum(tmp, 1); tmp.diag() = -d; } return dna; } /* lai and ying modification of the Nelson Aalen estimator. we have an extra argument: a matrix similar to nrisk, with 0s and 1s that says where we should compute */ cube deltaNA_LY(const cube & nev, const mat & nrisk, const mat & which_compute, int nstate, int ltimes) { cube dna(nstate, nstate, ltimes); dna.zeros(); for (int t=0; t < ltimes; ++t) { for (int i=0; i < nstate; ++i) { if (nrisk.at(t, i) != 0) { for (int j=0; j< nstate; ++j) { dna.at(i, j, t) = which_compute.at(t, i) * nev.at(i, j, t) / nrisk.at(t, i); } } } mat tmp(dna.slice(t).begin(), nstate, nstate, false); vec d = sum(tmp, 1); tmp.diag() = -d; } return dna; } mat cov_dna(const mat & nev, const vec & nrisk, int d, int D) { mat the_cov(D, D); the_cov.zeros(); uvec from(D); from.zeros(); uvec to(D); to.zeros(); // construct vectors that store the k and l; m, n for each // indice of the final covariance matrix for (int i = 0; i < d; ++i) { for (int j = 0; j < d; ++j) { from[j + i * d] = j; to[j + i * d] = i; } } vec sum_nev = sum(nev, 1); vec pow_nrisk = pow(nrisk, -3); for (int j = 0; j < D; ++j) { for (int i = 0; i < D; ++i) { if (nrisk[from[i]] != 0) { int cond = 1 * (from[i] == to[i] && from[i] == from[j] && from[j] == to[j]) + 2 * (from[i] == to[i] && from[i] == from[j] && from[i] != to[j]) + 4 * (from[i] == from[j] && from[i] != to[i] && from[i] != to[j] && to[i] == to[j]) + 8 * (from[i] == from[j] && from[i] != to[i] && from[i] != to[j] && to[i] != to[j]) + // add a condition for the symmetric of cond 2 16 * (from[j] == to[j] && from[i] == from[j] && from[i] != to[i]); switch(cond) { case 1: the_cov(i, j) = (nrisk[from[i]] - sum_nev[from[i]]) * sum_nev[from[i]] * pow_nrisk[from[i]]; break; case 2: the_cov(i, j) = -(nrisk[from[i]] - sum_nev[from[i]]) * nev(from[i], to[j]) * pow_nrisk[from[i]]; break; case 4: the_cov(i, j) = (nrisk[from[i]] - nev(from[i], to[i])) * nev(from[i], to[j]) * pow_nrisk[from[i]]; break; case 8: the_cov(i, j) = -nev(from[i], to[i]) * nev(from[i], to[j]) * pow_nrisk[from[i]]; break; case 16: the_cov(i, j) = -(nrisk[from[i]] - sum_nev[from[i]]) * nev(from[i], to[i]) * pow_nrisk[from[i]]; break; default: the_cov(i, j) = 0; } } } } // Alternative algorithm, just fill the lower triamgular part of the matrix. Then // "symmetrize the matrix // the_cov = the_cov + the_cov.t(); // the_cov.diag() /= 2; // Rcpp::Rcout << "cov_dna is" << std::endl << the_cov << std::endl; // Rcpp::Rcout << "cov_dna[2,5] is" << std::endl << the_cov(1, 4) << std::endl; return the_cov; } etm/src/los_etm.cpp0000755000176200001440000000724613057751334014020 0ustar liggesusers// diff start at .begin() + 1 #include // #include using namespace arma; vec my_diff(const vec bouh); /* Length of stay without competing outcomes */ RcppExport SEXP los_nocp(SEXP __times, SEXP __tr_mat, SEXP __tau) { Rcpp::NumericVector _times(__times), _tr_mat(__tr_mat); Rcpp::IntegerVector Dims = _tr_mat.attr("dim"); const double tau = Rcpp::as(__tau); const int lt = _times.size(); const int nstate = Dims[0]; cube tr_mat(_tr_mat.begin(), nstate, nstate, lt); vec times(_times.begin(), _times.size(), false); vec T(times); T.resize(lt+1); T[lt] = tau; // new stuffs we'll need mat::fixed<3, 3> I; I.eye(); cube aj(nstate, nstate, lt); for (int i = 0; i < lt; ++i) { tr_mat.slice(i) = tr_mat.slice(i) + I; aj.slice(i).eye(); } vec los0(lt), los1(lt), a00(lt), a11(lt), a01(lt); a00.zeros(); a01.zeros(); a11.zeros(); los0.fill(tau); los1.fill(tau); for (int t = (times.size() - 2); t >= 0; --t) { vec dd = my_diff(T(span(t+1, lt))); for (int j = t; j < lt; ++j) { aj.slice(j) = aj.slice(j) * tr_mat.slice(t+1); a00(j) = aj(0, 0, j); a01(j) = aj(0, 1, j); a11(j) = aj(1, 1, j); } colvec a = a00(span(t, lt - 2)) + a01(span(t, lt - 2)); colvec b = a11(span(t, lt - 2)); los0[t] = T[t+1] + as_scalar(dd.t() * a); los1[t] = T[t+1] + as_scalar(dd.t() * b); } return Rcpp::List::create(Rcpp::Named("los0") = los0, Rcpp::Named("los1") = los1); } /* Length of stay with competing outcomes */ RcppExport SEXP los_cp(SEXP __times, SEXP __tr_mat, SEXP __tau) { Rcpp::NumericVector _times(__times), _tr_mat(__tr_mat); Rcpp::IntegerVector Dims = _tr_mat.attr("dim"); const double tau = Rcpp::as(__tau); const int lt = _times.size(); const int nstate = Dims[0]; cube tr_mat(_tr_mat.begin(), nstate, nstate, lt); vec times(_times.begin(), _times.size(), false); vec T(times); T.resize(lt+1); T[lt] = tau; // new stuffs we'll need mat::fixed<4, 4> I; I.eye(); cube aj(nstate, nstate, lt); for (int i = 0; i < lt; ++i) { tr_mat.slice(i) = tr_mat.slice(i) + I; aj.slice(i).eye(); } vec los0(lt), los1(lt), a00(lt), a11(lt), a01(lt), a12(lt), a13(lt), phi2case(lt), phi2control(lt), phi3case(lt), phi3control(lt); a00.zeros(); a01.zeros(); a11.zeros(); phi2case.zeros(); phi2control.zeros(); phi3case.zeros(); phi3control.zeros(); los0.fill(tau); los1.fill(tau); for (int t = (times.size() - 2); t >= 0; --t) { vec dd = my_diff(T(span(t+1, lt))); for (int j = t; j < lt; ++j) { aj.slice(j) = tr_mat.slice(t+1) * aj.slice(j); a00(j) = aj(0, 0, j); a01(j) = aj(0, 1, j); a11(j) = aj(1, 1, j); a12(j) = aj(1, 2, j); a13(j) = aj(1, 3, j); } colvec a = a00(span(t, lt - 2)) + a01(span(t, lt - 2)); colvec b = a11(span(t, lt - 2)); colvec c = a12(span(t, lt - 2)); colvec d = a13(span(t, lt - 2)); los0[t] = T[t+1] + as_scalar(dd.t() * a); los1[t] = T[t+1] + as_scalar(dd.t() * b); phi2case[t] = T[lt - 1] * aj(1, 2, lt - 1) - as_scalar(dd.t() * c); phi3case[t] = T[lt - 1] * aj(1, 3, lt - 1) - as_scalar(dd.t() * d); phi2control[t] = aj(1, 2, lt - 1) * los0[t]; phi3control[t] = aj(1, 3, lt - 1) * los0[t]; } return Rcpp::List::create(Rcpp::Named("los0") = los0, Rcpp::Named("los1") = los1, Rcpp::Named("phi2control") = phi2control, Rcpp::Named("phi3control") = phi3control, Rcpp::Named("phi2case") = phi2case, Rcpp::Named("phi3case") = phi3case); } etm/vignettes/0000755000176200001440000000000013725621640013055 5ustar liggesusersetm/vignettes/etmCIF_tutorial.Rnw0000644000176200001440000002514213234163603016576 0ustar liggesusers%\VignetteIndexEntry{Computing Cumulative Incidence Functions with the etmCIF Function} \documentclass{article} \usepackage{amsmath, amssymb} \usepackage{graphicx} \usepackage{url} \usepackage[pdftex]{color} \usepackage[round]{natbib} \SweaveOpts{keep.source=TRUE,eps=FALSE} \title{Computing Cumulative Incidence Functions with the {\tt etmCIF} Function, with a view Towards Pregnancy Applications} \author{Arthur Allignol} \date{} \begin{document} \maketitle \section{Introduction} This paper documents the use of the {\tt etmCIF} function to compute the cumulative incidence function (CIF) in pregnancy data. \section{Data Example} The data set {\tt abortion}, included in the {\bf etm} package will be used to illustrate the computation of the CIFs. We first load the {\bf etm} package and the data set. <<>>= library(etm) library(survival) data(abortion) @ Briefly, the data set contains information on \Sexpr{nrow(abortion)} pregnant women collected prospectively by the Teratology Information Service of Berlin, Germany \citep{meister}. Among these pregnant women, \Sexpr{with(abortion, table(group)[2])} were exposed therapeutically to coumarin derivatives, a class of orally active anticoagulant, and \Sexpr{with(abortion, table(group)[1])} women served as controls. Coumarin derivatives are suspected to increase the number of spontaneous abortions. Competing events are elective abortion (ETOP) and life birth. Below is an excerpt of the data set <<>>= head(abortion) @ {\tt id} is the individual number, {\tt entry} is the gestational age at which the women entered the study, {\tt exit} is the gestational age at the end of pregnancy, {\tt group} is the group membership (0 for controls and 1 for the women exposed to coumarin derivatives) and {\tt cause} is the cause of end of pregnancy (1 for induced abortion, 2 for life birth and 3 for spontaneous abortion.) \section{Computing and plotting the CIFs} \subsection{The {\tt etmCIF} function} The CIFs are computed using the {\tt etmCIF} function. It is a wrapper around the {\tt etm} function, meant to facilitate the computation of the CIFs. {\tt etmCIF} takes as arguments \begin{itemize} \item {\tt formula}: A formula consisting of a {\tt Surv} object on the left of a {\tt ~} operator, and the group covariate on the right. A {\tt Surv} object is for example created this way: {\tt Surv(entry, exit, cause != 0)}. We need to specify the entry time ({\tt entry}), the gestational age at end of pregnancy ({\tt exit}), and an event indicator ({\tt cause != 0}). The latter means that any value different from 0 in {\tt cause} will be considered as an event -- which is the case in our example, as we don't have censoring. \item {\tt data}: A data set in which to interpret the terms of the formula. In our case, it will be {\tt abortion}. \item {\tt etype}: Competing risks event indicator. When the status indicator is 1 (or TRUE) in the formula, {\tt etype} describes the type of event, otherwise, for censored observation, the value of {\tt etype} is ignored. \item {\tt failcode}: Indicates the failure type of interest. Default is one. This option is only interesting for some features of the plot function. \end{itemize} \subsection{Estimation and display of the CIFs} We know compute the CIFs <<>>= cif.abortion <- etmCIF(Surv(entry, exit, cause != 0) ~ group, abortion, etype = cause, failcode = 3) cif.abortion @ Above is the display provided by the {\tt print} function. It gives, at the last event time, the probabilities ({\tt P}) standard errors ({\tt se(P)}), and the total number of events ({\tt n.event}) for the three possible pregnancy outcomes and for both groups. More information is provided by the {\tt summary} function. <<>>= s.cif.ab <- summary(cif.abortion) @ The function returns a list of data.frames that contain probabilities, variances, pointwise confidence intervals, number at risk and number of events for each event times. the {\tt print} function displays this information for some selected event times. <<>>= s.cif.ab @ \subsection{Plotting the CIFs} Interest lies in the CIFs of spontaneous abortion. We display them using the {\tt plot} function, which by default, plots only the the CIFs for the event of interest, i.e., the one specified in {\tt failcode}. \setkeys{Gin}{width=0.9\textwidth} \begin{figure}[!htb] \begin{center} <>= plot(cif.abortion) @ \caption{CIFs of spontaneous abortion for the controls (solid line) and the exposed (dashed line), using the default settings of the {\tt plot} function.} \end{center} \end{figure} \clearpage We now add confidence intervals taken at week 27, plus a bit of customisation. \setkeys{Gin}{width=0.9\textwidth} \begin{figure}[!htb] \begin{center} <>= plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.6), ci.type = "bars", pos.ci = 27, col = c(1, 2), ci.lwd = 6, lwd = 2, lty = 1, cex = 1.3) @ \caption{CIFs of spontaneous abortion for the controls (black) and the exposed (red), along with pointwise confidence intervals taken at week 27.} \end{center} \end{figure} \clearpage When the figure is to be in black and white, or when the confidence intervals are not as separated as in this example, it might be a good idea to shift slightly one of the bar representing the confidence interval, so that the two bars don't overlap. This might be done manipulating the {\tt pos.ci} argument: \setkeys{Gin}{width=0.9\textwidth} \begin{figure}[!htb] \begin{center} <>= plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.6), ci.type = "bars", pos.ci = c(27, 28), col = c(1, 1), ci.lwd = 6, lwd = 2, lty = c(2, 1), cex = 1.3) @ \caption{CIFs of spontaneous abortion for the controls (dashed line) and the exposed (solid line), along with pointwise confidence intervals.}\label{decalage} \end{center} \end{figure} \clearpage Pointwise confidence intervals can also be plotted for the whole follow-up period. \begin{figure}[!htb] \begin{center} <>= plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.5), ci.type = "pointwise", col = c(1, 2), lwd = 2, lty = 1, cex = 1.3) @ \caption{Same as the last pictures, except for the confidence intervals, that are displayed for the whole follow-up period.} \end{center} \end{figure} \clearpage CIFs for other pregnancy outcomes can also be plotted using the {\tt which.cif} arguments. For instance, for plotting the CIFs of ETOP and life birth on the same graph, we specify {\tt which.cif = c(1, 2)} in the call to {\tt plot}. \begin{figure}[!htb] \begin{center} <>= plot(cif.abortion, which.cif = c(1, 2), ylim = c(0, 0.8), lwd = 2, col = c(1, 1, 2, 2), lty = c(1, 2, 1, 2), legend = FALSE) legend(0, 0.8, c("Control", "Exposed"), col = c(1, 2), lty = 1, bty = "n", lwd = 2) legend(0, 0.7, c("ETOP", "Life Birth"), col = 1, lty = c(1, 2), bty = "n", lwd = 2) @ \end{center} \caption{CIFs of ETOP (solid lines) and life birth (dashed lines) for the exposed, in red, and the controls, in black.} \end{figure} \clearpage \subsection{Some More Features} \paragraph{Competing event names} For those who don't like using plain numbers for naming the competing events or the group allocation, it is of course possible to give more informative names, either as factors or character vectors. For instance, we define a new group variable that takes value {\tt 'control'} or {\tt 'exposed'}, and we give more informative names for the pregnancy outcomes. <<>>= abortion$status <- with(abortion, ifelse(cause == 2, "life birth", ifelse(cause == 1, "ETOP", "spontaneous abortion"))) abortion$status <- factor(abortion$status) abortion$treat <- with(abortion, ifelse(group == 0, "control", "exposed")) abortion$treat <- factor(abortion$treat) @ We can compute the CIFs as before, taking care of changing the {\tt failcode} argument. <<>>= new.cif <- etmCIF(Surv(entry, exit, status != 0) ~ treat, abortion, etype = status, failcode = "spontaneous abortion") new.cif @ The {\tt summary} and {\tt plot} functions will work as before, except for a more informative outcome from scratch. \paragraph{Taking advantage of the miscellaneous functions defined for {\tt etm} objects} The {\tt etmCIF} function uses the more general {\tt etm} machinery for computing the CIFs. Thus the returned {\tt etmCIF} object is for part a list of {\tt etm} objects (one for each covariate level). It is therefore relatively easy to use the methods defined for {\tt etm} on {\tt etmCIF} objects. An example would be to use the {\tt trprob} function to extract the CIF of spontaneous abortion for the controls. This function takes as arguments an {\tt etm} object, the transition we are interested in, in the form ``from to'' (the state a patient comes from is automatically defined as being 0 in {\tt etmCIF}), and possibly some time points. Using {\tt new.cif} from the example above: <<>>= trprob(new.cif[[1]], "0 spontaneous abortion", c(1, 10, 27)) @ We applied the {\tt trprob} function to the {\tt etm} object for the controls (which is in the first item of the output, for the exposed in the second). The transition of interest is from {\tt 0} to {\tt spontaneous abortion}, and we want the CIF at weeks 1, 10 and 27 (just put nothing if you want the CIF for all time points). Another example would be to use the {\tt lines} function to add a CIF to an existing plot. The following code snippet adds the CIF of ETOP for the exposed to Figure \ref{decalage}. That's the {\tt tr.choice} arguments that defines which CIF to pick. It works in the same way as in the {\tt trprob} function. <>= lines(cif.abortion[[2]], tr.choice = "0 1", col = 2, lwd = 2) @ \setkeys{Gin}{width=0.9\textwidth} \begin{figure}[!htb] \begin{center} <>= plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.6), ci.type = "bars", pos.ci = c(27, 28), col = c(1, 1), ci.lwd = 6, lwd = 2, lty = c(2, 1), cex = 1.3) lines(cif.abortion[[2]], tr.choice = "0 1", col = 2, lwd = 2) @ \caption{Figure \ref{decalage} along with the CIF of ETOP for the exposed in red.} \end{center} \end{figure} \clearpage \begin{thebibliography}{1} \bibitem[Meister and Schaefer, 2008]{meister} Meister, R. and Schaefer, C. (2008). \newblock Statistical methods for estimating the probability of spontaneous abortion in observational studies--analyzing pregnancies exposed to coumarin derivatives. \newblock {\em Reproductive Toxicology}, 26(1):31--35. \end{thebibliography} \end{document} etm/R/0000755000176200001440000000000013723751627011255 5ustar liggesusersetm/R/zzz.R0000755000176200001440000000131213057751334012230 0ustar liggesusers##################################################################### ### Some stuffs that have to be somewhere ### Arthur Allignol ##################################################################### utils::globalVariables(c("entry", "exit", "from", "to", "id", "idd", "masque", "entree", "Haz", "time", "V1", "dhaz"), package = "etm") etm/R/pseudo_clos.R0000755000176200001440000001112013723751351013707 0ustar liggesusers##################################################################### ### Pseudo values for excess LoS ### Arthur Allignol ##################################################################### closPseudo <- function(data, state.names, tra, cens.name, s = 0, formula, na.action, aw = FALSE, ratio = FALSE, ncores = 1, trick_ties= FALSE) { stopifnot("data.frame" %in% class(data)) data <- data.table(data) ## take care of the formula argument call <- match.call() m <- match.call(expand.dots = FALSE) temp <- c("", "formula", "data", "id", "subset", "na.action") m <- m[match(temp, names(m), nomatch = 0)] Terms <- if (missing(data)) terms(formula) else terms(formula, data = data) m$formula <- Terms m[[1]] <- as.name("model.frame") m <- eval(m, parent.frame()) m <- data.table(cbind(id = data$id, m)) n <- length(unique(data[, id])) ### get a minimal data set for computing the pseudo values reg <- names(data) names_msm <- intersect(c("id", "entry", "exit", "time", "from", "to"), reg) dat_clos <- data[, names_msm, with = FALSE] ## theta. From there we will see what kind of model it is ## is no alternative weights, NULL ## No competing risks: not in the list theta <- unlist(etm::clos(etm::etm(dat_clos, state.names = state.names, tra = tra, cens.name = cens.name, s = 0, covariance = FALSE), aw = aw, ratio = ratio)[c("e.phi", "e.phi.weights.1", "e.phi.weights.other", "e.phi2", "e.phi3")]) competing <- "e.phi2" %in% names(theta) ## Compute pseudo values, and store results depending of competing ## and aw namen <- c("ps.e.phi", "ps.e.phi.weights.1", "ps.e.phi.weights.other", "ps.e.phi2", "ps.e.phi3") if (trick_ties) { ## we want to find all patients that have the same "dynamic" ## and get id's of some of them to compute PS make_cat <- function(entry, exit, from, to) { if (length(from) == 1) { cat <- paste(entry, exit, from, to, sep = "_") } else { cat <- paste(entry[1], exit[1], from[1], to[1], entry[2], exit[2], from[2], to[2], sep = "_") } list(categs = cat) } cat_dyn <- dat_clos[, make_cat(entry, exit, from, to), by = "id"] cat_dyn_red <- unique(data.table(cat_dyn, key = "categs")) ids <- cat_dyn_red[, id] } else { ids <- unique(data$id) } psMatrix <- parallel::mclapply(seq_along(ids), function(i) { temp <- clos(etm(dat_clos[!(id %in% ids[i])], state.names = state.names, tra = tra, cens.name = cens.name, s = 0, covariance = FALSE), aw = aw, ratio = ratio) data.table(cbind(temp$e.phi, temp$e.phi.weights.1, temp$e.phi.weights.other, temp$e.phi2, temp$e.phi3)) }, mc.cores = ncores) psMatrix <- rbindlist(psMatrix) psMatrix <- lapply(seq_along(psMatrix), function(i) { n * theta[i] - (n - 1) * psMatrix[, i, with = FALSE] }) psMatrix <- do.call(cbind, psMatrix) setnames(psMatrix, namen[c(TRUE, aw, aw, competing, competing)]) ## if trick, we need to merge intelligently if (trick_ties) { bouh <- cbind(cat_dyn_red, psMatrix) setkeyv(cat_dyn, "categs") psMatrix <- merge(bouh, cat_dyn, by = "categs", all.y = TRUE) psMatrix <- psMatrix[, c("id.y", namen[c(TRUE, aw, aw, competing, competing)]), with = FALSE] setnames(psMatrix, c("id", colnames(psMatrix)[-1])) setkeyv(psMatrix, "id") } else { psMatrix <- data.frame(ids, psMatrix, stringsAsFactors=TRUE) names(psMatrix) <- c("id", names(psMatrix)[-1]) } cov <- unique(data.table(m, key = "id")) theta <- matrix(theta, nrow = 1) colnames(theta) <- c("e.phi", "e.phi.weights.1", "e.phi.weights.other", "e.phi2", "e.phi3")[c(TRUE, aw, aw, competing, competing)] pseudoData <- merge(psMatrix, cov) zzz <- list(pseudoData = pseudoData, theta = theta, aw = aw, call = call) class(zzz) <- "closPseudo" zzz } etm/R/lines.etm.R0000755000176200001440000000433613233437357013304 0ustar liggesuserslines.etm <- function(x, tr.choice, col = 1, lty, conf.int = FALSE, level = 0.95, ci.fun = "linear", ci.col = col, ci.lty = 3, ...) { if (!inherits(x, "etm")) { stop("'x' must be of class 'etm'") } is_stratified <- !is.null(x$strata) ufrom <- unique(x$trans$from) uto <- unique(x$trans$to) absorb <- setdiff(uto, ufrom) nam1 <- dimnames(x$est)[[1]] nam2 <- dimnames(x$est)[[2]] pos <- c(paste(nam1[!(nam1 %in% as.character(absorb))], nam2[!(nam2 %in% as.character(absorb))]), paste(x$trans$from, x$trans$to)) if (missing(tr.choice)) { if (is_stratified) { tr.choice <- pos[1] } else { tr.choice <- pos } } ref <- sapply(1:length(x$state.names), function(i) { paste(x$state.names, x$state.names[i]) }) ref <- matrix(ref) if (sum(tr.choice %in% ref == FALSE) > 0) stop("Argument 'tr.choice' and possible transitions must match") if (is_stratified) { lstrat <- length(x$strata) temp <- lapply(seq_len(lstrat), function(i) { tmp <- ci.transfo(x[[i]], tr.choice, level, ci.fun) tmp2 <- lapply(tmp, cbind, strata = x$strata[[i]]) tmp2 }) temp <- do.call(c, temp) } else { temp <- ci.transfo(x, tr.choice, level, ci.fun) } lt <- length(temp) if (missing(lty)) { lty <- seq_len(lt) } else if (length(lty) < lt) { lty <- lty * rep(1, lt) } if (length(col) < lt) col <- col * rep(1, lt) for (i in seq_len(lt)) { lines(temp[[i]]$time, temp[[i]]$P, type = "s", col = col[i], lty = lty[i], ...) } if (conf.int && !is.null(x$cov)) { if (length(ci.col) < lt) ci.col <- ci.col * rep(1, lt) if (length(ci.lty) < lt) ci.lty <- ci.lty * rep(1, lt) for (i in seq_len(lt)) { lines(temp[[i]]$time, temp[[i]]$lower, type = "s", col = ci.col[i], lty = ci.lty[i], ...) lines(temp[[i]]$time, temp[[i]]$upper, type = "s", col = ci.col[i], lty = ci.lty[i], ...) } } invisible() } etm/R/summary.etmCIF.R0000755000176200001440000000233213233712221014165 0ustar liggesusers### Summary function for etmCIF objects summary.etmCIF <- function(object, ci.fun = "cloglog", level = 0.95, ...) { if (!inherits(object, "etmCIF")) { stop("'object' must be of class 'etmCIF'") } l.X <- ncol(object$X) l.trans <- nrow(object[[1]]$trans) temp <- lapply(object[seq_len(l.X)], function(ll) { aa <- summary(ll, ci.fun = ci.fun, level = level, ...)[seq_len(l.trans) + 1] names(aa) <- paste("CIF ", sapply(strsplit(sub("\\s", "|", names(aa)[1:l.trans]), "\\|"), "[", 2), sep = "") aa }) class(temp) <- "summary.etmCIF" temp } ### ... and the print function print.summary.etmCIF <- function(x, ...) { if (!inherits(x, "summary.etmCIF")) { stop("'x' must be of class 'summary.etmCIF'") } for (i in seq_along(x)) { cat("\n\t", names(x)[i], "\n\n") time <- x[[i]][[1]]$time qtime <- quantile(time, probs = c(0, 0.25, 0.5, 0.75, 0.9, 1)) ind <- findInterval(qtime, time) for (j in seq_along(x[[i]])) { cat(names(x[[i]][j]), "\n") print(x[[i]][[j]][ind, ], row.names = FALSE) cat("\n") } } invisible() } etm/R/clos.R0000755000176200001440000001011513723751545012340 0ustar liggesusers### Expected change of LoS ### Arthur Allignol ##################################################################### clos <- function(x, aw, ratio, ...) { UseMethod("clos") } clos.etm <- function(x, aw = FALSE, ratio = FALSE, ...) { if (!inherits(x, "etm")) { stop("'x' must be an 'etm' object") } if (is.null(x$delta.na)) { stop("Needs the increment of the Nelson-Aalen estimator") } if (!is.null(x$strata)) stop("'clos' is not yet implemented for etm objects with strata. Please use e.g., 'clos(etm_object_name[1]'") ## test if we have an illness-death model dims <- dim(x$est) comp.risk <- FALSE if (dims[1] == 4) comp.risk <- TRUE ## I <- diag(1, dims[1]) ## tr.mat <- array(apply(x$delta.na, 3, "+", I), dim = dims) if (comp.risk) { res <- clos.cp(x, aw, ratio) ## stop("not yet") } else res <- clos.nocp(x, aw, ratio) class(res) <- "clos.etm" res } clos.msfit <- function(x, aw = FALSE, ratio = FALSE, cox_model, ...) { if (!inherits(x, "msfit")) { stop("'x' must be an 'msfit' object") } if (missing(cox_model)) { stop("cox model fit is missing") } ## CumHaz <- dplyr::group_by(x$Haz, trans) ## CumHaz <- dplyr::mutate(CumHaz, dhaz = diff(c(0, Haz))) CumHaz <- data.table(x$Haz) CumHaz[, dhaz := diff(c(0, Haz)), by = trans] trans <- x$trans[!is.na(x$trans)] ltrans <- dim(x$trans) ltimes <- unique(CumHaz[, length(time), by = trans][, V1]) times <- sort(unique(CumHaz$time)) dna <- nev <- array(0, dim = c(ltrans[1], ltrans[1], ltimes)) nrisk <- matrix(0, nrow = ltimes, ncol = ltrans[1]) ## Take care of the cox model and do the transformations in the ## same loop temp_surv <- survival::survfit(cox_model) dat_surv <- data.frame(time = temp_surv$time, n.risk = temp_surv$n.risk, n.event = temp_surv$n.event, trans = rep(trans, temp_surv$strata), stringsAsFactors=TRUE) for (i in trans) { aa <- which(x$trans == i, arr.ind = TRUE) dna[aa[1], aa[2], ] <- CumHaz$dhaz[CumHaz$trans == i] ## fill nev and nrisk dat_temp <- dat_surv[dat_surv$trans == i, ] ind <- findInterval(times, dat_temp$time) place <- which(ind != 0) tmp <- integer(ltimes) tmp <- cumsum(dat_temp$n.event)[ind] nev[aa[1], aa[2], place] <- c(tmp[1], diff(tmp)) nrisk[place, aa[1]] <- dat_temp$n.risk[ind] tt <- nrisk[2:ltimes, aa[1]] - nev[aa[1], aa[2], 1:(ltimes-1)] if (!all((tt == 0) == FALSE)) { uu <- max(times[tt == 0]) if (uu < max(times)) { vv <- which(times == uu) nrisk[(vv + 1):nrow(nrisk), aa[1]] <- 0 } } } ## Ugly risk set fix for illness-death models where nobody starts ## in state 1 at time 0 ind <- which(nrisk[, 2] != 0)[1] dni <- which(nev[1, 2, ] != 0)[1] if ((ind - 1) > dni) { nrisk[(dni + 1):(ind - 1), 2] <- cumsum(nev[1, 2, dni:(ind - 2)]) } ii <- seq_len(ltrans[1]) for (i in seq_along(times)) { dna[cbind(ii, ii, i)] <- -(.rowSums(dna[, , i], ltrans[1], ltrans[1], FALSE)) } ## Need to compute AJ (again) which.compute <- rep(1, ltimes) first <- 1; last <- ltimes est <- prodint(dna, times, first, last, which.compute) comp.risk <- FALSE if (ltrans[1] == 4) comp.risk <- TRUE ## I <- diag(1, ltrans[1]) ## tr.mat <- array(apply(dna, 3, "+", I), dim = c(ltrans, ltimes)) d_tmp <- data.frame(exit = cox_model$y[, 2]) zzz <- list(est = est$est, delta.na = dna, time = est$time, n.event = nev, n.risk = nrisk[, 1:2], ## dirty. but these should be illness-death models data = d_tmp ) if (comp.risk) { stop("'clos.msfit' is not yet implemented with competing risks") } else res <- clos.nocp(zzz, aw, ratio) class(res) <- "clos.etm" res } etm/R/print.etmCIF.R0000755000176200001440000000225513135646703013644 0ustar liggesusers### Print Method for cif.etm objects print.etmCIF <- function(x, ...) { if (!inherits(x, "etmCIF")) { stop("'x' must be of class 'etmCIF'") } cat("Call: "); dput(x$call); cat("\n") if (ncol(x$X) > 1) { cat("Covariate: ", rownames(x$X), "\n") cat("\tlevels: ", x$X, "\n\n") } l.trans <- nrow(x[[1]]$trans) l.x <- length(x$X) zzz <- lapply(seq_len(l.x), function(i) { temp <- summary(x[[i]])[-1] mat <- matrix(0, ncol = 4, nrow = l.trans) for (j in seq_len(l.trans)) { n.temp <- nrow(temp[[j]]) mat[j, 1] <- temp[[j]][n.temp, "time"] mat[j, 2] <- temp[[j]][n.temp, "P"] mat[j, 3] <- sqrt(temp[[j]][n.temp, "var"]) mat[j, 4] <- sum(temp[[j]][, "n.event"]) } rownames(mat) <- paste("CIF ", sapply(strsplit(sub("\\s", "|", names(temp)[1:l.trans]), "\\|"), "[", 2), sep = "") colnames(mat) <- c("time", "P", "se(P)", "n.event") if (ncol(x$X) > 1) { cat("\n", paste(rownames(x$X), " = ", x$X[i], sep = ""), "\n") } print(mat) }) invisible() } etm/R/ci.transfo.R0000755000176200001440000000471513723751627013460 0ustar liggesuserssans.cov <- function(i, object, trs.sep) { P <- object$est[trs.sep[i, 1], trs.sep[i, 2], ] time <- object$time n.event <- object$n.event[trs.sep[i, 1], trs.sep[i, 2], ] n.risk <- object$n.risk[, trs.sep[i, 1]] data.frame(P, time, n.risk, n.event, stringsAsFactors=TRUE) } avec.cov <- function(i, object, transfo, trs.sep, trs, level) { P <- object$est[trs.sep[i, 1], trs.sep[i, 2], ] time <- object$time n.event <- object$n.event[trs.sep[i, 1], trs.sep[i, 2], ] n.risk <- object$n.risk[, trs.sep[i, 1]] var <- object$cov[trs[[i]], trs[[i]], ] alpha <- qnorm(level + (1 - level) / 2) switch(transfo[i], "linear" = { lower <- P - alpha * sqrt(var) upper <- P + alpha * sqrt(var) }, "log" = { lower <- exp(log(P) - alpha * sqrt(var) / P) upper <- exp(log(P) + alpha * sqrt(var) / P) }, "cloglog" = { lower <- 1 - (1 - P)^(exp(alpha * (sqrt(var) / ((1 - P) * log(1 - P))))) upper <- 1 - (1 - P)^(exp(-alpha * (sqrt(var) / ((1 - P) * log(1 - P))))) }, "log-log" = { lower <- P^(exp(-alpha * (sqrt(var) / (P * log(P))))) upper <- P^(exp(alpha * (sqrt(var) / (P * log(P))))) }) lower <- pmax(lower, 0) upper <- pmin(upper, 1) data.frame(P, time, var, lower, upper, n.risk, n.event, stringsAsFactors=TRUE) } ## Should be used without strata (Give it single etm object) ci.transfo <- function(object, tr.choice, level = 0.95, transfo = "linear") { lt <- length(tr.choice) trs <- tr.choice trs.sep <- lapply(trs, strsplit, split = " ") ## Fixing separation of states with names including a space for (i in seq_along(trs.sep)) { if (length(trs.sep[[i]][[1]]) == 2) { next } else { tt <- charmatch(trs.sep[[i]][[1]], object$state.names, nomatch = 0) trs.sep[[i]][[1]] <- object$state.names[tt] } } trs.sep <- matrix(unlist(trs.sep), length(trs.sep), 2, byrow = TRUE) if (length(transfo) != lt) transfo <- rep(transfo[1], lt) if (is.null(object$cov)) { res <- lapply(seq_len(lt), sans.cov, object = object, trs.sep = trs.sep) } else { res <- lapply(seq_len(lt), avec.cov, object = object, transfo = transfo, trs.sep = trs.sep, trs = trs, level = level) } names(res) <- tr.choice res } etm/R/clos_pure.R0000755000176200001440000001654313057751334013402 0ustar liggesusersclos_pure <- function(x, aw = FALSE) { if (!inherits(x, "etm")) { stop("'x' must be an 'etm' object") } if (is.null(x$delta.na)) { stop("Needs the increment of the Nelson-Aalen estimator") } absorb <- setdiff(levels(x$trans$to), levels(x$trans$from)) transient <- unique(x$state.names[!(x$state.names %in% absorb)]) if (!(length(transient) == 2 && length(absorb) %in% c(1, 2))) stop("The multistate model must have 2 transient states \n and 1 or 2 absorbing states") dims <- dim(x$est) comp.risk <- FALSE if (dims[1] == 4) comp.risk <- TRUE I <- diag(1, dims[1]) tr.mat <- array(apply(x$delta.na, 3, "+", I), dim = dims) #tr.mat <- x$delta.na if (comp.risk) { res <- clos.cp(x, tr.mat, aw) } else res <- clos.nocp(x, tr.mat, aw) class(res) <- "clos.etm" res } clos.cp_pure <- function(x, tr.mat, aw) { dims <- dim(x$est) times <- if (sum(x$n.event[, , dims[3]]) != 0) x$time else x$time[-length(x$time)] los <- matrix(rep(times, 3), ncol = 3, byrow = FALSE) phi2 <- phi3 <- matrix(0, nrow(los), 3) phi2[, 1] <- times; phi3[, 1] <- times lt <- length(times) tau <- max(times) los[length(times)-1, 2:3] <- rep(tau, 2) aj <- array(NA, c(4, 4, 1)) aj[, , 1] <- diag(1, 4, 4) funn <- function(x, y) { x %*% aj[ , , y] } for (i in (lt - 2):1) { diffs <- diff(times[(i + 1):length(times)]) mat <- tr.mat[ , , length(x$time[x$time <= times[i + 1]])] aj <- array(apply(X = diag(1:dim(aj)[3]), 1, funn, x = mat), c(4, 4, dim(aj)[3])) los[i, 3] <- times[i + 1] + matrix(diffs, nrow=1) %*% matrix(aj[2, 2, ], ncol = 1) los[i, 2] <- times[i + 1] + matrix(diffs, nrow=1) %*% matrix((aj[1, 1, ] + aj[1, 2, ]),ncol=1) phi2[i, 2] <- aj[2, 3, dim(aj)[3]] * los[i, 3] aj <- array(c(diag(1, 4, 4), aj), c(4, 4, (dim(aj)[3] + 1))) } ## phi2[, 3] <- out$phi2case; phi2[, 2] <- out$phi2control ## phi3[, 3] <- out$phi3case; phi3[, 2] <- out$phi3control indi <- apply(x$n.event, 3, function(x) {sum(x[1, ]) != 0}) wait.times <- x$time[indi] wait.prob <- x$est["0", "0", ][indi] my.weights <- diff(c(0, 1 - wait.prob)) pp <- x$n.risk[-1, ] ev.last <- apply(x$n.event[, , dims[3]], 1, sum)[1:2] pp <- rbind(pp, pp[nrow(pp), ] - ev.last) filtre <- pp[, 1] <= 0 | pp[, 2] <= 0 tmp <- list(los)#, phi2, phi3) estimates <- lapply(tmp, function(z) { ldiff <- z[, 3] - z[, 2] ldiff[filtre] <- 0 estimate <- matrix(ldiff[is.element(z[, 1], wait.times)], nrow = 1) %*% matrix(my.weights, ncol=1) estimate }) e.phi.w1 <- e.phi.w23 <- my.weights1 <- my.weights23 <- NULL if (aw) { cif1 <- cumsum(c(1, x$est["0", "0", 1:(dims[3] - 1)]) * tr.mat[1, 2, ]) my.weights1 <- diff(c(0, cif1[indi])) / cif1[length(cif1)] cif23 <- cumsum(c(1, x$est["0", "0", 1:(dims[3] - 1)]) * (tr.mat[1, 3, ] + tr.mat[1, 4, ])) my.weights23 <- diff(c(0, cif23[indi])) / cif23[length(cif23)] weights.aw <- list(my.weights1, my.weights23) estimates.aw <- lapply(weights.aw, function(z) { ldiff <- los[, 3] - los[, 2] ldiff[filtre] <- 0 estimate <- matrix(ldiff[is.element(los[, 1], wait.times)], nrow = 1) %*% matrix(z, ncol = 1) estimate }) e.phi.w1 <- estimates.aw[[1]] e.phi.w23 <- estimates.aw[[2]] } res <- list(e.phi = estimates[[1]], phi.case = los[, 3], phi.control = los[, 2], ## e.phi2 = estimates[[2]], ## phi2.case = phi2[, 3] ## phi2.control = phi2[, 2] ## e.phi3 = estimates[[3]], phi3.case = phi3[, 3], ## phi3.control = phi3[, 2], weights = my.weights, w.time = wait.times, time = x$time, e.phi.weights.1 = e.phi.w1, e.phi.weights.other = e.phi.w23, weights.1 = my.weights1, weights.other = my.weights23) res } clos.nocp_pure <- function(x, tr.mat, aw) { dims <- dim(x$est) times <- if (sum(x$n.event[, , dims[3]]) != 0) x$time else x$time[-length(x$time)] los <- matrix(rep(times, 3), ncol = 3, byrow = FALSE) lt <- length(times) tau <- max(times) los[length(times)-1, 2:3] <- rep(tau, 2) aj <- array(NA, c(3, 3, 1)) aj[, , 1] <- diag(1, 3, 3) funn <- function(x, y) { x %*% aj[ , , y] } for (i in (lt - 2):1) { print(i) diffs <- diff(times[(i + 1):length(times)]) mat <- tr.mat[ , , length(x$time[x$time <= times[i + 1]])] aj <- array(apply(X = diag(1:dim(aj)[3]), 1, funn, x = mat), c(3, 3, dim(aj)[3])) los[, 3][i] <- times[i + 1] + matrix(diffs, nrow=1) %*% matrix(aj[2, 2, ], ncol = 1) los[, 2][i] <- times[i + 1] + matrix(diffs, nrow=1) %*% matrix((aj[1, 1, ] + aj[1,2,]),ncol=1) aj <- array(c(diag(1, 3, 3), aj), c(3, 3, (dim(aj)[3] + 1))) } pp <- x$n.risk[-1, ] ev.last <- apply(x$n.event[, , dims[3]], 1, sum)[1:2] pp <- rbind(pp, pp[nrow(pp), ] - ev.last) filtre <- pp[, 1] <= 0 | pp[, 2] <= 0 indi <- apply(x$n.event, 3, function(x) {sum(x[1, ]) != 0}) wait.times <- x$time[indi] wait.prob <- x$est["0", "0", ][indi] los.diff <- los[, 3] - los[, 2] los.diff[filtre] <- 0 my.weights <- diff(c(0, 1 - wait.prob)) estimate <- matrix(los.diff[is.element(los[, 1], wait.times)], nrow = 1) %*% matrix(my.weights, ncol=1) e.phi.w1 <- e.phi.w2 <- my.weights1 <- my.weights2 <- NULL if (aw) { cif1 <- cumsum(c(1, x$est["0", "0", 1:(dims[3] - 1)]) * tr.mat[1, 2, ]) my.weights1 <- diff(c(0, cif1[indi])) / cif1[length(cif1)] cif2 <- cumsum(c(1, x$est["0", "0", 1:(dims[3] - 1)]) * tr.mat[1, 3, ]) my.weights2 <- diff(c(0, cif2[indi])) / cif2[length(cif2)] weights.aw <- list(my.weights1, my.weights2) estimates.aw <- lapply(weights.aw, function(z) { ldiff <- los[, 3] - los[, 2] ldiff[filtre] <- 0 estimate <- matrix(ldiff[is.element(los[, 1], wait.times)], nrow = 1) %*% matrix(z, ncol = 1) estimate }) e.phi.w1 <- estimates.aw[[1]] e.phi.w2 <- estimates.aw[[2]] } res <- list(e.phi = estimate[[1]], phi.case = los[, 3], phi.control = los[, 2], weights = my.weights, w.time = wait.times, time = x$time, e.phi.weights.1 = e.phi.w1, e.phi.weights.other = e.phi.w2, weights.1 = my.weights1, weights.other = my.weights2, aj = aj) res } boot.clos <- function(data, state.names, tra, cens.name, s = 0, nboot) { res <- double(nboot) for (i in seq_len(nboot)) { index <- sample(unique(data$id), replace = TRUE) inds <- new.id <- NULL for (j in seq_along(index)){ ind <- which(data$id == index[j]) new.id <- c(new.id, rep(j, length(ind))) inds <- c(inds, ind) } dboot <- cbind(data[inds, ], new.id) dboot[, which(names(dboot) == "id")] dboot$id <- dboot$new.id tr.prob <- etm(dboot, state.names, tra, cens.name, s, cova = FALSE) res[i] <- clos(tr.prob)$e.phi } res } etm/R/summary.etm.R0000755000176200001440000000613013647146711013661 0ustar liggesusersfind_times <- function(d, timepoints) { ind <- findInterval(timepoints, d$time) ind0 <- sum(ind == 0) dd <- d[ind, ] if (ind0 > 0) { tmp <- d[1, , drop = FALSE] tmp$P <- round(tmp$P) tmp$var <- 0 tmp$lower <- tmp$upper <- tmp$P tmp$n.event <- 0 for (i in seq_len(ind0)) dd <- rbind(tmp, dd) } dd$time <- timepoints dd$n.event <- cumsum(dd$n.event) dd } summary.etm <- function(object, tr.choice, ci.fun = "linear", level = 0.95, times, ...) { if (!inherits(object, "etm")) stop("'object' must be of class 'etm'") if (level <= 0 | level > 1) { stop ("'level' must be between 0 and 1") } ref <- c("linear", "log", "cloglog", "log-log") if (sum(ci.fun %in% ref == FALSE) != 0) { stop("'ci.fun' is not correct. See help page") } ## Number of strata. Will be computed in this if condition ns <- 1 if (!is.null(object$strata_variable)) { ns <- length(object$strata) time <- unique(sapply(1:ns, function(i) { object[[i]]$time })) } else { time <- object$time } ## If no event time between s and t, don't need a summary if (is.null(time)) stop("no event time") ## Derive the transition names we need if (missing(tr.choice)) { if (!is.null(object$strata_variable)) { indi <- lapply(1:ns, function(i) { !apply(object[[i]]$est != 0, c(1, 2), function(temp){all(temp == FALSE)}) }) indi <- do.call("+", indi) > 0 } else { ind <- object$est != 0 indi <- !apply(ind, c(1, 2), function(temp){all(temp == FALSE)}) } tmp <- which(indi, arr.ind = TRUE) tmp <- tmp[order(tmp[, 1]), ] namen <- list(rownames(indi), colnames(indi)) trs <- lapply(seq_len(NROW(tmp)), function(i) { paste(namen[[1]][tmp[i, 1]], namen[[2]][tmp[i, 2]], sep = " ") }) trs <- cbind(trs) absorb <- setdiff(as.character(object$tran$to), as.character(object$trans$from)) for (i in seq_along(absorb)) trs <- trs[-grep(paste("^", absorb[i], sep =""), trs, perl = TRUE)] } else { ref <- sapply(1:length(object$state.names), function(i) { paste(object$state.names, object$state.names[i]) }) ref <- matrix(ref) if (sum(tr.choice %in% ref == FALSE) > 0) stop("Argument 'tr.choice' and possible transitions must match") trs <- tr.choice } not_missing <- !missing(times) if (ns > 1) { res <- lapply(seq_len(ns), function(i) { tmp <- ci.transfo(object[[i]], trs, level, ci.fun) if (not_missing) tmp <- lapply(tmp, find_times, timepoints = times) class(tmp) <- "summary.etm" tmp }) names(res) <- object$strata class(res) <- "summary.etm" } else { res <- ci.transfo(object, trs, level, ci.fun) if (not_missing) res <- lapply(res, find_times, timepoints = times) class(res) <- "summary.etm" } res } etm/R/print.etm.R0000755000176200001440000000666613647151527013337 0ustar liggesusersprint.etm <- function(x, covariance = FALSE, whole = TRUE, ...) { if (!inherits(x, "etm")) stop("'x' must be of class 'etm'") absorb <- setdiff(as.character(x$trans$to), as.character(x$trans$from)) transient <- unique(x$state.names[!(x$state.names %in% absorb)]) cat(paste("Multistate model with", length(transient), "transient state(s)\n", "and", length(absorb), "absorbing state(s)\n\n", sep = " ")) cat("Possible transitions:\n") print(x$trans, row.names = FALSE) cat("\n") if (is.null(x$strata)) { cat(paste("Estimate of P(", x$s, ", ", x$t, ")\n", sep = "")) print(x$est[, , dim(x$est)[3]]); cat("\n") if (!is.null(x$cov) & covariance == TRUE) { if (whole) { cat(paste("Estimate of cov(P(", x$s, ", ", x$t, "))\n", sep = "")) print(x$cov[, , dim(x$cov)[3]]) } else { cov <- x$cov[, , dim(x$cov)[3]][rowSums(x$cov[, , dim(x$cov)[3]]) != 0, ] cova <- cov[, colSums(cov) != 0] cat(paste("Estimate of cov(P(", x$s, ", ", x$t, "))\n", sep = "")) print(cova) } } } else { for (i in seq_along(x$strata)) { cat("\t", x$strata[i], ":\n\n") cat(paste("Estimate of P(", x[i]$s, ", ", x[i]$t, ")\n", sep = "")) print(x[i]$est[, , dim(x[i]$est)[3]]); cat("\n") if (!is.null(x$cov) & covariance == TRUE) { if (whole) { cat(paste("Estimate of cov(P(", x[i]$s, ", ", x[i]$t, "))\n", sep = "")) print(x[i]$cov[, , dim(x[i]$cov)[3]]) } else { cov <- x[i]$cov[, , dim(x[i]$cov)[3]][rowSums(x[i]$cov[, , dim(x[i]$cov)[3]]) != 0, ] cova <- cov[, colSums(cov) != 0] cat(paste("Estimate of cov(P(", x[i]$s, ", ", x[i]$t, "))\n", sep = "")) print(cova) } } } } invisible() } ### etmStratified ## print.etm.stratified <- function(x, covariance = FALSE, whole = TRUE, ...) { ## if (!inherits(x, "etm.stratified")) ## stop("'x' must be of class 'etm.stratified'") ## absorb <- setdiff(levels(x$trans$to), levels(x$trans$from)) ## transient <- unique(x$state.names[!(x$state.names %in% absorb)]) ## cat(paste("Multistate model with", length(transient), "transient state(s)\n", ## "and", length(absorb), "absorbing state(s)\n\n", sep = " ")) ## cat("Possible transitions:\n") ## print(x$trans, row.names = FALSE) ## cat("\n") ## for (i in seq_along(x$strata)) { ## cat(x$strata[i], ":\n\n") ## cat(paste("Estimate of P(", x[i]$s, ", ", x[i]$t, ")\n", sep = "")) ## print(x[i]$est[, , dim(x[i]$est)[3]]); cat("\n") ## if (!is.null(x$cov) & covariance == TRUE) { ## if (whole) { ## cat(paste("Estimate of cov(P(", x[i]$s, ", ", x[i]$t, "))\n", sep = "")) ## print(x[i]$cov[, , dim(x[i]$cov)[3]]) ## } ## else { ## cov <- x[i]$cov[, , dim(x[i]$cov)[3]][rowSums(x[i]$cov[, , dim(x[i]$cov)[3]]) != 0, ] ## cova <- cov[, colSums(cov) != 0] ## cat(paste("Estimate of cov(P(", x[i]$s, ", ", x[i]$t, "))\n", sep = "")) ## print(cova) ## } ## } ## } ## invisible() ## } etm/R/plot.etmCIF.R0000755000176200001440000001062313057751334013464 0ustar liggesusersplot.etmCIF <- function(x, which.cif, xlim, ylim, ylab = "Cumulative Incidence", xlab = "Time", col = 1, lty, lwd = 1, ci.type = c("none", "bars", "pointwise"), ci.fun = "cloglog", ci.col = col, ci.lty = 3, legend = TRUE, legend.pos, curvlab, legend.bty = "n", pos.ci = 27, ci.lwd = 3, ...) { if (!inherits(x, "etmCIF")) { stop("'x' must be of class 'etmCIF'") } ci.type <- match.arg(ci.type) tr.choice <- paste(x[[1]]$trans[, 1], x[[1]]$trans[, 2]) l.x <- NCOL(x$X) n.trans <- length(tr.choice) if (missing(which.cif)) { tr.choice <- paste(0, x$failcode, sep = " ") } else { tr.choice <- paste(0, which.cif, sep = " ") ## A small test on tr.choice ref <- sapply(1:length(x[[1]]$state.names), function(i) { paste(x[[1]]$state.names, x[[1]]$state.names[i]) }) ref <- matrix(ref) if (sum(tr.choice %in% ref == FALSE) > 0) stop("Argument 'which.cif' and causes of failure must match") } n.what <- length(tr.choice) max.time <- max(sapply(x[1:l.x], function(ll) { max(ll$time) })) if (missing(ylim)) ylim <- c(0, 1) if (missing(xlim)) xlim <- c(0, max.time) if (missing(lty)) { lty <- seq_len(n.what * l.x) } else if (length(lty) < (l.x * n.what)) { lty <- lty * rep(1, l.x * n.what) } if (length(col) < l.x * n.what) col <- col * rep(1, l.x * n.what) conf.int <- if (ci.type == "pointwise") TRUE else FALSE if (ci.type != "none") { if (missing(ci.col)) { ci.col <- col } else { if (length(ci.col) < (l.x * n.what)) { ci.col <- ci.col * rep(1, l.x * n.what) } } if (missing(ci.lty)) { ci.lty <- lty } else { if (length(ci.lty) < (l.x * n.what)) { ci.lty <- ci.lty * rep(1, l.x * n.what) } } } plot(xlim, ylim, xlab = xlab, ylab = ylab, xlim = xlim, ylim = ylim, type = "n", ...) summx <- lapply(x[1:l.x], summary, ci.fun = ci.fun) if (length(pos.ci) < l.x) pos.ci <- rep(pos.ci, l.x) for (i in seq_len(l.x)) { for (j in seq_along(tr.choice)) { lines(x[[i]], tr.choice = tr.choice[j], col = col[j + (i - 1) * n.what], lty = lty[j + (i - 1) * n.what], lwd = lwd, conf.int = conf.int,...) if (ci.type == "bars") { ind <- findInterval(pos.ci[i], summx[[i]][[tr.choice[j]]]$time) graphics::segments(pos.ci[i], summx[[i]][[tr.choice[j]]]$lower[ind], pos.ci[i], summx[[i]][[tr.choice[j]]]$upper[ind], lwd = ci.lwd, col = ci.col[j + (i - 1) * n.what], lty = ci.lty[j + (i - 1) * n.what],...) } } } if (legend) { if (missing(legend.pos)) { legend.pos <- "topleft" } if (missing(curvlab)) { cdc <- sapply(strsplit(sub("\\s", "|", tr.choice), "\\|"), "[", 2) ## cdc <- sapply(strsplit(tr.choice, " "), "[", 2) if (l.x == 1) { curvlab <- paste("CIF ", cdc, sep = "") } else { if (length(cdc) == 1) { curvlab <- paste("CIF ", cdc, "; ", rownames(x$X), "=", x$X, sep = "") } else { curvlab <- as.vector(sapply(seq_along(x$X), function(j){ paste("CIF ", cdc, "; ", rownames(x$X), "=", x$X[j], sep = "") })) } } } if (is.list(legend.pos)) legend.pos <- unlist(legend.pos) if (length(legend.pos) == 1) { xx <- legend.pos yy <- NULL } if (length(legend.pos) == 2) { xx <- legend.pos[1] yy <- legend.pos[2] } args <- list(...) ii <- pmatch(names(args), names(formals("legend")[-charmatch("bty",names(formals("legend")))])) do.call("legend", c(list(xx, yy, curvlab, col=col, lty=lty, lwd = lwd, bty = legend.bty), args[!is.na(ii)])) } invisible() } etm/R/etm_intern.R0000755000176200001440000000240713646546615013555 0ustar liggesusers##################################################################### ### The etm machinery ### Arthur Allignol s & times <= t] if (length(times) == 0) { zzz <- list() zzz$est <- array(diag(1, nrow = nstate, nstate), dim = list(nstate, nstate, 1)) zzz$dna <- array(matrix(0, nrow = nstate, ncol = nstate), dim = list(nstate, nstate, 1)) zzz$n.risk <- zzz$time <- zzz$n.event <- NULL return(zzz) } else { c_modif <- matrix(const_modif, length(times), nstate, byrow = TRUE) zzz <- .Call("gen_msm", times, entry, exit, from, to, nstate, c_modif) } if (covariance) { cov_etm <- .Call("cov_aj", zzz$time, zzz$est, zzz$n.risk, zzz$n.event, zzz$dna) zzz$cov <- cov_etm } zzz } etm/R/print.clos.etm.R0000755000176200001440000000111113057751334014247 0ustar liggesusersprint.clos.etm <- function(x, ...) { if (!inherits(x, "clos.etm")) { stop("'x' must be of class 'clos.etm'") } cat("The expected change in length of stay is:\n") cat(paste(round(x$e.phi, 3)), "\n") if (!is.null(x$e.phi.weights.1)) { cat("\nAlternative weighting:\n\n") cat(paste("Expected change in LOS with weight.1:", round(x$e.phi.weights.1, 3), "\n", sep = " ")) cat(paste("Expected change in LOS with weight.other:", round(x$e.phi.weights.other, 3), "\n", sep = " ")) } invisible() } etm/R/prepare.los.data.R0000755000176200001440000001066413723751461014550 0ustar liggesusers"prepare.los.data" <- function(x) { ## -------------------------------------------------------------------------------- ## Title: R-function prepare.los.data() ## --------------------------------------------------------------------------------- ## Author: Matthias Wangler ## mw@imbi.uni-freiburg.de ## Institute of Med. Biometry and Med. Computer Science ## Stefan-Meier-Strasse 26, D-79104 Freiburg, ## http://www.imbi.uni-freiburg.de ## --------------------------------------------------------------------------------- ## Description: Read and prepare a data set which can be passed to the function clos ## --------------------------------------------------------------------------------- ## Required Packages: - ## --------------------------------------------------------------------------------- ## Usage: prepare.los.data( x ) ## ## x: data.frame of the form data.frame( id, j.01, j.02, j.03, j.12, j.13, cens, stringsAsFactors=TRUE): ## ## id: id (patient id, admision id, ...) ## j.01: observed time for jump from "0" to "1" ## j.02: observed time for jump from "0" to "2" ## j.03: observed time for jump from "0" to "3" ## j.12: observed time for jump from "1" to "2" ## j.13: observed time for jump from "1" to "3" ## cens: observed time for censoring ## --------------------------------------------------------------------------------- ## Value: data.frame of the form data.frame(id, from, to, time, stringsAsFactors=TRUE): ## ## id: id (patient id, admision id) ## from: the state from where a transition occurs ## to: the state to which a transition occurs ## time: the time a transition occurs ## oid: the observation id ## --------------------------------------------------------------------------------- ## Notes: It's possible that the same patient, person or object was observed several ## times (e.g. bootstrap). ## So for each observation the same id recieves different observation id's. ## --------------------------------------------------------------------------------- ## Example: > data(los.data) ## > my.observ <- prepare.los.data(x=los.data) ## --------------------------------------------------------------------------------- ## License: GPL 2 ##---------------------------------------------------------------------------------- ## History: 20.06.2004, Matthias Wangler ## first version ## --------------------------------------------------------------------------------- ## check the passed parameters if( missing(x) ) { stop("Argument 'x' is missing, with no defaults.") } if( !is.data.frame(x) ) { stop("Argument 'x' must be a 'data.frame'.") } ## check the number of columns of the passed data.frame x if( dim(x)[2] != 7 ) { stop("The passed data.frame 'x' doesn't include 7 columns.") } ## compute variables cens.0 for admissions censored in the initial state 0 ## and cens.1 for admissions censored in state 1 x$cens.0 <- x$cens x$cens.0[is.finite(x[,2])] <- Inf x$cens.1 <- x$cens x$cens.1[is.infinite(x[,2])] <- Inf x <- x[,c(1,2,3,4,5,6,8,9)] id <- c(x[,1][x[,2] != Inf], x[,1][x[,3] != Inf],x[,1][x[,4] != Inf], x[,1][x[,5] != Inf], x[,1][x[,6] != Inf],x[,1][x[,7] != Inf], x[,1][x[,8] != Inf]) from <- c(rep("0",length(x[,2][x[,2] != Inf])), rep("0",length(x[,3][x[,3] != Inf])), rep("0",length(x[,4][x[,4] != Inf])), rep("1",length(x[,5][x[,5] != Inf])), rep("1",length(x[,6][x[,6] != Inf])), rep("0",length(x[,7][x[,7] != Inf])), rep("1",length(x[,8][x[,8] != Inf]))) to <- c(rep("1",length(x[,2][x[,2] != Inf])), rep("2",length(x[,3][x[,3] != Inf])), rep("3",length(x[,4][x[,4] != Inf])), rep("2",length(x[,5][x[,5] != Inf])), rep("3",length(x[,6][x[,6] != Inf])), rep("cens",length(x[,7][x[,7] != Inf])), rep("cens",length(x[,8][x[,8] != Inf]))) time <- c(x[,2][x[,2] != Inf], x[,3][x[,3] != Inf],x[,4][x[,4] != Inf], x[,5][x[,5] != Inf], x[,6][x[,6] != Inf],x[,7][x[,7] != Inf], x[,8][x[,8] != Inf]) ## observation id x$oid <- 1:length(x[,1]) oid <- c(x[,9][x[,2] != Inf], x[,9][x[,3] != Inf],x[,9][x[,4] != Inf], x[,9][x[,5] != Inf], x[,9][x[,6] != Inf],x[,9][x[,7] != Inf], x[,9][x[,8] != Inf]) observ <- data.frame(id, from, to, time, oid, stringsAsFactors=TRUE) return(observ) } etm/R/plot.clos.etm.R0000755000176200001440000000445013057751334014102 0ustar liggesusersplot.clos.etm <- function(x, xlab = "Time", ylab.e = "Expected LOS", ylab.w = "Weights", xlim, ylim.e, ylim.w, col.e = c(1, 2), col.w = 1, lty.e = c(1, 1), lty.w = 1, legend = TRUE, legend.pos, curvlab, legend.bty = "n", ...) { if (!inherits(x, "clos.etm")) { stop("'x' must be a 'clos.etm' object") } if (missing(xlim)) { xlim <- c(0, max(x$w.time)) } if (missing(ylim.e)) { ylim.e <- c(0, max(c(x$phi.case, x$phi.control))) } if (missing(ylim.w)) { ylim.w <- c(0, max(x$weights)) } def.par <- graphics::par(no.readonly = TRUE) on.exit(par(def.par)) graphics::split.screen(figs=matrix(c(rep(0,2), rep(1,2), c(0, 0.6), c(0.7, 1)), ncol=4)) screen(2) op <- graphics::par(mar=c(2, 5, 2, 1)) graphics::plot(c(0,x$w.time), c(0, x$weights), type = "s", axes = FALSE, lty = lty.w, xlim = xlim, ylim = ylim.w , xlab = xlab , ylab = ylab.w, col=col.w, ...) graphics::axis(side=2) graphics::box() graphics::par(op) graphics::screen(1) op <- graphics::par(mar=c(5, 5, 4, 1)) graphics::plot(x$time, x$phi.case, type = "s", lty = lty.e[1], xlim = xlim, ylim = ylim.e, xlab = xlab, ylab = ylab.e, col = col.e[1], ...) graphics::lines(x$time, x$phi.control, type = "s", lty = lty.e[2], col = col.e[2], ...) graphics::par(op) if (legend == TRUE) { if (missing(legend.pos)) legend.pos <- "bottomright" if (missing(curvlab)) curvlab <- c("Intermediate event by time t", "No intermediate event by time t") if (is.list(legend.pos)) legend.pos <- unlist(legend.pos) if (length(legend.pos) == 1) { xx <- legend.pos yy <- NULL } if (length(legend.pos) == 2) { xx <- legend.pos[1] yy <- legend.pos[2] } args <- list(...) ii <- pmatch(names(args), names(formals("legend")[-charmatch("bty",names(formals("legend")))])) do.call("legend", c(list(xx, yy, curvlab, col = col.e, lty = lty.e, bty = legend.bty), args[!is.na(ii)])) } graphics::close.screen(all.screens = TRUE) invisible() } etm/R/transfoData.R0000755000176200001440000001021713723751324013644 0ustar liggesusers### Function to prepare the data in way ### that they can be used in etm() etmprep <- function(time, status, data, tra, state.names, cens.name = NULL, start = NULL, id = NULL, keep) { if (nrow(tra) != ncol(tra)) stop("'tra' must be quadratic") ## What are the possible transitions, transient and absorbing states if (missing(state.names)) { state.names <- as.character(0:(dim(tra)[2] - 1)) } ls <- length(state.names); n <- nrow(data) if (ls != dim(tra)[2]) stop("Discrepancy between 'tra' and the number of states specified in 'state.names'") if (length(time) != ls) { stop("The length of 'time' must be equal to the number of states") } colnames(tra) <- rownames(tra) <- state.names t.from <- lapply(1:dim(tra)[2], function(i) { rep(rownames(tra)[i], sum(tra[i, ])) }) t.from <- unlist(t.from) t.to <- lapply(1:dim(tra)[2], function(i) { colnames(tra)[tra[i, ]==TRUE] }) t.to <- unlist(t.to) trans <- data.frame(from=t.from, to=t.to, stringsAsFactors=TRUE) absorb <- setdiff(levels(trans$to), levels(trans$from)) transient <- unique(state.names[!(state.names %in% absorb)]) ## extract informations in time ind <- match(time[!is.na(time)], names(data)) if (any(is.na(ind))) stop("At least one element in 'time' is not in 'data'") indd <- which(time %in% names(data)) time <- matrix(NA, n, ls) time[, indd] <- as.matrix(data[, ind]) ## extract infos in status if (length(status) != ls) { stop("The length of 'status' must be equal to the number of states") } ind <- match(status[!is.na(status)], names(data)) if (any(is.na(ind))) stop("At least one element in 'status' is not in 'data'") indd <- which(status %in% names(data)) status <- matrix(NA, n, ls) status[, indd] <- as.matrix(data[, ind]) if (is.null(start)) { start.state <- rep(state.names[1], n) start.time <- rep(0, n) } else { if ((length(start$state) != nrow(data)) | (length(start$time) != nrow(data))) stop("'start$state' or 'start$time' are not as long as the data") if (!all(unique(start$state) %in% state.names)) stop("'start$state' not in 'state.names'") start.state <- start$state start.time <- start$time } if (is.null(id)) { id <- seq_len(n) } else id <- data[, id] if (!missing(keep)) { cova <- data[, keep, drop = FALSE] } else keep <- NULL ## let's try to start the real work newdata <- lapply(seq_len(n), function(i) { ind <- which(status[i, ] != 0) li <- length(ind) if (li == 0) { from <- start.state[i] to <- cens.name entry <- start.time[i] exit <- time[i, ncol(time)] idd <- id[i] } else { from <- c(start.state[i], state.names[ind[-li]]) to <- state.names[ind] entry <- c(start.time[i], time[i, ind[-li]]) exit <- time[i, ind] idd <- rep(id[i], length(exit)) if (to[length(to)] %in% transient) { from <- c(from, to[length(to)]) to <- c(to, cens.name) entry <- c(entry, exit[length(exit)]) exit <- c(exit, time[i, ncol(time)]) idd <- c(idd, id[i]) } } if (is.null(keep)) { tmp <- data.frame(idd, entry, exit, from, to, stringsAsFactors=TRUE) } else { aa <- matrix(apply(cova[i, , drop = FALSE], 2, rep, length(exit)), length(exit), ncol(cova)) tmp <- data.frame(idd, entry, exit, from, to, aa, stringsAsFactors=TRUE) } tmp }) newdata <- do.call(rbind, newdata) names(newdata) <- c("id", "entry", "exit", "from", "to", keep) if (is.factor(newdata$from) || is.factor(newdata$to)) { aa <- unique(c(levels(newdata$from), levels(newdata$to))) newdata$from <- factor(as.character(newdata$from), levels = aa) newdata$to <- factor(as.character(newdata$to), levels = aa) } newdata } etm/R/misc.R0000755000176200001440000000557313057751334012343 0ustar liggesusers### Some useful miscellaneous functions ### tra_ill <- function(state.names = c("0", "1", "2")) { if (length(state.names) != 3) stop("An illness-death model has 3 states") tra <- matrix(FALSE, ncol = 3, nrow = 3, dimnames = list(state.names, state.names)) tra[1, 2:3] <- TRUE tra[2, 3] <- TRUE tra } tra_ill_comp <- function(nComp = 2, state.names = as.character(seq(0, nComp + 1, 1))) { if (nComp == 1) stop("No competing risks. Use 'tra_ill' instead") nstates <- length(state.names) if (length(state.names) != nComp + 2) stop(paste("Something is wrong with 'state.names'. The specified multistate model has ", nComp + 2L, " states", sep = "")) tra <- matrix(FALSE, nstates, nstates, dimnames = list(state.names, state.names)) tra[1, 2:nstates] <- TRUE tra[2, 3:nstates] <- TRUE tra } tra_comp <- function(nComp = 2, state.names = as.character(seq(0, nComp))) { if (nComp == 1) stop("That's not a competing risks model. Use 'tra_surv' instead") nstates <- length(state.names) if (nstates != nComp + 1L) stop(paste("Something is wrong with 'state.names'. The specified multistate model has ", nComp + 1L, " states", sep = "")) tra <- matrix(FALSE, nstates, nstates, dimnames = list(state.names, state.names)) tra[1, 2:nstates] <- TRUE tra } tra_surv <- function(state.names = c("0", "1")) { if (length(state.names) != 2) stop("Survival model has 2 states") tra <- matrix(FALSE, ncol = 2, nrow = 2, dimnames = list(state.names, state.names)) tra[1, 2] <- TRUE tra } ### A little function that transform the data from time to entry exit transfo_to_counting <- function(df) { if (!("data.table" %in% class(df))) stop("The data should be of class 'data.table'") setorder(df, id, time) df[, idd := as.integer(id)] df[, masque := rbind(1, apply(as.matrix(idd), 2, diff))] df[, entree := c(0, time[1:(length(time) - 1)]) * (masque == 0)] df[, ':='(entry = entree, exit = time, entree = NULL, time = NULL, masque = NULL)] return(df) } ### Product integration prodint <- function(dna, times, first, last, indi) { I <- array(0, dim=dim(dna)[c(1, 2)]) diag(I) <- 1 if (first >= last) { est <- array(I, dim=c(dim(dna)[c(1, 2)], 1)) time <- NULL } else { est <- array(0, dim=c(dim(dna)[c(1, 2)], (last-first+1))) est[, , 1] <- I + dna[, , first] * indi[1] j <- 2 for (i in (first + 1):last) { est[, , j] <- est[, , j-1] %*% (I + dna[, , i] * indi[j]) j <- j + 1 } time <- times[first:last] } list(est=est, time=time) } etm/R/etm.R0000755000176200001440000002326513723751505012173 0ustar liggesusersetm <- function(data, ...) { UseMethod("etm") } etm.data.frame <- function(data, state.names, tra, cens.name, s, t = "last", covariance = TRUE, delta.na = TRUE, modif = FALSE, c = 1, alpha = NULL, strata, ...) { if (missing(data)) stop("Argument 'data' is missing with no default") x <- data.table(data) if (missing(tra)) stop("Argument 'tra' is missing with no default") if (missing(state.names)) stop("Argument 'state.names' is missing with no default") if (missing(cens.name)) stop("Argument 'cens.name' is missing with no default") if (missing(s)) stop("Argument 's' is missing with no default") if (!is.data.frame(x)) stop("Argument 'x' must be a data.frame") if (!(xor(sum(c("id", "from", "to", "time") %in% names(x)) != 4, sum(c("id", "from", "to", "entry", "exit") %in% names(x)) != 5))) stop("'data' must contain the right variables") if (nrow(tra) != ncol(tra)) stop("Argument 'tra' must be a quadratic matrix.") if (sum(diag(tra)) > 0) stop("transitions into the same state are not allowed") if (nrow(tra) != length(state.names)) { stop("The row number of 'tra' must be equal to the number of states.") } if (!is.logical(tra)) { stop("'tra' must be a matrix of logical values, which describes the possible transitions.") } if (length(state.names) != length(unique(state.names))) { stop("The state names must be unique.") } if (!(is.null(cens.name))) { if (cens.name %in% state.names) { stop("The name of the censoring variable just is a name of the model states.") } } ## The stratification variable if (missing(strata)) { strat_var <- "X" x$X <- "1" is_stratified <- FALSE } else { if (!all(strata %in% names(x))) stop("Stratification variables not in data") strat_var <- strata x[, (strat_var) := lapply(.SD, as.character), .SDcols = strat_var] is_stratified <- TRUE } ## if modif TRUE, check that the model is competing risks. else ## set to false and issue a warning if (modif == TRUE && covariance == TRUE) { ## check for competing risks tr.cp <- tra_comp(length(state.names) - 1) if (any(dim(tra) != dim(tr.cp)) | (all(dim(tra) == dim(tr.cp)) && !all(tra == tr.cp))) { covariance <- FALSE warning("The variance of the estimator with the Lay and Ying transformation is only computed for competing risks data") } } ## keep only the variables we need reg <- names(x) names_msm <- intersect(c("id", "entry", "exit", "time", "from", "to", strat_var), reg) x <- x[, names_msm, with = FALSE] ## Work through the stratification variables combi <- unique(x[, strat_var, with = FALSE]) if (length(strat_var) == 1) { conditions <- lapply(seq_len(nrow(combi)), function(i) { parse(text = paste0(strat_var, " == '", combi[i], "'")) }) } else { conditions <- lapply(seq_len(nrow(combi)), function(i) { parse(text = paste(sapply(strat_var, function(j) { paste0(j, "== '", combi[i, j, with = FALSE], "'") }), collapse = " & ")) }) } ## transitions colnames(tra) <- rownames(tra) <- state.names t.from <- lapply(1:dim(tra)[2], function(i) { rep(rownames(tra)[i], sum(tra[i, ])) }) t.from <- unlist(t.from) t.to <- lapply(1:dim(tra)[2], function(i) { colnames(tra)[tra[i, ]==TRUE] }) t.to <- unlist(t.to) trans <- data.frame(from=t.from, to=t.to, stringsAsFactors=TRUE) namen <- paste(trans[, 1], trans[, 2]) ## test on transitions test <- x[, unique(paste(from, to))] if (!(is.null(cens.name))) { ref <- c(paste(trans$from, trans$to), paste(unique(trans$from), cens.name)) } else { ref <- paste(trans$from, trans$to) } ref.wo.cens <- paste(trans$from, trans$to) if (!(all(test %in% ref)==TRUE)) stop("There is undefined transitions in the data set") if (x[, sum(as.character(from) == as.character(to))] > 0) stop("Transitions into the same state are not allowed") if (!(all(ref.wo.cens %in% test) == TRUE)) warning("You may have specified more possible transitions than actually present in the data") n <- length(unique(x$id)) ### data.table transformation x[, id := if (is.character(id)) as.factor(id) else id] if (!(is.null(cens.name))) { x[, from := factor(from, levels = c(cens.name, state.names), ordered = TRUE)] levels(x$from) <- 0:length(state.names) x[, to := factor(to, levels = c(cens.name, state.names), ordered = TRUE)] levels(x$to) <- 0:length(state.names) } else{ x[, from := factor(from, levels = state.names, ordered = TRUE)] levels(x$from) <- 1:length(state.names) x[, to := factor(x$to, levels = state.names, ordered = TRUE)] levels(x$to) <- 1:length(state.names) } ## if not, put like counting process data if ("time" %in% names(x)) { setorder(x, id, time) x[, idd := as.integer(id)] x[, masque := rbind(1, apply(as.matrix(idd), 2, diff))] x[, entree := c(0, time[1:(length(time) - 1)]) * (masque == 0)] x[, ':='(entry = entree, exit = time, entree = NULL, time = NULL, masque = NULL)] if (sum(x$entry < x$exit) != nrow(x)) stop("Exit time from a state must be > entry time") } else { if (sum(x$entry < x$exit) != nrow(x)) stop("Exit time from a state must be > entry time") } x[, from := as.integer(as.character(from))] x[, to := as.integer(as.character(to))] if (t=="last") t <- max(x$exit) if (!(0 <= s & s < t)) stop("'s' and 't' must be positive, and s < t") if (t < x[, min(exit)] | s >= x[, max(exit)]) stop("'s' or 't' is an invalid time") ## remove the lines in which transition before s x <- x[exit > s] ## remove the entries after t x <- x[entry < t] ## The Lai and Ying modification (if any) if (modif) { if (is.null(alpha)) { if (length(c) == 1) { c_modif <- c } else { if (length(c) != length(state.names)) { stop("if specifying a unique c for each transient state, 'c' should be the same length as the 'state.names'") } else { c_modif <- c } } } else { ## the original lay and ying proposal c_modif <- c * n^alpha } } else { c_modif <- 0 } res <- lapply(conditions, function(ll) { zzz <- .etm(entry = x[eval(ll), entry], exit = x[eval(ll), exit], from = x[eval(ll), from], to = x[eval(ll), to], nstate = dim(tra)[1], s, t, covariance, c_modif) nrisk <- zzz$n.risk est <- zzz$est nev <- zzz$n.event var_aj <- zzz$cov dimnames(est) <- list(state.names, state.names, zzz$time) if (!is.null(zzz$n.risk)) { colnames(nrisk) <- state.names nrisk <- nrisk[, !(colnames(nrisk) %in% setdiff(unique(trans$to), unique(trans$from))), drop = FALSE] dimnames(est) <- list(state.names, state.names, zzz$time) dimnames(nev) <- list(state.names, state.names, zzz$time) if (covariance) { pos <- sapply(1:length(state.names), function(i) { paste(state.names, state.names[i]) }) pos <- matrix(pos) dimnames(var_aj) <- list(pos, pos, zzz$time) var_aj[var_aj < 0] <- 0 } else { var_aj <- NULL } } else { var_aj <- NULL } res <- list(est = est, cov = var_aj, time = zzz$time, n.risk = nrisk, n.event = nev, delta.na = zzz$dna, s = s, t = t) res }) if (is_stratified) { names(res) <- do.call('c', lapply(conditions, as.character)) res$trans <- trans res$tra <- tra res$state.names <- state.names res$data <- x res$strata_variable <- strata res$strata <- do.call('c', lapply(conditions, as.character)) class(res) <- "etm" } else { res <- res[[1]] res$trans <- trans res$tra <- tra res$state.names <- state.names res$data <- x class(res) <- "etm" } res } ### with Hist ## etm.formula <- function(formula, data, subset, na.action) { ## call <- match.call() ## if (missing(data)) ## data <- environment(formula) ## if (!missing(subset)) ## data <- subset(data, subset = subset) ## mod <- EventHistory.frame(formula, ## data, ## specials = c("strata", "factor"), ## stripSpecials = "strata", ## stripAlias = list(strata = c("Strata", "factor")), ## check.formula = TRUE) ## mod ## } etm/R/xyplot.etm.R0000755000176200001440000000467413233704366013533 0ustar liggesusersxyplot.etm <- function(x, data = NULL, tr.choice, col = c(1, 1, 1), lty = c(1, 3, 3), xlab="Time", ylab = "Transition probability", conf.int = TRUE, ci.fun = "linear", level = 0.95, ...) { if (!inherits(x, "etm")) stop("Argument 'x' must be of class 'etm'") is_stratified <- !is.null(x$strata) ref <- sapply(1:length(x$state.names), function(i) { paste(x$state.names, x$state.names[i]) }) ref <- matrix(ref) if (missing(tr.choice)) { ufrom <- unique(x$trans$from) uto <- unique(x$trans$to) absorb <- setdiff(uto, ufrom) nam1 <- dimnames(x$est)[[1]] nam2 <- dimnames(x$est)[[2]] pos <- c(paste(nam1[!(nam1 %in% as.character(absorb))], nam2[!(nam2 %in% as.character(absorb))]), paste(x$trans$from, x$trans$to)) tr.choice <- pos } if (sum(tr.choice %in% ref == FALSE) > 0) stop("Argument 'tr.choice' and possible transitions must match") if (is_stratified) { lstrat <- length(x$strata) temp <- lapply(seq_len(lstrat), function(i) { tmp <- ci.transfo(x[[i]], tr.choice, level, ci.fun) tmp2 <- lapply(tmp, cbind, strata = x$strata[[i]]) tmp2 }) temp <- do.call(c, temp) } else { temp <- ci.transfo(x, tr.choice, level, ci.fun) } for (i in seq_along(temp)) { temp[[i]]$cov <- names(temp)[i] } temp <- do.call(rbind, temp) temp$cov <- factor(temp$cov, levels = tr.choice) if (is_stratified) { if (conf.int) { aa <- lattice::xyplot(temp$P + temp$lower + temp$upper ~ temp$time | temp$cov + temp$strata, type = "s", col = col, lty = lty, xlab = xlab, ylab = ylab, ...) } else { aa <- lattice::xyplot(temp$P ~ temp$time | temp$cov + temp$strata, type = "s", col = col, lty = lty, xlab = xlab, ylab = ylab, ...) } } else { if (conf.int) { aa <- lattice::xyplot(temp$P + temp$lower + temp$upper ~ temp$time | temp$cov, type = "s", col = col, lty = lty, xlab = xlab, ylab = ylab, ...) } else { aa <- lattice::xyplot(temp$P ~ temp$time | temp$cov, type = "s", col = col, lty = lty, xlab = xlab, ylab = ylab, ...) } } aa } etm/R/plot.etm.R0000755000176200001440000000706713233437453013151 0ustar liggesusersplot.etm <- function(x, tr.choice, xlab = "Time", ylab = "Transition Probability", col = 1, lty, xlim, ylim, conf.int = FALSE, level = 0.95, ci.fun = "linear", ci.col = col, ci.lty = 3, legend = TRUE, legend.pos, curvlab, legend.bty = "n", ...) { if (!inherits(x, "etm")) stop("'x' must be a 'etm' object") is_stratified <- !is.null(x$strata) ufrom <- unique(x$trans$from) uto <- unique(x$trans$to) absorb <- setdiff(uto, ufrom) nam1 <- dimnames(x$est)[[1]] nam2 <- dimnames(x$est)[[2]] pos <- c(paste(nam1[!(nam1 %in% as.character(absorb))], nam2[!(nam2 %in% as.character(absorb))]), paste(x$trans$from, x$trans$to)) if (missing(tr.choice)) { if (is_stratified) { tr.choice <- pos[1] } else { tr.choice <- pos } } ref <- sapply(1:length(x$state.names), function(i) { paste(x$state.names, x$state.names[i]) }) ref <- matrix(ref) if (sum(tr.choice %in% ref == FALSE) > 0) stop("Argument 'tr.choice' and possible transitions must match") if (is_stratified) { lstrat <- length(x$strata) temp <- lapply(seq_len(lstrat), function(i) { tmp <- ci.transfo(x[[i]], tr.choice, level, ci.fun) tmp2 <- lapply(tmp, cbind, strata = x$strata[[i]]) tmp2 }) temp <- do.call(c, temp) } else { temp <- ci.transfo(x, tr.choice, level, ci.fun) } lt <- length(temp) if (missing(lty)) { lty <- seq_len(lt) } else if (length(lty) < lt) { lty <- lty * rep(1, lt) } if (length(col) < lt) col <- col * rep(1, lt) if (missing(xlim)) { xlim <- c(0, max(sapply(temp, function(x) max(x$time)))) } if (missing(ylim)) { ylim <- c(0, 1) } graphics::plot(xlim, ylim, xlab = xlab, ylab = ylab, xlim = xlim, ylim = ylim, type = "n", ...) for (i in seq_len(lt)) { graphics::lines(temp[[i]]$time, temp[[i]]$P, type = "s", col = col[i], lty = lty[i], ...) } if (conf.int && !is.null(x$cov)) { if (length(ci.col) < lt) ci.col <- ci.col * rep(1, lt) if (length(ci.lty) < lt) ci.lty <- ci.lty * rep(1, lt) for (i in seq_len(lt)) { graphics::lines(temp[[i]]$time, temp[[i]]$lower, type = "s", col = ci.col[i], lty = ci.lty[i], ...) graphics::lines(temp[[i]]$time, temp[[i]]$upper, type = "s", col = ci.col[i], lty = ci.lty[i], ...) } } ## Extend to deal with the strata if (legend) { if (missing(legend.pos)) legend.pos <- "topleft" if (missing(curvlab)) { if (is_stratified) { curvlab <- as.vector(sapply(tr.choice, paste, x$strata)) } else { curvlab <- tr.choice } } if (is.list(legend.pos)) legend.pos <- unlist(legend.pos) if (length(legend.pos) == 1) { xx <- legend.pos yy <- NULL } if (length(legend.pos) == 2) { xx <- legend.pos[1] yy <- legend.pos[2] } args <- list(...) ii <- pmatch(names(args), names(formals("legend")[-charmatch("bty",names(formals("legend")))])) do.call("legend", c(list(xx, yy, curvlab, col=col, lty=lty, bty = legend.bty), args[!is.na(ii)])) } invisible() } etm/R/clos_intern.R0000755000176200001440000001222513057751334013717 0ustar liggesusers### To be used for single endpoint clos.nocp <- function(x, aw, ratio) { dims <- dim(x$est) los <- matrix(rep(x$time, 3), ncol = 3, byrow = FALSE) tau <- max(x$data$exit) times <- x$time surv <- x$est[1, 1, ] ## Call to C++ function out <- .Call("los_nocp", times, x$delta.na, tau) los[, 2] <- out$los0 los[, 3] <- out$los1 indi <- apply(x$n.event, 3, function(x) {sum(x[1, ]) != 0}) wait.times <- x$time[indi] wait.prob <- x$est[1, 1, ][indi] pp <- x$n.risk[-1, ] ev.last <- apply(x$n.event[, , dims[3]], 1, sum)[1:2] pp <- rbind(pp, pp[nrow(pp), ] - ev.last) filtre <- pp[, 1] <= 0 | pp[, 2] <= 0 if (ratio) { los.diff <- los[, 3] / los[, 2] } else { los.diff <- los[, 3] - los[, 2] } los.diff[filtre] <- 0 my.weights <- diff(c(0, 1 - wait.prob)) estimate <- matrix(los.diff[is.element(los[, 1], wait.times)], nrow = 1) %*% matrix(my.weights, ncol=1) e.phi.w1 <- e.phi.w2 <- my.weights1 <- my.weights2 <- NULL if (aw) { I <- diag(1, dims[1]) tr.mat <- array(apply(x$delta.na, 3, "+", I), dim = dims) cif1 <- cumsum(c(1, x$est[1, 1, 1:(dims[3] - 1)]) * tr.mat[1, 2, ]) my.weights1 <- diff(c(0, cif1[indi])) / cif1[length(cif1)] cif2 <- cumsum(c(1, x$est[1, 1, 1:(dims[3] - 1)]) * tr.mat[1, 3, ]) my.weights2 <- diff(c(0, cif2[indi])) / cif2[length(cif2)] weights.aw <- list(my.weights1, my.weights2) estimates.aw <- lapply(weights.aw, function(z) { ldiff <- los[, 3] - los[, 2] ldiff[filtre] <- 0 estimate <- matrix(ldiff[is.element(los[, 1], wait.times)], nrow = 1) %*% matrix(z, ncol = 1) estimate }) e.phi.w1 <- estimates.aw[[1]] e.phi.w2 <- estimates.aw[[2]] } res <- list(e.phi = estimate[[1]], phi.case = los[, 3], phi.control = los[, 2], weights = my.weights, w.time = wait.times, time = x$time, e.phi.weights.1 = e.phi.w1, e.phi.weights.other = e.phi.w2, weights.1 = my.weights1, weights.other = my.weights2) res } ####################################### ## The competing risks version ####################################### clos.cp <- function(x, aw, ratio) { dims <- dim(x$est) los <- matrix(rep(x$time, 3), ncol = 3, byrow = FALSE) phi2 <- matrix(data=c(x$time, rep(0, dims[3]), rep(0, dims[3])), ncol=3, byrow=FALSE) phi3 <- matrix(data=c(x$time, rep(0, dims[3]), rep(0, dims[3])), ncol=3, byrow=FALSE) ind.cens <- apply(x$n.event, 3, function(r) all(r == 0)) times <- x$time tau <- max(x$time) out <- .Call("los_cp", times, x$delta.na, tau) los[, 2] <- out$los0 los[, 3] <- out$los1 phi2[, 3] <- out$phi2case; phi2[, 2] <- out$phi2control phi3[, 3] <- out$phi3case; phi3[, 2] <- out$phi3control indi <- apply(x$n.event, 3, function(x) {sum(x[1, ]) != 0}) wait.times <- x$time[indi] wait.prob <- x$est[1, 1, ][indi] my.weights <- diff(c(0, 1 - wait.prob)) pp <- x$n.risk[-1, ] ev.last <- apply(x$n.event[, , dims[3]], 1, sum)[1:2] pp <- rbind(pp, pp[nrow(pp), ] - ev.last) filtre <- pp[, 1] <= 0 | pp[, 2] <= 0 tmp <- list(los, phi2, phi3) estimates <- lapply(tmp, function(z) { if (ratio) { ldiff <- z[, 3] / z[, 2] } else { ldiff <- z[, 3] - z[, 2] } ldiff[filtre] <- 0 estimate <- matrix(ldiff[is.element(z[, 1], wait.times)], nrow = 1) %*% matrix(my.weights, ncol=1) estimate }) e.phi.w1 <- e.phi.w23 <- my.weights1 <- my.weights23 <- NULL if (aw) { I <- diag(1, dims[1]) tr.mat <- array(apply(x$delta.na, 3, "+", I), dim = dims) cif1 <- cumsum(c(1, x$est[1, 1, 1:(dims[3] - 1)]) * tr.mat[1, 2, ]) my.weights1 <- diff(c(0, cif1[indi])) / cif1[length(cif1)] cif23 <- cumsum(c(1, x$est[1, 1, 1:(dims[3] - 1)]) * (tr.mat[1, 3, ] + tr.mat[1, 4, ])) my.weights23 <- diff(c(0, cif23[indi])) / cif23[length(cif23)] weights.aw <- list(my.weights1, my.weights23) estimates.aw <- lapply(weights.aw, function(z) { ldiff <- los[, 3] - los[, 2] ldiff[filtre] <- 0 estimate <- matrix(ldiff[is.element(los[, 1], wait.times)], nrow = 1) %*% matrix(z, ncol = 1) estimate }) e.phi.w1 <- estimates.aw[[1]] e.phi.w23 <- estimates.aw[[2]] } res <- list(e.phi = estimates[[1]], phi.case = los[, 3], phi.control = los[, 2], e.phi2 = estimates[[2]], phi2.case = phi2[, 3], phi2.control = phi2[, 2], e.phi3 = estimates[[3]], phi3.case = phi3[, 3], phi3.control = phi3[, 2], weights = my.weights, w.time = wait.times, time = x$time, e.phi.weights.1 = e.phi.w1, e.phi.weights.other = e.phi.w23, weights.1 = my.weights1, weights.other = my.weights23) res } etm/R/extract.R0000755000176200001440000001203413233440065013040 0ustar liggesuserstrprob <- function(x, ...) { UseMethod("trprob") } trcov <- function(x, ...) { UseMethod("trcov") } trprob.etm <- function(x, tr.choice, timepoints, ...) { if (!inherits(x, "etm")) stop("'x' must be a 'etm' object") if (!is.character(tr.choice)) stop("'tr.choice' must be a character vector") if (length(tr.choice) != 1) stop("The function only extracts 1 transition probability") pos <- sapply(1:length(x$state.names), function(i) { paste(x$state.names, x$state.names[i]) }) pos <- matrix(pos) if (!(tr.choice %in% pos)) stop("'tr.choice' not in the possible transitions") trans.sep <- strsplit(tr.choice, " ") if (length(trans.sep[[1]]) != 2) { tt <- charmatch(trans.sep[[1]], x$state.names, nomatch = 0) trans.sep[[1]] <- x$state.names[tt] } trans.sep <- unlist(trans.sep) miss_timepoints <- missing(timepoints) ## Number of strata. Will be computed in this if condition if (!is.null(x$strata_variable)) { ns <- length(x$strata) } else { if (miss_timepoints) { tmp <- x$est[trans.sep[1], trans.sep[2], ] } else { ind <- findInterval(timepoints, x$time) tmp <- numeric(length(timepoints)) place <- which(ind != 0) noplace <- which(ind == 0) tmp[place] <- x$est[trans.sep[1], trans.sep[2], ind] if (trans.sep[1] == trans.sep[2]) tmp[noplace] <- 1 } return(tmp) } ## Compute for the case with strata res <- lapply(1:ns, function(i) { if (miss_timepoints) { tmp <- x[[i]]$est[trans.sep[1], trans.sep[2], ] } else { ind <- findInterval(timepoints, x[[i]]$time) tmp <- numeric(length(timepoints)) place <- which(ind != 0) noplace <- which(ind == 0) tmp[place] <- x[[i]]$est[trans.sep[1], trans.sep[2], ind] if (trans.sep[1] == trans.sep[2]) tmp[noplace] <- 1 } tmp }) names(res) <- names(x)[seq_len(ns)] res } trcov.etm <- function(x, tr.choice, timepoints, ...) { if (!inherits(x, "etm")) stop("'x' must be a 'etm' object") if (!is.character(tr.choice)) stop("'tr.choice' must be a character vector") if (!(length(tr.choice) %in% c(1, 2))) stop("'tr.choice' must be of length 1 or 2") pos <- sapply(1:length(x$state.names), function(i) { paste(x$state.names, x$state.names[i]) }) pos <- matrix(pos) if (!all((tr.choice %in% pos))) stop("'tr.choice' not in the possible transitions") if (length(tr.choice) == 1) { tr.choice <- rep(tr.choice, 2) } miss_timepoints <- missing(timepoints) if (!is.null(x$strata_variable)) { ns <- length(x$strata) if (is.null(x[[1]]$cov)) stop("The covariance matrix was not computed") } else { if (is.null(x$cov)) stop("The covariance matrix was not computed") if (miss_timepoints) { tmp <- x$cov[tr.choice[1], tr.choice[2], ] } else { ind <- findInterval(timepoints, x$time) tmp <- numeric(length(timepoints)) place <- which(ind != 0) tmp[place] <- x$cov[tr.choice[1], tr.choice[2], ind] } return(tmp) } res <- lapply(1:ns, function(i) { if (miss_timepoints) { tmp <- x[[i]]$cov[tr.choice[1], tr.choice[2], ] } else { ind <- findInterval(timepoints, x[[i]]$time) tmp <- numeric(length(timepoints)) place <- which(ind != 0) tmp[place] <- x[[i]]$cov[tr.choice[1], tr.choice[2], ind] } tmp }) names(res) <- names(x)[seq_len(ns)] res } ############################## ### For the stratified etm ### ############################## "[.etm" <- function(x, ..., drop = FALSE) { if (missing(..1)) i <- NULL else i <- ..1 ## No subscript, do nothing if (is.null(i)) return(x) ## No strata, do nothing if (is.null(x$strata_variable)) return(x) if (is.character(i)) { ind <- match(gsub(" ", "", i, fixed = TRUE), gsub(" ", "", x$strata, fixed = TRUE)) if (any(is.na(ind))) stop(paste("subscript(s)", paste(i[is.na(ind)], sep = " "), "not matched")) } else { ind <- i if (max(ind) > length(x$strata)) stop(paste0("There is only ", length(x$strata), " strata")) } if (length(ind) == 1) { res <- x[[ind]] res$trans <- x$trans res$tra <- x$tra res$state.names <- x$state.names res$data <- x$data res$strat_variable <- NULL res$strata <- NULL } else { res <- unclass(x)[ind] res$trans <- x$trans res$tra <- x$tra res$state.names <- x$state.names res$data <- x$data res$strat_variable <- NULL res$strata <- NULL } class(res) <- "etm" res } etm/R/etmCIF.R0000755000176200001440000000511113723751530012501 0ustar liggesusers### Wrapper around etm for easier computation of cumulative incidence ### functions etmCIF <- function(formula, data, etype, subset, na.action, failcode = 1) { if (!requireNamespace("survival", quietly = TRUE)) stop("This function requires the 'survival' package") Surv <- survival::Surv is.Surv <- survival::is.Surv if (missing(data)) stop("A data frame in which to interpret the formula must be supplied") if (missing(etype)) stop("'etype' is missing, with no default") Call <- match.call() ## arg.etype <- deparse(substitute(etype)) mfnames <- c('formula', 'data', 'etype', 'subset', 'na.action') temp <- Call[c(1, match(mfnames, names(Call), nomatch=0))] temp[[1]] <- as.name("model.frame") m <- eval.parent(temp) n <- nrow(m) y <- model.extract(m, 'response') if (!is.Surv(y)) stop("Response must be a survival object") etype <- model.extract(m, "etype") ## cov <- model.matrix(formula, m) name.strata <- attr(attr(m, "terms"), "term.labels") if (length(name.strata) == 0) { cova <- rep(1, n) } else { cova <- m[[name.strata]] } ## need to deal with etype when that's a fucking factor if (!is.factor(etype)) etype <- factor(etype) levels(etype) <- c(levels(etype), "cens") ## Creating data set for using etm if (attr(y, "type") == "right") { etype[y[, 2] == 0] <- "cens" entry <- rep(0, n) exit <- y[, 1] } else { etype[y[, 3] == 0] <- "cens" entry <- y[, 1] exit <- y[, 2] } etype <- etype[, drop = TRUE] from <- rep(0, n) to <- etype id <- seq_len(n) ## cov <- cov[, ncol(cov)] dat.etm <- data.frame(id = id, from = from, to = to, entry = entry, exit = exit, cov = cova, stringsAsFactors=TRUE) ## Now, let's use etm tab.cov <- sort(unique(dat.etm$cov)) state.names <- as.character(c(0, as.character(sort(unique(etype[etype != "cens"]))))) tra <- matrix(FALSE, length(state.names), length(state.names)) tra[1, 2:length(state.names)] <- TRUE cifs <- lapply(seq_along(tab.cov), function(i) { etm(dat.etm[dat.etm$cov == tab.cov[i], ], state.names, tra, "cens", 0) }) X <- matrix(tab.cov, nrow = 1, dimnames = list(name.strata)) if (ncol(X) > 1) names(cifs) <- paste(rownames(X), X, sep = "=") cifs$failcode <- failcode cifs$call <- Call cifs$X <- X class(cifs) <- "etmCIF" cifs } etm/R/print.summary.etm.R0000755000176200001440000000143713060253413015004 0ustar liggesusersprint.summary.etm <- function(x, ...) { if (!inherits(x, "summary.etm")) stop("'x' must be of class 'summary.etm'") ## Find out if we have strata if (is.data.frame(x[[1]])) { ns <- 1 } else { ns <- length(x) } if (ns == 1) { time <- x[[1]]$time qtime <- quantile(time, probs = c(0, 0.25, 0.5, 0.75, 0.9, 1)) ind <- findInterval(qtime, time) for (i in seq_along(x)) { cat(paste("Transition", names(x)[i], "\n", sep = " ")) print(x[[i]][ind, ], row.names = FALSE) cat("\n") } } else { nn <- names(x) for (i in seq_len(ns)) { cat(nn[i], "\n\n") print(x[[i]]) } } invisible() } etm/MD50000644000176200001440000000673613725704663011400 0ustar liggesusersfe1468d3a858f14221f02594e528aa9e *DESCRIPTION bf4771a352eea182f8857ae19ab39f31 *LICENSE 5b727d383e1ea6bef8ce90fee8d0534c *NAMESPACE eaeffe35a8b4f9a4c649e1d6c9ecb562 *R/ci.transfo.R 473e907af768c5fbebfb9f27b926b6e4 *R/clos.R 94e754d78ab8e1a9d0ac25318af1402d *R/clos_intern.R 31f457ed77326cc80ce76c90eba5e7d8 *R/clos_pure.R 9c08aff9c1a44097a18965e57bbde0a8 *R/etm.R b201acf7e285393f01f3c5732fab04d6 *R/etmCIF.R a025b0575eb645f9164b967b13b3363d *R/etm_intern.R 1c839bfcf2d515d0263d523d1e9164db *R/extract.R 35b0bcccc2953598f9264c29afba5b0a *R/lines.etm.R 6b82e8c5d51e477168b184b9d36551e9 *R/misc.R c97cc25b23be2232b60ee852a79f2742 *R/plot.clos.etm.R 41895dae402ca72ca3bbb27b27b66c62 *R/plot.etm.R 858c4c2bc25f0d57d74f76d6fc685a19 *R/plot.etmCIF.R e6a252069894c090a2f66169a6c5ee26 *R/prepare.los.data.R f18f5b80b9470edaa72732e1852b3c81 *R/print.clos.etm.R 44f54efbf70cea5271661a4424450394 *R/print.etm.R d5c58eef22053d56c05fa47ec6bf910f *R/print.etmCIF.R 60dd0e4ad256d9a9865fa83a6be5e357 *R/print.summary.etm.R 801178e57467ad2635cce90aac7ddd58 *R/pseudo_clos.R f008b730118c0646e6bf34c797073d0c *R/summary.etm.R 3d95d0044e7f34dae51be145af4d0cf4 *R/summary.etmCIF.R fdf4b7fb04939fccfd3b6c41e14ee453 *R/transfoData.R 51ce105f7d32832c7ae823b78e5d2362 *R/xyplot.etm.R 22ffeb4077655dafa2616b2d62a50258 *R/zzz.R 81075f4111ecf686ba3e8248e748144c *README.md 476bcb434771e9b96558abd030d09396 *data/abortion.txt.gz 6ab49cb48191ac4da0f54e4804f19ea1 *data/fourD.rda dcae240445955c2f848e08eb333100c2 *data/los.data.csv.gz baba7e394ff9255728343ee4dc10b546 *data/sir.cont.txt.gz 1622cbf13863ed0debde782fa2742772 *inst/CITATION 3c6bb46d26563280b6d7bf86a82b760e *inst/doc/etmCIF_tutorial.R d995bff8026f0562f9b944ada1ed995c *inst/doc/etmCIF_tutorial.Rnw e97597ac5ac892807f7ab083a2896343 *inst/doc/etmCIF_tutorial.pdf 5541acbfe1040be8fbb765e7d2f193fe *man/abortion.Rd 6989cdf3614ab98dc901a9acd4ebe1ae *man/clos.Rd b7260a7ae888976f46fb464b1c42a655 *man/closPseudo.Rd d3ee5c8613c3d4e5d21fd9353bb1d474 *man/etm.Rd 271989b496081f4fd77463a7ecc82f1a *man/etmCIF.Rd d5350672de6c7492fbb83a836971b273 *man/etmprep.Rd fd38028a1eabb4129f91a55efe1b1ea1 *man/fourD.Rd beafa275eb3031638c9c2ba9a70ddcfb *man/lines.etm.Rd c1b89e51669d0c7a05cced57bcb65931 *man/los.data.Rd f17dca99e74128f1328ec1319537ca23 *man/plot.clos.etm.Rd b19292b32bfa6ac5ca48353e21a22841 *man/plot.etm.Rd cc29202e4d5e747bdeaf04d8755f5a05 *man/plot.etmCIF.Rd 37ece37de86bb13e66c65dd32fe9f884 *man/prepare.los.data.Rd 00b1458078dc4e1f9622ecb700d5e21e *man/print.clos.etm.Rd 4ca64940f92d9b71c0dbc4efdb7b3efc *man/print.etm.Rd 56daf01bfa198bce09b75d76f71b7427 *man/print.etmCIF.Rd 474d026085ee1807de4de6426dcf549c *man/sir.cont.Rd e8a6b0d2101968441cba31902f4c77cc *man/summary.etm.Rd c673ffbe169fc14c22762e957331e5eb *man/summary.etmCIF.Rd b864fd140417a12c804315ad061a427a *man/tra.Rd 9b3d2c7f15770074499e0c75e844971a *man/trprob_trcov.Rd c4f6038afd25a1e7d383d8e91cbb1ebf *man/xyplot.etm.Rd ba32818dd84685090cce692c2a92298b *src/Makevars 8d46d69896a1f1d31ed76035a0e49d67 *src/Makevars.win 8b4a6007502cf8b2c74e3712e025dbc0 *src/cov_aj.cc d3f6b170f89f00a533692ddbbd5a06d7 *src/gen_msm.cpp d5f5f251eb8f170e07624d9b308643c7 *src/init.c 8c8d9c0557fd89b3c9a725a238e6bb42 *src/los_etm.cpp c6d79c413224332c4e5f9fbb55881da2 *src/utils.cpp f7528d19da8933f83bc94570a571b564 *tests/test.etmCIF.R 6f81b538c1c28dbaaee58f1944afaf53 *tests/test.etmCIF.Rout.save 694b108943d5d7c16d17709040726db2 *tests/tests.etm.R f8495f802ba6da7c1bbaa8b5413587de *tests/tests.etm.Rout.save d995bff8026f0562f9b944ada1ed995c *vignettes/etmCIF_tutorial.Rnw etm/inst/0000755000176200001440000000000013725621640012022 5ustar liggesusersetm/inst/doc/0000755000176200001440000000000013725621640012567 5ustar liggesusersetm/inst/doc/etmCIF_tutorial.Rnw0000644000176200001440000002514213234163603016310 0ustar liggesusers%\VignetteIndexEntry{Computing Cumulative Incidence Functions with the etmCIF Function} \documentclass{article} \usepackage{amsmath, amssymb} \usepackage{graphicx} \usepackage{url} \usepackage[pdftex]{color} \usepackage[round]{natbib} \SweaveOpts{keep.source=TRUE,eps=FALSE} \title{Computing Cumulative Incidence Functions with the {\tt etmCIF} Function, with a view Towards Pregnancy Applications} \author{Arthur Allignol} \date{} \begin{document} \maketitle \section{Introduction} This paper documents the use of the {\tt etmCIF} function to compute the cumulative incidence function (CIF) in pregnancy data. \section{Data Example} The data set {\tt abortion}, included in the {\bf etm} package will be used to illustrate the computation of the CIFs. We first load the {\bf etm} package and the data set. <<>>= library(etm) library(survival) data(abortion) @ Briefly, the data set contains information on \Sexpr{nrow(abortion)} pregnant women collected prospectively by the Teratology Information Service of Berlin, Germany \citep{meister}. Among these pregnant women, \Sexpr{with(abortion, table(group)[2])} were exposed therapeutically to coumarin derivatives, a class of orally active anticoagulant, and \Sexpr{with(abortion, table(group)[1])} women served as controls. Coumarin derivatives are suspected to increase the number of spontaneous abortions. Competing events are elective abortion (ETOP) and life birth. Below is an excerpt of the data set <<>>= head(abortion) @ {\tt id} is the individual number, {\tt entry} is the gestational age at which the women entered the study, {\tt exit} is the gestational age at the end of pregnancy, {\tt group} is the group membership (0 for controls and 1 for the women exposed to coumarin derivatives) and {\tt cause} is the cause of end of pregnancy (1 for induced abortion, 2 for life birth and 3 for spontaneous abortion.) \section{Computing and plotting the CIFs} \subsection{The {\tt etmCIF} function} The CIFs are computed using the {\tt etmCIF} function. It is a wrapper around the {\tt etm} function, meant to facilitate the computation of the CIFs. {\tt etmCIF} takes as arguments \begin{itemize} \item {\tt formula}: A formula consisting of a {\tt Surv} object on the left of a {\tt ~} operator, and the group covariate on the right. A {\tt Surv} object is for example created this way: {\tt Surv(entry, exit, cause != 0)}. We need to specify the entry time ({\tt entry}), the gestational age at end of pregnancy ({\tt exit}), and an event indicator ({\tt cause != 0}). The latter means that any value different from 0 in {\tt cause} will be considered as an event -- which is the case in our example, as we don't have censoring. \item {\tt data}: A data set in which to interpret the terms of the formula. In our case, it will be {\tt abortion}. \item {\tt etype}: Competing risks event indicator. When the status indicator is 1 (or TRUE) in the formula, {\tt etype} describes the type of event, otherwise, for censored observation, the value of {\tt etype} is ignored. \item {\tt failcode}: Indicates the failure type of interest. Default is one. This option is only interesting for some features of the plot function. \end{itemize} \subsection{Estimation and display of the CIFs} We know compute the CIFs <<>>= cif.abortion <- etmCIF(Surv(entry, exit, cause != 0) ~ group, abortion, etype = cause, failcode = 3) cif.abortion @ Above is the display provided by the {\tt print} function. It gives, at the last event time, the probabilities ({\tt P}) standard errors ({\tt se(P)}), and the total number of events ({\tt n.event}) for the three possible pregnancy outcomes and for both groups. More information is provided by the {\tt summary} function. <<>>= s.cif.ab <- summary(cif.abortion) @ The function returns a list of data.frames that contain probabilities, variances, pointwise confidence intervals, number at risk and number of events for each event times. the {\tt print} function displays this information for some selected event times. <<>>= s.cif.ab @ \subsection{Plotting the CIFs} Interest lies in the CIFs of spontaneous abortion. We display them using the {\tt plot} function, which by default, plots only the the CIFs for the event of interest, i.e., the one specified in {\tt failcode}. \setkeys{Gin}{width=0.9\textwidth} \begin{figure}[!htb] \begin{center} <>= plot(cif.abortion) @ \caption{CIFs of spontaneous abortion for the controls (solid line) and the exposed (dashed line), using the default settings of the {\tt plot} function.} \end{center} \end{figure} \clearpage We now add confidence intervals taken at week 27, plus a bit of customisation. \setkeys{Gin}{width=0.9\textwidth} \begin{figure}[!htb] \begin{center} <>= plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.6), ci.type = "bars", pos.ci = 27, col = c(1, 2), ci.lwd = 6, lwd = 2, lty = 1, cex = 1.3) @ \caption{CIFs of spontaneous abortion for the controls (black) and the exposed (red), along with pointwise confidence intervals taken at week 27.} \end{center} \end{figure} \clearpage When the figure is to be in black and white, or when the confidence intervals are not as separated as in this example, it might be a good idea to shift slightly one of the bar representing the confidence interval, so that the two bars don't overlap. This might be done manipulating the {\tt pos.ci} argument: \setkeys{Gin}{width=0.9\textwidth} \begin{figure}[!htb] \begin{center} <>= plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.6), ci.type = "bars", pos.ci = c(27, 28), col = c(1, 1), ci.lwd = 6, lwd = 2, lty = c(2, 1), cex = 1.3) @ \caption{CIFs of spontaneous abortion for the controls (dashed line) and the exposed (solid line), along with pointwise confidence intervals.}\label{decalage} \end{center} \end{figure} \clearpage Pointwise confidence intervals can also be plotted for the whole follow-up period. \begin{figure}[!htb] \begin{center} <>= plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.5), ci.type = "pointwise", col = c(1, 2), lwd = 2, lty = 1, cex = 1.3) @ \caption{Same as the last pictures, except for the confidence intervals, that are displayed for the whole follow-up period.} \end{center} \end{figure} \clearpage CIFs for other pregnancy outcomes can also be plotted using the {\tt which.cif} arguments. For instance, for plotting the CIFs of ETOP and life birth on the same graph, we specify {\tt which.cif = c(1, 2)} in the call to {\tt plot}. \begin{figure}[!htb] \begin{center} <>= plot(cif.abortion, which.cif = c(1, 2), ylim = c(0, 0.8), lwd = 2, col = c(1, 1, 2, 2), lty = c(1, 2, 1, 2), legend = FALSE) legend(0, 0.8, c("Control", "Exposed"), col = c(1, 2), lty = 1, bty = "n", lwd = 2) legend(0, 0.7, c("ETOP", "Life Birth"), col = 1, lty = c(1, 2), bty = "n", lwd = 2) @ \end{center} \caption{CIFs of ETOP (solid lines) and life birth (dashed lines) for the exposed, in red, and the controls, in black.} \end{figure} \clearpage \subsection{Some More Features} \paragraph{Competing event names} For those who don't like using plain numbers for naming the competing events or the group allocation, it is of course possible to give more informative names, either as factors or character vectors. For instance, we define a new group variable that takes value {\tt 'control'} or {\tt 'exposed'}, and we give more informative names for the pregnancy outcomes. <<>>= abortion$status <- with(abortion, ifelse(cause == 2, "life birth", ifelse(cause == 1, "ETOP", "spontaneous abortion"))) abortion$status <- factor(abortion$status) abortion$treat <- with(abortion, ifelse(group == 0, "control", "exposed")) abortion$treat <- factor(abortion$treat) @ We can compute the CIFs as before, taking care of changing the {\tt failcode} argument. <<>>= new.cif <- etmCIF(Surv(entry, exit, status != 0) ~ treat, abortion, etype = status, failcode = "spontaneous abortion") new.cif @ The {\tt summary} and {\tt plot} functions will work as before, except for a more informative outcome from scratch. \paragraph{Taking advantage of the miscellaneous functions defined for {\tt etm} objects} The {\tt etmCIF} function uses the more general {\tt etm} machinery for computing the CIFs. Thus the returned {\tt etmCIF} object is for part a list of {\tt etm} objects (one for each covariate level). It is therefore relatively easy to use the methods defined for {\tt etm} on {\tt etmCIF} objects. An example would be to use the {\tt trprob} function to extract the CIF of spontaneous abortion for the controls. This function takes as arguments an {\tt etm} object, the transition we are interested in, in the form ``from to'' (the state a patient comes from is automatically defined as being 0 in {\tt etmCIF}), and possibly some time points. Using {\tt new.cif} from the example above: <<>>= trprob(new.cif[[1]], "0 spontaneous abortion", c(1, 10, 27)) @ We applied the {\tt trprob} function to the {\tt etm} object for the controls (which is in the first item of the output, for the exposed in the second). The transition of interest is from {\tt 0} to {\tt spontaneous abortion}, and we want the CIF at weeks 1, 10 and 27 (just put nothing if you want the CIF for all time points). Another example would be to use the {\tt lines} function to add a CIF to an existing plot. The following code snippet adds the CIF of ETOP for the exposed to Figure \ref{decalage}. That's the {\tt tr.choice} arguments that defines which CIF to pick. It works in the same way as in the {\tt trprob} function. <>= lines(cif.abortion[[2]], tr.choice = "0 1", col = 2, lwd = 2) @ \setkeys{Gin}{width=0.9\textwidth} \begin{figure}[!htb] \begin{center} <>= plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.6), ci.type = "bars", pos.ci = c(27, 28), col = c(1, 1), ci.lwd = 6, lwd = 2, lty = c(2, 1), cex = 1.3) lines(cif.abortion[[2]], tr.choice = "0 1", col = 2, lwd = 2) @ \caption{Figure \ref{decalage} along with the CIF of ETOP for the exposed in red.} \end{center} \end{figure} \clearpage \begin{thebibliography}{1} \bibitem[Meister and Schaefer, 2008]{meister} Meister, R. and Schaefer, C. (2008). \newblock Statistical methods for estimating the probability of spontaneous abortion in observational studies--analyzing pregnancies exposed to coumarin derivatives. \newblock {\em Reproductive Toxicology}, 26(1):31--35. \end{thebibliography} \end{document} etm/inst/doc/etmCIF_tutorial.pdf0000644000176200001440000050122113725621637016323 0ustar liggesusers%PDF-1.5 % 3 0 obj << /Length 1573 /Filter /FlateDecode >> stream xڝXIoVWH!V..P4@@S,QEڊ# .offQ*ZE*t~rz\hCmiWFLXF7GpoViMbrz Z\;oK+M IQǰe~g܇??"2(5:NJ4TMm2EiJ>lrs\0s/3ST+.Ҏ ڽhΚoO8y S8]_hPAŢ ~_be5+ o4yo&g2<(2zcb=v]0H̺Sm !eY1NRheA$YFUV&G@E~(Dv(+] ߋxIʥچxnќiW\4sDؓ.-{L X 0C=b iԬdž(ڳ7h'!VT (rYJF/gOߔWd-\EZBz'/buv0_`LB0w!SpGx^w]{Q&OT=2'u/LqJWҝΊ| 2ւ\<9R[gXSTY%3A-|SRJ1q n&]kѢc"-fBܴOIrGԇ,ҫʼ6/ )^L@(7O7,Iפtߔv@Xu%ϿG̹Wێ)DWu2xB}DZjΔC`oI}pp)陡P.b<ԉK sNJ10@vL#_PwJV᜝ *7%A#xaTg}ǟ¶M($4 -)ї1kЊQ$`V9tM/Ỏ q3ƌS+78GƺiJpJuz69'4*'gT(΀{j5}XdPog@a6pםgu|*c7ɍZip4. <,z{${lo^-l ptoܙĒP@a=gع oùd$}R@xI;`1sk%1 iա&`Od)Œp$8퍡D]z>|yh2EQ(}=D,SᰭGcG2nEAM]`FA4r' K4D% +/G@2l"6qq%' endstream endobj 16 0 obj << /Length 2402 /Filter /FlateDecode >> stream xYKۺWLWՠc^%*-ЦI.)hۍ2,;s{^(Y$@Ō(>9o7>MҔ77t2ܯnmouӵFՅvaN0ܴ8γ6l˹3<&ˬ=7&.UUpc t\h*+$_L <׭ Ny˖g,IE7 ]ʸ ZNKۅ&fZYxL0rHJ]!S@@Bĝ>pw<5v|Ul0T" Jf"z5|>ljFD@Srxy*=v;5o+=)1#áAx5|NƎW-;r(cW]9( X@#TpA-6"mLH}^ Blp$ϑ)\wQpE 㭄^l:Mrw9lc!0gk8Gzm 0gp`oDDi-d/X#}[I6Vc;..FQW+Ұuz芹 ,y<.,oQת^@28|@HPb0l4ӚāgUA /z%ٶPc&lG&nEa'&>Dqy>6 sV_)X9e xmVFr ~KP++7x١ tnv83y0()5s\~]uY)ׄ,pPBX A:B3 2Z ]+ dt>ݓ2ET'' ; |p߂.-$M!hsSO18l\`^Í򎔞 L᢭u]es#R0 k C2YwR~Z :F"!Y.FcLjޖoHѼ;Qn'}@9!ocUb\홈`L!ۅ߀G )Pp0O^`jct;q/`#Q;h@5M[_*+Jm28SMH΄^kHf< R/ :D,%Aupkk͓+/ ExxBwӳe<(fvGG (=$ /qFv0,Tuv/ZA v$1i 1~={"@rX3ym(eemkِM5`TUC2esU/|L[i;A<^Jkn3umR>C=DYm[lQWb$`1bQPQqh#$עA7C) y)M+b헒`bp!eLKNw41sXN c2-dT~!#ch6{~>oDԃU!p;nĂ4 1J=Md&a~4ȇPЦfBrIrL+Kûm]~kU*Զ_)m6DG4KS@kr(AmhƎŕvWLBjI7+6i˜CHc6xB{b\(6D\nEFhmhRxgoX,MO|VU͝+< ; BD^N0 4i(j-a4$I-re*f鸽C爫"W x"xgb!lqD=|d0Y'\ Ȕg'ґ^i9-ifBV;\O0\ Ee'ŏ˟@B2i /+8q'=&eܟg\ߤOKOcuc@}DluN0۲,7Yw> stream xYKo6W蠕@[4(CndGE}Ed;遖Doo82~ś+h2љwUannfK=[A̝2Wr Ijv_|'.#˭.Yu8Wh~ G*UJg)O AiH GJVRjaS'Q*)Ϡ2R 񢔧xD3ȴ ŵ kf#]uc{yꊨ\arcFkFv[((Pxb7 ̡Fo++p̡IX%fEtJ#ϰEI K/+H3( hػ^YhLc4<+Mho͛:h <e*XngM3[ܽRjv+>?ϺE'Š2(rQ/yH76@ &$h5 x6/q"89196 p|}qv<Aw~u<5GZA;tP)_ L"q'h*Vm`m5G&UJ=##4BP)6 mº 2#j^Rf +_%"b-˪\IBCN͖-OWu@r%봍u\7m}^C.,iu]4 T`4b{񕅌o2g5KOÍ{jz >la.A|PW/gbVfKˏ@\iA=.&-ع~Ļ9e{L4yD yvE%W"E~m8g-|.8ZV2` C}@O |xVJBC%7qpLsgn9]^.JBVTd2f$Nr6>[t>C=ϖ3Ĭl(l9$p$lvƉ')HKί W*i4lRKe'Z*kyNKZ~-]^_QKT|NjtE/U5'Nh{ϏSITfi Z''I#G# F\Y> stream xYR6^z*z/ RduTe\*`V>z䶭bd8-nUUW|'TW*PŶbFVCnj$zb+ M~q+3;W߹-Ϯچ8+ _ymTP5jkuvrW+%7YY8 9`CP&]XW40zZ.5.p+=ή0-C m :(EF51꒖l6&GX >p{9dKPZ2 dmg1e8&(Mޖ(U> q^F|9JC({)tl+Tǣq_?Jg(bٽ|7`V\lBHӞe,v9u]9뉖ɐ,0B3I% o/0CS.r2f#쫇ȡs2+$s99(\D8"B_ e`|Y)1о "MAvB/ Nf"b)FV}8QB4 =R#<=%;7`E`'nq/ # ވoH(dK2GЗ{?t|)aJاcjJtK\C%ӣkbsTRM^ z [Hdo "E'a'Q" 2 {þOJBˌNB x\ds|gnzh#~5 #U`,\ hү=$9,F|Ʊ$ s0 !,P:0CH2ʇx74}ŒՑ5bd"S;fs5A&y22C>Q>G fXY#DЦ?3gGA&AbQn>ԇTݷLr.J?BRL*?n@y2Q} eMF&0 އ%~&txJ<-2}U('~z~춱`ClvNwAUֿH_%y :kh(8ױ mR#pIS9ָNx?I.?{Ħ]s{q߸ W\4HV_o8߾)v aEG=6/~A86F O@^Zm?mR6B걂'as{|阿.N=v:|^ĝ &>ԹkUtˁG10o5Z endstream endobj 27 0 obj << /Length 413 /Filter /FlateDecode >> stream xڅSMo0 +ri$$!>:uIܶ]% Pi?VZM*+瘄XžKcXs# +j&Ҕg2).lƊwQe#6`-`k[W&%x*m$L0kͤdmW̍"̥TA.xߔ'xFJzyӻNJPFa,Q,MصHV ]oGjw&>+oR3 =IP:&10yO, Vߐ i:]V)!oፋܽ#ݵ#S{Fd3*SMiwxc=ll2{A*MrI n/\NPl䄝ngO;y87XԯF @ endstream endobj 21 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp2Bxm3q/Rbuild437a290ae595/etm/vignettes/etmCIF_tutorial-006.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 28 0 R /BBox [0 0 720 720] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 29 0 R>> /ExtGState << >>/ColorSpace << /sRGB 30 0 R >>>> /Length 894 /Filter /FlateDecode >> stream xKo1 )|l<*@T v%* jˣ>$`3i]W3p{?<gNR ߻Ww=(i8UIAH7C ^Ȝ{4jtDGsnd0h/8 gn?ٗ_-l{p@,9$T(3u _yhfze7;LѢ3gsR98ɡQL&AIYK2MVH2 NvA^p'{'{ wϢgf,!z>7.u[En9a4fw7;cD=nv\:G]U$yx̀+LTq/\8ps9!wa'deh|wrvs ZN889ۋˏۋ{؟?s Y \oFcmu:0&Ϙ'LۚcbOF39q= d a2#(3}WYbm#3 ^/xIn5jGVe?dfZQ&;ōdVXg f̅vH Ea5r* ;> Tw^ T[jfJ<)5PAGlY冟)b"Qs.Nʬ22+fRY1wχ6m.ʭ+ ge9_HkvrGfxZ#0,pD-!JgHIz'&9+YmnsVvۜ6gelЪImnDj}<g~{VF6\p^<>za%,^wB endstream endobj 32 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 36 0 obj << /Length 660 /Filter /FlateDecode >> stream xڅTKo0 W9XH%öfnw$vG"i"P$DRP{Oe Q'F BgsiR+F3;Y44sQ먎M{< 6֨}T:C?sR\5ϱ  5ul F#g4D&C@95>\M0 N0H%LYK#ԕDЅ}0t. PB$/ĚiQYp,0l#w N yfd՟Z9q7acȁlP[vn@xŗu'|}n:K/$IN3wb1_нVxya>t`@w9&z޸QyI3rs& <}̴16>BUsL+m4$*ɡRL=ecakķ~*i|&ף'Me al!U!> /ExtGState << >>/ColorSpace << /sRGB 39 0 R >>>> /Length 964 /Filter /FlateDecode >> stream xn7 :ڇ2EQ5F@ ^ ޢ6v'mH;6PKQ/3ƙQ>o^~\ fYgXs78s- !!59͉3`Kn2WlvRDb go_V6r4y!TCy,^n7|@3_ً1npřrF9͜ir 29ZIv!YQ}bvzTե)N͎!^=B_nhnY~eD6!q)XYoFTfw.WwCjDO|޶uVX$NuDf k9w-#(4߰AS?]\};\gŷ߾}i0ntlv׺o9,I! eo~5O߻!Dlp!e)qb)NY,0ZK-I#[Uo^z.dT>-YC%;*K48a<`Za0)0Ge5v+,'M ' Zҍ5^A~}zrRHx].Kb`LWEebst*Avg8KrY32Y/:!lelzկʢhY`,Ú֧ѮO@Q|'j.Y1 QgS}o]([W/8Y]fgu) wKΚVaGM\TeV^gI5^}10U`HF7>WsQ>UsQ>UsQ>UrU>UX/RUEQ- 9? |BT&X2HRR$6h[?dٹ˥)u/KH4.?_w%>C endstream endobj 41 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 45 0 obj << /Length 908 /Filter /FlateDecode >> stream xڅVKo@+VԨe?#Jozh{pT<^'$Ux3|%B#ϳ4,Rٽq.3mDdDgcUeQrƿG7?MP5T%û*9%ppE(Ȓt$wP@1!r |!QSA˖Z??654Y`|]{6w8@x6yQ畳&,:vz7=PJ9bT(84XjecRuMnLc*,[Ҝ5}<;i71I^*ׄizE`_I[o$g[i!mꎂJ˜ i> endstream endobj 42 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp2Bxm3q/Rbuild437a290ae595/etm/vignettes/etmCIF_tutorial-008.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 47 0 R /BBox [0 0 720 720] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 48 0 R>> /ExtGState << >>/ColorSpace << /sRGB 49 0 R >>>> /Length 979 /Filter /FlateDecode >> stream xMo7 +taAQ5FZ@ ^ 66N#hm1a~̡Fȗ\Q^?uu3hZoOJk< FPh A@TQݜ3Vk"X3 VՎ1A^_lg]ٕ>8rv_P +sHIao.= ow]1qk68;vs pv(Ņ3Ξ*y\`\Uj5C `@l/XrՎ>,/Xr^3[FnW(@*Dq?mBewR|wSmP,dZ:Bz0 &-E4H2cqfN‰[fjr-đs?9eQ^-YU[F.!y.{h|>X9 6069ѯ0a72+W A(s+~yIrלR 0v.s`b(,<9pn!38p$%pG,ϰIuy*3Kϵ+Za5In}>Zo9IXYy4sւ>Ya3~V9i}N!0*ҰG7K}.Z}Z}Z}Z}ZвRY \k;YiF^žϹ~ynIh:8QhV(n%[451 /qꯜKpR8.?w։ endstream endobj 51 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 55 0 obj << /Length 611 /Filter /FlateDecode >> stream xڕTM0 Wxzr+N -'zc9tv MVdw{`2eYzI$IZ?Σ,g(vlf"S4ڤl^_{svsbUX]~{,, >%|H|Eݒ7h R}p|8hj<@S ~C ԔLju &=eEa-J)܄ؘm2RÕt܀H-E.u@'6ܥ*eI @f2hd hv"'B}oEq&~yOΓ;xzIK&S@UDž@0 do/tW"Ǘ&NJ/jk2ȷy}WdLc`F҃"k/Gzlqj|wH?)R9҅R)F"#ֲ> /ExtGState << >>/ColorSpace << /sRGB 58 0 R >>>> /Length 1515 /Filter /FlateDecode >> stream xMo7 @+tUG5FZ4@ ^ qI۟_riM=΋Vc 'R33̟k_i^V1[*Vp+n#XGT25T0.- rr8:3[,[0Y3]HxvDǖ].F(`{ ;©Xet]@g\g\g\g\g\e\g\2U:*;KXֿ;,=9ezmw>Jmȶg{ζ{N\vϙ V5 Nxy3gk[pIn*:ӑ.[l2gs9[Ze*sVkVk{5[Z^a} ˼p#|n`X8~89A}\uCH'v6Te6TrE17Cu&Cu&CWPPPɅnPmx*::::::*:㑡:*0_ُo'r݈/\/R qxm'upJ]?>>߿[zR endstream endobj 60 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 64 0 obj << /Length 856 /Filter /FlateDecode >> stream xڽVo0~篰x pm'NIveTi۶VߝNB-S)rl;lvN&"А\Iي202rjFn#9i*έD/UBBJ  PFd'ujXܝHa6fn5-WqrF?9Зx 岑2Jnu+{G1NMN|&-"҆hO:]'GGB9Mc$p?Wdz\ ;x&R*/:;< <zǢ>?h< %?ۮ)(J@ë?i<@Rȱ- vNH>4XW:ȧlx~*YI?VW~aXVOrB.yYO_R=rP6Ƨ/ݱL)c'>vMt!m endstream endobj 61 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp2Bxm3q/Rbuild437a290ae595/etm/vignettes/etmCIF_tutorial-010.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 65 0 R /BBox [0 0 720 720] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 66 0 R>> /ExtGState << >>/ColorSpace << /sRGB 67 0 R >>>> /Length 1182 /Filter /FlateDecode >> stream xKs68J x,^W{N=}[39xrDnm i9hi`oB;W3q~)tsS%b/q&^5:JӸu  N03n?۔<YC;|2@C ًZ]w鯼jX}B0[asB0D+u (*`4 Mmʘ UDӨ.8[ӸS/8 W}We ^D/͖Gm)NS?9[5m/u c{%G.0g|.A[DTA t,7GU_~-/^ j+~xnnbsurp.e&9?T-0 yu Kv3u)srϥgr9hiGI/p>k8Ϲ;,fW\o鈤%EJIIIHIGIFIE 9$9$8$Z Tzz-&$^_y7cP{2*_y7cOoHl endstream endobj 69 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 72 0 obj << /Length 2037 /Filter /FlateDecode >> stream xYIW0Bwbނ؇@ >9M6Ito۪zaIdV+5[/δN45L[Y1<16/gls~VsCWK eUOʤLk\-4S**%[ D amUR9,@EpnYp'lsy7T>ACK[s##wɣx(DCVp뜅ψ1vd2"1,eUFB8F`-iQ/)b ;Mc;y^>Cݷ`}vki-` lt뢝1xWԸ@7)Kf?0U-*-aHC=H(CuD<;N[VaiQH'xbRh~Q5"4c;>uf񙇑2q,8{VF1jB)"Ghs 9dJL+M+Qж,JEw\4BIt|yɭ1ܖL{gMO,K}HogX(OFWN8{wy݋yGfvq-`LZ{e!>/a\R:7r?㶊3MEH>fJ7Yoa*?)y-GL-QVkء#Mlvf?Y/OE(&/ӍߛƲޗ AjOt.ߕ-C=$lc"b\X6\sg޶cJKP7e^nsWS16X,6+U'3.pncO7ʪw'Mj qsZo34 besϛKً&+!1Sh #UMeRuH$Wtʶ\AQW0 Umdh._)$TD!? 炤T_n63iA1wguNI& T=1kafwCk' ثQ78uJ@~/0Ckړɤx(qd?lw,D!=`6'_`\qcؕnu_<Ƀ8TcN*PΓS d)LGƇ42o&CEˣM8qo2 2$aGtkg mb>y$hV>kh\T'hcI:nEQ4uw'K@J׸'W7~$C`ήZKdr~㇮ս! 5Ы&|TW'űljy>0f)=-ê<@ݝϙ#* VσIaFAך+,EI\2pN&yj܀ߞZ~U'T=up6P7\ &*]ŏ_Ӛ()!>ñҀvAJW( R72=L1pu& ԁeFhylp~,cN,XnCke~rA$6 .97.HGTբ^-PF/*GEm%D{AK t(nŶZ)漥#\RP _SۻdBGp6yTL D-3s5O?

> stream xڭXK6WT d>$J*i-K{pCJ֒ag^h˻idԐh[ϴ[>{yS-jU{*]Tj.{_]eW&lww?->\2+^xu BqH6&˛7^B*L {#Sy|m+]Mk :s;Ϥioni45 @52]\[]kcT]h쑉ܒQFXa {$okXAr)Ht tx3A{mѩ=_Eo+zl玸 g P'6:G}k5!mӶ[r@;3Gd$|yy&"1,Q{5;cׅ3ld(0PS{숨`| ^'+\K\tNö Nm% 2 M,!Ky{ǫ9q`Dy9-<7(g]3 Dqǎ=hĹWie˳ll\̭-m8o <(wߣ}Z9I/~z`iᲾh*V=zE qc<^BP2>,4L^+kk"!_!{X+bwg>O}CQ4d\DXd$V S Ò Mxf!BLɶ3(}Npg`[ ' U,?WPi0 *kv;NWmVEhUYOwuaZ/1@B9 g8rMtĆihQ`.@-I6hiYYbA79m<]Z#w*.bt6WIA E}t?ISb$+ T(%c,NyO?DR8Pl lheH7:w=}JtTu-@ kUH4o\øďdRDA#'! (4Wc[[";qCq#v"* &gʜ&VK31]ov( "}Mp,^ÁBwЮ1\hrP8CNX2U>MjP1w4I_|]S2)M˟!I8Ɉ0͋gL+~\+"?+;h{uVcIz?SH\Ǻ7m'HO 6?ڏ(Y~áOixf=\oy Hh#墓y;B+t;R>x9IϐȊ!0;pƆ_3v}&Egѷ$ʐT^y3%HצJ 8ΰJ3?K|d3@\U)@<2S𫤹> stream xڅQN1 +|LI㼺tQRn݂D)ZE'3cGr,l™Tl59Fp1Yr cGI̖s>֓E%(`Ȧ71(+B@y(ttws}$USW e˸jurA\t|WG'kOJ_b[}tǮiFݔ?c=--̋@kQeY endstream endobj 73 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp2Bxm3q/Rbuild437a290ae595/etm/vignettes/etmCIF_tutorial-015.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 80 0 R /BBox [0 0 720 720] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 81 0 R>> /ExtGState << >>/ColorSpace << /sRGB 82 0 R >>>> /Length 1135 /Filter /FlateDecode >> stream xMo6 :&jA}]7 ma" 2v4e˱)f'45EUV=?ޫhcZ~MA=|z`Ðꤢ :ƊnefQ;:b^!aWl7ۙw?uo:] Ŝ6QAI]kux>ƕ/:ku/pM g9p9`0@`3E_)+bjVi6Wlv~Wlvr!-ׯr^3[FnoQST99Yf/z۔hGnw-v!mv0ma{m>MڪCDI~M%"$ww-#>ZmN\TqOܐ'MZY>k傺::E 7XuBfC(?l w"(!M<3IzF G~fR^C9UlzvVG A30=[#` 2&< :&bh7&k68k:=|$p\`J l E @Lfw]dNV{e \0pEH%.0#2S{ Ff sV~8)Ojb(WQ^kc<׶sIjH~Z^9jc=;Nr2s-w\pVkt>o̵{.VdEMdf-g8Z!sle.SUcgG7eZ!3k̬2Z 3k̬"W-gR@f[z,QrM< =#8(q^(l%q/eq5MlV-8ury-T)K|珗ô-8;[AELW_r$fRx81.̊$~5c>-$O*"x'3K^υ*e!8V%OfI^XBIUdfJ,y2̒'3K,y2\%Of endstream endobj 84 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 87 0 obj << /Length 467 /Filter /FlateDecode >> stream xUS=0 +4JYG$[4 tvpc% Xz?_dP|؁)eخ[gH{̻ uwB81"Il.<]okTUFZՙ$*=`}_ op\@~( l…U5"K#QBQOrk1qA2Ty* Kp84*e;= ULg;]?lZj1h H&lF9$c " k[_n#F޻CoZ0 {tCJaT0e#ݸ †_q&| !mxl++\zoe s* UZOtrYPJ\)k7l.w߅U `k*gd m>=b endstream endobj 101 0 obj << /Length1 1729 /Length2 12084 /Length3 0 /Length 13179 /Filter /FlateDecode >> stream xڍPk-@pwwƽww!8 !8N ~923g潪{[WRkJZ:䜝 lBiU)}N7 --/9 . l$ i7*B^ UJNn''C_nB%@ J;xZ@^#)(;@fkt!6 --g [B0@ .B잞l@G0# bAn K)ԀScCh؂Rh9[A= :<}SZaȯ: ? yu&rvC|v?D"$`7[[l[r7}E.6{?_Yv|:(:L]_Ҁp|'Y.?쵶nL dl!fWVԓuoRtvO/wɭ1cȆۭdh,Í2I[#bTGd͙vCS' d~O~mJꅸ=W#4kQgYu⌂KQ#@Xɑp.0MP*%3s}ɕp7V!~Cg|Wo \đ封ye]bu"2V n7=ynSj:z$pRyjR2'r}hK^3n&D"!IG[Q; |:Ͳ[ YQp|cK_vv~!FB^ꍇ?>u'ٌ6Ncv FLCS/X0~T(enp9t`5-Of1r~hi*ģŰeNO 8r>j!q/I}ge>l[\@jrI'؃Q}T Z#li}'a ?7׹jR?M <&z[)+\$eU* L9æpR;W늤l:d7׸y6P^*#e\h&(J. ;MdZit?IxnjBZd|*f աUd'@*S\Z-!fًrEFC۽ עz)bj:%E6aF' %N bkbᵸg 2ݻ♲Z4Hs=A+x}v:XRp8+$|0au=g&a:"2 6ÇGB;l1*Guvv17~/38?TR}+K^y=q+wWsI[6z^梢UX 'X$9P3VY'`3ݭ Ae^PIG_TEldVo*t@a.hqqr¾\ !sl PkjSz6-r"->%>]pe"t33_2'xfIgMIHrݚIGm)ޖ4>#=Z`0Q-(y,103]<7}w"p'تaYȿ4X]BbT۰Cm<񦫖R70u`v.M$5\Y1%~=͡eC[n(uD2j,˄7`x!!8|dc)4 H'#~,S!hAsQӏ$E[iMQc/vhѷtUwb'N9b.euIܓ@lGC+p(:jђVhS/y?4Y5q>؀qm^&B^~@bG @3#ʗل<хO2Pbuec۷^߂Jeq+ ']ihma][dc W6[-Zz"}?NǬL([P =y;/[qt̺g_f]cbǏ=9leKE&ɧ(]y#I:jMp0YpLCj$%<0>/<1N29K/": {7reĶ=ss젎ݰiv 6U8O54:H oog$?ĩ]v{ĺEAy%Ӭ9g6~%(!86֢Hq իi ߿b-j~ت V +qkA²ڱTDm3N[s> Pg Q-zn|?7!R鷑A&Fwf %ֆZY/5ÝQ ~Z@%7乨oI-Ӟ W%OQTwR͹Am3 YeqU8KqlQ\63cv8>-&~@d1gâ2YwQmߡ)B5 !0k6[H&^kscVc(%ٵ΢BQc!n(M-2JMaaoSx01sl|}.]U}XCr u{$uƆ*:- ^OMUo9öżVfV["騔IS#=ȘH8p[9Twt-5qwgKZShŧm͡';P楑Jext ^_Ce#.͵0k0#Ě<<2ÍWPlGM@5n! bHVo`.P"۞>\J";Kzvi(.[4Hq$ʍ2WB%kR-q"D$ؽlOy5W;K}ͪ61cpdTBLF+S<ǛZ{:°;*hRRfgbdپ=̦ (M jX~S{6|ZbwQ L'_ꀤCgA{~fE4UTf^cGn'AB$x={u=`Fwj'gMy6 i&ß1(g'uSXJ%rs`(VY We"+=zҍwW6K{}݉--ov/M&aX >=CȣN'gBuFC7UY΁yEWU5aeu6l#G5Z(<8>z]yn)=P |{B!?U[T<4F1| *& ӭR]ߒ^UV5Zt:7nP lґ5{K. i0t?rN|8dc~z:=*' tm-9꿾Dp?CvM> <ϥ1ڑ  MM+fq72o+h EDXu)4c̭:[[ ͏&+=?bٔ]#=埈gԍQ+8eej:J8 @ mloAчIVh3-wTSл0\_/CUw_lrb,Ǻ̊eզiJ~!~8_YzPE*m]Rs͇o2ƬпvկO=yb*zet' ? D%aPŃN'NLfBWB3dz*>d7̦ !-~m"+iKhX')"z-Zw+^{d ]| NA0Xf j(Y=5oEelMPa"c2g'*Ư=_IPŐ+Rddf/=*(Zk"̙d͞v>P_y@3IxPL]7}=,r96RKmػM\ĂǫNIhHXIm1O SX$۲ ~c{HrL@[C+yڔsu2U|=v:2aIԍHN_ʡ#4}\7P{mW 3a~d7֗v5xV| r&V-i/􉐢o@yZ=tafru `ٯ ֪ۄUP"0f[:HB^uBZkqT@ A LM)B'9r4^C%ڟRU]&E 9K@0ﴏ4 [NĿû]1L.j6FvO~.]U `«%I]U0(`xфUd݄ҡxH$ѵ Ȧ2T&$␎OhJspL(|y6 {ϝݱw 6#) z8?PTZ*zɬ{efq a@&1Tp'شλݮwls(ֶIA$9qGܛ.e\YR~ar]o S彭hg)͘i22uk0Eh>A_?0)K븦CLطբ3"_x'ӤSD4({n_;^=>`l^S&+^9 +Uxy 4=%~yc~RɡI<ҩP 0Ne.ۭqa; 9](6ǴW8v1ɬōy*ZKhN&WN#* krǷKHI]$}3(aolWKr5uJ wRSiƚ'fma닸Q'>=AFեc?Bdm ̢F7\9@&0Rc]V$LoI73mX<,e3{aq"W 4 Ww?8i8pSVĚy8Æ4h[6%L!IYy^ρ#r}Wē֓@X'  [bCXloLrVc{9S|>.2h,ttt)Gn|e?xh=/obfРQׇg~=|bk (4^']D5N͞Q9G'%v``#श#M1dXV] ׅo8gnT `4"/{r@}$szԵ6ںǞ6#.40NZ*urRoQqpfju_QvGT*lIz?hqCgRF)7?s m ˱tbǷ1AS7|N~:ל?`o)6$՜Wp险 cFCNjZ:1G8~`Ų 9H;1}LkQqVCw zG8-Ҋ'֬-yǛ. ?W[=H|I\Lu6QvJvϜF}[JZTڢw(=LQ?7>1i9k,MkzNԽa{\ik p B'kF5ݓP_(K/`.> f-0R|FgZc/‚ @K~s}vOGF{x$+bYHP^9w ~\'!]Gs+Ël}ukQ?VdA<3H[k0 AP뾓*<'Xw"c'E]N,_;rS)^ g]Dh2&o\v~|!Q{ʭ L+ZjJL8Rz>KE&lüѹ+oG{L#g0iRx! 2DoAɑk.bR?AMyGFftVIrsϔB-9ai^ s'gN N}IkSpt)MX#?"(ѧ|B`yGZA-mGrei(u8|9%̊<,6JtWDI%윰"2BS8)ߥ,<}_g i>f.ObM{},~}?,7h<$6{Ť}-dϪ:ۧLMQ);hp&>|hGnxq7fPȾy4 HcG55(*EMP>8r9*{`Vc4=c{Yz&/CQ,L1jw䵲& ^pÐ'gY GX:lkU >c*gw8[53\j)I9YǵUa޶&KÕ?cɒS^CS}2n >|]|35DA7E(IQݿ~],LY0Z)G;_N`(I9;T\MDT~3,sTmz#v,'(2=8YEl8X ^R9$jx [r~AAn֬ς a4QUWUnۋuYϑA wRhp;Tn ,s?i$XZ-r?v>Q7vz9j(uRP=X ~DICy}t2=хi> ݣMaen4p :ˬMB*@h8R?c"Bm #s_ЕZ7eTD8o"8Gv)v rdc?bH̡:9EV\5֍kpNǯQon&ڨDgN.I3^취S`cYq4?9u)*tL6:;Żs`"1Cs'ͩX8jx=W05RxƔ#fs߰y[>W E6>͆o-?z< Uz L&x50vF^wUTK'QdUS ²2p~9WFe8CK ʌlnFXOy{#̵  L[QVe}Z4Uћ͵rш1Zk+jE~1zS8nQ= ׯy&j|}{gq?DFh<Ö'F.ES,uKRFOLVu6J˙*N"+o2!*ϽƶO=W!Wi65P9x %&@mό48c*AZw 7*e^;. N;VxvFXXE^n]`a->:%>),ী:vbތ"+I#IzMA ]AㅙI?>XO‚{IJCŒ~RhϪڈR> Vcü}nH]- _>mP&)6h 5ȪIEs7YB#84 $3o9rB٬hzV't&%Eh)Ov!u[%殯3jۭwc(N#kPzŒ S"r ƈ}Gwn%~rRK\vu~T7&0UZɣu:g8H`>̡[.U] }⎐$H0pG*?/_ӿ##rQFݕQ/.>KFd}hoO:4`I6[Mdޛ"j]Գmw,nYNLqNPT o˴n$BHjTN7qkFK_d2XAu۱0%ϨX84rwΊY+L^mT pԋ+s+a͌mo|.5\uGm> 3u!y͊ɍ3lݭ3,Nm"3 |ܳ * BSS>,q˷``kξm8-Kweʣİ}>EW֧;-dzT@RPH7G3=0٨5 )Q!Dkѝ)dQ&sR<|r)H! $s] {ɆU"N@y##"Ծ"a9i Q *YJ!깜 nHgt%*+|WX,jƽhòTS,so|"˳G50r@e(Ђ S- ܁R<^sP rg1[^|M~]ppbXr ƏĪT6wiʄ\KY)(,ȡ#iMVw% }ac_l/_}*۫BW)Yrs;CQ7* d?fAylfHV C^࿷jWY(}hi!iF::11?&Jp<$=Ɣ4f [1f&ƫ< c,pjXCNyC/B.40o=٩v)'fZ+&4J [UZPK %A,$]BX\KRY̘}U@Y"A,_xUNS}cb a>1'{Q} Օ]"Ťfo`B,@WC5]Ԩ 4_Y âK5JfQf̾F8ylj8'D3K6Jބgo)zv،t e$O1Gh!2k_.p4* ^KcMK1# "p%n66/O-GbR6'\Ϲtq_rDY,c:v{\ ΰT OEn W|C|8ks(l>So |n-9pUjtVfs>CkeC{Qz;{e oOݫ` ;&lRIe\pn'"pMmBN0)1u?Bgܼi#ɖmg}&0$姂 w !{v9cRV AUBU*嬞[BOlwIA;RgY6y|krfE%)Ф4?+[H󅵏' QeN\2e_.\m_lbX_{֌WCg|z?kS4ϟLK10

> stream xڍP\. 54nw A ݝ ]$Hp ;3{uoZ[B]E1B]Y8XR*vv.VvvNmW{(4` Q_RP0Y& t}6T8\^A>Avv'; !PA4Pa(B.(4R'/s|-|$P #@j vxhhA,l^^Ià Z20^f@ ?' %t\n`?+pp@6s#?џ`?Cm<F~2yfhG̦&#W+%%!. 'K8@`W9d8@ׂ0;*䙹`?D7fax.,JH==/g溹>o yTJBASp>cqm\-˟rߋfoVZ,{. 噓)e- [ B@/g*q|86VG 9?%DylRE"~?H&7cl (*#gK'MiA-FgX y~#_Vyyl6S|.\s!!}/s)Ny3!㹖U\˿ೇ?='sI 6Wȿ|{ >,ܠ=7 @YXֆVKx쌋2,A;~b &3TeC%{Veė}[#Z5}4vP'&>J}&C&e}t {ۥHƏs/YhnC4;㠢Y\9BJW2$FSO٫'r&w\>wsޫڜ.DDd/Gh}$S | ã -LD;05]K¥##͂J1,4h$kewbM?r壸ht={GWfBC\9#ۿC܏OY]$,?MW)@*KdRd]%N&R>l }LA m2n`JQtPOorxSOU^wDuw4عKOJzM)jgW|ƫ7ndN[Cժnye7ع!h"?¦frYo,:c__s_oxxhFl#ǘcM³l-w'PJL-l(ŻΣu6v\G.;,CwԠ<1Jp w"_$OAw.~~'G%C!S0ׂQ4` tsvCnLh[KnRGZ^;ͨƄ})Jny%x[dF= O}WfZw!Oύ1_9 *o7"q(,Dd?\W/$7" q'{_ 1)ٽ"Be4-'@"͂k41=!fn<Z\rtY԰D!~<XZr*-o+IBҝ@L>W|m*"qg^8oM"M_*ZulYg⬉~..akʌ%{QAQRafEÏRuWwWQm4OclA?V̸(+~r14ƙNt}*`(_z93mO+'H# زA'3C Ա-Ԝ޺xR4 s6ۜR)d~qIuP(,;rz1jb]Gz` 6j݅ 5HLU4ӯ)2 )x0[UD~ V9+GFv)?sS~XIQs叛o^jhO9o^Jr.&+Q'#jSW] 6f4" zG-j8BhU_i /jk˂Z^>D$Sm/L3+}*0%wlIP!ֿg}XMF5ueZ ',B(nPaX ӓnAˆNK6,`LqOqTN]J0Gֽ1 -oh,81W+6:U,h@v̹fYW=h+F ښT0K]׽[ J}=wf eD[mE#Arq⇰1Hh@dꏲ()- 2(`u$"&@cK9"zR\Dݦ¹DNv+ 6kfK\[ȫ1ܞt2ų g@p$u*YsxJ %5iu@JB] mZ2WVEΩv")G1,CwUF'd/[ŧm7zM{Q=ҟ^􎜄cѸ|Y0~ 1=YF9r~YY ٖ˞$^+8k_ pSuZ7ʲRU{Ja,b?LX._}n6!h vnt'XU`dRCל9_$)0HJMz ·s~J15 h=3gPȲĭGDOkrv}WP~͉G,jFo\~5d|Ъ%'c{֜MBԟr=XadE-~-ʖ~8]?i 15JR͘%w|}o3=koTwS>N*eݯtPxYb`KPojg/U{ٺBCaƱQoN6S W+ͫ"`wvйdF!/,0[jD;3}^ %M6,+aF.̬Nd L²}bP`U;ͯs:9F|laAH:pooNU'HG6m9@ݯ2/cE zmݴ(5gz&T_N`NiXjHt# -\/nCSTn{̞jTχ4v01b5cc86|29~0jW7X1u%O"_Qt3:HhD#jJ[{u4^@* "B<(RY <=? 2 dDžyver5dg HcBo 7Wқ-;?΋wͬA{a/Wi f/3;e7S>SGϢ 7=, F,WkL-TXJM#}DOk=7~QsƬ8g2m<,\F5gz˲LrI5$Сd!ܫ}?㰰]v~F # 84转p]<1lڃ_[4kㄫ!}>21yv"$g餒5M (sUJ%6v= Kuv(,M6CâRV8_=&yx > K#yRpA_#0>NB RAS]wU-20rsFX8E^|F9hXѰAztmrWl'Rd[~9ہp*JuM9D= ?JY5h&uk-Det|:X2z^ӛSѾ70tMFA֗iHK I0$ur"L`.υ6z'_fCd[4J+#[n^@U3 I;#ފ_:F=*Cδ_k T#&*BM W[*^r+e"^ZJkN ێN=|]x+k8p jMqͱ@)%R/I7Xa㤕`GV B!zlɽ_H>lsJpE̝2,NXIQ\H+ ty;Tc'f;.ڷ̆Clgz&52N˘дK HhT8XLestS#{a}op~l_ =(%#+Q]w?J8wh*OLZXXLTÆpOLsha feIE:EYpqlΜjbPy"?+r#w E4P *&J\.=0Y.%ϡIQ 7fK'|_XFf@hjp|G#҂:+ T*l'ԇ͌(˩vΈ ' !1EK%ol*(1fe)oef㜈~,At|mDIAhJ]؅fG Ƽx=l:L{2{qbdyK!-Ěgz!۝.B̆ҹ=t82QSJBvLe*B3Pej{cm2-6)OJgf "[r=~p!M;@ACKçҢ/L&դjbYWϽo=cK*2%9Jq[}ERRA=3z:a^GL 5.$ f(K&r0.őiVq~ߤuLrpL1 5;z7 uv>(QU\V(2W:[ʌ{/LoՇM`7D˻;&,H[zzJA!*GfHFŇQ!{G`OJb{!ΐB-]Ŀ6w1HMsk*_j(%ccK/zӆnWF-f3Ȭ ''jF}- 3u,CtDo _!"d<& g]~-科:ʝ &:GxS0r7B-! ՇY3lB= ꘼*Az_G90fg% X:}Š'%bc5v B£~{GOHG-F$WUɢƐ$wqdƓQi}:-t~rKCe!4 Voeb~24rOn7AKœRN{'P/FFpWlT)C|8.]m_:d.4^Xn˺/Tt)0mjy&&I: o}Wes of ӍίJ/0'3 g{3|穊qË2L$(ԌŮ,Y>,S긎Oy 9"Bk`~+J"OJ䋨S 1p+ Ci$ LLY?(ڧJx ʪ{+O8j{g_VK^l *Yf*{}0T62eQYP 8(]E3K~ZlٯJpQ|j_sƉZ%^ka^uMy͟.1 ]ϗ!YV|9lmD[W|rxD۱TYzH_7n?e.Z=ž2etØMgoXhaMֻ +ת2mV`t#'G;ڶ$BupDL-ڒ.uR:؄|`˚i4G( ~nJ-'i?Suz T9ځn)S_q/Yx=^9滏aߎ>ѬHNՁNI\?oVIIvW9Z߽=f! SL;ٕ2|8,k a]\ n6ڦ۞?zitQN܎qlZ/^]>׼z&b5/%-[LsSizaͯ# tN:,Ozy. 0/5cksp]Fyh߽bsǺR-8d O}p2qs ) _X-*lT F~>},mJr U}O{E~5YPqӎ&YrcF+/f~y$Y~6$Xh݇W~Zy `E-+[4 :#b R;/@OEGH@Goi.\J}|I;dlAx0cwŶ51~yJ\Z=?lvQQnY;^]=QFHWf5kJZ„݉*:PA)/l>$i^8 #Aa'L.G4_C5nImP2AP2wa6^X[j GFj6ܳ{)̕ś^ib.CEG+2)g."q'W8u"k3Ȫna6}iKb+2}v7Wn._;3^;4>K0췪^:ED]Yv>(ņǹo̬ZTjD>䢩b|Wck>R֫ BncM4U=ѓt(FA4gCx_!qS08ě ۷I8f)@u 74_R>ҊU\| | r3^Ic+%cLvwL僑kcH-lZg$_]ԵŸg&X#RJ# Ei!VA8€b'd{'u#coj5AK jϜ9~F6pX-3-c>6z^@ g_Bғ3b|Ҭ_ozl;.:Ub3R됁}$j~ gI'n}T<&U8Kf p-f}[[6 P2"rDH-.,<ɒGJ C+(I : ηF䲔l2bGް0vsU4tQ}ȽNmfPM%3 3-l,6ld ]uWi uꊛRȾhg&a/IK:2*+Πahnj}񥜑8F2%ܶ*&;RgbӸWu7=+nv;yzj(69!:v$v`->> &3]~I %$M:/ў;F0J] @"{}h/XLyZwvn6{q.#Jtgڙ%[);Ɉљw9m bހS,+(1/w֤agHnFS3$oӓ<%D{K!C9JHyip.QG˧nacz,|'}u|R[·P 6* -.[7wh#rݶt+Rheu'1[ڛV.q͍!{Zv|T5xq(3Ѻ6lN_O^x f)ꘄf0 pքQ:(3fY${uKF_7e-,jz/:sASjbǫf^ h?YLKlnY猲TDn*sX_OTuR]x9o#dy[7I*!{S!{7SXn쌹ёRiRNƀ anO[W`.{ÎC>4T&%` L4)$ |aJ`=)}јrJ:Sc 6s0ʩ\ +0inzzD"Cz3B˦i:97;D1Wj՚D[ ^3Un: 8=yѧs$aSZso"ZM>$/,Gs0ƱqԡFRk6 4H=9 6õ>$RmC_" E+XN 8- C|H V+WGPRfEgyT#?Q{2K@jvi+`ko3`$#-6WAIfjwF:kgH- LVHq(LZ>RV@|Ҕa2TdkCV=*ҧ#v8Hf'Q=GG|"|:S"^bÙzEc_\}&JUqbSlɂ&ɌϾaHZP*N@N@z,\ B3OwCDo]gS.pڎZ\B~~`_wd[rAWJb#|p _7=ao{ʊ@Zx+-g%}2ҖNˤK>챶3-θޤ{|H`jL j|`azrH|OݎW>SI=Yn\,#4;wѦq/Bu;a"qNyaS0pgH{ϋ.9K}kb (?Iْ-Yi 8hT^F yɎ!eyJ$Μ^/󂡛Vu[JqQ4?JfUvK?No$r h,eۅwp^mE> stream xڌPY.$ӸKwww $-Cf2o9U,yBAA djo sa22D䔁ffVFff8 UK?b8 uϿ D@F.o2Q#7;9{; r9y,ch5r41@p"N.o#ڄ d r41XlN41؛X\<Łݝ֙\nbP9@ lAgGPt[bon l,M@vov ')Yocٿ dDv9:yZڙ,m@qYFzoC#g7#7#K#7"7 )'=g'KgFgK)2y-w|N {2Yk;{w;$L],]ARA.vfffNnV0`MK -~` l8|oL-M\ sK;?obN6^v6/8G',lf`c03i, _Rvf}+DP4撷Zϐ23?_.6; qW?j#[K ކmj^Z9J-h,n2Ut1{Z2K;k֚{[-뷫m$R6翏37b,#''#O&!v7mMA 1/ wG9LBE# `L7I?$L+IzXX ƢT4ߐv#ac-CLo0U[o=3r[bfٿoJ?Nb30|lotMf/տ[ߊd/VAV?ovoC/[ys/[2odo&;ٟ:WޢvxM4djl_l@ǿJ |4#ۿJfv{qx%b༥n/ҹ U_-LM̛cy|+ן:1y>.WuտM^ nqބ7Ī6;4ŮF: St MMvкӍP`ʶQStxsRˣϓAn Vxз^BXU=gG@k&\Hw=z+Gvj8d*bbtf( sfqH\ah=go_|cYK7X>z~Veq%!F>HƞTҷWBH€xUcmmdCIZހaDYbDxn&zifF=0eqX:8p|70Q;VB'je'0}(DH ~-Q(wЅpY}7){Gߪsyw4`WiŸbaYbkqTJ *,FrOb-~6)( O{"S*x"%hуӃJa}̟Uƒ7U9C "ە:2$!JogaNTHl5TG;J+D)Jze~,-t~ Ċn`mSCFYH If6ؠ~'zWH=?5M2AB[ۅX9c"d,Ms<*{~=A%4f-)̍ hxp9ȚNUoՙbz8!aN*'?19龹ɢg_ѽ6x e1zP l{*SDYH5) XZ#~ cWt,g8R+u*qzUBn{G u3|oY_A9@*w|h#ؠ1VS\ebL0 i=;ǦBQH]FEXiB$Wh6dž{yA8T")L4X:X}"jg*69Ћt AB+G@eW[#\bAQSqwVO"md9 ^UHϯ^1Ph6]ՠw q4VT-q ΔѰJZc!+sdMxܽ+1T@_zOtxY vHzhLrź1ƃ)asI+Mz᪍b|ӮVǢ;zVV)b.FL#!U+0*nXҷrqUwoo<Ȉߩ?'~1Y2]%i-1,CU[/$8,BQݡ󉆳)b.+O-eTN3Lvv)ҲX0ԩppU2Yk]v~X'5Ez0FjMOhn[g+{lINB)]}Wv됴-CYƂ s0$""&0ߏψ7B͝M&uojf(e~CkDAGi˪:x`INg6-xӠVثz(08Ua'z (BAP# B³VJ- P_Lד5vle85AQ>4 kFQUM5lj?z{}PL jݓ̀Kh~Õ80)i<&z^PȮQ-Ftd-*vT^<rZDb ޕObkaE $ORe't7 JZl;c:ay1v ,M[U/R֐/e~ӘM{e67|(ܖ2TL{}ߚxfƅ#DʨJӳub#ׄ}j\&/zjpi6Dy*j>$ ڳM}CVO}>|pH04ks2u*ıӏyUo6I %fϒG2]!gP\q KFOEWpnh.EډB׶>ưp'EVwV~jͣ҉wX Ӭ!+f֍ʌGYnThT*]-#6O8IXZs"ߪzmpe7Ȃ_>"0lĎlmE~VE< :@Us[>|<7\Пje*v?jy#x&L(h] s@NeOB%S"hU@ *CE<=VQE`8L+>L"njL&`w`-h|"wRԩV(eR&>D ^[j]-Ztmϟy{Ƌ{?.mAwx>>cέDe/q2zN> FԌENuu?6"G(ڳ5 F?(Xw=tƮ]tf;Z$o^W)Ch\' Eg2úO]?+>4 >E&b=+ m~76 [nm_ ɵ'],Sm2?45Z'?׍Xy⁶b&^W<'¬L GY}mvɕmIb1M_U]|.D*!Nҟޢa|L,.rwK4%gOBn??ҡ/j 0ntLtJ/p"u,i?ZF$Z:F܋*_KVIS-6Vv! l_T]BvnK>Scc]p^DBD]XoAhYyr V4|;r󅃯~uQYfMd2>x3gdE_Qӭ27dc HxϷ3Ix>Qݞ DIWt%c^ƏĬW*#<Vƨ'. LC لNk]z_Zh:lr!Qt &yQ)?Q[G~Wꔺ5AADpA {_ZEs+g 966&qeƅo4*'B}#0'Dk*{uܜN}_p9yyd73 TLDVCᐂ%_xT7x-妕bŚ%^9cU[t6Y,V\4D#VNS}n58óajEVTa_l$')MZ4W оr -ꑝSA* 0m-b=;WgMfڰ$ x 'jإ 8ٗ%Y1Y;"E/C{Y: RƧ֩C.hi Wavos=Tk@-SҒbܡ>`F$mcȓ8UukyQb; J2E1X9tm.GehGepW5JTvG*${zVML,LH*rvbhh 2Ԋ%eGn呣]P)5mAZom9_OmZ>Bf`yHl4m5ˡwůh}Y hURuP*W)U/~P`4۬$ٟO;ǫޗ^ipY mazBרщӈ^@mJ׎ݽE'H$.H%"<0<+:H26hM9Xl閤@rIّnThmAbCE.PBn1 H`8;7tӍ] n|&{%2mP m' > * <K0o]cߔi) E4o< j{W42 (\-mQi?@ծ-1ۤ)5np9RDlb냥(h xxϕ %tsZdF˻ ?k[x˥64L^kR2}(]HN- Zl}%ce7&VE?dLʞ8Q 3\ԛP" 2,@?%6Y֪;c9ː<eRa=buG`^Ŕe{2|,8 aJ5MP͵"(#cqeK^KG />n/K.LlVQѬ'DJXC|-_Sa a*j8%eYmZ]9BE)/}"a8N%I8,}l[_[#ʧYm ALl&6?O4(*sF"#8̌ݹkNs'>jǫ:Q5 S}uwd,^|x~fR|CE]2UJTߩ(Po"1"6whXcv mUSlrF8 LM$NJY 2 AQ=塃#o ϰ1a":﫝5}*B@t/y'|< N௣iQ$o*`1Ä.SWZDDy{FjėJLlBHS&gKƯSwp ۖ-< A!Q>کĚt m۞:*K9dJ掯!WsTK8F LCia`=k>2ЍE$g0P& ̡aRAJk}5}6F/P݅ujkQrpQa2]PjQz N[xǚkfY'}GdEiW-4Ɛd`qǒU{IswрBl -_Whx+"0 f/+CIp *|W /!] $^Zj,ǀ֔GOVw iY]<ΌDQޭq҆ɩ~O26ӆMARjnXSu3R Bx?%Z t[dbпC]_l5!r`z2 )=A VsM/K+ ΅kk Q,G_vJ[NBX]]߱{9lю*>O%hM{rҪ޹D+s7ږ$ŬJ{tMjm$L[!HIA vahLsbLq"(F>1i&re$L Az/G%9*뛞>XN:+uѴ&++.Uhܳ0;tKK}@5fN ,UtEv{&RMNNG_jS&Ann9|1C4^I:"⪸~TдBx%$>&="=wMNtz4o+@3h?e'8he fERjqJ(KDH2Q0qzQ./9aɂ9Lc6 ^R瘢x* >a9Fʖ7U0&c(.#:iSp%mka[FVTrN32b+JMGtϸ`ṧ1EgD|bqe^P`mEiAIɏ&[s_13Q~6u$E#yI#RP&ܖ+ZtC?S q&髎 'Gx(,::,/w uAK `V!ϪRg:XB~h4Ahn%1/e] { ĉ5m*8S$k׽7|y_|ͥF2PbEܴUv7 aNOKk(]bK;הU ֻcoewI=H]|B 䶜Uq0_6#`RmR_4D+yL݋j\f#QzM9?U3+OHAq#Ԏ_a?m>AO]s SE!@lp]Zsߋ2D]v/h73$a_i G(/C2rsZ,G=d?բ7Mb =iS)!Sc}KX[uJD-|NW"@˄U4dNoG􀃡Aa6a Wc/}Ϗa[sLMI eNq3ݴ4{$tQ*_^a 7?FBPRC0l 1Nx 5-3 %E n'*~sݿĿ0BG'6H7l/ d0>d:g,4'5,?yEo]P^趪ɰ%^u+"Ihہmq c+:nxFEOR senDˬB] ծ e#KgAZU-u&MuE<-։Qpm9ni>WGi䞳7AjxJJ!d:B!]M 1QV ҇ j[ s; `͌]I6n4!K>C7v-׈W1,HQ/\K#rxZ"uzPy?y,5Uj}hHDp^VPvn&a P ,(+"{ui^[( Pu_ZsQ[abu;zT@h^֛!KJCũh["HL{89dfz$WwMR6Z |SQ۷ZLOO9G}>[\A=J8oߠv+w8 L$3K.&>egq浉-"0P3$f%qE!xd#N+:ڷ% 5 {Yp#1(.)2rHWYB;ց]^i9r8٧J5'ȶo={+OǝJ/5}WԜ6.C[䦉}эs|)u ~҈4 ꊬY0I ($}r Jb_:ѥsTn܉譞ïMYg_# ̐W;d߿:5Ǣn4'm TMg܅!!;"ֶ?9Le6>]&eĪe|[ 7Їέ%9UHgJSq jSP=Cr9AZR׉'Qi֏K{Le7FfJW Dž-V3 ͟ #M7Rz>P91gG5֏DyQ WDM:\ɝ|4ңM,6Yhi?VX3($] ?s㖖{"HH#> *ku?k/GҬg7,ʹr0࢝8 ={tv<Y&etQ9WRe}]8NvkPr \T'~*PSbL/AHeDGRxC h/ ,w8KK0*) >-?ӐmNAOlS Ue?\+Qcu-͘}wlF5 Ñ ໃy4(mQ2Uq?$_͟+L5)(Eg[OSEݑ|o*i2P߽B\fc)_(̣8\7>Ki#.~׹A'(dI+Ď Rd#tAnpW *>kPGIg0)MK(BJNC>:&Қ>h׈ui0hc9bb*־@ gyrpF%7 OͽK+CtUomXRt/r1ZtaznY̙rZ(=*XQ~bNZ#>7u,}V:j%,(Y"Y)ػD^9&[lp5f toIDOp V؃ǧVA*Ugn`<ُbY+=B7,HPEVS:[>+43{"͋XϐXgB XbFߎ3%֕VNyQI[T>9W!ްvsIb>9b{[Ќix)<$`#L'p3*i9<:—} ۪шx5^ߓ6xDq9`h`ͱ%1#*:QB xP'2}(Y9}[?2u1EwgrJLםk'ڥ_9]"q@j?U;lՏ[ b>f<#W@ x5^+KvK6 Q*!KY4X/V!\uzLUZ{scr. ,)4V"Ur(-;٘qOblWP\Ā.-6#xW 1oaWu6cp T~z,[,Py%>u^Q)zd1֜auq:j _igh  1l=Cbm sZ^$]ZiKhP=\'i|L?ܖ:m%*8m(#?H3՝P뒐dge(9.ebe@/iDFztJc(8{7wtӕD `uȂ<-87]f˾Qm85=KKS Ȫ}bJi#蓄|Ox7= W"=.N(~mVK\ZEHO$cQC' v֏Z@3_u1Wx'kl6t[!VO zuUg&dz ͝$=D#NR 6RͿs|!qMC9$SM/n}ojp (ơ["b [[s7YVHҷ%T0ihUWصҜthJI1rtF3X\asTR0mtzu`> S{9‹&j闉WY0&%c@J S3l7-;'U`0Q Eu<1Ju!\Cq=.~{OyTtA4]]%`rқjJ!lMr\U.'֍ul{{S B9|,k=&ļ%g &*A:.>k|rNz J>.oEkr6+j42ݠ僲2CG߸zPx>R6c@!倈aqMhॠq,KRnn_!~_hI%k=Ȩn..pV~1q(a&_7:ڪyPd}ͬj\6+HIc0}Q1u%Ryޢ09Sl89Ғ1Ӓε}Yu5P'"I!Nl+"{OR}d&}'~ʌ e<`_vX>A[L8؏` #vH,>0ϙֻ;i5q4($#%psvpc,x-6yU(ZQU qG^;9aP<{Oa J)R"I4PRCPlC1OjB"CϵoіM.(O {Q7|12iXG뷬۱M!d:/جRq ׮@n} %-1,f)1_T.㙎O7,. sP)zr(yL}N7~@F3V'M,} 7Z͙f,3/!ЯĈB ̭rOj 4EHY{\#iq8 -\W*S>[s3K˪-ԯ$P_݂B #GtlE-?(\7]EaT6gib%j3]bҭfe ']Ir_=MgJ0F@Ig^ϿexihD1LchpwFهk^s_fng><Zl؜abҨ#nO)#q|'H,6N@g9(既Vʨ|xXD޿;٣ح w˿dWӱ@;~{MwĚ\mxCW*&8èƴ{ m]o7w *VF"%)E:#* _puK+M',OQAws y-p4Ż;E[$ũw7$ a%6Q$r`{̖tEI.mki|?f  p;aF0֍¹E7_ym0ǽmz᠀b 0t(oX^걠ae"K q<^Om4\1jEcj ,w,Q͔<۬6ڨWE!,?_68z S8fcN$Tr}@/.k9?IScj%&$X@֮ڲ5ª~.0scŪjl}8#cysg1>6P`nl+Ά')Br#c_]o6w0)o)grMu}Ecߨ߸» mgSA mɦ/,{&-z*k# uc柼1c<¤$=`rBOuAqxid4h$٩Rhx*QnB/9qosIO9q.؎$f0v7uS \~ QY3ɯw2re`LqmY-d{WВS.I7yAVn"R&9ބ"/pZfo`)B@B1Gfr}iPp[L.s%0 -^2S0HKP( B.L-gO-A_sPQgt0qgE{&udc {kbggٖG ѦSu{v.>ϞG2`$񇅰ZqO6K*=ٴƟrR8lmI$he FA m?%`_AH}V\I{wK]TӴn5!$gU͆]]*KM26Ξ XH|T&"vf_*ZJ86~A}9<~~p?v!59#/Ys_|}=mdTlnƽ:sa@+r¤OU-{dj$XFU,0_ߒ7@=,zzn{=@޽@KTPYGNEci+M~ZXoՉ]Fzaͳ rD 'y +/L$vIZ9{zh|b2[xAFqmHŨl=wP_kF (cS{'d{^+v3(>X˛_0#p0-dn 9:`} 02M_x:Dڭf)-SfBȍ̙ǀo+h4 ` 1Гq 5w۝v[Qϓbn('$<_ZH".潧_"6 [,L,_#=]~ ՇTDw"7ʵGbz׹:LzL̏ @Pq 諩<黧 s^9_;J!?!UN=ͳwc"lǣy !UQt4 \=p ꐸC~5 _:(^n0 ~e2Z".Rpz[)mNGzF%GH+q{6Fd`uO=K(4C-kkxrݯqSNYtEL;_{pF!Y0a@>09ʄ/XV4d[bʻh1f@M W7֤> CIhtNGa Up~?تt+8='qFCm7'EM2 # ӣ_yIL+ËS돍v,(IdӊnXWXt00s)wwQuԆCe1] P1dlnCeuG)6%3dHqF4NM! х{9OlVQr8D4 cRr\uOe3^0;ե`$}D6Se#I0=P <ѳښeh1 񛶀% HB:roZ f5|27S V-S.CߍLdVYö+p5\=;@@du IAg4i7# oP\2}Xۓ,Y|ոH3c$W ȸ>?-J@GF_ʴ7{5&4(h_NʃyY_:vhV6^VwsW1,O3UR١L@Z gp Uj.X^ʜN.ߨPPCn}=ܦeHiE3n endstream endobj 107 0 obj << /Length1 1497 /Length2 7515 /Length3 0 /Length 8516 /Filter /FlateDecode >> stream xڍTk6L#-0Hݍ03 CwtKH7HHs@KJZA@B@Cysk}ߚyk?Lz gk3+(i @!> Pte5"`pP> BMwG@@TR@L!:#$ tCpY]0[;2yp9b< NP AH;`# "ՂCt99#le9y0@Ex@!_: 'pYv0?6HO 8P};Ehht]?Zx @O] \@po`stU^HE99׃<@0G=AU'н乁0D_mOYQrvr‘n C@:=bK݅suj(E""@ PLBu@vz@'~8lE@a6?\_7DC}7@``$j > _>0{O{{A/ STt xE1 ]@vTn s {u'߽tM pg@ !%ݐ4' r9zE;S_ ϙՆB`N@@nc¼=lY2GU ,ޑS*p3ׄ @xo$A(B^= ;#K6_7**WB~@a?=(w @?}+?((w @oK1B`܅YgT}CXE')-LN^D!vgmN*\!mO*g7_ۚ#StLҟH10Bc?=ߍqzj&k8^gWch֓ZxqFςKY sga!ypyMO1j&q _,W f6G?#`UMפ-+YEfPt; 8rl_ [KrPSi]mWOv*eJ=]ڍG7v(('s賋A`oGGod#*޲\y6^Y&kn Ro ll4kHcXg2coˑ<н=q@Mcmn٭kOW}AјK~.FIǜU&Ԭ7ha+gvnG'ET ;W8 -hcj%WH"5o9"NLߟ=9|^ 櫰5P$qL%5M:*h%,}΅M7$η7T1³JӵRh5I-iA^xt'XlX يQF!{W?eA ?aP h7(5#y0~An+2>t{JG+b0~p2)-d0AEDEbpzqJ!.P|bQ&6aZ_۫d |/RO9#[byM1K h0Zn-Ra^׻q@afčĊKI.!UbWAxh ,>iͺ2Y~N6I 7l[ ~sab +L"KoVӫ_xSq-ڏ{=G+rr\6~3E*j=p]bLlʆf^lB>gއH>*,z^L8*3rԣV|Ie!k iH;/buOTA(tR=(FkArL&mIuw Rxrʵ(=X-H7&쐝W~)U&yuBF^(Wwౚբ]2I,QLs fkFY;X9[ *sIHd:A;Unaţ /1h|CDF235~`SF e f4ȢKY2ńPȿs$uɠ~1ZMڱTMnp{yG4Ƚ%V"Vx\8&|2w.Eg(H#v?6bTr_|*!> [}]HIslI;w`JU g/Su š2j&QNZbr& 1hVIH7ÉMְkܡn=6< qSO5![[NAYZ`z6-/$XPx&QAz󔞇YWkI'_? }r2QSmŐ[DSc1ҥ,~9O#hj3 "l\MxnBE]2]m  vHڄrB%ȅo6Z՗L箌u|STRY @urGSܚl,?I0CӄnᡜERUGoM9GI~dAY}WE?[OМM]N0-u>;sKWڍk* j씵(%ȟJfpBNHBt3BShA^L.}a ^ܣe{F3Picb]8 fjѻVzJJ  i& qc13-GSm 2:i{d/$?GFZa"6Hh ud&t(waC9p7oLTS`mDO[&oP5nSta,#RI qZ;?ɫkF]HA$7> x]~ڴJ2~v̦,p _i)cX Fm*/~ln}kDMlHOͰ`8Gd!>yڙGe~ rGZT= ACvFni9 DK^.ߎZ["OlPSsګk2ѲkKc`D&c$@GpӢcfpxRc]%^ u J[ QLা<@E8CYx呰ʬnDa̠GQߨuKZP1$r҇I~Q31|N1a3!5EZ# \+mxi &HNoo2nߨ-=](mB՟Y_v;50 Ʃ7(5'1(Wz؛R/ָ5w\;9Fd 3}:@$}=rgjaic] _*#j%Ȇ <!M$`mhtQrM LK t ZHӧHFJֳގIU2zJaן,? N;ܜ}@ۓ֫%ch_v'd^=΃2|OQ(7'@HH>љS3aVI͈p񍘲$z Vݤk/piXC{ֆk8L=9(xfB:#G_d̃׳kKh>!$] ĸ5>,Rn(DS&:+k4l:sG8jm@'[/]cdT9Xx9az!V.QV>9Q^чYɸPJF%Kd-:j,AF?bPPQ7W]e/΍ l{&?`Q$<2HA@ ab&`A::^Vsi|DQ; ;;Esp9} 綜OO4>(6ST2NCL;N.r8%62~cFoRԹ xG={E]3mv4+-Fh7v3 \ JIJ4ۀggNwR8z9Ij7Xl&"ڶ6m:?懯73oiظ,?1!c)d0T;e8Qpf\1Њs0nPDl{X&Wes͖6-3Gܳ[,ƥvcrCYP!{?"~B=e${z'K\S&.s,xtFo&BiO4/pAV~ѐL•B{4S,_O&Zxbij˥D{mx p0wܹp5lKQh3g6;(6hHlHV`-&؊]Lv3T$i 3T։ߣ|Jk?~m(!@uR}pЯogD;`G.1NL:}}:dz7sP<;olcCc0Z z\T/'?.ҋddY'8Yj"ZepLӴ'^Fn6]>XN*g뉱s?CabP@`y7z/~H ~˛}w=diQ|1b3lѶ-VVy|H'C+S=ÆaTD^XƆWIt /(R=zdn,6!յգy@0΀CRB]E.τ q^:煭r WDvb2gcfiO)Kߠm=) N((8*g|DttBi70Q1=ޑ|'x|J;"[{F|377󧌭g8UVıiѩIcIL%~gQ }܏J(M~{u+w\+3] b_:m֡.DPyu t@侼3.R*^'8jXs3٧E|YXClD]1I&˵6Y-d*Y)qY ~&$t:&,;pU\wu'[Obo$}5iEeHrR2ojy51[ !j{Dqh[I :>ysJ9;;,LIsm,\= [qvv 3"ěl=V @8#׭?ZxZXW'Z)dק0xOĺJ)ƈƄO[R&(,F/:-)gy#A\9VтNyi닠!i"#Ėp* :ffғСg[_bA4-6TM2o7s-41>Xh -УzHx\3V=`Ӵ&r`Aqx|##=<߼^߻d~OԜ$I#Iov,^`l-ܜ.E _'q3y;# ފ'b?H M9ԪөA?JV#eheiاӦ%Z ʘ 9O{T "_ [&`֗ᯱ%nQ1מxHV3+dS؍cI=)7$7d_? ~گzMs$Eӣ0)a|=9+ax*ꖇR-ǖwzUv,4¼,>tx:mkzdОnxF/-H2 SIUAlk8ESȨZ@BR3iڰWO"IBn:g פm *!6\Fv)hjcrJ+*w=znzۇqSvnȼ5k#.EkFA_HG㟎K sVU^E,)*H^5:k,2n76R!m*7K[#Wyf`ޛN:\H4}*t02]q~ZھpbYJ,&칹+ܝ)!_cH)\HZ FfcO=U 7o7¿o9}hy={dU"_fc'%9Y$c2X! HQо )$xT48@Ya#2qHl54@b7A\ W*R31;r몰x&^m yNjh;ytg/+m1iߓb" ue=()}HRSqԶW.)E9%R9BV0hE۴;;r)^ҫQ/ۤcXqZ; qBJhڴk/GH)E?C723,@`lN:/`eTsQk2eUD8ԣ3hw[GzM|7RHޱh૤ZtnBcZ (uUi~E>~u6~re13-b$NNy*5oZ~Ϫ(v+B•n>).6YV66IR^ቑ-b:8%o}6X4è?M6 Y=M>K:_mfV42A0̾J bw.YOݥ?.V)3>bY)Jtm?% "wrwۗaI4N6%g| -eܾzX鮖q>!)zak$xnNi H"(1}1^lelNT$0#4^b{罊Da62>eD /ȑB8ڈq G2hx^,^7B7!if/9ܷ,Z9Hd>ڣ %dI̝k﹦O~}%e~yX רWV߬tʨ^3Kfҏh7)A3u?U@QtQnT h|e}zixToYg>Y9y>ǂxH[ AE&A4^\l_F(S4Q}7ñmH9 nyRt6<0KI3㰨\'Y5Dq&/dfܤm[b 2~|m{o: V^_Jyʺ -+HӪj%šsr#O!~84E곫NM!z}ɸ76H6{R R\|l/c2CJEvQDc< O1=Bֹ5ނ W]<=ѷG>`}W~h`8v {3E<ᬏkݥ!mn^Q}\L:Iw ;!suZ)ᥥ:^9-YiѶ#t"B-m#g31ˁ ږ~XDkVܧ.WR]忩$Оkj@'%w?M5۵\ٯ)&CJVfZjf˖0\<3ICd+I*QUI8d{8Eާː (?,VR,=1|>tc}=mNwbU0<5hZ@~/G!I{Hu8bUב!b8-X[aWkiQ ']SY7xY _sࢺh\j iFU -%g]OdEz{yۢ8*k&-03`㺾'߼hgJZ" YK(cer0,ebjC>l"bDHȭ-,Iϸ㿣i9 {G@h$-kHٮDG[0_J|rh O'c߀$RbϹԥջ,OX d$ %1I]R6oÏ6Dl[+*.6Nee\S^UKQ!̯o pXlI*_)}X- z{/+;H#7`RhX"%i,-͚jܴbh?g7*i+lSt ~a #(qL:'ݚuX4N夔R| JtT]d>=,:Z֞RU|[=Q茋Pk/O_K,S!9J/Jf.,fۤXi7OUd݇-kXmL20สQeeg +^\F6UrgL&|T*I>wcTdƁAR'(y|(}2ͧ4.C6EA-|y?*yZŒ#!OUvR=j^EDrE`5flS'uީдX~7EJۍ#; tC,!TX^b^T쬗7'"lqnz{uQov, ׇ!z.55n1PMD!ɦM=`7'Ad+ /R};:]LHຬ̏xr sf BdEMlxpl/=,H:E,C8O9RQbC`wR F~v6M󕎇pFbb.+A,`&!EXV5ƦTZ"sTs|3]T6rg}zymEDl tx;a* ;NX/Ƨ,<*< fr\sK&@(~ N̨ ëٹ-dǠ%ľˢWX^#˖L}IecS:f+J2I HhBtԟ'uvv DI|`څhJg+FK<* Қ ͺݚzZj׃-Ȏ^7Aͭ'" d$f x_ۛb x^ŞGfHs=\&x="[OГ{De 2l :(?ZX,Lݘ.sN KYt NNu%Qx;0,ky= hPl ܠt޶PqΪK{ppr2)oipX֘ JWw5o(ק (}N~fQZ[ZYeM3Yeq+/Mҭ'D0Ԑ hY]HV~/s8$iBbAjAn끂pTVkG@' ombୌ>k#\yAEN_ .OV@u~Cpb-샫n;AMhY?ϵ'ٶ8[nTܪULCK%iϷPJ&Ņ6|Q$I̤7.[Q]M"L {" #Дf+VszlUmaäXtuwNG,Ш[A* #pfM,p+ ˯p5jcPS2N5E)`~B3R^F*n|) Cg^;C羾^c1fuXM8iYWg#P{Qb/FUFZ}P AUH|. 2|%zx謙2uoUdۡrM)DueC#C|ެe2+vS^$돍$v{ y:W2D68ŀMPGlQN"t@w-Yff: $uںrʩhrZᝊDBUeH]-,qf 2{$E8Y; a={m[V}{7niv!Vr{} AQǢ I)- U% fU=_"Quq7xNuL9f޴6ߔ;SⷩyK Y*x[:]NQ.V=F+iSG`o%Ӣff~@P;Š߁ClsK<_ip'b(ά/|jsNBGelrpHJ5|eEj4۩T*Bypx<z+Z +@%isۈw^LAy,x9)y!t`ZoP#XA f٫V[FI k[y)PUBsrC'QvXDϷ3. sKCCJQB[h  #S,&juӿyip xt3zY2$#_Y%`Lf_Jb!eQsܳxg꫕+P$dy,4lBuP-yn!([Wi;ʠ\ih %wEP#*3tj50B('#!307V?#;=1%eRp 9љk d]ksQ86x௱{HR$`Ǟs=+Y3U=GKaDWґhc )_B5,:@W_ C3߻@N};?ɖ/9 pTCUCoX4Rfu"^V&n{Kfw^lr+qDtI1qP+i0Q IC) 뺆pF(B fCZaF":۾L٨B}Ҟl~iN>cȝ 8{U|܈V<.C7.,!"9I:1Uq>Çϩ2ģl;^ o"KֈnUyÿsYS8;0:WMyS[*slBz>A"^ ܜogZ}彮j~<; oM+LZ/W(%!>I|}U$e54oYqN#&5$e-lyQ[ !l7KZˍ0|㣚O/ކ5wd6CD:9~B$MF)׹`ātP)'i7DJr:21YqD$ONTLX㳀{ ٫XȫK8qZ6 1wQ%C㥒JJRu'yuI_Pn@^?sm:8$pEesQj*i>w_.$ 3T6b@ b7_̽Xhzʪ \Xmюj\oB@ovl|}(`Ϡ8u*ْK@d~5O(-"I(HY4` 2ތA9x)w3W+\гGGnoIbBte8vyNL>|(riJԪؙ_Æ&ekͽwz/O `;m$x^U,*@jI,sd1!aprd73~fϸINJŽ.2~lwG'x +66?}*L7׍&1<Z3i‡в+A˱5 bQh%:]6}Zj1h ~6^=rkr oݭЏŦ,SM|n5yŬر@ԧڌ(T#%ea:~qVT鐕\-;LA P/ 77ϩ 7aP  BN>8g֏W^ڭnWU|a1i wYE_ʍ.BXfƠdV_ZM`ʻL^jsdVgds8X9?ш|A~t1!xm{OCqNT5AU*MBw>p6<.TxԸX&=tLz-(%S|x*lrvF tgTRdnB8f@D@~vlT֔ΤYLW6˛` -Zf{ B/~Rz~B-NFߺhL`%m_U,+ X6`6jI;'SRFLEŧ2KM} $7iɡ5vh?_-WK: 2kʴʹrk۞PWЊ ? z=͙$f{]O>'B S!TB5*u⏂ݘSe_SHJbInDc0]Fcv4&e$quA!+%@r gcO{ N0!NOKVL:7|n!߿\ e܍! ,n6AEtM֓]RS[dT4VpBWQI!M(yyMXX_ChZg `ŠzG 3EJpGg XᬅC6&S'|n(B™r>%utAa[ѥ~rl6Bdտ$vc7m}! E2XiQtG.r?c&:JT5|뤁5TDkgQVdU9:z\H\ Ċ+Hgr5Hۏ˟e' 2 $%^PE|oxۂ˵"DZ֑Gܠ{@-sAlk0GCjwƛo>ycơטkUE3\.6~qx֊ q "~5 O|C̯ ;Ήox7M޲>q߆60&D$(%Z_zM p1jW4IZoTp篁b)Cst)AJI;S7Af խ-f+dvH1%d 7o6׺.B2sd5x[Zݱt69`72nJǐ)}x{\M`ɔFu܄t(w뺛HUÎXBDS+*f`ކ992 $.MNj`rZ5NUCa6Ko*4׮h4'L6fŽua9C@$!wFGEӯ\ EpW߾UℑDN6; /;Y=N{\'pҟݏj 5$SOσ *J*ፂʣ?y G$VwyBB"|Ry4!Nm'EO1uUmDᯃM9BQ!̓AUЧ0!})K{d6m R.y\Lk*$&KbJOP0,c  Hg*%tkUݏtH-C11> F\M>?NBʙr_LWsv+f1K4YL~55|YW"Q1:B27=8;`@WҤeA˧"CMVrWEojN,;>`kڠA"Icimv9x*J|6{mcp F8p):e[}č?Kq@?][>K[1jt԰)r &hfwS.*y'@`s5eАgB򬞋,%}63* 2WsG`x fxDAbdxd! ?nimaʬfH꧆3 jI#VVN~3 m(ѧUڧ^ENSL2λ :37:6sma݇lJW!]9hD9m>X s6n[` .2Qx~kWżyf?:dܣn CW.3Mj0P5>A00f)$^ V){hQ_)7^L8Gkwd3DS>"')Q&_} "Y?ޟw4%=yxD(1 C,wvyнu(ٷ-:}N ƌYJ endstream endobj 111 0 obj << /Length1 2297 /Length2 14047 /Length3 0 /Length 15415 /Filter /FlateDecode >> stream xڍveT[ .;]www-;/Vwz]Y+ME$j`rwebeY dCRr Ri]!# 2v$] 97[+;#0v2(0A.T^V`O@kJ`f:@lejlP0vف=L@^eVՑÃ΅Baj PAf(ہN nio3&Z]Jnf g?@MV)osːMM-V <+#/Ac[ X_DU _Ye\hI{3q;; _IX9Lb6>_9h[9d%#&!Y\@ Xiju/Gпy8:8ADcw O#DVV+dae: 27O'@BV sf`oG_fUTa;bb&6  !ecUY{sbv gOmK< yrM_S/װecwLRnK?2vsx)[2r\YWcZ[Gd+)+Odbש05S9qOX *WI{Sv `l''f 3g0wpF\o`,/Eo HA?lE)xzXOxލFl`.VZٚHXL V0r66O: pp#p+f A9;CO<&_|'7m %v`1c,anLc,mד@[XK/GK9#Yk'*.p>8|\Xa |X˂|`Ct:<P)aq?h'8vpNn 38SQVpT8B ,>[,Πt?C? (a?{ rZqS7gp\u?_Xd8`j5NЃigK͍1rWϦ'5WByRFZ2d X'3<fL1s"s `Ab,^qA3[*!1 p{ݽ}'%8BwJt8J2*|p?$HrS4rHw՝FsbȜ҈_Muʹƺ-;?tA~g,Χٻb,q(OA)̭ pM)?cv#d!41K7>GQiwwя@ڳVӣF;0cp d)#',dDZolw?6yKr]GATӬC?1":C+I}0+$:e1/)f왲EX8g?n{S[00ʐX}<@>n,ZN)&j0?bFTMmٴ٧ztr~`FүMBt֫F4 Axa7 >KvH:P| 8~vLKxX` ~wPݗS?}3wo/Z e>D(1H,浘8∩tW<Q "֮lץ1?#XJv C-]˓9(5h5nX ffԘfm])38Pgd$#t7%L;ngII}_vkJ}9մ?CHҨ?+(ep;Z|pAg*J@BbpӠqzͳ iVQ}OTO̥?W_ }ۻ/+o G\}VԽ).ofѐD2zȸ(-N qcS%fmAaqv}_eëY & s-w XWhtlPW UB)RZnIiەbg[QpkE'BId E Kyݨe ،/gH̫ P^F0RB9ecdz@/xP.TڌpɁG*S%-{6y =l'bc:_UPSXЫdYQc-b [O{`0ѣ9\ x=u"LR ߓ卞.:bj-EJ2a9AYO/F?hc'ZV *1CCqrw,aÒ d@#] &xUt/*5r܂ uS4DuX̕y_dEda>N}2l/sm"ਗds!x GM><`>)>7-"c0ҁ󹰥rK&i0 IjQ-@>S%\fOg) 65gG]ߵ>|Ջ:8a$ ΂) A5'Q3vE3Y@ˠ)=1gD"毭|؆q2] 9ܱWyTgsb=s -]0cԘoؾ 60y2>Ql8hAg rX4ꛑ%ܦspwx#vIф+ %M;r-#,Z˶H=0 r^=YW)uYNr%"GeK J&v(F!,@Wc6ٟӵٖY5LЧNu& |1^77nhO3^hjL}ʧuc^$~v^~^a9J鲄 ڗ!!Hjd:;v\ޠ(`RSvwN$^}XWNnyʚ` [ dwJ8ՋDI-st%d.ߤ}k i,.Qͨhe#$_Wr(cg>(CaP *к&iW6PD|Ѝ~7 d]]OG 'tim<;#AUɹkDy- Gr 7dVm-5#׭;0 6Pse4Z%)|]_֖\qC_>-|KYRL6vyž=e/#4q7%!= MzFV/¶Hk>2sݩ(Hg#tqL7vv!߶Qd 9*;2Z.xJY~4w1,NkJ^!c4svrI*M0QneOk.;Ҽł=tp0~PDQ= s8c#ǖzcx7 >+75zÖ/c'gBz(>!fdORy{s7)`efn|=߫kogND$5ܫLCaAԲ[۲k>T3 Mry^\9_~@E#9YUJ,gIn >G>4J@Ǖ< ;-|Lnm?VdjZ]V#;؁䆆t>\1w{d~DOWBz:/jZhI. '=nPZC 鴖XN\0|*z!jXZHտr&j4M"0cE2dAĻŬ|KE9۰fߩB_izV, ad<$V uNa@̈$_-Hj|&% l,gmE8x y?R2suaw+ۀ#8wc+W-IW-ݬ&k[ٳ:+縢uN!wAD$IDzcظVZWS/tLb+6.f6K=28BT _=}Kz/ aJZSg:2 ,8OSF&"OPǝm}/PWek .&O4jk/G@m.-" ЮWH_k:(ᶾ*٦r|q7Tܼ.mZ7t2w/B]|}z ^elC '_9 ^cvoG=,b oB$x(  ̝0%?zq)at%/w:OrgҭwGHf Trwo'|%jYTIRD1|t.I6^Q 1)*fbrhWHڌ`8L okC@FrtKNW/-'aS,b90 =}ʎ.yd}T1?CTKâ, Z5x͗׬lGa[-Q0Gt.. Uyc,e; +gWՋ~"Gw߹R``e%׿&e]~!: [2o* >giЋQ**v^#.;Zj3h(C!nwK~˒Ίy?λ{ڠe$[N}b3ᗡm,jəGYf.xɘ!eXkirX{3ȵYd2S9c)*+X;_AJIB}Fs] >.֜7㥹 &77Q+QGLQ5k$ i!?8 H<٥dyD@fz(ynj\rgh5H"5-yu% aVƸRQg&tj2^ GsVOq6_FA!p*`i;RPeD:k#P^}K"y1ψL bd"߉Ƌ@bw| OPk5֫rrCҌI/6U3>iܕ;AR'85WwP5lS U֖G0}2:Y"]QVDpr[-ΦzH/{w~ \51VI4-oX/z 1IM JU>8A̟T_ GƮݧT#8M5(My#'Y3"]DdI t  ϛTp-/CZSa!>8!yo"␨QVԶyT8-L}*/E]'5߽*ZV|-7l1t'LTxhU=xfp5Z+en2 c;}.V2Ui zcI-YpWS jo7vC&#AU+,I c泥>5E= `vxbP㹘Ge@ՂOT1#ʠ?ipQH:`SLGVY'9$n:>JYwvFQThVbKxqG09(S[;fۻd$#WvѡJ/b+}iOF3tsDOdIk?yI_ -v!8>0sQ]@o$R[ "ls= {SVGWy lU˪!\}/3%ᚽO+.ic<[=?VI5,x\Lqq$%5'Ltˇ%AѣOF8gc6t&+"H EMK8k>.`CSPvmh܆imҟsJqj{2AAP$ޫ@v\bttn'3|v K'ՈEfئl,TuFІS{]o _YS&Su!Y`Iz,3lG`i>լ8A= 8;A O7Lχv Jyח/y W\׋έCeZN.ǖث0Ǒ'kc@^$deiˮ$ʗ]QUD ^"H{=t79/U8 ̺-nd;f]mw'^[Sxl9B̹Pon>YFCU=jc~ aw<Jݍ"pp+s&rCp|e:!7nwslEQ^*==HC, 2nYkD!ZR u.jw[F=|"L. R?&**u9ĵ꯾BJ`,v&$(_򆙪M4Ak5* #p%H?6a)ɤY_A9SXھ#XYE}}lzޮkUo#0xjgz++(7WpP|FB۳]kKWˏƾF)Zem}=ҟ{7| uހ r.~."CAޅ݃$[NwWX2uj>i p S jג-`3v QEA eW#TJF~eAi&zͷ|[((!TzD[ǣB=.S!|WsvPT*ӓCqͥ ,ۦ\}֣Cy A&K 2 M|&zOp=/n&n }6Y '%fkQW8݂X#uݢ9F4e~G> 1{2X1}elelY5h|.PSY=U|B1j:T68Ye,f%}{L鍟qgsuO}S¨g <~FmdpI!ucI x3ǃԑ8N7-xQ1ϴ)iWƣ*J揍 I-Xm$V,xwm$2uBE@@i̩l'lCYh3jM̺QnU*p-k3"ŧ^iy%2h+=\ʏi(w(7 DJ0{r}%cߠrFښH4Y[3>gq}~. Qw)PT,>J[A»MCȆVp>f@PY )K:f@\|ũd@9u]G/f&~!śڛ\11=Chaߋ]Sr|rrΉVb':q ,Q ʬxMjc'1~B:17tkV0r1~1$mqvfFYy1I1`HyZδ({IsBvl PoɭV 4h(զ\9M"O_߸CʊGg(|ddYckI#Ӓ?E+!6|BZbRpלaYEo:wsͪ&hL7yNC .LqPxo=PqSyNMZ)W{LK9+^,gfʟnK qH%.|IDI)QDI<cϐcKqPoI8 \#.=16_Unα+Ń"b~b90`Aގ9t?{Kxkُ6K|ee WJ|.ls b Sl7FgH8![u%I*BU^D^(mdpW&MBW %v7O?*CtQNEb4GE6Z̸:D\VmhhEיet{LˈlH?jQ4!Tw.0t$0aw}%Gh,ue, ӎ)3شϘ2"2/ qo=[AoT@ 9\!gPϡNG6*1GMo:Pfgi0Agޢl$/^bPN}aSl$n2@$wS}9>{>juQR eFW8`*`#ѐo+Uѷs^ҐP/e!Cp&z7""c 7m`=p_xoa(_'C=uXaq+Gh8%>X.Zƛ{MȈSi BVeׁ,UoKHA {,qiBtzel {yl٬-!:--e: e,Uq-˄w?ˡIGLW>uIb@Hi4p~)=\fHUH$[p5z* 1{)HFď燋ꎔ|97) w1MzoŽ\ m|*^'qu8&k;D۷4wAż6gxͤεJTH﮹we)k3KCs$.G~Hm/rdu{gݽgWx߹/LP\5NÞ(ųGrg}?CPь(lRPIQYȱ^.䁬" {VZʀWdjAagP+0vIsnLFy\snOUS2}Ra -F[eetiHcq`kM:g7Zi{,I%VkL+HǩB62rօVO6k=m O\U*?odO=rDŽW4 V:jiD2XԝRCEyVU)Yϝ67Z,!wMfH}@40K/^L#Vi:u+P;nY׼LJV?ZVèJs@_w9$0io]#QVJh4hF̅ٸ&}[UĒ'je,DC43Q26sgvMёy-P.iK*s|z3 Of_S9V^γـ NE%ZvW0k8]P50*UZT̗R(Z%ٹHkޒ]wR3p/S܂Y ` 틝({Yڑ ,Gw%GJ+եxjHFr8Ndul1y}^*{Mb/\821ɔGW70ݲ[XяM0[Lܿ0K`xWMNB)HV".Z8ngY7!\"7$Q Ϯ4mB;5fLX27y]Zp;5r?j% ;{X2VX3j07ڍU? QM%2ԍq1h_Gƒ)})ll W E#,vkqvfՎprgsV{iŲ#_6'=Z15Mz>gJ~{W^*k]) FVcdw dlKܨOuGеqeh8+/ϨU0;kxXBlYt~Y "U{4v}prB'-'h5OL.#t"2KD{1;#ߘhN/ /󰖳ïy9,ɸ.UG5n(G)/MS+'=Q9 [L\zPH60rߡwܔHpgܽO-[#tCyG6k=xdg<{Q꫖`NjۜFj=A&gT(Zab}FǞ7`h;Y+) "Wh?] WE]"UBnЀ@H^װQ޹}LN,jح.gdIT!j*p*m׈WJ4&8|4hЧa!6x̍Ʒ5= '׌+D]؀Ǝ>Siq1y;*3fGO.QNp:^6YMz̊7ڃK7̴F  43ЁK&ڭlIKSy4(ޮMV-NXVDV;R[$י#hGV$r~A`kudmm,}nGS3B^T2{TBnp$(n pe074WT!?SI4HW!cuFp(Ss@Kt,49Z>X*Op{] Է\+Ð܏%S`IUC4v1>(v|%?6S3+eϹ_8M8~~g\G.XbsAym3aǮy7>Xd=Vs Z=NB˽dsG&a#UE:!&+/;癵Q6;a\’ BY WxCLε]a3KDoTCNwߕ˛5e@>vQcj2L«h +.wpN(yO R~´swo/n} 3UUȊ ^Yj CAt<4OKG6 ƽ 21p 3YC Y̷HXuvXa9J>NGٛڶ%"-m\Kz[i8xbw+ vM)MoHTdS%2A| wOlȮCsK^hBօReswYą ӡ+i9:@91U-0x\\bUDC%A dE~ڄh@,24MԇPYv~ ړV>vX"nJ(}(d$PS}٦0܎ڬ4qDpBd5msqd|˯#2C()4I/tKMq-t6}#oϐyڄq2F\AH(>wq3(g类bјpiB+zh9%R|pF^*)5::A}Lk_1kcȞxBE;5@# cl L% 뎽'XQY 4؃f Q:Ԃ,ph?9Tu:Ⱥ$z#E0jfA4vd!5NdQHA<*zu˹Ob!$'.0~}-˜<{}M.}."a_wI%VE.O|Ө}Tl sF<ّzV6yt"nž16V% s@I(ytvI%:{5#\x'iNtd]eNRסE3,3F2 qh+c}|ј '~#}36 DvԒ|-o \Dl#yMa9J!Ҵ[R8#ה%v:zkЖ.8`;es tVBh2}ehe> %(5썰*L£R@e567T`Շu<0fWN泥^m&cgkLZۦA):}sNBٝUVN q endstream endobj 113 0 obj << /Length1 1599 /Length2 10013 /Length3 0 /Length 11057 /Filter /FlateDecode >> stream xڍT6Lw(CJ ҡ4 0 0CwtJt7H t_֬}@.i5A!pvn.a"7 ہ%b9P?,@')P qp@..B2.`  a1HCܝV<:̙BBl$AN`sS@n hnjЄAp wtuu0q@Ę`5@9, P5@ K :O;9{rqXOʀ _#򧳩9X,v [9e ` }7u1ۙ=Y)@NR`̝p lGy,BjoaX'v?ݝ˵@]!B`mX8;pjC EmDXY>...A [s@SޞPS o%fAޞT7X3Ob_n\OpaPbN-m9Y)uֿ[RJ d@^㨙K(@r] X'L!Ӈ(WoErvv2Mv[<1*Ч].UYW7}Iٹy9xar`7nnkkov`H we9;8ݔpV~}}ʓ9/1yF,zl#5ZJ&[mA4`F$zSvn)3XX6j IL1?cs<9+U/HtrAAVr*ɩ6Ez؉r)@}%l{{Jg{bv)L6do?23F4D27(lF)jX5*!&#K}=ZÔfꇑKL׈D|W%]Ģr=r9>*y)W Ni3Rنӈ4O='1#lR/6|52mWUy- 4Ƿ/tF٤#-88(-nܧ}=Ña=X]U8.ʴȚ7IE9Vu O oS&X^K90 }pcPk0r_Ǵ$#U#إَQFl_=j|W#hWԸ'Ԝkh鏫~I+D8)_✇X4e \&2e?XC!8"zuYE*_p\YTyt"ShYf84.MߗS0XD?cxᑓdؗh=Iv:iTjiu/xmpΰe $sV$[eng[/5L6DmR#g!Mh=/.aL0ߵ^ӃKl0l&NX4~ *J{5> AQF|i1UC'g[ۤ$)6?E€zd8V#D~ff6nE7u\"#qciH&VխRMkIBMt2,%-D? EBod *t%;GBO {Ԗ_=hZ/G}Iq87sTx'9KjǨ^|;n,Tߠo~> 렆`"|n*M^ hTY0݌`gy~#75`Kr%Wr?8,tp0ޛiTHq$ٰoʊddWؠ2~|+Mb;@jƩ^Ab8%ˡ@2$&t)*;awID7y6LOrj[?YalEp8+=4cXV]w0(_vRg%@T 鍅XPJz5X"ΌEz9"J2iŵ.ca2Cy!5KS1M{Ʌ1~^%m.pVgܶZ5}U|=ʙQ]ȗl`ウ+g{Nes\&$U 3-g _FR b79 CLZ)$(#`Ӑ etQ&V-WeC|oCeIrϭR:aB%1x4~ggO7;zHZ㭅m^1e~S Rq\"$),ZNyT3|²3葾[M\ʋ} L:ˇ)LʆV,&P%^p%BŰXpYH#>kN"oDR'& 916^r>F0(#Ri S[uȱ9%̒UzJϝ5Pg {yDdX6ߗ 5~V(v j`R\;he&أ"F[/hg+Q6GSMj6B9<#p,B^ 7vd驀l1dސӌpC6mA즮 ۵wqf/׾GM 6ގͥj@2S_>a#jP_T?DEFa令MdžF. ^io2`= ?7rOG5 ?3 Em/4n؄h,v(^9Ժ5G<A5'3p#z1(x|CNw]E]Xmec̵࢙E¦QtqX9Q"$ĵ[u-[nBO)v(5p᫩Jyw>gձK_%VҴ4RKKB NTZ,23"k66#]phm | s-#4u6!7- 1hڪecks8|.])-u)5=Ol{="GoT0p$!gWք:8L5V7*%C2pF\!JpCϙv|+[ڙC+UQȸb9, xv>EQ06)CjVTG5h ^fw&zQhOڌ,[;y$xKm438R{!eR|b3/ӫP5ҽ2"γ>CiI>|&lw!1}IAA>U^e@xxIq䄬X[\D$AnVcϣɢ1FF*EtJ<VdԡN. TwN˹NHR y Ja$krPҰG@ϒP֜-=v:hq.42=FOd/iEIhb?\OS|>,h*\#\b ƙzn^+̘?K!\#RX7J|}Խsc1EF'S1U8]@5+p"uS'L%qLv`k ͉V[5AK&1ҝӲO-gvR(Uʚ|]rߙhA^VUhƪH”EKڒwѨ% ծad}? &ՁZ߄W;w / T&lȅ0**=#X*#BHx;J?(xoN!4PiܵXzb6:9ג2z9&*.F6/`v~r RWW?$^h>8,!d~ǏmRu+ɰלS\O6`+ێe*k/j_R:N| Z<^ 3ڦAt|3R|ݒk{n"Okٹq'e/ }9 }8( . Aޛǃ{|16*UV滪#y8~ز:ATf"xo99<U-滞,y {/shvjhK%6w.*YQX!pjZ]Ƴ@%=S F43ܕn"K\]13Oo1M;RHD]A;s#퐣xدf< @w]lG+[y6ACsHFmg|BfƣҾ&I7Bu+q JT =t86_fe+;B› { E>0[>oVK|]B?kkPl%+q/*$◑dÛvyUJ1N:6< 4 &G'qwMTLs.-[aL&$ u= **/Wh> \JA޹Jt{2²s..6 UatE \2H] (bSQ)W!&oo~ ^)~oR]B< evrBWVED%kAHF 奷yo3Su!"_X|^c $=DpGl06ъq|Ve-XcdӴHaJLhI$gԕq['uXgEpA0Nt #~J{w>7FYʖߤH (2 d,Y]*T 5^$`O91MaTuMhS; bL8A< bҪjPQ{WA68L*6QK!+'Y6: [x؃N!)%6QQcG"8E݈]TVK,ZyW6|cܟ^ZlkwU>ٝaXQ@Wc, 5aͦZ`2jĨ"Vu |Kb ڸXWbP(͂,  O]tF}+zW)n.kVŠAhicUI8/P`hJ>"ݹ_/9D'&fdge#I[2δZuoYQ'~xu}B˼LjF 4!RSSZbzXLqtШ0Emfj yI L2GPMISz$O0WV+6vB-q?flN71FM R!"|~0Pc0ۨ<穞)W'x_$zӋxk s~NP60jW^qN84/6† sWEWw-02ŪFLi獋UŸ{y9J  p}ݧ mbg)<2Ƥvey ؍Js[qWj:Z+esJ\ZR{ƕLzɟsܔU\H~!kQ Ϧ@l!OS@CHA132&"ӆE܉E#{wR8ޔxmx\V<8\%cb!n\[6( X:#iЈC(+xHoq6S"%R_/|J%,$}iטN5?VIE#n.N gsO`*"fx j,%2.A6&- ~%ՠs`nc;9hLkx"rQyt}NzҚQ \ܨj=RP_N( јgU$:cmUv0a&)~ 8|>pLn˧M$mxtuFU_T娷앐`N'FGҬc4fV>Sk!;ة#cqO)|e١XY(`}ɚ@ b+[[{FκO:^/?~429B Yzh8-}[FA(wl>e|Ě/%|R%'mk[dAf*J- #a@Ǣd |\DH*SB#4onZdyC?8Ĩk9mB>{41Zni<otMMPo>UEFq";ӥLTk"2cCN̎hH 'mG8Rg!'Ѩ[t B~]s^8GKImO﯂- cڜG^g8X2 m/Gjj~jL/$լֆI%"ed.?lRuz).O^XHBρ-qrFgz^۝Rx N[Z "\&MK_\(yckuyt6ֿӋu/c[M$t؅zgZфE𓕵O۫{WN)Qb_k&F1 3}3J0TUp'lr>Y|P^uzrx=!cQ.bSCrWUghswj,'KK{zzz@DN {ZJ'Mĉ$ endstream endobj 115 0 obj << /Length1 2268 /Length2 15214 /Length3 0 /Length 16567 /Filter /FlateDecode >> stream xڍPZ c vpwwwwwww.=wwwwǝ37{Eսw$J4v&v4 !eez==-==#4 $&Nv0M ?mΟD;[5 IO`Α lja Hٚ8A{8Z;r# 6&Fgs JvF&͍ٞƉьflP4q2qt512@hINv(ٙ:8> F&N!.&J9{M-+ l l=,l&9QiZgwgj_Dk'xW kO¿J7 ( >;?'#G {g'Z' z+ͧ"Bv66&N'lhbߗkekfdjaklW.t*.&s>ML,L9_({؛/{;{g&>& \MΎ.&>^:A30-&fd4޿;@sZ{CJ Pv/f # ,WG~]׃d>@Ϙkӳ}b< 7e[& l,=f|έ}n{qeL-\lWslͬ+ffD⯗@@O|edz8}\&'d,GGhIbdax1|n@Gkk`jו2qDt &?)_ɔ}2A:" Y?ŧ&t Oh`deJ:cgc_gqFE,Ɍ?/|JOg3X;|,EYtddZ/?gTCm?Ggvl?q&.bf8g.Nٻ"sm| ?ddTL,!?dc;}>|Og䏛O\B?tc?83?z8;rz}??__&&&F+vF\AuA?kh&yHR)hV;\^!(3FzDW{6@%(z)C/ON B(zvVm$upaGyvs([YC%x,URųMOA 5>=Ep%-Ao!6N^O yoOYgIe&*/Rԯ{8 He,!uq uvQ79e ,!;Uۻ2֫r~]c\ )  d$YJBkkUTe"o\3] :qH(B>-:-`qL_r͸]xB&G,Ȍ匧,l^3+9E '\5\Enu[n /t [dPkl47Jx.r<ʴ9LV2]mdZL1M^D,Ҝ|@KBLE!Cٮ8N_ŠN ѷq͹eQȺ!5Ra Rƃ.B`y_>q[]}3z'rW7ltObFd(mZ5RPyhP*bM腻YˏrNtN;ͽi6GjAm2uI0"6ۈݸ*jH^]Ha&RƏ&.*'N)>Je^Szh9 RPZϢp%[i.BG3x9FG_rzAO-ّ |i-;+ ~ƃ`7ѥ*3WgQ Szsy*22Y&~Ra7\ZY #Q`τ)M;}UY=}meHt m燛`Q'ȗLu[I B`t؝LW_]fy:ÀsBv;?B=@m%Lȗֲqc|8֍6y0GB'43ǣ3z|t1t4"윤>_̫4fn ޭ]P$]fl{qjIOpn.-E,'R(l,)2XkF4{NڰFf0UҨ #tPL}&]exyWhү55{=q:OeBB`,9.vψև(N8AC`hǕB5,@KH}'E3\nW4_Jxftȓ*m^pavxs2Ee9e•Yshtգ֎|EiSxךppÁ:Y Ps>%+k/veyvQ&dޘeG2N['h X#4e9yi'=\}>lv7m&2rj1*Ck ۲e,*] iF޹ފ]Ș7F fVPu(Xfԉh$Aw`PZ T)v+Up~ユUG*0`8qKax~m~ռGAhC*PL1l~rMZLQ,w[Ij8?/P$?<3:5-LGlG j"E@rmyUKo"=R [3) 06k~8x;bh~p,΋U1sna9tN|;wMQ 4_Vut73yuSz N(j043{>.'7 /3l@c;n+z9ʹщD_D9Y3jm,t$CdQ`;Dʇ:li 8*3RL\?\ow8a.\^w;`a Fm~&؆|GhI#WOPV8T~JV"k¬~4\ɝ/ QaZH;{IxēzxS WO z#^0k5N[T$fբQ`&Ȍ'iM S Y}1*R./@4hLhIg^L/2tS(w {gNN:F'hh@Fx,=NEJƽ`y`zpT*}@:plʹqs(0VB4:6AOUͰIcHt7*>'1xӊv&JH8̗g(359&6q& m;nU펯> @ǹԚ|L׷G:de噞c22Hy>y ? bu}t)7 po0w\C&u>8?GYmEcP:U2ryA|OQ[0ӏ%+ IYYgZTJ:0[<g<6r$ޡݷWӝzK7~H1cծ9!oxYzQS{zkط ޖl)cq92p'Y0@CY/3&o"-I<ۗ04`ft)Z/>ohŒIKs8k;^.Zha$'L=a1ol !SisE+*`vYvt|Z=jP30T*AQ|׳ Q&yz3pܘHREap ðx\窳Ԩyz.DZ[UJFΙ14X˂v:)n[ĸ*Άˡپo(KD2f_]zr[lXSt^`4Ǝpy/l[37AKsO JY{d9_=Z  猬 ! -C=MxbIU)D(Q ԧ @H(>s LyTԦW#\=ȕͅBbq.}ݐP K8@'R?/β#jzӶL~aSEf#y 58vi5.j~LqJޚfpDWnCQMw BC=Sm+P-_z|2 (Y]˲4 :<iRVRD!E/}luwbH8Co%ߛ7t{U˟Incalkh %>$6ᥬo ƫ1eR)x=|q_M$@_&ZAAs:#asX:MKAiz7~!֚_2%|z-)#>*S}B$P If -G-tuHaځBeH:qԯ{'H,/ hL.L ,qx^O_ٰ |sҾJ˱!sOt4t5ĕݰEJ?Q'}{ebQůټKN`ۑ!`툶]{Bo\p sjR⛠.y+m'xǭfl`"mhُ sF5ÌBdB V iDPB9ray1J՚ػZhnOE!>(c $l9Fdhܤ)\ rgj([́}YBtlI%CYQWy]n"M$$ wDK PcLdIK4`ZԀYVe 0UI%ںqϔKNIN}in7 ^Ƴ0܊=3vf>Ԝe}0Y:}{bFF В1(r:~=o.- Gֽ jB@@rοkK Vo;ܜpN awQwIF$L:Rs44uh-CJ"Q8SL+44T۽T3= Ƃa,%ؓ3@N|»6Ӑw$aZ!f995cdTȑ\}~Q!lzMFH;"bˆ4BZm\anO-ѯ?d.n"6) Q$7.4B c'NWTP2F".TVw~ln-G~9\3 4>fq =gU5z55(x^Do:Sg `/LIgkzWp꩗"*"ʀ kv5,&vhP\0r=AVY3М7CTH74)nY6thXFVMj<wd  msvRM6ӏ؏75B+`Aq;2qf_R0SqZ&+Eml6li5X|՚:Un@o_yVfyBk ٦iGx[%ߪxF}1n57wZ*$/ߋ.󗕦WCJ|Eɨ c_h]%3fI")@=eoHf+bRqaq^&(}"͵;TN4:D>ϗR!YozM`Àa'qCf)[x DշE pFl■ Sc[%xG R Ux⭅U},v7vgT`d ^ƫU| FW&=f$rnXS-R^Vs ?cSuyӬ]".}v`fyqyYHL"'i{\EAnn<@=0bL0YPD2K ,CC>˒τz2k3<fߕ-~4iD'CN -*S h5¸ U]\vw2.Y#.gi#S;DhuӦ{/#zʂ[jMj]V2DCjM,z#IIw=ʉ{s5Ue4duVX*#'Ȓ:a^E fWJKw0(mfzW;o|+,^`/風oaRhCլڍhƹt\5(iӜ [$h~4 VA|](Ff'(:Hţ( =f2lab ediI|˟ߵXFLWp.QH@*[Wb U4x.R4]V2pI)D2/F4)/bͯ(~h#!VdfOwMU$F;M(5uN TeaANrR aLIN&默RqmI4F k!$^*~sZ@C%g-+Pz 5~()_,v}< GApF־7Ƶ~Vӄ[٪+cAY  ;{.}MʸxG$FE3@>G_`{Gksф]b#ce:? *]WR8d@-EU.s΀]bIu;8 #+im\caC@lu=0vۗYdl7tvn"wx0 &'⧇uauj|(<s[dnZJ-Qz'xAHW3GfŎf׷VK;/5h8S I`m4 Fw#.ge)-HGY۵Fs˞RWgK˜'y=T\:~ws,AIciMsd0_ /p{ d͉7wp 2HIJVO> ?@9QIIsW+_j@tƠ*UғE4ڡFDHTцMZ`t$0~ r' e! w^vwݵ٩z O2uňʴD*35@ä"%ߥ tX63bμgz4Hkw'r46W YB 1Q\Ks4h'm ŌJYsIQL.;rMe; j,K?*p閮.r ߞ$7 0O9Xk~k=zQ$ϢӊEg DKΕ"`sLjbt4[F: MAxO;dlخYSn!r#Nea8nFOįeTK)ĺ _ Fxg-QQ.íﭦa csgmЮr1/6* J]ľں.fu&(h0< 4s& xnmXp ׊EHٜfYmHG1bmtk|{eq4] N=do}F[I| VAmނ'ZP1!\m|orMT!`+bDEEҼtYۅȷ9߿E/dW.S%vٯnq6ڰ}5 k->՚~֓vi<1TA( 흫.Ǫ?HqeKg˘CAdl!b!lH%&8ׄٞ=:.DASGF3Vsf!0EC&N Îj^Oci&ϤgNGv}oVr8EXqr|kx4̏۬J$^}Df%Zݥ<aX!; `΅,{轵7 +yY|Ñ \$`Fsz@R7v@xӴSoB%u '%ⲫCΎ5cߨty꟡$ bi[L(jx="K=pm/#GqLjh=oe)K0vB0dU{lkhe!!ҎJ֕RP<2\ }4r@筶eM^~!Z[74~!]X2㺀e%NJ@(&:@HOiqj͸U]RNyH2OZG:GH\bz'ߑ&)-}5lS5%)b'bqmš3m S·W7q|{rRa*Z[03+58Qk׋l.ô[+&k?Va(\W^ DGmW hM ͋ -o=Ц'Ɇ߾3(`[ Wc$&M cz?D_&GamNk1InȾoaZ9\uY]S?~pӼY 3#nqiO;faOlc|4 !̔&i$)X N5YK^U^[/9>D@EyZp!Ip KY6?#6HU+ Ak) 9":C)׍yybI=kCDFτ(s$5mo*i+N 3U ʛ縢X7D*Ck9Mc^;@5O뤄ZG~ 7ǧpzAr ۠6(w./qIBE+k6nD3aMF_$M+fwŦ,:?'ot[p~XV16 ʩsʃa?@CM1td? iêF%Ś+ƕ$1·(>)[H0:ء'[럂# EW+b1;x(܁^'t5ovGNC`*º~Ω0ݿC% N 0E3?EI@(yM+dQFa~uC1b (UrWq7Sܵ.2͢[ ͟YA[𥳐~h<^cʣcEڻST`K| -)#ӽ KAGQ% )=&3[%2z[7p8crNx)|Ԏ2ȊTh$9Bj$`vy~۰^K9i:w"%,$lo'=!g >(UL#Tn%Ah4kd ^#kC$[(!)W X2}nb|?RqVVr]PE 5ρ%O0vqgFqKéVÎ8|>XXtV{d&9&!P'OIʭ}ivGo27# syH1e B"ĩ&ez}wib–}J[R& ^^8Q[VItqD1Qo8cG:71$2Zڇ^?;I5*c - Knv"ru9ĺ|vuSmwA)wuH8lX`VH-{g`K2OS̾/xֹ^Yvv,RjJ΅/+9NTBx[EC!,lh@bQ˨KxC!;H2:fg&*Zmg8lWXT(aĴ=Hd_؍֡DVMQib[||_ƨՆ~g"{Ai)DO-I\(@] )nU#F~9XCffڒInyv]&SNk\*P3 aJ_IMYtڻ$_(֊ &QF4 o .a (j9-`Ip}o@N/a;<5}r BELO+/ęAT4U. ԛC]ZN띋SvN-'ξvrDr`_Q3,2ۃC2I~F!F*QŽ^ !_uxz "ނV> 3[ma9sA- od '*e]7v@?7.J6R&oņ; n-Ecuϐ%OF_DvB6J:Hspdj>xG+֌:©crl}!*6$mAN/2/^0ZH™UZKuI4پv" Vwx=Vu57mpAx~&vÒXl,U8@c\gMU&N9n$YN*,n;Ms >AdQDbsjw$ZX?I$%"bP. &uCv 6LԶ:#3= NO(#%0l _4'\c {J,k:Z؃_w{@'pF`{}qmd'm BHb:VtO5td&F Vl9:ː]汒-[9Wlez=3~}<ᦓ8 3Vle;h+I5[3;HEA3u+P/onjEḬl\6p΢ drWy]0)pVxc :.JAuo '+P7^'-dft g3#XU|D|cYت5 _&5Zf HU>#+KyY<fodK0RɱZ )}7f} ߜ/c)B=v8@ġyCԦkm5UifțfR3EZs@M \g1@IV#=uC˲hmRU>sZ(.1jQ$*iNRXoo6K],c۝k,޾pkF 29Y)W+ַʾ&Wg gO6r41Pffp>3[T3;(0\v\ީטpzp -D^͛. pD lv}# `F}9@wQ M,o;b]@O0=jdGc3Nmpj˗HЈҶ֗99c\Q]ɐ0]3Ҁ\۴Zzg",ǾiAsw(2p<E4@7)q=N#ҍp~}-!GfL\W"Fk[V*g{=ʮxY'dPtT՗WNc.¯sCvOK*KX0F1X3a0 J|]@WUJזPD̛/3B#G gWVWsӓǜq8l;=r?)I endstream endobj 117 0 obj << /Length1 1441 /Length2 1873 /Length3 0 /Length 2800 /Filter /FlateDecode >> stream xڍT 8TiVK2j%jKa3gfDE'5fΘqgf j*槨M))b+)BOVJPOӏT ﻮus繟}WWȆ*4Q `CbP NA|C-aٳCh @3Y@CG [{VkEH0OHfnnf8lBaaPPbE616 (A aTX,B 20bD^#` Xh.!ɀ7Y8 aèHۙ `t̜4 Sly!HfXh B`E0pwdRBCB9r /|V ᳂D,h XĄS 8&P_>#U^fc¨P@g0(ᆠ"(+# Hv.g_0,&f0H6*_'* nbɶ0, p1` …i!.%"h FPNH$ H|0>'bnȟX$fDFt10Ss  r1`>,KbyJZn[?<2ċ}"q\^E|D< 8+GM!ފ\1B p]a" :,dZA68"0yܘtuGP  !.vq{JN`B;_耲1\dtSqV "D71h9pbB"II#55T;k2TOiM) '/cp?7 Gl҃&&nqeo mƳe37t9,xcg9:8pߦNOhg! -m3,<8_ 40wg޳bS /,ˬ 辛dWR:7_O5~oի]ɼR`[dxy`غ/K{G3nMW7NC:2[/JzTs}`hh,#+uI9ƚ\rD:qR]n>Cǫ,nenZ3vf8xfr~Fo+^/o@6`HhR ^wZc)/dمJ;huӹZB$/Wv6|;Rt;uvvQꦕ'4T\X]@VSL=2]6^h_k=d1lqSƞʃYbw%eLnIKѭdߜV&5g^xoyvidkcQCgz S1ޚ|pߛmznټȠMyRޱ?le.)nr<қIQ6{WL^rѢ1w OWGǫ,E,Mg-Z7i=sC\]ɯw4^-Z'gŵ8̍;grd_ꇬj%Ro.z_VˆK[N8l~QXC,(Xnmeh0y춢Z{FtWϴPdTitўݸ2͹Y5z1N?cu*Rz@oտT{Ge\a4%[גLsxbR\\35/vȠk1QV/]4a=` ~WmSjӿ0¢ñXv̦Cٽj ,ryn?XxuG[ ݣZU+^KXָ}f-0[[F{*k ݑ|ZuG$UZتn9hay vKsu YƏ`۬5dUBqS=M˘%PMçy7GqM6R<Au 6dE\tKU K9 mtz}K/Q\諎$o`uh~ӎ{ʴ1Jq{4z̍w@}"FjxGh3Ɔ @k? Z۸Oy!n| Szv _ O 뵾)R:_@٪q>R嗵)֙Yj}HP .0˲X\Ig7g?L\z ?]MfܾWb5jZh8:1CRIԴ,H yUr6hXx+ŧm찎晭ΟZtAxM}O7YunNԅV)}WW3kꐑW8(Cڄ endstream endobj 119 0 obj << /Length1 721 /Length2 4672 /Length3 0 /Length 5264 /Filter /FlateDecode >> stream xmrg4ju :ѣ D%.E13 3ѣN"D'щ5DF^7]Zz>쳟˥A!0HDT`n `P<V2`pb 2^ `@D!c ȹ*➋`+\7"=`tBTʹ @F`N6NH@ CqA- p'0h8oM8?Ю,Z-A t4x5â>_//u'!p$ A!dM m<?wt-w p f?wrCQ t1p 0YP_z9 $N醀#VB- ]O?ڏcN;z?<50 ⯽bP? \""X7Oa#i|žc4׻9$ #d |r o Y {igKX /(lok} (V{"B-XOΞuZjuӘ'OM{$ަ,}'OίmE3;1|KyzI!TB3`eda0$3;6/3?=KqrytnEGu2rHtn%MbԈpsڧ BJ ;`e`FX(8WD"Q/]*\ұaRƨoV@~CM…bԙe3'3'>]}TJT!{QyŦr؞{ } 2%.Evpz#J, Jc9u}-*;\pf4ѫ&wϯ,3o;!@ LGl** 7$WWpYQ5Ϛ5# o9-ͰEq?sHf =R=]q'b."_{88  8ixxs=e26R>-MԜy$l$Hr*ReK\w:(_``M:ǦBԲmhR@NP >ѝU%' 13atLjgt4O ")<u@VoYA38IG 4_?)o~[u.ᅬpLw$,ttQ[ \6Qb})Ŏ72K@w>T8~5,N乁c-Tlv#$I2<-fJLZ摳lru^Pd<=.m1MMf+km(=[3/71,(m}!\.·ڔe=D{ωM^ E2 !w/3+H6= M4A'Z,Dƞi*s\F. ONޜՍ 6 ۹,W!#%Xfo߷90 )!Us*@>i}ޟ|Gv-z C-d9Du1N,tA po%ǞMݩvIeʾ&Ĵ6flVk;;v^-YlM.#&l^D3 KYOhlu9ZM:IQtf\jwwŶLaG|-;+qm@٧ N4 8$ZTcg3-KVn*?CmY;S^cyס8'"R\R.E(/^,j&Ny[뙧}x0Q;>vdJKo7f>!ʏs5hr\TesnX͈S)lY,W%!%?b:I9;D>b60*/꘤p&8y\/+5D 8ǒܚsϩRXKIHdݢxN m& V}ih6{͎Q z|yń'<3reh;Xy3E ="A`.jbZ_+2f%vI^ف7Ҥz3q|Po_-g畈 eWGߚ&PJ/$/32pDqDwu&:`O#4) =lp7X\~\m+r-]hQ"eG>xTh "#Ud5i\*!' xAE@}oU4gnş5Y,tl:/IZo8io'"v){gdXߟ;ٺE+u7{</&Uiѝ*v|0l (kN1S#k>w?{Y9Ay|'?8*Yf dW(jP ]~:e!=0iټ౱]PEf-|ѝ6%~R)'ryhz`v,z5bphѵ1[$1ʪ{Jb~Կ s;_<9|9t*ʝX|Jy~>M۩^L(ݡ ֣KHڪzԴDjt³ޘy&m=t9+r[lS3΄QDgy+3f^x_hiޠdd357hm Oڻ;=F!}7;\+9n"jqK5T灁?"(l ,A]Dn,,fhaP)Feɻ3o52i@{;H8dg%lo VUÜ{#gZ#K 2f}{UZIݴzEW1M;7I^_w󱛍^1cŐ=!m endstream endobj 123 0 obj << /Producer (pdfTeX-1.40.18) /Creator (TeX) /CreationDate (D:20200908082431+02'00') /ModDate (D:20200908082431+02'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.18 (TeX Live 2017/Debian) kpathsea version 6.2.3) >> endobj 12 0 obj << /Type /ObjStm /N 86 /First 700 /Length 3079 /Filter /FlateDecode >> stream x[r7}W1m˕*K;8FH"^'_!9(zw֮1 @w> 3#,L)ɤaZjJ1Ĕ~d1o!X0"0qLj!ʹ5ZȤ_4cMxV굑 \5T,])P-0q陃Jg3p5臉K?f*f$&F` jCcal`+x`2`,XL\t ,dNӼwϼL p"T #*P*pK E&H EA@!O%f"BVJhU$aD~I-@Rh% \ $,3k0H!H CE\ʓjw0ԓ?0{#PU#U@%rIQ@8ʳ:ߎr>#ʏv>3asҭxgvraK erDG—wdw3ML 8үXi`,&ppXLJ?Pf6U>zNQq{]utr;O7Wq>./K@E~ot1N~y !+~5*J^twQwzs/?I莆~1*!!E(^jI#]/U1w-hm-pmK7,N٢WV'mNF~<ܴ/g. m{ϸ3u8}8]xhWxhV5Fz+(DؗV$ MAGZ"=Vi5IcRu5.դF#khI t'3/֙5R[B6Kv'~/#D< -oyKv=@UuVWu(zn7p/6Rwb"lFmɄyM!4"YdcH߃ΥrNЁu)){@KBU :`2,D\".!!!#H &IHxY@2-5`%tMjlZbz%l`Y+,MaI^TcUڍIFB:CYHQu?wGd8ʿY݈g?x)/du챢M:C;~?o~ɃDz:PcI/&E>\KO'~׃`bD?wy_V_now7|O=UЃcKxͳg'MB~ D?/1OiBdp:JTsPܖjث\ʒOet6|l5=8^&6Z6y/?vM+^tzyDyr/۩(Y='vbS쒌iK6%2;37ۄjxwՍ4VD3N>kw5\64>Bͭv/޼?ڰMH=vxOċUɲK[^<ӣcE6P^% D+Ilƽb@˗5K'tRz Vۖ~B=lMtÀ%⚓=)mC׭U?1?U=,}K/m>J>74{pg|VRyP`^use7MB endstream endobj 124 0 obj << /Type /XRef /Index [0 125] /Size 125 /W [1 3 1] /Root 122 0 R /Info 123 0 R /ID [<542594E0F30F4550A44DBA949E0F1694> <542594E0F30F4550A44DBA949E0F1694>] /Length 344 /Filter /FlateDecode >> stream x%л/a|nKUEQ-J[w-Ā6Ibtdu'XVw.> ȟ!b؅ile"iNdٻ^"%ĀXlXH)67{}:(#VEk5)xBZ+H%"6e ֑H NIj!y9iēZ3H#qC'gF!-CZr:괋CHNH. 4]YdCngA CC [ɒQDH8 $B4$-3(`-Y`/)jOMsשyNWMdȽ q@1] endstream endobj startxref 163897 %%EOF etm/inst/doc/etmCIF_tutorial.R0000644000176200001440000001036113725621637015753 0ustar liggesusers### R code from vignette source 'etmCIF_tutorial.Rnw' ################################################### ### code chunk number 1: etmCIF_tutorial.Rnw:34-37 ################################################### library(etm) library(survival) data(abortion) ################################################### ### code chunk number 2: etmCIF_tutorial.Rnw:51-52 ################################################### head(abortion) ################################################### ### code chunk number 3: etmCIF_tutorial.Rnw:96-99 ################################################### cif.abortion <- etmCIF(Surv(entry, exit, cause != 0) ~ group, abortion, etype = cause, failcode = 3) cif.abortion ################################################### ### code chunk number 4: etmCIF_tutorial.Rnw:108-109 ################################################### s.cif.ab <- summary(cif.abortion) ################################################### ### code chunk number 5: etmCIF_tutorial.Rnw:116-117 ################################################### s.cif.ab ################################################### ### code chunk number 6: etmCIF_tutorial.Rnw:129-130 ################################################### plot(cif.abortion) ################################################### ### code chunk number 7: etmCIF_tutorial.Rnw:145-148 ################################################### plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.6), ci.type = "bars", pos.ci = 27, col = c(1, 2), ci.lwd = 6, lwd = 2, lty = 1, cex = 1.3) ################################################### ### code chunk number 8: etmCIF_tutorial.Rnw:167-170 ################################################### plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.6), ci.type = "bars", pos.ci = c(27, 28), col = c(1, 1), ci.lwd = 6, lwd = 2, lty = c(2, 1), cex = 1.3) ################################################### ### code chunk number 9: etmCIF_tutorial.Rnw:183-185 ################################################### plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.5), ci.type = "pointwise", col = c(1, 2), lwd = 2, lty = 1, cex = 1.3) ################################################### ### code chunk number 10: etmCIF_tutorial.Rnw:200-206 ################################################### plot(cif.abortion, which.cif = c(1, 2), ylim = c(0, 0.8), lwd = 2, col = c(1, 1, 2, 2), lty = c(1, 2, 1, 2), legend = FALSE) legend(0, 0.8, c("Control", "Exposed"), col = c(1, 2), lty = 1, bty = "n", lwd = 2) legend(0, 0.7, c("ETOP", "Life Birth"), col = 1, lty = c(1, 2), bty = "n", lwd = 2) ################################################### ### code chunk number 11: etmCIF_tutorial.Rnw:226-232 ################################################### abortion$status <- with(abortion, ifelse(cause == 2, "life birth", ifelse(cause == 1, "ETOP", "spontaneous abortion"))) abortion$status <- factor(abortion$status) abortion$treat <- with(abortion, ifelse(group == 0, "control", "exposed")) abortion$treat <- factor(abortion$treat) ################################################### ### code chunk number 12: etmCIF_tutorial.Rnw:237-240 ################################################### new.cif <- etmCIF(Surv(entry, exit, status != 0) ~ treat, abortion, etype = status, failcode = "spontaneous abortion") new.cif ################################################### ### code chunk number 13: etmCIF_tutorial.Rnw:261-262 ################################################### trprob(new.cif[[1]], "0 spontaneous abortion", c(1, 10, 27)) ################################################### ### code chunk number 14: etmCIF_tutorial.Rnw:276-277 (eval = FALSE) ################################################### ## lines(cif.abortion[[2]], tr.choice = "0 1", col = 2, lwd = 2) ################################################### ### code chunk number 15: etmCIF_tutorial.Rnw:282-286 ################################################### plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.6), ci.type = "bars", pos.ci = c(27, 28), col = c(1, 1), ci.lwd = 6, lwd = 2, lty = c(2, 1), cex = 1.3) lines(cif.abortion[[2]], tr.choice = "0 1", col = 2, lwd = 2) etm/inst/CITATION0000644000176200001440000000144213723734775013174 0ustar liggesuserscitHeader("To cite etm in publications use:") citEntry(entry = "Article", title = "Empirical Transition Matrix of Multi-State Models: The {etm} Package", author = personList(as.person("Arthur Allignol"), as.person("Martin Schumacher"), as.person("Jan Beyersmann")), journal = "Journal of Statistical Software", year = "2011", volume = "38", number = "4", pages = "1--15", url = "https://www.jstatsoft.org/v38/i04/", textVersion = paste("Arthur Allignol, Martin Schumacher, Jan Beyersmann (2011).", "Empirical Transition Matrix of Multi-State Models: The etm Package.", "Journal of Statistical Software, 38(4), 1-15.", "URL https://www.jstatsoft.org/v38/i04/.") )