epitools/0000755000176200001440000000000013174443221012111 5ustar liggesusersepitools/NAMESPACE0000644000176200001440000000100713174424211013324 0ustar liggesusersexportPattern("^[^\\.]") importFrom("grDevices", "colors", "rgb") importFrom("graphics", "abline", "axis", "barplot", "matplot", "points", "rect", "text", "title") importFrom("stats", "binom.test", "chisq.test", "dbinom", "dpois", "fisher.test", "ftable", "pbinom", "pchisq", "pnorm", "ppois", "qgamma", "qnorm", "quantile", "rbinom", "uniroot", 'confint.default', "binomial", "coef", "deriv", "family", "glm", "glm.fit", "model.matrix", "sd", "vcov")epitools/data/0000755000176200001440000000000013174424211013020 5ustar liggesusersepitools/data/wnv.rda0000644000176200001440000002060613174424211014326 0ustar liggesusers ŵIaD4 AqS]= @rAb+ |y9s9s9T}:v~n닢PO Y͵xn|Eqlޅ]Eo.b5>s^}qŽ}ЃPl!aQ1qsГ硧&ih3,9yh mv@;h y*(@54& Ћnh@Cat:N@/C@'Si *tz:}zzz m;w}ZޅރCW wC_.BB+%k@+U#\|^/'~PA?Џ~XA? O~TA?τ~\A?/~_RAЯ~_ZA o~VA~^A?QAП?YA _UA߄]A?SAп5o ;C3_ 7C7 E{x_ x_}x_}x_}x_}x_}x_}x_6A / / / / / / /~x_}x_}x_}x_}x_}x_}x_}x_}2 / / / / / / / /| / / / / / / / / / / / / / / / / / / / / / / / / /?_____obCW_W_5+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +~{_{g(|>1տ]6h@$muVݘCS~=úiژ mң=˻1O^cַv9)ʔb9Gu>kN:S_/1ofyp}+YkFc߈%.M[C9Xx+҂\fxZ8u%?ҭ^mϬطk]M:)p/ui}ZcyoHѿ:HPzv>kbQ:iw(i5f^k~Sۏ6]C}_3G_lm<\kƵn9yo t-~]'N߰m<ܹ5p受/,rm!6;ի厣\J]\^Y/wk˗/,]k_^}eM,]ʥ+|qJpr{ӷӗ;};sq.||ʅiK]^pyjJ޳K+"/4K_X~? N\Z..m:tqR~+WW6х+N{RKw҇Szw~}4K/u`{1<6Z{W/jݲR޺Z FUo][.vG%o[$Ji)&{U/^#ۍh-Չ[[4O}mccYڎ}iōP^sE{-΢wrm>bV-Ksk1^6ǭX>֘ƲmhEakcIm|>l\b-6~#kgŎU>jlc|1;Em*Vosc6Z_wZ-~;ڼk[N\k m=`c5l|bMv\gm|b}OZY'ZbC{ f~Ŋ5ǖw\?qn;渵Ayj[۬,y֗k-r6[;q_m=o<?j-F6mOYX廳gھ6>Vy>cˎ\ly{m m N8<k}ckub^϶'XUWiygl4n͂K]~s`|=eOرOXN}sՍ9lx{Ď]>c_}zmnߋvlmq#׎YYn+u3Vku>ksc1K֮+ȑYߞc=muv[{q uzr=dyډeݣS<&^uvňeqem5 > >ޱŏ^Yk7}s'5Fk{3łc}Ik =t{Ǝ}?gsrrmžGDn1v==6{mbkZϯZ;i:6|OXNރv!cs6+X[o'l.WmNzV. l"KvYn{v\mvlEr?fsu}zrMC-X㘬[ף~Vӿ ~T5q[ܲ9ꖷ#S;֬mscf/Sښg,fW?Ce͎|6s޾Ź7Ys7:ӴgnԫC}P}~R\oh16P;Yfs4m1̚YYs8Ěkٳ:O9O,Y}דb3ZC̳,w>fgh]o^zv8mܨzǫ5/⍮yPYL5vƢoa4MoǷ!PCW^8ZcͷCh!Ƥks.kA=6f.뮩nn?ՙVm/Yjwֺ[S ]_C]'CK27gyx]WݾAwи>6m}is:{i;> v.?zh||4ކƾo ߡ1Py~Eݵ:s}_[7qV>ԟޗo__0m}i,cXZbV_CtOʴgw Zןiޞ}}fi^foyt7{fi:b_C;e:~F;XN:ՕK_O?yT:XƩSo"֔bm([g=x$fw)o~Y<~ۋңsq߃/\?Tޯh=x_/'|癶[g7mx3=ˎY>[|J?vX岡K8yVl=ޣ46=nhn,S6;,T*x4wa'o[ՏmofmvlIm_gRغ5^8kӵp6=yoE\|',_( ]V?XٸP9t{є`*G)vlwڎcvض_?=#V'l[:e־IcX[ӽ4/'ocʨserxrRz.xm[{i8g5sq鹿X>\|[>imۯ8vY~Szve;@5Uv,ҳ/rDqs*f|UJ,?*m{g8ٌ\K_<_otg|dX}X91\k;>rֱo;y۶cMbwϗeY{u;wKY~Uo~Ԋ}VݎNm~ 3ˋ|߷[yakp>蔯ر_5ű_sgí.w>쩓^.犵_s#''=);]m)''}k~ޱ )Azクk}Dϧ )N蛦;L?pjJBV28w}IعXg%nh1+YITYIֲe%Y.X.BVԍ%z(+qYJʬJdL%ݹ@I(˰;_u6_u6_uP)_m_:w=6cjccKf9gn6ߤQvܷnR"-|c̡7m34Jw>Jס5z7n?v(1vMQwn޴vT~߻CLSգ =nsOr~7׹)j_WWMx{@ {Puҵt~G{{Ry:PrҽiJ'P{_5cIʻziQwމv_Y>K(,:NiL,Iu)^{{Tt>Kj"e ^cSuBvn3ΐq쌳z̫:ٕs%/nwݦmݾ+gmufץ uۮ0ݲGY>ZQ~(]ZQ~e(.yM%.ˢ\azѽw={um]]e:Fu(6FlƨX2閸,!G.VƮr}R\F4k= ;c 3TFo`ԯn[f^n;7:F!y\59WwhLf1SJoO -ͥC=rR׬$+^Ӟs4~Ϭgz6Y)Vҟggb\۱̸0B=ݘFguI7!϶$b/,\Hjٹo62{YuN^}]6^Yby].KL5ӊKqv};Ai5騿H&In3SsMǽ9w t҄v*ImN{Z;uK/9qexzyf9/.ZU LѓEyE3>JU.O&,+eLU0ѕrʭ IU 9Cfe.K+UmA]ˮJ|-#Sȕ\_n0<(Eg;h`NmDo0ECjT[y\v'$_mOOCa9F։izp.uaɄ7gv?¸Wo9v EK"@VP;T_ q1` #W|!).5ĒuL,l\<|Xb9,氘b9,氘b9,氙f9l氙f9l氙f9pa9pa9pe9\pe9\pe9D0 GhOҞ=M8YsiH O>E4h>Kgh}/vl?vl;v~áph;7iph;ßg;ßg mCv8t ?OS)`0 x?O4~ X?O SZ>+g@F+h%'iieZV+a4lV 6[f+l;+m`춂V V [v+n`g`tg;+m`춂`lVѰ [AV [~+oA+>A4uР4thhQ-ChP E:|A::hP ?A:O:OtKtKtK AA:Pg' -LihQ-EuС:A:PCtuС:A:hP \@C: A:hPA:hO=tН'4tОA{:hO=tНAw:N;ttНu4tohN;tC4tОΏПy+ ?tПӹuР4ts -C4uРТ{iQ=G M>>u\```}}>u\uڤ}}p}0}0}>8>8}}pGO>8>8>8>}````nV}}^൏>xhyj*}U WoV*}*X_ Wg~Vgx W`~̯U W*u*`ܯUUb*_%&U*XĄU8 V*X%6ƒU*qa>V bذ 7V*a~‹U8J\X%^%^%>‘U*aJJX7f wV*1b\`ŸUb*Z%VTe.+4Bo+0Y LVm.+ lV`جf6+gE\ \V[ lVn>+YhVnV+tBw+0[ VxkV`"OlVlf+0[ V`B+p[T`mn+p[ `+0X \UBK+U |U_ U`cXEQ UX Uox[*kW*r |U_3+0V U`cGV" UoxZ*V U`g8X*0V YΪ1B+B+4B+4<"C*r ͮ ͮ _OçSd% _?ᐸ;ďC|8ćC|8$;ėC|9$ېx;wCmooognφlφlφlφlφh Ѳ!!!!:6C7wC|7oC6_C5Dlv  C|7Dom߆ C4kpf ??  C|8wC|7$   1Ce ѓ!z2DOtC4e є!2DSh=#Ctd~ я!1D;hCR vCtcn ь!z1D/hCr!:1D'Ð\nF ч!0GCta.@4K#4K#taFLLL<<] #`FjF`jD/G`kFjF`jFˆI]qFipF`jF`iFhFhD #`F`jFiFiF`iF`iFhFh #p4C#04C#3?##?#?#b ##GqDLGֈ7"Gyֈ88#8"7"#:#:#:#:#:"|kDFĽ9쎈}#;#܎w#;#;#;.Qg#:#0:# ,l;\;Y;\;&w`rX;;'vŸڝڝg'ɜvcw2ph'Iw;Nx'\\ ii\u\u\h'`s.'rB4p9A'`s6'g>'s6'`s6':~.'r.'r.'\N z?!/4N'tONN͟4f'`vf'`vON넺zf'`vf'tF'`s6'`s.'rB3As'lN Z;Ak'sB2As',tw^'uV'tN tv F`sN|NlN\N):E[s >r .r .rN):EWs >rNm))):ESsN|N\NLNMS9Sp9Sr)))LM%Stu >$S0:EO`sNN])5 N NM=S7{S7wSp7%ט)8E`o n `n ަm ަ`m.N۔c Φl Φl.NMm)X)X)8C+fh  _ _ ' ͘~z1732/32/3r~Z1/32/32C+ffF3 ЎqoFܛ!34CCfjf fĽz23d㌸7×3|9CWfhʌ7ß39#ЖoF웡-3:#rg 33<3<3<3jz3Cof{F,Z33>3|=3|=3tfg{З/3=3egy _ =~eKΈ3eF /3eЗoИ3#Й3#gh  gh 53tfЙqq̈3ffqT#k&FѡѡѡjdQhQ=Ѣ\FjbdMѤMjr:FjFj&~ѨѨEdk5|C jPÇ>&p5|Ѫ>&pFjxQË5ܨE /jxQ\5G ?jQÍn5UÍnp5E /j8QÉ>5\B jxPÃR5\B jt5ZWÉ>5|C j5|C jPÅܰFjPÇ[Ç>&/^np5ܨF 7jxQ5ZX5H Gj8R5š[Ó[ÓZ'5XÕ'5<FkRÕ+5<kr+5\J WjRÕ|&.p35L gj8SkxSÛfq`q9X9X9898sb99999s09s09s09s8s8GhL<<,9XGqN7Gr.r.`r&Ls09G91v`q99s7{sp7wsp7wsx`o-99s08s08sb Ήs08s99<s08s08'9<{s7ws07Gnnh9؛9؛9؛9؛s7G`po`o`onn`nmsy>9؅v]߅wa]~6߅wa]z6ޅw]yvޅvf`vfu^u^`u.낼bf`vf`vf`vf`v..]] ]: p p p tnvn.. 4u.]] u`zu.l/v]`z l p EK`y`y`y.,/,/Z@KqjԆoCm !6߆z!7߆Z!7 q!7ᆺ!7XbqC,nнk נ} נ} Ao5^8tA 5h_pԀkRԀkSԀ,5`K 1O xjS4S ؀L5`S jTԀ-lT0ՀL5A0ՀL5`S jTԠ jT.ր5ࣁs hG6р\4]6׀|4 hapҀ4`# hGCmG># hк|4!6k zא6h^5h^5h^5h]5k2йkйkйkйk Zנu !7mмkк8۠w zנw qA4!6h^5؆۠} נ{ נ{ yi5 נ א"#itt|t|t|t N5\X kka >5u|oѦuѥutiu6MhKf-Z?du::ֱS$LEctN~-?xƹ,gMQ\?;Z}yܗ=]3s?~gŽŹSеg[vr\fMe7xUZyzAM/qKFY>qcmʙaq[afkT*jMscn8Ϲ1V1yUf39Kߚy?>eUzu6_˿{F*Zp=w»W\G߳T073}*O|O3i6mdcCT԰Os8'O&o^3RCkŹlgC|f*Lxs}dcTpRͲb!絾|&=;]}M8#*Wge  Ykq#xWu͙ք;l~zׄO>w|Ek>;6DŽrJؙJ8#Q*9˩Ęs?1?ncuZƏki._c|E?;{S$>ϱ[qM9BvByr)zs;9 m.'K(llshdo99-,~+N׹zV9|:-`aHcx+il,ZjQd?5͓?|1gS|T|Q8R NطW T@yp3-uiS]dO}JC֩Α/?a ejCyV֏Kߧ9z{ U;VH'TRל?„j[6(~H[=d/s凊']3QyPSuF1L9re?SXS}Pc?|k3R/xzGGCaJ:"|5{N'0u[Kϲ5Og?6 :x+P+]oJڵӎ9OT+kpV9-;U}s^xl?\}^Vv넞Kx-m}`#ڧ(s=ۑJN:S.,yitjj_3Љ5h'I^}NWZx>u_M1^=h|'OWVިLPy뵧{!%o;l' V.\u^5hSXQCq-p{'֥\My0#^㚃tssauʞη/!YǤv9';(u;uZ*9l$_^&"nMsOW+*6OlPkC1caIC#t*oo4Hsk/&S+*Գe:N(fCǬ|MF._J=p=mc(/K:#\ k}W:&.aq^YsjchQ"/~x)LvWﵭ_ncK wܔ(o>SLWMtf*Ɉkp~=+/,(AqJ|/V{ҫ^Zrju{] /JU3-*6yAߝŚS6sZ<∞ Oץ¡ޝo"نUi4D9>&?{]¦M+hV1QyCYr9GMVsI=3eh,/ zG==6dwxjǧv?ny9V<7UnMz1c֟ ǪNhrs~x’0${UlR>S}i &sdko#~z߻μSyg^~5q]hOm䵕4zh}δ:Wk֟|x]5 1o{ ih.O?un_{]s]s~|.h{Z'_c{ϋsyWi{mv>_'Yㅶ[9{;r8{:Z|v.OkcG>֦~/:ϷŒ5]1s}޴i¥xݧtևy5Zv۸[kH3K#mO*#:fǘ-lfG`aklsۻ/vo0;/ukŅ~]/[8oǺ!~E6mvB;6m!^kWk\.h}{Or^Z)vcuVLVv,[w׻ݩ>kq=kcBK Nͣ̓ץe,?n5GTPӷ.>7Œ6V;^w+8t}?:':\ܟm=p_h ufڵuֱvR?m:#e ='w*x}h>=A8\Ky͡An/…>]]:ڵ㲱c䅩huks]iY/>5[;gwm?:4=)jtsQFI+TuioKc幞v|<vK]90Su#y pzo--q]ssnqkwZ¢e'};ֻ(6:nq^ {GŜi$d7. un琺gc6i9?Eo>wwe,k|-γ{1]8_\GK'$ii߯UujTkCgg='] c5k5۴m;n;g>؝}\s=i9ж>:y_Rm oב/+R^yup^q۹NE=jO7Մv8:kϡ۹88ȵ^:*5ՆZ]˺<ѧkGl_r]p~~.)&x庳՗rq&hZ8pN=ߺu5?S.v~)o׶kiy/G۝ .\|s%\"ml0 k^U[wvu5i'o*xlp \=uvNk=PVvv9os>g̯msj?8ߎ9U0Eu\o}|0H_=+lzx9iYϷ1|.=_wi9Qs'Ϟ [}y~:l>iZ{oZsl>;/-kAs~{/eaI;J{S~3*aG;fZܮ47C5t<uwI6sN9GXp=j>.{Fb{m}r,z-{!::#=vms-.=_߮uv~!_zj翞 x,uk^_y6C~=\שPOvFk ާun[{n3u kٞoxT{ksy)ֵd]}}]5gir|NZ}Nk30q99]ڸw^/m;|Rhȟ^?k/-ssN W||k[6P7uT5nk[9<kǺ=1Fghi=B8h}%~>n}8y >Qڳh^ _<l+??5w98g<|*rX#qCv/DŰN_g㚼/z9e,?5kܗ+v] gTI׏oY~>@t҆/-=66b]H1z":.nz_5;seTpd*o܄%]aa'lg/=Ϥ!Ҩ1iq.T4&G|y, x'<6vJgT'Sݷ|1N}4;+5>2^>MwFůtX*1v#1_5ߛpJ=iY(qgEGBŃч43ǫiYIE[^5H7R6U^q߉aR\SG'.ϛ>{1!eMxW*qX֓{>[cҷŵƽυˤw8Tq hIHAhҹc==ʍCخSg暟8SK6b^GS\&*kh_k‡rėR'=JTy#-c0_s7?x1楸PܣP]k<}?w4[?:H*cc N9nL{Ri>}Jαa~ja;դOۜuqIose=Z箸Sq_31Wa`BxwW'a~#l5< O1h*TM\BjN%vH[P*$=䗍6~|<<)9HTm3Tr1Ͽ9]_?}:h/[cc^OM(\^´x)3<ǫéhIaGS/<&ss}~>8GR~K{cS)߻SgW~[[TF:|aROPηx2DQ{GOr*{ᛧc͹ߟu}5dn"d?}7 ==#;Q,#|E w~6weA?fkMX|8R(}߈^9)O{I})Tx)Tki9ɘJl@*נ7j_H5'L*yNq[COom^1<ħrG99F*z\>VxQ]%luܮU=jM{8_u##lKSO?TjcaKi6D\/OՈ_Z*dOY^cq0k},|InI⁾?JNT4xM#<)z|l*A;SʛTkY^M%jT8]®Kee;qڻV7qR|5`M}_H/ļ?+[_ [>i)7iTqG~y&sEP{J}OEJEWċw2^JeR>/߭fi;€x-kPFϟ 8:6?λbN ۾Jno^uTtTJYģ䳺Fcc勩A=sx2zQ@O%Png&Dkug{`q.T򴏐+ةcz ^<`y{M*F*{Zϱ⯚41fbKi+mEy HW:Dߧf\~(}ϛ}?4pZ֩}U9jN~囹;b^7D.Z">űSѯϤ󗭏weW>oՋ߲h|ۡX#v4F}iN ?4h Wݫg7;hn#z9TZoN%O~w*S~rc;¶o#w+.O[Tr=W ys@*yCZ\W~WFL'S۴TO}#_g-Rf/&u'"SzFUkT)_P?6zo*Je"TϏ›[RW'|\1h*>hcw T8T*u^>cbΓ6 Y*}yTrT\UWP]-bcjO[uYH\5ݩ䗯󜿞3$˩ioSW>ՉJTlTj+݃/Me#=qK<ѳ%د}K*,_:ї!x9w,||* 8; SmB*D(^'ﯦgyG3=SpT8gT<~wݔek7s#qϯ؉>TJS㩼=OĜs;9cx*5E^W w;/HZRyMU!=dWm:~:}QR*SyoQr_\ggҤS1^H%*ҳE/H%G}~l*->Qww:"sTþt*]PkCZp"z*Un!\v~%:N ܛqgʅ9ݩcևu=3{;zNxo>JhJ_NrRx(>>T||1.e|0|uTCx^yΥ}c=9cI{汑_~)S3HE1Kq'T!?_*T!JOqM%SG9u8w4ϫ36ͭoǘoJ%>暏3{1 Ѹl}[Mv6;c>oJh>>v88 5b.7}G 0w4~LaL]YƘ0d}[JHXsC1CqL\fv}n[фmqLsU us4ح/߾/|_󜯌n{v[o9ȯS|Oo^xO=S/1|XH987eqm1'aC=[Q:h*(ɖZ!vݭnnHO:u]Qu\p\ ~-KEw*IE[:L~+icf̾=\fx:{&jGR(\vY\my(q*X?5&-qJ犹GSJk;Ѳ? 74tJ} TCS|[2bն;ҷS)9m!澞i*P*פ)SMZO%d[:GnMΉTℰr(&`*1_;ScfcRPr}*|&Խ;rݔh>ʑnNe/PyM1WpHsxWH:&U.+lJsIRvTMTcצ¯l,W5 ̷51l:׿CA< /믋{+?hv?H%nSUџ#\h_:+^IgWqǔ]HqHxk*VnŃo6JE7RȉTbͽ6veI9TtS*w3s/u?IEu}^oϝ5)ٮﲭT?wCjzi֦)]J S+y28SMk=n^uͽѿOijO:IݮN!4{~_6_ʿ+P|R?9ҍqD*ژFTֿ}ym;]_M% rRKT~ o;_lߝaCp]#.ܯsE*aJW;4?_X*I>Ƽ*;=C647=T<$ 9b bE;VI%:};OؘwMyA;7sraPW-t]xHS?3]5Rps[p{{1g?imsKNj촇'IMtXZ1{Oac]m*.(x)>WA' |gZCjN<_> €aǗ~J%ݰ~[!Q|CP1IjYJ/e;pl ',kb=˜b}m*|)ly}*@*8P~T̕˾|?TE±}0Pv8b>O>ʞ iY[t9:š)GpP?djn|SZps4X)N'>wnW*Oˍq\S!'r$*8@*{?}8Mz5F*x*\P*Tj-'ݟ(GQ,;JFi/qTݟ&>)]\zr:VS/io*}骴Ec`PQޯr.9°r ,Ѽas8X˟S@gzž_??wekވ2RiiNq8=Pux%oI0@W▰ݛ 76}Yl#َkJeoC]Ga%p@O}Mߺ]' $̶V`iٞFyxncylxqu•ty+>)vn>S1Q5jl{S25}ߗJr0ب"qUkݲAUkS.;yͤkBաUa}YɮӜ9U5rXwl+yI\KʭK9%9m%۸O?']KN֮oZGZ/\j})\#ՁU8`c9_}5ka~'i5bĕiy_B}?sOA|r=h>-Xœxqݓ3iM/繫%[z=t#<W ڝfƺfoZ?{kNTCTj'E5c\o^c.J߮G…z_kֵʋ3]c uX1ho}*K}O6rjqu:OA;Է4_\T9_nxV5?Y^K¥%ξs7M;&ojh0ϟOqWkNǡw8u<I/Vߋt߈׾_U_x9ngINӵcbKS#}X끴pKvn>=~{,˶CA}_LLܮќ/K/<yCZQ۾Z ~L%r=]hK]m&?V\(-.k C{k٘SV{)NLޘ[v}oenglh*ڠZ|K6jsH|,, G&}ֿ0XV{ڷT /g|џi\fnn󑸢qU>E?Yu1W]o6~]Mnqڧ=ӷ?K<.k|/];U/Ɛ&N˸9`c5`MiY}EzR+_E–r/[F>hk۝ ϫƸ5yD{ڷ}7~2z김۞x.mmCVPs_ۥ]XmsWci=ow*{KcnzG?Id{?uߦ]wV6[pwbk^NM^>o=R߶B;;lG[7wwGOƚ9mH7fT&#sm5ֽx ;i(XC- ^>[Si ļ~=m7rsvlj_L8s{cG>M[ږo<㶿mSwMnb( |[6_ڜ߉~~&씹hconݿ9mݿmoX<}60}X Ǘ/Z4}K[v[ۼ+1O}9~gn=or\oo[B7>~=lm ~tk+߆uc2ܷF;s+No;+Ѱno3g[z(mT򮌝 +kVx%'?~ AJL@E آXcc+j,h&v,,bD ("(MQP3s>gy^ײ{̙r7e Xs;".q==YkG\+ǿVs9Gu%q'm'rL]^8IߗbLj/I+m}yR3y>cxkyΜl@~}גȑ7=qTx4o _^-q~$o:Bژ};=֯9Oo"ϱ]*y HgJ02+i ՙ|#m0,3|zIv񃋥mϔ2s=.))5Җw^qT³^(4_+Jisy2^v.wi6gpRkW'Jϐb($}C%$,a>.7ycqr=sҷ9yec?*LR{g}ۺImړ"FzRwɶv =Y|\–MOL_RV[nMo?Bݟ |s#ܿJy_&7O}.6'a/>\+;\ҿƒK?:Dڞzu>}wyʼ/m/J}Tz|}AşJ=)\vՁ;>^~i\-#>,s953pR~W߆]tL>]7d{w&4?0skwgW㥞:5r؏3+<Ϗ37zF|dVnƷ|9`Oϸq69s| Wzq掶ny7jFnO}p?wI;]*])η|A5&.xr]%qrǴ|Y^Lv?Krطω]ߖ?Npig߸D I߿>}ђ?וqr)E~_ܘiX>TEYNXniܷy~L.> .6IlDuo.zg\ǥyߚ1y;?9r~&q~(ezE)¶&;\<<&kv4y?8S~ۋyϵRtOJ).<~)xNA7O.7`q: >FnorxC2,tea|R˥ ڽgÓ}[v|oo+~_PRw_6ip8oʕ%_IsǑr=,5x;92 uQ^ne3ğޛy_:f]&bi7ϵsh_&7.|#Rn|Yl^|Jt} O_q|\")##ynf-i_\&yT<)Q}li;ͤ>O =/N⯟6>CDuܿE3O0x>ԏ{3&{M ~vۤw. >$i3}y&.pߖgbUxe^BmqmWKK6r[u^v_R|;N/ylpޯoᲴg2?L ɉ> 7C9m %̕_kɲG; ߎ#q[M=|b)Kp߾Oݹq|'7F^M w7?:L甼sRJ{~ҷw\'<=+ qLZWh} ۱]sp_g>M)'9?r;:Mɟna׃~뿖3pS+'rs('Iޟ"~$u?.yQR\+|]:}˥$og:=Wh?=KXyc'$o~;~ ˾ݎ GIb҆?9\y|t?$e{9Ҟ\?J.<.{r4+֗A"7N\3ų}o?F8d+m33ic۽O9鼖<﷓1L\w:pϹ~p#~k|ܷI睒/Ks;'H.:SIli.V_4u]"yo׃'O{q#{n9M`_Oam?q{\oK/IrW8|d/H>j8Jxr>&vw0NJ{׷!8%J~L{Ug_q[])>#q]L}\yo'7&c݅RvlẼWI侖s]vp'\`\Ǿ\ٹ~,d~cd"̭yqo W_%&Bλeon+ђ~Gk](Nyul|6Υ?=eskܟ6u0>;4x~j8R[K;],uqRNgK~IR?|y> 78΍?û:=M޳D|'Osmz&Rypm~彴OI.mMϟs[;;/x/8xEb&]߅"aJ#oju’e>ros'NH]$qo'g۾*z&W<\~#sOΖ6SqkkhL2_7?uM;J="u{0+Xw*񏣤gzhuD}O^u}9GI0ϐzv6M:_-վn3vu5i߫rZsNtvF{q\<կ]yѵ:.E\;U1۰\.~)>?ﲯ>ǏnmU:0;?/u}C=ONMoloH.o#'$O\'e--67Ɲ.u.Z d߶8gέ \c/J{!~sr;!uqn#H8A=+zlm_\ u̼c=&ݘ^{eQm_;UH3pZTowZ ,S?%u:'zo5^2v.Ouﮟ`7'?STJ?0gIJ:Ϸ{6q,UR3WL5gI{_"AOכ;e:g15#;bR~&q=-cƷĮ<8N)Ù~R}'frml}vT{װ|1VՖ1,C.ǔace =Rf[;&ŘXc>fW᳐k]}26."D}} mmjX ˓j߮+r/vJ]XC}kO7kXb$2ob ]#SoV8b<,s0ϩzיB?|v:byvW]74ùI a@H!wRbJ/|'dqKcT="k>kpMڎq.C<)aSY>)~Iw8 |cs2>R^lCLc;w11Oc>)N{>|X횻aR-xe=M̯w1ڰlmZT?ʔZӦ'SRyqkSk.55sWߎuh}},U8!S< &,1N,nl-F/Rl} $X;L0 OKC|dH~S2$6 }]cTRcuݔui􍩱6 i8k .6W0]\]a>]>iXo1b ),oBFfXY*aکecOS}:lg#XYbu*W_z3})jǰ/ڵb|c]uMa]s~U)OͫRiqO.X[u#SCܱzcQCt5?aAXB׿eH}]{1! %ap}ۏSyŶ |<|"JX.Եƍ.n17<V/XaYc{x6by 2}]5mLsACfGlmmKAl)IMwz},.^@lM4b5x1I75&qv]mk؜DOx/t3cC5['l 6/ ==p\}sXUo1vt0?a_iä XԼ+Ӯcs}*6ť7F]u[wک+1NÐ3>hߤ>KLjgz쫯T=mjNOùPj9l$n6){1S%k{$.8e{S{pm$]"cۤĻѦe+^r k7awmwk ln =;˵-{&=!.򮵽([,$lH~[ Ƹ<=[]<a[myݳIk ONF ˗3>_~A]xa{]ingZ/m;o5Ҭ6⋘L\9?7IdqoFvGo>Z&m{ka4d7lÖa-AY'bugއqQ[vL뽽_m[hߵ"+w{e1-?aBֆt,4bgX~o| ={ˁ0}3>cʍ2fϽw7=v˺ӎfm7~y뫛,[?ǽue3, u׈}<:j1gȰ,}pZȆv՗r۴;5 ]Y̴^b/c~ڹ]~e7ծ~;Rk0R$ m_؁i.0]roor⚥U^{-q.:Dx[jն^1aµاSmvk? p.w;Yqvx6d|g_5a\o˝*#>O/ՏEy۽yX»X^60~`|Xpظ޾ü>1p5g D=۴v{;}cvc#ۣc W>C_\^V[m_E#<úk|!yKy^jC_w-۩Ӗezrڿe~)r;Fҝn8^w8}[^p ^1}kNȷV!l66O-1{b8Ni7_yFȇ:cmmZ qkeh0w4>˿Ici^p΁XpmGv ~c8l9G-]jϥmo5ack5pXl Y'8.z>\|q#o2oT[>ߐk; rk+'yi[5EҸC\v7̲^-!Ll_KGy ~gvzo0qؚeY۹ ·[iS'|Xͦ7vLr w3Ŗ,mdﱮpߎޘvkslA>U  َG33xN'/3 Ц)xicJji |,l8 y[剥!1+p })nЦ XnXb{}l{/ Ǿ{KW0mn?G8׊Sgvle.ֳ%s ԐKa98N}yF?x>_nh'Vv/g5 Iޣ\7yz賸9KLchȮÄs}8968w/ؗ|v]pמci|0Hn{pOXF[žI~ߡ*nX n dzXtBa BP6|jS|3hYӷ S9W8?#O5#;6g ExgQ?S ,op;|oڣ݅}7<ПҬlnn7:qoݰڼ8af-[p߮?0l}]s}{ml}]߸yd.OSs~b>7Tc]̗3߄|ue'N*픽!׿b6+C_zCu84_]6~>{mJ7VW~Saby/_*cT~RWT67^?vX[W)@_X0/C+1{Tx}>>McG_n2lhY0!iwB4~/XRG,aXcco1{C jǔ!K?Ri wh]]4}]c+ӴFK߳Ta}tRi=Ȼ,<]u:LC|lh?0^Obt6I5em]xY]&v{} =ߩclu`tߕ:CH*nW~6ʎL=mY|>&F)~ I/f_;LTX~ש8ӄ)[WtJ'u>?|/|wki|44u0K?v kiڶ+2v>5ۮrg}_=M9_uFRcq N}+/}]i]P_+F|cH1>K'7/Cdžiԕ^^&CoNZD^5ߒPO 5`okܨ?v Ql-΁kL9yܑʷmYƾ92W&im봶}踰ʱ"[JoK-=o$Ms-OL̜v~9m}c1ܒ􇭱6]źghNʍ?mn{[nnio[?=!>5'>%қ&Ύv;ʱ=掃CӘ&/28:t슿%n=OSnG vTݑ5QvNsl:^kͅ5OۢG_{uͽvĵ>u9ю4;6g#kKWZ~s1d{v-1Zs4{";cG[vr/ykp[r-|u;%l)߇&{+Cyoc#/;ڱRwsS7;U^%ǎr ? uGXhoG߯lcsжMZiiÐ|m˹N7/ᐱocȺrs{sa&I,/]:}smi.n>5t)-mcZ_C|ja&lcI2>\7b7\6Sltl ]si9L; o\snuwƭylM-Ƕԏe#_fSۖeulMc\[bsiGٶ:pJ}_yG؟a;!kmulη!z߈8vnuߴim~4$o-fG䶲i)n#cG'[{l[~^`KMNcgS,e,[z}=g=l^|dK}{u\O{ p{W>.?||]/vfy_kܞ7~oJ=ֿ[~?ڣl?Kslol>oanf%Οw|>S=W*׫z۱m$sZkRW; {/r%?ϖ}z-lcl';_66f;o ܞ?aV/'=w3Iƙ{rC~A6O?}uk|i|]-ا>qs$v?,?i;Eyfѿ[X;Kܞϱ}Z[V6w:X{F>}}ϥxi}sOhnҧ~,mIC&hՇqyVs/ri*.8m~Vϴ+{ںZhOMkE~?>-C%eª#gǾhMe }y|<՞_~AX lZ=ȞJe]bNt칶ǧbmLeʜ<‡NlZGyƞ}n˶X%ɳoHl6IYlYa}8[$ ?(u\ǿ؏k~tlֱ}'I?wqelZ.}c*svFKP`}bt^ _9n3[:y;$?zx-uב`/xyi9|K/˭H\]~קz[[yUO=B-i,c?~$u}tُywK(yg|q>b_~wr|=bJw 3~%KRt_.];9n$a;g` do8>0<݄6s?sNwnA/:YN,۱}mLmtN|sgz?]}OgΖguل/\ܿGq8 k ;hٞ6ce.Hg˸x{ z9,^#_#9K$/_-|d}hy_,]_,< b{"_ mx̾={ʪ<.?׈rx̰|g,[ϼ`Vp>@z)^z?3϶af- O]ضc[(9<~}ÞG<?蛙ɗgtߜƪ+2ۘ-Wy>|=o޷Y7Ɉ>==I6ǿvbd~΍*ost0a]Xdb4?w)7)lH[Eڎpf ,,O8Fz&^rY{x#-֯gJm:켗wړ. ;ARf{?W /+o^o& `ٰrH,upb7M\ٟvkWܟ?\\yvurl˷dbČs%h?9;=Ƴ|^`6Tj}w~QڛFwKr~3r:35c#ri~rro-^+yE¾c6_%;皵;/kP^/-X-=҇~>gO%kDg+{W|X;\}J6{=|vzDži{g>Na+{|y}͒;c۟6=]{G8oE1msƕ>%?|. =(߭~՗q/_"/ ymc>SYz7Yu ⏟ag۾%/$v=ҧ桇˳OJgm%o?o&a??<{=w_+i덿;Swo!koW7vHno)v^;u#?ì_gؿ{vMɎkvdh[W{sߋړLʽArmI+if^W*qxoen-?lڛxޮ#?.s]Rsa7*{nksWuڙ}q[Ourڵ&;.  `~woo|l:z͎˖ {]仄.u&;'Y<5?yؚn gDv],vٰ+&˶5{movʹ_/,hC:9\dͲuΎ}wߞ(u7-^I۶-+N_\nm'񷤧INQu{W/-Gc庫Ml\>g.ŷrI~%v_k;H\~/%[~x+|u[nzn3Џ~7c5v~lv7+9 r:2Vps[6;-mڝ}l-~_9|򚰽w|W}oRwNzf̱jӟ=˥՝23? zYh3)s՞{*׋}G'۸{vv 9gކY|ع\oa?]vV|?Xxul-pqrcdYt7s#חjM+}Aillf*ycʲO%M6I>.usA 1`r~vmjֳŘvo58Wmp_R^>k^^K\%u5?%ua>.ğxkPom}׏=ܵ b>Mo/sn47&:#[œ}p>.ytZTy$Qykp6?t{v^;s:^񞽝N!G#{$13x={@v]F܀}|Xf?$=P?l\~ i:w$)މ}ϐu6]yc%UB0ؿ\/a]v?PʷK{8廠7J냥}+~Ab^k[_m{sn;3gl}b֖y>e%.[-)|x듹{:R?G|/}S}0ד,sݟ#e={y>>{NYt~ gڞOmC7q-8y sOl#[axK*YnYatyo\{GG3ۗwRD]|[-'r9\gw}w{nr>_ =Ds*q#e{\qū|ܷ}]Յͽͳ3{iԣ|JH·C~;ُ >O؝켎;?&ϸ`ןG'Ň{^ī0}\y>r]7['\yXfߗuOeC^2:Ӱke;^0>xmtkMY53URI<_gѭ.8ǿXỲ5WZƝ}y\f[S^oTRa,/!+3\,fkH´F_5]cCǁӧп}Ui˻9S~26.C}H m ]iL~ߐ4=LOۖ]v;ԏlu(W.z a|}Rχ}1ci m!!Lbk#ycL [t i8ClCU.4J'|WC;/ސwm,NCRig [r2ZCz bχ4mN4i7i=e#'6¦cKRuWo2ͧ-UcsƭgNúlO7r m!}Pwݨ0Lm~UQxC 7d,ۜc S+!>ӗ]i4}w#m< C4~(cس!MCn/m bcH>[掍]Wce'ϔvRcv=oyLRCJ+/N}v]|>1c#R>W!yXX!ǴC3N_ʭ!g_N/SR6loNgôqOapCJ7ca4y>^«?4Tؾ6F,CwhLJa䵯et*&]vRQW0?vCiwWfZ9i;>ߕ4K%{1?ס}6UGO^Lp٘i e/49MӦ?4#}6ەF1m{RҜ|ӄ=FƔTMgmG؇bdpO}~O}Ӟ9'=or_xӟI'=g9O~^0yg< ^ڈO) _8tmf$SwR jE7ޘ&oolonoΎ܍'w43|rWL]5'w4A4A4A4A4AfbLl 3a&6Ć0fbLlF>OlF>OlF1QLlF1QLlF1QLlF9QNlF9QNln0[MlTF5QMlTF5QMlTF=QOlF=QOlF=Ll4F3Ll4F3Ll4>XoIoz[mzjmjmjmjmjmHZ#Fj5RkHZ3jͨ5֌Z3jͨ5֌Z3jͨ\j-WkZZr\jPkZ+Z VBjPkZ+ZJVRjTkZ+Z*VJUjRkZZ*VZjVkZZjVZjQkZkZ֨F5jQkR%,!e )KHYBR%,!e )KHYBR%,!e )KHYBR%,!e )KHYBR%,!e )KHYBR%,!e )KHYBR%,!e )KHYBR%,!e )KHYBR%,!e )KHYBR%,!e )KHYBR%,!e )KHYBR%,!e )KHYBR%,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,ɕ%$Wʒ\Y+KreI,ɕ%$Wʒ\Y+KreI,ɕ%$Wʒ\Y+KreI,ɕ%$Wʒ\Y+KreI,ɕ%$Wʒ\Y+KreI,ɕ%$Wʒ\Y+KreI,ɕ%$Wʒ\Y+KreI,ɕ%$Wʒ\Y+KreI,ɕ%$Wʒ\Y+KreI,ɕ%$Wʒ\Y+KreI,ɕ%$Wʒ\Y+KreI,ɕ%$Wʒ\Y+KreI,ɕ%$WʒBYR(K eI,)%PʒBYR(K eI,)%PʒBYR(K eI,)%PʒBYR(K eI,)%PʒBYR(K eI,)%PʒBYR(K eI,)%PʒBYR(K eI,)%PʒBYR(K eI,)%PʒBYR(K eI,)%PʒBYR(K eI,)%PʒBYR(K eI,)%PʒBYR(K eI,)%PʒBYR(K eI,)%TʒRYR*KJeI,)%TʒRYR*KJeI,)%TʒRYR*KJeI,)%TʒRYR*KJeI,)%TʒRYR*KJeI,)%TʒRYR*KJeI,)%TʒRYR*KJeI,)%TʒRYR*KJeI,)%TʒRYR*KJeI,)%TʒRYR*KJeI,)%TʒRYR*KJeI,)%TʒRYR*KJeI,)%TʒJYR)K*eI,%RTʒJYR)K*eI,%RTʒJYR)K*eI,%RTʒJYR)K*eI,%RTʒJYR)K*eI,%RTʒJYR)K*eI,%RTʒJYR)K*eI,%RTʒJYR)K*eI,%RTʒJYR)K*eI,%RTʒJYR)K*eI,%RTʒJYR)K*eI,%RTʒJYR)K*eI,%RTʒJYR)K*eI,%VʒZYR+KjeI,%VʒZYR+KjeI,%VʒZYR+KjeI,%VʒZYR+KjeI,%VʒZYR+KjeI,%VʒZYR+KjeI,%VʒZYR+KjeI,%VʒZYR+KjeI,%VʒZYR+KjeI,%VʒZYR+KjeI,%VʒZYR+KjeI,%VʒZYR+KjeI,%VʒFY(KeI,i%Q4ʒFY(KeI,i%Q4ʒFY(KeI,i%Q4ʒFY(KeI,i%Q4ʒFY(KeI,i%Q4ʒFY(KeI,i%Q4ʒFY(KeI,i%Q4ʒFY(KeI,i%Q4ʒFY(KeI,i%Q4ʒFY(KeI,i%Q4ʒFY(KeI,i%Q4ʒFY(KeI,i%Q4ʒFY(KeI3ax L~ s/྄ kc;c;c;c;c;v %K`.]v kkknvs`79nvs[`-nv [`%-n vK[`حnv+[ V`حn vk[`5حn vkۀ6` mnvۀ]x5^Wcx5^Wcx5^Wcx5^Wcx5^Wcx5^Wcx5^Wcx5^Wcx5^Wcx5^Wcx5^Wcx5^Wcx5^Wcx5^Wcx5^Wcx5^Wcx5^Wcx5^Wcx5^Wcx5^Wcx5^Wcx5^Wcx5^Wcx5^Wcx5^WcxE+^W"xE+^W"xE+^W"xE+^W"xE+^W"xE+^W"xE+^W"xE+^W"xE+^W"xE+^W"xE+^W"xE+^W"xE+^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^xrUʁW9*^xrUʁW9*^xrUʁW9*^xrUʁW9*^xrUʁW9*^xrUʁW9*^xrUʁW9*^xrUʁW9*^xrUʁW9*^xrUʁW9*^xrUʁW9*^xrUʁW9*^xrU*W^xU U*W^xU U*W^xU U*W^xU U*W^xU U*W^xU U*W^xU U*W^xU U*W^xU U*W^xU U*W^xU U*W^xU U*W^xUJU *W%^xUJU *W%^xUJU *W%^xUJU *W%^xUJU *W%^xUJU *W%^xUJU *W%^xUJU *W%^xUJU *W%^xUJU *W%^xUJU *W%^xUJU *W%^xUJUW^U xU*UW^U xU*UW^U xU*UW^U xU*UW^U xU*UW^U xU*UW^U xU*UW^U xU*UW^U xU*UW^U xU*UW^U xU*UW^U xU*UW^xUjU W5^xUjU W5^xUjU W5^xUjU W5^xUjU W5^xUjU W5^xUjU W5^xUjU W5^xUjU W5^xUjU W5^xUjU W5^xUjU W5^xUjUjW ^5xUjW ^5xUjW ^5xUjW ^5xUjW ^5xUjW ^5xUjW ^5xUjW ^5xUjW ^5xUjW ^5xUjW ^5xUjW ^5xUjW v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з v};@No'з ۳GCepitools/R/0000755000176200001440000000000013174424211012310 5ustar liggesusersepitools/R/as.week.R0000644000176200001440000001113113174424211013765 0ustar liggesusers"as.week" <- function(x, format = "%Y-%m-%d", min.date, max.date, before = 7, after = 7, origin = as.Date("1970-01-01"), sunday = TRUE){ if(sunday) { firstday <- "Sunday" fday <- "%U" } else { firstday <- "Monday" fday <- "%W" } dates <- as.Date(x, format = format) names(dates) <- as.character(dates) wday <- as.POSIXlt(dates)$wday jul <- julian(dates, origin = origin) week <- format(dates, format = fday) stratum <- jul if(firstday=="Sunday"){ stratum[wday==0 & !is.na(wday)] <- jul[wday==0 & !is.na(wday)]+3 stratum[wday==1 & !is.na(wday)] <- jul[wday==1 & !is.na(wday)]+2 stratum[wday==2 & !is.na(wday)] <- jul[wday==2 & !is.na(wday)]+1 stratum[wday==4 & !is.na(wday)] <- jul[wday==4 & !is.na(wday)]-1 stratum[wday==5 & !is.na(wday)] <- jul[wday==5 & !is.na(wday)]-2 stratum[wday==6 & !is.na(wday)] <- jul[wday==6 & !is.na(wday)]-3 } if(firstday=="Monday"){ stratum[wday==1 & !is.na(wday)] <- jul[wday==1 & !is.na(wday)]+3 stratum[wday==2 & !is.na(wday)] <- jul[wday==2 & !is.na(wday)]+2 stratum[wday==3 & !is.na(wday)] <- jul[wday==3 & !is.na(wday)]+1 stratum[wday==5 & !is.na(wday)] <- jul[wday==5 & !is.na(wday)]-1 stratum[wday==6 & !is.na(wday)] <- jul[wday==6 & !is.na(wday)]-2 stratum[wday==0 & !is.na(wday)] <- jul[wday==0 & !is.na(wday)]-3 } if(missing(min.date)) {min.date <- min(dates, na.rm=TRUE) - before} if(missing(max.date)) {max.date <- max(dates, na.rm=TRUE) + after} mindate <- as.Date(min.date) mdtest <- c(as.POSIXlt(mindate)$mon[1], as.POSIXlt(mindate)$mday[1]) if(mdtest[1]==0 && mdtest[2]<7){ mindate <- mindate - 7 } cdates <- seq(mindate, as.Date(max.date), by = 1) names(cdates) <- as.character(cdates) cweek <- cweek2 <- format(cdates, format = fday) names(cweek2) <- names(cdates) for(i in 1:length(cweek)){ if(cweek2[i]=="00"){cweek2[i] <- cweek2[i-1]} } if(mdtest[1]==0 && mdtest[2]<7){ cdates <- cdates[-c(1:7)] cweek <- cweek[-c(1:7)] cweek2 <- cweek2[-c(1:7)] } week2 <- cweek2[names(dates)] cwday <- as.POSIXlt(cdates)$wday cjul <- julian(cdates, origin = origin) cstratum <- cjul if(firstday=="Sunday"){ cstratum[cwday==0 & !is.na(cwday)] <- cjul[cwday==0 & !is.na(cwday)]+3 cstratum[cwday==1 & !is.na(cwday)] <- cjul[cwday==1 & !is.na(cwday)]+2 cstratum[cwday==2 & !is.na(cwday)] <- cjul[cwday==2 & !is.na(cwday)]+1 cstratum[cwday==4 & !is.na(cwday)] <- cjul[cwday==4 & !is.na(cwday)]-1 cstratum[cwday==5 & !is.na(cwday)] <- cjul[cwday==5 & !is.na(cwday)]-2 cstratum[cwday==6 & !is.na(cwday)] <- cjul[cwday==6 & !is.na(cwday)]-3 } if(firstday=="Monday"){ cstratum[cwday==1 & !is.na(cwday)] <- cjul[cwday==1 & !is.na(cwday)]+3 cstratum[cwday==2 & !is.na(cwday)] <- cjul[cwday==2 & !is.na(cwday)]+2 cstratum[cwday==3 & !is.na(cwday)] <- cjul[cwday==3 & !is.na(cwday)]+1 cstratum[cwday==5 & !is.na(cwday)] <- cjul[cwday==5 & !is.na(cwday)]-1 cstratum[cwday==6 & !is.na(cwday)] <- cjul[cwday==6 & !is.na(cwday)]-2 cstratum[cwday==0 & !is.na(cwday)] <- cjul[cwday==0 & !is.na(cwday)]-3 } repeated <- function(x){ lx <- length(x) y <- rep(FALSE, lx) for (i in 2:lx){ if(x[i]==x[i-1]){ y[i] <- TRUE } } y } cweek <- cweek2[!repeated(cweek2)] cstratum <- cstratum[!repeated(cstratum)] attr(cstratum, "origin") <- origin stratum <- unname(stratum) cstratum <- unname(cstratum) stratum2 <- factor(stratum, levels = cstratum) julian2date <- function(x){ orig <- as.Date(attributes(x)[[1]]) jorig <- as.numeric(orig) seqdates <- seq(from=orig,to=orig+max(x, na.rm=TRUE),by=1) seqjulian <- seq(from=jorig,to=jorig+max(x, na.rm=TRUE),by=1) seqdates[x+1] } stratum3 <- julian2date(stratum) cstratum2 <- julian2date(cstratum) cmday <- as.numeric(format(cstratum2, format = "%d")) cmonth <- format(cstratum2, format = "%b") cyear <- format(cstratum2, format = "%Y") list(dates = unname(dates), firstday = firstday, week = unname(week2), stratum = stratum, stratum2 = stratum2, stratum3 = stratum3, cweek = unname(cweek), cstratum = cstratum, cstratum2 = cstratum2, cmday = cmday, cmonth = cmonth, cyear = cyear ) } epitools/R/rate2by2.test.R0000644000176200001440000000261713174424211015051 0ustar liggesusers"rate2by2.test" <- function(x, y = NULL, rr = 1, rev = c("neither", "rows", "columns", "both") ){ if(is.matrix(x) && !is.null(y)){stop("y argument should be NULL")} if(is.null(y)){ x <- ratetable(x, rev = rev) } else { xn <- substitute(x) yn <- substitute(y) x <- ratetable(x, y, rev = rev) colnames(x) <- c(xn, yn) } tmx <- table.margins(x)[,-3] nr <- nrow(x) p.value <- matrix(NA, nr, 2) for(i in 2:nr){ aa <- x[i,1]; bb <- x[1,1]; pt1 <- x[i,2]; pt0 <- x[1,2] pt <- pt0 + pt1 mm <- aa + bb s <- rr*pt1/(rr*pt1 + pt0) p.lower <- dbinom(aa, mm, s)/2 + pbinom(aa-1, mm, s) p.upper <- 1 - p.lower pval1 <- min(p.lower, p.upper) pval2 <- 2*pval1 ##Score p value num <- aa - (pt1/pt)*mm dem <- sqrt(mm*(pt1/pt)*(pt0/pt)) zval <- num/dem chi2 <- (num/dem)^2 pv <- 1-pnorm(abs(zval)) pv2 <- 1-pchisq(chi2, df=1) p.value[i,] <- c(pval2, pv2) } colnames(p.value) <- c("midp.exact", "wald") rownames(p.value) <- rownames(x) if(is.null(names(dimnames(x)))){ names(dimnames(p.value)) <- c("Predictor", "Outcome") } if(!is.null(names(dimnames(x)))){ names(dimnames(p.value)) <- c(names(dimnames(x))[1], "two-sided") } if(rr!=1) {p.value <- p.value[,"midp.exact"]} rrl <- list(x = x, p.value = p.value ) rrl } epitools/R/epidate.R0000644000176200001440000000360613174424211014053 0ustar liggesusers##in projgress "epidate" <- function(x, format = "%m/%d/%Y", cal.dates = FALSE, before = 7, after = 7, sunday = TRUE){ dates <- as.Date(x, format = format) julian <- julian(dates) posixlt <- as.POSIXlt(dates) mday <- posixlt$mday ##1-31: day of the month mon <- posixlt$mon ##0-11: months after the first of the year. month <- months(dates) ##January, February, .... month2 <- substr(month, 1, 3) ##Jan, Feb, ... if(sunday){ week <- format(dates, format = "%U") ##0 1 2 3 ... 51 52 53 firstday <- "Sunday" } else { week <- format(dates, format = "%W") firstday <- "Monday" } names(firstday) <- "1st day of week for $week number:" year <- posixlt$year + 1900 ##Years0 yr <- substr(as.character(year), 3, 4) wday <- posixlt$wday ##0-6 day of the week, starting on Sunday. weekday <- weekdays(dates) ##Sunday Monday Tuesday wkday <- substr(weekday, 1, 3) ##Sun Mon Tue yday <- posixlt$yday ##0-365: day of the year quarter <- quarters(dates) if(cal.dates==TRUE){ cdates <- seq(from = min(dates, na.rm = TRUE) - before, to = max(dates, na.rm = TRUE) + after, by = 1) cjulian <- julian(cdates) } else { cdates <- "Not reported: To report, set cal.dates=TRUE" cjulian <- "Not reported: To report, set cal.dates=TRUE" } list(dates = dates, julian = julian, mday = mday, mon = mon, month = month, month2 = month2, firstday = firstday, week = week, year = year, yr = yr, wday = wday, weekday = weekday, wkday = wkday, yday = yday, quarter = quarter, cdates = cdates, cjulian = cjulian ) } epitools/R/ageadjust.direct.R0000644000176200001440000000162213174424211015654 0ustar liggesusers"ageadjust.direct" <- function (count, pop, rate = NULL, stdpop, conf.level = 0.95) { if (missing(count) == TRUE & !missing(pop) == TRUE & is.null(rate) == TRUE) count <- rate * pop if (missing(pop) == TRUE & !missing(count) == TRUE & is.null(rate) == TRUE) pop <- count/rate if (is.null(rate) == TRUE & !missing(count) == TRUE & !missing(pop) == TRUE) rate <- count/pop alpha <- 1 - conf.level cruderate <- sum(count)/sum(pop) stdwt <- stdpop/sum(stdpop) dsr <- sum(stdwt * rate) dsr.var <- sum((stdwt^2) * (count/pop^2)) wm<- max(stdwt/pop) gamma.lci <- qgamma(alpha/2, shape = (dsr^2)/dsr.var, scale = dsr.var/dsr) gamma.uci <- qgamma(1 - alpha/2, shape = ((dsr+wm)^2)/(dsr.var+wm^2), scale = (dsr.var+wm^2)/(dsr+wm)) c(crude.rate = cruderate, adj.rate = dsr, lci = gamma.lci, uci = gamma.uci) } epitools/R/epicurve.dates.R0000644000176200001440000000314513174424211015357 0ustar liggesusers"epicurve.dates" <- function(x, format = "%Y-%m-%d", strata = NULL, min.date, max.date, before = 7, after = 7, width = 1, space = 0, tick = TRUE, tick.offset = 0.5, segments = FALSE, ...){ dates0 <- as.Date(x, format = format) if(missing(min.date)){ min.date <- min(dates0, na.rm=TRUE) - before } if(missing(max.date)){ max.date <- max(dates0, na.rm=TRUE) + after } cdates <- seq(min.date, max.date, by = 1) dates <- factor(dates0, levels = cdates) if(is.null(strata)){ dat <- t(as.matrix(table(dates))) } else { dat <- t(table(dates, strata)) } xvals <- barplot(dat, width=width, space=space, ...) if(tick){ axis(1, at=c(0, xvals + tick.offset), labels=FALSE, tick=TRUE) } if(segments){ x <- xvals-(width/2) y2 <- apply(dat,2,sum) xy2 <- cbind(x,y2) y0 <- cbind(xy2[1,1],0:xy2[1,2]) z0 <- cbind(y0, y0[,1]+width, y0[,2]) for(i in 2:nrow(xy2)){ yy <- cbind(xy2[i,1],0:xy2[i,2]) z <- cbind(yy, yy[,1]+width, yy[,2]) z2 <- rbind(z0,z) z0 <- z2 } segments(z0[,1],z0[,2],z0[,3],z0[,4]) } cmday <- as.numeric(format(cdates, format = "%d")) cmonth <- format(cdates, format = "%b") cyear <- format(cdates, format = "%Y") rr <- list(dates = dates0, dates2 = dates, xvals = xvals, cdates = cdates, cmday = cmday, cmonth = cmonth, cyear = cyear ) invisible(rr) } epitools/R/probratio.r0000644000176200001440000001005713174424211014477 0ustar liggesusersprobratio <- function(object, parm, subset, method=c('ML', 'delta', 'bootstrap'), scale=c('linear', 'log'), level=0.95, seed, NREPS=100, ...) { if (length(match('glm', class(object))) < 0) stop('Non GLM input to "object"') if (family(object)$family != 'binomial') stop('object not a logistic regression model') nc <- length(cf <- coef(object)) if (missing(subset)) subset <- T if (missing(parm)) parm <- seq(2, nc) cf <- cf[parm] method <- match.arg(method, c('ML', 'delta', 'bootstrap')) scale <- match.arg(scale, c('linear', 'log')) if (is.na(scale)) stop('scale cannot take values outside of linear or log') if (scale == 'linear') { f <- function(x) x[2]/x[1] name <- c('Relative risk') null <- 1 } else { name <- c('Log relative risk') null <- 0 f <- function(x)log(x[2]) - log(x[1]) } cilevel <- c({1-level}/2, 1-{1-level}/2) ciname <- paste0(c('Lower', 'Upper'), ' ', formatC(100*cilevel, format='f', digits=1), '% CI') if (method == 'ML') { newfit <- glm(object, family=binomial(link=log), subset=subset, ...) out <- coef(summary(newfit))[parm, , drop=F] if (scale == 'log') { out <- cbind(out[, 1], out[, 2], out[, 3], out[, 4], out[, 1] + qnorm((1-level)/2)*out[, 2], out[, 1] + qnorm(1-(1-level)/2)*out[, 2]) } else { val <- exp(out[, 1]) se <- val * out[, 2] out <- cbind(val, se, z <- abs(val-1)/se, pnorm(z, lower.tail = F)*2, val + qnorm((1-level)/2)*se, val + qnorm(1-(1-level)/2)*se) } colnames(out) <- c(name, 'Std. Error', 'Z-value', 'p-value', ciname) return(out) } Mod1 <- Mod0 <- model.matrix(object)[subset, ] n <- nrow(Mod0) Nvec <- matrix(rep(c(1/n,0,0,1/n),each=n), n*2, 2) if (method == 'delta') { if (scale == 'linear') { df <- deriv( ~y/x, c('x', 'y')) } else { df <- deriv(~log(y) - log(x), c('x', 'y')) } out <- sapply(parm, function(p) { Mod0[, p] <- 0 Mod1[, p] <- 1 Mod <- rbind(Mod0, Mod1) allpreds <- family(object)$linkinv(Mod %*% coef(object)) avgpreds <- t(Nvec)%*% allpreds val <- f(avgpreds) V <- sweep(chol(vcov(object)) %*% t(Mod), allpreds*(1-allpreds), '*', MARGIN = 2) %*% Nvec V <- t(V)%*%V dxdy <- matrix(attr(eval(df, list('x'=avgpreds[1], 'y'=avgpreds[2])), 'gradient')) se <- sqrt(t(dxdy)%*%V%*%dxdy) out <- c(val, se, z <- abs({val-null}/se), pnorm(z, lower.tail=F)*2, val + qnorm(cilevel[1])*se, val + qnorm(cilevel[2])*se) names(out) <- c(name, 'Std. Error', 'Z-value', 'p-value', ciname) out }) out <- t(out) rownames(out) <- names(cf) return(out) } ## endif delta if (method == 'bootstrap') { if (missing(seed)) stop('seed must be supplied by the user when obtaining results from random number generation') set.seed(seed) out <- replicate(NREPS, { index <- sample(1:n, n, replace=T) Mod <- model.matrix(object)[subset, ][index, ] newbeta <- glm.fit(Mod, object$y[index], family=binomial())$coef out <- sapply(parm, function(p) { Mod1 <- Mod0 <- Mod Mod1[, p] <- 1 Mod0[, p] <- 0 Mod <- rbind(Mod0, Mod1) newpreds <- family(object)$linkinv(Mod %*% newbeta) f(t(Nvec) %*% newpreds) }) out }) if (length(parm) == 1) { out <- c(val <- mean(out), se <- sd(out), z <- abs({val - null}/se), pnorm(z, lower.tail = F)*2, val + qnorm((1-level)/2)*se, val + qnorm(1-(1-level)/2)*se) names(out) <- c(name, 'Std. Error', 'Z-value', 'p-value', ciname) } else { out <- cbind(val <- rowMeans(out), se <- apply(out, 1, sd), z <- abs({val - null}/se), pnorm(z, lower.tail = F)*2, val + qnorm(cilevel[1])*se, val + qnorm(cilevel[2])*se) colnames(out) <- c(name, 'Std. Error', 'Z-value', 'p-value', ciname) rownames(out) <- names(cf) } return(out) } } epitools/R/colors.matrix.R0000644000176200001440000000014413174424211015236 0ustar liggesusers"colors.matrix" <- function(){ x <- matrix(c(colors(),NA,NA,NA), 30, 22) invisible(x) } epitools/R/pois.daly.R0000644000176200001440000000156013174424211014337 0ustar liggesusers"pois.daly" <- function(x, pt = 1, conf.level = 0.95){ xc <- cbind(x,conf.level,pt) pt2 <- xc[,3] results <- matrix(NA,nrow(xc),6) cipois <- function(x, conf.level = 0.95){ if(x!=0){ LL <- qgamma((1 - conf.level)/2, x) UL <- qgamma((1 + conf.level)/2, x + 1) } else { if(x==0){ LL <- 0 UL <- -log(1 - conf.level) } } data.frame(x = x, lower = LL, upper = UL) } for(i in 1:nrow(xc)){ alp <- 1-xc[i,2] daly <- cipois(x = xc[i, 1], conf.level = xc[i, 2]) LCL <- daly$lower/pt2[i] UCL <- daly$upper/pt2[i] results[i,] <- c(xc[i,1],pt2[i],xc[i,1]/pt2[i],LCL,UCL,xc[i,2]) } coln <- c("x","pt","rate","lower","upper","conf.level") colnames(results) <- coln data.frame(results) } epitools/R/pois.exact.R0000644000176200001440000000144213174424211014511 0ustar liggesusers"pois.exact" <- function(x, pt = 1, conf.level = 0.95){ ## x = Poisson count ## pt = person time ##updated 2004-11-29 xc <- cbind(x,conf.level,pt) pt2 <- xc[,3] results <- matrix(NA,nrow(xc),6) f1 <- function(x,ans,alpha=alp) {ppois(x,ans)-alpha/2} f2 <- function(x,ans,alpha=alp) 1-ppois(x,ans)+dpois(x,ans)-alpha/2 for(i in 1:nrow(xc)){ alp <- 1-xc[i,2] interval <- c(0,xc[i,1]*5+4) uci <- uniroot(f1,interval=interval,x=xc[i,1])$root/pt2[i] if(xc[i,1]==0){ lci <- 0 } else { lci <- uniroot(f2,interval=interval,x=xc[i,1])$root/pt2[i] } results[i,] <- c(xc[i,1],pt2[i],xc[i,1]/pt2[i],lci,uci,xc[i,2]) } coln <- c("x","pt","rate","lower","upper","conf.level") colnames(results) <- coln data.frame(results) } epitools/R/tab2by2.test.R0000644000176200001440000000163113174424211014657 0ustar liggesusers"tab2by2.test" <- function(x, y = NULL, correction = FALSE, rev = c("neither", "rows", "columns", "both") ){ if(is.matrix(x) && !is.null(y)){stop("y argument should be NULL")} if(is.null(y)){ x <- epitable(x, rev = rev) } else { x <- epitable(x, y, rev = rev) } nr <- nrow(x); nc <- ncol(x) fish <- chi2 <- midp <- rep(NA, nr) for(i in 2:nr){ xx <- x[c(1,i),] a0<-x[1,2]; b0<-x[1,1]; a1<-x[i,2]; b1<-x[i,1] fish[i] <- fisher.test(xx)$p.value chi2[i] <- chisq.test(xx, correct = correction)$p.value midp[i] <- ormidp.test(a1, a0, b1, b0)$two.sided } pv <- cbind(midp, fish, chi2) colnames(pv) <- c("midp.exact", "fisher.exact", "chi.square") rownames(pv) <- rownames(x) names(dimnames(pv)) <- c(names(dimnames(x))[1], "two-sided") list(x = x, p.value = pv, correction = correction ) } epitools/R/oddsratio.small.R0000644000176200001440000000406713174424211015541 0ustar liggesusers"oddsratio.small" <- function(x, y = NULL, conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), correction = FALSE, verbose = FALSE){ if(is.matrix(x) && !is.null(y)){stop("y argument should be NULL")} if(is.null(y)){ x <- epitable(x, rev = rev) } else { x <- epitable(x, y, rev = rev) } tmx <- table.margins(x) p.exposed <- sweep(tmx,2,tmx["Total",],"/") p.outcome <- sweep(tmx,1,tmx[,"Total"],"/") Z <- qnorm(0.5*(1 + conf.level)) nr <- nrow(x) small <- matrix(NA, nr, 3) or <- rep(NA, nr) small[1,1] <- 1 for(i in 2:nr){ a0<-x[1,2]; b0<-x[1,1]; a1<-x[i,2]; b1<-x[i,1] or[i] <- (b0*a1)/(a0*b1) est <- (b0*a1)/((a0+1)*(b1+1)) logORss <- log(((b0+0.5)*(a1+0.5))/((a0+0.5)*(b1+0.5))) SElogORss <- sqrt((1/(b0+0.5))+(1/(a0+0.5))+(1/(b1+0.5))+(1/(a1+0.5))) ci <- exp(logORss + c(-1, 1)*Z*SElogORss) small[i,] <- c(est, ci) } if(any(or, na.rm=TRUE)<1){ cat("CAUTION: At least one unadjusted odds ratio < 1. Do not use small sample-adjusted OR to esimate 1/OR.",fill=1) } pv <- tab2by2.test(x, correction = correction) colnames(small) <- c("estimate", "lower", "upper") rownames(small) <- rownames(x) cn2 <- paste("odds ratio with", paste(100*conf.level, "%", sep=""), "C.I.") names(dimnames(small)) <- c(names(dimnames(x))[1], cn2) rr <- list(x = x, data = tmx, p.exposed = p.exposed, p.outcome = p.outcome, measure = small, conf.level = conf.level, p.value = pv$p.value, correction = pv$correction ) rrs <- list(data = tmx, measure = small, p.value = pv$p.value, correction = pv$correction ) attr(rr, "method") <- "small sample-adjusted UMLE & normal approx (Wald) CI" attr(rrs, "method") <- "small sample-adjusted UMLE & normal approx (Wald) CI" if(verbose==FALSE){ rrs } else rr } epitools/R/epitab.R0000644000176200001440000001165613174424211013710 0ustar liggesusersepitab <- function (x, y = NULL, method = c("oddsratio", "riskratio", "rateratio"), conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), oddsratio = c("wald", "fisher", "midp", "small"), riskratio = c("wald", "boot", "small"), rateratio = c("wald", "midp"), pvalue = c("fisher.exact", "midp.exact", "chi2"), correction = FALSE, verbose = FALSE) { method <- match.arg(method) if (method == "oddsratio" || method == "riskratio") { if (is.matrix(x) && !is.null(y)) { stop("y argument should be NULL") } if (is.null(y)) { x <- epitable(x, rev = rev) } else { x <- epitable(x, y, rev = rev) } } if (method == "rateratio") { if (is.matrix(x) && !is.null(y)) { stop("y argument should be NULL") } if (is.null(y)) { x <- ratetable(x, rev = rev) } else { xn <- substitute(x) yn <- substitute(y) x <- ratetable(x, y, rev = rev) colnames(x) <- c(xn, yn) } } if (method == "oddsratio") { oddsratio <- match.arg(oddsratio) rr <- oddsratio(x, method = oddsratio, verbose = TRUE, correction = correction, conf.level = conf.level) pvalue <- match.arg(pvalue) if (pvalue == "chi2") { pval <- rr$p.value[, 3] } else if (pvalue == "midp.exact") { pval <- rr$p.value[, 1] } else { pval <- rr$p.value[, 2] pvalue <- "fisher.exact" } tab <- cbind(rr$x[, 1], rr$p.exp[-nrow(rr$p.exp), 1], rr$x[, 2], rr$p.exp[-nrow(rr$p.exp), 2], rr$measure, pval) cn <- colnames(x) rownames(tab) <- rownames(x) colnames(tab) <- c(cn[1], "p0", cn[2], "p1", "oddsratio", "lower", "upper", "p.value") if (!is.null(names(dimnames(x)))) { names(dimnames(tab)) <- names(dimnames(x)) } if (verbose) { fin <- list(tab = tab, measure = oddsratio, conf.level = conf.level, pvalue = pvalue, x = rr$x, data = rr$data, p.exposed = rr$p.exposed, p.outcome = rr$p.outcome, p.value = rr$p.value, correction = correction) } else { fin <- list(tab = tab, measure = oddsratio, conf.level = conf.level, pvalue = pvalue) } } if (method == "riskratio") { riskratio <- match.arg(riskratio) rr <- riskratio(x, method = riskratio, verbose = TRUE, correction = correction) pvalue <- match.arg(pvalue) if (pvalue == "chi2") { pval <- rr$p.value[, 3] } else if (pvalue == "midp.exact") { pval <- rr$p.value[, 1] } else { pval <- rr$p.value[, 2] pvaue <- "fisher.exact" } tab <- cbind(rr$x[, 1], rr$p.out[-nrow(rr$p.out), 1], rr$x[, 2], rr$p.out[-nrow(rr$p.out), 2], rr$measure, pval) cn <- colnames(x) rownames(tab) <- rownames(x) colnames(tab) <- c(cn[1], "p0", cn[2], "p1", "riskratio", "lower", "upper", "p.value") if (!is.null(names(dimnames(x)))) { names(dimnames(tab)) <- names(dimnames(x)) } if (verbose) { fin <- list(tab = tab, measure = riskratio, conf.level = conf.level, pvalue = pvalue, x = rr$x, data = rr$data, p.exposed = rr$p.exposed, p.outcome = rr$p.outcome, p.value = rr$p.value, correction = correction) } else { fin <- list(tab = tab, measure = riskratio, conf.level = conf.level, pvalue = pvalue) } } if (method == "rateratio") { rateratio <- match.arg(rateratio) rr <- rateratio(x, method = rateratio, verbose = TRUE) pvalue <- match.arg(pvalue) if (pvalue == "chi2") { pval <- rr$p.value[, 2] pvalue <- "norm.approx" } else { pval <- rr$p.value[, 1] pvalue <- "midp.exact" } tab <- cbind(rr$x, rr$measure, pval) cn <- colnames(x) rownames(tab) <- rownames(x) colnames(tab) <- c(cn[1:2], "rateratio", "lower", "upper", "p.value") if (!is.null(names(dimnames(x)))) { names(dimnames(tab)) <- names(dimnames(x)) } if (verbose) { fin <- list(tab = tab, measure = rateratio, conf.level = conf.level, pvalue = pvalue, x = rr$x, data = rr$data, p.value = rr$p.value) } else { fin <- list(tab = tab, measure = rateratio, conf.level = conf.level, pvalue = pvalue) } } fin } epitools/R/expand.table.R0000644000176200001440000000114613174424211015002 0ustar liggesusersexpand.table <- function (x) { if (is.null(dimnames(x)) == TRUE) stop("must have dimnames") if (any(names(dimnames(x)) == "")) stop("must have names") tablevars <- expand.grid(rev(dimnames(x))) if (length(dim(x)) > 1) { ftablex <- ftable(x) counts <- as.vector(t(ftablex[, 1:ncol(ftablex)])) } else { counts <- as.vector(x) } expansion.index <- rep(1:nrow(tablevars), counts) newdat <- tablevars[expansion.index, , drop=FALSE] row.names(newdat) <- 1:nrow(newdat) revnames <- rev(names(newdat)) newdat[, revnames, drop=FALSE] } epitools/R/colorbrewer.pallette.R0000644000176200001440000000142413174424211016572 0ustar liggesusers"colorbrewer.palette" <- function(nclass = 5, type = c("qualitative", "sequential", "diverging"), palette = letters[1:18]){ type <- match.arg(type) if(type=="sequential" && (nclass<3 || nclass>9)){ stop("For 'sequential' type, 'nclass' must be between 3-9") } if(type=="diverging" && (nclass<3 || nclass>11)){ stop("For 'diverging' type, 'nclass' must be between 3-11") } if(type=="qualitative" && (nclass<3 || nclass>12)){ stop("For 'qualitative' type, 'nclass' must be between 3-12") } cd <- colorbrewer.data() palette <- match.arg(palette) nclass <- nclass cd2 <- cd[cd$type==type & cd$nclass==nclass & cd$palette==palette,] rgb(cd2$red, cd2$green, cd2$blue, maxColorValue = 255) } epitools/R/colors.plot.R0000644000176200001440000000177113174424211014717 0ustar liggesusers"colors.plot" <- function(locator = FALSE, cex.axis = 0.7){ xx <- rep(1:30,22) yy <- rep(1:22,rep(30,22)) yyy <- matrix(yy,ncol=22) cm <- colors.matrix() matplot(xx[1:30], yyy, pch=15, type="n", axes=FALSE, xlab="colors.matrix[row, ]", ylab="colors.matrix[ , col]", main ="Matrix plot of 'colors()' function in R. Use coordinates to identify color name.") title(sub = "Source: www.epitools.net", cex.sub = 0.7) points(xx,yy, type="p", pch=15, cex=2, col = c(colors(),NA,NA,NA)) axis(1, at=c(0:30 + 0.5), labels=FALSE, tick=TRUE) axis(1, at=1:30, labels=1:30, cex.axis=cex.axis, tick=FALSE) axis(2, at=c(0:22 + 0.5), labels=FALSE, tick=TRUE) axis(2, at=1:22, labels=1:22, cex.axis=cex.axis, tick=FALSE, las=1) if(locator==TRUE){ lxy <- locator() xy <- round(data.frame(lxy)) xym <- as.matrix(xy) located <- data.frame(xy, color.names = cm[xym]) return(located) } else invisible(cm) } epitools/R/oddsratio.wald.R0000644000176200001440000000341213174424211015351 0ustar liggesusers"oddsratio.wald" <- function(x, y = NULL, conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), correction = FALSE, verbose = FALSE){ if(is.matrix(x) && !is.null(y)){stop("y argument should be NULL")} if(is.null(y)){ x <- epitable(x, rev = rev) } else { x <- epitable(x, y, rev = rev) } tmx <- table.margins(x) p.exposed <- sweep(tmx,2,tmx["Total",],"/") p.outcome <- sweep(tmx,1,tmx[,"Total"],"/") Z <- qnorm(0.5*(1 + conf.level)) nr <- nrow(x) wald <- matrix(NA, nr, 3) wald[1,1] <- 1 for(i in 2:nr){ a0<-x[1,2]; b0<-x[1,1]; a1<-x[i,2]; b1<-x[i,1] est <- (b0*a1)/(a0*b1) logOR <- log(est) SElogOR <- sqrt((1/b0)+(1/a0)+(1/b1)+(1/a1)) ci <- exp(logOR + c(-1, 1)*Z*SElogOR) wald[i,] <- c(est, ci) } pv <- tab2by2.test(x, correction = correction) colnames(wald) <- c("estimate", "lower", "upper") rownames(wald) <- rownames(x) cn2 <- paste("odds ratio with", paste(100*conf.level, "%", sep=""), "C.I.") names(dimnames(wald)) <- c(names(dimnames(x))[1], cn2) rr <- list(x = x, data = tmx, p.exposed = p.exposed, p.outcome = p.outcome, measure = wald, conf.level = conf.level, p.value = pv$p.value, correction = pv$correction ) rrs <- list(data = tmx, measure = wald, p.value = pv$p.value, correction = pv$correction ) attr(rr, "method") <- "Unconditional MLE & normal approximation (Wald) CI" attr(rrs, "method") <- "Unconditional MLE & normal approximation (Wald) CI" if(verbose==FALSE){ rrs } else rr } epitools/R/or.midp.R0000644000176200001440000000316713174424211014012 0ustar liggesusers"or.midp" <- function(x, conf.level = 0.95, byrow = TRUE, interval = c(0, 1000)){ ##housekeeping if(is.vector(x)){ if(!is.numeric(x)){stop("vector must be numeric")} if(length(x)!=4){stop("vector must be of length 4")} x <- matrix(x, 2, 2, byrow = byrow) } if(is.matrix(x)){ if(!is.numeric(x)){stop("matrix must be numeric")} if(nrow(x)!=2 || ncol(x)!=2){stop("must be 2 x 2 matrix")} a1 <- x[1,1]; a0 <- x[1,2]; b1 <- x[2,1]; b0 <- x[2,2] } else {stop("must be numeric vector of length=4 or 2x2 numeric matrix")} ##median-unbiased estimate function mue <- function(a1, a0, b1, b0, or){ mm <- matrix(c(a1,a0,b1,b0),2,2, byrow=TRUE) fisher.test(mm, or=or, alternative="l")$p-fisher.test(x=x, or=or, alternative="g")$p } ##mid-p function midp <- function(a1, a0, b1, b0, or = 1){ mm <- matrix(c(a1,a0,b1,b0),2,2, byrow=TRUE) lteqtoa1 <- fisher.test(mm,or=or,alternative="l")$p.val gteqtoa1 <- fisher.test(mm,or=or,alternative="g")$p.val 0.5*(lteqtoa1-gteqtoa1+1) } alpha <- 1 - conf.level ##root finding EST <- uniroot(function(or){ mue(a1, a0, b1, b0, or) }, interval = interval)$root LCL <- uniroot(function(or){ 1-midp(a1, a0, b1, b0, or)-alpha/2 }, interval = interval)$root UCL <- 1/uniroot(function(or){ midp(a1, a0, b1, b0, or=1/or)-alpha/2 }, interval = interval)$root rr <- list(x = x, estimate = EST, conf.int = c(LCL, UCL), conf.level = conf.level) attr(rr, "method") <- "median-unbiased estimate & mid-p exact CI" return(rr) } epitools/R/riskratio.wald.R0000644000176200001440000000346613174424211015401 0ustar liggesusers"riskratio.wald" <- function(x, y = NULL, conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), correction = FALSE, verbose = FALSE){ if(is.matrix(x) && !is.null(y)){stop("y argument should be NULL")} if(is.null(y)){ x <- epitable(x, rev = rev) } else { x <- epitable(x, y, rev = rev) } tmx <- table.margins(x) p.exposed <- sweep(tmx,2,tmx["Total",],"/") p.outcome <- sweep(tmx,1,tmx[,"Total"],"/") Z <- qnorm(0.5*(1 + conf.level)) nr <- nrow(x) wald <- matrix(NA, nr, 3) wald[1,1] <- 1 for(i in 2:nr){ a0<-x[1,2]; b0<-x[1,1]; a1<-x[i,2]; b1<-x[i,1] n1<-a1+b1; n0<-a0+b0; m0<-b0+b1; m1<-a0+a1 est <- (a1/n1)/(a0/n0) logRR <- log(est) SElogRR <- sqrt((1/a1)-(1/n1)+(1/a0)-(1/n0)) ci <- exp(logRR + c(-1, 1)*Z*SElogRR) wald[i,] <- c(est, ci) } pv <- tab2by2.test(x, correction = correction) colnames(wald) <- c("estimate", "lower", "upper") rownames(wald) <- rownames(x) cn2 <- paste("risk ratio with", paste(100*conf.level, "%", sep=""), "C.I.") names(dimnames(wald)) <- c(names(dimnames(x))[1], cn2) rr <- list(x = x, data = tmx, p.exposed = p.exposed, p.outcome = p.outcome, measure = wald, conf.level = conf.level, p.value = pv$p.value, correction = pv$correction ) rrs <- list(data = tmx, measure = wald, p.value = pv$p.value, correction = pv$correction ) attr(rr, "method") <- "Unconditional MLE & normal approximation (Wald) CI" attr(rrs, "method") <- "Unconditional MLE & normal approximation (Wald) CI" if(verbose==FALSE) { rrs } else rr } epitools/R/epicurve.hours.R0000644000176200001440000001314513174424211015420 0ustar liggesusers"epicurve.hours" <- function(x, mindt, maxdt, strata = NULL, half.hour = FALSE, width = 1, space = 0, tick = TRUE, tick.offset = 0.5, segments = FALSE, ...){ ah <- as.hour(x, mindt = mindt, maxdt = maxdt, half.hour = half.hour) xfactor <- ah$stratum3 if(is.null(strata)){ dat <- t(as.matrix(table(xfactor))) } else { dat <- t(table(xfactor, strata)) } xvals <- barplot(dat, width=width, space=space, ...) if(tick){ axis(1, at=c(0, xvals + tick.offset), labels=FALSE, tick=TRUE) } if(segments){ x <- xvals-(width/2) y2 <- apply(dat,2,sum) xy2 <- cbind(x,y2) y0 <- cbind(xy2[1,1],0:xy2[1,2]) z0 <- cbind(y0, y0[,1]+width, y0[,2]) for(i in 2:nrow(xy2)){ yy <- cbind(xy2[i,1],0:xy2[i,2]) z <- cbind(yy, yy[,1]+width, yy[,2]) z2 <- rbind(z0,z) z0 <- z2 } segments(z0[,1],z0[,2],z0[,3],z0[,4]) } rr <- list(ct = ah$ct, sec = ah$sec, min = ah$min, hour = ah$hour, hour12 = ah$hour12, stratum = ah$stratum, stratum2 = ah$stratum2, stratum3 = ah$stratum3, xvals = xvals, cstratum = ah$cstratum, cstratum2 = ah$cstratum2, csec = ah$csec, cmin = ah$cmin, chour = ah$chour, chour12 = ah$chour12, campm = ah$campm, campm2 = ah$campm2, cweekday = ah$cweekday, cwkday = ah$cwkday, cmday = ah$cmday, cmonth = ah$cmonth, cmon = ah$cmon, cyear = ah$cyear, half.hour = ah$half.hour ) invisible(rr) } "epicurve.hours" <- function(x, mindt, maxdt, strata = NULL, half.hour = FALSE, width = 1, space = 0, tick = TRUE, tick.offset = 0.5, segments = FALSE, ...){ ah <- as.hour(x, mindt = mindt, maxdt = maxdt, half.hour = half.hour) xfactor <- ah$stratum3 if(is.null(strata)){ dat <- t(as.matrix(table(xfactor))) } else { dat <- t(table(xfactor, strata)) } xvals <- barplot(dat, width=width, space=space, ...) if(tick){ axis(1, at=c(0, xvals + tick.offset), labels=FALSE, tick=TRUE) } if(segments){ x <- xvals-(width/2) y2 <- apply(dat,2,sum) xy2 <- cbind(x,y2) y0 <- cbind(xy2[1,1],0:xy2[1,2]) z0 <- cbind(y0, y0[,1]+width, y0[,2]) for(i in 2:nrow(xy2)){ yy <- cbind(xy2[i,1],0:xy2[i,2]) z <- cbind(yy, yy[,1]+width, yy[,2]) z2 <- rbind(z0,z) z0 <- z2 } segments(z0[,1],z0[,2],z0[,3],z0[,4]) } rr <- list(ct = ah$ct, sec = ah$sec,, min = ah$min, hour = ah$hour, hour12 = ah$hour12, stratum = ah$stratum, stratum2 = ah$stratum2, stratum3 = ah$stratum3, xvals = xvals, cstratum = ah$cstratum, cstratum2 = ah$cstratum2, csec = ah$csec, cmin = ah$cmin, chour = ah$chour, chour12 = ah$chour12, campm = ah$campm, campm2 = ah$campm2, cweekday = ah$cweekday, cwkday = ah$cwkday, cmday = ah$cmday, cmonth = ah$cmonth, cmon = ah$cmon, cyear = ah$cyear, half.hour = ah$half.hour ) invisible(rr) } "epicurve.hours" <- function(x, mindt, maxdt, strata = NULL, half.hour = FALSE, width = 1, space = 0, tick = TRUE, tick.offset = 0.5, segments = FALSE, ...){ ah <- as.hour(x, mindt = mindt, maxdt = maxdt, half.hour = half.hour) xfactor <- ah$stratum3 if(is.null(strata)){ dat <- t(as.matrix(table(xfactor))) } else { dat <- t(table(xfactor, strata)) } xvals <- barplot(dat, width=width, space=space, ...) if(tick){ axis(1, at=c(0, xvals + tick.offset), labels=FALSE, tick=TRUE) } if(segments){ x <- xvals-(width/2) y2 <- apply(dat,2,sum) xy2 <- cbind(x,y2) y0 <- cbind(xy2[1,1],0:xy2[1,2]) z0 <- cbind(y0, y0[,1]+width, y0[,2]) for(i in 2:nrow(xy2)){ yy <- cbind(xy2[i,1],0:xy2[i,2]) z <- cbind(yy, yy[,1]+width, yy[,2]) z2 <- rbind(z0,z) z0 <- z2 } segments(z0[,1],z0[,2],z0[,3],z0[,4]) } rr <- list(ct = ah$ct, sec = ah$sec, min = ah$min, hour = ah$hour, hour12 = ah$hour12, stratum = ah$stratum, stratum2 = ah$stratum2, stratum3 = ah$stratum3, xvals = xvals, cstratum = ah$cstratum, cstratum2 = ah$cstratum2, csec = ah$csec, cmin = ah$cmin, chour = ah$chour, chour12 = ah$chour12, campm = ah$campm, campm2 = ah$campm2, cweekday = ah$cweekday, cwkday = ah$cwkday, cmday = ah$cmday, cmonth = ah$cmonth, cmon = ah$cmon, cyear = ah$cyear, half.hour = ah$half.hour ) invisible(rr) } epitools/R/as.month.R0000644000176200001440000000504713174424211014170 0ustar liggesusers"as.month" <- function(x, format = "%Y-%m-%d", min.date, max.date, before = 31, after = 31, origin = as.Date("1970-01-01"), abbreviate = TRUE){ dates <- as.Date(x, format = format) posixlt <- as.POSIXlt(dates) mday <- posixlt$mday mon <- posixlt$mon +1 if(abbreviate){ month <- format(dates, format = "%b") } else month <- format(dates, format = "%B") jul <- julian(dates, origin = origin) stratum <- jul md <- c(1:14, 16:31); adj <- c(14:1, (-1:(-16))) zz <- cbind(md,adj) for(i in 1:nrow(zz)){ stratum[mday==zz[i,1] & !is.na(mday)] <- jul[mday==zz[i,1] & !is.na(mday)] + zz[i,2] } if(missing(min.date)) {min.date <- min(dates, na.rm=TRUE) - before} if(missing(max.date)) {max.date <- max(dates, na.rm=TRUE) + after} cdates <- seq(as.Date(min.date), as.Date(max.date), by = 1) cposixlt <- as.POSIXlt(cdates) cmday <- cposixlt$mday cmon <- cposixlt$mon + 1 if(abbreviate){ cmonth <- format(cdates, format = "%b") } else cmonth <- format(cdates, format = "%B") cjul <- julian(cdates, origin = origin) cstratum <- cjul for(i in 1:nrow(zz)){ cstratum[cmday==zz[i,1] & !is.na(cmday)] <- cjul[cmday==zz[i,1] & !is.na(cmday)] + zz[i,2] } repeated <- function(x){ lx <- length(x) y <- rep(FALSE, lx) for (i in 2:lx){ if(x[i]==x[i-1]){ y[i] <- TRUE } } y } cmon <- cmon[!repeated(cmon)] cmonth <- cmonth[!repeated(cmonth)] cstratum <- cstratum[!repeated(cstratum)] attr(cstratum, "origin") <- origin stratum2 <- factor(stratum, levels = cstratum) julian2date <- function(x){ orig <- as.Date(attributes(x)[[1]]) jorig <- as.numeric(orig) seqdates <- seq(from=orig,to=orig+max(x, na.rm=TRUE),by=1) seqjulian <- seq(from=jorig,to=jorig+max(x, na.rm=TRUE),by=1) seqdates[x+1] } stratum3 <- julian2date(stratum) cstratum2 <- julian2date(cstratum) cmday <- as.numeric(format(cstratum2, format = "%d")) cyear <- format(cstratum2, format = "%Y") list(dates = unname(dates), mon = unname(mon), month = unname(month), stratum = stratum, stratum2 = stratum2, stratum3 = stratum3, cmon = unname(cmon), cmonth = unname(cmonth), cstratum = cstratum, cstratum2 = cstratum2, cmday = cmday, cyear = cyear ) } epitools/R/riskratio.boot.R0000644000176200001440000000451613174424211015412 0ustar liggesusers"riskratio.boot" <- function(x, y = NULL, conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), correction = FALSE, verbose = FALSE, replicates = 5000){ if(is.matrix(x) && !is.null(y)){stop("y argument should be NULL")} if(is.null(y)){ x <- epitable(x, rev = rev) } else { x <- epitable(x, y, rev = rev) } tmx <- table.margins(x) p.exposed <- sweep(tmx,2,tmx["Total",],"/") p.outcome <- sweep(tmx,1,tmx[,"Total"],"/") Z <- qnorm(0.5*(1 + conf.level)) nr <- nrow(x) boot <- matrix(NA, nr, 3) boot[1,1] <- 1 rr.boot <- function(a1, a0, b1, b0, conf.level = 0.95, replicates = 5000){ alpha <- 1 - conf.level n1 <- a1 + b1; n0 <- a0 + b0 p1 <- a1/n1; p0 <- a0/n0 r1 <- rbinom(replicates, n1, p1)/n1 r0 <- rbinom(replicates, n0, p0)/n0 rrboot <- r1/r0 rrbar <- mean(rrboot, na.rm=T) ci <- quantile(rrboot, c(alpha/2, 1-alpha/2), na.rm = T) list(p0 = p0, p1 = p1, rr = p1/p0, rr.mean = rrbar, conf.level = conf.level, conf.int = unname(ci), replicates = replicates) } for(i in 2:nr){ a0<-x[1,2]; b0<-x[1,1]; a1<-x[i,2]; b1<-x[i,1] rrb <- rr.boot(a1 = a1, a0 = a0, b1 = b1, b0 = b0, conf.level = conf.level, replicates = replicates) boot[i,] <- c(rrb$rr, rrb$conf.int) } pv <- tab2by2.test(x, correction = correction) colnames(boot) <- c("estimate", "lower", "upper") rownames(boot) <- rownames(x) cn2 <- paste("risk ratio with", paste(100*conf.level, "%", sep=""), "C.I.") names(dimnames(boot)) <- c(names(dimnames(x))[1], cn2) rr <- list(x = x, data = tmx, p.exposed = p.exposed, p.outcome = p.outcome, measure = boot, replicates = rrb$replicates, p.value = pv$p.value, correction = pv$correction ) rrs <- list(data = tmx, measure = boot, p.value = pv$p.value, correction = pv$correction ) attr(rr, "method") <- "Unconditional MLE & bootstrap CI" attr(rrs, "method") <- "Unconditional MLE & bootstrap CI" if(verbose==FALSE) { rrs } else rr } epitools/R/pois.byar.R0000644000176200001440000000072613174424211014346 0ustar liggesusers"pois.byar" <- function(x, pt = 1, conf.level = 0.95) { Z <- qnorm(0.5*(1 + conf.level)) aprime <- x + 0.5 Zinsert <- (Z/3)*sqrt(1/aprime) lower <- (aprime*(1-1/(9*aprime) - Zinsert)^3)/pt upper <- (aprime*(1-1/(9*aprime) + Zinsert)^3)/pt data.frame(x = x, pt = pt, rate = x/pt, lower = lower, upper = upper, conf.level = conf.level ) } epitools/R/riskratio.R0000644000176200001440000000202213174424211014436 0ustar liggesusers"riskratio" <- function(x, y = NULL, method = c("wald", "small", "boot"), conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), correction = FALSE, verbose = FALSE, replicates = 5000){ if(is.matrix(x) && !is.null(y)){stop("y argument should be NULL")} if(is.null(y)){ x <- epitable(x, rev = rev) } else { x <- epitable(x, y, rev = rev) } method <- match.arg(method) if(method=="wald"){ rr <- riskratio.wald(x, conf.level = conf.level, verbose = verbose, correction = correction) } if(method=="small"){ rr <- riskratio.small(x, conf.level = conf.level, verbose = verbose, correction = correction) } if(method=="boot"){ rr <- riskratio.boot(x, conf.level = conf.level, replicates = replicates, verbose = verbose, correction = correction) } rr } epitools/R/kapmeier.R0000644000176200001440000000072613174424211014235 0ustar liggesusers"kapmeier" <- function (time, status) { stime <- sort(time) status <- status[order(time)] nj <- length(time):1 nj <- nj[!duplicated(stime)] dj <- tapply(status, stime, sum) tj <- unique(stime) sj <- (nj - dj)/nj cumsj <- cumprod(sj) cumrj <- 1 - cumsj results <- cbind(time = tj, n.risk = nj, n.events = dj, condsurv = sj, survival = cumsj, risk = cumrj) dimnames(results)[1] <- list(NULL) results[dj != 0, ] } epitools/R/rateratio.R0000644000176200001440000000144413174424211014430 0ustar liggesusers"rateratio" <- function(x, y = NULL, method = c("midp", "wald"), conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), verbose = FALSE){ if(is.matrix(x) && !is.null(y)){stop("y argument should be NULL")} if(is.null(y)){ x <- ratetable(x, rev = rev) } else { xn <- substitute(x) yn <- substitute(y) x <- ratetable(x, y, rev = rev) colnames(x) <- c(xn, yn) } method <- match.arg(method) if(method=="midp"){ rr <- rateratio.midp(x, conf.level = conf.level, verbose = verbose) } if(method=="wald"){ rr <- rateratio.wald(x, conf.level = conf.level, verbose = verbose) } return(rr) } epitools/R/oddsratio.R0000644000176200001440000000207113174424211014423 0ustar liggesusersoddsratio <- function (x, y = NULL, method = c("midp", "fisher", "wald", "small"), conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), correction = FALSE, verbose = FALSE) { if (is.matrix(x) && !is.null(y)) { stop("y argument should be NULL") } if (is.null(y)) { x <- epitable(x, rev = rev) } else { x <- epitable(x, y, rev = rev) } method <- match.arg(method) if (method == "midp") { rr <- oddsratio.midp(x, conf.level = conf.level, verbose = verbose, correction = correction) } if (method == "fisher") { rr <- oddsratio.fisher(x, conf.level = conf.level, verbose = verbose, correction = correction) } if (method == "wald") { rr <- oddsratio.wald(x, conf.level = conf.level, verbose = verbose, correction = correction) } if (method == "small") { rr <- oddsratio.small(x, conf.level = conf.level, verbose = verbose, correction = correction) } rr } epitools/R/rateratio.midp.R0000644000176200001440000000435413174424211015363 0ustar liggesusersrateratio.midp <- function(x, y = NULL, conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), verbose = FALSE){ if(is.matrix(x) && !is.null(y)){stop("y argument should be NULL")} if(is.null(y)){ x <- ratetable(x, rev = rev) } else { xn <- substitute(x) yn <- substitute(y) x <- ratetable(x, y, rev = rev) colnames(x) <- c(xn, yn) } midprob <- function(p,y,n,lower.tail,offset) dbinom(y,n,p)/2 + pbinom(y-lower.tail, n, p, lower.tail = lower.tail) + offset solve.p <- function(n, y, offset=-0.5, lower.tail=T) { if (lower.tail & !midprob(1, y, n, lower.tail,offset) < 0) return(1) if (!lower.tail & !midprob(0, y, n, lower.tail,offset) < 0) return(0) return(uniroot(midprob, c(0,1),y=y,n=n,lower.tail=lower.tail,offset)$root) } tmx <- table.margins(x)[,-3] alpha <- 1 - conf.level nr <- nrow(x) est <- matrix(NA, nr, 3) est[1,1] <- 1 for(i in 2:nr){ aa <- x[i,1]; bb <- x[1,1]; pt1 <- x[i,2]; pt0 <- x[1,2] pt <- pt0 + pt1 mm <- aa + bb s.irr <- solve.p(n = mm, y = aa, offset = -0.5, lower.tail = F) irr <- (s.irr / (1 - s.irr)) * (pt0 / pt1) s.lower <- solve.p(n=mm, y=aa, offset=-alpha/2, lower.tail = F) irr.lower <- (s.lower/ (1 - s.lower)) * (pt0 / pt1) s.upper <- solve.p(n=mm, y=aa, offset=-alpha/2, lower.tail=T) irr.upper <- (s.upper/ (1 - s.upper)) * (pt0 / pt1) est[i,] <- c(irr, irr.lower, irr.upper) } pval <- rate2by2.test(x)$p.value colnames(est) <- c("estimate", "lower", "upper") rownames(est) <- rownames(x) cn2 <- paste("rate ratio with", paste(100*conf.level, "%", sep=""), "C.I.") names(dimnames(est)) <- c(names(dimnames(x))[1], cn2) rr <- list(x = x, data = tmx, measure = est, conf.level = conf.level, p.value = pval ) rrs <- list(data = tmx, measure = est, p.value = pval ) attr(rr, "method") <- "Median unbiased estimate & mid-p exact CI" attr(rrs, "method") <- "Median unbiased estimate & mid-p exact CI" if(verbose==FALSE) { rrs } else rr }epitools/R/ratetable.R0000644000176200001440000000500613174424211014377 0ustar liggesusers"ratetable" <- function(..., byrow = FALSE, rev = c("neither", "rows", "columns", "both") ){ lx <- list(...) if(length(lx)==0) { stop("No arguments provided") } if(length(lx)==1 && (is.character(lx[[1]]) || is.factor(lx[[1]]))) { stop("Must be numeric vector or matrix.") } ## r x 2 table if(length(lx)==1 && is.matrix(lx[[1]]) && nrow(lx[[1]])>=2 && ncol(lx[[1]])==2) { x <- lx[[1]] if(is.null(dimnames(lx[[1]]))) { nr <- nrow(x) rn <- paste("Exposed", 1:nr, sep="") cn <- c("Count", "Person-time") dimnames(x) <- list(Predictor = rn, Outcome = cn) } } ## 2 vectors if(length(lx)==2 && is.vector(lx[[1]]) && is.vector(lx[[2]])) { x <- cbind(lx[[1]], lx[[2]]) if(!is.null(names(lx))) { colnames(x) <- names(lx) } if(is.null(rownames(x)) && !is.null(colnames(x))) { nr <- nrow(x) rn <- paste("Exposed", 1:nr, sep="") rownames(x) <- rn } if(is.null(dimnames(x))) { nr <- nrow(x) rn <- paste("Exposed", 1:nr, sep="") cn <- c("Count", "Person-time") dimnames(x) <- list(Predictor = rn, Outcome = cn) } } ## >=4 numbers is.even <- function(x){ifelse(x%%2==0, TRUE, FALSE)} if(length(lx)>=4 && all(sapply(list(1,2,3,4,5),is.numeric)) && is.even(length(lx)) && all(sapply(lx,length)==1)) { x <- matrix(sapply(lx,as.vector), ncol = 2, byrow = byrow) nr <- nrow(x) rn <- paste("Exposed", 1:nr, sep="") cn <- c("Cases", "Person-time") dimnames(x) <- list(Predictor = rn, Outcome = cn) } ## 1 vector if(length(lx)==1 && is.vector(lx[[1]]) && is.numeric(lx[[1]]) && is.even(length(lx[[1]]))) { x <- matrix(lx[[1]], ncol = 2, byrow = byrow) nr <- nrow(x) rn <- paste("Exposed", 1:nr, sep="") cn <- c("Cases", "Person-time") dimnames(x) <- list(Predictor = rn, Outcome = cn) } nrx <- nrow(x) ncx <- ncol(x) reverse <- match.arg(rev) if(reverse=="rows") finalx <- x[nrx:1,] if(reverse=="columns") finalx <- x[,ncx:1] if(reverse=="both") finalx <- x[nrx:1,ncx:1] if(reverse=="neither") finalx <- x finalx } epitools/R/ageadjust.indirect.R0000644000176200001440000000175613174424211016213 0ustar liggesusers"ageadjust.indirect" <- function(count, pop, stdcount, stdpop, stdrate=NULL, conf.level = 0.95){ zv <- qnorm(0.5*(1+conf.level)) countsum <- sum(count) if(is.null(stdrate)==TRUE & length(stdcount)>1 & length(stdpop>1)){ stdrate <- stdcount/stdpop } ##indirect age standardization ##a. sir calculation expected <- sum(stdrate * pop) sir <- countsum/expected logsir.lci <- log(sir) - zv * (1/sqrt(countsum)) logsir.uci <- log(sir) + zv * (1/sqrt(countsum)) sir.lci <- exp(logsir.lci) sir.uci <- exp(logsir.uci) ##b. israte calculation stdcrate <- sum(stdcount)/sum(stdpop) crude.rate <- sum(count)/sum(pop) isr <- sir * stdcrate isr.lci <- sir.lci * stdcrate isr.uci <- sir.uci * stdcrate results <- list(sir=c(observed=countsum,exp=expected, sir=sir,lci=sir.lci,uci=sir.uci), rate=c(crude.rate=crude.rate,adj.rate=isr, lci=isr.lci,uci=isr.uci)) results } epitools/R/ormidp.test.R0000644000176200001440000000056613174424211014712 0ustar liggesusersormidp.test <- function(a1, a0, b1, b0, or = 1){ x <- matrix(c(a1,a0,b1,b0),2,2, byrow=TRUE) lteqtoa1 <- fisher.test(x,or=or,alternative="l")$p.val gteqtoa1 <- fisher.test(x,or=or,alternative="g")$p.val pval1 <- 0.5*(lteqtoa1-gteqtoa1+1) one.sided <- min(pval1, 1-pval1) two.sided <- 2*one.sided data.frame(one.sided=one.sided, two.sided=two.sided) } epitools/R/table.margins.R0000644000176200001440000000111513174424211015157 0ustar liggesusers"table.margins" <- function(x){ #x = matrix or array if (!is.array(x)) stop("x is not an array") dd <- dim(x) y <- matrix(x, nrow = dd[1]) z <- rbind(y, apply(y, 2, sum)) y2 <- matrix(t(z), nrow = dd[2]) z2 <- rbind(y2, apply(y2, 2, sum)) z3 <- t(matrix(t(z2), nrow = prod(dd[-c(1, 2)]))) fin <- array(z3, c(dd[1:2] + 1, dd[-c(1, 2)])) rownames(fin) <- c(rownames(x, do.NULL=FALSE),"Total") colnames(fin) <- c(colnames(x, do.NULL=FALSE),"Total") if(!is.null(names(dimnames(x)))){ names(dimnames(fin)) <- names(dimnames(x)) } fin } epitools/R/rateratio.wald.R0000644000176200001440000000307013174424211015353 0ustar liggesusers"rateratio.wald" <- function(x, y = NULL, conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), verbose = FALSE){ if(is.matrix(x) && !is.null(y)){stop("y argument should be NULL")} if(is.null(y)){ x <- ratetable(x, rev = rev) } else { xn <- substitute(x) yn <- substitute(y) x <- ratetable(x, y, rev = rev) colnames(x) <- c(xn, yn) } tmx <- table.margins(x)[,-3] Z <- qnorm(0.5*(1 + conf.level)) nr <- nrow(x) wald <- matrix(NA, nr, 3) pval <- matrix(NA, nr, 2) wald[1,1] <- 1 for(i in 2:nr){ aa <- x[i,1]; bb <- x[1,1]; pt1 <- x[i,2]; pt0 <- x[1,2] est <- (aa/pt1)/(bb/pt0) logRR <- log(est) SElogRR <- sqrt((1/aa) + (1/bb)) ci <- exp(logRR + c(-1, 1)*Z*SElogRR) wald[i,] <- c(est, ci) } pval <- rate2by2.test(x)$p.value colnames(wald) <- c("estimate", "lower", "upper") rownames(wald) <- rownames(x) cn2 <- paste("rate ratio with", paste(100*conf.level, "%", sep=""), "C.I.") names(dimnames(wald)) <- c(names(dimnames(x))[1], cn2) rr <- list(x = x, data = tmx, measure = wald, conf.level = conf.level, p.value = pval ) rrs <- list(data = tmx, measure = wald, p.value = pval ) attr(rr, "method") <- "Unconditional MLE & normal approximation (Wald) CI" attr(rrs, "method") <- "Unconditional MLE & normal approximation (Wald) CI" if(verbose==FALSE) { rrs } else rr } epitools/R/binom.approx.R0000644000176200001440000000061213174424211015046 0ustar liggesusers"binom.approx" <- function(x, n, conf.level = 0.95) { Z <- qnorm(0.5*(1 + conf.level)) SE.R <- sqrt(x * (n - x) / (n^3)) R.lci <- x/n - Z*SE.R R.uci <- x/n + Z*SE.R data.frame(x = x, n = n, proportion = x/n, lower = R.lci, upper = R.uci, conf.level = conf.level ) } epitools/R/colorbrewer.display.R0000644000176200001440000000407713174424211016434 0ustar liggesusers"colorbrewer.display" <- function (nclass = 5, type = c("qualitative", "sequential", "diverging"), col.bg = "white") { type <- match.arg(type) if (type == "sequential" && (nclass < 3 || nclass > 9)) { stop("For 'sequential' type, 'nclass' must be between 3-9") } if (type == "diverging" && (nclass < 3 || nclass > 11)) { stop("For 'diverging' type, 'nclass' must be between 3-11") } if (type == "qualitative" && (nclass < 3 || nclass > 12)) { stop("For 'qualitative' type, 'nclass' must be between 3-12") } cd <- colorbrewer.data() cd.tn <- cd[cd$type == type & cd$nclass == nclass, ] examp <- unique(cd.tn$palette) uname <- unique(cd.tn$name) nex <- length(examp) yvals <- matrix(rep(1:nex, rep(nclass, nex)), nrow = nclass, ncol = nex) xvals <- matrix(rep(1:nclass, nex), nrow = nclass, ncol = nex) matplot(xvals, yvals, type = "n", xlab = "", ylab = "", xlim = c(0, 18), ylim = c(0, 19.5), xaxs = "i", yaxs = "i", axes = FALSE) rect(0, 0, max(xvals) + 1, max(yvals) + 1, col = col.bg) points(as.vector(xvals), as.vector(yvals), pch = 15, cex = 2.5, col = rgb(cd.tn[, "red"], cd.tn[, "green"], cd.tn[, "blue"], maxColorValue = 255)) text(nrow(xvals) + 3, 1:(length(uname) + 1), labels = c(uname, "$name")) abline(h = c(0, (1:nex) + 0.5), col = "grey") axis(1, at = 1:nclass, labels = 1:nclass, tick = FALSE) axis(1, at = (0:nclass) + 0.5, labels = FALSE, tick = TRUE) axis(2, at = 1:nex, labels = letters[1:nex], tick = FALSE, las = 1, cex.axis = 0.7) axis(2, at = (0:nex) + 0.5, labels = FALSE, tick = TRUE) xlab <- paste("$nclass =", nclass) ylab <- paste("$palette = (see y axis)") main <- paste("Palettes from www.ColorBrewer.org:\nnclass = ", nclass, ", ", "type = ", type, ", ", "col.bg = ", col.bg, sep = "") title(xlab = xlab, ylab = ylab, main = main, sub = "Source: Cynthia Brewer, Pennsylvania State University, cbrewer@psu.edu", cex.sub = 0.7) invisible(cd.tn) } epitools/R/binom.exact.R0000644000176200001440000000104013174424211014635 0ustar liggesusers"binom.exact" <- function(x, n, conf.level=.95) { xnc <- cbind(x,n,conf.level) lower <- numeric(nrow(xnc)) upper <- numeric(nrow(xnc)) for(i in 1:nrow(xnc)){ ci <- binom.test(x=xnc[i,1], n=xnc[i,2], conf.level=xnc[i,3])$conf.int lower[i] <- ci[1] upper[i] <- ci[2] } data.frame(x = x, n = n, proportion = x/n, lower = lower, upper = upper, conf.level = conf.level ) } epitools/R/epicurve.table.R0000644000176200001440000000146113174424211015345 0ustar liggesusersepicurve.table <- function(x, width = 1, space = 0, tick = TRUE, tick.offset = 0.5, segments = FALSE, ...){ xvals <- barplot(x, width=width, space=space, ...) if(tick) {axis(1, at=c(0, xvals + tick.offset), labels=FALSE, tick=TRUE)} if(segments){ xx <- xvals-(width/2) y2 <- apply(x,2,sum) xy2 <- cbind(xx,y2) y0 <- cbind(xy2[1,1],0:xy2[1,2]) z0 <- cbind(y0, y0[,1]+width, y0[,2]) for(i in 2:nrow(xy2)){ yy <- cbind(xy2[i,1],0:xy2[i,2]) z <- cbind(yy, yy[,1]+width, yy[,2]) z2 <- rbind(z0,z) z0 <- z2 } segments(z0[,1],z0[,2],z0[,3],z0[,4]) } invisible(xvals) } epitools/R/epicurve.months.R0000644000176200001440000000334213174424211015566 0ustar liggesusers"epicurve.months" <- function(x, format = "%Y-%m-%d", strata = NULL, min.date, max.date, before = 31, after = 31, width = 1, space = 0, tick = TRUE, tick.offset = 0.5, segments = FALSE, origin = as.Date("1970-01-01"), ...){ am <- as.month(x, format = format, min.date = min.date, max.date = max.date, before = before, after = after, origin = origin) original.dates <- am$dates cdates <- am$cstratum dates <- am$stratum2 if(is.null(strata)){ dat <- t(as.matrix(table(dates))) } else { dat <- t(table(dates, strata)) } xvals <- barplot(dat, width=width, space=space, ...) if(tick){ axis(1, at=c(0, xvals + tick.offset), labels=FALSE, tick=TRUE) } if(segments){ x <- xvals-(width/2) y2 <- apply(dat,2,sum) xy2 <- cbind(x,y2) y0 <- cbind(xy2[1,1],0:xy2[1,2]) z0 <- cbind(y0, y0[,1]+width, y0[,2]) for(i in 2:nrow(xy2)){ yy <- cbind(xy2[i,1],0:xy2[i,2]) z <- cbind(yy, yy[,1]+width, yy[,2]) z2 <- rbind(z0,z) z0 <- z2 } segments(z0[,1],z0[,2],z0[,3],z0[,4]) } rr <- list(dates = original.dates, mon = am$mon, month = am$month, stratum = am$stratum, stratum2 = am$stratum2, stratum3 = am$stratum3, xvals = xvals, cmon = am$cmon, cmonth = am$cmonth, cstratum = am$cstratum, cstratum2 = am$cstratum2, cmday = am$cmday, cyear = am$cyear ) invisible(rr) } epitools/R/pois.approx.R0000644000176200001440000000057513174424211014724 0ustar liggesusers"pois.approx" <- function(x, pt = 1, conf.level = .95) { Z <- qnorm(0.5*(1 + conf.level)) SE.R <- sqrt(x/pt^2) lower <- x/pt - Z*SE.R upper <- x/pt + Z*SE.R data.frame(x = x, pt = pt, rate = x/pt, lower = lower, upper = upper, conf.level = conf.level ) } epitools/R/riskratio.small.R0000644000176200001440000000351313174424211015553 0ustar liggesusers"riskratio.small" <- function(x, y = NULL, conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), correction = FALSE, verbose = FALSE){ if(is.matrix(x) && !is.null(y)){stop("y argument should be NULL")} if(is.null(y)){ x <- epitable(x, rev = rev) } else { x <- epitable(x, y, rev = rev) } tmx <- table.margins(x) p.exposed <- sweep(tmx,2,tmx["Total",],"/") p.outcome <- sweep(tmx,1,tmx[,"Total"],"/") Z <- qnorm(0.5*(1 + conf.level)) nr <- nrow(x) small <- matrix(NA, nr, 3) small[1,1] <- 1 for(i in 2:nr){ a0<-x[1,2]; b0<-x[1,1]; a1<-x[i,2]; b1<-x[i,1] n1<-a1+b1; n0<-a0+b0; m0<-b0+b1; m1<-a0+a1 est <- (a1/n1)/((a0+1)/(n0+1)) logRR <- log(est) SElogRR <- sqrt((1/a1)-(1/n1)+(1/a0)-(1/n0)) ci <- exp(logRR + c(-1, 1)*Z*SElogRR) small[i,] <- c(est, ci) } pv <- tab2by2.test(x, correction = correction) colnames(small) <- c("estimate", "lower", "upper") rownames(small) <- rownames(x) cn2 <- paste("risk ratio with", paste(100*conf.level, "%", sep=""), "C.I.") names(dimnames(small)) <- c(names(dimnames(x))[1], cn2) rr <- list(x = x, data = tmx, p.exposed = p.exposed, p.outcome = p.outcome, measure = small, conf.level = conf.level, p.value = pv$p.value, correction = pv$correction ) rrs <- list(data = tmx, measure = small, p.value = pv$p.value, correction = pv$correction ) attr(rr, "method") <- "small sample-adjusted UMLE & normal approx (Wald) CI" attr(rrs, "method") <- "small sample-adjusted UMLE & normal approx (Wald) CI" if(verbose==FALSE) { rrs } else rr } epitools/R/oddsratio.midp.R0000644000176200001440000000335613174424211015362 0ustar liggesusers"oddsratio.midp" <- function(x, y = NULL, conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), correction = FALSE, verbose = FALSE, interval = c(0, 1000)){ if(is.matrix(x) && !is.null(y)){stop("y argument should be NULL")} if(is.null(y)){ x <- epitable(x, rev = rev) } else { x <- epitable(x, y, rev = rev) } tmx <- table.margins(x) p.exposed <- sweep(tmx,2,tmx["Total",],"/") p.outcome <- sweep(tmx,1,tmx[,"Total"],"/") nr <- nrow(x) midp <- matrix(NA, nr, 3) midp[1,1] <- 1 for(i in 2:nr){ a0<-x[1,2]; b0<-x[1,1]; a1<-x[i,2]; b1<-x[i,1] tmpx <- matrix(c(a1,a0,b1,b0),2,2, byrow=TRUE) OR <- or.midp(tmpx, conf.level = conf.level, interval = interval) midp[i,] <- c(OR$estimate, OR$conf.int) } pv <- tab2by2.test(x, correction = correction) colnames(midp) <- c("estimate", "lower", "upper") rownames(midp) <- rownames(x) cn2 <- paste("odds ratio with", paste(100*conf.level, "%", sep=""), "C.I.") names(dimnames(midp)) <- c(names(dimnames(x))[1], cn2) rr <- list(x = x, data = tmx, p.exposed = p.exposed, p.outcome = p.outcome, measure = midp, conf.level = conf.level, p.value = pv$p.value, correction = pv$correction ) rrs <- list(data = tmx, measure = midp, p.value = pv$p.value, correction = pv$correction ) attr(rr, "method") <- "median-unbiased estimate & mid-p exact CI" attr(rrs, "method") <- "median-unbiased estimate & mid-p exact CI" if(verbose==FALSE){ rrs } else rr } epitools/R/as.hour.R0000644000176200001440000000400213174424211014006 0ustar liggesusers"as.hour" <- function(x, mindt, maxdt, half.hour = FALSE){ if(half.hour==TRUE){ unit <- 3600/2 } else { unit <- 3600 } ct <- as.POSIXct(x) lt <- as.POSIXlt(ct) mindt <- as.POSIXct(mindt) maxdt <- as.POSIXct(maxdt) ct.sec <- as.numeric(ct) ct.hour <- ct.sec%/%unit ct.hour12 <- as.numeric(format(ct, format = "%I")) ct.wkday <- format(ct, format = "%a") ct.weekday <- format(ct, format = "%A") cct <- seq(mindt, maxdt, 1) cct.sec <- as.numeric(cct) cct.hour <- cct.sec%/%unit cct.hour.tab <- as.numeric(names(table(cct.sec%/%unit))) cct.tab <- cct[!duplicated(cct.hour)] cct.hour12 <- as.numeric(format(cct.tab, format = "%I")) cct.ampm <- cct.ampm2 <- format(cct.tab, format = "%p") cct.ampm2[cct.ampm=="AM" & !is.na(cct.ampm)] <- "am" cct.ampm2[cct.ampm=="PM" & !is.na(cct.ampm)] <- "pm" cct.weekday <- format(cct.tab, format = "%A") cct.wkday <- format(cct.tab, format = "%a") cct.month <- format(cct.tab, format = "%B") cct.mon <- format(cct.tab, format = "%b") cct.year <- format(cct.tab, format = "%Y") names(cct.tab) <- cct.hour.tab ct.hour.factor <- factor(ct.hour, levels = cct.hour.tab) ct.stratum <- cct.tab[as.character(ct.hour)] ct.stratum.factor <- factor(unname(ct.stratum), levels = unname(cct.tab)) clt <- as.POSIXlt(cct.tab) list(ct = ct, sec = lt$sec, min = lt$min, hour = lt$hour, hour12 = ct.hour12, stratum = unname(ct.hour.factor), stratum2 = unname(ct.stratum), stratum3 = ct.stratum.factor, cstratum = unname(cct.hour.tab), cstratum2 = unname(cct.tab), csec = clt$sec, cmin = clt$min, chour = clt$hour, chour12 = cct.hour12, campm = cct.ampm, campm2 = cct.ampm2, cweekday = cct.weekday, cwkday = cct.wkday, cmday = clt$mday, cmonth = cct.month, cmon = cct.mon, cyear = cct.year, half.hour = half.hour ) } epitools/R/colorbrewer.data.R0000644000176200001440000022737713174424211015712 0ustar liggesuserscolorbrewer.data <- function(){ "cbd3" <- structure(list(type = structure(as.integer(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3)), .Label = c("diverging", "qualitative", "sequential" ), class = "factor"), nclass = as.integer(c(3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9 )), name = structure(c("BrBG", "BrBG", "BrBG", "PiYG", "PiYG", "PiYG", "PRGn", "PRGn", "PRGn", "PuOr", "PuOr", "PuOr", "RdBu", "RdBu", "RdBu", "RdGy", "RdGy", "RdGy", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlGn", "RdYlGn", "RdYlGn", "Spectral", "Spectral", "Spectral", "BrBG", "BrBG", "BrBG", "BrBG", "PiYG", "PiYG", "PiYG", "PiYG", "PRGn", "PRGn", "PRGn", "PRGn", "PuOr", "PuOr", "PuOr", "PuOr", "RdBu", "RdBu", "RdBu", "RdBu", "RdGy", "RdGy", "RdGy", "RdGy", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "Spectral", "Spectral", "Spectral", "Spectral", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "BrBG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PiYG", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PRGn", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "PuOr", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdBu", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdGy", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlBu", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "RdYlGn", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "Spectral", "Accent", "Accent", "Accent", "Dark2", "Dark2", "Dark2", "Paired", "Paired", "Paired", "Pastel1", "Pastel1", "Pastel1", "Pastel2", "Pastel2", "Pastel2", "Set1", "Set1", "Set1", "Set2", "Set2", "Set2", "Set3", "Set3", "Set3", "Accent", "Accent", "Accent", "Accent", "Dark2", "Dark2", "Dark2", "Dark2", "Paired", "Paired", "Paired", "Paired", "Pastel1", "Pastel1", "Pastel1", "Pastel1", "Pastel2", "Pastel2", "Pastel2", "Pastel2", "Set1", "Set1", "Set1", "Set1", "Set2", "Set2", "Set2", "Set2", "Set3", "Set3", "Set3", "Set3", "Accent", "Accent", "Accent", "Accent", "Accent", "Dark2", "Dark2", "Dark2", "Dark2", "Dark2", "Paired", "Paired", "Paired", "Paired", "Paired", "Pastel1", "Pastel1", "Pastel1", "Pastel1", "Pastel1", "Pastel2", "Pastel2", "Pastel2", "Pastel2", "Pastel2", "Set1", "Set1", "Set1", "Set1", "Set1", "Set2", "Set2", "Set2", "Set2", "Set2", "Set3", "Set3", "Set3", "Set3", "Set3", "Accent", "Accent", "Accent", "Accent", "Accent", "Accent", "Dark2", "Dark2", "Dark2", "Dark2", "Dark2", "Dark2", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Pastel1", "Pastel1", "Pastel1", "Pastel1", "Pastel1", "Pastel1", "Pastel2", "Pastel2", "Pastel2", "Pastel2", "Pastel2", "Pastel2", "Set1", "Set1", "Set1", "Set1", "Set1", "Set1", "Set2", "Set2", "Set2", "Set2", "Set2", "Set2", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Accent", "Accent", "Accent", "Accent", "Accent", "Accent", "Accent", "Dark2", "Dark2", "Dark2", "Dark2", "Dark2", "Dark2", "Dark2", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Pastel1", "Pastel1", "Pastel1", "Pastel1", "Pastel1", "Pastel1", "Pastel1", "Pastel2", "Pastel2", "Pastel2", "Pastel2", "Pastel2", "Pastel2", "Pastel2", "Set1", "Set1", "Set1", "Set1", "Set1", "Set1", "Set1", "Set2", "Set2", "Set2", "Set2", "Set2", "Set2", "Set2", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Accent", "Accent", "Accent", "Accent", "Accent", "Accent", "Accent", "Accent", "Dark2", "Dark2", "Dark2", "Dark2", "Dark2", "Dark2", "Dark2", "Dark2", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Pastel1", "Pastel1", "Pastel1", "Pastel1", "Pastel1", "Pastel1", "Pastel1", "Pastel1", "Pastel2", "Pastel2", "Pastel2", "Pastel2", "Pastel2", "Pastel2", "Pastel2", "Pastel2", "Set1", "Set1", "Set1", "Set1", "Set1", "Set1", "Set1", "Set1", "Set2", "Set2", "Set2", "Set2", "Set2", "Set2", "Set2", "Set2", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Pastel1", "Pastel1", "Pastel1", "Pastel1", "Pastel1", "Pastel1", "Pastel1", "Pastel1", "Pastel1", "Set1", "Set1", "Set1", "Set1", "Set1", "Set1", "Set1", "Set1", "Set1", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Paired", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Set3", "Blues", "Blues", "Blues", "BuGn", "BuGn", "BuGn", "BuPu", "BuPu", "BuPu", "GnBu", "GnBu", "GnBu", "Greens", "Greens", "Greens", "Greys", "Greys", "Greys", "Oranges", "Oranges", "Oranges", "OrRd", "OrRd", "OrRd", "PuBu", "PuBu", "PuBu", "PuBuGn", "PuBuGn", "PuBuGn", "PuRd", "PuRd", "PuRd", "Purples", "Purples", "Purples", "RdPu", "RdPu", "RdPu", "Reds", "Reds", "Reds", "YlGn", "YlGn", "YlGn", "YlGnBu", "YlGnBu", "YlGnBu", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrRd", "YlOrRd", "YlOrRd", "Blues", "Blues", "Blues", "Blues", "BuGn", "BuGn", "BuGn", "BuGn", "BuPu", "BuPu", "BuPu", "BuPu", "GnBu", "GnBu", "GnBu", "GnBu", "Greens", "Greens", "Greens", "Greens", "Greys", "Greys", "Greys", "Greys", "Oranges", "Oranges", "Oranges", "Oranges", "OrRd", "OrRd", "OrRd", "OrRd", "PuBu", "PuBu", "PuBu", "PuBu", "PuBuGn", "PuBuGn", "PuBuGn", "PuBuGn", "PuRd", "PuRd", "PuRd", "PuRd", "Purples", "Purples", "Purples", "Purples", "RdPu", "RdPu", "RdPu", "RdPu", "Reds", "Reds", "Reds", "Reds", "YlGn", "YlGn", "YlGn", "YlGn", "YlGnBu", "YlGnBu", "YlGnBu", "YlGnBu", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrRd", "YlOrRd", "YlOrRd", "YlOrRd", "Blues", "Blues", "Blues", "Blues", "Blues", "BuGn", "BuGn", "BuGn", "BuGn", "BuGn", "BuPu", "BuPu", "BuPu", "BuPu", "BuPu", "GnBu", "GnBu", "GnBu", "GnBu", "GnBu", "Greens", "Greens", "Greens", "Greens", "Greens", "Greys", "Greys", "Greys", "Greys", "Greys", "Oranges", "Oranges", "Oranges", "Oranges", "Oranges", "OrRd", "OrRd", "OrRd", "OrRd", "OrRd", "PuBu", "PuBu", "PuBu", "PuBu", "PuBu", "PuBuGn", "PuBuGn", "PuBuGn", "PuBuGn", "PuBuGn", "PuRd", "PuRd", "PuRd", "PuRd", "PuRd", "Purples", "Purples", "Purples", "Purples", "Purples", "RdPu", "RdPu", "RdPu", "RdPu", "RdPu", "Reds", "Reds", "Reds", "Reds", "Reds", "YlGn", "YlGn", "YlGn", "YlGn", "YlGn", "YlGnBu", "YlGnBu", "YlGnBu", "YlGnBu", "YlGnBu", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrRd", "YlOrRd", "YlOrRd", "YlOrRd", "YlOrRd", "Blues", "Blues", "Blues", "Blues", "Blues", "Blues", "BuGn", "BuGn", "BuGn", "BuGn", "BuGn", "BuGn", "BuPu", "BuPu", "BuPu", "BuPu", "BuPu", "BuPu", "GnBu", "GnBu", "GnBu", "GnBu", "GnBu", "GnBu", "Greens", "Greens", "Greens", "Greens", "Greens", "Greens", "Greys", "Greys", "Greys", "Greys", "Greys", "Greys", "Oranges", "Oranges", "Oranges", "Oranges", "Oranges", "Oranges", "OrRd", "OrRd", "OrRd", "OrRd", "OrRd", "OrRd", "PuBu", "PuBu", "PuBu", "PuBu", "PuBu", "PuBu", "PuBuGn", "PuBuGn", "PuBuGn", "PuBuGn", "PuBuGn", "PuBuGn", "PuRd", "PuRd", "PuRd", "PuRd", "PuRd", "PuRd", "Purples", "Purples", "Purples", "Purples", "Purples", "Purples", "RdPu", "RdPu", "RdPu", "RdPu", "RdPu", "RdPu", "Reds", "Reds", "Reds", "Reds", "Reds", "Reds", "YlGn", "YlGn", "YlGn", "YlGn", "YlGn", "YlGn", "YlGnBu", "YlGnBu", "YlGnBu", "YlGnBu", "YlGnBu", "YlGnBu", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrRd", "YlOrRd", "YlOrRd", "YlOrRd", "YlOrRd", "YlOrRd", "Blues", "Blues", "Blues", "Blues", "Blues", "Blues", "Blues", "BuGn", "BuGn", "BuGn", "BuGn", "BuGn", "BuGn", "BuGn", "BuPu", "BuPu", "BuPu", "BuPu", "BuPu", "BuPu", "BuPu", "GnBu", "GnBu", "GnBu", "GnBu", "GnBu", "GnBu", "GnBu", "Greens", "Greens", "Greens", "Greens", "Greens", "Greens", "Greens", "Greys", "Greys", "Greys", "Greys", "Greys", "Greys", "Greys", "Oranges", "Oranges", "Oranges", "Oranges", "Oranges", "Oranges", "Oranges", "OrRd", "OrRd", "OrRd", "OrRd", "OrRd", "OrRd", "OrRd", "PuBu", "PuBu", "PuBu", "PuBu", "PuBu", "PuBu", "PuBu", "PuBuGn", "PuBuGn", "PuBuGn", "PuBuGn", "PuBuGn", "PuBuGn", "PuBuGn", "PuRd", "PuRd", "PuRd", "PuRd", "PuRd", "PuRd", "PuRd", "Purples", "Purples", "Purples", "Purples", "Purples", "Purples", "Purples", "RdPu", "RdPu", "RdPu", "RdPu", "RdPu", "RdPu", "RdPu", "Reds", "Reds", "Reds", "Reds", "Reds", "Reds", "Reds", "YlGn", "YlGn", "YlGn", "YlGn", "YlGn", "YlGn", "YlGn", "YlGnBu", "YlGnBu", "YlGnBu", "YlGnBu", "YlGnBu", "YlGnBu", "YlGnBu", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrRd", "YlOrRd", "YlOrRd", "YlOrRd", "YlOrRd", "YlOrRd", "YlOrRd", "Blues", "Blues", "Blues", "Blues", "Blues", "Blues", "Blues", "Blues", "BuGn", "BuGn", "BuGn", "BuGn", "BuGn", "BuGn", "BuGn", "BuGn", "BuPu", "BuPu", "BuPu", "BuPu", "BuPu", "BuPu", "BuPu", "BuPu", "GnBu", "GnBu", "GnBu", "GnBu", "GnBu", "GnBu", "GnBu", "GnBu", "Greens", "Greens", "Greens", "Greens", "Greens", "Greens", "Greens", "Greens", "Greys", "Greys", "Greys", "Greys", "Greys", "Greys", "Greys", "Greys", "Oranges", "Oranges", "Oranges", "Oranges", "Oranges", "Oranges", "Oranges", "Oranges", "OrRd", "OrRd", "OrRd", "OrRd", "OrRd", "OrRd", "OrRd", "OrRd", "PuBu", "PuBu", "PuBu", "PuBu", "PuBu", "PuBu", "PuBu", "PuBu", "PuBuGn", "PuBuGn", "PuBuGn", "PuBuGn", "PuBuGn", "PuBuGn", "PuBuGn", "PuBuGn", "PuRd", "PuRd", "PuRd", "PuRd", "PuRd", "PuRd", "PuRd", "PuRd", "Purples", "Purples", "Purples", "Purples", "Purples", "Purples", "Purples", "Purples", "RdPu", "RdPu", "RdPu", "RdPu", "RdPu", "RdPu", "RdPu", "RdPu", "Reds", "Reds", "Reds", "Reds", "Reds", "Reds", "Reds", "Reds", "YlGn", "YlGn", "YlGn", "YlGn", "YlGn", "YlGn", "YlGn", "YlGn", "YlGnBu", "YlGnBu", "YlGnBu", "YlGnBu", "YlGnBu", "YlGnBu", "YlGnBu", "YlGnBu", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrRd", "YlOrRd", "YlOrRd", "YlOrRd", "YlOrRd", "YlOrRd", "YlOrRd", "YlOrRd", "Blues", "Blues", "Blues", "Blues", "Blues", "Blues", "Blues", "Blues", "Blues", "BuGn", "BuGn", "BuGn", "BuGn", "BuGn", "BuGn", "BuGn", "BuGn", "BuGn", "BuPu", "BuPu", "BuPu", "BuPu", "BuPu", "BuPu", "BuPu", "BuPu", "BuPu", "GnBu", "GnBu", "GnBu", "GnBu", "GnBu", "GnBu", "GnBu", "GnBu", "GnBu", "Greens", "Greens", "Greens", "Greens", "Greens", "Greens", "Greens", "Greens", "Greens", "Greys", "Greys", "Greys", "Greys", "Greys", "Greys", "Greys", "Greys", "Greys", "Oranges", "Oranges", "Oranges", "Oranges", "Oranges", "Oranges", "Oranges", "Oranges", "Oranges", "OrRd", "OrRd", "OrRd", "OrRd", "OrRd", "OrRd", "OrRd", "OrRd", "OrRd", "PuBu", "PuBu", "PuBu", "PuBu", "PuBu", "PuBu", "PuBu", "PuBu", "PuBu", "PuBuGn", "PuBuGn", "PuBuGn", "PuBuGn", "PuBuGn", "PuBuGn", "PuBuGn", "PuBuGn", "PuBuGn", "PuRd", "PuRd", "PuRd", "PuRd", "PuRd", "PuRd", "PuRd", "PuRd", "PuRd", "Purples", "Purples", "Purples", "Purples", "Purples", "Purples", "Purples", "Purples", "Purples", "RdPu", "RdPu", "RdPu", "RdPu", "RdPu", "RdPu", "RdPu", "RdPu", "RdPu", "Reds", "Reds", "Reds", "Reds", "Reds", "Reds", "Reds", "Reds", "Reds", "YlGn", "YlGn", "YlGn", "YlGn", "YlGn", "YlGn", "YlGn", "YlGn", "YlGn", "YlGnBu", "YlGnBu", "YlGnBu", "YlGnBu", "YlGnBu", "YlGnBu", "YlGnBu", "YlGnBu", "YlGnBu", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrBr", "YlOrRd", "YlOrRd", "YlOrRd", "YlOrRd", "YlOrRd", "YlOrRd", "YlOrRd", "YlOrRd", "YlOrRd"), class = "AsIs"), palette = structure(as.integer(c(1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5, 6, 6, 6, 7, 7, 7, 8, 8, 8, 9, 9, 9, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 6, 6, 6, 6, 7, 7, 7, 7, 8, 8, 8, 8, 9, 9, 9, 9, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 9, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5, 6, 6, 6, 7, 7, 7, 8, 8, 8, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 6, 6, 6, 6, 7, 7, 7, 7, 8, 8, 8, 8, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5, 6, 6, 6, 7, 7, 7, 8, 8, 8, 9, 9, 9, 10, 10, 10, 11, 11, 11, 12, 12, 12, 13, 13, 13, 14, 14, 14, 15, 15, 15, 16, 16, 16, 17, 17, 17, 18, 18, 18, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 6, 6, 6, 6, 7, 7, 7, 7, 8, 8, 8, 8, 9, 9, 9, 9, 10, 10, 10, 10, 11, 11, 11, 11, 12, 12, 12, 12, 13, 13, 13, 13, 14, 14, 14, 14, 15, 15, 15, 15, 16, 16, 16, 16, 17, 17, 17, 17, 18, 18, 18, 18, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 12, 12, 12, 12, 12, 13, 13, 13, 13, 13, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 16, 16, 16, 16, 16, 17, 17, 17, 17, 17, 18, 18, 18, 18, 18, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 13, 13, 13, 13, 13, 13, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 16, 16, 16, 16, 16, 16, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 18, 18, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 12, 13, 13, 13, 13, 13, 13, 13, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 16, 16, 16, 16, 16, 16, 16, 17, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 18, 18, 18, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 12, 12, 13, 13, 13, 13, 13, 13, 13, 13, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 16, 16, 16, 16, 16, 16, 16, 16, 17, 17, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 18, 18, 18, 18, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 12, 12, 12, 13, 13, 13, 13, 13, 13, 13, 13, 13, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 16, 16, 16, 16, 16, 16, 16, 16, 16, 17, 17, 17, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 18, 18, 18, 18, 18)), .Label = c("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r"), class = "factor"), number = as.integer(c(1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9)), red = as.integer(c(216, 245, 90, 233, 247, 161, 175, 247, 127, 241, 247, 153, 239, 247, 103, 239, 255, 153, 252, 255, 145, 252, 255, 145, 252, 255, 153, 166, 223, 128, 1, 208, 241, 184, 77, 123, 194, 166, 0, 230, 253, 178, 94, 202, 244, 146, 5, 202, 244, 186, 64, 215, 253, 171, 44, 215, 253, 166, 26, 215, 253, 171, 43, 166, 223, 245, 128, 1, 208, 241, 247, 184, 77, 123, 194, 247, 166, 0, 230, 253, 247, 178, 94, 202, 244, 247, 146, 5, 202, 244, 255, 186, 64, 215, 253, 255, 171, 44, 215, 253, 255, 166, 26, 215, 253, 255, 171, 43, 140, 216, 246, 199, 90, 1, 197, 233, 253, 230, 161, 77, 118, 175, 231, 217, 127, 27, 179, 241, 254, 216, 153, 84, 178, 239, 253, 209, 103, 33, 178, 239, 253, 224, 153, 77, 215, 252, 254, 224, 145, 69, 215, 252, 254, 217, 145, 26, 213, 252, 254, 230, 153, 50, 140, 216, 246, 245, 199, 90, 1, 197, 233, 253, 247, 230, 161, 77, 118, 175, 231, 247, 217, 127, 27, 179, 241, 254, 247, 216, 153, 84, 178, 239, 253, 247, 209, 103, 33, 178, 239, 253, 255, 224, 153, 77, 215, 252, 254, 255, 224, 145, 69, 215, 252, 254, 255, 217, 145, 26, 213, 252, 254, 255, 230, 153, 50, 140, 191, 223, 246, 199, 128, 53, 1, 197, 222, 241, 253, 230, 184, 127, 77, 118, 153, 194, 231, 217, 166, 90, 27, 179, 224, 253, 254, 216, 178, 128, 84, 178, 214, 244, 253, 209, 146, 67, 33, 178, 214, 244, 253, 224, 186, 135, 77, 215, 244, 253, 254, 224, 171, 116, 69, 215, 244, 253, 254, 217, 166, 102, 26, 213, 244, 253, 254, 230, 171, 102, 50, 140, 191, 223, 246, 245, 199, 128, 53, 1, 197, 222, 241, 253, 247, 230, 184, 127, 77, 118, 153, 194, 231, 247, 217, 166, 90, 27, 179, 224, 253, 254, 247, 216, 178, 128, 84, 178, 214, 244, 253, 247, 209, 146, 67, 33, 178, 214, 244, 253, 255, 224, 186, 135, 77, 215, 244, 253, 254, 255, 224, 171, 116, 69, 215, 244, 253, 254, 255, 217, 166, 102, 26, 213, 244, 253, 254, 255, 230, 171, 102, 50, 84, 140, 191, 223, 246, 199, 128, 53, 1, 0, 142, 197, 222, 241, 253, 230, 184, 127, 77, 39, 64, 118, 153, 194, 231, 217, 166, 90, 27, 0, 127, 179, 224, 253, 254, 216, 178, 128, 84, 45, 103, 178, 214, 244, 253, 209, 146, 67, 33, 5, 103, 178, 214, 244, 253, 224, 186, 135, 77, 26, 165, 215, 244, 253, 254, 224, 171, 116, 69, 49, 165, 215, 244, 253, 254, 217, 166, 102, 26, 0, 158, 213, 244, 253, 254, 230, 171, 102, 50, 94, 84, 140, 191, 223, 246, 245, 199, 128, 53, 1, 0, 142, 197, 222, 241, 253, 247, 230, 184, 127, 77, 39, 64, 118, 153, 194, 231, 247, 217, 166, 90, 27, 0, 127, 179, 224, 253, 254, 247, 216, 178, 128, 84, 45, 103, 178, 214, 244, 253, 247, 209, 146, 67, 33, 5, 103, 178, 214, 244, 253, 255, 224, 186, 135, 77, 26, 165, 215, 244, 253, 254, 255, 224, 171, 116, 69, 49, 165, 215, 244, 253, 254, 255, 217, 166, 102, 26, 0, 158, 213, 244, 253, 254, 255, 230, 171, 102, 50, 94, 127, 190, 253, 27, 217, 117, 166, 31, 178, 251, 179, 204, 179, 253, 203, 228, 55, 77, 102, 252, 141, 141, 255, 190, 127, 190, 253, 255, 27, 217, 117, 231, 166, 31, 178, 51, 251, 179, 204, 222, 179, 253, 203, 244, 228, 55, 77, 152, 102, 252, 141, 231, 141, 255, 190, 251, 127, 190, 253, 255, 56, 27, 217, 117, 231, 102, 166, 31, 178, 51, 251, 251, 179, 204, 222, 254, 179, 253, 203, 244, 230, 228, 55, 77, 152, 255, 102, 252, 141, 231, 166, 141, 255, 190, 251, 128, 127, 190, 253, 255, 56, 240, 27, 217, 117, 231, 102, 230, 166, 31, 178, 51, 251, 227, 251, 179, 204, 222, 254, 255, 179, 253, 203, 244, 230, 255, 228, 55, 77, 152, 255, 255, 102, 252, 141, 231, 166, 255, 141, 255, 190, 251, 128, 253, 127, 190, 253, 255, 56, 240, 191, 27, 217, 117, 231, 102, 230, 166, 166, 31, 178, 51, 251, 227, 253, 251, 179, 204, 222, 254, 255, 229, 179, 253, 203, 244, 230, 255, 241, 228, 55, 77, 152, 255, 255, 166, 102, 252, 141, 231, 166, 255, 229, 141, 255, 190, 251, 128, 253, 179, 127, 190, 253, 255, 56, 240, 191, 102, 27, 217, 117, 231, 102, 230, 166, 102, 166, 31, 178, 51, 251, 227, 253, 255, 251, 179, 204, 222, 254, 255, 229, 253, 179, 253, 203, 244, 230, 255, 241, 204, 228, 55, 77, 152, 255, 255, 166, 247, 102, 252, 141, 231, 166, 255, 229, 179, 141, 255, 190, 251, 128, 253, 179, 252, 166, 31, 178, 51, 251, 227, 253, 255, 202, 251, 179, 204, 222, 254, 255, 229, 253, 242, 228, 55, 77, 152, 255, 255, 166, 247, 153, 141, 255, 190, 251, 128, 253, 179, 252, 217, 166, 31, 178, 51, 251, 227, 253, 255, 202, 106, 141, 255, 190, 251, 128, 253, 179, 252, 217, 188, 166, 31, 178, 51, 251, 227, 253, 255, 202, 106, 255, 141, 255, 190, 251, 128, 253, 179, 252, 217, 188, 204, 166, 31, 178, 51, 251, 227, 253, 255, 202, 106, 255, 177, 141, 255, 190, 251, 128, 253, 179, 252, 217, 188, 204, 255, 222, 158, 49, 229, 153, 44, 224, 158, 136, 224, 168, 67, 229, 161, 49, 240, 189, 99, 254, 253, 230, 254, 253, 227, 236, 166, 43, 236, 166, 28, 231, 201, 221, 239, 188, 117, 253, 250, 197, 254, 252, 222, 247, 173, 49, 237, 127, 44, 255, 254, 217, 255, 254, 240, 239, 189, 107, 33, 237, 178, 102, 35, 237, 179, 140, 136, 240, 186, 123, 43, 237, 186, 116, 35, 247, 204, 150, 82, 254, 253, 253, 217, 254, 253, 252, 215, 241, 189, 116, 5, 246, 189, 103, 2, 241, 215, 223, 206, 242, 203, 158, 106, 254, 251, 247, 174, 254, 252, 251, 203, 255, 194, 120, 35, 255, 161, 65, 34, 255, 254, 254, 204, 255, 254, 253, 227, 239, 189, 107, 49, 8, 237, 178, 102, 44, 0, 237, 179, 140, 136, 129, 240, 186, 123, 67, 8, 237, 186, 116, 49, 0, 247, 204, 150, 99, 37, 254, 253, 253, 230, 166, 254, 253, 252, 227, 179, 241, 189, 116, 43, 4, 246, 189, 103, 28, 1, 241, 215, 223, 221, 152, 242, 203, 158, 117, 84, 254, 251, 247, 197, 122, 254, 252, 251, 222, 165, 255, 194, 120, 49, 0, 255, 161, 65, 44, 37, 255, 254, 254, 217, 153, 255, 254, 253, 240, 189, 239, 198, 158, 107, 49, 8, 237, 204, 153, 102, 44, 0, 237, 191, 158, 140, 136, 129, 240, 204, 168, 123, 67, 8, 237, 199, 161, 116, 49, 0, 247, 217, 189, 150, 99, 37, 254, 253, 253, 253, 230, 166, 254, 253, 253, 252, 227, 179, 241, 208, 166, 116, 43, 4, 246, 208, 166, 103, 28, 1, 241, 212, 201, 223, 221, 152, 242, 218, 188, 158, 117, 84, 254, 252, 250, 247, 197, 122, 254, 252, 252, 251, 222, 165, 255, 217, 173, 120, 49, 0, 255, 199, 127, 65, 44, 37, 255, 254, 254, 254, 217, 153, 255, 254, 254, 253, 240, 189, 239, 198, 158, 107, 66, 33, 8, 237, 204, 153, 102, 65, 35, 0, 237, 191, 158, 140, 140, 136, 110, 240, 204, 168, 123, 78, 43, 8, 237, 199, 161, 116, 65, 35, 0, 247, 217, 189, 150, 115, 82, 37, 254, 253, 253, 253, 241, 217, 140, 254, 253, 253, 252, 239, 215, 153, 241, 208, 166, 116, 54, 5, 3, 246, 208, 166, 103, 54, 2, 1, 241, 212, 201, 223, 231, 206, 145, 242, 218, 188, 158, 128, 106, 74, 254, 252, 250, 247, 221, 174, 122, 254, 252, 252, 251, 239, 203, 153, 255, 217, 173, 120, 65, 35, 0, 255, 199, 127, 65, 29, 34, 12, 255, 254, 254, 254, 236, 204, 140, 255, 254, 254, 253, 252, 227, 177, 247, 222, 198, 158, 107, 66, 33, 8, 247, 229, 204, 153, 102, 65, 35, 0, 247, 224, 191, 158, 140, 140, 136, 110, 247, 224, 204, 168, 123, 78, 43, 8, 247, 229, 199, 161, 116, 65, 35, 0, 255, 240, 217, 189, 150, 115, 82, 37, 255, 254, 253, 253, 253, 241, 217, 140, 255, 254, 253, 253, 252, 239, 215, 153, 255, 236, 208, 166, 116, 54, 5, 3, 255, 236, 208, 166, 103, 54, 2, 1, 247, 231, 212, 201, 223, 231, 206, 145, 252, 239, 218, 188, 158, 128, 106, 74, 255, 253, 252, 250, 247, 221, 174, 122, 255, 254, 252, 252, 251, 239, 203, 153, 255, 247, 217, 173, 120, 65, 35, 0, 255, 237, 199, 127, 65, 29, 34, 12, 255, 255, 254, 254, 254, 236, 204, 140, 255, 255, 254, 254, 253, 252, 227, 177, 247, 222, 198, 158, 107, 66, 33, 8, 8, 247, 229, 204, 153, 102, 65, 35, 0, 0, 247, 224, 191, 158, 140, 140, 136, 129, 77, 247, 224, 204, 168, 123, 78, 43, 8, 8, 247, 229, 199, 161, 116, 65, 35, 0, 0, 255, 240, 217, 189, 150, 115, 82, 37, 0, 255, 254, 253, 253, 253, 241, 217, 166, 127, 255, 254, 253, 253, 252, 239, 215, 179, 127, 255, 236, 208, 166, 116, 54, 5, 4, 2, 255, 236, 208, 166, 103, 54, 2, 1, 1, 247, 231, 212, 201, 223, 231, 206, 152, 103, 252, 239, 218, 188, 158, 128, 106, 84, 63, 255, 253, 252, 250, 247, 221, 174, 122, 73, 255, 254, 252, 252, 251, 239, 203, 165, 103, 255, 247, 217, 173, 120, 65, 35, 0, 0, 255, 237, 199, 127, 65, 29, 34, 37, 8, 255, 255, 254, 254, 254, 236, 204, 153, 102, 255, 255, 254, 254, 253, 252, 227, 189, 128)), green = as.integer(c(179, 245, 180, 163, 247, 215, 141, 247, 191, 163, 247, 142, 138, 247, 169, 138, 255, 153, 141, 255, 191, 141, 255, 207, 141, 255, 213, 97, 194, 205, 133, 28, 182, 225, 172, 50, 165, 219, 136, 97, 184, 171, 60, 0, 165, 197, 113, 0, 165, 186, 64, 25, 174, 217, 123, 25, 174, 217, 150, 25, 174, 221, 131, 97, 194, 245, 205, 133, 28, 182, 247, 225, 172, 50, 165, 247, 219, 136, 97, 184, 247, 171, 60, 0, 165, 247, 197, 113, 0, 165, 255, 186, 64, 25, 174, 255, 217, 123, 25, 174, 255, 217, 150, 25, 174, 255, 221, 131, 81, 179, 232, 234, 180, 102, 27, 163, 224, 245, 215, 146, 42, 141, 212, 240, 191, 120, 88, 163, 224, 218, 142, 39, 24, 138, 219, 229, 169, 102, 24, 138, 219, 224, 153, 77, 48, 141, 224, 243, 191, 117, 48, 141, 224, 239, 207, 152, 62, 141, 224, 245, 213, 136, 81, 179, 232, 245, 234, 180, 102, 27, 163, 224, 247, 245, 215, 146, 42, 141, 212, 247, 240, 191, 120, 88, 163, 224, 247, 218, 142, 39, 24, 138, 219, 247, 229, 169, 102, 24, 138, 219, 255, 224, 153, 77, 48, 141, 224, 255, 243, 191, 117, 48, 141, 224, 255, 239, 207, 152, 62, 141, 224, 255, 245, 213, 136, 81, 129, 194, 232, 234, 205, 151, 102, 27, 119, 182, 224, 245, 225, 188, 146, 42, 112, 165, 212, 240, 219, 174, 120, 88, 130, 184, 224, 218, 171, 115, 39, 24, 96, 165, 219, 229, 197, 147, 102, 24, 96, 165, 219, 224, 186, 135, 77, 48, 109, 174, 224, 243, 217, 173, 117, 48, 109, 174, 224, 239, 217, 189, 152, 62, 109, 174, 224, 245, 221, 194, 136, 81, 129, 194, 232, 245, 234, 205, 151, 102, 27, 119, 182, 224, 247, 245, 225, 188, 146, 42, 112, 165, 212, 247, 240, 219, 174, 120, 88, 130, 184, 224, 247, 218, 171, 115, 39, 24, 96, 165, 219, 247, 229, 197, 147, 102, 24, 96, 165, 219, 255, 224, 186, 135, 77, 48, 109, 174, 224, 255, 243, 217, 173, 117, 48, 109, 174, 224, 255, 239, 217, 189, 152, 62, 109, 174, 224, 255, 245, 221, 194, 136, 48, 81, 129, 194, 232, 234, 205, 151, 102, 60, 1, 27, 119, 182, 224, 245, 225, 188, 146, 100, 0, 42, 112, 165, 212, 240, 219, 174, 120, 68, 59, 88, 130, 184, 224, 218, 171, 115, 39, 0, 0, 24, 96, 165, 219, 229, 197, 147, 102, 48, 0, 24, 96, 165, 219, 224, 186, 135, 77, 26, 0, 48, 109, 174, 224, 243, 217, 173, 117, 54, 0, 48, 109, 174, 224, 239, 217, 189, 152, 104, 1, 62, 109, 174, 224, 245, 221, 194, 136, 79, 48, 81, 129, 194, 232, 245, 234, 205, 151, 102, 60, 1, 27, 119, 182, 224, 247, 245, 225, 188, 146, 100, 0, 42, 112, 165, 212, 247, 240, 219, 174, 120, 68, 59, 88, 130, 184, 224, 247, 218, 171, 115, 39, 0, 0, 24, 96, 165, 219, 247, 229, 197, 147, 102, 48, 0, 24, 96, 165, 219, 255, 224, 186, 135, 77, 26, 0, 48, 109, 174, 224, 255, 243, 217, 173, 117, 54, 0, 48, 109, 174, 224, 255, 239, 217, 189, 152, 104, 1, 62, 109, 174, 224, 255, 245, 221, 194, 136, 79, 201, 174, 192, 158, 95, 112, 206, 120, 223, 180, 205, 235, 226, 205, 213, 26, 126, 175, 194, 141, 160, 211, 255, 186, 201, 174, 192, 255, 158, 95, 112, 41, 206, 120, 223, 160, 180, 205, 235, 203, 226, 205, 213, 202, 26, 126, 175, 78, 194, 141, 160, 138, 211, 255, 186, 128, 201, 174, 192, 255, 108, 158, 95, 112, 41, 166, 206, 120, 223, 160, 154, 180, 205, 235, 203, 217, 226, 205, 213, 202, 245, 26, 126, 175, 78, 127, 194, 141, 160, 138, 216, 211, 255, 186, 128, 177, 201, 174, 192, 255, 108, 2, 158, 95, 112, 41, 166, 171, 206, 120, 223, 160, 154, 26, 180, 205, 235, 203, 217, 255, 226, 205, 213, 202, 245, 242, 26, 126, 175, 78, 127, 255, 194, 141, 160, 138, 216, 217, 211, 255, 186, 128, 177, 180, 201, 174, 192, 255, 108, 2, 91, 158, 95, 112, 41, 166, 171, 118, 206, 120, 223, 160, 154, 26, 191, 180, 205, 235, 203, 217, 255, 216, 226, 205, 213, 202, 245, 242, 226, 26, 126, 175, 78, 127, 255, 86, 194, 141, 160, 138, 216, 217, 196, 211, 255, 186, 128, 177, 180, 222, 201, 174, 192, 255, 108, 2, 91, 102, 158, 95, 112, 41, 166, 171, 118, 102, 206, 120, 223, 160, 154, 26, 191, 127, 180, 205, 235, 203, 217, 255, 216, 218, 226, 205, 213, 202, 245, 242, 226, 204, 26, 126, 175, 78, 127, 255, 86, 129, 194, 141, 160, 138, 216, 217, 196, 179, 211, 255, 186, 128, 177, 180, 222, 205, 206, 120, 223, 160, 154, 26, 191, 127, 178, 180, 205, 235, 203, 217, 255, 216, 218, 242, 26, 126, 175, 78, 127, 255, 86, 129, 153, 211, 255, 186, 128, 177, 180, 222, 205, 217, 206, 120, 223, 160, 154, 26, 191, 127, 178, 61, 211, 255, 186, 128, 177, 180, 222, 205, 217, 128, 206, 120, 223, 160, 154, 26, 191, 127, 178, 61, 255, 211, 255, 186, 128, 177, 180, 222, 205, 217, 128, 235, 206, 120, 223, 160, 154, 26, 191, 127, 178, 61, 255, 89, 211, 255, 186, 128, 177, 180, 222, 205, 217, 128, 235, 237, 235, 202, 130, 245, 216, 162, 236, 188, 86, 243, 221, 162, 245, 217, 163, 240, 189, 99, 230, 174, 85, 232, 187, 74, 231, 189, 140, 226, 189, 144, 225, 148, 28, 237, 189, 107, 224, 159, 27, 224, 146, 45, 252, 221, 163, 248, 205, 127, 247, 196, 95, 237, 178, 59, 243, 215, 174, 113, 248, 226, 194, 139, 248, 205, 150, 65, 249, 228, 204, 140, 248, 228, 196, 139, 247, 204, 150, 82, 237, 190, 141, 71, 240, 204, 141, 48, 238, 201, 169, 112, 239, 201, 169, 129, 238, 181, 101, 18, 240, 201, 154, 81, 235, 180, 104, 1, 229, 174, 106, 24, 255, 230, 198, 132, 255, 218, 182, 94, 255, 217, 153, 76, 255, 204, 141, 26, 243, 215, 174, 130, 81, 248, 226, 194, 162, 109, 248, 205, 150, 86, 15, 249, 228, 204, 162, 104, 248, 228, 196, 163, 109, 247, 204, 150, 99, 37, 237, 190, 141, 85, 54, 240, 204, 141, 74, 0, 238, 201, 169, 140, 90, 239, 201, 169, 144, 108, 238, 181, 101, 28, 0, 240, 201, 154, 107, 39, 235, 180, 104, 27, 1, 229, 174, 106, 45, 15, 255, 230, 198, 163, 104, 255, 218, 182, 127, 52, 255, 217, 153, 95, 52, 255, 204, 141, 59, 0, 243, 219, 202, 174, 130, 81, 248, 236, 216, 194, 162, 109, 248, 211, 188, 150, 86, 15, 249, 235, 221, 204, 162, 104, 248, 233, 217, 196, 163, 109, 247, 217, 189, 150, 99, 37, 237, 208, 174, 141, 85, 54, 240, 212, 187, 141, 74, 0, 238, 209, 189, 169, 140, 90, 239, 209, 189, 169, 144, 108, 238, 185, 148, 101, 28, 0, 240, 218, 189, 154, 107, 39, 235, 197, 159, 104, 27, 1, 229, 187, 146, 106, 45, 15, 255, 240, 221, 198, 163, 104, 255, 233, 205, 182, 127, 52, 255, 227, 196, 153, 95, 52, 255, 217, 178, 141, 59, 0, 243, 219, 202, 174, 146, 113, 69, 248, 236, 216, 194, 174, 139, 88, 248, 211, 188, 150, 107, 65, 1, 249, 235, 221, 204, 179, 140, 88, 248, 233, 217, 196, 171, 139, 90, 247, 217, 189, 150, 115, 82, 37, 237, 208, 174, 141, 105, 72, 45, 240, 212, 187, 141, 101, 48, 0, 238, 209, 189, 169, 144, 112, 78, 239, 209, 189, 169, 144, 129, 100, 238, 185, 148, 101, 41, 18, 0, 240, 218, 189, 154, 125, 81, 20, 235, 197, 159, 104, 52, 1, 1, 229, 187, 146, 106, 59, 24, 0, 255, 240, 221, 198, 171, 132, 90, 255, 233, 205, 182, 145, 94, 44, 255, 227, 196, 153, 112, 76, 45, 255, 217, 178, 141, 78, 26, 0, 251, 235, 219, 202, 174, 146, 113, 69, 252, 245, 236, 216, 194, 174, 139, 88, 252, 236, 211, 188, 150, 107, 65, 1, 252, 243, 235, 221, 204, 179, 140, 88, 252, 245, 233, 217, 196, 171, 139, 90, 255, 240, 217, 189, 150, 115, 82, 37, 245, 230, 208, 174, 141, 105, 72, 45, 247, 232, 212, 187, 141, 101, 48, 0, 247, 231, 209, 189, 169, 144, 112, 78, 247, 226, 209, 189, 169, 144, 129, 100, 244, 225, 185, 148, 101, 41, 18, 0, 251, 237, 218, 189, 154, 125, 81, 20, 247, 224, 197, 159, 104, 52, 1, 1, 245, 224, 187, 146, 106, 59, 24, 0, 255, 252, 240, 221, 198, 171, 132, 90, 255, 248, 233, 205, 182, 145, 94, 44, 255, 247, 227, 196, 153, 112, 76, 45, 255, 237, 217, 178, 141, 78, 26, 0, 251, 235, 219, 202, 174, 146, 113, 81, 48, 252, 245, 236, 216, 194, 174, 139, 109, 68, 252, 236, 211, 188, 150, 107, 65, 15, 0, 252, 243, 235, 221, 204, 179, 140, 104, 64, 252, 245, 233, 217, 196, 171, 139, 109, 68, 255, 240, 217, 189, 150, 115, 82, 37, 0, 245, 230, 208, 174, 141, 105, 72, 54, 39, 247, 232, 212, 187, 141, 101, 48, 0, 0, 247, 231, 209, 189, 169, 144, 112, 90, 56, 247, 226, 209, 189, 169, 144, 129, 108, 70, 244, 225, 185, 148, 101, 41, 18, 0, 0, 251, 237, 218, 189, 154, 125, 81, 39, 0, 247, 224, 197, 159, 104, 52, 1, 1, 0, 245, 224, 187, 146, 106, 59, 24, 15, 0, 255, 252, 240, 221, 198, 171, 132, 104, 69, 255, 248, 233, 205, 182, 145, 94, 52, 29, 255, 247, 227, 196, 153, 112, 76, 52, 37, 255, 237, 217, 178, 141, 78, 26, 0, 0)), blue = as.integer(c(101, 245, 172, 201, 247, 106, 195, 247, 123, 64, 247, 195, 98, 247, 207, 98, 255, 153, 89, 191, 219, 89, 191, 96, 89, 191, 148, 26, 125, 193, 113, 139, 218, 134, 38, 148, 207, 160, 55, 1, 99, 210, 153, 32, 130, 222, 176, 32, 130, 186, 64, 28, 97, 233, 182, 28, 97, 106, 65, 28, 97, 164, 186, 26, 125, 245, 193, 113, 139, 218, 247, 134, 38, 148, 207, 247, 160, 55, 1, 99, 247, 210, 153, 32, 130, 247, 222, 176, 32, 130, 255, 186, 64, 28, 97, 191, 233, 182, 28, 97, 191, 106, 65, 28, 97, 191, 164, 186, 10, 101, 195, 229, 172, 94, 125, 201, 239, 208, 106, 33, 131, 195, 232, 211, 123, 55, 6, 64, 182, 235, 195, 136, 43, 98, 199, 240, 207, 172, 43, 98, 199, 224, 153, 77, 39, 89, 144, 248, 219, 180, 39, 89, 139, 139, 96, 80, 79, 89, 139, 152, 148, 189, 10, 101, 195, 245, 229, 172, 94, 125, 201, 239, 247, 208, 106, 33, 131, 195, 232, 247, 211, 123, 55, 6, 64, 182, 247, 235, 195, 136, 43, 98, 199, 247, 240, 207, 172, 43, 98, 199, 255, 224, 153, 77, 39, 89, 144, 191, 248, 219, 180, 39, 89, 139, 191, 139, 96, 80, 79, 89, 139, 191, 152, 148, 189, 10, 45, 125, 195, 229, 193, 143, 94, 125, 174, 218, 239, 208, 134, 65, 33, 131, 171, 207, 232, 211, 160, 97, 55, 6, 20, 99, 182, 235, 210, 172, 136, 43, 77, 130, 199, 240, 222, 195, 172, 43, 77, 130, 199, 224, 186, 135, 77, 39, 67, 97, 144, 248, 233, 209, 180, 39, 67, 97, 139, 139, 106, 99, 80, 79, 67, 97, 139, 152, 164, 165, 189, 10, 45, 125, 195, 245, 229, 193, 143, 94, 125, 174, 218, 239, 247, 208, 134, 65, 33, 131, 171, 207, 232, 247, 211, 160, 97, 55, 6, 20, 99, 182, 247, 235, 210, 172, 136, 43, 77, 130, 199, 247, 240, 222, 195, 172, 43, 77, 130, 199, 255, 224, 186, 135, 77, 39, 67, 97, 144, 191, 248, 233, 209, 180, 39, 67, 97, 139, 191, 139, 106, 99, 80, 79, 67, 97, 139, 191, 152, 164, 165, 189, 5, 10, 45, 125, 195, 229, 193, 143, 94, 48, 82, 125, 174, 218, 239, 208, 134, 65, 33, 25, 75, 131, 171, 207, 232, 211, 160, 97, 55, 27, 8, 6, 20, 99, 182, 235, 210, 172, 136, 75, 31, 43, 77, 130, 199, 240, 222, 195, 172, 97, 31, 43, 77, 130, 199, 224, 186, 135, 77, 26, 38, 39, 67, 97, 144, 248, 233, 209, 180, 149, 38, 39, 67, 97, 139, 139, 106, 99, 80, 55, 66, 79, 67, 97, 139, 152, 164, 165, 189, 162, 5, 10, 45, 125, 195, 245, 229, 193, 143, 94, 48, 82, 125, 174, 218, 239, 247, 208, 134, 65, 33, 25, 75, 131, 171, 207, 232, 247, 211, 160, 97, 55, 27, 8, 6, 20, 99, 182, 247, 235, 210, 172, 136, 75, 31, 43, 77, 130, 199, 247, 240, 222, 195, 172, 97, 31, 43, 77, 130, 199, 255, 224, 186, 135, 77, 26, 38, 39, 67, 97, 144, 191, 248, 233, 209, 180, 149, 38, 39, 67, 97, 139, 191, 139, 106, 99, 80, 55, 66, 79, 67, 97, 139, 191, 152, 164, 165, 189, 162, 127, 212, 134, 119, 2, 179, 227, 180, 138, 174, 227, 197, 205, 172, 232, 28, 184, 74, 165, 98, 203, 199, 179, 218, 127, 212, 134, 153, 119, 2, 179, 138, 227, 180, 138, 44, 174, 227, 197, 228, 205, 172, 232, 228, 28, 184, 74, 163, 165, 98, 203, 195, 199, 179, 218, 114, 127, 212, 134, 153, 176, 119, 2, 179, 138, 30, 227, 180, 138, 44, 153, 174, 227, 197, 228, 166, 205, 172, 232, 228, 201, 28, 184, 74, 163, 0, 165, 98, 203, 195, 84, 199, 179, 218, 114, 211, 127, 212, 134, 153, 176, 127, 119, 2, 179, 138, 30, 2, 227, 180, 138, 44, 153, 28, 174, 227, 197, 228, 166, 204, 205, 172, 232, 228, 201, 174, 28, 184, 74, 163, 0, 51, 165, 98, 203, 195, 84, 47, 199, 179, 218, 114, 211, 98, 127, 212, 134, 153, 176, 127, 23, 119, 2, 179, 138, 30, 2, 29, 227, 180, 138, 44, 153, 28, 111, 174, 227, 197, 228, 166, 204, 189, 205, 172, 232, 228, 201, 174, 204, 28, 184, 74, 163, 0, 51, 40, 165, 98, 203, 195, 84, 47, 148, 199, 179, 218, 114, 211, 98, 105, 127, 212, 134, 153, 176, 127, 23, 102, 119, 2, 179, 138, 30, 2, 29, 102, 227, 180, 138, 44, 153, 28, 111, 0, 174, 227, 197, 228, 166, 204, 189, 236, 205, 172, 232, 228, 201, 174, 204, 204, 28, 184, 74, 163, 0, 51, 40, 191, 165, 98, 203, 195, 84, 47, 148, 179, 199, 179, 218, 114, 211, 98, 105, 229, 227, 180, 138, 44, 153, 28, 111, 0, 214, 174, 227, 197, 228, 166, 204, 189, 236, 242, 28, 184, 74, 163, 0, 51, 40, 191, 153, 199, 179, 218, 114, 211, 98, 105, 229, 217, 227, 180, 138, 44, 153, 28, 111, 0, 214, 154, 199, 179, 218, 114, 211, 98, 105, 229, 217, 189, 227, 180, 138, 44, 153, 28, 111, 0, 214, 154, 153, 199, 179, 218, 114, 211, 98, 105, 229, 217, 189, 197, 227, 180, 138, 44, 153, 28, 111, 0, 214, 154, 153, 40, 199, 179, 218, 114, 211, 98, 105, 229, 217, 189, 197, 111, 247, 225, 189, 249, 201, 95, 244, 218, 167, 219, 181, 202, 224, 155, 84, 240, 189, 99, 206, 107, 13, 200, 132, 51, 242, 219, 190, 240, 219, 153, 239, 199, 119, 245, 220, 177, 221, 181, 138, 210, 114, 38, 185, 142, 84, 177, 187, 184, 188, 79, 14, 160, 76, 32, 255, 231, 214, 181, 251, 226, 164, 69, 251, 227, 198, 157, 232, 188, 196, 190, 233, 179, 118, 69, 247, 204, 150, 82, 222, 133, 60, 1, 217, 138, 89, 31, 246, 225, 207, 176, 247, 225, 207, 138, 246, 216, 176, 86, 247, 226, 200, 163, 226, 185, 161, 126, 217, 145, 74, 29, 204, 153, 121, 67, 204, 180, 196, 168, 212, 142, 41, 2, 178, 92, 60, 28, 255, 231, 214, 189, 156, 251, 226, 164, 95, 44, 251, 227, 198, 167, 124, 232, 188, 196, 202, 172, 233, 179, 118, 84, 44, 247, 204, 150, 99, 37, 222, 133, 60, 13, 3, 217, 138, 89, 51, 0, 246, 225, 207, 190, 141, 247, 225, 207, 153, 89, 246, 216, 176, 119, 67, 247, 226, 200, 177, 143, 226, 185, 161, 138, 119, 217, 145, 74, 38, 21, 204, 153, 121, 84, 55, 204, 180, 196, 184, 148, 212, 142, 41, 14, 4, 178, 92, 60, 32, 38, 255, 239, 225, 214, 189, 156, 251, 230, 201, 164, 95, 44, 251, 230, 218, 198, 167, 124, 232, 197, 181, 196, 202, 172, 233, 192, 155, 118, 84, 44, 247, 217, 189, 150, 99, 37, 222, 162, 107, 60, 13, 3, 217, 158, 132, 89, 51, 0, 246, 230, 219, 207, 190, 141, 247, 230, 219, 207, 153, 89, 246, 218, 199, 176, 119, 67, 247, 235, 220, 200, 177, 143, 226, 192, 181, 161, 138, 119, 217, 161, 114, 74, 38, 21, 204, 163, 142, 121, 84, 55, 204, 180, 187, 196, 184, 148, 212, 145, 79, 41, 14, 4, 178, 118, 76, 60, 32, 38, 255, 239, 225, 214, 198, 181, 148, 251, 230, 201, 164, 118, 69, 36, 251, 230, 218, 198, 177, 157, 107, 232, 197, 181, 196, 211, 190, 158, 233, 192, 155, 118, 93, 69, 50, 247, 217, 189, 150, 115, 82, 37, 222, 162, 107, 60, 19, 1, 4, 217, 158, 132, 89, 72, 31, 0, 246, 230, 219, 207, 192, 176, 123, 247, 230, 219, 207, 192, 138, 80, 246, 218, 199, 176, 138, 86, 63, 247, 235, 220, 200, 186, 163, 134, 226, 192, 181, 161, 151, 126, 119, 217, 161, 114, 74, 44, 29, 13, 204, 163, 142, 121, 93, 67, 50, 204, 180, 187, 196, 192, 168, 132, 212, 145, 79, 41, 20, 2, 4, 178, 118, 76, 60, 42, 28, 38, 255, 247, 239, 225, 214, 198, 181, 148, 253, 249, 230, 201, 164, 118, 69, 36, 253, 244, 230, 218, 198, 177, 157, 107, 240, 219, 197, 181, 196, 211, 190, 158, 245, 224, 192, 155, 118, 93, 69, 50, 255, 240, 217, 189, 150, 115, 82, 37, 235, 206, 162, 107, 60, 19, 1, 4, 236, 200, 158, 132, 89, 72, 31, 0, 251, 242, 230, 219, 207, 192, 176, 123, 251, 240, 230, 219, 207, 192, 138, 80, 249, 239, 218, 199, 176, 138, 86, 63, 253, 245, 235, 220, 200, 186, 163, 134, 243, 221, 192, 181, 161, 151, 126, 119, 240, 210, 161, 114, 74, 44, 29, 13, 229, 185, 163, 142, 121, 93, 67, 50, 217, 177, 180, 187, 196, 192, 168, 132, 229, 188, 145, 79, 41, 20, 2, 4, 204, 160, 118, 76, 60, 42, 28, 38, 255, 247, 239, 225, 214, 198, 181, 156, 107, 253, 249, 230, 201, 164, 118, 69, 44, 27, 253, 244, 230, 218, 198, 177, 157, 124, 75, 240, 219, 197, 181, 196, 211, 190, 172, 129, 245, 224, 192, 155, 118, 93, 69, 44, 27, 255, 240, 217, 189, 150, 115, 82, 37, 0, 235, 206, 162, 107, 60, 19, 1, 3, 4, 236, 200, 158, 132, 89, 72, 31, 0, 0, 251, 242, 230, 219, 207, 192, 176, 141, 88, 251, 240, 230, 219, 207, 192, 138, 89, 54, 249, 239, 218, 199, 176, 138, 86, 67, 31, 253, 245, 235, 220, 200, 186, 163, 143, 125, 243, 221, 192, 181, 161, 151, 126, 119, 106, 240, 210, 161, 114, 74, 44, 29, 21, 13, 229, 185, 163, 142, 121, 93, 67, 55, 41, 217, 177, 180, 187, 196, 192, 168, 148, 88, 229, 188, 145, 79, 41, 20, 2, 4, 6, 204, 160, 118, 76, 60, 42, 28, 38, 38))), .Names = c("type", "nclass", "name", "palette", "number", "red", "green", "blue"), row.names = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", "37", "38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "49", "50", "51", "52", "53", "54", "55", "56", "57", "58", "59", "60", "61", "62", "63", "64", "65", "66", "67", "68", "69", "70", "71", "72", "73", "74", "75", "76", "77", "78", "79", "80", "81", "82", "83", "84", "85", "86", "87", "88", "89", "90", "91", "92", "93", "94", "95", "96", "97", "98", "99", "100", "101", "102", "103", "104", "105", "106", "107", "108", "109", "110", "111", "112", "113", "114", "115", "116", "117", "118", "119", "120", "121", "122", "123", "124", "125", "126", "127", "128", "129", "130", "131", "132", "133", "134", "135", "136", "137", "138", "139", "140", "141", "142", "143", "144", "145", "146", "147", "148", "149", "150", "151", "152", "153", "154", "155", "156", "157", "158", "159", "160", "161", "162", "163", "164", "165", "166", "167", "168", "169", "170", "171", "172", "173", "174", "175", "176", "177", "178", "179", "180", "181", "182", "183", "184", "185", "186", "187", "188", "189", "190", "191", "192", "193", "194", "195", "196", "197", "198", "199", "200", "201", "202", "203", "204", "205", "206", "207", "208", "209", "210", "211", "212", "213", "214", "215", "216", "217", "218", "219", "220", "221", "222", "223", "224", "225", "226", "227", "228", "229", "230", "231", "232", "233", "234", "235", "236", "237", "238", "239", "240", "241", "242", "243", "244", "245", "246", "247", "248", "249", "250", "251", "252", "253", "254", "255", "256", "257", "258", "259", "260", "261", "262", "263", "264", "265", "266", "267", "268", "269", "270", "271", "272", "273", "274", "275", "276", "277", "278", "279", "280", "281", "282", "283", "284", "285", "286", "287", "288", "289", "290", "291", "292", "293", "294", "295", "296", "297", "298", "299", "300", "301", "302", "303", "304", "305", "306", "307", "308", "309", "310", "311", "312", "313", "314", "315", "316", "317", "318", "319", "320", "321", "322", "323", "324", "325", "326", "327", "328", "329", "330", "331", "332", "333", "334", "335", "336", "337", "338", "339", "340", "341", "342", "343", "344", "345", "346", "347", "348", "349", "350", "351", "352", "353", "354", "355", "356", "357", "358", "359", "360", "361", "362", "363", "364", "365", "366", "367", "368", "369", "370", "371", "372", "373", "374", "375", "376", "377", "378", "379", "380", "381", "382", "383", "384", "385", "386", "387", "388", "389", "390", "391", "392", "393", "394", "395", "396", "397", "398", "399", "400", "401", "402", "403", "404", "405", "406", "407", "408", "409", "410", "411", "412", "413", "414", "415", "416", "417", "418", "419", "420", "421", "422", "423", "424", "425", "426", "427", "428", "429", "430", "431", "432", "433", "434", "435", "436", "437", "438", "439", "440", "441", "442", "443", "444", "445", "446", "447", "448", "449", "450", "451", "452", "453", "454", "455", "456", "457", "458", "459", "460", "461", "462", "463", "464", "465", "466", "467", "468", "469", "470", "471", "472", "473", "474", "475", "476", "477", "478", "479", "480", "481", "482", "483", "484", "485", "486", "487", "488", "489", "490", "491", "492", "493", "494", "495", "496", "497", "498", "499", "500", "501", "502", "503", "504", "505", "506", "507", "508", "509", "510", "511", "512", "513", "514", "515", "516", "517", "518", "519", "520", "521", "522", "523", "524", "525", "526", "527", "528", "529", "530", "531", "532", "533", "534", "535", "536", "537", "538", "539", "540", "541", "542", "543", "544", "545", "546", "547", "548", "549", "550", "551", "552", "553", "554", "555", "556", "557", "558", "559", "560", "561", "562", "563", "564", "565", "566", "567", "568", "569", "570", "571", "572", "573", "574", "575", "576", "577", "578", "579", "580", "581", "582", "583", "584", "585", "586", "587", "588", "589", "590", "591", "592", "593", "594", "595", "596", "597", "598", "599", "600", "601", "602", "603", "604", "605", "606", "607", "608", "609", "610", "611", "612", "613", "614", "615", "616", "617", "618", "619", "620", "621", "622", "623", "624", "625", "626", "627", "628", "629", "630", "631", "632", "633", "634", "635", "636", "637", "638", "639", "640", "641", "642", "643", "644", "645", "646", "647", "648", "649", "650", "651", "652", "653", "654", "655", "656", "657", "658", "659", "660", "661", "662", "663", "664", "665", "666", "667", "668", "669", "670", "671", "672", "673", "674", "675", "676", "677", "678", "679", "680", "681", "682", "683", "684", "685", "686", "687", "688", "689", "690", "691", "692", "693", "694", "695", "696", "697", "698", "699", "700", "701", "702", "703", "704", "705", "706", "707", "708", "709", "710", "711", "712", "713", "714", "715", "716", "717", "718", "719", "720", "721", "722", "723", "724", "725", "726", "727", "728", "729", "730", "731", "732", "733", "734", "735", "736", "737", "738", "739", "740", "741", "742", "743", "744", "745", "746", "747", "748", "749", "750", "751", "752", "753", "754", "755", "756", "757", "758", "759", "760", "761", "762", "763", "764", "765", "766", "767", "768", "769", "770", "771", "772", "773", "774", "775", "776", "777", "778", "779", "780", "781", "782", "783", "784", "785", "786", "787", "788", "789", "790", "791", "792", "793", "794", "795", "796", "797", "798", "799", "800", "801", "802", "803", "804", "805", "806", "807", "808", "809", "810", "811", "812", "813", "814", "815", "816", "817", "818", "819", "820", "821", "822", "823", "824", "825", "826", "827", "828", "829", "830", "831", "832", "833", "834", "835", "836", "837", "838", "839", "840", "841", "842", "843", "844", "845", "846", "847", "848", "849", "850", "851", "852", "853", "854", "855", "856", "857", "858", "859", "860", "861", "862", "863", "864", "865", "866", "867", "868", "869", "870", "871", "872", "873", "874", "875", "876", "877", "878", "879", "880", "881", "882", "883", "884", "885", "886", "887", "888", "889", "890", "891", "892", "893", "894", "895", "896", "897", "898", "899", "900", "901", "902", "903", "904", "905", "906", "907", "908", "909", "910", "911", "912", "913", "914", "915", "916", "917", "918", "919", "920", "921", "922", "923", "924", "925", "926", "927", "928", "929", "930", "931", "932", "933", "934", "935", "936", "937", "938", "939", "940", "941", "942", "943", "944", "945", "946", "947", "948", "949", "950", "951", "952", "953", "954", "955", "956", "957", "958", "959", "960", "961", "962", "963", "964", "965", "966", "967", "968", "969", "970", "971", "972", "973", "974", "975", "976", "977", "978", "979", "980", "981", "982", "983", "984", "985", "986", "987", "988", "989", "990", "991", "992", "993", "994", "995", "996", "997", "998", "999", "1000", "1001", "1002", "1003", "1004", "1005", "1006", "1007", "1008", "1009", "1010", "1011", "1012", "1013", "1014", "1015", "1016", "1017", "1018", "1019", "1020", "1021", "1022", "1023", "1024", "1025", "1026", "1027", "1028", "1029", "1030", "1031", "1032", "1033", "1034", "1035", "1036", "1037", "1038", "1039", "1040", "1041", "1042", "1043", "1044", "1045", "1046", "1047", "1048", "1049", "1050", "1051", "1052", "1053", "1054", "1055", "1056", "1057", "1058", "1059", "1060", "1061", "1062", "1063", "1064", "1065", "1066", "1067", "1068", "1069", "1070", "1071", "1072", "1073", "1074", "1075", "1076", "1077", "1078", "1079", "1080", "1081", "1082", "1083", "1084", "1085", "1086", "1087", "1088", "1089", "1090", "1091", "1092", "1093", "1094", "1095", "1096", "1097", "1098", "1099", "1100", "1101", "1102", "1103", "1104", "1105", "1106", "1107", "1108", "1109", "1110", "1111", "1112", "1113", "1114", "1115", "1116", "1117", "1118", "1119", "1120", "1121", "1122", "1123", "1124", "1125", "1126", "1127", "1128", "1129", "1130", "1131", "1132", "1133", "1134", "1135", "1136", "1137", "1138", "1139", "1140", "1141", "1142", "1143", "1144", "1145", "1146", "1147", "1148", "1149", "1150", "1151", "1152", "1153", "1154", "1155", "1156", "1157", "1158", "1159", "1160", "1161", "1162", "1163", "1164", "1165", "1166", "1167", "1168", "1169", "1170", "1171", "1172", "1173", "1174", "1175", "1176", "1177", "1178", "1179", "1180", "1181", "1182", "1183", "1184", "1185", "1186", "1187", "1188", "1189", "1190", "1191", "1192", "1193", "1194", "1195", "1196", "1197", "1198", "1199", "1200", "1201", "1202", "1203", "1204", "1205", "1206", "1207", "1208", "1209", "1210", "1211", "1212", "1213", "1214", "1215", "1216", "1217", "1218", "1219", "1220", "1221", "1222", "1223", "1224", "1225", "1226", "1227", "1228", "1229", "1230", "1231", "1232", "1233", "1234", "1235", "1236", "1237", "1238", "1239", "1240", "1241", "1242", "1243", "1244", "1245", "1246", "1247", "1248", "1249", "1250", "1251", "1252", "1253", "1254", "1255", "1256", "1257", "1258", "1259", "1260", "1261", "1262", "1263", "1264", "1265", "1266", "1267", "1268", "1269", "1270", "1271", "1272", "1273", "1274", "1275", "1276", "1277", "1278", "1279", "1280", "1281", "1282", "1283", "1284", "1285", "1286", "1287", "1288", "1289", "1290", "1291", "1292", "1293", "1294", "1295", "1296", "1297", "1298", "1299", "1300", "1301", "1302", "1303", "1304", "1305", "1306", "1307", "1308", "1309", "1310", "1311", "1312", "1313", "1314", "1315", "1316", "1317", "1318", "1319", "1320", "1321", "1322", "1323", "1324", "1325", "1326", "1327", "1328", "1329", "1330", "1331", "1332", "1333", "1334", "1335", "1336", "1337", "1338", "1339", "1340", "1341", "1342", "1343", "1344", "1345", "1346", "1347", "1348", "1349", "1350", "1351", "1352", "1353", "1354", "1355", "1356", "1357", "1358", "1359", "1360", "1361", "1362", "1363", "1364", "1365", "1366", "1367", "1368", "1369", "1370", "1371", "1372", "1373", "1374", "1375", "1376", "1377", "1378", "1379", "1380", "1381", "1382", "1383", "1384", "1385", "1386", "1387", "1388", "1389", "1390", "1391", "1392", "1393", "1394", "1395", "1396", "1397", "1398", "1399", "1400", "1401", "1402", "1403", "1404", "1405", "1406", "1407", "1408", "1409", "1410", "1411", "1412", "1413", "1414", "1415", "1416", "1417", "1418", "1419", "1420", "1421", "1422", "1423", "1424", "1425", "1426", "1427", "1428", "1429", "1430", "1431", "1432", "1433", "1434", "1435", "1436", "1437", "1438", "1439", "1440", "1441", "1442", "1443", "1444", "1445", "1446", "1447", "1448", "1449", "1450", "1451", "1452", "1453", "1454", "1455", "1456", "1457", "1458", "1459", "1460", "1461", "1462", "1463", "1464", "1465", "1466", "1467", "1468", "1469", "1470", "1471", "1472", "1473", "1474", "1475", "1476", "1477", "1478", "1479", "1480", "1481", "1482", "1483", "1484", "1485", "1486", "1487", "1488", "1489", "1490", "1491", "1492", "1493", "1494", "1495", "1496", "1497", "1498", "1499", "1500", "1501", "1502", "1503", "1504", "1505", "1506", "1507", "1508", "1509", "1510", "1511", "1512", "1513", "1514", "1515", "1516", "1517", "1518", "1519", "1520", "1521", "1522", "1523", "1524", "1525", "1526", "1527", "1528", "1529", "1530", "1531", "1532", "1533", "1534", "1535", "1536", "1537", "1538", "1539", "1540", "1541", "1542", "1543", "1544", "1545", "1546", "1547", "1548", "1549", "1550", "1551", "1552", "1553", "1554", "1555", "1556", "1557", "1558", "1559", "1560", "1561", "1562", "1563", "1564", "1565", "1566", "1567", "1568", "1569", "1570", "1571", "1572", "1573", "1574", "1575", "1576", "1577", "1578", "1579", "1580", "1581", "1582", "1583", "1584", "1585", "1586", "1587", "1588", "1589", "1590", "1591", "1592", "1593", "1594", "1595", "1596", "1597", "1598", "1599", "1600", "1601", "1602", "1603", "1604", "1605", "1606", "1607", "1608", "1609", "1610", "1611", "1612", "1613", "1614", "1615", "1616", "1617", "1618", "1619", "1620", "1621", "1622", "1623", "1624", "1625", "1626", "1627", "1628", "1629", "1630", "1631", "1632", "1633", "1634", "1635", "1636", "1637", "1638", "1639", "1640", "1641", "1642", "1643", "1644", "1645", "1646", "1647", "1648", "1649", "1650", "1651", "1652", "1653", "1654", "1655", "1656", "1657", "1658", "1659", "1660", "1661", "1662", "1663", "1664", "1665", "1666", "1667", "1668", "1669", "1670", "1671", "1672", "1673", "1674", "1675", "1676", "1677", "1678", "1679", "1680", "1681", "1682", "1683", "1684", "1685", "1686", "1687", "1688", "1689"), class = "data.frame") invisible(cbd3) } epitools/R/binom.wilson.R0000644000176200001440000000072613174424211015056 0ustar liggesusers"binom.wilson" <- function(x, n, conf.level = 0.95) { Z <- qnorm(0.5*(1 + conf.level)) Zinsert <- Z*sqrt(((x*(n-x))/n^3) + Z^2/(4*n^2)) R.lower <- (n/(n+Z^2))*(x/n + Z^2/(2*n) - Zinsert) R.upper <- (n/(n+Z^2))*(x/n + Z^2/(2*n) + Zinsert) data.frame(x = x, n = n, proportion = x/n, lower = R.lower, upper = R.upper, conf.level = conf.level ) } epitools/R/oddsratio.fisher.R0000644000176200001440000000314213174424211015702 0ustar liggesusersoddsratio.fisher <- function (x, y = NULL, conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), correction = FALSE, verbose = FALSE) { if (is.matrix(x) && !is.null(y)) { stop("y argument should be NULL") } if (is.null(y)) { x <- epitable(x, rev = rev) } else { x <- epitable(x, y, rev = rev) } tmx <- table.margins(x) p.exposed <- sweep(tmx, 2, tmx["Total", ], "/") p.outcome <- sweep(tmx, 1, tmx[, "Total"], "/") nr <- nrow(x) fisher <- matrix(NA, nr, 3) fisher[1, 1] <- 1 for (i in 2:nr) { xx <- rbind(x[1, ], x[i, ]) ftestxx <- fisher.test(xx, conf.level = conf.level) est <- ftestxx$estimate ci <- ftestxx$conf.int fisher[i, ] <- c(est, ci) } pv <- tab2by2.test(x, correction = correction) colnames(fisher) <- c("estimate", "lower", "upper") rownames(fisher) <- rownames(x) cn2 <- paste("odds ratio with", paste(100 * conf.level, "%", sep = ""), "C.I.") names(dimnames(fisher)) <- c(names(dimnames(x))[1], cn2) rr <- list(x = x, data = tmx, p.exposed = p.exposed, p.outcome = p.outcome, measure = fisher, conf.level = conf.level, p.value = pv$p.value, correction = pv$correction) rrs <- list(data = tmx, measure = fisher, p.value = pv$p.value, correction = pv$correction) attr(rr, "method") <- "Conditional MLE & exact CI from 'fisher.test'" attr(rrs, "method") <- "Conditional MLE & exact CI from 'fisher.test'" if (verbose == FALSE) { rrs } else rr } epitools/R/julian2date.R0000644000176200001440000000040313174424211014632 0ustar liggesusers"julian2date" <- function(x){ orig <- as.Date(attributes(x)[[1]]) jorig <- as.numeric(orig) seqdates <- seq(from=orig,to=orig+max(x, na.rm=TRUE),by=1) seqjulian <- seq(from=jorig,to=jorig+max(x, na.rm=TRUE),by=1) seqdates[x+1] } epitools/R/epicurve.weeks.R0000644000176200001440000000352613174424211015400 0ustar liggesusers"epicurve.weeks" <- function(x, format = "%Y-%m-%d", strata = NULL, min.date, max.date, before = 7, after = 7, width = 1, space = 0, tick = TRUE, tick.offset = 0.5, segments = FALSE, origin = as.Date("1970-01-01"), sunday = TRUE, ...){ aw <- as.week(x, format = format, min.date = min.date, max.date = max.date, before = before, after = after, sunday = sunday, origin = origin) if(sunday) {firstday <- "Sunday"} else {firstday <- "Monday"} original.dates <- aw$dates cdates <- aw$cstratum dates <- aw$stratum2 if(is.null(strata)){ dat <- t(as.matrix(table(dates))) } else { dat <- t(table(dates, strata)) } xvals <- barplot(dat, width=width, space=space, ...) if(tick){ axis(1, at=c(0, xvals + tick.offset), labels=FALSE, tick=TRUE) } if(segments){ x <- xvals-(width/2) y2 <- apply(dat,2,sum) xy2 <- cbind(x,y2) y0 <- cbind(xy2[1,1],0:xy2[1,2]) z0 <- cbind(y0, y0[,1]+width, y0[,2]) for(i in 2:nrow(xy2)){ yy <- cbind(xy2[i,1],0:xy2[i,2]) z <- cbind(yy, yy[,1]+width, yy[,2]) z2 <- rbind(z0,z) z0 <- z2 } segments(z0[,1],z0[,2],z0[,3],z0[,4]) } rr <- list(dates = original.dates, firstday= firstday, week = aw$week, stratum = aw$stratum, stratum2 = aw$stratum2, stratum3 = aw$stratum3, xvals = xvals, cweek = aw$cweek, cstratum = aw$cstratum, cstratum2 = aw$cstratum2, cmday = aw$cmday, cmonth = aw$cmonth, cyear = aw$cyear ) invisible(rr) } epitools/R/epitable.R0000644000176200001440000000465013174424211014225 0ustar liggesusers"epitable" <- function(..., ncol = 2, byrow = TRUE, rev = c("neither", "rows", "columns", "both")){ lx <- list(...) if(length(lx)==0){ stop("No arguments provided") } if(length(lx)==1 && (is.character(lx[[1]]) || is.factor(lx[[1]]))){ stop("Single factor or character vector not allowed.") } ## r x c table if(length(lx)==1 && is.matrix(lx[[1]]) && nrow(lx[[1]])>=2 && ncol(lx[[1]])>=2) { x <- lx[[1]] if(is.null(dimnames(lx[[1]]))) { nr <- nrow(x) nc <- ncol(x) rn <- paste("Exposed", 1:nr, sep="") cn <- paste("Disease", 1:nc, sep="") dimnames(x) <- list(Predictor = rn, Outcome = cn) } } ## 2 vectors if(length(lx)==2 && (is.vector(lx[[1]]) || is.factor(lx[[1]])) && (is.vector(lx[[2]]) || is.factor(lx[[2]])) ) { x <- table(lx[[1]], lx[[2]]) if(nrow(x)<2 || ncol(x)<2) { stop("must have 2 or more rows and columns") } if(is.null(names(lx))) { names(dimnames(x)) <- c("Predictor", "Outcome") } else names(dimnames(x)) <- names(lx) } ## >=4 numbers is.even <- function(x){ifelse(x%%2==0, TRUE, FALSE)} if(length(lx)>=4 && all(sapply(list(1,2,3,4,5),is.numeric)) && is.even(length(lx)) && all(sapply(lx,length)==1)) { x <- matrix(sapply(lx,as.vector), ncol = ncol, byrow = byrow) nr <- nrow(x) nc <- ncol(x) rn <- paste("Exposed", 1:nr, sep="") cn <- paste("Disease", 1:nc, sep="") dimnames(x) <- list(Predictor = rn, Outcome = cn) } ## 1 vector if(length(lx)==1 && is.vector(lx[[1]]) && is.numeric(lx[[1]]) && is.even(length(lx[[1]])) ) { x <- matrix(lx[[1]], ncol = ncol, byrow = byrow) nr <- nrow(x) nc <- ncol(x) rn <- paste("Exposed", 1:nr, sep="") cn <- paste("Disease", 1:nc, sep="") dimnames(x) <- list(Predictor = rn, Outcome = cn) } nrx <- nrow(x) ncx <- ncol(x) reverse <- match.arg(rev) if(reverse=="rows") finalx <- x[nrx:1,] if(reverse=="columns") finalx <- x[,ncx:1] if(reverse=="both") finalx <- x[nrx:1,ncx:1] if(reverse=="neither") finalx <- x finalx } epitools/R/expected.R0000644000176200001440000000031713174424211014235 0ustar liggesusersexpected <- function(x){ if(!is.matrix(x)){stop("Must be a matrix")} rtot <- margin.table(x, 1) ctot <- margin.table(x, 2) tot <- margin.table(x) outer(rtot, ctot, "*")/tot } epitools/MD50000644000176200001440000001020113174443221012413 0ustar liggesusers4e327f3e185ceed5c521db691174de78 *DESCRIPTION f259c9f26e82e13a8eb777c4f2fbecc7 *NAMESPACE 2745fc0b8c7dd39e9272b0a8d8d573ae *R/ageadjust.direct.R f57b81c6d42888d11c7673aa911aaaa4 *R/ageadjust.indirect.R 9999f1f5ee9c394bf1a34add54477f64 *R/as.hour.R 955288de4d5853e6267e1824f4f37043 *R/as.month.R b4603993b2d1394cfc31daea4dc41341 *R/as.week.R 13caf5a87d4e792057da8dbe5751ad68 *R/binom.approx.R 855b9c43ab68917e283b4177624ba10a *R/binom.exact.R b4706a6d9ce5047254d8c22ac3a8c1a6 *R/binom.wilson.R ddedd99b5387ad17cd7dfba74523dee6 *R/colorbrewer.data.R db4eaa213863a52eea8a8bd4027328b7 *R/colorbrewer.display.R 06344fcfe81efbfbaf36dee45005f5d8 *R/colorbrewer.pallette.R 81e0fbc4cac9f0609620196ac6849f63 *R/colors.matrix.R 1c524fa48ef18e1e2d73711adfd06943 *R/colors.plot.R 96f7527ccf4ed84fabb02dc096ce28c2 *R/epicurve.dates.R 58ba866ec8cefaf513583c7a1c186624 *R/epicurve.hours.R 75d983ec8c95b58243aa3014ff182dab *R/epicurve.months.R fa499ffb3c03f701c285651f17d27281 *R/epicurve.table.R 4c967bb24b7afe4f3b1e55c4a62a2251 *R/epicurve.weeks.R d3c4e9e088e8f7a5b443c41aae4275ea *R/epidate.R 6747156ed3942ed6d02b60b78da9fe23 *R/epitab.R 7c593b15d35b36c12bcaf7d0edf9ad73 *R/epitable.R de032fdfe12b7040d90bad21705e9f85 *R/expand.table.R 65e258dc3ec4f60ddf0db0f061ac67c4 *R/expected.R e2429e5410ebaff6041571acb3133895 *R/julian2date.R 097e6251d1440f95dd8792ba7c49421b *R/kapmeier.R b1eb0b5967d1fa97b02afb8574a0856c *R/oddsratio.R 18f9c52071d76fcd57911e0d9769c45a *R/oddsratio.fisher.R 49797a2c28d2e7ed11807c584dfe831b *R/oddsratio.midp.R 24c3188da171865ed54d7f419b3a50cf *R/oddsratio.small.R a35da492ad3c15762844f5638e0b6ee8 *R/oddsratio.wald.R 86d23ffeb6ca7043640e1a35083a2135 *R/or.midp.R 602298320f3da803a4a546569a0a9979 *R/ormidp.test.R e28acb2889bafdd602f505928ac631af *R/pois.approx.R b4af057b9684dd25a204d0fdd07bc490 *R/pois.byar.R 92a9a8539406cf2b7891d3c620948f02 *R/pois.daly.R 6f7f8d32c5b17250ab5114fa0eb90ef4 *R/pois.exact.R f55b48d7e8d39764eacac14d02617368 *R/probratio.r d963dd2d0fd72e1b1852100d3f3a731c *R/rate2by2.test.R 23a6d06d89f020f2632c8167a1c5bfb6 *R/rateratio.R 92875d4809c02c2d90b6ce814f08d0bd *R/rateratio.midp.R b5a48d34e42c464993cdc31d6f2450af *R/rateratio.wald.R da5914dac422077e09bf4ec11bd0bdcb *R/ratetable.R 7d63605703662d7f708b79875995fafb *R/riskratio.R 5482920348d27e7b2b0e2f44fe908b02 *R/riskratio.boot.R c6786e9f1bec78093f3c8bf3127b990f *R/riskratio.small.R 372dc792ac711f77388e2351cd8529f6 *R/riskratio.wald.R 05e1e91775de4db5b6c40e5064d471a1 *R/tab2by2.test.R d7e398c713b9e03c7f24d0d5178749f6 *R/table.margins.R 599db95edbab735f585432c50c915e8f *data/oswego.rda 4bc99d86c08e5e31f6e87132281c6354 *data/wcgs.rda f7ca7daa6bea1cfa48fe3278634836e9 *data/wnv.rda 2ecd6774c3f523c83284892ad1fd6bca *man/ageadjust.direct.Rd d41e7c97f6fe25f55bb36bcf745411fd *man/ageadjust.indirect.Rd 4651e245cf53e65b2d7a3409b80fdc28 *man/as.hour.Rd 828563827b1cc26d6ba1e9ddb85ca321 *man/as.month.Rd bbc8be41dc8edffcac753bf5e9550c8e *man/as.week.Rd e4c54b3e4ad98db993e292c289e0c5e2 *man/binom.conf.int.Rd 03dc3e297ee6a20a59bd82584ad7981e *man/colorbrewer.Rd 2ba04a295ec5be831bc257728f4c1b40 *man/colors.plot.Rd 8b2ba43ece30ab1813482df74d2fd524 *man/epicurve.Rd ccefe1c4ad859cdc5f424432205646aa *man/epidate.Rd 60fdf552393e0d5826ef8a0c6c5d975c *man/epitab.Rd f1578bc60e2b81620e66d05a1b4ab050 *man/epitable.Rd 5c6fcb8ae2da13dbc3262550652b42e9 *man/expand.table.Rd 505f1a901450169ac054b6ee3c690239 *man/expected.Rd 15f06c30128f8556685bf4b65c083ae1 *man/julian2date.Rd 518a7ea26bd0cd1469797dfa88885440 *man/kapmeier.Rd 50808280b2ab493fbf40ac08c8063597 *man/oddsratio.Rd f6aea5940cd50004b1cb1891932c26e0 *man/or.midp.Rd cc44f5cbf9bf742da3fc2812fbb0116d *man/ormidp.test.Rd 60c145e9a59b01973ad1ef5d354e9eda *man/oswego.Rd 7e4aadfb1419d6707259d2dfbced4ba2 *man/pois.conf.int.Rd 87bb14cc9f0590b20b9885172e7e8e1a *man/probratio.Rd 7a6a6a89eda18545c4194f62827dc7b9 *man/rate2by2.test.Rd 3e78113268282c0e0a3458ef85db6744 *man/rateratio.Rd 76d5efb56197e4496efe1e8d14b803bf *man/ratetable.Rd 2ee62232595ea0e0ca866ef586e8a09d *man/riskratio.Rd 5bda8bae7c61e9fbb874d64d247bcff6 *man/tab2by2.test.Rd 649f7061356cd0ae69410c6dc7022e48 *man/table.margins.Rd 6eee4357e4f5efd6ac15912e8c6cbea8 *man/wcgs.Rd b9f7bf52cb42a1a9edb8a505f21f2bc5 *man/wnv.Rd epitools/DESCRIPTION0000644000176200001440000000164113174443221013621 0ustar liggesusersPackage: epitools Version: 0.5-10 Date: 2017-10-26 Title: Epidemiology Tools Authors@R: c(person("Tomas J.", "Aragon", role = "aut", email = "aragon@berkeley.edu"), person("Michael P.", "Fay", role = "ctb", email = "mfay@niaid.nih.gov"), person("Daniel", "Wollschlaeger", role = "ctb", email = "dwoll@psychologie.uni-kiel.de"), person("Adam", "Omidpanah", role = c("cre", "ctb"), email = "adam.omidpanah@wsu.edu")) Depends: R (>= 2.1.0) Description: Tools for training and practicing epidemiologists including methods for two-way and multi-way contingency tables. License: GPL (>= 2) Packaged: 2017-10-26 18:25:13 UTC; adam.omidpanah Author: Tomas J. Aragon [aut], Michael P. Fay [ctb], Daniel Wollschlaeger [ctb], Adam Omidpanah [cre, ctb] Maintainer: Adam Omidpanah Repository: CRAN Date/Publication: 2017-10-26 20:33:21 UTC NeedsCompilation: no epitools/man/0000755000176200001440000000000013174424211012662 5ustar liggesusersepitools/man/table.margins.Rd0000644000176200001440000000171713174424211015705 0ustar liggesusers\name{table.margins} \alias{table.margins} %- Also NEED an '\alias' for EACH other topic documented here. \title{Marginal totals of a table} \description{ Calculates marginal totals of a matrix, table, or array. } \usage{ table.margins(x) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{is a matrix, table, or array} } \details{ Calculates marginal totals of a matrix, table, or array. } \value{Returns original object with marginal totals %- \item{comp1 }{Description of 'comp1'} %- \item{comp2 }{Description of 'comp2'} } \references{none} \author{Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}} %- ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ See also \code{\link[base]{margin.table}} } \examples{ x <- matrix(1:4, 2, 2) table.margins(x) } \keyword{manip} %- \keyword{ ~kwd2 }% __ONLY ONE__ keyword per line epitools/man/ageadjust.direct.Rd0000644000176200001440000001023513174424211016372 0ustar liggesusers\name{ageadjust.direct} \alias{ageadjust.direct} %- Also NEED an '\alias' for EACH other topic documented here. \title{Age standardization by direct method, with exact confidence intervals} \description{ Calculates age standardized (adjusted) rates and "exact" confidence intervals using the direct method } \usage{ ageadjust.direct(count, pop, rate = NULL, stdpop, conf.level = 0.95) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{count}{vector of age-specific count of events} \item{pop}{vector of age-specific person-years or population estimates} \item{rate}{vector of age-specific rates} \item{stdpop}{vector of age-specific standarad population} \item{conf.level}{confidence level (default = 0.95)} } \details{ To make valid comparisons between rates from different groups (e.g., geographic area, ethnicity), one must often adjust for differences in age distribution to remove the confounding affect of age. When the number of events or rates are very small (as is often the case for local area studies), the normal approximation method of calculating confidence intervals may give a negative number for the lower confidence limit. To avoid this common pitfall, one can approximate exact confidence intervals. This function implements this method (Fay 1997). Original function written by TJ Aragon, based on Anderson, 1998. Function re-written and improved by MP Fay, based on Fay 1998. } \value{ \item{crude.rate}{crude (unadjusted) rate} \item{adj.rate}{age-adjusted rate} \item{lci}{lower confidence interval limit} \item{uci}{upper confidence interval limit} } \references{ Fay MP, Feuer EJ. Confidence intervals for directly standardized rates: a method based on the gamma distribution. Stat Med. 1997 Apr 15;16(7):791-801. PMID: 9131766 Steve Selvin. Statistical Analysis of Epidemiologic Data (Monographs in Epidemiology and Biostatistics, V. 35), Oxford University Press; 3rd edition (May 1, 2004) Anderson RN, Rosenberg HM. Age Standardization of Death Rates: Implementation of the Year 200 Standard. National Vital Statistics Reports; Vol 47 No. 3. Hyattsville, Maryland: National Center for Health Statistics. 1998, pp. 13-19. Available at \url{http://www.cdc.gov/nchs/data/nvsr/nvsr47/nvs47_03.pdf}. } \author{Michael P. Fay, \email{mfay@niaid.nih.gov}; Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}} %- ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ See also \code{\link{ageadjust.indirect}} } \examples{ ## Data from Fleiss, 1981, p. 249 population <- c(230061, 329449, 114920, 39487, 14208, 3052, 72202, 326701, 208667, 83228, 28466, 5375, 15050, 175702, 207081, 117300, 45026, 8660, 2293, 68800, 132424, 98301, 46075, 9834, 327, 30666, 123419, 149919, 104088, 34392, 319933, 931318, 786511, 488235, 237863, 61313) population <- matrix(population, 6, 6, dimnames = list(c("Under 20", "20-24", "25-29", "30-34", "35-39", "40 and over"), c("1", "2", "3", "4", "5+", "Total"))) population count <- c(107, 141, 60, 40, 39, 25, 25, 150, 110, 84, 82, 39, 3, 71, 114, 103, 108, 75, 1, 26, 64, 89, 137, 96, 0, 8, 63, 112, 262, 295, 136, 396, 411, 428, 628, 530) count <- matrix(count, 6, 6, dimnames = list(c("Under 20", "20-24", "25-29", "30-34", "35-39", "40 and over"), c("1", "2", "3", "4", "5+", "Total"))) count ### Use average population as standard standard<-apply(population[,-6], 1, mean) standard ### This recreates Table 1 of Fay and Feuer, 1997 birth.order1<-ageadjust.direct(count[,1],population[,1],stdpop=standard) round(10^5*birth.order1,1) birth.order2<-ageadjust.direct(count[,2],population[,2],stdpop=standard) round(10^5*birth.order2,1) birth.order3<-ageadjust.direct(count[,3],population[,3],stdpop=standard) round(10^5*birth.order3,1) birth.order4<-ageadjust.direct(count[,4],population[,4],stdpop=standard) round(10^5*birth.order4,1) birth.order5p<-ageadjust.direct(count[,5],population[,5],stdpop=standard) round(10^5*birth.order5p,1) } \keyword{models} %- \keyword{ ~kwd2 }% __ONLY ONE__ keyword per line epitools/man/epitab.Rd0000644000176200001440000001410713174424211014420 0ustar liggesusers\name{epitab} \alias{epitab} %- Also NEED an '\alias' for EACH other topic documented here. \title{Epidemiologic tabulation for a cohort or case-control study} \description{ Calculates risks, risk ratio, odds ratio, and confidence intervals for epidemiologic data } \usage{ epitab(x, y = NULL, method = c("oddsratio", "riskratio", "rateratio"), conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), oddsratio = c("wald", "fisher", "midp", "small"), riskratio = c("wald", "boot", "small"), rateratio = c("wald", "midp"), pvalue = c("fisher.exact", "midp.exact", "chi2"), correction = FALSE, verbose = FALSE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ For odds ratio or risk ratio, input data can be one of the following: r x 2 table, vector of numbers from a contigency table (will be transformed into r x 2 table in row-wise order), or single factor or character vector that will be combined with \code{y} into a table. For rate ratio, input data can be one of the following: r x 2 table where first column contains disease counts and second column contains person time at risk; a single numeric vector of counts followed by person time at risk; a single numeric vector of counts combined with \code{y} which would be a numeric vector of corresponding person time at risk } \item{y}{ For odds ratio or risk ratio, a single factor or character vector that will be combined with \code{x} into a table (default is NULL) For rate ratio, a numeric vector of person-time at risk; if provided, \code{x} must be a numeric vector of disease counts } \item{method}{ select measure of association: "oddsratio" (default), "riskratio", or "rateratio" } \item{conf.level}{ confidence level (default is 0.95) } \item{rev}{ reverse order of "rows", "colums", "both", or "neither" (default) } \item{oddsratio}{ selection estimation method: "wald" (default), "fisher", "midp", "small" } \item{riskratio}{ selection estimation method: "wald" (default), "boot", "small" } \item{rateratio}{ "wald" (default), "midp" } \item{pvalue}{ "fisher.exact" (default), "midp.exact", "chi2" (normal approximation); for rate ratio, "fisher.exact" not calculated } \item{correction}{ set to TRUE for Yate's continuity correction (default is FALSE) } \item{verbose}{ set to TRUE to return more detailed results (default is FALSE) } } \details{ The \code{epitab} calculates odds ratios, risk ratios, or rate ratios for rx2 tables. The odds ratios are estimated using unconditional maximum likelihood (Wald), conditional maximum likelihood (Fisher), median-unbiased method (mid-p), or small-sample adjusted. The confidence intervals are estimated using a normal approximation (Wald), hypergeometric exact (Fisher), mid-p exact, or small sample adjusted method. The risk ratios are estimated using unconditional maximum likelihood (Wald), or small-sample adjusted. The confidence intervals are estimated using a normal approximation (Wald), or bootstrap estimation. The rate ratios are estimated using unconditional maximum likelihood estimation (Wald), or median unbiased method (mid-p). The confidence intervals are estimated using normal approximation, or mid-p exact method. Notice the expected structure of the data to be given to 'epitab': \preformatted{ Disease Exposure No (ref) Yes Level 1 (ref) a b Level 2 c d Level 3 e f } This function expects the following table struture for rate ratios: \preformatted{ counts person-time exposed=0 (ref) n00 t01 exposed=1 n10 t11 exposed=2 n20 t21 exposed=3 n30 t31 } If the table you want to provide to this function is not in the preferred form, just use the \code{rev} option to "reverse" the rows, columns, or both. If you are providing categorical variables (factors or character vectors), the first level of the "exposure" variable is treated as the reference. However, you can set the reference of a factor using the \code{\link[stats]{relevel}} function. Likewise, each row of the rx2 table is compared to the exposure reference level and test of independence two-sided p values are calculated using fisher exact, mid-p exact, or normal approximation method. } \value{ \item{tab}{primary table} \item{measure}{odds ratio, risk ratio, or rate ratio} \item{conf.level}{confidence level} \item{pvalue}{p value method} \item{x}{data input} \item{data}{data with margin totals} \item{p.exposed}{proportion exposed} \item{p.outcome}{proportion outcome} \item{p.value}{p value} \item{correction}{TRUE if Yate's continuity correction was used} } \references{ Nicolas P Jewell, Statistics for Epidemiology, 1st Edition, 2004, Chapman & Hall Kenneth J. Rothman and Sander Greenland (1998), Modern Epidemiology, Lippincott-Raven Publishers Kenneth J. Rothman (2002), Epidemiology: An Introduction, Oxford University Press } \author{Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}} %- ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{riskratio}}, \code{\link{oddsratio}}, \code{\link{rateratio}} } \examples{ r243 <- matrix(c(12,2,7,9), 2, 2) dimnames(r243) <- list(Diarrhea = c("Yes", "No"), "Antibody level" = c("Low", "High") ) r243 r243b <- t(r243) r243b epitab(r243, rev = "b", verbose = TRUE) epitab(r243, method="riskratio",rev = "b", verbose = TRUE) epitab(matrix(c(41, 15, 28010, 19017),2,2)[2:1,], method="rateratio", verbose = TRUE) } \keyword{models} %- \keyword{ ~kwd2 }% __ONLY ONE__ keyword per line epitools/man/epidate.Rd0000644000176200001440000000607513174424211014574 0ustar liggesusers\name{epidate} \alias{epidate} %- Also NEED an '\alias' for EACH other topic documented here. \title{Convert dates into multiple legible formats} \description{ Convert character vector of dates into multiple legible formats. } \usage{ epidate(x, format = "\%m/\%d/\%Y", cal.dates = FALSE, before = 7, after = 7, sunday = TRUE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{character vector of dates to be converted} \item{format}{format of character vector of dates} \item{cal.dates}{Calendar dates that contains \code{x}, starting 7 days 'before' (default) until 7 days 'after' \code{x}} \item{before}{defines lower limit of \code{cal.dates}: default is 7 days before earliest date in \code{x}} \item{after}{defines upper limit of \code{cal.dates}: default is 7 days after latest date in \code{x}} \item{sunday}{first day of the week is either Sunday (default) or Monday} } \details{ Dates can come in many formats (e.g., November 12, 2001, 12Nov01, 11/12/2001, 11/12/01, 2001-11-12) and need to be converted into other formats for data analysis, graphical displays, generating reports, etc. There is tremendous flexibility in converting any character vector with sufficient information to be converted into a unique date. For complete options for the \code{format} option see \code{\link[base]{strptime}}. } \value{ \item{dates}{dates wtih date-time class} \item{julian}{number of days since 1970-01-01} \item{mday}{day of the month: 1-31} \item{mon}{month of the year: 0-11} \item{month}{month: January, February, March, ...} \item{month2}{month: Jan, Feb, Mar, ...} \item{firstday}{first day of the week: Sunday or Monday} \item{week}{week of the year: 0-53} \item{year}{year: YYYY} \item{yr}{year: YY} \item{wday}{day of the week: 0-6} \item{weekday}{weekday: Monday, Tuesday, Wednesday, ...} \item{wkday}{weekday: Mon, Tue, Wed, ...} \item{yday}{day of the year: 0-365} \item{quarter}{quarter of the year: Q1, Q2, Q3, Q4} \item{cdates}{Calendar dates that contains \code{dates}} \item{cjulian}{Julian calendar dates} } \references{none} \author{Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}} \seealso{ \code{epitools}: \code{\link{as.week}} \code{\link[base]{DateTimeClasses}} to learn about date-time classes \code{\link[base]{format.Date}} to convert character vector of dates into calendar dates with date-time class (done by \code{epidate}) \code{\link[base]{strptime}} to convert date-time character strings into a date-time class } \examples{ #x <- c("12/1/03", "11/2/03", NA, "1/7/04", "1/14/04", "8/18/04") #epidate(x, format = "\%m/\%d/\%y") #epidate(x, format = "\%m/\%d/\%y", TRUE) # ###convert vector of disease weeks into vector of mid-week dates #dwk <- sample(0:53, 100, replace = TRUE) #wk2date <- paste(dwk, "/", "Wed", sep="") #wk2date[1:10] #wk2date2 <- epidate(wk2date, format = "\%U/\%a") #wk2date2$dates[1:20] } \keyword{chron} epitools/man/ormidp.test.Rd0000644000176200001440000000255213174424211015425 0ustar liggesusers\name{ormidp.test} \alias{ormidp.test} \title{odds ratio test for independence (p value) for a 2x2 table} \description{ Test for independence using the mid-p method (Rothman 1998) } \usage{ ormidp.test(a1, a0, b1, b0, or = 1) } \arguments{ \item{a1}{ number of exposed cases } \item{a0}{ number of unexposed cases } \item{b1}{ number of exposed noncases (controls) } \item{b0}{ number of unexposed noncases (controls) } \item{or}{ odds ratio reference value (default is no association) } } \details{ Test for independence using the mid-p method (Rothman 1998) } \value{ \item{$one.sided}{one-sided p value} \item{$two.sided}{two-sided p value} } \references{ Kenneth J. Rothman and Sander Greenland (1998), Modern Epidemiology, Lippincott-Raven Publishers Kenneth J. Rothman (2002), Epidemiology: An Introduction, Oxford University Press Nicolas P. Jewell (2004), Statistics for Epidemiology, 1st Edition, 2004, Chapman & Hall, pp. 73-81 } \author{Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}} \seealso{ \code{\link{tab2by2.test}}, \code{\link{oddsratio}}, \code{\link{riskratio}} } \examples{ ##rothman p. 243 ormidp.test(12,2,7,9) ##jewell p. 79 ormidp.test(347,555,20,88) } \keyword{htest} epitools/man/expand.table.Rd0000644000176200001440000000543213174424211015522 0ustar liggesusers\name{expand.table} \alias{expand.table} %- Also NEED an '\alias' for EACH other topic documented here. \title{Expand contingency table into individual-level data set} \description{ Expands contingency table or array into individual-level data set. } \usage{ expand.table(x) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{table or array with \code{dimnames(x)} and \code{names(dimnames(x))} } } \details{ For educational purposes, one may want to convert a multi-dimensional contingency table into an individual-level data frame. In R, multi-dimensional contigency tables are represented by arrays. An array can be created using the \code{array} command, or the \code{table} command with 3 or more vectors (usually fields from a data frame). It is this array, \code{x}, that is processed by \code{expand.table}. In order to generate a data frame, \code{expand.table} needs to process the field names and the possible values for each field. The array x must have dimension names [i.e., \code{dimnames(x)}] and field names [i.e., \code{names(dimnames(x))}]. The \code{expand.table} function converts \code{names(dimnames(x))} to field names and the \code{dimnames(x)} to factor levels for each field. Study the examples. An \code{ftable} object, say \code{ftab}, can be expanded using \code{expand.table(as.table(ftab))}. Study the Titanic example to compare how a data frame can contain either individual-level data or group-level data. } \value{Returns an individual-level data frame %- \item{comp1 }{Description of 'comp1'} %- \item{comp2 }{Description of 'comp2'} } \references{none} \author{Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}; Daniel Wollschlaeger, \email{dwoll@psychologie.uni-kiel.de}, \url{http://www.uni-kiel.de/psychologie/dwoll/} } %- ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link[base]{expand.grid}} } \examples{ ##Creating array using 'array' function and expanding it tab <- array(1:8, c(2, 2, 2)) dimnames(tab) <- list(c("No","Yes"), c("No","Yes"), c("No","Yes")) names(dimnames(tab)) <- c("Exposure", "Disease", "Confounder") tab df <- expand.table(tab) df ##Creating array using 'table' function and expanding it tab2 <- table(Exposure = df$Exp, Disease = df$Dis, Confounder = df$Conf) expand.table(tab2) ##Expanding ftable object ftab2 <- ftable(tab2) ftab2 expand.table(as.table(ftab2)) ##Convert Titanic data into individual-level data frame data(Titanic) expand.table(Titanic)[1:20,] ##Convert Titanic data into group-level data frame as.data.frame(Titanic) } \keyword{manip} %- \keyword{ ~kwd2 }% __ONLY ONE__ keyword per line epitools/man/julian2date.Rd0000644000176200001440000000236013174424211015354 0ustar liggesusers\name{julian2date} \alias{julian2date} %- Also NEED an '\alias' for EACH other topic documented here. \title{Convert a julian date into standard a date format} \description{ Convert a julian date into a standard calendar date format } \usage{ julian2date(x) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{julian date; that is, the number of days since day 0 (default is 1970-01-01)} } \details{ In R, the \code{julian} function converts a date-time object into a Julian date: the number of day since day 0 (default is 1970-01-01). However, there is no function, without loading another package, that converts a Julian date back into a date object. The \code{julian2date} function does this conversion. } \value{ Return standard calendar date format. } \references{none} \author{Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}} \seealso{ \code{\link[base]{format.Date}}, \code{\link[base]{weekdays}} } \examples{ mydates <- c("1/1/04", "1/2/04", "1/7/04", "1/14/04", "8/18/04"); mydates <- as.Date(mydates, format = "\%m/\%d/\%y") mydates myjulian <- julian(mydates) myjulian julian2date(myjulian) } \keyword{chron} epitools/man/riskratio.Rd0000644000176200001440000001357513174424211015173 0ustar liggesusers\name{riskratio} \alias{riskratio} \alias{riskratio.wald} \alias{riskratio.small} \alias{riskratio.boot} \title{Risk ratio estimation and confidence intervals} \description{ Calculates risk ratio by unconditional maximum likelihood estimation (Wald), and small sample adjustment (small). Confidence intervals are calculated using normal approximation (Wald), and normal approximation with small sample adjustment (small), and bootstrap method (boot). } \usage{ riskratio(x, y = NULL, method = c("wald", "small", "boot"), conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), correction = FALSE, verbose = FALSE, replicates = 5000) riskratio.wald(x, y = NULL, conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), correction = FALSE, verbose = FALSE) riskratio.small(x, y = NULL, conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), correction = FALSE, verbose = FALSE) riskratio.boot(x, y = NULL, conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), correction = FALSE, verbose = FALSE, replicates = 5000) } \arguments{ \item{x}{input data can be one of the following: r x 2 table, vector of numbers from a contigency table (will be transformed into r x 2 table in row-wise order), or single factor or character vector that will be combined with \code{y} into a table.} \item{y}{ single factor or character vector that will be combined with \code{x} into a table (default is NULL) } \item{method}{ method for calculating risk ratio and confidence interval } \item{conf.level}{confidence level (default is 0.95)} \item{rev}{ reverse order of "rows", "colums", "both", or "neither" (default) } \item{correction}{ set to TRUE for Yate's continuity correction (default is FALSE) } \item{verbose}{ set to TRUE to return more detailed results (default is FALSE) } \item{replicates}{ Number of bootstrap replicates (default = 5000) } } \details{ Calculates risk ratio by unconditional maximum likelihood estimation (Wald), and small sample adjustment (small). Confidence intervals are calculated using normal approximation (Wald), and normal approximation with small sample adjustment (small), and bootstrap method (boot). This function expects the following table struture: \preformatted{ disease=0 disease=1 exposed=0 (ref) n00 n01 exposed=1 n10 n11 exposed=2 n20 n21 exposed=3 n30 n31 } The reason for this is because each level of exposure is compared to the reference level. If you are providing a 2x2 table the following table is preferred: \preformatted{ disease=0 disease=1 exposed=0 (ref) n00 n01 exposed=1 n10 n11 } If the table you want to provide to this function is not in the preferred form, just use the \code{rev} option to "reverse" the rows, columns, or both. If you are providing categorical variables (factors or character vectors), the first level of the "exposure" variable is treated as the reference. However, you can set the reference of a factor using the \code{\link[stats]{relevel}} function. Likewise, each row of the rx2 table is compared to the exposure reference level and test of independence two-sided p values are calculated using Fisher's Exact, Monte Carlo simulation, and the chi-square test. } \value{ \item{x}{table that was used in analysis (verbose = TRUE)} \item{data}{same table as \code{x} but with marginal totals} \item{p.exposed}{proportions exposed (verbose = TRUE)} \item{p.outcome}{proportions experienced outcome (verbose = TRUE)} \item{measure}{risk ratio and confidence interval} \item{conf.level}{confidence level used (verbose = TRUE)} \item{boot.replicates}{number of replicates used in bootstrap estimation of confidence intervals (verbose = TRUE)} \item{p.value}{p value for test of independence} \item{mc.replicates}{number of replicates used in Monte Carlo simulation p value (verbose = TRUE)} \item{correction}{logical specifying if continuity correction was used} } \references{ Kenneth J. Rothman and Sander Greenland (1998), Modern Epidemiology, Lippincott-Raven Publishers Kenneth J. Rothman (2002), Epidemiology: An Introduction, Oxford University Press Nicolas P. Jewell (2004), Statistics for Epidemiology, 1st Edition, 2004, Chapman & Hall, pp. 73-81 Steve Selvin (1998), Modern Applied Biostatistical Methods Using S-Plus, 1st Edition, Oxford University Press } \author{Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}} \seealso{ \code{\link{tab2by2.test}}, \code{\link{oddsratio}}, \code{\link{rateratio}}, \code{\link{epitab}} } \examples{ ##Case-control study assessing whether exposure to tap water ##is associated with cryptosporidiosis among AIDS patients tapw <- c("Lowest", "Intermediate", "Highest") outc <- c("Case", "Control") dat <- matrix(c(2, 29, 35, 64, 12, 6),3,2,byrow=TRUE) dimnames(dat) <- list("Tap water exposure" = tapw, "Outcome" = outc) riskratio(dat, rev="c") riskratio.wald(dat, rev="c") riskratio.small(dat, rev="c") ##Selvin 1998, p. 289 sel <- matrix(c(178, 79, 1411, 1486), 2, 2) dimnames(sel) <- list("Behavior type" = c("Type A", "Type B"), "Outcome" = c("CHD", "No CHD") ) riskratio.boot(sel, rev = "b") riskratio.boot(sel, rev = "b", verbose = TRUE) riskratio(sel, rev = "b", method = "boot") } \keyword{models} epitools/man/ratetable.Rd0000644000176200001440000000423113174424211015114 0ustar liggesusers\name{ratetable} \alias{ratetable} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Create r x 2 count and person-time table for calculating rates } \description{ Create r x 2 count and person-time table for calculating rates } \usage{ ratetable(..., byrow = FALSE, rev = c("neither", "rows", "columns", "both")) } \arguments{ \item{...}{see details} \item{byrow}{Default is TRUE and single vector or collection of numbers is read in row-wise. Set to FALSE to read in column-wise.} \item{rev}{ reverse order of "rows", "colums", "both", or "neither" (default) } } \details{ Creates r x 2 table with r exposure levels and 2 columns (counts and person-time exposed). Arguments can be one of the following: (1) r x 2 table of the following form: \preformatted{ Outcome Exposure cases pyears E = 0 (ref) a PT0 E = 1 b PT1 } (2) Two numeric vectors: 1st should be vector of counts, and the 2nd vector should be vector of person-times at risk. For example, \preformatted{ cases <- c(a, b) pyears <- c(PT0, PT1) } (3) >= 4 numbers in the following order: a, PT0, b, PT1 (4) One numeric vector of the following form: c(a, PT0, b, PT1) } \value{ Returns r x 2 rate table, usually for additional analyses. } \references{none} \author{Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}} \seealso{ \code{\link{epitable}} } \examples{ ##Breast cancer cases from radiation treatment for tuberculosis ##Rothman 1998, p. 238 bc0 <- 15 bc1 <- 41 py0 <- 19017 py1 <- 28010 ##4 numbers ratetable(bc0, py0, bc1, py1) ##1 vector dat <- c(bc0, py0, bc1, py1) ratetable(dat) ##2 vectors cases <- c(bc0, bc1) pyears <- c(py0, py1) ratetable(bc.cases = cases, person.years = pyears) ##1 matrix r238 <- matrix(c(41, 28010, 15, 19017), 2, 2) dimnames(r238) <- list(c("BC cases", "Person-years"), "Radiation" = c("Yes", "No")) r238 r238b <- t(r238) r238b ratetable(r238b, rev = "r") } \keyword{manip} epitools/man/wcgs.Rd0000644000176200001440000000357213174424211014123 0ustar liggesusers\name{wcgs} \docType{data} \alias{wcgs} \title{Western Collaborative Group Study data} \description{ The Western Collaborative Group Study (WCGS), a prospective cohort studye, recruited middle-aged men (ages 39 to 59) who were employees of 10 California companies and collected data on 3154 individuals during the years 1960-1961. These subjects were primarily selected to study the relationship between behavior pattern and the risk of coronary hearth disease (CHD). A number of other risk factors were also measured to provide the best possible assessment of the CHD risk associated with behavior type. Additional variables collected include age, height, weight, systolic blood pressure, diastolic blood pressure, cholesterol, smoking, and corneal arcus. } \usage{ ##data(wcgs) } \format{ \itemize{ \item{\code{id}}{ Subject ID: } \item{\code{age0}}{ Age: age in years } \item{\code{height0}}{ Height: height in inches } \item{\code{weight0}}{ Weight: weight in pounds } \item{\code{sbp0}}{ Systolic blood pressure: mm Hg } \item{\code{dbp0}}{ Diastolic blood pressure: mm Hg } \item{\code{chol0}}{ Cholesterol: mg/100 ml } \item{\code{behpat0}}{ Behavior pattern: } \item{\code{ncigs0}}{ Smoking: Cigarettes/day } \item{\code{dibpat0}}{ Dichotomous behavior pattern: 0 = Type B; 1 = Type A } \item{\code{chd69}}{ Coronary heart disease event: 0 = none; 1 = yes } \item{\code{typechd}}{ to be done } \item{\code{time169}}{ Observation (follow up) time: Days } \item{\code{arcus0}}{ Corneal arcus: 0 = none; 1 = yes } } } \source{UC Berkeley School of Public Health} \references{ pending } \keyword{datasets} epitools/man/rate2by2.test.Rd0000644000176200001440000000644013174424211015565 0ustar liggesusers\name{rate2by2.test} \alias{rate2by2.test} \title{Comparative tests of independence in rx2 rate tables} \description{ Tests for independence where each row of the rx2 table is compared to the exposure reference level and test of independence two-sided p values are calculated using mid-p xxact, and normal approximation. } \usage{ rate2by2.test(x, y = NULL, rr = 1, rev = c("neither", "rows", "columns", "both")) } \arguments{ \item{x}{ input data can be one of the following: r x 2 table where first column contains disease counts and second column contains person time at risk; or a single numeric vector for counts followed by person time at risk } \item{y}{ vector of person-time at risk; if provided, x must be a vector of disease counts } \item{rr}{rate ratio reference value (default is no association)} \item{rev}{ reverse order of "rows", "colums", "both", or "neither" (default) } } \details{ Tests for independence where each row of the rx2 table is compared to the exposure reference level and test of independence two-sided p values are calculated using mid-p xxact, and normal approximation. This function expects the following table struture: \preformatted{ counts person-time exposed=0 (ref) n00 t01 exposed=1 n10 t11 exposed=2 n20 t21 exposed=3 n30 t31 } The reason for this is because each level of exposure is compared to the reference level. If the table you want to provide to this function is not in the preferred form, just use the \code{rev} option to "reverse" the rows, columns, or both. If you are providing categorical variables (factors or character vectors), the first level of the "exposure" variable is treated as the reference. However, you can set the reference of a factor using the \code{\link[stats]{relevel}} function. Likewise, each row of the rx2 table is compared to the exposure reference level and test of independence two-sided p values are calculated using mid-p exact method and normal approximation. This function can be used to construct a p value function by testing the MUE to the null hypothesis (rr=1) and alternative hypotheses (rr not equal to 1) to calculate two-side mid-p exact p values. For more detail, see Rothman. } \value{ \item{x}{table that was used in analysis} \item{p.value}{p value for test of independence} } \references{ Kenneth J. Rothman and Sander Greenland (2008), Modern Epidemiology, Lippincott Williams and Wilkins Publishers Kenneth J. Rothman (2002), Epidemiology: An Introduction, Oxford University Press } \author{Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}} \seealso{ \code{\link{rateratio}}, } \examples{ ##Examples from Rothman 1998, p. 238 bc <- c(Unexposed = 15, Exposed = 41) pyears <- c(Unexposed = 19017, Exposed = 28010) dd <- matrix(c(41,15,28010,19017),2,2) dimnames(dd) <- list(Exposure=c("Yes","No"), Outcome=c("BC","PYears")) ##midp rate2by2.test(bc,pyears) rate2by2.test(dd, rev = "r") rate2by2.test(matrix(c(15, 41, 19017, 28010),2,2)) rate2by2.test(c(15, 41, 19017, 28010)) } \keyword{htest} epitools/man/ageadjust.indirect.Rd0000644000176200001440000000744613174424211016733 0ustar liggesusers\name{ageadjust.indirect} \alias{ageadjust.indirect} %- Also NEED an '\alias' for EACH other topic documented here. \title{Age standardization by indirect method, with exact confidence intervals} \description{ Calculates age standardized (adjusted) rates and "exact" confidence intervals using the indirect method } \usage{ ageadjust.indirect(count, pop, stdcount, stdpop, stdrate = NULL, conf.level = 0.95) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{count}{vector of age-specific count of events} \item{pop}{vector of age-specific person-years or population estimates} \item{stdcount}{vector of age-specific standard counts} \item{stdpop}{vector of age-specific standarad population} \item{stdrate}{vector of age-specific standard rates} \item{conf.level}{confidence level (default = 0.95)} } \details{ To make valid comparisons between rates from different groups (e.g., geographic area, ethnicity), one must often adjust for differences in age distribution to remove the confounding affect of age. When the number of events or rates are very small (as is often the case for local area studies), the normal approximation method of calculating confidence intervals may give a negative number for the lower confidence limit. To avoid this common pitfall, one can approximate exact confidence intervals. This function implements this method (Anderson 1998). } \value{ \item{$sir}{observed, expected, standardized incidence ratio, and confidence interval} \item{$rate}{crude.rate, adjusted rate, and confidence interval} } \references{ Anderson RN, Rosenberg HM. Age Standardization of Death Rates: Implementation of the Year 200 Standard. National Vital Statistics Reports; Vol 47 No. 3. Hyattsville, Maryland: National Center for Health Statistics. 1998, pp. 13-19. Available at \url{http://www.cdc.gov/nchs/data/nvsr/nvsr47/nvs47_03.pdf}. Steve Selvin. Statistical Analysis of Epidemiologic Data (Monographs in Epidemiology and Biostatistics, V. 35), Oxford University Press; 3rd edition (May 1, 2004) } \author{Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}. Thanks to Giles Crane (\email{giles.crane@doh.state.nj.us}) for reporting error in 'ageadjust.indirect' function.} \note{Visit \url{https://repitools.wordpress.com/} for the latest} %- ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ See also \code{\link{ageadjust.direct}} } \examples{ ##From Selvin (2004) ##enter data dth60 <- c(141, 926, 1253, 1080, 1869, 4891, 14956, 30888, 41725, 26501, 5928) pop60 <- c(1784033, 7065148, 15658730, 10482916, 9939972, 10563872, 9114202, 6850263, 4702482, 1874619, 330915) dth40 <- c(45, 201, 320, 670, 1126, 3160, 9723, 17935, 22179, 13461, 2238) pop40 <- c(906897, 3794573, 10003544, 10629526, 9465330, 8249558, 7294330, 5022499, 2920220, 1019504, 142532) ##calculate age-specific rates rate60 <- dth60/pop60 rate40 <- dth40/pop40 #create array for display tab <- array(c(dth60, pop60, round(rate60*100000,1), dth40, pop40, round(rate40*100000,1)),c(11,3,2)) agelabs <- c("<1", "1-4", "5-14", "15-24", "25-34", "35-44", "45-54", "55-64", "65-74", "75-84", "85+") dimnames(tab) <- list(agelabs,c("Deaths", "Population", "Rate"), c("1960", "1940")) tab ##implement direct age standardization using 'ageadjust.direct' dsr <- ageadjust.direct(count = dth40, pop = pop40, stdpop = pop60) round(100000*dsr, 2) ##rate per 100,000 per year ##implement indirect age standardization using 'ageadjust.indirect' isr <- ageadjust.indirect(count = dth40, pop = pop40, stdcount = dth60, stdpop = pop60) round(isr$sir, 2) ##standarized incidence ratio round(100000*isr$rate, 1) ##rate per 100,000 per year } \keyword{models} %- \keyword{ ~kwd2 }% __ONLY ONE__ keyword per line epitools/man/pois.conf.int.Rd0000644000176200001440000000503213174424211015640 0ustar liggesusers\name{pois.conf.int} \alias{pois.exact} \alias{pois.daly} \alias{pois.byar} \alias{pois.approx} \title{Confidence intervals for Poisson counts or rates} \description{ Calculates confidence intervals for Poisson counts or rates } \usage{ pois.exact(x, pt = 1, conf.level = 0.95) pois.daly(x, pt = 1, conf.level = 0.95) pois.byar(x, pt = 1, conf.level = 0.95) pois.approx(x, pt = 1, conf.level = 0.95) } \arguments{ \item{x}{count or vector of counts} \item{pt}{person-time at risk (default = 1) or vector of person-times} \item{conf.level}{confidence level (default = 0.95) } } \details{ These functions calculate confidence intervals for a Poisson count or rate using an exact method (\code{pois.exact}), gamma distribution (\code{pois.daly}), Byar's formula (\code{pois.byar}), or normal approximation to the Poisson distribution (\code{pois.approx}). To calculate an exact confidence interval for a crude rate (count divided by person-time at risk), set \code{pt} equal to the person-time at risk. Both \code{x} and \code{pt} can be either a number or a vector of numbers. The \code{pois.daly} function gives essentially identical answers to the \code{pois.exact} function except when x = 0. When x = 0, for the upper confidence limit \code{pois.exact} returns 3.689 and \code{pois.daly} returns 2.996. } \value{ This function returns a n x 6 matrix with the following colnames: \item{x}{Poisson count} \item{pt}{person-time at risk} \item{rate}{crude rate = x/pt} \item{lower}{lower confidence interval limit} \item{upper}{upper confidence interval limit} \item{conf.level}{confidence level} } \references{ Tomas Aragon, et al. Applied Epidemiology Using R. Available at \url{http://www.phdata.science} Leslie Day (1992), "Simple SAS macros for the calculation of exact binomial and Poisson confidence limits." Comput Biol Med, 22(5):351-361 Kenneth Rothman (2002), Epidemiology: An Introduction, Oxford University Press, 1st Edition. } \author{ Tomas Aragon, \email{aragon@berkeley.edu}, \url{https://repitools.wordpress.com/}; with contributions by Francis Dimzon, \email{fdimzon@yahoo.com}; with contributions by Scott Nabity, \email{scott.nabity@sfdph.org} } \seealso{ \code{\link{binom.exact}} } \examples{ pois.exact(1:10) pois.exact(1:10, 101:110) pois.daly(1:10) pois.daly(1:10, 101:110) pois.byar(1:10) pois.byar(1:10, 101:110) pois.approx(1:10) pois.approx(1:10, 101:110) } \keyword{univar} epitools/man/wnv.Rd0000644000176200001440000000050413174424211013762 0ustar liggesusers\name{wnv} \docType{data} \alias{wnv} \title{West Nile Virus human cases reported in California, USA, as of December 14, 2004} \description{ Public Health Surveillance data } \usage{ ##data(wnv) } \format{pending} \source{California Department of Health Services} \references{ pending } \keyword{datasets} epitools/man/as.hour.Rd0000644000176200001440000000773513174424211014544 0ustar liggesusers\name{as.hour} \alias{as.hour} \title{Convert date-time object into hour units} \description{ Convert date-time object into hour or half-hour units } \usage{ as.hour(x, mindt, maxdt, half.hour = FALSE) } \arguments{ \item{x}{ Date-time object in standard format: for example, "2004-12-23 08:27:00", "2004-12-23 08:27", "2004-12-23" } \item{mindt}{ [required] Date-time object in standard format that will form the lower boundary of the hour or half-hour time categories. \code{mindt} must less than or equal to the minimum value in \code{x}, and must be rounded off to the nearst hour for hour categories (e.g., HH:00:00) or rounded off to the nearest half-hour for half-hour categories (e.g., HH:30:00). } \item{maxdt}{ [required] Date-time object in standard format that will form the upper boundary of the hour or half-hour time categories. \code{maxdt} must greater than or equal to the minimum value in \code{x}, and must be rounded off to the nearst hour for hour categories (e.g., HH:00:00) or rounded off to the nearest half-hour for half-hour categories (e.g., HH:30:00). } \item{half.hour}{ Set to TRUE for half-hour categories. } } \details{ This function (1) converts standard date-time objects into 1-hour or 1/2-hour categories, and (2) generates levels for range of values that that the new 1-hour or 1/2-hour categories can take. These levels are use for converting x into a factor and for providing names for labeling the x-axis in plot. This function is used by \code{epicurves.hours}. } \value{ \item{$ct}{ Date-time object that contains the number of seconds since the beginning of 1970 as a numeric vector and produced by \code{\link{as.POSIXct}}. You can use \code{\link{as.POSIXlt}} to convert this output in human legible (already done by this function). } \item{$sec}{seconds} \item{$min}{minutes} \item{$hour}{hours (0-23)} \item{$hour12}{hours (1-12)} \item{$stratum}{number of hours or 1/2 hours since beginning of 1970} \item{$stratum2}{ factor (categorical variable) with number of hours of 1/2 hours since beginning of 1970 using \code{$cstratum} as the levels } \item{$stratum3}{ factor (categorical variable) in standard date-time format indicating number of hours or 1/2 hours since beginning of 1970 using \code{$cstratum2} as the levels } \item{$cstratum}{levels for creating \code{$stratum2} factor} \item{$cstratum2}{levels for creating \code{$stratum3} factor} \item{$csec}{seconds from \code{$cstratum2}} \item{$cmin}{minutes from \code{$cstratum2}} \item{$chour}{hours from \code{$cstratum2} in 24-hour format} \item{$chour12}{hours from \code{$cstratum2} in 12-hour format} \item{$campm}{corresponding 'AM' or 'PM' for \code{$chour12}} \item{$campm2}{corresponding 'am' or 'pm' for \code{$chour12}} \item{$cweekday}{day of the week for \code{$cstratum2}} \item{$cwkday}{abbreviated day of the week for \code{$cstratum2}} \item{$cmday}{day of the month for \code{$cstratum2}} \item{$cmonth}{month for \code{$cstratum2}} \item{$cmon}{abbreviated month for \code{$cstratum2}} \item{$cyear}{year for \code{$cstratum2}} \item{$half.hour}{ FALSE (default) for 1-hour categories; TRUE for 1/2-hour categories} } \references{none} \author{Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}} \seealso{ epitools: \code{\link{as.month}}, \code{\link{epicurve.dates}} \code{\link[base]{as.Date}}, \code{\link[base]{strptime}}, \code{\link[base]{DateTimeClasses}}} \examples{ dates <- c("1/1/04", "1/2/04", "1/3/04", "1/4/04", "1/5/04", "1/6/04", "1/7/04", "1/8/04", "1/9/04", "1/10/04", NA, "1/12/04", "1/14/04", "3/5/04", "5/5/04", "7/6/04", "8/18/04", "12/13/05", "1/5/05", "4/6/05", "7/23/05", "10/3/05") aw <- as.week(dates, format = "\%m/\%d/\%y") aw aw2 <- as.week(dates, format = "\%m/\%d/\%y", sunday= FALSE) aw2 aw3 <- as.week(dates, format = "\%m/\%d/\%y", min.date="2003-01-01") aw3 } \keyword{chron} epitools/man/oddsratio.Rd0000644000176200001440000001521713174424211015147 0ustar liggesusers\name{oddsratio} \alias{oddsratio} \alias{oddsratio.midp} \alias{oddsratio.fisher} \alias{oddsratio.wald} \alias{oddsratio.small} \title{Odds ratio estimation and confidence intervals} \description{ Calculates odds ratio by median-unbiased estimation (mid-p), conditional maximum likelihood estimation (Fisher), unconditional maximum likelihood estimation (Wald), and small sample adjustment (small). Confidence intervals are calculated using exact methods (mid-p and Fisher), normal approximation (Wald), and normal approximation with small sample adjustment (small). } \usage{ oddsratio(x, y = NULL, method = c("midp", "fisher", "wald", "small"), conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), correction = FALSE, verbose = FALSE) oddsratio.midp(x, y = NULL, conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), correction = FALSE, verbose = FALSE, interval = c(0, 1000)) oddsratio.fisher(x, y = NULL, conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), correction = FALSE, verbose = FALSE) oddsratio.wald(x, y = NULL, conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), correction = FALSE, verbose = FALSE) oddsratio.small(x, y = NULL, conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), correction = FALSE, verbose = FALSE) } \arguments{ \item{x}{input data can be one of the following: r x 2 table, vector of numbers from a contigency table (will be transformed into r x 2 table in row-wise order), or single factor or character vector that will be combined with \code{y} into a table.} \item{y}{ single factor or character vector that will be combined with \code{x} into a table (default is NULL) } \item{method}{ method for calculating odds ratio and confidence interval } \item{conf.level}{confidence level (default is 0.95)} \item{rev}{ reverse order of "rows", "colums", "both", or "neither" (default) } \item{correction}{ set to TRUE for Yate's continuity correction (default is FALSE) } \item{verbose}{ set to TRUE to return more detailed results (default is FALSE) } \item{interval}{ interval for the \code{\link{uniroot}} that finds the odds ratio median-unbiased estimate and mid-p exact confidence interval for \code{oddsratio.midp} } \item{...}{ passes optional arguments to \code{\link{tab2by2.test}} for calculatng tests of independence (p values): adding \code{correction = TRUE} implements Yate's continuity correction (default is FALSE), and adding \code{replicates = n} where \code{n} is an integer specifying the number of iterations (default is 2000) of the Monte Carlo simulation method of calculating p values. } } \details{ Calculates odds ratio by median-unbiased estimation (mid-p), conditional maximum likelihood estimation (Fisher), unconditional maximum likelihood estimation (Wald), and small sample adjustment (small). Confidence intervals are calculated using exact methods (mid-p and Fisher), normal approximation (Wald), and normal approximation with small sample adjustment (small). This function expects the following table struture: \preformatted{ disease=0 disease=1 exposed=0 (ref) n00 n01 exposed=1 n10 n11 exposed=2 n20 n21 exposed=3 n30 n31 } The reason for this is because each level of exposure is compared to the reference level. If you are providing a 2x2 table the following table is preferred: \preformatted{ disease=0 disease=1 exposed=0 (ref) n00 n01 exposed=1 n10 n11 } however, for odds ratios from 2x2 tables, the following table is equivalent: \preformatted{ disease=1 disease=0 exposed=1 n11 n10 exposed=0 n01 n00 } If the table you want to provide to this function is not in the preferred form, just use the \code{rev} option to "reverse" the rows, columns, or both. If you are providing categorical variables (factors or character vectors), the first level of the "exposure" variable is treated as the reference. However, you can set the reference of a factor using the \code{\link[stats]{relevel}} function. Likewise, each row of the rx2 table is compared to the exposure reference level and test of independence two-sided p values are calculated using mid-p exact, Fisher's Exact, Monte Carlo simulation, and the chi-square test. } \value{ \item{x}{table that was used in analysis (verbose = TRUE)} \item{data}{same table as \code{x} but with marginal totals} \item{p.exposed}{proportions exposed (verbose = TRUE)} \item{p.outcome}{proportions experienced outcome (verbose = TRUE)} \item{measure}{risk ratio and confidence interval} \item{conf.level}{confidence level used (verbose = TRUE)} \item{p.value}{p value for test of independence} \item{replicates}{number of replicates used in Monte Carlo simulation p value (verbose = TRUE)} \item{correction}{logical specifying if continuity correction was used} } \references{ Kenneth J. Rothman and Sander Greenland (1998), Modern Epidemiology, Lippincott-Raven Publishers Kenneth J. Rothman (2002), Epidemiology: An Introduction, Oxford University Press Nicolas P. Jewell (2004), Statistics for Epidemiology, 1st Edition, 2004, Chapman & Hall, pp. 73-81 } \author{Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}} \seealso{ \code{\link{tab2by2.test}}, \code{\link{riskratio}}, \code{\link{rateratio}}, \code{\link{ormidp.test}}, \code{\link{epitab}} } \examples{ ##Case-control study assessing whether exposure to tap water ##is associated with cryptosporidiosis among AIDS patients tapw <- c("Lowest", "Intermediate", "Highest") outc <- c("Case", "Control") dat <- matrix(c(2, 29, 35, 64, 12, 6),3,2,byrow=TRUE) dimnames(dat) <- list("Tap water exposure" = tapw, "Outcome" = outc) oddsratio(dat, rev="c") oddsratio.midp(dat, rev="c") oddsratio.fisher(dat, rev="c") oddsratio.wald(dat, rev="c") oddsratio.small(dat, rev="c") } \keyword{models} %- \keyword{ ~kwd2 }% __ONLY ONE__ keyword per line epitools/man/colors.plot.Rd0000644000176200001440000000424613174424211015435 0ustar liggesusers\name{colors.plot} \alias{colors.plot} \alias{colors.matrix} %- Also NEED an '\alias' for EACH other topic documented here. \title{Plots R's 657 named colors for selection} \description{ Plots R's 657 named colors for selection } \usage{ colors.plot(locator = FALSE, cex.axis = 0.7) colors.matrix() } %- maybe also 'usage' for other objects documented here. \arguments{ \code{colors.plot}: \item{locator}{activates 'locator' for interactive selection of color names (default is FALSE)} \item{cex.axis}{change size of axes labels} \code{colors.matrix} has no arguments. } \details{ The \code{colors.plot} function plots R's 657 named colors. If \code{locator=TRUE} then you can interactively point and click to select the colors for which you want names. To end selection, right click on the mouse and select 'Stop', then R returns the selected color names. The \code{colors.matrix} function is used by \code{colors.plot} to create the matrix of color names that corresponds to the graph created by \code{colors.plot}. \code{colors.matrix} can be used alone to create the matrix of name without generating a plot. To see the matrix it must be assigned an object name and then displayed. } \value{ \code{colors.plot} generates plot with R colors and, when \code{locator=TRUE}, returns matrix with graph coordinates and names of colors selected \code{colors.matrix} quietly returns matrix of names } %- \item{comp1 }{Description of 'comp1'} %- \item{comp2 }{Description of 'comp2'} \references{ none } \author{Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}} %- ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{colorbrewer.display}}, \code{\link{colorbrewer.palette}}, \code{\link{colorbrewer.data}} \code{\link[grDevices]{colors}} } \examples{ ##creates matrix with color names cm <- colors.matrix() cm[1:3, 1:3] ##generates plot colors.plot() ##generates plot and activates 'locator' ##don't run ##colors.plot(TRUE) } \keyword{color} %- \keyword{ ~kwd2 }% __ONLY ONE__ keyword per line epitools/man/epicurve.Rd0000644000176200001440000004020613174424211014775 0ustar liggesusers\name{epicurve} \alias{epicurve.hours} \alias{epicurve.dates} \alias{epicurve.weeks} \alias{epicurve.months} \alias{epicurve.table} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Construct an epidemic curve } \description{ Construct an epidemic curve } \usage{ epicurve.dates(x, format = "\%Y-\%m-\%d", strata = NULL, min.date, max.date, before = 7, after = 7, width = 1, space = 0, tick = TRUE, tick.offset = 0.5, segments = FALSE, ...) epicurve.weeks(x, format = "\%Y-\%m-\%d", strata = NULL, min.date, max.date, before = 7, after = 7, width = 1, space = 0, tick = TRUE, tick.offset = 0.5, segments = FALSE, origin = as.Date("1970-01-01"), sunday = TRUE, ...) epicurve.months(x, format = "\%Y-\%m-\%d", strata = NULL, min.date, max.date, before = 31, after = 31, width = 1, space = 0, tick = TRUE, tick.offset = 0.5, segments = FALSE, origin = as.Date("1970-01-01"), ...) epicurve.hours(x, mindt, maxdt, strata = NULL, half.hour = FALSE, width = 1, space = 0, tick = TRUE, tick.offset = 0.5, segments = FALSE, ...) epicurve.table(x, width = 1, space = 0, tick = TRUE, tick.offset = 0.5, segments = FALSE, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ character vector of dates } \item{format}{ date format of \code{x}; default is of form "2004-08-10" } \item{strata}{ [optional] categorical vector (character or factor) for stratifying \code{x} } \item{min.date}{ [optional] minimum calendar date for plotting x-axis of an epidemic curve; should be of the form of "2004-08-10"; if no date is specified, then several days are subtracted from the minimum date in \code{x} as specified by the \code{before} option } \item{max.date}{ [optional] maximum calendar date for plotting x-axis of an epidemic curve; should be of the form of "2004-08-10"; if no date is specified, then several days are added to the maximum date in \code{x} as specified by the \code{after} option } \item{before}{ if \code{min.date} is not specified, then these number of days are subtracted from the minimum date in \code{x} for plotting minimum calendar date for epidemic curve } \item{after}{ if \code{max.date} is not specified, then these number of days are added to the maximum date in \code{x} for plotting maximum calendar date for epidemic curve } \item{mindt}{ [required] Date-time object in standard format that will form the lower boundary of the hour or half-hour time categories. The \code{mindt} option must less than or equal to the minimum value in \code{x}, and must be rounded off to the nearst hour for hour categories (e.g., HH:00:00) or rounded off to the nearest half-hour for half-hour categories (e.g., HH:30:00). } \item{maxdt}{ [required] Date-time object in standard format that will form the upper boundary of the hour or half-hour time categories. The \code{maxdt} option must greater than or equal to the minimum value in \code{x}, and must be rounded off to the nearst hour for hour categories (e.g., HH:00:00) or rounded off to the nearest half-hour for half-hour categories (e.g., HH:30:00). } \item{half.hour}{ Set to TRUE for half-hour categories in \code{epicurve.hours}. } \item{width}{ width of bars in the epidemic curve; this value is passed to \code{barplot} function } \item{space}{ space between bars in the epidemic curve; this value is passed to \code{barplot} function } \item{tick}{ adds tick marks to the x-axis (default = TRUE) } \item{tick.offset}{ offsets tick marks so that they plotted between the bars } \item{segments}{ segments bars so that each box represents one case } \item{origin}{ allows user to specify an alternative origin for Julian dates that are generated by this function (default = "1970-01-01") } \item{sunday}{ First day of the week is Sunday (default = TRUE); setting to FALSE makes Monday the first day of the week } \item{...}{ options are passed to the \code{barplot} function } } \details{ These functions makes plotting epidemic curves much easier in R. Normally, to plot an epidemic curve in R, one must do the following: (1) have disease onset dates in some calendar date format, (2) convert these onset dates into a factor with the levels specified by the range of calendar dates for the x-axis of the epidemic curve, (3) convert this factor into a table (with or without stratification), (4) use this table as an argument in the \code{barplot} function to plot the epidemic curve, and (5) make final adjustments (labels, titles, etc.). Why use the \code{barplot} function? Strictly speaking, an epidemic curve is a histogram displaying the distribution of onset times which are categorized into, for example, dates. However, histogram functions seems to work better for measurements that our continuous (e.g., height, weight). In contrast, epidemic curves are constructed from onset time data that has been categorized into days, weeks, or months. For this type of categorical data, the \code{barplot} does a better job. The caveat, however, is that we need to specify the range of possible calendar dates, weeks, or months in order to construct an appropriate plot. To do this we convert the data into a factor with the levels specified by the possible calendar date values. To make this whole process much easier, and to generate additional data that can be use for labeling your epidemic curve, the \code{epicurve} functions were created. } \value{ \item{epicurve.dates}{returns list:} \item{$dates}{ input dates are converted to standard calendar date format } \item{$dates2}{ input dates are also converted to a factor with levels determined by the calendar dates (\code{$cdates}) used to plot the epidemic curve } \item{$xvals}{ x-axis numeric values used for plotting the epidemic curve; this comes from the \code{barplot} function } \item{$cdates}{ the calendar dates used for plotting the epidemic curve } \item{$cmday}{ the day of the mon (1-31) for the calendar dates used for plotting the x-axis of the epidemic curve } \item{$cmonth}{ the months (Jan, Feb, Mar, ...) for the calendar dates used for plotting the x-axis of the epidemic curve } \item{$cyear}{ the years (e.g., 1996, 2001, ...) for the calendar dates used for plotting the x-axis of the epidemic curve } \item{epicurve.weeks}{returns list:} \item{$dates}{ input dates are converted to standard calendar date format } \item{$firstday}{ first day of the week is reported } \item{$week}{ week of the year (1-53); note that week 52 or 53 can represent both last week of a year but also the first few days at the beginning of the year } \item{$stratum}{ the Julian date for the mid-week day of the \code{$week} value } \item{$stratum2}{ the Julian date for the mid-week day of the \code{$week} value converted to a factor with levels determined by the Julian dates (\code{$cstratum}) used to plot the epidemic curve } \item{$stratum3}{ the mid-week day of the \code{$week} value converted to standard calendar dates } \item{$xvals}{ x-axis numeric values used for plotting the epidemic curve; this comes from the \code{barplot} function } \item{$cweek}{ the week of the year used for plotting the x-axis of the epidemic curve } \item{$cstratum}{ the Julian date for the mid-week day of the \code{$cweek} value used for plotting the x-axis of the epidemic curve } \item{$cstratum2}{ the standard calendar date for the mid-week day of the \code{$cweek} value used for plotting the x-axis of the epidemic curve } \item{$cmday}{ the day of the mon (1-31) for the calendar dates used for plotting the x-axis of the epidemic curve } \item{$cmonth}{ the months (Jan, Feb, Mar, ...) for the calendar dates used for plotting the x-axis of the epidemic curve } \item{$cyear}{ the years (e.g., 1996, 2001, ...) for the calendar dates used for plotting the x-axis of the epidemic curve } \item{epicurve.months}{returns list:} \item{$dates}{ input dates are converted to standard calendar date format } \item{$mon}{ month of the year (1-12) } \item{$month}{ month of the year (Jan, Feb, Mar, ...) } \item{$stratum}{ the Julian date for the mid-month day of the \code{$mon} value } \item{$stratum2}{ the Julian date for the mid-month day of the \code{$mon} value converted to a factor with levels determined by the Julian dates (\code{$cstratum})used to plot the epidemic curve } \item{$stratum3}{ the mid-month day of the \code{$mon} value converted to standard calendar dates } \item{$xvals}{ x-axis numeric values used for plotting the epidemic curve; this comes from the \code{barplot} function } \item{$cmon}{ the month of the year (1-12) used for plotting the x-axis of the epidemic curve } \item{$cmonth}{ the months (Jan, Feb, Mar, ...) for the calendar dates used for plotting the x-axis of the epidemic curve } \item{$cstratum}{ the Julian date for the mid-month day of the \code{$cmonth} value used for plotting the x-axis of the epidemic curve } \item{$cstratum2}{ the standard calendar date for the mid-month day of the \code{$cmonth} value used for plotting the x-axis of the epidemic curve } \item{$cmday}{ the day of the mon (1-31) for the calendar dates used for plotting the x-axis of the epidemic curve } \item{$cyear}{ the years (e.g., 1996, 2001, ...) for the calendar dates used for plotting the x-axis of the epidemic curve } \item{epicurve.hours}{returns list:} \item{$ct}{ Date-time object that contains the number of seconds since the beginning of 1970 as a numeric vector and produced by \code{\link{as.POSIXct}}. You can use \code{\link{as.POSIXlt}} to convert this output in human legible (already done by this function). } \item{$sec}{seconds} \item{$min}{minutes} \item{$hour}{hours (0-23)} \item{$hour12}{hours (1-12)} \item{$stratum}{number of hours or 1/2 hours since beginning of 1970} \item{$stratum2}{ factor (categorical variable) with number of hours of 1/2 hours since beginning of 1970 using \code{$cstratum} as the levels } \item{$stratum3}{ factor (categorical variable) in standard date-time format indicating number of hours or 1/2 hours since beginning of 1970 using } \item{$xvals}{} \item{$cstratum}{levels for creating \code{$stratum2} factor} \item{$cstratum2}{levels for creating \code{$stratum3} factor} \item{$csec}{seconds from \code{$cstratum2}} \item{$cmin}{minutes from \code{$cstratum2}} \item{$chour}{hours from \code{$cstratum2} in 24-hour format} \item{$chour12}{hours from \code{$cstratum2} in 12-hour format} \item{$campm}{corresponding 'AM' or 'PM' for \code{$chour12}} \item{$campm2}{corresponding 'am' or 'pm' for \code{$chour12}} \item{$cweekday}{day of the week for \code{$cstratum2}} \item{$cwkday}{abbreviated day of the week for \code{$cstratum2}} \item{$cmday}{day of the month for \code{$cstratum2}} \item{$cmonth}{month for \code{$cstratum2}} \item{$cmon}{abbreviated month for \code{$cstratum2}} \item{$cyear}{year for \code{$cstratum2}} \item{$half.hour}{ FALSE (default) for 1-hour categories; TRUE for 1/2-hour categories } \item{epicurve.table}{returns numeric vector:} \item{xvals}{ x-axis numeric values used for plotting the epidemic curve; this comes from the \code{barplot} function } } \references{none} \author{Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}} \seealso{ \code{\link[graphics]{barplot}}, \code{\link[base]{strptime}} } \examples{ ##epicurve.dates sampdates <- seq(as.Date("2004-07-15"), as.Date("2004-09-15"), 1) x <- sample(sampdates, 100, rep=TRUE) xs <- sample(c("Male","Female"), 100, rep=TRUE) epicurve.dates(x) epicurve.dates(x, strata = xs) rr <- epicurve.dates(x, strata = xs, segments = TRUE, axisnames = FALSE) axis(1, at = rr$xvals, labels = rr$cmday, tick = FALSE, line = 0) axis(1, at = rr$xvals, labels = rr$cmonth, tick = FALSE, line = 1) ##epicurve.weeks sampdates <- seq(as.Date("2004-07-15"), as.Date("2004-09-15"), 1) x <- sample(sampdates, 100, rep=TRUE) xs <- sample(c("Male","Female"), 100, rep=TRUE) epicurve.weeks(x) epicurve.weeks(x, strata = xs) rr <- epicurve.weeks(x, strata = xs, segments = TRUE) rr ##epicurve.months dates <- c("1/1/04", "1/2/04", "1/3/04", "1/4/04", "1/5/04", "1/6/04", "1/7/04", "1/8/04", "1/9/04", "1/10/04", NA, "1/12/04", "1/14/04", "3/5/04", "5/5/04", "7/6/04", "8/18/04", "12/13/05", "1/5/05", "4/6/05", "7/23/05", "10/3/05") aw <- as.month(dates, format = "\%m/\%d/\%y") aw aw2 <- as.month(dates, format = "\%m/\%d/\%y", min.date="2003-01-01") aw2 ##epicurve.hours data(oswego) ## create vector with meal date and time mdt <- paste("4/18/1940", oswego$meal.time) mdt[1:10] ## convert into standard date and time meal.dt <- strptime(mdt, "\%m/\%d/\%Y \%I:\%M \%p") meal.dt[1:10] ## create vector with onset date and time odt <- paste(paste(oswego$onset.date,"/1940",sep=""), oswego$onset.time) odt[1:10] ## convert into standard date and time onset.dt <- strptime(odt, "\%m/\%d/\%Y \%I:\%M \%p") onset.dt[1:10] ##set colors col3seq.d <- c("#43A2CA", "#A8DDB5", "#E0F3DB") par.fin <- par()$fin par(fin=c(5,3.4)) ##1-hour categories xv <- epicurve.hours(onset.dt, "1940-04-18 12:00:00", "1940-04-19 12:00:00", axisnames = FALSE, axes = FALSE, ylim = c(0,11), col = col3seq.d[1], segments = TRUE, strata = oswego$sex) hh <- xv$chour12==3 | xv$chour12== 6 | xv$chour12== 9 hh2 <- xv$chour12==12 hh3 <- xv$chour12==1 hlab <- paste(xv$chour12,xv$campm2,sep="") hlab2 <- paste(xv$cmonth,xv$cmday) axis(1, at = xv$xval[hh], labels = xv$chour12[hh], tick = FALSE, line = -.2) axis(1, at = xv$xval[hh2], labels = hlab[hh2], tick = FALSE, line = -.2) axis(1, at = xv$xval[hh3], labels = hlab2[hh3], tick = FALSE, line = 1.0) axis(2, las = 1) title(main = "Figure 1. Cases of Gastrointestinal Illness by Time of Onset of Symptoms (Hour Category) Oswego County, New York, April 18-19, 2004", xlab = "Time of Onset", ylab = "Cases") ##1/2-hour categories xv <- epicurve.hours(onset.dt, "1940-04-18 12:00:00", "1940-04-19 12:00:00", axisnames = FALSE, axes = FALSE, ylim = c(0,11), col = col3seq.d[1], segments = TRUE, half.hour = TRUE, strata = oswego$sex) hh <- xv$chour12==3 | xv$chour12== 6 | xv$chour12== 9 hh2 <- xv$chour12==12 hh3 <- xv$chour12==1 hlab <- paste(xv$chour12,xv$campm2,sep="") hlab2 <- paste(xv$cmonth,xv$cmday) axis(1, at = xv$xval[hh], labels = xv$chour12[hh], tick = FALSE, line = -.2) axis(1, at = xv$xval[hh2], labels = hlab[hh2], tick = FALSE, line = -.2) axis(1, at = xv$xval[hh3], labels = hlab2[hh3], tick = FALSE, line = 1.0) axis(2, las = 1) title(main = "Figure 2. Cases of Gastrointestinal Illness by Time of Onset of Symptoms (1/2 Hour Category) Oswego County, New York, April 18-19, 2004", xlab = "Time of Onset", ylab = "Cases") par(fin=par.fin) ##epicurve.table xvec <- c(1,2,3,4,5,4,3,2,1) epicurve.table(xvec) names(xvec) <- 1991:1999 epicurve.table(xvec) xmtx <- rbind(xvec, xvec) rownames(xmtx) <- c("Male", "Female") epicurve.table(xmtx) epicurve.table(xmtx, seg = TRUE) } \keyword{hplot} epitools/man/binom.conf.int.Rd0000644000176200001440000000426613174424211016002 0ustar liggesusers\name{binom.conf.int} \alias{binom.exact} \alias{binom.wilson} \alias{binom.approx} \title{Confidence intervals for binomial counts or proportions} \description{ Calculates confidence intervals for binomial counts or proportions } \usage{ binom.exact(x, n, conf.level = 0.95) binom.wilson(x, n, conf.level = 0.95) binom.approx(x, n, conf.level = 0.95) } \arguments{ \item{x}{number of successes in n trials, can be a vector} \item{n}{number of Bernoulli trials, can be a vector} \item{conf.level}{confidence level (default = 0.95), can be a vector} } \details{ The function, \code{binom.exact}, calculates exact confidence intervals for binomial counts or proportions. This function uses R's \code{binom.test} function; however, the arguments to this function can be numeric vectors of any length. The function, \code{binom.wilson}, calculates confidence intervals for binomial counts or proportions using Wilson's formula which approximate the exact method. The arguments to this function can be numeric vectors of any length (Rothman). The function, \code{binom.approx}, calculates confidence intervals for binomial counts or proportions using a normal approximation to the binomial distribution. The arguments to this function can be numeric vectors of any length. } \value{ This function returns a n x 6 matrix with the following colnames: \item{x}{number of successes in n trials} \item{n}{number of Bernoulli trials} \item{prop}{proportion = x/n} \item{lower}{lower confidence interval limit} \item{upper}{upper confidence interval limit} \item{conf.level}{confidence level} } \references{ Tomas Aragon, et al. Applied Epidemiology Using R. Available at \url{http://www.phdata.science} Kenneth Rothman (2002), Epidemiology: An Introduction, Oxford University Press, 1st Edition. } \author{Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}} \seealso{ \code{\link{pois.exact}}, \code{\link[stats]{binom.test}} } \examples{ binom.exact(1:10, seq(10, 100, 10)) binom.wilson(1:10, seq(10, 100, 10)) binom.approx(1:10, seq(10, 100, 10)) } \keyword{univar} epitools/man/tab2by2.test.Rd0000644000176200001440000000667513174424211015412 0ustar liggesusers\name{tab2by2.test} \alias{tab2by2.test} \title{Comparative tests of independence in rx2 contigency tables} \description{ Tests for independence where each row of the rx2 table is compared to the exposure reference level and test of independence two-sided p values are calculated using mid-p exact, Fisher's Exact, and the chi-square test. } \usage{ tab2by2.test(x, y = NULL, correction = FALSE, rev = c("neither", "rows", "columns", "both")) } \arguments{ \item{x}{input data can be one of the following: r x 2 table, vector of numbers from a contigency table (will be transformed into r x 2 table in row-wise order), or single factor or character vector that will be combined with \code{y} into a table.} \item{y}{ single factor or character vector that will be combined with \code{x} into a table (default is NULL) } \item{correction}{ set to TRUE for Yate's continuity correction (default is FALSE) } \item{rev}{ reverse order of "rows", "colums", "both", or "neither" (default) } } \details{ Tests for independence where each row of the rx2 table is compared to the exposure reference level and test of independence two-sided p values are calculated using mid-p exact, Fisher's Exact, and the chi-square test. This function expects the following table struture: \preformatted{ disease=0 disease=1 exposed=0 (ref) n00 n01 exposed=1 n10 n11 exposed=2 n20 n21 exposed=3 n30 n31 } The reason for this is because each level of exposure is compared to the reference level. If you are providing a 2x2 table order does not matter: If the table you want to provide to this function is not in the preferred form, just use the \code{rev} option to "reverse" the rows, columns, or both. If you are providing categorical variables (factors or character vectors), the first level of the "exposure" variable is treated as the reference. However, you can set the reference of a factor using the \code{\link[stats]{relevel}} function. Likewise, each row of the rx2 table is compared to the exposure reference level and test of independence two-sided p values are calculated using mid-p exact, Fisher's Exact, Monte Carlo simulation, and the chi-square test. } \value{ \item{x}{table that was used in analysis} \item{p.value}{p value for test of independence} \item{correction}{logical specifying if continuity correction was used} } \references{ Kenneth J. Rothman and Sander Greenland (1998), Modern Epidemiology, Lippincott-Raven Publishers Kenneth J. Rothman (2002), Epidemiology: An Introduction, Oxford University Press Nicolas P. Jewell (2004), Statistics for Epidemiology, 1st Edition, 2004, Chapman & Hall, pp. 73-81 } \author{Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}} \seealso{ \code{\link{oddsratio}}, \code{\link{riskratio}} } \examples{ ##Case-control study assessing whether exposure to tap water ##is associated with cryptosporidiosis among AIDS patients tapw <- c("Lowest", "Intermediate", "Highest") outc <- c("Case", "Control") dat <- matrix(c(2, 29, 35, 64, 12, 6),3,2,byrow=TRUE) dimnames(dat) <- list("Tap water exposure" = tapw, "Outcome" = outc) tab2by2.test(dat, rev="c") } \keyword{htest} epitools/man/expected.Rd0000644000176200001440000000257313174424211014761 0ustar liggesusers\name{expected} \alias{expected} %- Also NEED an '\alias' for EACH other topic documented here. \title{Expected values in a table} \description{ Assuming independence, calculates expected values in a matrix or table. } \usage{ expected(x) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{is a matrix or table} } \details{ Assuming independence, calculates expected values in a matrix or table. } \value{ expected values } \references{ Steve Selvin (2001), Epidemiologic Analysis: A Case-Oriented Approach, Oxford University Press } \author{Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}} %- ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ See also \code{\link[base]{margin.table}} } \examples{ ##From Selvin, 2001, p.2 ##year = year of birth ##one+ = one or more congenital defects ##one = one congenital defect dat <- c(369, 460, 434, 434, 506, 487, 521, 518, 526, 488, 605, 481, 649, 477, 733, 395, 688, 348) ##observed oi <- matrix(dat, nrow =2) colnames(oi) <- 1983:1991 rownames(oi) <- c("one+", "one") ##expected ei <- expected(oi) ##Pearson chi-square test chi2.T <- sum((oi - ei)^2/ei) pchisq(q = chi2.T, df = 8, lower.tail = FALSE) } \keyword{manip} %- \keyword{ ~kwd2 }% __ONLY ONE__ keyword per line epitools/man/as.week.Rd0000644000176200001440000001156713174424211014520 0ustar liggesusers\name{as.week} \alias{as.week} %- Also NEED an '\alias' for EACH other topic documented here. \title{Convert dates object in 'disease week' for plotting epidemic curves} \description{ Convert dates into "disease week" with values of 1 to 53 for plotting epidemic curves } \usage{ as.week(x, format = "\%Y-\%m-\%d", min.date, max.date, before = 7, after = 7, origin = as.Date("1970-01-01"), sunday = TRUE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ character vector of dates } \item{format}{ date format of \code{x}; default is of form "2004-08-10" } \item{min.date}{ [optional] minimum calendar date for plotting x-axis of an epidemic curve; should be of the form of "2004-08-10"; if no date is specified, then several days are subtracted from the minimum date in \code{x} as specified by the \code{before} option } \item{max.date}{ [optional] maximum calendar date for plotting x-axis of an epidemic curve plot; should be f the form of "2004-08-10"; if no date is specified, then several days are added to the maximum date in \code{x} as specified by the \code{after} option } \item{before}{ if \code{min.date} is not specified, then these number of days are subtracted from the minimum date in \code{x} for plotting minimum calendar date for epidemic curve } \item{after}{ if \code{max.date} is not specified, then these number of days are added to the maximum date in \code{x} for plotting maximum calendar date for epidemic curve } \item{origin}{ allows user to specify an alternative origin for Julian dates that are generated by this function (default = "1970-01-01") } \item{sunday}{ First day of the week is Sunday (default = TRUE); setting to FALSE makes Monday the first day of the week } } \details{ In public health, reportable diseases are often reported by 'disease week' (either week of reporting or week of symptom onset). In R, weeks are numbered from 0 to 53 in the same year. The first day of week 1 starts with either the first Sunday or Monday of the year. Days before week 1 are numbered as 0s. In contrast to R, the \code{as.week} function generates weeks numbered from 1 to 53. The week before week 1 takes on the value (52 or 53) from the last week of the previous year. The \code{as.week} functions facilitates working with multiple years and generating epidemic curves. } \value{ Returns a list of the following: \item{$dates}{ input dates are converted to standard calendar date format } \item{$firstday}{ first day of the week is reported } \item{$week}{ week of the year (1-53); note that week 52 or 53 can represent both last week of a year but also the first few days at the beginning of the year } \item{$stratum}{ the Julian date for the mid-week day of the \code{$week} value } \item{$stratum2}{ the Julian date for the mid-week day of the \code{$week} value converted to a factor with levels determined by the Julian dates (\code{$cstratum}) used to plot the epidemic curve } \item{$stratum3}{ the mid-week day of the \code{$week} value converted to standard calendar dates } \item{$cweek}{ the week of the year used for plotting the x-axis of an epidemic curve } \item{$cstratum}{ the Julian date for the mid-week day of the \code{$cweek} value used for plotting the x-axis of an epidemic curve } \item{$cstratum2}{ the standard calendar date for the mid-week day of the \code{$cweek} value used for plotting the x-axis of an epidemic curve } \item{$cmday}{ the day of the mon (1-31) for the calendar dates used for plotting the x-axis of an epidemic curve } \item{$cmonth}{ the months (Jan, Feb, Mar, ...) for the calendar dates used for plotting the x-axis of an epidemic curve } \item{$cyear}{ the years (e.g., 1996, 2001, ...) for the calendar dates used for plotting the x-axis of an epidemic curve } } \references{none} \author{Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}} \seealso{ epitools: \code{\link{as.month}}, \code{\link{epicurve.dates}} \code{\link[base]{as.Date}}, \code{\link[base]{strptime}}, \code{\link[base]{DateTimeClasses}}} \examples{ dates <- c("1/1/04", "1/2/04", "1/3/04", "1/4/04", "1/5/04", "1/6/04", "1/7/04", "1/8/04", "1/9/04", "1/10/04", NA, "1/12/04", "1/14/04", "3/5/04", "5/5/04", "7/6/04", "8/18/04", "12/13/05", "1/5/05", "4/6/05", "7/23/05", "10/3/05") aw <- as.week(dates, format = "\%m/\%d/\%y") aw aw2 <- as.week(dates, format = "\%m/\%d/\%y", sunday= FALSE) aw2 aw3 <- as.week(dates, format = "\%m/\%d/\%y", min.date="2003-01-01") aw3 } \keyword{chron} epitools/man/epitable.Rd0000644000176200001440000000432413174424211014741 0ustar liggesusers\name{epitable} \alias{epitable} \title{Create r x c contigency table (exposure levels vs. binary outcome)} \description{ Create r x c contigency table for r exposure levels and c outcome levels } \usage{ epitable(..., ncol =2, byrow = TRUE, rev = c("neither", "rows", "columns", "both")) } \arguments{ \item{...}{see details} \item{ncol}{ number of columns = 2 (default) when a table is constructed from a vector or sequence of numbers } \item{byrow}{Default is TRUE and single vector or collection of numbers is read in row-wise. Set to FALSE to read in column-wise.} \item{rev}{ reverse order of "rows", "colums", "both", or "neither" (default) } } \details{ Creates r x 2 table with r exposure levels and 2 outcome levels (No vs. Yes). Arguments can be one of the following: (1) four or more integers that be converted into r x 2 table (the number of integers must be even), (2) two categorical vectors (1st vector is exposure with r levels, 2nd vector is outcome with 2 levels), (3) r x 2 contingency table, or (4) single vector that be converted into r x 2 table (the number of integers must be even). The contingency table created by this function is usually used for additional analyses, for example, the \code{epitab} function. } \value{ Returns r x 2 contingency table, usually for additional analyses. } \references{none} \author{Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}} \seealso{ \code{\link{epitable}} } \examples{ ## single vector dat <- c(88, 20, 555, 347) epitable(dat) ## 4 or more integers epitable(1,2,3,4,5,6) ## single matrix epitable(matrix(1:6, 3, 2)) ## two categorical vectors exposure <- factor(sample(c("Low", "Med", "High"), 100, rep=TRUE), levels=c("Low", "Med", "High")) outcome <- factor(sample(c("No", "Yes"), 100, rep=TRUE)) epitable(exposure, outcome) epitable("Exposure"=exposure, "Disease"=outcome) ## reversing row and/or column order zz <- epitable("Exposure Level"=exposure, "Disease"=outcome) zz epitable(zz, rev = "r") epitable(zz, rev = "c") epitable(zz, rev = "b") } \keyword{manip} epitools/man/colorbrewer.Rd0000644000176200001440000000761513174424211015507 0ustar liggesusers\name{colorbrewer} \alias{colorbrewer.display} \alias{colorbrewer.palette} \alias{colorbrewer.data} %- Also NEED an '\alias' for EACH other topic documented here. \title{Display and create ColorBrewer palettes} \description{ Display and create ColorBrewer palettes based on Cindy Brewer's website at www.colorbrewer.org. } \usage{ colorbrewer.display(nclass = 5, type = c("qualitative", "sequential", "diverging"), col.bg = "white") colorbrewer.palette(nclass = 5, type = c("qualitative", "sequential", "diverging"), palette = letters[1:18]) colorbrewer.data() } %- maybe also 'usage' for other objects documented here. \arguments{ \item{nclass}{number of classes or categories to be compared graphically} \item{type}{select either 'qualitative' (default), 'sequential', or 'diverging'} \item{col.bg}{set background color (default is white)} \item{palette}{select palette (letter) from displayed plot} } \details{ These R functions includes color specifications and designs developed by Cynthia Brewer (\url{http://www.colorbrewer.org}). For more details on color selection please visit this excellent site. First, select the number of classes or categories to be compared (\code{nclass}). Second, select the \code{type} of comparison (qualitative vs. sequential vs. diverging). Third, use \code{colorbrewer.display} to display the available ColorBrewer palette for a given type and number of classes. Fourth, using the \code{colorbrewer.palette} function, create a color palette for use in R graphics functions (e.g, col = mypal, where mypal was created from \code{colorbrewer.palette}). Note that you can change the background color. ColorBrewer is Copyright (c) 2002 Cynthia Brewer, Mark Harrower, and The Pennsylvania State University. All rights reserved. The ColorBrewer palettes have been included in this R package with permission of the copyright holder. Copyright and license information at \url{http://www.colorbrewer.org}. These functions for \code{epitools} were created to make the ColorBrewer palettes readily available to \code{epitools} users, and to have the same 3-step selection order as the \url{www.colorbrewer.org} site. A more visually appealing display of the ColorBrewer schemes is available in the \code{RColorBrewer} package. } \value{ \code{colorbrewer.display} displays ColorBrewer selection and invisibly returns data that corresponds to graphical display \code{colorbrewer.palette} returns \code{rgb} vector palette } %- \item{comp1 }{Description of 'comp1'} %- \item{comp2 }{Description of 'comp2'} \references{ ColorBrewer, by Cynthia Brewer, Pennsylvanis State University, \email{cbrewer@psu.edu}, \url{http://www.colorbrewer.org} accessed on 2004-11-26 } \author{ Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science} } %- ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{epitools} package: \code{\link{colors.plot}} } \examples{ ##display available palettes for given nclass and type colorbrewer.display(9, "sequential") ##change background to blue colorbrewer.display(9, "sequential", "blue") ##display available palettes for given nclass and type, ##but also display RGB numbers to create your own palette cbrewer.9s <- colorbrewer.display(9, "sequential") cbrewer.9s ##Display and use ColorBrewer palette ##first, display and choose palette (letter) colorbrewer.palette(10, "q") ##second, extract and use ColorBrewer palette mycolors <- colorbrewer.palette(nclass = 10, type = "q", palette = "b") xx <- 1:10 yy <- outer(1:10, 1:10, "*") matplot(xx,yy, type="l", col = mycolors, lty = 1, lwd = 4) } \keyword{color} %- \keyword{ ~kwd2 }% __ONLY ONE__ keyword per line epitools/man/as.month.Rd0000644000176200001440000001043313174424211014701 0ustar liggesusers\name{as.month} \alias{as.month} %- Also NEED an '\alias' for EACH other topic documented here. \title{Convert dates into months of the year for plotting epidemic curves} \description{ Converts dates into months of the year (1-12); but also creates range of calendar months that can be used to plot an epidemic curve } \usage{ as.month(x, format = "\%Y-\%m-\%d", min.date, max.date, before = 31, after = 31, origin = as.Date("1970-01-01"), abbreviate = TRUE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ character vector of dates } \item{format}{ date format of \code{x}; default is of form "2004-08-10" } \item{min.date}{ [optional] minimum calendar date for plotting x-axis of an epidemic curve; should be of the form of "2004-08-10"; if no date is specified, then several days are subtracted from the minimum date in \code{x} as specified by the \code{before} option } \item{max.date}{ [optional] maximum calendar date for plotting x-axis of an epidemic curve plot; should be f the form of "2004-08-10"; if no date is specified, then several days are added to the maximum date in \code{x} as specified by the \code{after} option } \item{before}{ if \code{min.date} is not specified, then these number of days are subtracted from the minimum date in \code{x} for plotting minimum calendar date for epidemic curve } \item{after}{ if \code{max.date} is not specified, then these number of days are added to the maximum date in \code{x} for plotting maximum calendar date for epidemic curve } \item{origin}{ allows user to specify an alternative origin for Julian dates that are generated by this function (default = "1970-01-01") } \item{abbreviate}{ abbreviate month names to Jan, Feb, Mar, etc.; often used for labeling plots } } \details{ This function converts dates to months (1-12). In addition, a range of calendar months are generated that can be used to plot the x-axis of an epidemic curve. } \value{ Returns a list of the following: \item{$dates}{ input dates are converted to standard calendar date format } \item{$mon}{ month of the year (1-12) } \item{$month}{ month of the year (Jan, Feb, Mar, ...) } \item{$stratum}{ the Julian date for the mid-month day of the \code{$mon} value } \item{$stratum2}{ the Julian date for the mid-month day of the \code{$mon} value converted to a factor with levels determined by the Julian dates (\code{$cstratum})used to plot an epidemic curve } \item{$stratum3}{ the mid-month day of the \code{$mon} value converted to standard calendar dates } \item{$cmon}{ the month of the year (1-12) used for plotting the x-axis of the epidemic curve } \item{$cmonth}{ the months (Jan, Feb, Mar, ...) for the calendar dates used for plotting the x-axis of an epidemic curve } \item{$cstratum}{ the Julian date for the mid-month day of the \code{$cmonth} value used for plotting the x-axis of an epidemic curve } \item{$cstratum2}{ the standard calendar date for the mid-month day of the \code{$cmonth} value used for plotting the x-axis of an epidemic curve } \item{$cmday}{ the day of the mon (1-31) for the calendar dates used for plotting the x-axis of an epidemic curve } \item{$cyear}{ the years (e.g., 1996, 2001, ...) for the calendar dates used for plotting the x-axis of the epidemic curve } } \references{none} \author{Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}} \seealso{ epitools: \code{\link{as.week}}, \code{\link{epicurve.dates}} \code{\link[base]{as.Date}}, \code{\link[base]{strptime}}, \code{\link[base]{DateTimeClasses}}} \examples{ dates <- c("1/1/04", "1/2/04", "1/3/04", "1/4/04", "1/5/04", "1/6/04", "1/7/04", "1/8/04", "1/9/04", "1/10/04", NA, "1/12/04", "1/14/04", "3/5/04", "5/5/04", "7/6/04", "8/18/04", "12/13/05", "1/5/05", "4/6/05", "7/23/05", "10/3/05") aw <- as.month(dates, format = "\%m/\%d/\%y") aw aw2 <- as.month(dates, format = "\%m/\%d/\%y", min.date="2003-01-01") aw2 } \keyword{chron} epitools/man/or.midp.Rd0000644000176200001440000000365313174424211014530 0ustar liggesusers\name{or.midp} \alias{or.midp} \title{Odds ratio estimation and confidence intervals using mid-p method} \description{ Calculates odds ratio by median-unbiased estimation and exact confidence interval using the mid-p method (Rothman 1998). } \usage{ or.midp(x, conf.level = 0.95, byrow = TRUE, interval = c(0, 1000)) } \arguments{ \item{x}{input data can be 2x2 matrix or vector of length 4} \item{conf.level}{confidence level (default is 0.95)} \item{byrow}{integer vectors are read in row-wise (default)} \item{interval}{interval for the \code{\link{uniroot}} that finds the odds ratio median-unbiased estimate and mid-p exact confidence interval for \code{oddsratio.midp}} } \details{ Calculates odds ratio by median-unbiased estimation and exact confidence interval using the mid-p method (Rothman 1998, p. 251). This function expects the following 2x2 table struture: \preformatted{ exposed not exposed disease a1 a0 no disease b1 b0 } or a numeric vector of the form c(a1, a0, b1, b0). This function is used by \code{\link{oddsratio.midp}}. } \value{ \item{x}{table that was used in analysis} \item{data}{same table as \code{x} but with marginal totals} \item{estimate}{median unbiased odds ratio} \item{conf.level}{confidence level used} } \references{ Kenneth J. Rothman and Sander Greenland (1998), Modern Epidemiology, Lippincott-Raven Publishers } \author{Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}} \seealso{ \code{\link{oddsratio}} } \examples{ ##rothman p. 243 z1 <- matrix(c(12,2,7,9),2,2,byrow=TRUE) z2 <- z1[2:1,2:1] ##jewell p. 79 z3 <- matrix(c(347,555,20,88),2,2,byrow=TRUE) z4 <- z3[2:1,2:1] or.midp(z1) or.midp(z2) or.midp(z3) or.midp(z4) } \keyword{models} %- \keyword{ ~kwd2 }% __ONLY ONE__ keyword per line epitools/man/kapmeier.Rd0000644000176200001440000000455313174424211014755 0ustar liggesusers\name{kapmeier} \alias{kapmeier} %- Also NEED an '\alias' for EACH other topic documented here. \title{Implements product-limit (Kaplan-Meier) method} \description{ Implements product-limit (Kaplan-Meier) method for time-to-event data with censoring. } \usage{ kapmeier(time, status) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{time}{numeric vector with individual observation times} \item{status}{integer vector indicating status at the end of the observation time: 1 = event, 0 = censored} } \details{ This function implements the product-limit method for estimating survival probability for time-to-event data with censoring: \preformatted{ S(t) = product[(nj - dj) / nj] for all tj <= t, } where \code{tj} are event times (i.e., times at which one or more events occur), \code{nj} are the number at risk at time \code{tj} (by convention, subjects censored at time \code{tj} are considered at-risk and included in \code{nj}), and \code{dj} are the number of events at time \code{tj}. A primary purpose of this function was to demonstrate the use of available R functions to implement a simple statistical method. For example, \code{kapmeier} uses \code{sort}, \code{order}, \code{duplicated}, \code{tapply}, \code{unique}, \code{cumprod}, \code{cbind}, and \code{dimnames}. Studying this function carefully helps one understand and appreciate the utility of R functions to implement simple methods. For serious survival analysis load the \code{survival} package. The \code{survfit} function in this package implements the product-limit method and much more. See examples. } \value{Returns an individual-level data frame} \references{ Selvin S. Statistical Analysis of Epidemiologic Data (Monographs in Epidemiology and Biostatistics, V. 35). Oxford University Press; 3rd edition (May 1, 2004) } \author{Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}} %- ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ See also \code{\link[survival]{survfit}} } \examples{ ##Product-limit method using 'kapmeier' function tt <- c(1,17,20,9,24,16,2,13,10,3) ss <- c(1,1,1,1,0,0,0,1,0,1) round(kapmeier(tt, ss), 3) } \keyword{survival} %- \keyword{ ~kwd2 }% __ONLY ONE__ keyword per line epitools/man/rateratio.Rd0000644000176200001440000001106113174424211015142 0ustar liggesusers\name{rateratio} \alias{rateratio} \alias{rateratio.midp} \alias{rateratio.wald} \title{Rate ratio estimation and confidence intervals} \description{ Calculates rate ratio by median-unbiased estimation (mid-p), and unconditional maximum likelihood estimation (Wald). Confidence intervals are calculated using exact methods (mid-p), and normal approximation (Wald). } \usage{ rateratio(x, y = NULL, method = c("midp", "wald"), conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), verbose = FALSE) rateratio.midp(x, y = NULL, conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), verbose = FALSE) rateratio.wald(x, y = NULL, conf.level = 0.95, rev = c("neither", "rows", "columns", "both"), verbose = FALSE) } \arguments{ \item{x}{ input data can be one of the following: r x 2 table where first column contains disease counts and second column contains person time at risk; a single numeric vector of counts followed by person time at risk; a single numeric vector of counts combined with \code{y} which would be a numeric vector of corresponding person time at risk } \item{y}{ numeric vector of person-time at risk; if provided, \code{x} must be a numeric vector of disease counts } \item{method}{ method for calculating rate ratio and confidence interval } \item{conf.level}{confidence level (default is 0.95)} \item{rev}{ reverse order of "rows", "colums", "both", or "neither" (default) } \item{verbose}{ set to TRUE to return more detailed results (default is FALSE) } } \details{ Calculates rate ratio by median-unbiased estimation (mid-p), and unconditional maximum likelihood estimation (Wald). Confidence intervals are calculated using exact methods (mid-p), and normal approximation (Wald). This function expects the following table struture: \preformatted{ counts person-time exposed=0 (ref) n00 t01 exposed=1 n10 t11 exposed=2 n20 t21 exposed=3 n30 t31 } The reason for this is because each level of exposure is compared to the reference level. If the table you want to provide to this function is not in the preferred form, just use the \code{rev} option to "reverse" the rows, columns, or both. If you are providing categorical variables (factors or character vectors), the first level of the "exposure" variable is treated as the reference. However, you can set the reference of a factor using the \code{\link[stats]{relevel}} function. Likewise, each row of the rx2 table is compared to the exposure reference level and test of independence two-sided p values are calculated using mid-p exact method and normal approximation (Wald). } \value{ \item{x}{table that was used in analysis (verbose = TRUE)} \item{data}{same table as \code{x} but with marginal totals} \item{measure}{rate ratio and confidence interval} \item{conf.level}{confidence level used (verbose = TRUE)} \item{p.value}{p value for test of independence} } \references{ Kenneth J. Rothman, Sander Greenland, and Timothy Lash (2008), Modern Epidemiology, Lippincott-Raven Publishers Kenneth J. Rothman (2012), Epidemiology: An Introduction, Oxford University Press } \author{Rita Shiau (original author), \email{rita.shiau@sfdph.org}; Tomas Aragon, \email{aragon@berkeley.edu}, \url{http://www.phdata.science}; Adam Omidpanah, \email{adam.omidpanah@wsu.edu} \url{https://repitools.wordpress.com/} } \seealso{ \code{\link{rate2by2.test}}, \code{\link{oddsratio}}, \code{\link{riskratio}}, \code{\link{epitab}} } \examples{ ##Examples from Rothman 1998, p. 238 bc <- c(Unexposed = 15, Exposed = 41) pyears <- c(Unexposed = 19017, Exposed = 28010) dd <- matrix(c(41,15,28010,19017),2,2) dimnames(dd) <- list(Exposure=c("Yes","No"), Outcome=c("BC","PYears")) ##midp rateratio(bc,pyears) rateratio(dd, rev = "r") rateratio(matrix(c(15, 41, 19017, 28010),2,2)) rateratio(c(15, 41, 19017, 28010)) ##midp rateratio.midp(bc,pyears) rateratio.midp(dd, rev = "r") rateratio.midp(matrix(c(15, 41, 19017, 28010),2,2)) rateratio.midp(c(15, 41, 19017, 28010)) ##wald rateratio.wald(bc,pyears) rateratio.wald(dd, rev = "r") rateratio.wald(matrix(c(15, 41, 19017, 28010),2,2)) rateratio.wald(c(15, 41, 19017, 28010)) } \keyword{models} epitools/man/probratio.Rd0000644000176200001440000001110413174424211015147 0ustar liggesusers\name{probratio} \alias{probratio} \title{Obtain unbiased probability ratios from logistic regression models} \description{ Estimates probability (prevalence or risk) ratios from logistic regression models using either maximum likelihood or marginal standardization. When using the latter, standard errors are calculated using the delta method or bootstrap. } \usage{ probratio(object, parm, subset, method=c('ML', 'delta', 'bootstrap'), scale=c('linear', 'log'), level=0.95, seed, NREPS=100, ...) } \arguments{ \item{object}{ a glm object with the family attribute equal to "binomial" } \item{parm}{ a specification of which parameters are to be sequentially assigned predicted responses, either a vector of numbers or a vector of names. If missing, all parameters are considered except the intercept which should not be used except when the method argument is "model".} \item{subset}{ a logical vector referring to which observations are included in the numerators and denominators of risk calculation. The default is TRUE, corresponding to a total population prediction ratios. User can supply subsets to calculate exposed population prediction ratios.} \item{method}{ One of three ways that standard errors of prediction ratios are calculate. Maximum likelihood uses relative risk regression directly. Delta-method uses asymptotically correct normal approximations to prediction ratios. } \item{scale}{ The scale on which marginal standardization calculates normal approximations to variability. When using ML, the log scale is the efficient parameterization.} \item{level}{ The confidence level for confidence intervals.} \item{seed}{ The random number generation seed} \item{NREPS}{ The number of bootstrap samples to be drawn} \item{...}{ Further arguments to glm when using maximum likelihood} } \details{ Estimates prevalence and risk ratios from logistic regression models using either maximum likelihood or marginal standardization. Maximum likelihood is relative risk regression: a GLM with binomial variance structure and a log link. Marginal standardization averages predicted probabilities from logistic regression models in the total sample or exposed sample to obtain prevalence or risk ratios. Standard errors for marginal standardization estimates are calculated with the delta method or the normal bootstrap, which is not bias corrected. Ratios can be estimated on the linear or log scale, which may lead to different inference due to the invariance of Wald statistics. } \value{ An array of ratios or log ratios, their standard errors, a z-score for a hypothesis test for the log ratio being different from 0 or the ratio being different from 1, the corresponding p-value, and the confidence interval for the estimate. } \references{ Muller, Clemma J., and Richard F. MacLehose. "Estimating predicted probabilities from logistic regression: different methods correspond to different target populations." International journal of epidemiology 43.3 (2014): 962-970. Lumley, Thomas, Richard Kronmal, and Shuangge Ma. "Relative risk regression in medical research: models, contrasts, estimators, and algorithms." (2006). } \author{Adam Omidpanah, \email{adam.omidpanah@wsu.edu}} \note{Maximum likelihood estimation via Newton Raphson may result in predicted probabilities greater than 1. This dominates estimating functions and leads to either false convergence or failure. Users should attempt to refit such models themselves using glms with the family argument binomial(link=log). By modifying inputs to glm.control, domination may be averted. An ideal first step is supplying starting coefficients. Input start=c(-log(p), 0,0,...,0) where p is the prevalence of the outcome. The current implementation of bootstrap standard errors, inference, and confidence intervals are not bias corrected. This will be updated in a later version. } \seealso{ \code{\link{glm}}, \code{\link{deriv}},w \code{\link{predict.glm}}, \code{\link{family}} } \examples{ set.seed(123) x <- rnorm(500) y <- rbinom(500, 1, exp(-1 + .3*x)) logreg <- glm(y ~ x, family=binomial) confint.default(logreg) ## 95\% CI over-estimates the 0.3 log-RR pr1 <- probratio(logreg, method='ML', scale='log', start=c(log(mean(y)), 0)) ## generally more efficient to calculate log-RR then exponentiate for non-symmetric 95\% CI pr1 <- probratio(logreg, scale='log', method='delta') pr2 <- probratio(logreg, scale='linear', method='delta') exp(pr1[, 5:6]) pr2[, 5:6] } \keyword{models} \keyword{risk} %- \keyword{ ~kwd2 }% __ONLY ONE__ keyword per line epitools/man/oswego.Rd0000644000176200001440000000755613174424211014471 0ustar liggesusers\name{oswego} \docType{data} \alias{oswego} \title{Outbreak of Gastrointestinal Illness in Oswego County, 1940} \description{ On April 19, 1940, the local health officer in the village of Lycoming, Oswego County, New York, reported the occurrence of an outbreak of acute gastrointestinal illness to the District Health Officer in Syracuse. Dr. A. M. Rubin, epidemiologist-in-training, was assigned to conduct an investigation. When Dr. Rubin arrived in the field, he learned from the health officer that all persons known to be ill had attended a church supper held on the previous evening, April 18. Family members who did not attend the church supper did not become ill. Accordingly, Dr. Rubin focused the investigation on the supper. He completed Interviews with 75 of the 80 persons known to have attended, collecting information about the occurrence and time of onset of symptoms, and foods consumed. Of the 75 persons interviewed, 46 persons reported gastrointestinal illness. The onset of illness in all cases was acute, characterized chiefly by nausea, vomiting, diarrhea, and abdominal pain. None of the ill persons reported having an elevated temperature; all recovered within 24 to 30 hours. Approximately 20% of the ill persons visited physicians. No fecal specimens were obtained for bacteriologic examination. The supper was held in the basement of the village church. Foods were contributed by numerous members of the congregation. The supper began at 6:00 p.m. and continued until 11:00 p.m. Food was spread out on a table and consumed over a period of several hours. Data regarding onset of illness and food eaten or water drunk by each of the 75 persons interviewed are provided in the attached line listing (Oswego dataset). The approximate time of eating supper was collected for only about half the persons who had gastrointestinal illness. } \usage{ ##data(oswego) } \format{ \itemize{ \item{\code{id}}{ subject identificaton number } \item{\code{age}}{ age } \item{\code{sex}}{ sex: F = Female, M = Male } \item{\code{meal.time}}{ meal time on April 18th } \item{\code{ill}}{ developed illness: Y = Yes N = No } \item{\code{onset.date}}{ onset date: "4/18" = April 18th, "4/19" = April 19th } \item{\code{onset.time}}{ onset time: HH:MM AM/PM } \item{\code{baked.ham}}{ consumed item: Y = Yes N = No } \item{\code{spinach}}{ consumed item: Y = Yes N = No } \item{\code{mashed.potato}}{ consumed item: Y = Yes N = No } \item{\code{cabbage.salad}}{ consumed item: Y = Yes N = No } \item{\code{jello rolls}}{ consumed item: Y = Yes N = No } \item{\code{brown.bread}}{ consumed item: Y = Yes N = No } \item{\code{milk}}{ consumed item: Y = Yes N = No } \item{\code{coffee}}{ consumed item: Y = Yes N = No } \item{\code{water}}{ consumed item: Y = Yes N = No } \item{\code{cakes}}{ consumed item: Y = Yes N = No } \item{\code{vanilla.ice.cream}}{ consumed item: Y = Yes N = No } \item{\code{chocolate.ice.cream}}{ consumed item: Y = Yes N = No } \item{\code{fruit.salad}}{ consumed item: Y = Yes N = No } } } \source{ Center for Disease Control and Prevention, Epidemic Intelligence Service } \references{ Oswego: An Outbreak of Gastrointestinal Illness Following a Church Supper (updated 2003): S. aureus outbreak among church picnic attendees, 1940; the classic, straightforward outbreak investigation in a defined population. Training modules available at \url{https://www.cdc.gov/eis/casestudies/xoswego.401-303.student.pdf}. } \keyword{datasets}