etm/0000755000176000001440000000000012441577674011110 5ustar ripleyusersetm/inst/0000755000176000001440000000000011753444243012053 5ustar ripleyusersetm/inst/CITATION0000644000176000001440000000144011753444243013207 0ustar ripleyuserscitHeader("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 = "http://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 http://www.jstatsoft.org/v38/i04/.") ) etm/inst/doc/0000755000176000001440000000000012441572507012620 5ustar ripleyusersetm/inst/doc/etmCIF_tutorial.pdf0000644000176000001440000050203212441572507016347 0ustar ripleyusers%PDF-1.5 % 3 0 obj << /Length 1757 /Filter /FlateDecode >> stream xڝXIoFWH3+KǍ( zhz)Z*(ɿۆZm 9[TIT~ݍs.2KVwy]g2j^/t=yi =6UVqaarza7jqJ?~5k"&"5o8sAGKsΔ(f*d"|5f+HU ٸP7@ވ"ŎRq#xh"$OAXWym_$_r~ӑPo8 ]}X:g? CzEQ^sv4̜_2ϟ7$p!h_p Ap:SZ A4\Y,df<~+o9𔼆CP@jJ2 >RZ "RK̾?|anz81b$x!Y =;=ԓ 4xe3`0.{0yDtv;(<wP52)z*AQĻ#,q`^w;W!]] ǾpGb Уߣ8PoNc8P#x ._q_㱻V׌R%1̡F]=t:eF,  %>3*$Dgܚu]LS0(3v"@U( gN+Lcq>%yY4+Y+ &#"8֮{0?dCez,H<1 G- $3%-4꾝sPW CWK 3!GQ"ڣݹ-5솄M6 p 7|?b@Q0L(5vqfT'}Z\B{=իd.Qͅ~N#aC?+k+L+;R$5?۴WTڎ 󚙅jp-MnD4jFJKF桶D2d4s`0BȦJ`^C biHqB DDk$B {T! <"^$w֡ TfH6q8C͡}Mf9Vp0t.r n=jnĻnb[ђ 7'Jg?Wuہ }:ɠ˴V).(cl^eJ'A^1M&h 2,mHZJ O9};|Y.2c6 ,@e2N}K endstream endobj 16 0 obj << /Length 2322 /Filter /FlateDecode >> stream xYIoPNV k!Yld$N{9 &rH@K, Ԏ }VŢ(;@-l5g?7YҔǙVUE-f߲"[ӝ{jtcʬ~ 6Ee1/r{޾v7n[y-{Rb授JlSrEwB@ sU]KK+>eeg$œ1$΁`.238C(jf cV&LDNk l|`݇NE/L;e]iPxk5 jm8ٟ .PVYpH"[p@(뇋Ix, <xrdii8=6 do/n5ms}e|lP`UdGQ \Eܟe&]=PRæ(6_+WG]ġ}M̛6V'eq΀:S+ZitG=)SҩN/ܖ|R..OEDJ:1Wx b1#]8~Kb0? yPӰb/":p2܈Am}$GL퇨% xtAg/W#AwuޢCq:pu5=y \\3WŦg"bă6%% 6D}̧iq  4]J;22O:VvVOal̢CiBÿGQv DCbCdT \QontLKa ˆ $[(15xjORҧNn,)D@y䓄! Jlolq l%7GhW>%I^Dאj+l)웵QƒE;MMߖSA0 %y4pCиDOQ8a0t U݋Vm ? R!{ =6OcKx*(_BX.!ݴ|̵ eF9@VNU5T*grJ CFbږzKNb5D5|wL]Ks( (5υ}dLx, :vmɵPro%y)MIXگ%HC圖i`V%s0(hx9%$udT1͎kQ,47"%ǚ8 >J=<@. ,Ȭ 0;ÊcGΌca': J!#%!,D_}H2vJ SU!`w+hC"oYPeȕf8O=LGcOib:irlt> d&aaPQ$66 / K;Bg{{%}u5UeR~!P6DG4JS6UΏ $sP`Y Ǝ%}`Yp0 B{&Zrjix/,T;)cnp̕`pj3Y'X^&{ P[u Е lFV`Rxgl XQVM;4 IH>8*,[ɡM(A^zz(j]G0mAā=Pe*Uiyq{߇w&@<^U ~`{(⁊~Ə")?B$Jgiy\ )IGjL˳ےG \xUb$m-4C8}޿ :ٺ;o/?"shkƍ{~s߭߻_c)7Hqe0n.m|XU'DMQ^[V1xT nmegnpR Y":"])[94ÍEQg?bUVQG؉yd‹d({J 8n t`(SM鬀_M9Ks6cgi<=P 4Fy? sA endstream endobj 20 0 obj << /Length 1578 /Filter /FlateDecode >> stream xYKo7W(]f%hH>W2r΋+J4(|"7OWԿ^yIT10]L $J'w_ׅ7vj +=ueRARKBX)J %\󪁾 t.VяsfseRa#SuWX,E+c0VE͌GG42A %PUOodCnZy$[jV^aTy:S׈L l\oK&%!,ϛ 'FsvdZJܰs]X#fnԕ9cnm7oL:t<e*07ˎGqމOujc#k0 ҶwWl:q}2޷oK -w-1ttg VBOpjߔ|BGe2fÍvAZk6d%n7 e6ٸ.w!{ G@Z`nlwrϠ> \]Ve}`,_&")]*k$ c};_N oWiw}uۡKV ;O>v'!i .){A!pNYOZf T Ld-7#.4KbG;=,l"y&v>md4\%LOјd^K]F%܅9)dzaȧC%B7K/y> .y*ts#BRd%MF`B]I}j>A$#?#W㌏8~(aep%H!ԪvA$F/$"&ZN'Dv{2}Vmb%3C\G 1 )AFbUP> s ^I~.)1ʔ  Sqן1E) coKa<`ԗL2UɈlج<.]xj^2 KakRfSZΔpno>#;$ YJrqTyϽH C)z@R^,̮z>KQMJi2fji Ԗ礴U:726)ޣR^rsqe(E7?PgbH90JzqKXa3´ Дsw졇iD<8©K!qu B.x#kYt 4+g/z3RH oHŁ U(Rwxb+ڽ ^lh endstream endobj 24 0 obj << /Length 1264 /Filter /FlateDecode >> stream xY;s6+XR,k3NufR$)td{HKM}XK235)bo|Yq[ ϟ4+lm5b-05ЪAb.~/قD9 *.uaD$vWh ش _QX6YfUp.X W⼶  DG&7EfQڡ6t#26%as@&!$&H PGd2g4l`CfH`x]:Ct[">9"k:?g+2!n(*juu<998,ԎqdQ-=.]뵓JTlh>Eӽw͢ W{_+ܖo=:߽DG' 3>?pfYD3U 3jQ kTG ?.'Zt}Bu&jodψHM!2[cn? &04 a_(Ee$!y&a}= ]4 "?\uIH.M& L1"q&PحuUJAPf%OKd/ZF1 ~mRAEUK2nVC"MGQh2Rd>RN:ل!stba/yT/fNJ}q"s#=\lmzӑУ-e8%3Ege>?,qɁd:=I2rx z]?yΗ:EɅ w2Se>fI3{[C̕(8Mـ,?4}duxn/#{ rcgja0=\`B獧1o%, ԽM`oO^W;:gޔ0\L ]4򷅑%Z_ >1o0 ڤvJcҩu [=w~Mgt/ ;ݴc` =fg?f6ޡ Nv",ow!{|=`<Ng3U[iWjuV(d۹ ?c pEey BD9Pyy/ 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 (./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 949 /Filter /FlateDecode >> stream xMo6@<ڇN8r1.CCl u;#Ra~r(T ՝:ϳ?{Z~޽WZ}P]n@}Vs^@T:3Q 5nmxw1Ats`7yt5X&2Ǜ+Õ:~RhW@rQ{u/n8^y; w\ܑl9.olv$h"H&^nN\ ؙ&A)Ye2ըNn2 ָA/X Pqo)^pb,ˢJ!fպnfchN7-MnwC fJiwF)ٮ*-<x3!DeLJv?xtAqӎ<8+'RVO?s2^]뇛ۏ{urNR1c7~;t ةK,Nm Y7Q9peg̉ [vq Oe-bar2fryq lQV dF r73 lpͫl*VM`-G^(}LR/0mp‡>;+̗z]ep˶o0]> 6s>ntknRFtۧ vN}Azϼ]属>:H)K}&^|<}{~ 惞}>.TXX'XѤ8lzglV5lY 5Hd4[az-\f^ .U5]Zz].klsg9[z-G@sVI.VsRl>g9[:}rNuZ6`uNu|8;qQ~Gv$~nw3ʋFI%ϲyʻ,j##7XW_)\//v#NWʕpқ F 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 1008 /Filter /FlateDecode >> stream xn7@<ڇN8pH^cE @j=9 ذ6N~~Kj,ڃ?[I1כ_~xn Zk5YkQi0Ӏ! "uPl0|VwL`r`S`[G/X"kl:j<ÿ7Yo @~#hV;+}vOû8zAG\ܐl%οlH`,nHf٣f4%;Y RсѲؙƄi/˜*Sbp.X38; ָe?` ָ0`9gO7_r}7[EBC\,}QN`,fsuNnN'u9ݑw:y>/b ~ 5D.Epߍ2J>|v?er6y|W7_ 8uW?GMҊ$\UmۓtRFx@l!KDÅ(oYC( Z(l4ۖ6m3V[6$&6,J0NID˲ XLfE &,09Y#f`8}93.T[Z0>GL:u 饴1v#شd]*TM*>exs7e吚F?]“3Qj,t}.r9D\(Iz~sty ;, O9:4IbҼihҵ0,՘ l؋qm5fAa&c69jK&όl.cӖMs6f1Ʊl>gcy?1+a~9h}Fs6Vl>gcuX-\oX}rP r6 OzG釘LAO):>q_s%M&lM˼:_t##d177//_!8Ļy?x?Job 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 (./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 1029 /Filter /FlateDecode >> stream xMo6@<ڇN1iQ-z{8i;#Rv)X4]y4E gUF=?yOoݠAkw7W>*n4@2D Up,lZ9\ƝGnq "5~2yv5vWu_Û-2J e 4) ԕVny;dinyc{A2F&,(E2ɞU`5/v&rIP,lUeQ=0 ָ 5(,/Xr51./Xq+XH) f Af"T:ywq:bNj=:yq:9]'OE[ 1$HC"R8]|7+ő! {uWW{a_T[篖$+Ɠq_wuӂP(p^?7#n`<| 9¼)0FQ8ك>1[@e_9K,2ulݲ50zpe^^me4^-2avuq` <3/,kϼ1ѯ0|n5Mf|d=\4B3ίp}b 'plGx\XLV |YtkޮvM;.sqQ>1=bV9/&Dasg9qh7;J}Fu",/f8Պ&51ʲZ<͛6KOl8Y9fO嵮zaɆ{UO6 3{1VO3ja>gOvx$ld'=ٰٓ}Ξsd˔gds6lu~c}rX=>gO9{S].sT.[T\T\%)C/? {~Ν輻~;B+?pɅF+<g9u#3:ؖ|cio^_<*qwx? Lk 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 1645 /Filter /FlateDecode >> stream xKo6F+e7  tdQ8.v8i{{)j .8Pd^*ޫ?/?~&`Kz0CO*9zPེ43Ũ-Z5K`ow-킽碳_{,G۟>8ó-X- 9=EV|=缋FOI:bt!ϳU=:ֹqQ'fӦ\hly┴O# r hnd]=v^;S00vy䐪CWjda*'[ B;avu6lE'Þfa8gN1Ǥ9V.q6ڔ.^OYp6u<;Yz= G.z~v&N3 aIjwؤ9@{_㘩pSds#'z \sK;q st;LE|Le8ނ%ꐺ6h,eT>v 870)y[N-v-s9o๔+A!n8΃,x6AmW+A!nt LZ;o`cY9888qsdqdqdqdqdqdz98qsdqdqdqdqolnv:JxGLҙr5!nin[.gOۆ%ۇ6+v9L 3 md:M톙60{0F*afAl62N6ffffdfffffȁ[솙Y솙톙톙톙&/X#u۰ Z3,.]y.I eO?5pdKbkanIy0!ݸ 8rϕbfbfL0b@l  3  3 333333hd+afAט eyg~n֔k~h8-k9 ;ԡt\$Ir5QKY["[ʂ,) qKY8,Ȓ Kr1)%eA5p8r fII:z ,)qKA%AYRdI9%@Ȓr?7n)d g5GK(vuRl[R='T[҈=IVOF{ \bn'tblbsbllY#'~"L> 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 (./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 1240 /Filter /FlateDecode >> stream xKo7+xa~\mE- #VPN۟ߡ.5$%;2]~;K.dygj\W?z3n.~ !(nv)˝a$¨+93 =3 33l:Jl|d77 *9}1Ulc+fbsTd id4J'$;F1TfJP âJ@ Sa.R*-p%nKySj' nTn=a&^ܭlᷗLYڲ7wvm.0V)U &aa> 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 (./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 1178 /Filter /FlateDecode >> stream xKo7+xe8|#)jR !ȡU%qwf\-wTA?ϒԭ>?U7w{I0yV{ޫ6+>U)Fm9j!k sbqsb\tsb g]߿nL8yoqv(9mIvueix{>m}vҢq=*yύ.W%hkp+ث0V1(s[ܦ[ŴbWl-^3[b~XQɢ7lkHF6f 67w!{_̓7mљ6xCD_ht5 Nqznw+E&alx_0Yd?^|;\+0_V6x??-W9ъ BM@-?پ7Eܤ&L>0:x(|-fKzFl#f2C-b}.X :'KWEϸ @N{ ف6oi ¢&eƃG12#l0@_uJ2{ sich t:&ab9ZJ< s]#r0x\4V"ca= 255 s\F^87I s'3] =XQz#3d2)WLPcLg+ɨգ7x3)[4Ɏka.u͓k8g]dP7';.X5{tZxRfՓ=ڲٓ2'efOv c>{Rfɞ#g̜[]=&3{L1c2dfO̞=%3{J)S=;η)S"7/UDiGR܉֋XDo,61Ľ8F̗0*zdym/2/ݳ]`R> 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 1751 /Length2 12084 /Length3 0 /Length 13187 /Filter /FlateDecode >> stream xڍPi.@pwwƽww!8 !8N ~ٝ{WMK*ilsvrqU99l\(ڶп( 7?,@@ȫLy5Tuv(;8|BB.: dU6B+fkmy=ߏ F ?˟IG ؀_O:-lA b{zzlnb,O[ @y, P:J mc B t^ '𫋻% z:@KQ/c'G [?Ύ.@'o['kVN a,0:_@[ԁ9I 5ÿ[ٺ@l`[?rd#5:YJ;;: `?غ,^ݛ;9{:Y:YZ ;HQ/W2k'@^6S5_gk [+/@AT7BXZ@ k['AV¯wr'_;o?K̮WQJI9{|Yy\NN> ;?@ۿ#3@_I޿3F oa<Q3::xePu~5k,WN,gTX]N ug ?י]*Z)dlqFy-+r%99C^]P(?]џH$#A-9@.d-7 +vyN[`|emJu|u`ٝ_2s|||JO_pws{]mkmܣ eiB8̮>w$'ޤ^&#[=b:cǐ [>Ye'ߓF/~ɚ3{(ߧ O$ɑX%\ta۠h]0 q{{5 G,i)>ϲ|-0ϙ'F#1\xa~ɛzTJfF?n+ngR C9 {%Eqщ#a)ʺDnaeA*ݸoz<-t-t HᴥV49dwO4Z)Ж̝=g:L~)DB]9|wyt+ueZb_ϿX`">CօP'S<}N5lŻ2ڙp=s6_(rJaQsMk[R c=t(_89ҌUG5ar 4 +p+|$ԢC^,1˄}4p32OQ ^QGu0OcQ=~n sդ~yL=STWHv%TXAtsM-,HwIEtnqlࡼTH 2rGRpMMQ\'9v ɴɒTt+UC{L.pOL}4U ߵ .F][C9}?)4ڍ*'.{EA<StJmŒ4N@H?KO 0kqC q dwf%3ey]h`K zV&!t7)fq,VHa80{zG+LDtD#d@)l*v4cT\4Ncn[ob_fq~ OV藘 ɧ{6W:^m2EE V,NIrf; ﳆOf[?A<ˢ𡒎ԩȬX#6,Tc{ρ؉\0Ѹ}>C`8Ղ Sl2[*5DF7L[}K>M}XE馅gfH`dVO$^?nπ3hR159꿏$ڞ3R865-Ki|Gz `ZFQXc`g .xOoETO'SUòiGd7bax3r#MW-ina&?]>LIk`iWcNK>=}{7CˆbPbpz!eR1Y `׽o? jC/C>O5p(o RB=hNJG ,JYC$nTH퍧I* ^6o ׫6ļͽOsL]%\ ӓ'i؎.O1V8$bP6t>L%b [_~2Cij˖{MvcR43,^mHeribX.c$YpP8N6iL? S Q'q=e_~W,}[G@F F@LZp]u e-)XAef̲8W'b(p;`1\_nVZ%Nj7{2DE`.rGʯ*zq<:D2z7Ɨ'zōrNhϚlW1L?cP΁Ovݯ0;J|羋PCyL?EdWη{\  D@;lhb/7p[Z^L䋱|d#{XM+G &OϮ@nR84"Sjºh!&dmF-jQ<yp| Rz|@B~(xhdc QAY,UM [S99H%عkvutn&ࣁաF9j#Uk7]`.&~<\q)(u{UN>/Z)-r}n!|y#Kc#y8{?śW ndD  WvxnڋM®PĖ:(4w:Jѷa,y`j:6`*[cg @E ջyeY_ {"DIDl9 Gm QPeJ7}Si(5[-t*ȵr)eM,Wh{>kŲ)Fz?Ͼ}=VqϕH1"p3#*Di1uq%ZP'ނr0 "l3gZ08-w/aT^RtXuaˈM#ӠFB*q穳-yNjTۺS5*d;rY#_Y1ҟznMACL[0:EJW!pvpWDORDp'[V ; W`5 Q { k4߂= ʾ'ٚ֡EFe*nINT(_{8z3!46[!#V<^z(nUQ\5PquD@3ɚ=|tX &bgh7f1 xdK_F9?5v{~ Tb[hY;q,ـ>eԬlѧըr}nl{,SsY|smɍ0w՛|g]?WKF9Аmhb-He%\3։W)}\ǣ%nh[e*{telÒtCGhn fR̡ oT/6ZkmAA$M[ g_!EF3:7zjuX1_U +PE|M' ea̶t2q>8d׈ 8z,ƁDOȃP=8kZmS_'NyV/ s_9$r1Mtvj|敐E.ܿ4w;6&[`}HZY^`Ѻ6E25n>f?ۧY/4XV>ye1:y޸Iթ%ɃVzYż;(vr|IJxE>[\ԯmrRb]Wt_,ﮤEb4W'Ku̕Y?[ne&̴˕V"}4sOEiX_>JK?ǥL&sL>ai_'2i*!L‡wSbԙ/\vm, 3<?:]j҅WKz۫1`~Q D F CLMHzkM9 e M,H:!>*+VPlx;y=cHm*:/ FS %p!:.wU.Y7nT$W-ÀMb5]i)2 NiY%1םw]VQmHrݛ17]? `˸u^4VE# @q{[фR1ӌed9`5 E}~R/`RqMχJ ݡ?oEEgTE OIQ;NIiQܾ: 5w0T{},10=,~MWr lWh qwi*C"{^KƐf)CP3ySA`"\[Dg gw@rPЯ7m8ik'p*bYT8 L/Q [=<ϻGhU* o2+1ԓH[(gPGæٮ )jhzp0;SV_5N̦qO|zK5fu' 4&J3EyR]`ߙb\0zv K,WYjO{>|nr4+"L`!H,\1~o1fn*xXPWe=gbG8(hEkh ~q)p*VA5p4 EiTlJ>C=G''+N4<%A%c-y&^o1;ۘ( jEh$o`2\ϻھ\TA7ay'Ri ZНYQOteHEqjÇ^R&/."1fy\Kc/5;G:I"ɗ`|7ߚ7HZ E%ra}di]4 feX,Sx} `V/{^ -Am?fR{nPiN j=ѣo5,"SG%rNJFImGVc"Ȱ5&D 8oqx B;hE<_j$6 I'I4kmߵu5=m,G2]h0- 9aN򋱭TN3䤸ߢ:)vMYꈿTْ~&&p:Ro:~|cjooc8o"u9R:mHU9Jy3Sm{nj#ȵucpe@rx웂F;)NZmn*c=eW& M퀫@Evjl;FaH269642s'|y83,f|} 꿢x  #GD6;R#hVqِ IV>d:eƯsv&|OBW&- ֢~NȂyf60J`A6B݃$]=9I!}'?Tx6vO DlO(:Qp&\++s%K2#x#Yhm1!կJ9aE`e< Sp R,KgYx wE)|\(.#Ś 3Y[&s+Ydy9~X2o&>" 1xHɧmfI;ZȼUuO9L-8?SwЫL|f 5A3o,%"n ;Vi}h@G1Ƃk0&-jjQT x)|p6PrT&Fh{M^NYbt1Ժke?L!Oϲά/Qu\=٦0ث}:TgFS,r,k%}¼mM+9~\%?$*Ƨ3 eJ}&h$gj`96oPN>懝ׯYxa( Szv`(Qr<=v6R8fX%8(,RAGqXOPpezpxt|pc=AZ- "sI>A d) ,\lYAh:@|)ϳ##ÃͱVN9v(%X~Hر T[~d|֣*olrPD{J-5l| e'{ R խ5|AGq1Z)iy+uYG "x@T6Xq2)4~LDb'FޕAؿ+:op˨q\)YEpS g ;b;v~>*J ~'%C)Bsus̹j ҇睎_z7!LQ>8'Μ\foQ2Ʋ*i~Ss2~ST>A0mt. wߋwcQEb@/'N޹=S'6qnz"aj OT)9Fa|l*e}}R+ 12( [~8x44w: :L1 )fkavN*ލ54eeF"FkA&ly>#Q ND6hN&7;$kw˓ic:Wվn7cjSqܢz{AЯ_SYMv=}S~ y*-O\tY4>x戳wng0fla^ 7}9 p ap+hאNg*Y-,aEսR1*{H4C6dz&j !i[LJ6OCGԃ,{$ɲ\d$h&R^-rV3fʇM1 ؏']9JCva-]nj*%FL1xrD,T̏(AC颍i>G!内׽|QXBK饻J7H!+QB_R]v͛xpVu&i!'mU|lJ3UD&VF7 eRWCTԟ{m {`7lC-*"mjr@KL Ӂھip?pkURneo>UwO˼JUw\vRlӱ(/`[}uJ|RXOu(x5"~=T˽ DpWN ;9Fo'i" 5q.! 3~|&2y%H:̥{7eԅvuU|^A'GGyܐZ7}-t |MRmj֑U]\?0T ntvGpifaHgs䄲YђƷ2] 9)O MKRB B,J]_S3f 8r[TeQFנ&d-D r<`gQK2? ;nL8a.ݓGt`q*|&uC\tf!TWIa6ࠏhU~8_J#F\G䢣j+2;/_\|Nޞ uh!mݛ(7'EԺrgRdY(ܲ✠vVߖiHF]n.#bdX+%1+<뀷cai1JHiQpei 9꩝V -C?LÍVVÚ ]k}3n5_g%Bc)gT<>[gXEf,1o+gT$%8,ԧd)>}Xo֜} # &pZ NʔGa|2OA/3 wZrP%b=9 N 46'n2fzD,]aQk-617RB֊;S`1pL>lT10xyRBAH"黺#An+ D>́FGD}+E:rs*>BC%@!lURkHC%ŕyCs9ޑJTVBԯHYԌ{e>YϓEgu߅Gk`j*qPZkydPEb#̇T0ľ049:%3ˍ U-alЕ 幘LSPtu XCGҚ6K2fEuƾxԼ6YlUTƩbq N qm 5/=,l9N!H1+i) O@ lHhN?@IDPA'tKF?P^2_HI,s=+_:]jzL7}#@tH#lOh6pM.Y^ %pD (g"6#[w0xZzP,ϐ؛g*A Uis [JoƽXS2VvYXB?"'SrGքȆD|mw~0- uԲRHW9QMf<4뗒pPJe\so h` :tef"搯" IgT&:]^/V^ []m{ j聍S6Tvr5iJMB/A-[J_qW}B٦zE(E 5 ՙB">+\&dT\X b|u B#(R템%<5,6:j.Zf~YN=I6/ׇ^6|ز_|5TWŅr 18R~$34wh oT:~*ۃ"57Zs3I$":͐NyoծP ѮBZ:}%A#5/putbbd/(M,xH {)il_ cLWy!*X*X=(f@_]i#`6{8SsSY-N?(WNM.hlA5>\_8K$Y*I仄^+]1M+^dzE2`Y Xړ8.9"+j|}c5Nʏ+1O7Zѻ*;#EI, /Y 6ASkQA~iEj̢l}ٍNkqq>ҏCq OJfm: \RH: Pbx: s{$vyazpJQ8bؔ FŭN5ZZ& THߩzK]SIaɄrWM;\cs胺xES'90(yQPe"7r6,tDwϱ^9 O,ʻT!~ (z0}Bd׾\lHiTp>.H#cFG{ADJ!l.(_mH_ F[Ĥ#mN$]9sM䉒Y thaѥ3U˩|,[*#Rʯ5\p8Q|*2Z,r6I0ITM.A|ʠ4Zbw"ޞWOQ}M:*ʤhN0Eڄ`<;Sb~Rr zyUӨG C-)"5) M`HO)B4>'n ,r>(P3lY*'yUKY="<$vϲlRw ,JRIi'Wv k!sI1wGO 5Adڝb dʾ\۾ت  ;n7QM% [?#Hݯ<|~(Bh?8.b`*ypӃALɪ їҽV+_yKb~E$Z.n)r͐FN")Y9"oSw/>%c; endstream endobj 103 0 obj << /Length1 1886 /Length2 11777 /Length3 0 /Length 12943 /Filter /FlateDecode >> stream xڍP C{p ;!H,;A';3gfUVWu4Z, 9X.Rssh۸ڃ+GC]l /2i닡 fp r 8k 6 +@vA8yAm]_@oc X*@WkKF =@ bav֮Nll@VJaj `@_m\ЂXz`C/Z 5'c k8VG ?' PUfuteA] /@w=ҁY ÿs8#a^,88]]PO x_kp/qY͉M ͋+;l$rC҃ `t\n`?+pp@6s#?_`x_` @G{v{O:h A07*`?7faxQ_+uSO=/> eC? - _+eC$'nja^8!.6\8v{9 KT_VS8Z@@'/P_xYROnX!/.('`C` dF|6MEobi^A6K?%ٰ9l$C? /KZ<6) x)_ߐ-/K)Ny_ !㥖UR˿?$sI 6Wȿ^|{ ,ܠЗ=9 @YXքUIxlLl0,B~a &1TfAo$zdŗȟ|#Z>i>>%hNn,L=FLʢ-dS&ٍC=ΣOγ[ɏmJ^%ǒ):1A349晳,dHg37Y L(~G} 9cgWʴ9] ^_cLH%+)GX5c):K7 ͂J0&,46i$:k 8P\4:vg2!bv߆^Ӌ!tE%.🢫 ijD?xww7>.JXT{t Ú"K g;QXlG;1{UZ- ܋Zwv ]'clᆕ8reJcCBk*ɑtMVWdcuSQA %'aU0+JTҧ\z"YG&.;Yy+fȄST(ECDex_6CE mosRt~{T>oU!niz?#!vao]x[eU1ifSl`|tAYͺ8v6xjPzl1[}&ڴЏk'Kј菷\e7[!f[16FY',<[J ?ӧc  G.(If~|#מ5(%8_;d /^ç;?ܜi^!ohNkA  V0vW wLM<>F&b7&zTFK-%=#-Ǧwa¾ NC۲:-BstQ?l_ƘE-c8p}SiNg8(&(ɖ/jc4"|~&L0B]D,k[]ԋ҆,3zKJNh'M 9ngsjx eAtZ>!1SEZKte ,vqU  }C>2?FoەpD_m7ިv t Rf'l,RmT8V(] :kcE6;H K3QJ?$ٯ7 ;)8I )Hܟt  2WV^g Hb5 e@yfs?N*>&jXz2*6;ʿn@VL+zBx/P.b-eOzH/@\K].o;CӗJGyx[шe0cKؒ"qўifDЀEi&In`ˀuYv+( [/3J߇ 13D.]@GCMt> !W^L;SuI;lЉ٥C2u,*9&5'}d8MCjalUvnu Dk{.z#|#$M;jF2>8a}Nޚlz,ȭAE@3O֟JtmMF鍅HsRn:dG%?%&=X(kWEPUŕ^DV™ ('E]Ί#kD=UsW\^d6).[^fMC>\Mfew,) )2;*=~#‰sDPE6j?YzH`ZV`H!M1FH>Tg**PI-foMȾۜQ+d|wNqP(,۳{1jbDza 6j݅ 5HLgwU4n(~0 )<("?I+ ãjy)KVY,1vg  "o;=ᤤ\9;IJIDy{ȩmfLiiO= #ՈG !4A^*uo4>fB- Myx" v~j囒;6?0AԿ?$a-xwt"]q7i(0,„ID[!%t$bP0Gg8߲*'xJNkYS~A 4 Jj+Azՙ:J:s;4 + M+F_nFxmU`2%ˍ ׾t~ɻB%" |cN^] c z*鉲奥 [jH"kl 8J)yjrlN_ɖ zw(&}^#`CkrPgإ>i6v~Z)6 SDʸޛ[.9|mX]8.ASWqSst,Mp˲w*j.)$-uC|ڵW;8+t*T]֦b.0:h$Cc.~P3o\fD_B>/QgWb`fJ9$tFN['/-8V7nY5f`mdilP8NZ9*WUC,)ٸ*nrE!,4Q;ɤ ;ϼ=]UYsh>)gkaW֝ķq*϶]EYh $G4tCm7#\?T;i4 al d9~n(X}{;ޱ1@4!=kGJvnj5Z]\A"S/Px=N$TVU x@(sVrђ)VG"2a+4f1.-Os^*g e-A'ԡ!|h&OkrTy[bwQx[Xt"_k6OdÖ 6_HIKEKj9.I$9(`mE",uT~(Ui85tȻi% gWIe-/H59ew;Zt,[ߴ,w( k>e;6bEz,ݬh0u9#C ?A7:ǖB[^ e79cެl VWy̮sqBnXuA԰v:gH7d+r,XXWnd] i%OAm V06Q.hX^)gYViͰYDG!g;W? EݰuNWBdyѺevZ0ԗU^)jsRSPCܯ ipa ZOQ)k25R=xة2dJǜqkCzatt-r2`vVob7KxlϨ9[Zteg c)kjhAoU-E/R[/}aI2LiOO(O//Iۛ޽iLϳK"bZu*PSL~sc]l7/H&eSm7YQ;b9^;紧>FLQsP7QOlUe,P4*u 0*{T3ILJR|#P Tċ:ݥ`V,MfEcYFu#EfyрFN{jJ[{}<^\O* "B<+/V 88'Ɯ4 dDžyzmj5x{ HcBo 7Sқ)=ɍ{ì ᄇmx-߰ gb̞}v˲ڡ g $ eS jkvwK4M(gDJQqޅHm@߳FGdВ>m,I!a`<~`,sSv ,ڱq*4Eҕz6L¾2L@Y(aƻ@c ?$3tvzI+]uŒK{CWc9Ps4seVKBn6.e :% Vv}x,˳ٙK$XI4m} T!λUBNm9U3vsP|4Js4ϒࠍA,0Ɣu(2Ac/raw|RqLf;)Tr?%t\MWAus쁛Ank?TTB & jTh.'`.uiG/u^Z6]"<~بfO>=yYi=S.>Z!Ey!@B> sͤ>J`1FN+S#k''9O#,nTOB]JT*ĝxw;7P~-;ۡh4nA[]" JXL~w S4Y3z}-Jù~}7Z@(< 1x*lMfMF_vB>W,t5aM`XzeaE"x[%NQb)6ѷTjQ% o: ~#9Z1խvܛtljaK NxMLoFz>a1i w]l6P >KC-_FNQ&Qas~͇ס (n!slAU^LtRkXO8S'1Vjt^D\YƠ5SiJglM~4Uz5_+RмUZuZO`Nrt''[QŁh^ $_Cw75JtDHV\&AH bV^Ly{^P<9$|',z+En2{d{0~k[EVºvSA/N`k$ĒJZ&P ȫx}Xm\YLjdEW1W &.<)p Ai*FxMz?;v~ yoQJFV'6h$]|3Օp(nTT6 Ν6ģ 8Y8(g>O3ӡ˔t 򿽷8ޘ>Š|-;I~^FhXN-T8MƋ?Z|6}eCNMmn̖FV36 Ͳ%_:* 4O WyuV!Q\'\f}wّQ8S,J}O;CQca=6pJ`މh4jh/P|Jf T AS l$")о]2s*S1i%%<2fib\,hdBUUSIf5$Iۯ2Zb̖YNJ2{tVf-!Y`#jL#DxFMNǺg6\S/#/jq{u;eLt (&3`VnZ]B3#1V{x=zƅYڣ&\+~R7^8d +\0+}83W^Y)e 5* K , ]aٓr78! aE8,Tncr+7 ĘwJ4`=jrI:{ܡDGY;~ML}rR0~TPYAЦ6^-;9XNdK 4vqP A0% :1#?/џo[I4(E"%tJpȈ':XA۷2%tvzKCi!4+Vb~24rn9Н>wkoOEAҥߍ5of`٨ p[\:[mz=5h8\&皅}X Si½yE3Wē/aL-ULt;bA ᚯRal9wތh9b[y/?"^رa$~HgϜf穌qË2L ԌŮY<.S긎zo 9"Bg#J"=OJ苨S1p+ Ci$fwvYGgI'.7 +Zt<Ι}A [֣.{*%xU<]@` 62Uay)P 0~Bqyc客=/YKwG(Fs59BDdm-Q50/&nJ YO,gsY>\\E| if-|=N`si_,(f=DW;f?e!ZΤ=®eTMG' "#diVoUdZn)-FnJ&YL&^=>Duv/ۄ|`˜n0G/ ~nJ-'a?]yvT9ց~鐍)C_q7Ix#n9/UYa?>Ҭ%KNւH+]?_4Nkl)d$'a E)lYIBJFBwvDʱ .,Tzd5mzmъm͝0,L'nU^L?]U%I}/x.xNnc^G u|pm㷒 dpuqr&T?2a|wKi@z!Kq=y2~ r*Kh\}RPQYl5_N&0nv/!Swq<4[*U_O{yK[|lz:UG83?uU@~ܴc3 )d@چ ˺řV5UĽ  /H|%1;]yUB{Vaނ[[cǏvs)s 6hHt概Ǎ״;֏vZ־qlSju+R7GMi3C-p ژLovRM41nwk҃E:3Y3SNT1Ձ⍹a1Lϒvݍ9"5Ԩ"&,r9_(n;dr8Z1CuApho( 2ɐvZ{Siи4(W;?XNb./VH+=w/~;Z|JF?0w?K!ıYż@Vu M=[Dk[n(GmPrӄp:B^sf~V("ZE<@fQ13jQ+y !Qd ?HZ'H VT5TDB$[G[zaoH~$sm%'yԥ.`6|G^LvB+V~Ie&ce*loxU&o?f}\~`&\Go~Â(8'ʂ-ƽ3䱭W{}Hvƻ՝=Ҵrz~Hame1",+!tUͨS }_u>'`hftt@ "A:M rĬ=L^a֙MS@"ql A(PB@D+SX!{D 1c-ש=gO$PW>2푍6֭犱 gZ}lo*<ξ&'YW7 ifYgR:>:$Ubۡ3R렁},j^ gƇ 'o}P8&U??aR ?@dJ.xTU9"` K$MFd$X7 uu;Bt /!Hm(8*<_HQ)o# e1qU1:x:~Qty%i"y[9}a1L ${,.sJcٗcw A8a$}2hצD[V?ZeoL읺v+cߴr߅fGWLS+G a#A챣O3WoR0隿2`'N(I()hҾH{R(?/w% Y7N*^}Oele1 jn޾\ T, lH>jh6M ?Id8r7 < Ǿ>P5!TzwïV8h3!7n&tLTz2,FKWіw\D0af&HP/7ge a]3.fZd܇(ѕag֛>fɧl$#Fgk5yNz?{ /_XǬY"qvߌd{boQϦ;iS`,.Asrҵܑ%2jm6cZO`\˵X*rFwj"ՌI~5?~[].|-?)#WJ# /cwݬ\ckXby*h`hG%u)s<5SmKT#xBuMUזziȹ}u^"/`$M =Uv9y7cl=5 7RU#FzUCCY~Ա0ʫ?b"֟YS^g6T10 %$0@O~# od&Ů X3~~)=YteAW1L@>' +#~ b)SE4 c 1 YzA[Ԁ@'O\zd*蘄3sVQ:מs,˼##q/2_ev`W5}$RՇG51V UN\-G4SNƟԬNl|ZQP6uFH`߈r* 7r`9, ʯ%I*J;(.o2|<$vɩFJy,7iGmxH޵hp'_gpY~bZ]oVmr\0͕EÁ' ^G*M!Uk@ b+E'M*r7qnfJ[0}/̼4ԐMb~!;r&F+L[@ebUcŬ֑~K%*MMzёJ7s[=_pWJ9 7I-Gwh-&_i`n>9k 8Pom@Ene|̚N_AwZPġ?z酢i /%u} ]V!>&DBI૥/~[!F3w] Z/=f}%h 5b80f#|Ի?\ Ԥj#i~c}QR }=]0v5v7 %0evƄLz&KD]<5lve s+a;'[$SA(ב&bxhMpI.2/ =Bl\.^ZIc qdaG81B16ND~d7_0$-!o%'r 'XN{]x=z!Vi{ANI8)mG-h.!J' UsКwMJ?qw^GwrȒOY '3th)؏} sK9$+ϛ Wed Isvg)W|{^+s24R`p ֽ~:+rqO*o c~E7u[7?u }C$d.4kſV,UN%($m1=NخATZmVߢ]Z U142|F궦25Nc,Pt=agJKty)nfT miubEM[FY"q1f9tԬ\T%ɲ~G?-wڠY{`+JT-@K[:5&#w4Fض 82sӛ; !-#S߫Q؇zkI"I޿vڧdL&vgGq|پ@6| /.}뙂Ʌ{=E&c]r^\ ]euSVPg?PDA=GOzЖ|^.h\c/cJbY)15;Kmۗ";cskU n[ma0*Ex$V90)l; K@;v1.\6wƨp3)mlLw䗚$F7@͂6_o#Uӓ`Zlw:i*osA9oWF~;ڹ Lʘ/4j$T0Dfr, R~ݦ?s| $d(pQqZ".ӗX/cH2f1L@17Ыkf7yI endstream endobj 105 0 obj << /Length1 2395 /Length2 19810 /Length3 0 /Length 21194 /Filter /FlateDecode >> stream xڌP\ # 4Ҹww]{ www .sν9=Ɯs  1H΅S2YY((T-]l@(ANΖv< qD\Ү6 +af03s'މ jfi cHہ(D<,-\ޖ#ڄ+ d r41XlV41؛X\<Łݝ֙\nbP9@߂F1QT-,؛9oK[) 8@EJ;Xz?'7_F&&Fvv3K@A\Å`dg;--௝ąFoldli["o*ٙڂ\~O dVvO;kmgn035-ՁI$%Oț `gfff  77 _K3 04q-Af;Yztf`xx Lrt+OX ``agۃUQG?cAϑ o P}]fvf௔sm]mlrSqZx6ʮ.oBpP GYdjjR.FoCet*ZX=CHe`xk8 W@o37}X9FNNFpoCo 5y5&F;{<_r~F&?$qD n'3I$ V)(q(A,&?Eb0Ao4ߐz[俈gboֈX~[lmR= `y[ό-&|0CY`;_ooV) O ݿ"lo"g/V$ K[u0ڽ oZl-obXv6 ?ecuB676GW{Pq/ +?5o*1bdF -N?to _&_ os|ۿ651oZ_ ^r{HL\ުU6A  ✽ oUmH!|w1i]tE6$u.m1k%g:$G' #o {>ώ>֐M?)] {$m%R9ڮb;p'?B߇T +5LxF*`{+`Q(qup6,nahWCsw N2Oa Q  [ {P> WHRP, Y[- yRۦpG "{o̠mAO_Ek{~jtdxrۦJi@I2yObո.TD5k~<0N C`XP\N&[B:k#@_[qZɯۡN.!Bvb#%oC@ɮ?3 wDzb.9d~N Nn&P hmY*ڸ etEVT/BH5{jE]*(99‘OtOtI']E3!ϛ'ǹ_DԼ+폥O}!2d=k_^8_YS_KևA\WGX#uRگ<؀W.w`KȈMN2j"`-3$]j'}or$5Ʒ?3  ~pBœةU`uO~r?q@Scr}smEϾ{PmAb@T j S>qԱ G#kǮrNYp4&W!UsԓCݜ))f2k޲rTжGAc6 vŘy1=atOAzuwMK,_);zHPm op<5Y{;qDRht.oDUlsc{9x4 6DWmF.0 0 ﬞDd&rrϫ:_c`l*+IAԅ4 |i߭ ,[)a5bCV)0ɾ {Wc3K)QU-84DoИucHgs R74`œ\W4rU47ѧ] $E7v^ Rb:PW](hFBDV`Tݰo⪜# > 5$xS-0~LOhWhCmc^ݙdw='V<ӶFlW@:wrK!,hTJ/WlٚD 'o#demU>֎u2ܮ"B͏#oZ9= ؙSl"\/Gq*je\"\ìtJE1ulخ"$A.5:{5,}esz\8XC/'d9@=;Wkl~(9$UOt}Ϲ/dVBoqy'Jã[5X3沒#dkU\\xG|@Y`f}/ 1aq$NPDHGPagN[ I'!j *2:ȳpk<|h֌$S6k\c|w$NJ9>'4+Cq`R"VxL/8"]M7Z (ZTh18x$g'x+ÊdH\]ƃNn /Dvt XIcX)N^L!_r 12loP-e&"I5 =0G<@w[kkQg64F I qM&3_ԬmRTԪ}*39IbM gߧFX}y ~hWяߣyk. jV+D,>g< LɁ4\!o^N2 lp~NjِڰJ&+nSbбwr!XMс>|ő5aNiֶB eU+c7{l]1}xK>͞%e~Bh2uH!'zg׃ ͋,Im]80" m}aXOyխ8՚GZm1YCn -%WƃݨmѨFUD[Fm&Ɯ[8_?e|44:/@+@ҩB1j-r|lDPgy)kk5eP(j׷yL{]pvHH56˽SТNd')!d u( S OW :W|hvn}MĜ{V$olJھkO X5ye~h>j1޵N<2]sm+Ā+MxOY t+?ے Nc I\OUB?EÔX\z;3g }rǺw71ȟ﵉>{"ނ2h4, wZ#^ _6A'ҳ>i͚Ⱦe"NQ}Bf8EɊH[enTotog y3`;|=A3JT9JƼdYUFx*QO)] ^O p=4A luC۷LS~B,*)u)93k*ω+Gh7aNׂU~ꚹ9gm҅rn-g MX"!6!Kr#3n1(0[M+5]K꽀 sƪw1#m9XziF,> 9I$=jqgԊf3ڱ$I0NR3nGi"ba}[#;[U`V1kZ%z7wÏ0ʹa!I:[wQ%N=԰Kp/Kh% cwDڭ^.t>.)K)NgeOS]'-+*awc+rIzl]7.腁Z%ĸC};Iǐ'q*+ vJ27dcsx\"//Wu.dl dD5[s±-I"1Vg#7KPѪۂV 6J1\?b!89m+pvn d~g$]MM J4d.3tA6O>@Ʃ}TJ(o;x`Ã=ƾ)1:IS Dhߒy@hd`I[ܛQZ#m[ڢ3~bϫ][c ISg;ksܥK Q"A@v+A K簵Ȍ0w~Z׶K%/lh7֤e&-PvZJ6"1?Jl? nM*-u',=qg7=x?D *dNYZہ*l]Jlꝳ8V)Uw&cTs^!iy4ˤ8>zĆ7'=)xdu&?X:q\)ÔjJJʲ۴61s(󅐋S_*@ џJI@8eA acO)v}+l{CkG aVacD8tW;?jU93^On)xf_GӢHTеc ]r+3H7wK/؄#§MJ_W`3@-[yR4GC |fS5ڶ=uEUru;ɔD_CrHQqj I 0{ }?5}-7}d,@?SI|QJaMCԥjlmP^6 {ׅV֢8~j4d,xԢ9|5;3n?O>49xN YasiYD&/!ͅH3P@<ʤ}4믞Zh!ɦ8Ǐ%dyϪԞ*c*tn.  >FTϑ<Վy]⑔$+Ea!m6XrZjrZ)9t m, `j2#9lu[Y]?o̝\UE:%dpPf`|A[ VE`4:^^WU^1BwIM޵(Xla)687(7Cyv-[ SQOe2=S{HԋY6 ԀcHBMRm- 2rArĘ2㘇%DQ:}.cV M6ʌIA_yOKrTy?~7=|<9vq tW FAWiMVV^O]m%tgqav yӗk̜@.Xԫ! *`M*˥&4>Z*MrbhRs归*uDUqуRiکKHT}MMzDz3>|h.W1gFhOq<+j̊5B Q(<4e8afn]^r" ’sC5m$1E?TPAx Y{Y 4G4~9w~urn^fB hdV8P7>>(lۗX*ykO n.xzL e #V.KD0Y_5ܷb,;dSo67#T{:9u>Mx D`7 cX"T)Oܾ"In*vw4U\9vqcm>}; $ʆUU{76cNDAcFL?:O#:Na)"-ȆlzJ:EL?2t}Xm)eB.ث) [BtY]jєirvyǦ[` 8<]S $kH+UVBҙ ˧T/+#ef!ٱs\6T9yQAss,i .Gw-ƉnMk׆S塯%ud&A:1$ X ؼl͓GLs[2۽39 Ŷk`8Vb[5i}l٢xu : [>p͸b.܍/! :Ƌ`a0`Dd)ElQWΥ(ÛJ4Ck&0>UEZy JU^*&nB˓Bn |􎏌S 1]{Y3{w)?*?M.8s8%u7(ҳ3-WA :F~>BsJn"Duu>y8!.Έx1mcDaՕۊ`H'sKZ_Q i/ #o9Y ;PFv}y\T玈hz.18ri J3*:Ceȇ+Lnl4Ͷħ}| (-r더-o88waTIkM:"P\F a%CuluJ>ÖЭ gheRW̛~ɟq[sOc&h! 齠?΋҂CMXzV"cg4m,ilH;F"R+n0BG9?MJK -Wj ʇl~ڧzMWNՏN0QY, t u{Yv_ ꂖpqSC CUyYَ[ML*G~r./@ztaݘ cgw#rټ`ʛxQkK`.;$ʧ.5 ׇ1tc|uUj7.BMy8ahő j4dRJ& 4> Ck&FS:v+ W]ЯKCq0h)e ι3nqzqyQVr!1Jf灸=QAGvJiri42;0EkSXV>/ap X6JχzSBC;U,\|;5;1s5.˘3?~:3CGctn'DK~Ω:3`]kU.[L}6ti`5K4c_&=jj!=.Tp1RߧI ׮{]o-G=KdĊùin8Dts$>Q*w,+)7<&&Pw9߆6z8JV5m9"p`mFS~78"i<#d;WϝmS^Ƨ$ӕúN&Z: fiiH H'T4qwaJ+o 6aNcjZfrJZק21NpUDÉaL#(]csOln\ɫ._ a*G}-uτYhNjX!15] 2mUaK~WD| @x= Wt^#Bq{!J? ݈TY(]SMba "9 cdN5D|-&u5Φ; #ýCtCvEm7r>0 l"| 3M@9qU;,;ʬ o[Krψ)H4զtz8,3sOӄQʦo򥹛͔5 '["g?FoT},rbh/9kȭ >u?; *cwI7hGYmz~fQIfI?--E:FƗǑF}T ~֬_YnBY)iaE;q> >D{hy/LrΥ0qqҗvC5<! :T,D3N%;U١^?Ę^oa; Շ^_XY"kp.:9{߉aTГ3R}Z~!ۜ:+2§^:~JV Z1]! NS!ٌjzh*-Jn4xMS-sP:o$~LN"YQyI UƓ~c^=:s|{սVx30#-F۰3<0+륥_bl =賳13#1'徣PzT2!/&ĺ+G|nHXtbKX>Q~ՏDdSw3}usZMِj<%\*D՟T78+e TOU_;2//h.2(>y5VB{P?39oX^ɭpu&÷,},Whf*BQE/!jA ʱČgKҭ+1<<|rfB&aT|rзa;4RxHZG~Ny>%mNVa\x qgO'wX|&#b-MgTrx$^u/U5_jZ{] 'm*8 <Ls `cKb/GRU0u0z%NdQ-Rs~ecj϶2•=C7;Gk<4N,Kͽ޵ߙs7D 2f'|Tw 9BG)5Q뱟 |̆5xD#0FXc5'dm}6{l26B0lKҗ++E9`X#sd-6ipr  1 !%+b%1k[) @3xLqcoH!3/#σdPYL-N}gka3ww:=џj){iPIFKX0<=LZl::tQ ޽wr1x;@l/R!DXiZ |C+$<+*&: |c*[ éEk-ތ-AӛF]P2IBN_)86nCcdDtoY_Qc&Bt^2}'Yc!jq* J]KP5.2AK[R-chYSc %y.ZOmI^;<%s&>-R#)"f6LxQ1lrNNvV>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}=ܦeHiE3ut endstream endobj 107 0 obj << /Length1 1519 /Length2 7515 /Length3 0 /Length 8522 /Filter /FlateDecode >> stream xڍTk6L#-0Hݍ03 CwtKH7HHs@KJZA@B@C99k}ߚyk?Lz gk3+(i @!> Pte5"`pP> BMwG@@TR@Le h:ánJ.~_`Nrmt"0pàHj!mDH{zz<Ou"</Oe|C;۟qg'a`(" 4.Pd? < 'vUj.N. 7 n 9BZ|H/$"ݜA #{ ^_ ҍ K"6(9;9AH7_S!cfΞp߿ %oC5܇pB (&! ^`;_ ] }]]6"0 @"ܡN7@``$j > _>0{O{{A/ STt xE1 GG@ [_kb8󽕡 (?ߜRuwtAN0GNvGOljsf5P:an0/(Dio᾽# svx{vWSq%U`gȯ7.^""_@~;wFޗlnTT+ ~{2_P~VAQ?_P :;q?w/ozA `0΋:ZOޭ2S[& .+B4ڜUĹB6T8o|5aG5ш٭'۵+&ybNZP=B?"9">;"cLߏ*5[Y2t{GBmFE~F2:櫸I9[V͘[wJpѿ@}`c䠦G'xڮTʔ%{IsKXn2NQQDOb*g+Rߎ<+IFUe;xGlK*DkFrDT?{{r(WakHJju8U/Bk!Kv+Y *nH؝oo4`12bVg:k'l="kzÓ[v޽N5ٰcB~@q w+Юo70P kF`4?*&xW>S?r ^h2rF,I~ћ b`ֵr[~7ֽwz~qq\x IӋj#MPf֎(C8ƍ1vcz9㬲IJlS70 cD{b=dF3̸}MTBt}^C $Ů6X|<Қue\q/l@n0ٶPuÄfKV™E,;4&W-dOç;㶃[{FW>L#r?lW/g'8TNz1;>ЃŘbsޕ ͼF|μ}8XUdYFѽ27އqT"g.GF?Z ;HCyײI&w ^\,Llѩԃ P*{Qւ_i/TMڒ.P]O kC/QzZnlM&f!;LS L.`!NWk ~ӽ QFc5EeӁ)vY8 ;vr:UғȰupw(N5{2,G_bz.ʼn5d(f$k ̠iE_eʋ ߡHAcʛcwJ3h{1J6+DL/b&p*?Me+z]P`aG l`9Ũha5UB}bz#_q/S;&X#̓vJTO)n_Ty[=5eL>ǣJ7)46 *ĸMHcќ4n%o+a׸C={xSymxL+V9'jBARxO#8c4m7)F'gD?g*;`jxƮ;Hc?<+@]׺MF9JԽm!3?EB>,TKbt)hNG!)H$DzE +㧇(¦<24"Vv}8E#md[_IձRbM*h )=N-EOө~dey^/KYQSsdtGѦzl}mgvGE8(ٸ.݄F;csep; 쐴 $K l/<] :T}ץ+9>ҧ:536jIE X&Jy|av!1^ =3LC9e$ߚUsx7:Ȃ2H+RH?3&~*9o-08aaZ~}v菗 mu߫ԵT|)kQJ"?Eͮl0fjMn z¯!L]xفQY\Xݛ5R^dk+ d4iE]' ѧ^Q£ۂ-ʾVB>NXvj 3kxI쭷*NWZOs|o/EQyRD, [{ծ! Ґcz)/U/ n_3G B9¸$. VQEE WzaWI{H%lSвjtk H"AGD%'4(RvWܣ83z?_$ "JV3} A5"UO848ijISdFr*. W⢘g_9^ia-w3dVbBtb6!#欂CS"p״0qE[큰 5x-^L j:ݦ:. XFnϭlPx$wbW-֌In|L>ie.ME-?X !RK1^jmU/_(b?׈22!)ěap0B|3RTgA zA"4H/Dn ܮjsه}-k!)0?] Okv~El٬&,A#WdeזƬLƶKI&4 VEͨ=J: 2"2&^c^M}wy* u=Hqʇ:#aəݕY%LTh+AQ%bH*8y!~gb<cfBkL;RdyGPAW̟L%2/$Hˏ>eܾQ[zP=8$!? #v|k/a@:SoQjNU:cy؟ğGGmHat Ĉ= DlǠuQCK)eJ|Pj7 N_qkr%︰wrčgtD-HJ{h' B(42zy;"TFJ| y0B8~Ih٣&&V>2#TwrMQ}ON+gdϫdî?Y ~v9##e:'WK,H>oO:ljHze2'Q*n6N$$yf3!-ktA]E钾]{+gP?`FMpAЏlWkX^G>3+YھPWaB V"R1G8Hv*{=NJ\:_x}ld*4,GAHN&GIT_hӆF jq{rQN͢tFȘg ז6|BI@qk|XfQMxuWzh0Mu&a;ƣLI|yd4,@L>8tt4&R)&-VeX+w-N=wvrN.r^@ m9g-h|vQT'bGm<76 e2fv]xfp,KDtm-dFapnj>ܩs,V#zR&Jg0;'hVZng =G(Ukh*Ήϲ.DBq<>s^olQ5!ׅM]X |ycߔM(FӞc#h\ ^ႬtG\7!+hЧzYֿMj_ZҮKnk_|^a^ùsk:ؖ楣 ѾgJKklwPl)dԑ,Aԝ(O ZP ZMX/z)f HҞbxgLgG>~PBP/Qf_߄;ϚvL]b u&t!2/t:g7oQxV5wޡna<'$+$'_N~:\ɾɲ OŕqسD 68iOȡ̍l>|}Tc~Š06$n*^Lǣ7gz&cgp?J m%[l 02l9N@m1WD{ cèn.X=J !^P0s)_zv9ovYm5CfkG`Al-6P]j} t [{vHkE=tFd<Qo̖<&SR=tM=A{4Q Sz%}+AnPG=PTEqTΒ ?L(oa"-c$9z#+2O,7vD(p| fnGřoO[;SpycӢSǒJJy8b5PV>+w)VTCQyM p-;gb  t$[ѭC]|Υ3xA}yg\<#QUNp8qчgOB (وbM<kmZTR@LItLXwL(7`*!$N艷<Đ)DI%VrUS~FZU*OMK01s Dm L 6/56_cK⣊c=] M[gVاǒzRnHnȾy_HZGaS:P{krWRUJ-Zj-gXiTy-Y|^8t\e$i=:g靍^Z[e""DSN.pWQꁄL'fҴaw-%Dt*AI'fUClV?6b.SX53..F:VJUF{yR$^<Ի'_ykFxR{lf-y`_WF{[bh8q sñҸo>xbedeOs^if}\ 3׌0h?r BXST> jPc-u֢Yen*lWC/TroFG#57-uҹ֑hT(`6Te`>&}!IJ`YL,ssicW.[;SB+;ڑRō)>@Ƹoz2nn^-ls@{Ȫ|EKrH}dževBAz}:SI;hpPYEGd2Ƒ\yيkhpon^4W?xcҾ'a-E{PR4㾩mk\RsJm)J֗ &36P*[&]7}yk]-C|<~BR.zIНND Qby*=A5rl;/!3M{@&E»\4ؘnXWB:J \¬qլ^!yvJr$i'Rdg8J W{1WY>-tk+UAW RUIh&70TYWB×Ld]3+J۩,&/3+ еlZ]Daj{OXR5vP endstream endobj 109 0 obj << /Length1 1755 /Length2 10497 /Length3 0 /Length 11602 /Filter /FlateDecode >> stream xڍP\. ]k\4\@#C`ANpwwIydfUթs^kjjre5&Q3;ęWTe@ 25:Z@d"0v~S\lV.>Vn> Α a 6(2 'djq;{GK|L܌DmA`Sc@dfg 9{W:Kgg{>777fc['f;G !zF r9 mA2cF[ٙ;;/)19^dA?4`u6Vfֿ;򇳱1 m@wR ΌcoCc'cWcɋDU/dwvbv;)KBlmAg'IA/gg!vn9bf=E ܼnj;=%o /{;{ Br2v]@>^V7BfeM& 0/b`weX_/ef()*:11;w;;ps|;1ڀxrvT1Πd2 ? 4}a?\woAR.66ƶ` ^&e+^vZ?7Ydv_vB,l>Fd v6sӅ6`H 0{7SW@/)%!vf `h |/6NN˂l 3B`n\ߢ?7Eo H,#?7}b8^,_. Y X@/i-_-_ Xl_RY_A_ X_9 $r8 0v|)_  K^?uc^u LL[o*EܘvwR陼\+>;^&vclK],=zjEkNTi~0WmA^%ZKD̤.[3 C:]9ƭGڽdy$tnW{{}ldf}?@^#3e5&߅ qpI m~x)*^]+DGڽKV.iUͬˡda:mؾ1OS7B~WEdo7:1,uidLe4vՌ)BFQg-1趁7sR[E26)w'=tےLO+7S},x3e/YDonBUCoq?vlk_r]1oYNsՑȺ}GJȒ;asM(K`7Q(a}Y=:Qf̤hyHXVJDd!1S-:ڿmؒE&f ƛnCQ(^ I0{fIڣCN?al-*Z?-Kť%]tRY|1oR,gl!41tb n5ʂ6;F߀HAb}rY}(^CLBhؾ"Qiro cj8sN'2hlxJ]aƗfaQNk8L^*͸I۶dn%6P2u4uZ0W@-U!զ*[9~Kt˅55F>$CWqhUgW1˯B!>fqbK5oOml9+hgbQ`5;!~Ź-^<)e򕆋좈py bzsc5j/?xz#,oee|0"&b¯ q*,fxY׺KC$+ۜ"$޳u FI/qV"wB((U GSKKus8[]QҢmWGy-EnZ:k}AGg3co'x1-=8KL٩ ,ָ߹O5\7.SQI=ז(/BOK*~jk_'RpMh:1D-oaxg '3DVUtKY^p-ɔph{pO!/HP~X"T=f)Xzb|E}68e{ /O0Ou3`4&%ykd^k[3_BpĪ#GCpT )-[V; .;/5$"JgFzOm۳*I_oFhnS cqEuf Ҍ4\[Jj:@XIgEe pTXO+aMZ4/agu}Oy#;0ѼϔD ЗP89K+-&;7< åNPbQ ?d͛Oi\lZ4~TL-%GBPTyNVpow:aߨB^v_ ~,kҰ=`)vfN &몒͔kP5QS:L|zpav(3/jrN߽Si۱$n`7;·_GvA醔YB.>+ż*Y/wOD*7:FţXC\"jj qb(@CM'znOV6^{wtuY#L;p? Ńyͼ70ԛZ^@{dY*tX>wqrĆ.L"PlD+̍vŒ\BW% YPL@Cp&jME8?U"g:l)5NƋt0^X1k=k+wTv8u^OY6y(Ux[}'CvWGiy肅~_ ) ҍB}f0%E\˹ʻ~룇@[WDw0в?1̣kOm}eq୷ݨ>љU1J4Ӟou/>M‹ 5m(IDՙI )o]zp hEn>D.G)72' \WJ%q415#I0SpWYQ:TG%YeVܗ_j ձ*B@ezkR">gTP`RlϼZw|7b-#}}˽T- chƏqӲ.GȣV_ ŸY_1j$؍T bǫ2]46AdJ Y3Ee8ҷC֛"Sn# &7-w2"GBuW Y e.VHBC Id.tKe:lgq!l̏DۣjW%Exc'ZttHu)хSј;:(WːZX b xeIyԾ[?{_zwr'VMMslAE:Tl)x;2T/a=a@o 1ބx 2l0s{vr2!ZsƎ,3cG|#􏤏\9\3N<5תu 2A>I8YB.eUh Ȱ֜8ުzftM p=Of>YqvjϤf9V{eB 4M;o{%^E_~N}Qv&u0uPq3/&Ux[BI'#B 3-x$FJnpJnk9UDm5o3`v騼!{tDxFn0Y%d_t/WոfL/g곻\0ݚ|LI]9:XĮ3nl7\v %QjUJ7sĨ>Q"+]GI0߬FӰ RfG W]n?[OE+@CԶmF"$p隳Lo|ɣq&vZ #{۶tnBdJ8.ERZ+m;J^V{>'Eԣn8O=6rͼim$r)wboS= }*U^;;*t\ʭzW$ JE##͠ Q 5zwAeb璗HyҘNOŴQY _@d Qҗ% l2͋ kOhS|%U0xB՝VIW~K(@Q)%X~s'SB'ywxTREG593$O" O!ʸ%ٻ}nF:>ųW#&׶z1ȳS2"Nr=WdO.o%g\.e'I^ɇ>!% w9.FXM`C=g(@\f82$#_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 ƌ endstream endobj 111 0 obj << /Length1 2334 /Length2 14204 /Length3 0 /Length 15585 /Filter /FlateDecode >> stream xڍeX.LwKP P ]%t H#]Rpf}ǹwUԙDLR &6fV~+Zd A~tvvCFh$L@`QE{- `ge3?@ s Q;8z:[[Z@kF`a[ jt63(v`f&u3k LоYXݙM\- +46@orH +kX wg L6ڻ\́@h?heoe33;G{Ok{K-, 1L4uq뛸Xۚ % 0 ]̜A..ֶep% ⓰v+o?;{bȢio f XYYy:fV,9td `NkmCv1q@ή@_?f )u0hO@8>9,968Dl#=pMo#F8.<'8}G[?,NK 47CL@l[ X|+4̺vkDp6;af>s_C z͐BlCEܙv'95q"B0C+ ,M͕PՃV K q' & J&?O Cqas_:BXa8$wNpDUE5t|Ag2~p_{$Xmӑz[fit[Nntc/,rχI#TL?Xuˋ@~f,*ٿb,zGI%̣pO)Z<`︑U6pt_DɰAp<.98='C{5k=;nL 7P*\|I+jP&T׫mw'D&җ U@FdXghe9cy"SiڬEl?I) =.v~Y7ݟ}{aMS3l ^'3Iݦ8 Dk^:0D ?>\kz0p"4؎OQd }u ^+Ei=`jҫga̿Ӽ5['4_{<N5b&Xa]qLCxDp ~o 瑆y}~'`&f>v10о#NFOb\ɉ#iV{&O/ +pmh,c6̉E"mEa+5NþQA58rL0yb07_|eD*'圇j.4 kw+y%'@f@ٯ+Z2oh.|֓'T~]]UqEvoG„J14mthw}Mj:som6 6#ar/Ր˙_A3N&t4F}RREOa!Ǭ~:0eC;tׅ6ZVUm7@za}Y3Ly'[a"K%))sg&uMa>0^ qrE{enVjgfAfS '،1(=6T!ÒA {͸)fR7 {畱*/6hbU,ɄW˷׬8O?qE9NWUkA:Cؼ |˧(KW͉1/-_\z4uUaX]P|l{#=eyavIHѳ5ޯf"H=8$вaQ>OI5Sbdy~1*A3*K`̿^ SSZf=uRC *GݏC@g5z]إEY7-ƄbBs,zSȾ'=4R[OrrnZ魑KÛ@wѦYt0a3)9< I9Ru17Bpm1maĶfƳqwP ȇu}eF$:dHÓ SwC}A#,^g.2n (:\f&{]<M TDW~~E[!0A_$3o>XQd)vpn4g/d&$/JS9ޛsODtXE(0a>9;aMc_9_,A{i:4Xy<'Ob %}#MCU ɞ riVj$"P2Jz2ENMPw Hx44ٍ9f?sy^@\_]r aŬ'*ټiFضX>$wD=2ē>_ ?/^&+Xikyy<ըdONƼ|BCՇBv@Rp{hqLGWJv>=x'j\jM. +?lR4@ U`ZM]0B>~ nZYJ6j.z,M"(cY2xIīͼbcEݛgʞKλfe2WLoa" 9mvMatlOwbƤ],kX"1'GYsr }Y%{]f>e 0kb(mCǝA]+6GFwwY nv;*xJdq{m=eRaJ>I|bn=c 5q%@O襅c1q_#1oǶ_C`)iC)Y(g %"^ mvK'ۗIϬ=JS%K3kMjZZ+Q7;d+Hh7+%-PmYmK⾺nť@\:|G ֫N>U 7% WE ,b !"./zy&^*!lOίMMN X8 .=I'ˣN?'řtx.A _ںfVn$U64:;*@|9~C gS)GJS` Kft92ZGO-8IbifcNYz\0Sfi&˜)݀Hw+5W'搠q'#ėV2&<,} ?GiruhPZYChC$Kz&2ڵ-:x cJoƻpu^r%XC!woqe,} s׿Ai-|*#5@Dl.D󕍍x5Q&ۆIQmЊy%/lOYrTJJe>τjV>T6-*P@!mtKeIgEH &<Bx<>`dz&mZM5wA1՛ W~*n͙D]e.|{X#gXkmv_ 5d=m%*+X7Q@Q'ۜLs~} ʈւ+O sK=/+4MEk _nVX߲W[:߫i$ B/$dq=:0ߥt=6cm{W˩R{y[q}O;HFc"@U$U:K%-`'Bа'<2ܫ)WGN *(Õq@' tRE<$Jk""cԄ/ p>Yd2/Bq$ÇO|G[bx@uU۶. #iOv5sio^߇5j .ïnÁ NyoU{?U!6j{GyޝÜ֑֬Ug C#fcJ*}{pz))mh 2{6E9v2<*:vmqO8}l} J߫ʿ%da HBWH\"}@iJӔĔ0|?}G?c'Vc4\%|8?D(sjsjO>ϯ栽l0?Ph]},xXN\lS.lzby|=V^~ws?1]}nh[Us$Ou*g1{hV/S^ߙiGRew~^{fe.cЎ+a It jib;n :BPx_ExM!pF?AhKb^PZQȒEGc{#˙7h۳^bO.;}xt sz\hqfv5s]oX"K߻ZrDLj3{'ɹt/gE4DDk*Nl}4-^j0YY}K%PwhlyFIY4RQ=m"MfGֵYR#YCm}SN+kn׎ٚ ]030gǖ4֒ DCאT(ӈA"ky)g[rKeHkL8V瓙3sRqy612esp UGʣ9w e4jrFoI}kRWn1LYcD뛛Qᤵ"2"A-/VV,4UxٱJ%+ }6Z?75hS QgmkZHs3)q>@e]VMF!geᝡfT k {Õ<$#U /:L?c&UG։~丧{e~*[:NZ.N!=ne។GuOw{+YX)oW!+snބ/j7PkWD$ [_3 ݈*7INFOSo_,G*] EL_#.&1iCE*a:K;K/1W>u2tј"VbFnZ "@Ɗ O?BKfQ mHJ"|rn%z!$RnjߚvJccM;(Qau!MꁽBnmWeN`&XNxFˌ 3xP{xV"W| flQܹs I Y*d.s- 8U;sXO!%m QoZ:.Vt6xq"Qog) Yhȯ0J7 ѸL "g} YKFȋuiW r,֊0chPnr5dC_lBM >1km}yw3\50V =;)O1z߿_d%JH(:!թRe8n*OᥰJR_Hl݁c#<[aOɌLZv0 wʣm(%59ll ($6GVF]͊gx2[lC1Bh/~ߋDehA~%I%*5(ԯ2lz]|~0V`N {*\udìla1Ǯ #;!+koV[cuÞ~zet\ eQD.v9 ul 67/bà7 8YCe7 B[5qSPN^5|P|BD\Qz"};ZnAZgCWwP UzI bs&m#1)tB _{zCVBjKIKL@dSXPfR:v"(D*k8I ?y$E÷)h(`|ū-R:Q|x|p߂mdG Rr'Rp7]~G]ڷNhMK (o(7"*0W2_>+'NsJ&44K ! BL!%%l9՞Zq+;Q`sh,ҸqG*OG90Y9k=)}ckmlP~S3HK )/6p(5k]*6K۽Q4]3Fg@dg,ׯ=7 Www=I/g1M:g|k;DG! {)6@My+;Kwƴ*A9 Y-5r攒oR UU֙}fgSbf.,V".r|_8L6{=1Vn _`ȶg^0]SGO.K-SmpHN˓·X"SSZ*S/!(CS$]_j{wW,iѬ%ΙؒWMIOAƚDcM[w&v,]`ȅ[D> ĔS"˺8>.xFKÊ拿D8OZZbY p.1y'䤌F}'3}`xӔ"&% s}v0}cMfK\I' 闶,CdjtR3ۂ)g(sȏNĦ~ʮ_ Eo=3bI H\u `Ž-=x쎘%%tQ4xBL$d8 ;z[,Z!?%) Pa5J_aP{'|k^{_(B:Ķf'tqӬ>شp w6AjSA2*=:%0zt,rܝyҌ x?x =^Ү/HA)uFsO ~^.{3OP2l*OS2C3 mWL;'[Spj 8wPvl<:EQ]\CeO.fwDMf\Js_,JU1~,.IɗL G; k}4:|.":JA}ޤH19=$aM+T`P3~1_!Isң%8B*rcASL 31{Fm/s ֤61D<(*KOwG|ds}.r2lPaTj25&xcF`μ!9fVxF^(y*쟣F Bv`9$!u3UkmyG?B-%relmA ]ck|91W葟%xgڵsgeAe%S+s:jK3s|hS6$*@J^YSİxV 1oE@nG,]"E: bzvfe5/,M-9 zgK utP57ɔGb$TG|ᮤS`5 :?HdDn *sb`Ò\'t AQ!s6wYg.篚\2$Pd]pQ`^vBvV!":s&R˄ve$Ǯ%2Ŭz"β0r%t'ѹ/HY6=LAvxz&BЩDpgQ- X,Xg*5M#)RT7%_63PCiG5f꛽J7Dc QB tRJVà []"OՒd L;>' ($)SRSa[ͧCKqZAzØ"咳+Rv3 f::u>PŸ{CC|ÍKʡ+m"S|xwr&aMѮS}N^񉜢4f>[/"2&% Us,LSڻ_IݲAm@ 'ŸkeۢS|'Om}\~naw7prץN1绎H'ϹYC^cԆMm}W$XJl_$Mc3N#}wRHzP{k83C:nZa՘uocX|Psw2Kj:9t)%N{MEe͗+'Eo(G+jN5ѣuP'?o?XUIhݪwN83Aشo#%uгȾ&AZXj$+0ד65|Ttr59OWX+yMRۺݳ6Wģ<n67Qu;=ԾBx397}g'kzv-hʽns OPv++c(}8y|h[ZjFrObk:Mï DfMmD}y.*@>J8mwoaG=NvB1s4y{HK>0i8^tsĞ"[AB,^D*- *G@bN7[\S! nUY0mx%a/K~PcR^ڔе\UX6Qb;Fm_A]s[!RVq*V\δ[:gS~?i5xb,zjjh6ע)E1X9;?imSڤۊSk@]PD>k\ ,loG/<B|asEm^}#Y qdHu0ДpLI``U" P_K(nǎ!6Bf -lK2 c%2N{El=a/{ЀVsM}= 4tau*$-A,Ӻ x{(;W[7a&4IQ\X2#]5c9!biY }T5ܪ^IŞڞGCվ |cĝN]Ʉ]՟{L?:cq|=}N"kq'޴h:U w?VC":lJˤ`Ȗ#U}R Ԫ9-Ǔى*isHLƢwT5kEUu͡>;ԕ)t~,VVS1~ǽUNG&+2^cfL L 8͙ "˦$:RѸIV2^nb4&_8ќo)8f]Z2|QF4ɑxG3wZ&2Mps/js@ڗ# } e/eݿo(">$uK{^~#DGa|sP(*G"ǧSל(=a_ ?*RͮfB$?y5T7{UR<;O'OQT\\|GJ8?YTk endstream endobj 113 0 obj << /Length1 1621 /Length2 10013 /Length3 0 /Length 11064 /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@^{O)Qb Ո`{mAg?72p?/.#[ݟz ?zS{O|v? iC k kU@`g*MvDbsvn^.޿` d[ť]S;0xwGzOo T6B̡ `dĀ'~U ۟pr@'SK+pj! >qHHioGuN?  p>'*@?Sd@SnO55sg'Oz?_W rc-BElZ*%DanRlH>ɍފ^#=6qzD -ԶZmy}#ه);ߙ@,5\$9IߕX~Yf}XT$: RPdzkTt"=Dbw a ߏ6Dz=\=O;]J&S ]Z`#t"NN65א{>aJ~v3{H]kBV߫RybQ9LyL_A '⌴`S)lijsÑN`6Q6sv+*n|lۗt:yT^#Bl[ΖWMDqU7YYӾHcY*SeZSd͛$BPoI'cb7 pE@rij815R]/cZ]Ƒnc Rl(#s`/a5]>o4۫Kzj\j5o?`RYPGX"~/qC,3&vɭnAl#7Igwݨh%@o3)_ӴJԹωo>LS TkXvԳ~ RQpc۝sdWCyXcZ=hPsR O!yxl+ak'$=}f5l]V^p'&x@ alfT8?'m{Gڒ BݍUUCPkюNjX t8,*<]:)[L|3x^ &KIT` ,sg 1 p&Cm &PoeGy rzr!_\bXh,hw@vAf7"Makou{@9^qmo#…b:VvXxfɪYHp=YERӼ?QG 2zAv̄_j;5c0p)QslD2I`S#u-@֗M43(@IPqɣ¦z5l UqU8dO!Z/e;T ^2o iuZK6ɠcvSGڻ8kߣ&{pnoRc5 ׊Aj ^uv(/? I0OS]ҦcCONKWF7OawN0Dope y˙"϶q]o7lBr4;/j#|M ǓG8W=z^~<>!kix;NЮ.62ap1Zpy"a(:f(Yڭ:و-l';qٿu8Tȼ;w3쥯+iZ{%z@tA * -dD5j.qNiuQ~zX86b^bD|C:_|f}FSmUʲ[ܱƵ9>n~yΈ:'6O׽ڣPѷ *i+kBti gNENwwҡLF G #Q%8ѡL;T-j塌ڪWd\qv~U^{Y!}>_ྤ t{*d <<[sxdrBj FS-Lx."W@A1dQ#":iy%N X[2P'ua*~@;\n'$j`ͼ%05h(i]Vt#|~ pgIR kΖŽ{QxY;w} IB|n8gW$E\K.)>Tx Lyf.1WlE=M7LfL%]cG),sc>O m9S" ݩDe^l`Xƚ MuиJ&zn;0JK嵄D@PTy%EixiYOn}]WlE}`*eMU\.9}4ts iD4cYuFea좌B%mɻhTφjWʏuDTyT}o ];Å* Ybq eBqEgɲ8ex1m:,GV!oD@Ɓ-ڣMCjf˧pO&EC_Iyڑf !HFQk$<G~\vop۷yvs4ZG_Z1G ˜kI HjXIxG0Yy@?h+ /4H Ͷ])td kN)'^m25 )xUqHv-VOșimIv:DXd\>nMQ⵽\[L`J`\ܸۧUՀ ҲgCqGEVk zptՄuE A=Y*u]!o3Qi_S:Xp¸L%* QRFM/32WmM"7+ %DVʉ.s \5(xw8lxI]H2MR%'po_ h8ĻF&*9ۭ0oPkJ]B Y\ \[Ei?Q}P \F%j:=I _aYA9|K?ʪ0"z_ydlq $t.uUth7MGmZQwq7 tfLc.e~2;9hiw+"YM_"Fגµ^RuOyl ݌ゼK7_㙩:[_Ic}Y/Lm"D#6FpghE ق8OF +Ų?1i]r0%f&P%m0/ُo..jdÅC_6=CɵRPn 1nwjdwQߴ1:3$|'2('d>@wUPjnLu6B?ό/i02uﻹj@71il OW ;Es={![|(l YSJd$7o KI$ xP+4'[eT>ޅOm'W!W#OHPzb<^RA/s:b#Xr3N1c;vKuF@rVXcyZes3C1/;ԑA9ضetǷ,13υ|M@͍(>R/G^#Q971&"GwCʭكlY%ޠIs%)b?J&zpx8mG:—KaqX8ac":~.;RmGټQ_\7t^ ٝ$HW}3[ʸ-L:Uߏ3|"BDDu':va?=Fwy;r,MeoR$Y}?مL2w,.rmE/g'IJΘ0*Sqn{ {4)\0M S iϘh߁H_gSiUvVKdUb0O;TBsb$uyxfI%8Do8cͶ>xo~YEBot:u8d]teOu|(&Oxsն SZ{c{cm<Fst%fx-xw8W@W5L9K%.-NJ}O9n*_$?ш5(]gSS SЧ) N!avIS ci"Ģ@Ȼh}h)UioL6iHw ˜1ͼzJM w?}c[CٖPt2=Ɲ36ˬQZpˆRsp >P>zԴkYi$Jx"7a'xچ߳9 ZS0Dk35 Lrw nAajGn90IZ^5H@Uw:־sN'=iMT(B|.onT5 )He'[qh̳|*Rx涪s;WY0\m΋|VN {>8&Ӧ?6U{e<:@J#˪yv/r[sJH0^Y#AH6z3ݭ2gwLV\vtq׏c>A qT& X.~_v9ig]Ntn#KVϸH'`,Y'=X\;<)M1gd#w0AbĄH |9m8P i1XQ+ ٩?TƑ踧>²P,Deyg0OXXdM ­G=#FrYzg'U?}X! T,CzC=] >\-`# ;6zDH~2o>@bMz󒌓- l3NM s ^cQvY>."$Ix!J_f7-<~~bTϏA6{!=Nnpy\thݴo{7 &o(k7x"w8ѝR&ɵzi{dagL1ʡ^jJfG4#RݿqQh-XL:!箹I/Woڥ@ Wg m#/G3,QbfTգ{s5n5?_n5_& |j}kUŤ 22M^PGhsEGD,G.B-l"3(Ҍ6ǖ$II0]0,}aF=֋0"򦉪b[Pv!iɇ~]|r/\лUWR ETKyK^GO-Cwa7' Y%Gq&K0?Ek:˓/-mc84'Lkұ]>6g8}Յ)7JSVqJbg([ u/{"\F6j,nJCT'/,$^~M@JT~˖ 8OvbSw]s}MN)<'-ڿLQ~.Y%7ߥ3i5ΘB'-iK/%ś zjwX}RE곇`&V1&C~~TZ6[ BX8‹\؎oPdրP.RM+):Gtۺ-Zq Ű#oQ?ֺi8]G ]dH&ވ#tuפYXe8GaBԺr6X<Ql-Yޛ w0桸<ُBkG8Hm9b$7 |b%yj?wXԊ15ܻ",;cIuz) ;-q_:t/_.`1Bs}T(z]o=z9(J !+檳~BI๻Ig=|xOX= P=-&l7 endstream endobj 115 0 obj << /Length1 2290 /Length2 15214 /Length3 0 /Length 16575 /Filter /FlateDecode >> stream xڍP c vpwwwwwww.=www  s'WWTYݫ{wݽOAB D#`lgh"jgL@K QVf33B([8[MjdagC&lAHX lFzz9Z49 70ppQ1q028|hd` P30qttnnn6Nvf7 gs1௖6&F MP6pCa02uq56q|Pٛ,5q 'DzXؚL-MrҴ[㿈NvK7 ( >:?'#G {g'Z' z+͇"Bv66&N'lhb?kekf_djaklW.t*.&p>Lпmf&zzzv&FȜ=Mv2e`цh/'WןE c #g-fwph?|LoWL'+%(BO:^4F&& Ym7?Iؚ8‡vm gi({46= /+w+ߊD]71.!cfu11p^ g 5WH 'Q wcy g#'D@@O|+gd8}\.ElZ=FV4|1>v9>9Bul:LA:=N7bIFLS7`*F:y"Fdd񡀵o;7b@FV&oo;ӿٿE,Ɍ?/|HOg8w9ҙ \>,:Y>mGQY>C]?GY#ch`qTono[q]~ѻ"sc| ?ddPw&|Н>NL9;qS9Ch?Gn G1~Grj8~(ŚA,qY}v9#9PKZqpyH r|HE\!_uږ8s<>8Up*P? C[ K$^>ɭ_̽~lm˩39Cwr xh4D&6ZfmjvC ( UQ5Z7qTvO77Fĩ" Cf|KsM pő2Z'"~5*v3 =zey/HDfTuϧuO٨"K.߿ ۯ J|/ W+tD1/0_hit%gd1~rM^ِg~bF Bm1HfxqFÙ.敮D$\tp[\ᑓy,ԍ)*d _`3NMv=V .Eŝ\hÜ%Vy͈~3Pyb,U]aϤ # Mf"NQQ1LPLѝߐ)!:br5CjP72X,q弐t ?0 Aj,В".+ϥH3x@ Isd6iϸ0RdRspd9H"Ԝ2G^JLb9|4W Qd~kG}5sn^ JWdT'++ve8jP%f vS`ǿ;*&U wp9Z 湵'ADo*+Hۊ5oGꘈ~GxXO{Xهmk0>U隩(;{ MOzD)5I+tf1!ő.>@+:ǂvO}]lkBf8f@,@ K9b؁}2 6q &Dwve5GXuY2@6Њd4C#o6d3+U:BsOv3X_4pWBs0o-7Lg}IDȪJ8@OTC7Jʪ *0`8qKoax~m~ռ?dцTc8䜛XAo[^!Rq:G{ס& %b{/I{5guj}]J[,`*؎D.f򪖶D{T AA9]g :KS+xam|wjwQ|)YqcXַr蜠 (r ロiʁT׭~M2,n*f(JfG Q((me%a ifJ l}]No^f؀/j[ l?~w2ך4~JPN)(ٵrn\64)M&tUG3lRGݎJOp` w4^+w%%IR'ed%? LM.{Meon\jsB1mUO2qn & ;m<&+uhyLF)R`A-i!X]=] b ",7אIK#`Ŭ"A1((< ֧(譼\~ѕ󤈬3-*Ql~aif-` IK ݳ{YC9 BR`UvNj[{N?a㘱jWz7Y,.kj $5գY0NϋǴ 4CyH2)=CXӨ=%E˄roK 1w޸8|Oɓk`@M, H$sex0{N3m k-?glY׳D~bI$9EZ mQ}w-0l;V`^GۀYIƓ_Vu0n:,R:>WmR5@|^v*YPM({JMن(P`o8fnL$)̀·"0̇B8aX<sjj<=Q mf%2%EZj_Z?OeAi;~mf-bJgl7W^ut.=9V6):X]0Oc Lw8S켎qgd6ɭ맠=؞^XsFV_j{&<$* ["ˈ Jr vIER{ӆ^eT3ϘSW3-B5Z)Mu4d (aw{qoz Mh| i۲q d};U6lDZhp ހͬxL^P7xrWj"CڅꭦI3dZ\j0tXhZDA Vz%F6 +% 88^Ү%A( xh=frdh#eUECȸp߂{!dX8%sl? & g '-3K?59 pO_>u#L`APY+zY:ʭ@ǚ' (32Ksoϫ9Sa1@U/G%ѐ 9F9(z(?!oe |P }<)/?n=EM 3G2,z+ [>1M!Qnup,?w楄~Ɲe)=?\YPAN2YLMx-@ޝqml"׸D*Ou2Ž+zkjCD]]WOc ?jʬaL ?)£ ?2)"`P6CL_AWS6H )1E˘7)jR/ңrNdcX*y3 \ɍ+/T+MQZR<0a-{cb9Z 7P CTeJwp}Wbz}M&% ߾7`YvF=}>WGݔ'<4;혿^J*>(ıhɻͱV' g荤[&ynoCjwcp]?y,mg`§DbT>f6-x}LdT&l_rܟ8D;GI.㗩{@HX.FN~nFM=f,—Laf ^;>3y yh0?A,+ሏJgS|yG%,6BBQt jdGvǵP%zBm~$ɇ1KA3v4K"2rK7ޗxcƗn6,C`υr?^@9;@JڀѮ"%Ũe=|N21F(?m&H vD[ЮÂM7.BK5)Mkr~ͶYLV3602GE߹m#aF[@p\t]i2Y!4"(0zbrԘnjM]ixF`4h'Vy#c $l9Fdhܤ1\ rgj(Ḱ]ת{YBtlI%CYQy]n"M$$ 7D PcLdI 4`ZԀYVe 0UI%ںqϔK=3+M~ }Y/[bˍa9{fV#: "(|9at?&w-@KǠt YZA Eɡ?|U8_C_ROzϼxkfjKZbGaWbVTġJ] ۂ S|Bwb.U9s)!Ģv?ĚŢpDޖfޙeNշD2Yv70*NHQ ЖRߝ"wt) hzARBCm ^Ϛ}%L&䅵fv/Eh?ˌ7=Hںdb2joS;?26,ͼV{ssg=l{.ޅr?L]'Owl'4 pnJM%8.[S=%c.~أFŗ/oV>Q:?[0h \n?P eLza9?BӓA"!T0"9PQ(G. 6u{L>˖!/:|<27^88j:K¤c 5zICS׌ւ8 !U!3MŴLHJ[H%1O b,xRr<9|'ϼ`3: y?$]!̽FtZӋEgJV׌;AilZS[ YiX=r^dZ_EDx{ay-Sîf3}Ü 'XC'iVL44uRu6MC *c?]9֠C>QbUӉ=)-:<H[Df=y'fa4TMhcC*"r~u XyCLFOl_ʛϑYf'%Tf JQM&DZe9/_N~@a@bЫg"h۲Y-a:l{´}i.V:sƷ*Q[M͝ 4+$e)`Ul?_R2*ؼzZzF q,HJPOүL`sl\׃7JߪHs%gGFU)GwHVK^kS|n~(0*@{Yʟ=^FQum?>_y!&/BTVlɤ<*v3޹xka71Ki͹Y&0[,ojQ" !``IܹTK՜OXT$urz4kKAc0hjo5Yg]f^kC52&`01^9W(3xۿ1P} &}5-: y'lА53^ Ě;wfC  QC Z 0nn{r`t.i:bL,"dֈ YڈvUx} 5߭`>ZZeo':F4r/lG8>-5k-KX[jN)'MZxyC8n hbvUIMüN[_߃I74|7%8Jϻfmw- ﷄBH(Y|= !XƗ) :wC$~.!S ~O|~pS9ͿވmsR{]rbhF){.1 }٣U1H :$=;tABչ]2x==+7d>?ߕhZڏ /[P tQc0)jVw4\w:.}y嚯Mi-p H?QI+ >ˮBo#3Zуi1NG0Z|@xD>VOǃZ,oȫmoA$Xj-[1`*qzd@m)6+8O\H" } lNǔ'bNMY{ur'd&*3D[X߭&AG:YB粰t} )0'z|]; 踶lI#5xA/MJL]va?֯D- @㡒@(=ۅ^`¦k SAY.X>@|jǔ/Wѿ X >ԣ jL #kߙl\ZH?i­ll =SSk$e\kb@#A"P ˣ/0սXh® 12m? *]WR8d@%EU.s΀]bIu;8 #Kimw\caC@lu=0vYdl׬tvn"x0 &'uauj|(<[dnZJ-QzxAHG3?P $%ͮn,` vR5~a_hpΧrA̓2?- E)bjrG]8 Lo=(RSn[ʑγk3:_eK:=ڥP[ϖ1O2z2uroY HӚj`>Z_* o2d:&O,DI1 p}PA.~8r3?sړt9綯V4 Aky>Q'Eh.=C+X=!)RE6kiLQ,ޞHU\ 'ezufi#+tff?@z#*uD "̛z6~TBJ6$N[8b̐9% Yݭ(6ًӘp\)гd DQ&Bp.΍lCX%3*QdE1FV>7,,̦vÅ[R`t>HmWX6/3T|{~7nO̽x?`Qmy?i|{}bfqNIȍ8EmJܪ>V"`RQOߦ`;&.68@I uD2wGYOFA̝QVCŜtXw,?Ы$(3wj뺘ՙS6K]9qjVetS'7&cӹ3/saxcNtQN1ncН9n`fGmPD}s*}r,ˊOWT|>l%DLsnɚmL%T}DkɲR"~y8b1xu #ژЌ=鬆_g(<i1b9Fx= 4SCjr^fV[\iO*vk.Y d a+TeRAO1xNNIh{Uل$Hfbq)[LHxGV1LaĕQ !7,f2դ\]rz൫Ηz¥GTv|ڬ*˴r.uG BVctc!dbj/;5l{dFZOJZU֓04sZm8o fbJcŹ4Mj=-ě5EB@Wk:$d j7҉f 6%6# AuBU<6ҿZ̧Ӫ0޳K 4zW!(/AI{Ah&e.21ʃjcxq AA?9  K s*5:HUozv-q!gF_!Ei1QPs>vhcuwĒk@?W,r/_Ft4@jt`G:9(kk^S-،ce7!<HT~q${x]3Jg. v(Eв욪 ѐನnoX$6x֖k E9_yKHݐ%B...D͏2C_4W)dL1cc5pr77^A64n VgH"FNjgOv۫ˁ1OR8m{[6x(fu S ,߿xc",gm>T:`j*pFtxe/L<2ltW ~*..,$u@eš7.9C3Nh^ UéIx^Zd]Xr@4.gX^Wڎ :$jlsE4jY=_H5C\\}4sR& 8oSO0gS^ꊇZ),c2L{j~hDȐ\/kȸ,ӲdnbRgk;́$^3]D .<~So/ A^b͇lEp"խ/tQZB3B4~1%YbԂ @1rc4|p o PTpD5~8Ӌ64Ac a%53d?[Ԕy*XЈM╩X&XS*U!nk=b$g@nYij0T.yAdAoC+XیOw]* @qCB{*j<(0ƲE00Ҹ1xGo2&nh4c`C=>s e 5agv Qԑ \ZLlQPlnrhZ}e3]*Nf--V\ &x}YvpVwϼm67E=1DHl 3a"Kw)zo- B^HDa-HzZY c. Lݟ Y4ۚ@"Z~{7cuԭ,!O߽>v"y-bY{Ʃ xV29R +uHR_[LK|f%,+T9vEp۪RL|^ȼK @n .n@+vb¢$@Tdm~aX)Y \)S݆0$8dio@̓U!P]vFq]Aے{hCR bp 'G@I ye4S8kfܪ.)' B5h-8 q=>% qfFEsyH:ϒXQ]v $$E< 5w m2"n\1ørVQtN.YuN8-aΛ['%Dɛ[!z5J bSG?uq,Xx!poEXhh~:JPz[CٶP\S(5D[i)N L^ Ze]c2V"Ojgum)3&紬NGY*$gԥ4TV;><̮"ϯѽx+i6\:'ZN녑dtG{%=Y*2 |u`/X9r,@~kudmd%$E㪢!"KOM۝o?q;eƆG#TAQBgs7:pxӫ& ]y{ܚQ\pUx##=Y8ǿbκfESҠrkA_m[ HxB99+gRLHq=vv^-~ xjEִ WW?J1-UvC'QL[?NQm3ED?#7ੌm]c0OZ)ɻ*ʣUmYm16k:r.92& 3_rHC5©v#lЬNDh t XWP<Z֒uMNN-yr5_+[ L?/c? cCfꩴe$vF'V H 9F9O8rJiIN>0.~yr ʺqIr% ct Bؓ1-Dp~.☨QRIizVSk>^?;I5*c- Knf"ru9ĺ|fuSmwA)wuH8lX`VH-{g`K2OS̾/xֹ^Yvv,RjJ΅/+ )NDBx[E]>,lh@bQ˨KpM!;H2*f{&*Zmg8lWXT(aĴ=Hd_ص֡DV#MQib[||_ƨՆ~'"{Ah)DO,I\?)@] )nU#F~ 9XCffڒInyzU&SNk\*P3 aJ_IEYtڻ$_(֊&QF4 o .a (j95`Ip}o@N/~;<5}rBYLO+OęgAT4{U. C]ZNvN-'ξgovrDr`Q3,2ڃC2IG!F*QŽ\ !_ uxz "ހV>3[ma9qA- od '*f]5vC?5.J>6R&oņ; n-Ecuϐ%OFDvB6J:Hqpdj{G+֌:©crl!*6$mAN/4/^AdQDbsjW%$ZX?I$"bP. &uC)v 6LԶ:3 NO(#%0l _4'\C {J,k:Zؽ_w{@'pZ`{}amd'm BHb*VtO5td&F Vl:]摒-k9glez=3~}<8 3Vއle;hKIc5[S;HEA3U+=P//On_jEḬl\6pN drWy]0(}sVxe :.JAyo '+P7^'-dft '30cKӫ3c=FGRIUk$FGAMjk$9|FVb3;$x4͠_Ȗʟ`cS(Y8oy~߮} +^<|]kpC!*M-jҨ(7 '&է ~#ob ʁ*F {7e/ۤ|4g)PM7}P46@]ubJ,IT82k(m4Xƌ;&X~֌erS\Wo}MF5ӟ<)m q*M-i0}c^l f(g<5vAQaMmݹF킹4du S1##^$[ .p7\F( K5##J{#.G]AV"|v@Xwź;&az0g2Y+<,F/-;m/d/s(s:`eﳷ(!aVgiDX}݆SQrS{)e>y(ۋh [1nRq zFËk}pZؙm0DֶU0K z]hNHɠTO/ Ʀ}+Zuu]tᅟ熬4+-.UT7K`^bf0`A#SB0f/#n,ܫzw57eFď:έϖ+Z'9pv{DO% endstream endobj 117 0 obj << /Length1 1463 /Length2 1873 /Length3 0 /Length 2805 /Filter /FlateDecode >> stream xڍT 8TyWK2tնF1sf%us2̌AM۠B\ڔ"".d \.RL==Gc(phV4 +tbpdE"Nn HXx4DW@f"؅8f%aDG6|16 (A VTX, 12bD>#aS0xxc ,aT@P;uepf~4 Sly!U$l,,F#h"|x:3)(1`9`D>+Y@1: 8yp#BE21;,, F|>GĹGS'/7)GN]""qCH}!Ap<_t8nd[8 Xpa⏴Mm|ih4AB (su s?H HOBa G+a$OA{{, l3:M|Y)  \b#hDN<4Ff??2ă")_^뉜E|"N8+ GO"5fc~_C7 B!vhA"g$ x!B6Ok {LhUX9v(MF} ec Y$ l;ʁT @.Wjnr²TO%i aM9 E8NBBS;Q0c{|"%b욑 N#x:X2%޷ӛ81=obh(tKDΗp7])@9! J}j2&/zfX.  PfMo؛h*ƬW첮5ݩp].mxR羱t5-Ӑ%ɲm2^3^9-O&`AWr6o\^/}{ڛлn/_9´Yx1N/E.hⴻq}H_r_Q`부54[H6bHhR->w:c/d9E*:Ghm˹:QbIF^,mvcwHg뜜M+Nleȹ΁G\oExM g}T_;,a {yhl|=UŦ)/JN?<,i˙&҂ٗbȾ9'K|{xMU2E[lNot%o 8盋Z"~NDlښu$𜃨p筜}}y5D^Xla;M2h^ӄ']܃;w>|aK'q>OIH˶fmRd>N~|K%RT,%)4n]y~sk1i=:*&[c$@ĥ[z~ntXMxߤ:{8z"kn4;^\C7& o-_ҵ1J7|2qUKgoPϜ!};KѺƎCWSevkG_c,LM}œ3n7(EoRϟ{a+sIIy޴JsػbTybx&:Qb-:dm{e:Cﻫ1w>UNyߕzg"_Dª?^Xs1fV|܄ӹfOIv]aئ6\/U|T J)uDь q^̖Uʵ-eO=VU׌i/>g&ZOLNeFfh7ٍ+\ˍu^ 3N_/˯Y.xz;m5wTFߠJtN/ ZAz-dj>dӧhzb+FmwMgXw;b(k {Tۗqs S6k4mYks+6= A1xVK@$NgIO[)=|v z^tm,IcMٲwG]^b=lMByS3M۸S%HCN!i#?GyMvRFNeJvde< ku-KMy ֗ $\=p&թO;*ŪWm{27~a#mW1*h3ɒ=.d`%YaȊ} t{eH2HuKb|Lؠ-OuG%V𓪾pHze[=EqE5dJ%+aҪnӧMn0V[ָOG#1ZX$wA`pΫS#r)~d7lպpZ;% Wo규~RssRL7-iIzz\sxĄa4Dſ. 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.14) /Creator (TeX) /CreationDate (D:20141209141239+01'00') /ModDate (D:20141209141239+01'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.1415926-2.5-1.40.14 (TeX Live 2013/TeX Live for SUSE Linux) kpathsea version 6.2.0dev) >> endobj 12 0 obj << /Type /ObjStm /N 86 /First 700 /Length 3085 /Filter /FlateDecode >> stream x[Yo~ׯc"]b;NI4E<=,Zܴ~IXV!X1$(,SJ2iȌRLfѣ4!b r[PȢ$pa2jQˤiFh=hL:0ґI/ 3_4c MxVⵑ "c.@MǔY̋C_!v0U qPk(砊9l!y,s8T ^25)4#&/U`j-h hCb:H " @ h ߒZyl`1SBlLa'~H=yahZ&\&&T[i5˳6?! } G&LIbɼ*7Lj(k!Jv2~æ4m5/*A)E(^jI#]/We1^/w-`myN`oe7ӿSIF_'7ÙK>c3^3 |v75dwgv  ׊øN|[77~;ϭWw/πυu{-^qpqԼa~NԌ+j3ك^|ɾՎa9Cs?Ջ}|*atj݃yF麌1ť'yzgm'vУf'WytלCʒAP$ZAi(lsqc&^Dme~<4*BV*$i+ ޮKZ:gHa R&? 4eYD[M*ck.&:nӯ=ע#2d ԓ -eWeEA/l\͌ɱgΩ3dLi~b&۔6!4ASO.U[4 [ tҮuLB&n(mzC[M*ľ9Pob~jExR=L ]Jkg0rNG/ͭfwJiK0j 1h7zb/y} _Hw&fkqEl¼x,1 s<t uscDJ% yU :`2i^go.sK Š T IFVDc9AL ouȠIB-3Rut@lzbɜ 6Km),ssڋjxv43hhH|3 4-T~l=8,Qu3=k~q"嘙Ln[+ߤ3F'P7?.pCc% tp/؟NדU1??]%Wꯛr+5!#>>巏GҼ?޾~IMυhg-?#s j᠄+nQ5\ʒO7_xG&xQC9G9-yytHh0M>zy>lQ'4LA:\]6oc__*73`MLiX6 %:=p["R1ncgG/_WggQQ6jz:-!\]=Zxlkիy*ݪ^NRf ~1Z$ӢO~qv[%=k/GDsz\ ޑ71Oc;V{ٻgD^l U]1muƐ @όF!(^;2u#6M;A> ڽc $W7)V>9^6 Iwt[iw#^ޛ,p_?=:9adeN`crK4 ĦAlΧ8 lYoxG'9|{i~U*:F )(مMZ%}nK7m5+:p:upʅBx^x\.Ŋ^l-}XV`uZ/)ض un^Wqpאq+mKZV@w qIתYY^vRE136W.E9r>;Uh(55dsaCC 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 [ ] /Length 348 /Filter /FlateDecode >> stream xI/a{>CkPS mP3-bR$]h, шD,%l%|n{_?C" Y dD<$0a]^"iĀXH2H:đ2B2!.\qilClOȼ=贐AoZAIc.GfuZJ I@WꇮT2HܣIlˉ'֓jȶSk %RA#ingV}k&M{r򪵕/iꠓ 9#]dt'2HKe~iȼ4in5) `_أMq'+0<YQs4 endstream endobj startxref 164286 %%EOF etm/inst/doc/etmCIF_tutorial.Rnw0000644000176000001440000002517112441572507016350 0ustar ripleyusers%\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. <<>>= require(etm) 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.R0000644000176000001440000001035212441572507015776 0ustar ripleyusers### R code from vignette source 'etmCIF_tutorial.Rnw' ################################################### ### code chunk number 1: etmCIF_tutorial.Rnw:34-36 ################################################### require(etm) data(abortion) ################################################### ### code chunk number 2: etmCIF_tutorial.Rnw:50-51 ################################################### head(abortion) ################################################### ### code chunk number 3: etmCIF_tutorial.Rnw:95-98 ################################################### cif.abortion <- etmCIF(Surv(entry, exit, cause != 0) ~ group, abortion, etype = cause, failcode = 3) cif.abortion ################################################### ### code chunk number 4: etmCIF_tutorial.Rnw:107-108 ################################################### s.cif.ab <- summary(cif.abortion) ################################################### ### code chunk number 5: etmCIF_tutorial.Rnw:115-116 ################################################### s.cif.ab ################################################### ### code chunk number 6: etmCIF_tutorial.Rnw:128-129 ################################################### plot(cif.abortion) ################################################### ### code chunk number 7: etmCIF_tutorial.Rnw:144-147 ################################################### 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:166-169 ################################################### 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:182-184 ################################################### 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:199-205 ################################################### 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:225-231 ################################################### 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:236-239 ################################################### new.cif <- etmCIF(Surv(entry, exit, status != 0) ~ treat, abortion, etype = status, failcode = "spontaneous abortion") new.cif ################################################### ### code chunk number 13: etmCIF_tutorial.Rnw:260-261 ################################################### trprob(new.cif[[1]], "0 spontaneous abortion", c(1, 10, 27)) ################################################### ### code chunk number 14: etmCIF_tutorial.Rnw:275-276 (eval = FALSE) ################################################### ## lines(cif.abortion[[2]], tr.choice = "0 1", col = 2, lwd = 2) ################################################### ### code chunk number 15: etmCIF_tutorial.Rnw:281-285 ################################################### 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/tests/0000755000176000001440000000000012441572507012240 5ustar ripleyusersetm/tests/test.etmCIF.Rout.save0000644000176000001440000004720112216653333016136 0ustar ripleyusers R version 2.14.1 (2011-12-22) Copyright (C) 2011 The R Foundation for Statistical Computing ISBN 3-900051-07-0 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. > ### test file for etmCIF. > ### Really simple tests and comparison with etm > > require(etm) Loading required package: etm Loading required package: lattice Loading required package: survival Loading required package: splines > > 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", ]) [1] TRUE > all.equal(trprob(cif.control, "0 2"), netm[[1]]$est["0", "2", ]) [1] TRUE > all.equal(trprob(cif.control, "0 1"), netm[[1]]$est["0", "1", ]) [1] TRUE > > all.equal(trprob(cif.exposed, "0 3"), netm[[2]]$est["0", "3", ]) [1] TRUE > all.equal(trprob(cif.exposed, "0 2"), netm[[2]]$est["0", "2", ]) [1] TRUE > all.equal(trprob(cif.exposed, "0 1"), netm[[2]]$est["0", "1", ]) [1] TRUE > > > all.equal(trcov(cif.control, "0 3"), netm[[1]]$cov["0 3", "0 3", ]) [1] TRUE > all.equal(trcov(cif.control, "0 2"), netm[[1]]$cov["0 2", "0 2", ]) [1] TRUE > all.equal(trcov(cif.control, "0 1"), netm[[1]]$cov["0 1", "0 1", ]) [1] TRUE > > all.equal(trcov(cif.exposed, "0 3"), netm[[2]]$cov["0 3", "0 3", ]) [1] TRUE > all.equal(trcov(cif.exposed, "0 2"), netm[[2]]$cov["0 2", "0 2", ]) [1] TRUE > all.equal(trcov(cif.exposed, "0 1"), netm[[2]]$cov["0 1", "0 1", ]) [1] TRUE > > > netm Call: etmCIF(formula = Surv(entry, exit, cause != 0) ~ group, data = abortion, etype = cause, failcode = 3) Covariate: group levels: 0 1 group = 0 time P se(P) n.event CIF 1 43 0.04015931 0.009257784 20 CIF 2 43 0.79905931 0.022186468 924 CIF 3 43 0.16078139 0.021326113 69 group = 1 time P se(P) n.event CIF 1 42 0.2851118 0.04249308 38 CIF 2 42 0.3525651 0.04213898 92 CIF 3 42 0.3623231 0.04947340 43 > > ## test on the summary > snetm <- summary(netm) > > snetm group=0 CIF 1 P time var lower upper n.risk n.event 0.00000000 4 0.000000e+00 0.00000000 0.00000000 18 0 0.03895488 13 8.444048e-05 0.02448808 0.06169378 645 1 0.04015931 23 8.570657e-05 0.02551262 0.06293875 819 0 0.04015931 33 8.570657e-05 0.02551262 0.06293875 885 0 0.04015931 39 8.570657e-05 0.02551262 0.06293875 716 0 0.04015931 43 8.570657e-05 0.02551262 0.06293875 6 0 CIF 2 P time var lower upper n.risk n.event 0.00000000 4 0.000000e+00 0.000000000 0.00000000 18 0 0.00000000 13 0.000000e+00 0.000000000 0.00000000 645 0 0.00000000 23 0.000000e+00 0.000000000 0.00000000 819 0 0.01354288 33 1.216141e-05 0.008169604 0.02241009 885 6 0.32201590 39 2.469805e-04 0.292313907 0.35391574 716 165 0.79905931 43 4.922394e-04 0.753968839 0.84061317 6 6 CIF 3 P time var lower upper n.risk n.event 0.0000000 4 0.0000000000 0.0000000 0.0000000 18 0 0.1504675 13 0.0004551293 0.1135970 0.1979013 645 1 0.1570366 23 0.0004553237 0.1199469 0.2041947 819 0 0.1599039 33 0.0004549788 0.1227389 0.2069247 885 0 0.1607814 39 0.0004548031 0.1235965 0.2077571 716 0 0.1607814 43 0.0004548031 0.1235965 0.2077571 6 0 group=1 CIF 1 P time var lower upper n.risk n.event 0.0000000 4 0.000000000 0.0000000 0.0000000 8 0 0.2604775 12 0.001785362 0.1879526 0.3542503 94 5 0.2811533 21 0.001802770 0.2074197 0.3742279 93 1 0.2851118 32 0.001805662 0.2111650 0.3780568 90 0 0.2851118 38 0.001805662 0.2111650 0.3780568 71 0 0.2851118 42 0.001805662 0.2111650 0.3780568 6 0 CIF 2 P time var lower upper n.risk n.event 0.00000000 4 0.000000e+00 0.000000000 0.00000000 8 0 0.00000000 12 0.000000e+00 0.000000000 0.00000000 94 0 0.00000000 21 0.000000e+00 0.000000000 0.00000000 93 0 0.01541036 32 6.016217e-05 0.005730041 0.04110307 90 1 0.13034947 38 5.576254e-04 0.090999609 0.18489993 71 12 0.35256510 42 1.775693e-03 0.276882073 0.44177471 6 6 CIF 3 P time var lower upper n.risk n.event 0.0000000 4 0.000000000 0.0000000 0.0000000 8 0 0.3143493 12 0.002571501 0.2266494 0.4254211 94 1 0.3507019 21 0.002482739 0.2627692 0.4576195 93 0 0.3584918 32 0.002459261 0.2706266 0.4644770 90 0 0.3584918 38 0.002459261 0.2706266 0.4644770 71 0 0.3623231 42 0.002447617 0.2744987 0.4678544 6 0 > > all.equal(unname(trprob(cif.control, "0 3")), snetm[[1]][[3]]$P) [1] TRUE > all.equal(unname(trprob(cif.control, "0 2")), snetm[[1]][[2]]$P) [1] TRUE > all.equal(unname(trprob(cif.control, "0 1")), snetm[[1]][[1]]$P) [1] TRUE > > all.equal(unname(trprob(cif.exposed, "0 3")), snetm[[2]][[3]]$P) [1] TRUE > all.equal(unname(trprob(cif.exposed, "0 2")), snetm[[2]][[2]]$P) [1] TRUE > all.equal(unname(trprob(cif.exposed, "0 1")), snetm[[2]][[1]]$P) [1] TRUE > > scif.control <- summary(cif.control, ci.fun = "cloglog") > scif.exposed <- summary(cif.exposed, ci.fun = "cloglog") > > all.equal(scif.control[[3]]$lower, snetm[[1]][[3]]$lower) [1] TRUE > all.equal(scif.control[[3]]$upper, snetm[[1]][[3]]$upper) [1] TRUE > > all.equal(scif.exposed[[3]]$lower, snetm[[2]][[3]]$lower) [1] TRUE > all.equal(scif.exposed[[3]]$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.04015931 0.009257784 20 CIF life birth 43 0.79905931 0.022186468 924 CIF spontaneous abortion 43 0.16078139 0.021326113 69 group = 1 time P se(P) n.event CIF ETOP 42 0.2851118 0.04249308 38 CIF life birth 42 0.3525651 0.04213898 92 CIF spontaneous abortion 42 0.3623231 0.04947340 43 > > summary(netm.factor) group=0 CIF ETOP P time var lower upper n.risk n.event 0.00000000 4 0.000000e+00 0.00000000 0.00000000 18 0 0.03895488 13 8.444048e-05 0.02448808 0.06169378 645 1 0.04015931 23 8.570657e-05 0.02551262 0.06293875 819 0 0.04015931 33 8.570657e-05 0.02551262 0.06293875 885 0 0.04015931 39 8.570657e-05 0.02551262 0.06293875 716 0 0.04015931 43 8.570657e-05 0.02551262 0.06293875 6 0 CIF life birth P time var lower upper n.risk n.event 0.00000000 4 0.000000e+00 0.000000000 0.00000000 18 0 0.00000000 13 0.000000e+00 0.000000000 0.00000000 645 0 0.00000000 23 0.000000e+00 0.000000000 0.00000000 819 0 0.01354288 33 1.216141e-05 0.008169604 0.02241009 885 6 0.32201590 39 2.469805e-04 0.292313907 0.35391574 716 165 0.79905931 43 4.922394e-04 0.753968839 0.84061317 6 6 CIF spontaneous abortion P time var lower upper n.risk n.event 0.0000000 4 0.0000000000 0.0000000 0.0000000 18 0 0.1504675 13 0.0004551293 0.1135970 0.1979013 645 1 0.1570366 23 0.0004553237 0.1199469 0.2041947 819 0 0.1599039 33 0.0004549788 0.1227389 0.2069247 885 0 0.1607814 39 0.0004548031 0.1235965 0.2077571 716 0 0.1607814 43 0.0004548031 0.1235965 0.2077571 6 0 group=1 CIF ETOP P time var lower upper n.risk n.event 0.0000000 4 0.000000000 0.0000000 0.0000000 8 0 0.2604775 12 0.001785362 0.1879526 0.3542503 94 5 0.2811533 21 0.001802770 0.2074197 0.3742279 93 1 0.2851118 32 0.001805662 0.2111650 0.3780568 90 0 0.2851118 38 0.001805662 0.2111650 0.3780568 71 0 0.2851118 42 0.001805662 0.2111650 0.3780568 6 0 CIF life birth P time var lower upper n.risk n.event 0.00000000 4 0.000000e+00 0.000000000 0.00000000 8 0 0.00000000 12 0.000000e+00 0.000000000 0.00000000 94 0 0.00000000 21 0.000000e+00 0.000000000 0.00000000 93 0 0.01541036 32 6.016217e-05 0.005730041 0.04110307 90 1 0.13034947 38 5.576254e-04 0.090999609 0.18489993 71 12 0.35256510 42 1.775693e-03 0.276882073 0.44177471 6 6 CIF spontaneous abortion P time var lower upper n.risk n.event 0.0000000 4 0.000000000 0.0000000 0.0000000 8 0 0.3143493 12 0.002571501 0.2266494 0.4254211 94 1 0.3507019 21 0.002482739 0.2627692 0.4576195 93 0 0.3584918 32 0.002459261 0.2706266 0.4644770 90 0 0.3584918 38 0.002459261 0.2706266 0.4644770 71 0 0.3623231 42 0.002447617 0.2744987 0.4678544 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.04015931 0.009257784 20 CIF life birth 43 0.79905931 0.022186468 924 CIF spontaneous abortion 43 0.16078139 0.021326113 69 ttt = exposed time P se(P) n.event CIF ETOP 42 0.2851118 0.04249308 38 CIF life birth 42 0.3525651 0.04213898 92 CIF spontaneous abortion 42 0.3623231 0.04947340 43 > > summary(netm.ttt) ttt=control CIF ETOP P time var lower upper n.risk n.event 0.00000000 4 0.000000e+00 0.00000000 0.00000000 18 0 0.03895488 13 8.444048e-05 0.02448808 0.06169378 645 1 0.04015931 23 8.570657e-05 0.02551262 0.06293875 819 0 0.04015931 33 8.570657e-05 0.02551262 0.06293875 885 0 0.04015931 39 8.570657e-05 0.02551262 0.06293875 716 0 0.04015931 43 8.570657e-05 0.02551262 0.06293875 6 0 CIF life birth P time var lower upper n.risk n.event 0.00000000 4 0.000000e+00 0.000000000 0.00000000 18 0 0.00000000 13 0.000000e+00 0.000000000 0.00000000 645 0 0.00000000 23 0.000000e+00 0.000000000 0.00000000 819 0 0.01354288 33 1.216141e-05 0.008169604 0.02241009 885 6 0.32201590 39 2.469805e-04 0.292313907 0.35391574 716 165 0.79905931 43 4.922394e-04 0.753968839 0.84061317 6 6 CIF spontaneous abortion P time var lower upper n.risk n.event 0.0000000 4 0.0000000000 0.0000000 0.0000000 18 0 0.1504675 13 0.0004551293 0.1135970 0.1979013 645 1 0.1570366 23 0.0004553237 0.1199469 0.2041947 819 0 0.1599039 33 0.0004549788 0.1227389 0.2069247 885 0 0.1607814 39 0.0004548031 0.1235965 0.2077571 716 0 0.1607814 43 0.0004548031 0.1235965 0.2077571 6 0 ttt=exposed CIF ETOP P time var lower upper n.risk n.event 0.0000000 4 0.000000000 0.0000000 0.0000000 8 0 0.2604775 12 0.001785362 0.1879526 0.3542503 94 5 0.2811533 21 0.001802770 0.2074197 0.3742279 93 1 0.2851118 32 0.001805662 0.2111650 0.3780568 90 0 0.2851118 38 0.001805662 0.2111650 0.3780568 71 0 0.2851118 42 0.001805662 0.2111650 0.3780568 6 0 CIF life birth P time var lower upper n.risk n.event 0.00000000 4 0.000000e+00 0.000000000 0.00000000 8 0 0.00000000 12 0.000000e+00 0.000000000 0.00000000 94 0 0.00000000 21 0.000000e+00 0.000000000 0.00000000 93 0 0.01541036 32 6.016217e-05 0.005730041 0.04110307 90 1 0.13034947 38 5.576254e-04 0.090999609 0.18489993 71 12 0.35256510 42 1.775693e-03 0.276882073 0.44177471 6 6 CIF spontaneous abortion P time var lower upper n.risk n.event 0.0000000 4 0.000000000 0.0000000 0.0000000 8 0 0.3143493 12 0.002571501 0.2266494 0.4254211 94 1 0.3507019 21 0.002482739 0.2627692 0.4576195 93 0 0.3584918 32 0.002459261 0.2706266 0.4644770 90 0 0.3584918 38 0.002459261 0.2706266 0.4644770 71 0 0.3623231 42 0.002447617 0.2744987 0.4678544 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.929943 0.80910809 0.07968014 45 CIF 2 4.929943 0.09661788 0.03290520 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.920944 0.7024648 0.10579670 19 CIF 2 2.920944 0.1114404 0.05338408 4 cov = 1 time P se(P) n.event CIF 1 4.929943 0.80787111 0.09405073 26 CIF 2 4.929943 0.08436022 0.04076920 4 > > summary(test) CIF 1 P time var lower upper n.risk n.event 0.0100000 0.009209855 0.000099000 0.001414712 0.0688628 100 1 0.1142996 0.360023778 0.001054230 0.064945430 0.1969931 76 0 0.2479372 0.784047742 0.002149357 0.170109947 0.3530034 51 0 0.4405912 1.555114392 0.003517175 0.333817035 0.5642480 26 1 0.5734230 2.268295292 0.004274160 0.450541377 0.7024323 11 0 0.8091081 4.929943217 0.006348924 0.635954424 0.9337329 1 0 CIF 2 P time var lower upper n.risk n.event 0.00000000 0.009209855 0.0000000000 0.00000000 0.0000000 100 0 0.04246723 0.360023778 0.0004318927 0.01615074 0.1092171 76 0 0.06702937 0.784047742 0.0007036620 0.03059797 0.1435033 51 0 0.09661788 1.555114392 0.0010827519 0.04908158 0.1854738 26 0 0.09661788 2.268295292 0.0010827519 0.04908158 0.1854738 11 0 0.09661788 4.929943217 0.0010827519 0.04908158 0.1854738 1 0 > summary(test.c) cov=0 CIF 1 P time var lower upper n.risk n.event 0.02222222 0.009209855 0.0004828532 0.00316047 0.1474667 45 1 0.09222222 0.406113230 0.0019360322 0.03559707 0.2276215 34 0 0.22668442 0.784047742 0.0045095420 0.12417599 0.3925031 23 0 0.42066416 1.478827203 0.0082446289 0.26725155 0.6164448 12 1 0.60941744 1.939093010 0.0095747480 0.42743893 0.7950394 6 1 0.70246483 2.920943647 0.0111929419 0.49448899 0.8839905 1 0 CIF 2 P time var lower upper n.risk n.event 0.00000000 0.009209855 0.000000000 0.00000000 0.0000000 45 0 0.04844136 0.406113230 0.001116811 0.01233703 0.1801316 34 0 0.07641078 0.784047742 0.001810437 0.02520184 0.2192780 23 0 0.11144039 1.478827203 0.002849860 0.04267633 0.2739153 12 0 0.11144039 1.939093010 0.002849860 0.04267633 0.2739153 6 0 0.11144039 2.920943647 0.002849860 0.04267633 0.2739153 1 0 cov=1 CIF 1 P time var lower upper n.risk n.event 0.01818182 0.06669232 0.000324568 0.002581315 0.1221376 55 1 0.13171422 0.36002378 0.002156700 0.065024199 0.2567179 42 0 0.26514875 0.80139542 0.004072829 0.162479119 0.4145201 28 0 0.46217162 1.55511439 0.006255707 0.322729736 0.6273534 15 1 0.59233377 2.48978047 0.007759845 0.428622952 0.7627259 7 0 0.80787111 4.92994322 0.008845539 0.602318537 0.9477134 1 0 CIF 2 P time var lower upper n.risk n.event 0.00000000 0.06669232 0.0000000000 0.000000000 0.0000000 55 0 0.03743357 0.36002378 0.0006745784 0.009493953 0.1415172 42 0 0.05934134 0.80139542 0.0011129497 0.019446521 0.1735097 28 0 0.08436022 1.55511439 0.0016621276 0.032211300 0.2111908 15 0 0.08436022 2.48978047 0.0016621276 0.032211300 0.2111908 7 0 0.08436022 4.92994322 0.0016621276 0.032211300 0.2111908 1 0 > etm/tests/tests.etm.R0000644000176000001440000001330012441415014014273 0ustar ripleyusersrequire(etm) ### 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 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[[1]]$P, as.vector(trprob(prob.sir, "0 1"))) summ.sir[[2]] ## 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) etm/tests/test.etmCIF.R0000644000176000001440000001057511753444242014457 0ustar ripleyusers### test file for etmCIF. ### Really simple tests and comparison with etm require(etm) 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[[3]]$lower, snetm[[1]][[3]]$lower) all.equal(scif.control[[3]]$upper, snetm[[1]][[3]]$upper) all.equal(scif.exposed[[3]]$lower, snetm[[2]][[3]]$lower) all.equal(scif.exposed[[3]]$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) etm/tests/tests.etm.Rout.save0000644000176000001440000007266512441423352016007 0ustar ripleyusers R version 3.1.2 (2014-10-31) -- "Pumpkin Helmet" Copyright (C) 2014 The R Foundation for Statistical Computing Platform: x86_64-suse-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) Loading required package: etm Loading required package: survival Loading required package: splines > > ### 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 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 Estimate of cov(P(1, 183)) 0 0 1 0 2 0 0 1 1 1 2 1 0 2 1 2 2 2 0 0 0 0 0 0 0 0 0.000000e+00 0.000000e+00 0 1 0 0 0 0 0 0 0 0.000000e+00 0.000000e+00 0 2 0 0 0 0 0 0 0 0.000000e+00 0.000000e+00 0 0 1 0 0 0 0 0 0 0.000000e+00 0.000000e+00 0 1 1 0 0 0 0 0 0 0.000000e+00 0.000000e+00 0 2 1 0 0 0 0 0 0 0.000000e+00 0.000000e+00 0 0 2 0 0 0 0 0 0 -2.864030e-20 -1.126554e-19 0 1 2 0 0 0 0 0 0 -4.785736e-20 2.710505e-19 0 2 2 0 0 0 0 0 0 0.000000e+00 0.000000e+00 0 > > summ.sir <- summary(prob.sir) Warning messages: 1: In sqrt(var) : NaNs produced 2: In sqrt(var) : NaNs produced > all.equal(summ.sir[[1]]$P, as.vector(trprob(prob.sir, "0 1"))) [1] TRUE > summ.sir[[2]] P time var lower upper n.risk n.event 1.5 0.0000000 1.5 0.000000e+00 0.00000000 0.0000000 394 0 2 0.1186869 2.0 2.641422e-04 0.08683265 0.1505411 396 47 2.5 0.1186869 2.5 2.641422e-04 0.08683265 0.1505411 364 0 3 0.2453993 3.0 4.465256e-04 0.20398301 0.2868156 365 54 3.5 0.2453993 3.5 4.465256e-04 0.20398301 0.2868156 328 0 4 0.3806244 4.0 5.416492e-04 0.33500942 0.4262393 331 62 4.5 0.3806244 4.5 5.416492e-04 0.33500942 0.4262393 280 0 5 0.4792121 5.0 5.480328e-04 0.43332915 0.5250951 283 48 5.5 0.4792121 5.5 5.480328e-04 0.43332915 0.5250951 248 0 6 0.5692649 6.0 5.141238e-04 0.52482414 0.6137058 249 47 7 0.6349924 7.0 4.665144e-04 0.59265929 0.6773256 212 36 8 0.6794916 8.0 4.202391e-04 0.63931284 0.7196703 195 27 8.5 0.6794916 8.5 4.202391e-04 0.63931284 0.7196703 172 0 9 0.7324895 9.0 3.579860e-04 0.69540594 0.7695730 173 34 10 0.7646506 10.0 3.140867e-04 0.72991512 0.7993860 148 21 10.5 0.7646506 10.5 3.140867e-04 0.72991512 0.7993860 135 0 11 0.7894789 11.0 2.789769e-04 0.75674237 0.8222154 136 18 12 0.8137852 12.0 2.419720e-04 0.78329710 0.8442733 129 18 12.5 0.8137852 12.5 2.419720e-04 0.78329710 0.8442733 117 0 13 0.8293991 13.0 2.181963e-04 0.80044760 0.8583507 118 13 14 0.8451773 14.0 1.938437e-04 0.81788913 0.8724654 115 14 15 0.8624687 15.0 1.670243e-04 0.83713851 0.8877988 106 15 16 0.8722513 16.0 1.522153e-04 0.84807011 0.8964324 93 9 17 0.8851601 17.0 1.329865e-04 0.86255784 0.9077624 86 12 17.5 0.8851601 17.5 1.329865e-04 0.86255784 0.9077624 77 0 18 0.8960254 18.0 1.167891e-04 0.87484428 0.9172066 76 9 19 0.9028854 19.0 1.069942e-04 0.88261196 0.9231589 71 7 20 0.9125267 20.0 9.367135e-05 0.89355740 0.9314960 64 10 21 0.9161439 21.0 8.878103e-05 0.89767636 0.9346114 57 4 22 0.9225643 22.0 7.995614e-05 0.90503865 0.9400899 55 6 23 0.9260521 23.0 7.536948e-05 0.90903660 0.9430677 51 4 23.5 0.9260521 23.5 7.536948e-05 0.90903660 0.9430677 49 0 24 0.9353639 24.0 6.292082e-05 0.91981690 0.9509108 50 9 25 0.9385430 25.0 5.877878e-05 0.92351645 0.9535695 42 3 26 0.9429383 26.0 5.325890e-05 0.92863472 0.9572418 39 5 27 0.9476771 27.0 4.748795e-05 0.93417068 0.9611835 35 6 27.5 0.9476771 27.5 4.748795e-05 0.93417068 0.9611835 29 0 28 0.9531288 28.0 4.092631e-05 0.94059022 0.9656674 30 5 29 0.9567220 29.0 3.667615e-05 0.94485230 0.9685917 31 4 30 0.9591876 30.0 3.383912e-05 0.94778617 0.9705889 28 3 30.5 0.9591876 30.5 3.383912e-05 0.94778617 0.9705889 29 0 31 0.9642349 31.0 2.820676e-05 0.95382549 0.9746442 30 6 32 0.9648667 32.0 2.752066e-05 0.95458472 0.9751487 25 1 33 0.9669455 33.0 2.533123e-05 0.95708094 0.9768100 24 2 34 0.9685356 34.0 2.367984e-05 0.95899806 0.9780732 26 2 35 0.9696628 35.0 2.251767e-05 0.96036219 0.9789633 28 2 36 0.9702263 36.0 2.194423e-05 0.96104495 0.9794077 26 1 37 0.9717546 37.0 2.043249e-05 0.96289513 0.9806141 26 2 38 0.9739393 38.0 1.831026e-05 0.96555250 0.9823261 25 4 38.5 0.9739393 38.5 1.831026e-05 0.96555250 0.9823261 21 0 39 0.9759610 39.0 1.643312e-05 0.96801570 0.9839062 23 3 40 0.9769163 40.0 1.557773e-05 0.96918064 0.9846521 19 1 41 0.9774305 41.0 1.511599e-05 0.96981026 0.9850507 22 1 42 0.9778509 42.0 1.475784e-05 0.97032155 0.9853803 22 0 43 0.9798010 43.0 1.307925e-05 0.97271272 0.9868892 22 3 44 0.9803023 44.0 1.265491e-05 0.97333000 0.9872746 21 1 45 0.9816513 45.0 1.156647e-05 0.97498560 0.9883171 19 1 46 0.9821527 46.0 1.115820e-05 0.97560565 0.9886997 17 1 47 0.9831389 47.0 1.037038e-05 0.97682722 0.9894506 18 2 48 0.9836281 48.0 9.986572e-06 0.97743435 0.9898219 17 1 49 0.9840553 49.0 9.669176e-06 0.97796078 0.9901499 17 0 50 0.9845409 50.0 9.296786e-06 0.97856487 0.9905170 17 1 50.5 0.9845409 50.5 9.296786e-06 0.97856487 0.9905170 16 0 51 0.9859918 51.0 8.213748e-06 0.98037462 0.9916090 17 3 52 0.9869591 52.0 7.512700e-06 0.98158694 0.9923312 14 2 53 0.9878950 53.0 6.874544e-06 0.98275613 0.9930339 12 1 54 0.9888571 54.0 6.213830e-06 0.98397136 0.9937428 12 2 55 0.9903001 55.0 5.253896e-06 0.98580762 0.9947926 10 3 56 0.9912678 56.0 4.666932e-06 0.98703372 0.9955020 6 1 57 0.9917489 57.0 4.363513e-06 0.98765469 0.9958430 5 1 58 0.9922299 58.0 4.064246e-06 0.98827860 0.9961812 4 1 59 0.9927109 59.0 3.769130e-06 0.98890578 0.9965160 3 1 60 0.9931938 60.0 3.488235e-06 0.98953323 0.9968544 3 1 62 0.9936805 62.0 3.229764e-06 0.99015816 0.9972029 2 0 63 0.9941634 63.0 2.955869e-06 0.99079373 0.9975331 2 1 68 0.9941634 68.0 2.955869e-06 0.99079373 0.9975331 1 0 70 0.9946482 70.0 2.693997e-06 0.99143126 0.9978652 2 1 78 0.9951349 78.0 2.442281e-06 0.99207193 0.9981979 1 0 80 0.9951349 80.0 2.442281e-06 0.99207193 0.9981979 1 0 85 0.9965950 85.0 1.695084e-06 0.99404323 0.9991468 2 0 89 0.9965950 89.0 1.695084e-06 0.99404323 0.9991468 2 0 90 0.9965950 90.0 1.695084e-06 0.99404323 0.9991468 1 0 95 0.9970816 95.0 1.448382e-06 0.99472276 0.9994403 2 0 100 0.9975681 100.0 1.203159e-06 0.99541824 0.9997180 3 0 101 0.9980544 101.0 9.591818e-07 0.99613482 0.9999739 3 1 108 0.9985406 108.0 7.169274e-07 0.99688111 1.0000000 2 1 113 0.9990272 113.0 4.763877e-07 0.99767440 1.0000000 1 0 116 0.9990272 116.0 4.763877e-07 0.99767440 1.0000000 1 0 124 0.9990272 124.0 4.763877e-07 0.99767440 1.0000000 2 0 130 0.9990272 130.0 4.763877e-07 0.99767440 1.0000000 1 0 164 0.9990272 164.0 4.763877e-07 0.99767440 1.0000000 0 0 183 1.0000000 183.0 -2.864030e-20 NaN NaN 1 1 > > ## 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) Warning messages: 1: In sqrt(var) : NaNs produced 2: In sqrt(var) : NaNs produced > 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") 4 5 6 7 8 9 0.000000000 0.000000000 0.000000000 0.007400858 0.014880870 0.026509184 10 11 12 13 14 15 0.033207696 0.037694266 0.037694266 0.038954884 0.040159308 0.040159308 16 17 18 19 20 21 0.040159308 0.040159308 0.040159308 0.040159308 0.040159308 0.040159308 22 23 24 25 26 27 0.040159308 0.040159308 0.040159308 0.040159308 0.040159308 0.040159308 28 29 30 31 32 33 0.040159308 0.040159308 0.040159308 0.040159308 0.040159308 0.040159308 34 35 36 37 38 39 0.040159308 0.040159308 0.040159308 0.040159308 0.040159308 0.040159308 40 41 42 43 0.040159308 0.040159308 0.040159308 0.040159308 > trprob(cif.control, "0 2") 4 5 6 7 8 9 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 10 11 12 13 14 15 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 16 17 18 19 20 21 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 22 23 24 25 26 27 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 28 29 30 31 32 33 0.000000000 0.000000000 0.003656854 0.006371445 0.008175002 0.013542879 34 35 36 37 38 39 0.023317266 0.031259966 0.053197090 0.084528525 0.179162614 0.322015902 40 41 42 43 0.563120872 0.742227421 0.793892771 0.799059306 > trprob(cif.control, "0 0") 4 5 6 7 8 9 1.000000000 1.000000000 0.965811966 0.932508105 0.887628036 0.862433353 10 11 12 13 14 15 0.838988563 0.822537807 0.813098849 0.810577612 0.806964339 0.806964339 16 17 18 19 20 21 0.806964339 0.805873846 0.805873846 0.803810149 0.803810149 0.802804129 22 23 24 25 26 27 0.802804129 0.802804129 0.801836895 0.800883462 0.799936791 0.799936791 28 29 30 31 32 33 0.799936791 0.799936791 0.796279938 0.793565347 0.791761789 0.786393913 34 35 36 37 38 39 0.776619525 0.768676825 0.745862216 0.714530781 0.619896693 0.477043404 40 41 42 43 0.235938435 0.056831886 0.005166535 0.000000000 > > trcov(cif.control, "0 1") 4 5 6 7 8 9 0.000000e+00 0.000000e+00 0.000000e+00 2.719306e-05 4.532753e-05 6.665019e-05 10 11 12 13 14 15 7.698480e-05 8.304209e-05 8.304209e-05 8.444048e-05 8.570657e-05 8.570657e-05 16 17 18 19 20 21 8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05 22 23 24 25 26 27 8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05 28 29 30 31 32 33 8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05 34 35 36 37 38 39 8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05 40 41 42 43 8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05 > trcov(cif.control, "0 2") 4 5 6 7 8 9 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 10 11 12 13 14 15 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 16 17 18 19 20 21 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 22 23 24 25 26 27 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 28 29 30 31 32 33 0.000000e+00 0.000000e+00 3.338155e-06 5.784419e-06 7.401205e-06 1.216141e-05 34 35 36 37 38 39 2.071916e-05 2.757764e-05 4.619460e-05 7.202415e-05 1.460900e-04 2.469805e-04 40 41 42 43 3.880102e-04 4.701879e-04 4.903148e-04 4.922394e-04 > trcov(cif.control, "0 0") 4 5 6 7 8 9 0.000000e+00 0.000000e+00 2.822155e-04 3.820769e-04 4.527000e-04 4.748082e-04 10 11 12 13 14 15 4.875383e-04 4.927267e-04 4.940647e-04 4.941740e-04 4.941106e-04 4.941106e-04 16 17 18 19 20 21 4.941106e-04 4.939636e-04 4.939636e-04 4.935609e-04 4.935609e-04 4.933371e-04 22 23 24 25 26 27 4.933371e-04 4.933371e-04 4.930834e-04 4.928195e-04 4.925502e-04 4.925502e-04 28 29 30 31 32 33 4.925502e-04 4.925502e-04 4.913851e-04 4.904884e-04 4.898842e-04 4.880340e-04 34 35 36 37 38 39 4.845548e-04 4.816321e-04 4.728916e-04 4.601194e-04 4.175917e-04 3.424805e-04 40 41 42 43 1.864578e-04 4.796800e-05 4.440837e-06 0.000000e+00 > > aa <- summary(cif.control) > aa$"0 1" P time var lower upper n.risk n.event 4 0.000000000 4 0.000000e+00 0.00000000 0.00000000 18 0 5 0.000000000 5 0.000000e+00 0.00000000 0.00000000 18 0 6 0.000000000 6 0.000000e+00 0.00000000 0.00000000 117 0 7 0.007400858 7 2.719306e-05 0.00000000 0.01762148 261 2 8 0.014880870 8 4.532753e-05 0.00168527 0.02807647 374 3 9 0.026509184 9 6.665019e-05 0.01050812 0.04251025 458 6 10 0.033207696 10 7.698480e-05 0.01601078 0.05040461 515 4 11 0.037694266 11 8.304209e-05 0.01983362 0.05555491 561 3 12 0.037694266 12 8.304209e-05 0.01983362 0.05555491 610 0 13 0.038954884 13 8.444048e-05 0.02094448 0.05696529 645 1 14 0.040159308 14 8.570657e-05 0.02201438 0.05830423 673 1 15 0.040159308 15 8.570657e-05 0.02201438 0.05830423 696 0 16 0.040159308 16 8.570657e-05 0.02201438 0.05830423 714 0 17 0.040159308 17 8.570657e-05 0.02201438 0.05830423 740 0 18 0.040159308 18 8.570657e-05 0.02201438 0.05830423 759 0 19 0.040159308 19 8.570657e-05 0.02201438 0.05830423 781 0 20 0.040159308 20 8.570657e-05 0.02201438 0.05830423 786 0 21 0.040159308 21 8.570657e-05 0.02201438 0.05830423 799 0 22 0.040159308 22 8.570657e-05 0.02201438 0.05830423 810 0 23 0.040159308 23 8.570657e-05 0.02201438 0.05830423 819 0 24 0.040159308 24 8.570657e-05 0.02201438 0.05830423 830 0 25 0.040159308 25 8.570657e-05 0.02201438 0.05830423 841 0 26 0.040159308 26 8.570657e-05 0.02201438 0.05830423 846 0 27 0.040159308 27 8.570657e-05 0.02201438 0.05830423 853 0 28 0.040159308 28 8.570657e-05 0.02201438 0.05830423 860 0 29 0.040159308 29 8.570657e-05 0.02201438 0.05830423 870 0 30 0.040159308 30 8.570657e-05 0.02201438 0.05830423 875 0 31 0.040159308 31 8.570657e-05 0.02201438 0.05830423 880 0 32 0.040159308 32 8.570657e-05 0.02201438 0.05830423 880 0 33 0.040159308 33 8.570657e-05 0.02201438 0.05830423 885 0 34 0.040159308 34 8.570657e-05 0.02201438 0.05830423 885 0 35 0.040159308 35 8.570657e-05 0.02201438 0.05830423 880 0 36 0.040159308 36 8.570657e-05 0.02201438 0.05830423 876 0 37 0.040159308 37 8.570657e-05 0.02201438 0.05830423 857 0 38 0.040159308 38 8.570657e-05 0.02201438 0.05830423 823 0 39 0.040159308 39 8.570657e-05 0.02201438 0.05830423 716 0 40 0.040159308 40 8.570657e-05 0.02201438 0.05830423 554 0 41 0.040159308 41 8.570657e-05 0.02201438 0.05830423 274 0 42 0.040159308 42 8.570657e-05 0.02201438 0.05830423 66 0 43 0.040159308 43 8.570657e-05 0.02201438 0.05830423 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.7473545 0.2526455 1 0 0 0.7072985 0.2927015 2 0 0 1.0000000 0.0000000 3 0 0 0.0000000 1.0000000 Estimate of cov(P(0, 82)) 0 0 1 0 2 0 3 0 0 1 1 1 2 1 3 1 0 2 1 2 2 2 3 2 0 0 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0 1 0 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0 2 0 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0 3 0 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0 0 1 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0 1 1 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0 2 1 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0 3 1 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0 0 2 0 0 0 0 0 0 0 0 0.0002497563 0.0002738457 0 0 1 2 0 0 0 0 0 0 0 0 0.0002738457 0.0019836077 0 0 2 2 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0 3 2 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0 0 3 0 0 0 0 0 0 0 0 -0.0002497563 -0.0002738457 0 0 1 3 0 0 0 0 0 0 0 0 -0.0002738457 -0.0019836077 0 0 2 3 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0 3 3 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0 0 3 1 3 2 3 3 3 0 0 0.0000000000 0.0000000000 0 0 1 0 0.0000000000 0.0000000000 0 0 2 0 0.0000000000 0.0000000000 0 0 3 0 0.0000000000 0.0000000000 0 0 0 1 0.0000000000 0.0000000000 0 0 1 1 0.0000000000 0.0000000000 0 0 2 1 0.0000000000 0.0000000000 0 0 3 1 0.0000000000 0.0000000000 0 0 0 2 -0.0002497563 -0.0002738457 0 0 1 2 -0.0002738457 -0.0019836077 0 0 2 2 0.0000000000 0.0000000000 0 0 3 2 0.0000000000 0.0000000000 0 0 0 3 0.0002497563 0.0002738457 0 0 1 3 0.0002738457 0.0019836077 0 0 2 3 0.0000000000 0.0000000000 0 0 3 3 0.0000000000 0.0000000000 0 0 > summary(tr.prob) Transition 0 1 P time var lower upper n.risk n.event 0.017195767 3 2.235459e-05 0.0079289311 0.02646260 756 13 0.063492063 15 7.865188e-05 0.0461099474 0.08087418 90 0 0.030423280 27 3.901813e-05 0.0181804650 0.04266610 26 1 0.015873016 41 2.066278e-05 0.0069637383 0.02478229 5 0 0.005291005 61 6.961654e-06 0.0001196507 0.01046236 3 0 0.000000000 82 0.000000e+00 0.0000000000 0.00000000 1 0 Transition 0 2 P time var lower upper n.risk n.event 0.08465608 3 0.0001024992 0.06481303 0.1044991 756 64 0.62301587 15 0.0003106708 0.58846983 0.6575619 90 4 0.69841270 27 0.0002786143 0.66569748 0.7311279 26 1 0.72751323 41 0.0002622192 0.69577517 0.7592513 5 0 0.74074074 61 0.0002540263 0.70950244 0.7719790 3 1 0.74735450 82 0.0002497563 0.71637985 0.7783291 1 1 Transition 0 3 P time var lower upper n.risk n.event 0.01587302 3 2.066278e-05 0.006963738 0.02478229 756 12 0.20105820 15 2.124786e-04 0.172488502 0.22962790 90 1 0.23941799 27 2.408691e-04 0.208999432 0.26983655 26 0 0.25000000 41 2.480159e-04 0.219133469 0.28086653 5 0 0.25132275 61 2.488884e-04 0.220401973 0.28224353 3 0 0.25264550 82 2.497563e-04 0.221670860 0.28362015 1 0 Transition 1 2 P time var lower upper n.risk n.event 0.0000000 3 0.000000000 0.0000000 0.0000000 0 0 0.4106972 15 0.002589866 0.3109532 0.5104412 51 2 0.6081627 27 0.002253890 0.5151131 0.7012123 23 1 0.6651925 41 0.002064292 0.5761426 0.7542425 14 2 0.6919872 61 0.002000374 0.6043268 0.7796477 4 0 0.7072985 82 0.001983608 0.6200062 0.7945908 0 0 Transition 1 3 P time var lower upper n.risk n.event 0.0000000 3 0.000000000 0.0000000 0.0000000 0 0 0.2026916 15 0.001784251 0.1199019 0.2854812 51 1 0.2706490 27 0.001967639 0.1837087 0.3575892 23 0 0.2888737 41 0.001981661 0.2016242 0.3761232 14 0 0.2927015 61 0.001983608 0.2054092 0.3799938 4 0 0.2927015 82 0.001983608 0.2054092 0.3799938 0 0 Transition 0 0 P time var lower upper n.risk n.event 0.882275132 3 1.373885e-04 0.859301836 0.905248429 756 0 0.112433862 15 1.320006e-04 0.089915535 0.134952189 90 0 0.031746032 27 4.065902e-05 0.019248434 0.044243630 26 0 0.006613757 41 8.690496e-06 0.000835852 0.012391661 5 0 0.002645503 61 3.490085e-06 0.000000000 0.006307062 3 0 0.000000000 82 0.000000e+00 0.000000000 0.000000000 1 0 Transition 1 1 P time var lower upper n.risk n.event 1.00000000 3 0.000000e+00 1.00000000 1.00000000 0 0 0.38661119 15 2.358121e-03 0.29143438 0.48178801 51 0 0.12118830 27 7.841875e-04 0.06630275 0.17607386 23 0 0.04593378 41 2.404897e-04 0.01553918 0.07632837 14 0 0.01531126 61 6.579352e-05 0.00000000 0.03120916 4 0 0.00000000 82 0.000000e+00 0.00000000 0.00000000 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.968323 > > ### 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 > > proc.time() user system elapsed 9.036 0.031 9.055 etm/src/0000755000176000001440000000000012441572507011665 5ustar ripleyusersetm/src/matrix.cc0000644000176000001440000002125312441572510013475 0ustar ripleyusers#include "matrix.h" /* Vector class definitions */ Vector::Vector():dVector(){ } Vector::Vector(const int n):dVector(n){ } Vector::Vector(double* v, const int n):dVector(){ for(int i=0;i 0 ) s << "("; // for(int i=0;isize() != v.size()) { // cout << "VECTOR Error: You're trying to add vectors of different sizes\n"; // cout << v << endl;; // cout << *this << endl; return Vector(); } Vector sum(this->size()); for(i=0;isize();i++) sum[i] = this->at(i)+v[i]; return sum; } Vector Vector::operator -(const Vector& v) { int i; if( this->size() != v.size()) { // cout << "VECTOR Error: You're trying to subtract vectors of different sizes\n"; // cout << v << endl;; // cout << *this << endl; return Vector(); } Vector sum(this->size()); for(i=0;isize();i++) sum[i] = this->at(i)-v[i]; return sum; } Vector Vector::operator*(const Vector& v) { int i; if( this->size() != v.size()) { // cout << "VECTOR Error: You're trying to multiply vectors of different sizes\n"; // cout << v << endl;; // cout << *this << endl; return Vector(); } Vector p(this->size()); for(i=0;isize();i++) p[i] = this->at(i)*v[i]; return p; } double scalar(const Vector& v1, const Vector& v2) { int i; double p = 0.0; if( v1.size() != v2.size()) { // cout << "VECTOR Error: You're trying to multiply vectors of different sizes\n"; // cout << v1 << endl;; // cout << v2 << endl; return p; } for(i=0;iat(0); for(int i=1;isize();i++) if(this->at(i) > max) max=this->at(i); return max; } double Vector::min(void)const { double min=this->at(0); for(int i=1;isize();i++) if(this->at(i) < min) min=this->at(i); return min; } double Vector::mean()const { double sum=0; for(int i=0;isize();i++) sum += this->at(i); return sum/(this->size()); } void Vector::zero(void) { for(int i=0;isize();i++) this->at(i)=0.0; return; } double Vector::norm(void) const { double s=0.0; for(int i=0;isize();i++) s+= this->at(i)*this->at(i); return sqrt(s); } Vector Vector::diff() const { int len = this->size(); if( len > 1 ) { Vector v(len-1); for(int i=0; i < (len - 1); i++){ v[i] = this->at(i+1) - this->at(i); } return v; } return Vector(); } void Vector::as_double(double* a) { for( int i=0; isize(); i++ ) { a[i] = this->at(i); } } /* Matrix class definitions */ Matrix::Matrix():dMatrix(){ } Matrix::Matrix(const int n):dMatrix(n){ } Matrix::Matrix(const int r,const int c) { Vector v(c); for(int i=0;isize() == 0 || m.size() == 0 ) return Matrix(); int rows = this->size(); int cols = (this->at(0)).size(); int m_rows = m.size(); int m_cols = (m.at(0)).size(); if(cols != m_rows) { // cout << "MATRIX Error: Matrix Matrix::operator*(const Matrix& m):" << endl; // cout << "matrices are the wrong size: " << cols << ", " << m_rows << endl; return Matrix(); } Matrix ans(rows,m_cols); for(int i=0;iat(i)).at(k)*m[k][j]; } } } return ans; } Vector Matrix::operator*(const Vector& v) { if(this->size() == 0 || v.size() == 0 ) return Vector(); int rows = this->size(); int cols = (this->at(0)).size(); if(cols != v.size()) { // cout << "MATRIX Error: multiplying matrix times Vector with wrong sizes\n"; return Vector(); } Vector ans(rows); for(int i=0;iat(i)).at(j)*v[j]; } return ans; } Matrix operator*(const double x, const Matrix& m) { if( m.size() == 0 ) return Matrix(); int m_rows = m.size(); int m_cols = (m.at(0)).size(); Matrix a(m_rows,m_cols); for(int i=0; isize() == 0 || m.size() == 0 ) return Matrix(); int rows = this->size(); int cols = (this->at(0)).size(); int m_rows = m.size(); int m_cols = (m.at(0)).size(); if(rows!= m_rows || cols != m_cols) { // cout << "MATRIX Error: you're trying to add matrices of different sizes\n"; return Matrix(); } Matrix ans(m_rows, m_cols); for(int i=0;iat(i)).at(j) + m[i][j]; } } return ans; } Matrix Matrix::operator-(const Matrix& m) { if(this->size() == 0 || m.size() == 0 ) return Matrix(); int rows = this->size(); int cols = (this->at(0)).size(); int m_rows = m.size(); int m_cols = (m.at(0)).size(); if(rows!= m_rows || cols != m_cols) { // cout << "MATRIX Error: you're trying to add matrices of different sizes\n"; return Matrix(); } Matrix ans(m_rows, m_cols); for(int i=0;iat(i)).at(j) - m[i][j]; } } return ans; } void Matrix::zero(void) { if(this->size() == 0 ) return; int rows = this->size(); int cols = (this->at(0)).size(); for(int i=0;iat(i)).at(j)=0.0; } } return; } void Matrix::identity(void) { if(this->size() == 0 ) return; int rows = this->size(); int cols = (this->at(0)).size(); if(rows!=cols) { // cout << "MATRIX Error: Matrix::identity(): Matrix not square\n"; } zero(); for(int i=0;iat(i)).at(i)=1.0; return; } void Matrix::as_double(double* a) { int rows = this->size(); for( int i=0; iat(i)).size(); for( int j=0; jat(i)).at(j); } } } /* Array class definitions */ Array::Array():dArray(){ } Array::Array(const int len):dArray(len){ } Array::Array(const int rows, const int cols, const int len) { Matrix m(rows, cols); for(int i=0;isize(); for( int k=0; kat(k)).size(); for( int i=0; iat(k)).at(i)).size(); for( int j=0; jat(k)).at(i)).at(j); } } } } Array operator*(const Matrix& m, const Array& a) { int len = a.size(); Array aj; for( int k=0; k void risk_set_etm(int *n, int *lt, int *dim_nev, double *times, int *from, int *to, double *entry, double *exit, int *nrisk, int *ncens, int *nev, double *dna) { const int ltimes = *lt; const int dim_trans = dim_nev[1]; const int nb = *n; int i, j, t; /* Computation of the risk set and transition matrix */ for (j=0; j < nb; ++j) { for (i=0; i < ltimes; ++i) { if (entry[j] < times[i] && exit[j] >= times[i]) { nrisk[i + *lt * (from[j] - 1)] += 1; } if (exit[j] == times[i] && to[j] != 0) { nev[dim_nev[1] * dim_nev[1]*i + from[j] - 1 + dim_nev[1] * (to[j] - 1)] += 1; break; } } } for (i = 0; i < dim_trans; ++i) { nrisk[i * (*lt)] = nrisk[i * (*lt) + 1]; } /* Nelson-Aalen increments */ for (t = 0; t < ltimes; ++t) { for (j = 0; j < dim_trans; ++j) { for (i = 0; i < dim_trans; ++i) { if (nrisk[i * (*lt) + t] != 0) { dna[dim_nev[1] * dim_nev[1] * t + j * dim_nev[1] + i] = (double) nev[dim_nev[1] * dim_nev[1] * t + j * dim_nev[1]+i] / (double) nrisk[i*(*lt)+t]; } } } } } etm/src/los_etm.cc0000644000176000001440000000747612441572510013646 0ustar ripleyusers#include "matrix.h" extern "C" { void los_cp (double* times, // transition times double* ma, // transition matrices int* len, // number of transitions int* rows, // row number of transition matrice int* cols, // colum nnumber of transition matrice double* los1, // LOS given state 1 double* los0, // LOS given state 0 double* phi2case, double* phi2control, double* phi3case, double* phi3control, double* tau ) { Vector Times(times,*len); Array Ma(ma,*rows,*cols,*len ); Vector Los1(los1, *len); Los1[*len] = *tau; Vector Los0(los0,*len); Los0[*len] = *tau; Vector Phi2case(phi2case,*len); Vector Phi2control(phi2control,*len); Vector Phi3case(phi3case,*len); Vector Phi3control(phi3control,*len); Matrix Diag(*rows, *cols); Diag.identity(); Array A; A.push_back(Diag); Array A2; A2.push_back(Diag); Vector T; T.push_back(*tau); Vector T2; for(int i = (Times.size() - 2); i >= 0; --i) { itVector vpos = T.begin(); T.insert(vpos, Times[i+1]); itVector vpos2 = T2.begin(); T2.insert(vpos2, Times[i+1]); Vector Diff = T.diff(); A = Ma[i+1]*A; Vector a11; Vector a00; Vector a01; for(int j = 0; j < A.size(); ++j) { a11.push_back( A[j][1][1] ); a00.push_back( A[j][0][0] ); a01.push_back( A[j][0][1] ); } Los1[i] = Times[i+1] + scalar(Diff, a11); Los0[i] = Times[i+1] + scalar(Diff, (a00 + a01)); if( i == (Times.size() - 2)) { Phi2case[i] = Times[(Times.size()-1)] * A[(A.size()-1)][1][2]; Phi3case[i] = Times[(Times.size()-1)] * A[(A.size()-1)][1][3]; } else { Vector Diff2 = T2.diff(); //cout << Diff2 << endl; A2 = Ma[i+1]*A2; Vector a12; Vector a13; for(int l = 0; l < A2.size(); ++l) { a12.push_back( A2[l][1][2] ); a13.push_back( A2[l][1][3] ); } Phi2case[i] = (Times[(Times.size()-1)] * A[(A.size()-1)][1][2]) - scalar(Diff2, a12); Phi3case[i] = (Times[(Times.size()-1)] * A[(A.size()-1)][1][3]) - scalar(Diff2, a13); // stack identity matrix on top for the next loop itArray apos2 = A2.begin(); A2.insert(apos2, Diag); } Phi2control[i] = A[(A.size()-1)][1][2] * Los0[i]; Phi3control[i] = A[(A.size()-1)][1][3] * Los0[i]; // stack identity matrix on top for the next loop itArray apos = A.begin(); A.insert(apos, Diag); } Los1.as_double(los1); Los0.as_double(los0); Phi2case.as_double(phi2case); Phi2control.as_double(phi2control); Phi3case.as_double(phi3case); Phi3control.as_double(phi3control); } } /* To be called when there's no competing risks */ extern "C" { void los_nocp(double *times, double *ma, int *len, int *rows, int *cols, double *los1, double *los0, double *tau) { Vector Times(times,*len); Array Ma(ma,*rows,*cols,*len ); Vector Los1(los1, *len); Los1[*len] = *tau; Vector Los0(los0,*len); Los0[*len] = *tau; Matrix Diag(*rows, *cols); Diag.identity(); Array A; A.push_back(Diag); Vector T; T.push_back(*tau); for(int i = (Times.size() - 2); i >= 0; --i) { itVector vpos = T.begin(); T.insert(vpos, Times[i+1]); Vector Diff = T.diff(); A = Ma[i+1]*A; Vector a11; Vector a00; Vector a01; for(int j = 0; j < A.size(); ++j) { a11.push_back( A[j][1][1] ); a00.push_back( A[j][0][0] ); a01.push_back( A[j][0][1] ); } Los1[i] = Times[i+1] + scalar(Diff, a11); Los0[i] = Times[i+1] + scalar(Diff, (a00 + a01)); // stack identity matrix on top for the next loop itArray apos = A.begin(); A.insert(apos, Diag); } Los1.as_double(los1); Los0.as_double(los0); } } etm/src/cov_dna.c0000644000176000001440000000361712441572510013443 0ustar ripleyusers#include #include #include void cov_dna(double *nrisk, double *nev, int *dd, double *cov) { const int d = *dd; const int D = pow(d, 2); double temp_cov[D][D]; double t_cov[D*D]; double sum_nev[d]; int a, b, i, j, k, l, e, f; double nr = 0; double temp[d][d]; /* Initialisation */ for (a = 0; a < d; ++a) { sum_nev[a] = 0; for (b = 0; b < d; ++b) { temp[a][b] = 0.0; } } for (a = 0; a < D; ++a) { for (b = 0; b < D; ++b) { temp_cov[a][b] = 0.0; t_cov[a + D*b] = 0.0; } } for (a = 0; a < d; ++a) { for (b = 0; b < d; ++b) { sum_nev[a] += nev[a + d * b]; } } /******************/ /* loops on the blocks */ for (i = 0; i < d; ++i) { for (j = 0; j < d; ++j) { /* loops in the blocks */ for (k = 0; k < d; ++k) { for (l = 0; l < d; ++l) { if (nrisk[k] != 0) { nr = pow(nrisk[k], 3); if (k == l) { if (k == i) { if (l == j) { temp[k][l] = ((nrisk[k] - sum_nev[k]) * sum_nev[k]) / nr; } else { temp[k][l] = -(((nrisk[k] - sum_nev[k]) * nev[k + j * d]) / nr); } } else { if (i != k && j != k) { if (i == j) { temp[k][l] = ((nrisk[k] - nev[k + i*d]) * nev[k + i*d])/ nr; } else { temp[k][l] = (-nev[k + i*d] * nev[k + j*d]) / nr; } } } } } temp_cov[i * d + k][j * d + l] = temp[k][l]; for (e = 0; e < d; ++e) { for (f = 0; f < d; ++f) { temp[e][f] = 0.0; } } } } } } for (i = 0; i < D; ++i) { for (j = 0; j < D; ++j) { t_cov[i + j*D] = temp_cov[i][j]; } } for (i = 0; i < D; ++i) { for (j = 0; j < D; ++j) { if (t_cov[j * D + i] != 0.0) { cov[j * D + i] = t_cov[j * D + i]; cov[i * D + j] = t_cov[j * D + i]; t_cov[j * D + i] = cov[j * D + i]; } } } } etm/src/matrix.h0000644000176000001440000000420612441572510013336 0ustar ripleyusers#ifndef MATRIX #define MATRIX /* #include */ #include #include using namespace std; class Vector; class Matrix; typedef vector< double, allocator > dVector; // vector of doubles (double vectorx) typedef dVector::iterator itVector; typedef vector dMatrix; // vector of double vectors (double Matrix) typedef dMatrix::iterator itMatrix; typedef vector dArray; // vector of double matrices (Array of double matrices) typedef dArray::iterator itArray; class Vector : public dVector { public: Vector(); Vector(const int n); Vector(double* v, const int n); // friend ostream& operator <<(ostream& s, const Vector& v); Vector operator +(const Vector& v); Vector operator -(const Vector& v); friend Vector operator*(double x, const Vector& v); friend Vector operator*(const Vector& v, double x); Vector operator*(const Vector& v); friend double scalar(const Vector& v1, const Vector& v2); double max()const; double min()const; double mean()const; void zero(void); double norm(void)const; Vector diff() const; void as_double(double* a); }; class Matrix: public dMatrix { public: //constructor Matrix(); Matrix(const int n); Matrix(const int r,const int c); Matrix(double* m, const int r,const int c); /* friend ostream& operator<<(ostream& s, const Matrix& m); */ Matrix operator*(const Matrix& m); Vector operator*(const Vector& v); friend Matrix operator*(const double, const Matrix& m); friend Matrix operator*(const Matrix& m, const double); Matrix operator+(const Matrix& m); Matrix operator-(const Matrix& m); void zero(void); void identity(void); void as_double(double* a); }; class Array : public dArray { public: Array(); Array(const int l); Array(const int r,const int c, const int l); Array(double*a, const int r, const int c, const int l); friend Array operator*(const Matrix& m, const Array& a); friend Array operator*(const Array& a, const Matrix& m); /* friend ostream& operator<<(ostream& s,Array a); */ void as_double(double* a); }; #endif etm/NAMESPACE0000644000176000001440000000120012441413503012274 0ustar ripleyusersimport(lattice, survival, parallel) export(etm, summary.etm, clos, trcov, trprob, ggtransfo, etmprep, etmCIF, summary.etmCIF, closPseudo, phiPseudo, tra_ill, tra_ill_comp, tra_comp, tra_surv, prepare.los.data) S3method(xyplot, etm) S3method(print, etm) S3method(summary, etm) S3method(print, summary.etm) S3method(plot, etm) S3method(lines, etm) S3method(print, clos.etm) S3method(plot, clos.etm) S3method(trprob, etm) S3method(trcov, etm) S3method(print, etmCIF) S3method(plot, etmCIF) S3method(summary, etmCIF) S3method(print, summary.etmCIF) S3method(ggtransfo, etm) useDynLib(etm, risk_set_etm, cov_dna, los_cp, los_nocp) etm/data/0000755000176000001440000000000012441572510012001 5ustar ripleyusersetm/data/abortion.txt.gz0000644000176000001440000001100412441572510014772 0ustar ripleyusersU[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.gz0000644000176000001440000002456112441572510014730 0ustar ripleyusers}]%{@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;`[kc!^=ڦ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/data/los.data.csv.gz0000644000176000001440000000616512441572510014652 0ustar ripleyusersuK. 罌$R^A $"wX*~vשDqHJ~O[*_Ww[)ufyi^.[I("qhe[ `P=o-0Z{Bdo#F :Q^B~S_WɞZos/Ou{&- a@{_zv*<-tu=Ztu`Pa&==5o>T=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/R/0000755000176000001440000000000012441572507011277 5ustar ripleyusersetm/R/ci.transfo.R0000644000176000001440000000470111753444243013472 0ustar ripleyuserssans.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) } 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) } ci.transfo <- function(object, tr.choice, level = 0.95, transfo = "linear") { if (!inherits(object, "etm")) { stop ("'x' must be of class 'etm'") } 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/plot.etmCIF.R0000644000176000001440000001055311753444243013512 0ustar ripleyusersplot.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) 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/plot.etm.R0000644000176000001440000000552411753444243013172 0ustar ripleyusersplot.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") 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)) 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") 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) } plot(xlim, ylim, xlab = xlab, ylab = ylab, xlim = xlim, ylim = ylim, type = "n", ...) 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], ...) } } if (legend) { if (missing(legend.pos)) legend.pos <- "topleft" if (missing(curvlab)) 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/ggtransfo.etm.R0000644000176000001440000000161512441412210014163 0ustar ripleyusers### Function to transform a etm object into something usable for ggplot ### ### Arthur Allignol 0) stop("Argument 'tr.choice' and possible transitions must match") 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/etm.R0000644000176000001440000003062512441412210012175 0ustar ripleyusersprodint <- 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) } ################################################# ### Variance Lai and Ying for competing risks ### ################################################# var.ly <- function(est, state.names, nrisk, nev, times, first, last, indi) { if (first >= last) { return(NULL) } else { nCompRisks <- length(state.names) - 1 ## prepare what we need cif <- n.event <- matrix(nrow = last - first + 1, ncol = nCompRisks) nev <- nev[, , first:last] nrisk <- nrisk[first:last, ] time <- times[first:last] lt <- length(time) for (i in seq_len(last - first + 1)) { cif[i, ] <- est[1, 2:(nCompRisks + 1), i] n.event[i, ] <- nev[1, 2:(nCompRisks + 1), i] } sminus <- c(1, est[1, 1, 1:(last - first)]) S <- est[1, 1, ] ## create the matrix of covariances out <- array(0, dim = c((nCompRisks + 1)^2, (nCompRisks + 1)^2, (last-first+1))) ## get the indices on where to put the variance pos <- sapply(1:length(state.names), function(i) { paste(state.names, state.names[i]) }) pos <- matrix(pos) dimnames(out) <- list(pos, pos, time) pos.cp <- sapply(seq_along(state.names), function(i) paste(state.names[1], state.names[i], sep = " "))[-1] ind.cp <- which(pos %in% pos.cp, arr.ind = TRUE) ## the real shebang for (i in seq_along(ind.cp)) { for (j in seq_len(lt)) { f <- cif[1:j, i] s <- sminus[1:j] spasminus <- S[1:j] y <- nrisk[1:j, 1] dn <- rowSums(array(n.event[1:j, ], dim = c(j, nCompRisks))) dnt <- n.event[1:j, i] indi.loop <- indi[1:j] ## from biomJ paper eq. (6) vly <- sum(((f[j] - f)^2 / (y - dn)) * (dn/y) * indi.loop + s^2/y^3 * (y - dnt - 2 * (y - dn) * ((f[j] - f)/spasminus)) * dnt * indi.loop) out[ind.cp[i], ind.cp[i], j] <- vly } } } return(out) } #################################### ### Variance of the AJ estimator ### #################################### var.aj <- function(est, dna, nrisk, nev, times, first, last) { d <- dim(nev)[1] if (first >= last) { return(NULL) } else { out <- array(0, dim=c(dim(dna)[c(1, 2)]^2, (last-first+1))) cov.dna <- matrix(.C(cov_dna, as.double(nrisk[first, ]), as.double(nev[, , first]), as.integer(d), cov = double(d^2 * d^2) )$cov, d^2, d^2) bI <- diag(1, d^2) out[, , 1] <- bI %*% cov.dna %*% bI Id <- diag(1, d) for (i in 1:length(times[(first + 1):last])) { step <- first + i cov.dna <- matrix(.C(cov_dna, as.double(nrisk[step, ]), as.double(nev[, , step]), as.integer(d), cov = double(d^2 * d^2) )$cov, d^2, d^2) out[, , i + 1] <- (t(Id + dna[, , step]) %x% Id) %*% out[, , i] %*% ((Id + dna[, , step]) %x% Id) + (Id %x% est[, , i]) %*% cov.dna %*% (Id %x% t(est[, , i])) } } return(out) } ########### ### etm ### ########### etm <- function(data, state.names, tra, cens.name, s, t="last", covariance=TRUE, delta.na = TRUE, modif = FALSE, alpha = 1/4, c = 1) { if (missing(data)) stop("Argument 'data' is missing with no default") 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(data)) stop("Argument 'data' must be a data.frame") if (!(xor(sum(c("id", "from", "to", "time") %in% names(data)) != 4, sum(c("id", "from", "to", "entry", "exit") %in% names(data)) != 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.") } } ## 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") } } ### 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) namen <- paste(trans[, 1], trans[, 2]) ## test on transitions test <- unique(paste(data$from, data$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 (sum(as.character(data$from)==as.character(data$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(data$id)) ### data.frame transformation data$id <- if (is.character(data$id)) as.factor(data$id) else data$id data$from <- as.factor(data$from) data$to <- as.factor(data$to) if (!(is.null(cens.name))) { data$from <- factor(data$from, levels = c(cens.name, state.names), ordered = TRUE) levels(data$from) <- 0:length(state.names) data$to <- factor(data$to, levels = c(cens.name, state.names), ordered = TRUE) levels(data$to) <- 0:length(state.names) } else{ data$from <- factor(data$from, levels = state.names, ordered = TRUE) levels(data$from) <- 1:length(state.names) data$to <- factor(data$to, levels = state.names, ordered = TRUE) levels(data$to) <- 1:length(state.names) } ### if not, put like counting process data if ("time" %in% names(data)) { data <- data[order(data$id, data$time), ] idd <- as.integer(data$id) entree <- double(length(data$time)) masque <- rbind(1, apply(as.matrix(idd), 2, diff)) entree <- c(0, data$time[1:(length(data$time) - 1)]) * (masque == 0) data <- data.frame(id = data$id, from = data$from, to = data$to, entry = entree, exit = data$time) if (sum(data$entry < data$exit) != nrow(data)) stop("Exit time from a state must be > entry time") } else { if (sum(data$entry < data$exit) != nrow(data)) stop("Exit time from a state must be > entry time") } ### Computation of the risk set and dN ttime <- c(data$entry, data$exit) times <- sort(unique(ttime)) data$from <- as.integer(as.character(data$from)) data$to <- as.integer(as.character(data$to)) temp <- .C(risk_set_etm, as.integer(nrow(data)), as.integer(length(times)), as.integer(c(dim(tra), length(times))), as.double(times), as.integer(data$from), as.integer(data$to), as.double(data$entry), as.double(data$exit), nrisk=integer(dim(tra)[1] * length(times)), ncens=integer(dim(tra)[1] * length(times)), nev=integer(dim(tra)[1] * dim(tra)[2] * length(times)), dna=double(dim(tra)[1] * dim(tra)[2] * length(times))) nrisk <- matrix(temp$nrisk, ncol=dim(tra)[1], nrow=length(times)) ncens <- matrix(temp$ncens, ncol=dim(tra)[1], nrow=length(times)) nev <- array(temp$nev, dim=c(dim(tra), length(times))) dna <- array(temp$dna, dim=c(dim(tra), length(times))) ii <- seq_len(dim(tra)[1]) for (i in seq_along(times)) { dna[cbind(ii, ii, i)] <- -(.rowSums(nev[, , i], dim(nev)[1], dim(nev)[1], FALSE))/nrisk[i, ] ## dna[cbind(ii, ii, i)] <- -(rowSums(nev[, , i])/nrisk[i, ]) } dna[is.nan(dna)] <- 0 ### computation of the Aalen-Johansen estimator if (t=="last") t <- times[length(times)] if (!(0 <= s & s < t)) stop("'s' and 't' must be positive, and s < t") if (t <= times[1] | s >= times[length(times)]) stop("'s' or 't' is an invalid time") first <- length(times[times <= s]) + 1 last <- length(times[times <= t]) if (first >= last) { est <- list() est$est <- array(diag(1, dim(tra)[1], dim(tra)[2]), c(dim(tra), 1)) dimnames(est$est) <- list(state.names, state.names, t) est$time <- NULL var <- NULL nrisk <- matrix(nrisk[last, ], 1, dim(tra)[1]) nev <- array(0, dim(tra)) } else { aa <- nrisk[first:last, ] if (modif) { which.compute <- as.integer(aa >= c * n^alpha) } else { which.compute <- rep(1, length(aa)) } est <- prodint(dna, times, first, last, which.compute) if (covariance == TRUE) { if (modif == FALSE) { var <- var.aj(est$est, dna, nrisk, nev, times, first, last) pos <- sapply(1:length(state.names), function(i) { paste(state.names, state.names[i]) }) pos <- matrix(pos) dimnames(var) <- list(pos, pos, est$time) } else { var <- var.ly(est$est, state.names, nrisk, nev, times, first, last, which.compute) } } else { var <- NULL } if (delta.na) { delta.na <- dna[, , first:last] } else delta.na <- NULL nrisk <- nrisk[first:last, ] nev <- nev[, , first:last] dimnames(est$est) <- list(state.names, state.names, est$time) dimnames(nev) <- list(state.names, state.names, est$time) } colnames(nrisk) <- state.names nrisk <- nrisk[, !(colnames(nrisk) %in% setdiff(unique(trans$to), unique(trans$from))), drop = FALSE] res <- list(est = est$est, cov = var, time = est$time, s =s, t = t, trans = trans, state.names = state.names, cens.name = cens.name, n.risk = nrisk, n.event = nev, delta.na = delta.na, ind.n.risk = ceiling(c * n^alpha)) class(res) <- "etm" res } etm/R/xyplot.etm.R0000644000176000001440000000310411753444243013543 0ustar ripleyusersxyplot.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'") 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") 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 (conf.int) { aa <- xyplot(temp$P + temp$lower + temp$upper ~ temp$time | temp$cov, type = "s", col = col, lty = lty, xlab = xlab, ylab = ylab, ...) } else { aa <- xyplot(temp$P ~ temp$time | temp$cov, type = "s", col = col, lty = lty, xlab = xlab, ylab = ylab, ...) } aa } etm/R/print.clos.etm.R0000644000176000001440000000111111753444243014273 0ustar ripleyusersprint.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/clos.R0000644000176000001440000001445212441412036012356 0ustar ripleyusers### To be used for competing endpoints clos.cp <- function(x, tr.mat, 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)) tau <- max(x$time[ind.cens], x$time) out <- .C(los_cp, as.double(x$time), as.double(tr.mat), as.integer(dims[3]), as.integer(dims[1]), as.integer(dims[2]), los1 = as.double(los[,2]), los0 = as.double(los[,3]), phi2case = as.double(phi2[,2]), phi2control = as.double(phi2[,3]), phi3case = as.double(phi3[,2]), phi3control = as.double(phi3[,3]), as.double(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["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) { 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) { 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 } ### To be used for single endpoint clos.nocp <- function(x, tr.mat, aw, ratio) { dims <- dim(x$est) los <- matrix(rep(x$time, 3), ncol = 3, byrow = FALSE) tau <- max(x$time) out <- .C(los_nocp, as.double(x$time), as.double(tr.mat), as.integer(dims[3]), as.integer(dims[1]), as.integer(dims[2]), los1 = as.double(los[,2]), los0 = as.double(los[,3]), as.double(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["0", "0", ][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) { 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) res } clos <- 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") } 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) if (comp.risk) { res <- clos.cp(x, tr.mat, aw, ratio) } else res <- clos.nocp(x, tr.mat, aw, ratio) class(res) <- "clos.etm" res } etm/R/summary.etmCIF.R0000644000176000001440000000234211753444243014226 0ustar ripleyusers### 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)] 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/print.etm.R0000644000176000001440000000215711753444243013347 0ustar ripleyusersprint.etm <- function(x, covariance = TRUE, whole = TRUE, ...) { if (!inherits(x, "etm")) stop("'x' must be of class 'etm'") 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") 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) } } invisible() } etm/R/prepare.los.data.R0000644000176000001440000001056011753444230014562 0ustar ripleyusers"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): ## ## 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 ): ## ## 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) return(observ) } etm/R/print.summary.etm.R0000644000176000001440000000117611753444243015043 0ustar ripleyusersprint.summary.etm <- function(x, ...) { if (!inherits(x, "summary.etm")) stop("'x' must be of class 'summary.etm'") if ("t" %in% names(x)) { cat(paste("No events between", x$s, "and", x$t, "\n\n", sep = " ")) print(x$P[, , 1]) } else { 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") } } invisible() } etm/R/print.etmCIF.R0000644000176000001440000000227111753444243013666 0ustar ripleyusers### 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]]) 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/summary.etm.R0000644000176000001440000000322011753444243013700 0ustar ripleyuserssummary.etm <- function(object, all = FALSE, ci.fun = "linear", level = 0.95, ...) { if (!inherits(object, "etm")) stop("'object' must be of class 'etm'") if (is.null(object$time)) { res <- list(P = object$est, s = object$s, t = object$t) class(res) <- "summary.etm" return(res) } 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") } if (all) { ind <- object$est != 0 indi <- apply(ind, c(1, 2), function(temp){all(temp == FALSE)}) tmp <- which(indi == FALSE, 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(levels(object$tran$to), levels(object$trans$from)) for (i in seq_along(absorb)) trs <- trs[-grep(paste("^", absorb[i], sep =""), trs, perl = TRUE)] } else { dtrs <- diag(outer(object$state.names, object$state.names, paste)) absorb <- setdiff(levels(object$tran$to), levels(object$trans$from)) for (i in seq_along(absorb)) dtrs <- dtrs[-grep(paste("^", absorb[i], sep =""), dtrs, perl = TRUE)] tmp <- paste(object$trans[, 1], object$trans[, 2]) trs <- c(tmp, dtrs) } res <- ci.transfo(object, trs, level, ci.fun) class(res) <- "summary.etm" res } etm/R/transfoData.R0000644000176000001440000001010112441412210013641 0ustar ripleyusers### 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) 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) } 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) } 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/etmCIF.R0000644000176000001440000000456711753444243012545 0ustar ripleyusers### Wrapper around etm for easier computation of cumulative incidence ### functions etmCIF <- function(formula, data, etype, subset, na.action, failcode = 1) { 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) ## 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/pseudo_clos.R0000644000176000001440000001572612441412036013742 0ustar ripleyusers### Function to compute the pseudo values ## Modelling will be done in another function to offer more ## flexibility ### Author: Arthur Allignol closPseudo <- function(data, state.names, tra, cens.name, s = 0, formula, aw = FALSE, ratio = FALSE, ncores = 1) { ## 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()) ids <- unique(data$id) n <- length(ids) ## theta. From there we'll see what kind of model it is ## is no alternative weights, NULL ## No competing risks: not in the list theta <- unlist(clos(etm(data = data, 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 ## TODO: ACTUALLY COMPUTE THE PSEUDO VALUES namen <- c("ps.e.phi", "ps.e.phi.weights.1", "ps.e.phi.weights.other", "ps.e.phi2", "ps.e.phi3") psMatrix <- parallel::mclapply(seq_along(ids), function(i) { temp <- clos(etm(data = data[!(data$id %in% ids[i]), ], state.names = state.names, tra = tra, cens.name = cens.name, s = 0, covariance = FALSE), aw = aw, ratio = ratio) cbind(temp$e.phi, temp$e.phi.weights.1, temp$e.phi.weights.other, temp$e.phi2, temp$e.phi3) }, mc.cores = ncores) ##} else { ## psMatrix <- lapply(seq_along(ids), function(i) { ## temp <- clos(etm(data = data[!(data$id %in% ids[i]), ], ## state.names = state.names, tra = tra, ## cens.name = cens.name, s = 0, covariance = FALSE), ## aw = aw, ratio = ratio) ## cbind(temp$e.phi, temp$e.phi.weights.1, temp$e.phi.weights.other, ## temp$e.phi2, temp$e.phi3) ## }) ## } psMatrix <- data.frame(do.call(rbind, psMatrix)) psMatrix <- lapply(seq_along(psMatrix), function(i) { n * theta[i] - (n - 1) * psMatrix[, i] }) psMatrix <- do.call(cbind, psMatrix) colnames(psMatrix) <- namen[c(TRUE, aw, aw, competing, competing)] ## the pseudo values n * ref - (n - 1) * temp ## psMatrix <- matrix(apply(psMatrix, 1, function(x) n * theta - (n - 1) * x), ## nrow = dim(psMatrix)[1], ncol = dim(psMatrix)[2]) ## colnames(psMatrix) <- namen[c(TRUE, aw, aw, competing, competing)] cov <- m[!duplicated(data$id), , drop = FALSE] colnames(cov) <- attr(Terms, "term.labels") 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)] zzz <- list(pseudoData = data.frame(id = ids, psMatrix, cov), theta = theta, aw = aw, call = call) class(zzz) <- "closPseudo" zzz } ### A function to compute the pseudo obs on phi instead on change in ### LoS directly phiPseudo <- function(data, state.names, tra, cens.name, s = 0, formula, timepoints, ncores = 1) { ## 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()) ids <- unique(data$id) n <- length(ids) nt <- length(timepoints) ref <- as.matrix(predictPhi(clos(etm(data = data, state.names = state.names, tra = tra, cens.name = cens.name, s = 0, covariance = FALSE), aw = FALSE), timepoints)[, c("phi", "phi.case", "phi.control", "phiR")]) ref <- apply(ref, 2, rep, n) psd <- matrix(0, nrow = n * nt, ncol = 6) temp <- parallel::mclapply(seq_along(ids), function(i) { as.matrix(predictPhi(clos(etm(data = data[!(data$id %in% ids[i]), ], state.names = state.names, tra = tra, cens.name = cens.name, s = 0, covariance = FALSE), aw = FALSE), timepoints)[, c("phi", "phi.case", "phi.control", "phiR")]) }, mc.cores = ncores) ## } else { ## temp <- lapply(seq_along(ids), function(i) { ## as.matrix(predictPhi(clos(etm(data = data[!(data$id %in% ids[i]), ], ## state.names = state.names, tra = tra, ## cens.name = cens.name, s = 0, covariance = FALSE), ## aw = FALSE), timepoints)[, c("phi", "phi.case", ## "phi.control", "phiR")]) ## }) ## } temp <- do.call(rbind, temp) for (i in seq_len(4)) { psd[, i + 2] <- n * ref[, i] - (n - 1) * temp[, i] } psd[, 1] <- as.vector(mapply(rep, ids, nt)) psd[, 2] <- rep(timepoints, n) psd <- as.data.frame(psd) names(psd) <- c("id", "time", "ps.phi", "ps.phi.case", "ps.phi.control", "ps.phiR") cov <- as.matrix(m[!duplicated(data$id), , drop = FALSE]) cov <- matrix(mapply(rep, cov, nt), dim(psd)[1], dim(cov)[2]) cov <- as.data.frame(cov) colnames(cov) <- attr(Terms, "term.labels") zzz <- list(pseudoData = data.frame(psd, cov), phi = data.frame(id = psd[, 1], ref, time = timepoints), ps = data.frame(id = psd[, 1], temp, time = timepoints), call = call) class(zzz) <- "phiPseudo" zzz } predictPhi <- function(object, timepoints) { if (!inherits(object, "clos.etm")) stop("gtfo") if (missing(timepoints)) stop("I want timepoints!!!") ## phi <- object$phi.case - object$phi.control ind <- findInterval(timepoints, object$time) tmp.case <- tmp.control <- numeric(length(timepoints)) place <- which(ind != 0) tmp.case[place] <- object$phi.case[ind] tmp.control[place] <- object$phi.control[ind] data.frame(phi.case = tmp.case, phi.control = tmp.control, phi = tmp.case - tmp.control, phiR = tmp.case / tmp.control, time = timepoints) } etm/R/plot.clos.etm.R0000644000176000001440000000422211753444243014123 0ustar ripleyusersplot.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 <- par(no.readonly = TRUE) on.exit(par(def.par)) split.screen(figs=matrix(c(rep(0,2), rep(1,2), c(0, 0.6), c(0.7, 1)), ncol=4)) screen(2) op <- par(mar=c(2, 5, 2, 1)) 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, ...) axis(side=2) box() par(op) screen(1) op <- par(mar=c(5, 5, 4, 1)) 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], ...) lines(x$time, x$phi.control, type = "s", lty = lty.e[2], col = col.e[2], ...) 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)])) } close.screen(all.screens = TRUE) invisible() } etm/R/extract.R0000644000176000001440000000410511753444243013074 0ustar ripleyuserstrprob <- 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) if (missing(timepoints)) { tmp <- x$est[trans.sep[1], trans.sep[2], ] } else { ind <- findInterval(timepoints, x$time) tmp <- numeric(length(timepoints)) place <- which(ind != 0) tmp[place] <- x$est[trans.sep[1], trans.sep[2], ind] } tmp } 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) } if (missing(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] } tmp } etm/R/misc.R0000644000176000001440000000337512263256476012373 0ustar ripleyusers### 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 } etm/vignettes/0000755000176000001440000000000012441572507013106 5ustar ripleyusersetm/vignettes/etmCIF_tutorial.Rnw0000644000176000001440000002517112263256476016644 0ustar ripleyusers%\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. <<>>= require(etm) 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/MD50000644000176000001440000000655012441577674011426 0ustar ripleyusersd669fb109b9e87292da9d4201b52c7c9 *ChangeLog a90f15f200f43e7d4e7723ef95a37763 *DESCRIPTION a0e69954bb848fa110ca164c01c07848 *NAMESPACE c769759089889310b44037f7e19f70e7 *R/ci.transfo.R 161631858c05a6977a4d54263bb78266 *R/clos.R d139e9461403cfe36837c0439720c1a7 *R/etm.R 3181f08b7c8e6c9c306ef4b299deca2f *R/etmCIF.R 91c190eca501eb828fb96f4fd476519f *R/extract.R 441c49e0a746a7db6a8a4a1215b751fd *R/ggtransfo.etm.R 34526139ea7e43e28181a7a04624b279 *R/lines.etm.R 02a37d5e97f248e95c43dcdac6388624 *R/misc.R 294bf2ed86d5a09fb528b776e0350eb9 *R/plot.clos.etm.R d8cba6e584cbfb681e5e23d99f9315fc *R/plot.etm.R 13326457eca65d52983c2d6694026c3d *R/plot.etmCIF.R 20031106830e8896903538717169541a *R/prepare.los.data.R f18f5b80b9470edaa72732e1852b3c81 *R/print.clos.etm.R f293e5e4a831f1636abf65446b5a3f6c *R/print.etm.R f087d944a523516bee415d5bdab898d0 *R/print.etmCIF.R cf52ae3579e299ad0a6f57d998c960b0 *R/print.summary.etm.R 9639135f498d9298226ae02df87db62c *R/pseudo_clos.R 6b60e2b1f5e65ecf5480fd858cae7e98 *R/summary.etm.R e65aacbc0b2bf7de232d5a419dc4e820 *R/summary.etmCIF.R 1c0e9ec7428a9f91839b880b22ec7565 *R/transfoData.R ccbc25c8a47d56c4961cba60d48d9671 *R/xyplot.etm.R 2aaf40c683563d5bf3db07140fde8e94 *build/vignette.rds 476bcb434771e9b96558abd030d09396 *data/abortion.txt.gz 6ab49cb48191ac4da0f54e4804f19ea1 *data/fourD.rda dcae240445955c2f848e08eb333100c2 *data/los.data.csv.gz baba7e394ff9255728343ee4dc10b546 *data/sir.cont.txt.gz 36b4ecf2f670d7cc5dbd8ffc8393bf39 *inst/CITATION c04ec76345a113c49c88ff0015dd6976 *inst/doc/etmCIF_tutorial.R 1d3dd06a96abe63ec23af1df8a759eda *inst/doc/etmCIF_tutorial.Rnw d5d343bc22b8b2afc41e7dff0b76a999 *inst/doc/etmCIF_tutorial.pdf 5541acbfe1040be8fbb765e7d2f193fe *man/abortion.Rd 298fe0940bb5d53ace5a0e9d4cb790e6 *man/clos.Rd e986af8cf8fbeaaf64fd080cb74f6014 *man/closPseudo.Rd d10655aab3b4473c458db8a728c9cd42 *man/etm.Rd 87813817aac9adb8355c24aa48acf1df *man/etmCIF.Rd 24e166bb6e78e768b8686a2348afadaa *man/etmprep.Rd fd38028a1eabb4129f91a55efe1b1ea1 *man/fourD.Rd 49df768ad47ee3ddb9b92fe2ee7b5500 *man/ggtransfo.Rd fb345ee72450087492d23b43bb67f33e *man/lines.etm.Rd c1b89e51669d0c7a05cced57bcb65931 *man/los.data.Rd 150641802b829978725aadc8fd7f7f95 *man/phiPseudo.Rd b47923be875349fadae3ab51e17b3561 *man/plot.clos.etm.Rd 47989b691389928ae10d0aaa2c4c95c9 *man/plot.etm.Rd 3306d47cd6d768ca9869f4b544ace52f *man/plot.etmCIF.Rd 37ece37de86bb13e66c65dd32fe9f884 *man/prepare.los.data.Rd 73575602cc041aea49b64a0fff90e29f *man/print.clos.etm.Rd 3de6acf45b4d863641b46b8d99cbab83 *man/print.etm.Rd 9e459a95d651bc276391c0dfdf6f58cf *man/print.etmCIF.Rd 474d026085ee1807de4de6426dcf549c *man/sir.cont.Rd fe0facea35751ae612521566750302b5 *man/summary.etm.Rd 83bcbc426557dcec08f02a99eae3f229 *man/summary.etmCIF.Rd c7061cba7c3e3106b2074ca58beba9fb *man/tra.Rd 6dd847e3ac794979dce68bc193d7018b *man/trprob_trcov.Rd b8d5092f9391804dce102fd1998e28df *man/xyplot.etm.Rd c7f5114c2954466b8fda5207bd5c7ee5 *src/cov_dna.c 4ac9ec1ce02d321c61c28e18fbd49e15 *src/los_etm.cc a58cd565dd706afa4346ddd996a82959 *src/matrix.cc bef22e0261a86cdd7d4044ac94c550e5 *src/matrix.h d4c110cdbcab77b2f6a7b123065726df *src/risk_set_etm.c 3d17b4ab9ed7ca8a3663c169d20e251b *tests/test.etmCIF.R 272293fad90eb63d397f365a49a4fd6f *tests/test.etmCIF.Rout.save 5bc88e30c083317f1f35cc2de10ae812 *tests/tests.etm.R b39cb79846ef3382614861486df05be5 *tests/tests.etm.Rout.save 1d3dd06a96abe63ec23af1df8a759eda *vignettes/etmCIF_tutorial.Rnw etm/build/0000755000176000001440000000000012441572507012175 5ustar ripleyusersetm/build/vignette.rds0000644000176000001440000000036312441572507014536 0ustar ripleyusersQK 0M?~APzwJA܈p'5&XyruV4 f2Iޛyl1y\J/ԥS8g<[4K)pj 2t^j#L<DQ J*^K1~,3h%r?KgekP:l=;SҲ&lTw%7|@etm/DESCRIPTION0000644000176000001440000000073712441577674012625 0ustar ripleyusersPackage: etm Title: Empirical Transition Matrix Version: 0.6-2 Author: Arthur Allignol Description: Matrix of transition probabilities for any time-inhomogeneous multistate model with finite state space Maintainer: Arthur Allignol License: GPL (>= 2) Depends: R (>= 2.14), survival Imports: lattice Suggests: ggplot2, kmi, geepack Packaged: 2014-12-09 13:12:40 UTC; arthur NeedsCompilation: yes Repository: CRAN Date/Publication: 2014-12-09 14:57:15 etm/ChangeLog0000644000176000001440000001157412441572101012646 0ustar ripleyusers9-12-2014 Arthur Allignol * help page for ggtransfo + exmaples * ggplot2 in suggest * remove changeLOS from suggest. Update tests and help pages accordingly * rerun of the tests 7-10-2014 Arthur Allignol Version 0.6-2 * etm: Implementation of the variance of CIF with Lai and Ying transformation. 24-3-2014 Arthur Allignol Version 0.6-1 * etmprep: Bug fix in error handling of the start argument * etmprep: Bug fix in the dealing of to and from when state names are given 2013-9-19 Arthur Allignol * Version number 0.6 * NEW: pseudo value regression for excess LoS (see closPseudo) 2012-04-02 Arthur Allignol * new version 0.5-3 * clos: All references to the changeLOS package removed from the doc * etm: removed the use of .internal() 2011-11-3 Arthur Allignol * etm: *EXPERIMENTAL* Product limit modification following Lai and Ying 2010-12-6 Arthur Allignol * New version 0.5-2 * sir.cont: Two new covariates age and sex 2010-11-24 Arthur Allignol * New version number 0.5-1 * CITATION: new file 2010-11-3 Arthur Allignol * fourD : New data set * etmCIF and methods print, summary, plot: New functions Lead to add survival package in the dependencies * etm: Fixed warning message when no censoring but still defined in the call * etm and methods: Fix to deal with more complicated state names (e.g., with characters with spaces) * vignette: A vignette on etmCIF has been added. Has a view towards CIFs for pregnancy data 2009-11-11 Arthur Allignol * lines.etm: New function * plot.etm: Rewritten. Possibility to draw confidence intervals. * xyplot.etm: Consistency checking on tr.choice argument modified. 2009-8-21 Arthur Allignol * Bug fix: in clos.cp and clos.nocp, O's were not in the right place for computing the weighted summary when P(X_s = 1) . P(X_s = 0) = 0 2009-7-30 Arthur Allignol * print.etm and print.summary.etm now return nothing, while before they returned x with the invisible flag set * Choice of the transformation for the confidence intervals in the avec.cov function is now done with switch instead of using several ifs * Bug correction: Tests on the tr.choice argument in xyplot, trprob and trcov methods was done comparing it to the rownames of the covariance matrix, which didn't make sense when etm was called with argument covariance set to FALSE, and thrown an error even if tr.choice was good. 2009-7-28 Arthur Allignol * New function etmprep that transform data in the wide format into the long format, in a way suitable for using the etm function. * New generics trprob and trcov and methods for etm objects. 2009-6-12 Arthur Allignol * New plot function for clos.etm objects 2009-6-9 Arthur Allignol * New aw argument to clos. Whether use alternative weighting to compute the expected change in LOS * Implementation of the alternative weighting 2009-6-8 Arthur Allignol * New argument to etm: delta.na which decides whether to include in the output the increments of the Nelson-Aalen estimator * Implementation of the Change of Length of Stay following changeLOS package. Though here, it works with left-truncated data, and doesn't require competing outcomes 2009-4-9 Arthur Allignol * New internal function ci.transfo() that transforms etm objects and computes pointwise CIs * Modification of summary.etm that now uses ci.transform * Modification of xyplot.etm. Uses ci.transform, and plots CI * New data set abortion 2009-2-4 Arthur Allignol * bug correction 2009-1-9 Arthur Allignol * Modification of sir.cont.Rd 2008-12-9 Arthur Allignol * Modification of print and summary new arguments * cov.dna now in C 2008-11-19 Arthur Allignol * Modification of the print an summary methods * Now result of summary is printed via print.summary.etm() * In etm: better handling when there's no event between (s, t] 2008-10-14 Arthur Allignol * Bug correction: now works when there is only 1 transient state. * Modification of the part which transforms the data into counting process * Modification of the C++ routine that is now faster nd computes the increments of the Nelson-Aalen estimator * Add a plot function etm/man/0000755000176000001440000000000012441572507011651 5ustar ripleyusersetm/man/ggtransfo.Rd0000644000176000001440000000747712441572475014155 0ustar ripleyusers\name{ggtransfo.etm} \alias{ggtransfo.etm} \alias{ggtransfo} \title{ Prepare etm output for plotting with ggplot2 } \description{ The \code{ggtransfo} function permits to transform the output of \code{etm} such that transition probabilities along with confidence intervals can be plotted more easily using the \pkg{ggplot2} package. } \usage{ ggtransfo(x, ...) \S3method{ggtransfo}{etm}(x, tr.choice, ...) } \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{\dots}{Further arguments. In particular for \code{\link{summary.etm}} that is called internally} } \value{ A data frame with the same variables returned by \code{\link{summary.etm}}. Addtional variables are \item{trans}{transition type. In the same format as given by \code{tr.choice}} \item{timemax}{Lagged transition times for drawing confidence intervals with \code{geom_rect}} } \author{ Arthur Allignol, \email{arthur.allignol@uni-ulm.de} } \seealso{ \code{\link{etm}}, \code{\link[ggplot2]{ggplot}}, \code{\link[ggplot2]{geom_rect}} \code{\link[ggplot2]{geom_step}} } \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) to_plot <- ggtransfo(tr.prob, tr.choice = c("0 1", "1 0")) \dontrun{ require(ggplot2) print(ggplot(to_plot, aes(x = time, y = P)) + facet_grid(. ~ trans) + geom_step() + geom_rect(aes(xmin = time, xmax = timemax, ymin = lower, ymax = upper), alpha = 0.5) ) } ## abortion data(abortion) cif.ab <- etmCIF(Surv(entry, exit, cause != 0) ~ group, abortion, etype = cause, failcode = 3) pcif.ab <- lapply(cif.ab[1:2], ggtransfo, tr.choice = c("0 1", "0 2", "0 3"), ci.fun = "cloglog") pcif.ab[[1]]$Group <- "Control" pcif.ab[[2]]$Group <- "Exposed" pcif.ab <- do.call(rbind, pcif.ab) pcif.ab$Group <- factor(pcif.ab$Group) pcif.ab$Group <- relevel(pcif.ab$Group, ref = "Exposed") pcif.ab$out <- factor(pcif.ab$trans, labels = c("Spontaneous abortion", "Induced abortion", "Live birth"), ordered = TRUE) \dontrun{ require(ggplot2) ggplot(pcif.ab, aes(x = time, y = P)) + facet_grid(. ~ out) + geom_step(aes(colour = Group), size = 1.3) + geom_rect(aes(xmin = time, xmax = timemax, ymin = lower, ymax = upper, fill = Group), alpha = 0.5) + scale_x_continuous("Week of gestation", limits = c(0, 45)) + scale_y_continuous("CIF", limits = c(0, 1), breaks = seq(0, 1, 0.1)) + theme(axis.text.x = element_text(size = 18), axis.title.x = element_text(size = 18), axis.text.y = element_text(size = 18), axis.title.y = element_text(size = 18), strip.text = element_text(size = 18, face = 2), legend.text = element_text(size = 18), legend.title = element_blank(), legend.position = "top", panel.background = element_rect(fill = grey(.93))) + scale_colour_brewer(type = "qual", palette = 6) + scale_fill_brewer(type = "qual", palette = 6) } } \keyword{hplot} \keyword{dplot} etm/man/etmprep.Rd0000644000176000001440000000704712263256476013632 0ustar ripleyusers\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@uni-ulm.de} } \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) ## 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/trprob_trcov.Rd0000644000176000001440000000411312263256476014672 0ustar ripleyusers\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@uni-ulm.de} } \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/xyplot.etm.Rd0000644000176000001440000000342012263256476014270 0ustar ripleyusers\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@uni-ulm.de}} \seealso{\code{\link{etm}}, \code{\link[lattice]{xyplot}}} \keyword{hplot} etm/man/abortion.Rd0000644000176000001440000000237212216653707013763 0ustar ripleyusers\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/prepare.los.data.Rd0000644000176000001440000000221312441413277015276 0ustar ripleyusers\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/phiPseudo.Rd0000644000176000001440000000471712263256476014117 0ustar ripleyusers\name{phiPseudo} \alias{phiPseudo} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Pseudo Value Regression for the Expected Excess Length of Stay } \description{ Pseudo value regression for the expected excess length of stay for each landmark time } \usage{ phiPseudo(data, state.names, tra, cens.name, s = 0, formula, timepoints, ncores = 1) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{data}{A data.frame in a format suitable for \code{\link{etm}}.} \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 \code{NULL}} \item{s}{Starting time for computing the transition probabilities.} \item{formula}{A formula with the covariates at the right of a \code{~} operator. The left hand side can be left empty.} \item{timepoints}{Landmark time points at which the pseudo values are computed.} \item{ncores}{Number of cores used if doing parallel computation using the \pkg{parallel} package} } \details{ The function calculates the pseudo-observations for the extra length-of-stay at several landmark time points 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}. } \value{ An object of class \code{phiPseudo} 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{phi}{Estimates of excess LoS in the whole sample} \item{ps}{} } \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@uni-ulm.de} } \seealso{ \code{\link[parallel]{mclapply}}, \code{\link[etm]{clos}} } \examples{ ## TODO } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{survival} etm/man/plot.clos.etm.Rd0000644000176000001440000000357112263256476014655 0ustar ripleyusers\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@uni-ulm.de}, Matthias Wangler } \seealso{ \code{\link{clos}} } \keyword{hplot}etm/man/plot.etmCIF.Rd0000644000176000001440000000652112263256476014236 0ustar ripleyusers\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@uni-ulm.de} } \seealso{ \code{\link{etmCIF}}, \code{\link{plot.etm}}, \code{\link{lines.etm}} } \examples{ data(abortion) cif.ab <- etmCIF(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/fourD.Rd0000644000176000001440000000310412216653707013217 0ustar ripleyusers\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/man/etmCIF.Rd0000644000176000001440000000454512263256476013265 0ustar ripleyusers\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@uni-ulm.de} } \seealso{ \code{\link{etm}}, \code{\link{print.etmCIF}}, \code{\link{summary.etmCIF}}, \code{\link{plot.etmCIF}} } \examples{ data(abortion) cif.ab <- etmCIF(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/los.data.Rd0000644000176000001440000000144012441413376013642 0ustar ripleyusers\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/lines.etm.Rd0000644000176000001440000000306212263256476014045 0ustar ripleyusers\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@uni-ulm.de} } \seealso{ \code{\link{etm}}, \code{\link{plot.etm}}, \code{\link{xyplot.etm}} } \keyword{hplot} \keyword{survival} etm/man/closPseudo.Rd0000644000176000001440000000737312441412036014260 0ustar ripleyusers\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, aw = FALSE, ratio = FALSE, ncores = 1) } \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{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} } \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}. } \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@uni-ulm.de} } \seealso{ \code{\link[parallel]{mclapply}}, \code{\link[etm]{clos}} } \examples{ library(kmi) ## 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) } } \keyword{survival} etm/man/print.clos.etm.Rd0000644000176000001440000000067512263256476015035 0ustar ripleyusers\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@uni-ulm.de} } \seealso{ \code{\link{clos}} } \keyword{print}etm/man/print.etm.Rd0000644000176000001440000000154412263256476014072 0ustar ripleyusers\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 = TRUE, 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@uni-ulm.de}} \seealso{\code{\link{etm}}} \keyword{print} etm/man/tra.Rd0000644000176000001440000000302112263256476012730 0ustar ripleyusers\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@uni-ulm.de} } \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/etm.Rd0000644000176000001440000001756012263256476012744 0ustar ripleyusers\name{etm} \alias{etm} \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{ etm(data, state.names, tra, cens.name, s, t = "last", covariance = TRUE, delta.na = TRUE, modif = FALSE, alpha = 1/4, c = 1) } \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{alpha}{Constant} \item{c}{Constant} } \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) } \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} } \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@uni-ulm.de}} \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/plot.etm.Rd0000644000176000001440000000531612263256476013715 0ustar ripleyusers\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} } \value{ No value returned } \author{Arthur Allignol, \email{arthur.allignol@uni-ulm.de}} \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/sir.cont.Rd0000644000176000001440000000301712216653707013702 0ustar ripleyusers\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/summary.etm.Rd0000644000176000001440000000364712263256476014441 0ustar ripleyusers\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, all = FALSE, ci.fun = "linear", level = 0.95, ...) \S3method{print}{summary.etm}(x, ...) } \arguments{ \item{object}{An object of class \code{etm}.} \item{all}{If set to TRUE, a data.frame will be computed for all transitions that are not 0 in the empirical transition matrix.} \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{\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@uni-ulm.de}} \seealso{\code{\link{etm}}} \keyword{methods} \keyword{print} etm/man/clos.Rd0000644000176000001440000001312212441417072013072 0ustar ripleyusers\name{clos} \alias{clos} \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 = FALSE, ratio = FALSE) } \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}} } \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@uni-ulm.de}, 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.etmCIF.Rd0000644000176000001440000000067612263256476014421 0ustar ripleyusers\name{print.etmCIF} \alias{print.etmCIF} \title{ Print function for 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@uni-ulm.de} } \seealso{ \code{\link{etmCIF}} } \keyword{survival} \keyword{print} etm/man/summary.etmCIF.Rd0000644000176000001440000000236312263256476014755 0ustar ripleyusers\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@uni-ulm.de} } \seealso{ \code{\link{etmCIF}} } \keyword{method} \keyword{print} \keyword{survival}