pvclust/0000755000176200001440000000000013564755632011772 5ustar liggesuserspvclust/NAMESPACE0000644000176200001440000000122513155452062013174 0ustar liggesusersexport(pvclust) export(pvpick) export(msfit) export(msplot) export(pvrect) export(seplot) export(parPvclust) S3method(plot, pvclust) S3method(lines, pvclust) S3method(text, pvclust) S3method(print, pvclust) S3method(summary, pvclust) S3method(plot, msfit) S3method(lines, msfit) S3method(summary, msfit) importFrom("grDevices", "n2mfrow") importFrom("graphics", "curve", "lines", "par", "plot", "rect", "segments", "text") importFrom("stats", "as.dist", "cor", "dist", "dnorm", "hclust", "lsfit", "na.omit", "pchisq", "pnorm", "qnorm", "rmultinom") importFrom("utils", "capture.output", "head", "packageVersion") pvclust/data/0000755000176200001440000000000013451056246012671 5ustar liggesuserspvclust/data/lung.RData0000644000176200001440000025246612677425647014610 0ustar liggesusersBZh91AY&SYSpc|D1!$?x*{9x Q"*3P5P=O@fm4jt+T*Qc%,[Z( M nw吥U%7pE%JIE BN5Z@ (( )!TSAB+153gnJR!TmqҊQ*6[ 5uWj6V/ Yۀ((H(wTH$'-5{⊪}Jiǀ=(LLmXF4Ybՙ{(7}ْJ@)S)TX*JK *F{ ccJQ^m^ )h%HTIRU24h4ODDE@ A@#`?C!"$B@'zxCP?B"E)il4d=M m=6Pjd @P$Jhh=A6S h@2!@ 4M MM<ҍ6=!4y4Lڂ hd=@i#&MĄ {ݾQ-KRή o{kkfo/RW4X"K0ѭsUWk2r,z+] t*IvmDH͵ҵR$el`CȄ1K4ʍ®JȒ0Qi:N{lmPP%ֶ+IQp˥==]N5B^iWV^:=]&7⼊-xiTu3RBAQU2'liAfvk{F b&Pz՞Ӈy~G!!Ăv'Xc1s<{A٫ae5qg6]A1\d*2~ $HI) POL(*4e2&DD.) 3BF&E&"32*Q&$T$D&Ic;wi$,d0֧̒`f$)Q c`fns%$%&f1a0Q„HA$ن30S(ɀ&`  e ڭ"c3&"VK#H6 PJI&vti&`̈3` m6ddD#IaĠEtf)K!A3"XhؚSbQ!E!(S"H2 &,"C 3("A!1) RY dP@PBTيm !)#1E"HHI&f( DDPdML (L$I!$Y L b"4aĒ@1bvڬHR1L E%H%E0R&ebHfle&`da)(E$`1$0Z"1b&@"uu\)&aL]#E$eȲRIB``֯WdMmmU>xUdZTxT&A1jK-J7ߩP.*HŦXRS_ H֫ LMң%G^8QÏ$aAd70Iֳ2x w P"d䡗kHШUե t)\t{6v11))) 6YvejۏpQV.o臌}<+Mvaa]͎[}3ee7wG;ݴ]Z:7`gY?awI8G4iȔ֬٨ņcRH>m٢G;UbMѐnN 9"}[Vѣ-PU9<*jH"Ib9v-'˻$ld!ueZ__%/i6R1)S[Uw`Zə%cMqtk1&` o*5O7?wDZߝVw,\_dk`=&UJ, T}#Hi҃WXhӳІ%d)>(~?Aqh}]{E*`|V/xP[zTe|\~ySJkD5 pTUN;mH_X܊*7Sӡu-n6k"cE m y=ş s+yͷ]D!ܸ1 ;tBIw<&$vRj){xf;.(i;$@Ic ̅&5[+Ʌ5oYjI%eʪANZ+M~eR~T~8g| sϙ\jt<)}ٕ8$+]*6:6:i Z4"eNϓO3w}́Twˬ'N\aэtZ&(;߱=p;roݵds;LNϝ䌃פֿWfF!ŵ0 "A^r{P"3ZeUVqa Gʩ8yJ/,YéVs4O խ;$PdpKl5޻-^*V'~[GL=Rĺ/nb&l)KA=e&iwm<[횭i<4Ikdži ,Y wTM1bIAe}iX匕5vk5Mt>qA9F֝ƻ^;E ب(0]] 3f ^r|BdbKrB,w24j q ٣8z&A䔛]VK%Xo]= '[wH/thF@.̏baPH̺mbۊDaqoWZ(I9}L}y񇊴j TA$cy &?4uo JhEJ nD4`e9)H[Q6(; Q1 h*+j[r( SO݉ܮmO Dr? SnADϵU3QZkIqQ4!/h.u4">B6~3BPphzP;gDFraROIW$m%FȕBBtH"h="QTxˆX4t7ŧw.1JժյvRH(Q ,i ! 6֪?_یKejv?f*f$h")a*v] :PRe!:IZI@&>@SJWJvXԇ\o4FSPx%5/ Wy}5P2vBOE"}^4uD,l YV"+qIA m!BYnA_wӢVgu0QXRhvܰK ӔR&צRֵTG/Q ZUC5Xĺ 4(@qEHQ*U7e|x gV9_Rz~VX2˾/cg EAEnR:ޞ["G+, {.ERoi7J\LLrD ]Av8rđӕJO3<TIZ#s].--qkp.~!X0.Rh\j?Jw*(FZ?Un9B)"de҅s~b(<*w:L6i"FD{wM]=/;+JCʛ;}/ 'YeuF⍄L2(*ta'I4yЙkΪMb[̤# %#^y^5ҥ3\ZR֩<|;I9sYB5ו]M|U!m&ZWzRçvkv.KdrMF= )n4B[a,$"=H3G57(&&DN|D!ߚ|R d+YKQgEL/ދ?=Rn PGa7</w[C4N`Z2َ؄tK:]TUk2:?"-nMot*;N&Aӄک-iOۢU@˚ulOD[yk4"69&yGXZKgF9Z.+v߅ֶH B؁ yHI/cdljy"a:zhZǹ'w,J&V;0cH//Y2"^"bݽ]w9Xm~r2M#M䧉b (lzRʶ'X`Ѫj8 qkdo9v0{"RХQrS}Ċ&۟SbOsOLF חnk&uvcٵg%5*Eēwycي.f}/P>25 ųWd)k#(/ܦ4u -T&cdyLu,j亙{ss?ONٮ$nojTP wa;Ԟf*s"R{-@Rtٷ"mË :fATUnЁ5o3D`W&VI2qkz{9s\#ɀCnyŬR 8l#_D"W/1.dN7ZԷOuӛ'uR}(h1,|[KO4F`Ƙ'nw|]5iԎ5T՟[js+Xnx%/+ֺ,ne|`> Y**;!BUG컉Ǖ ]Fn.(8|"k579Q;fG9D/~f4@ȌrRU<¤0!P~W5]TqC+ضNx]9ͮxb!ůY6JP^G" \QA-h}:mPקx5 >{VBm$.MLҶ޳.sʗEY^TؿS55+g}v'9#KClP|b;! C 1+yU0c}nx'd U v|"ZzsHu i:#VfZFY X7BESy98L\NΞKHi("{8'roHN*Nb_\x:|WvcȂC(I7*9ō8%Nw<ج}u'Dl$́Np۲.o+-ŢTv!Bwuyo ;tmjI)P#6)\!4 Sf''Ng-,6jq&u:{Xo $3ԅ&1  lFl b~ߪ9;M*R:)sy/ߜ}:B!.׬!oJ O3σKSNH[qRs]Q6ܿ[;Ob-MUQm"C HSiVlrE:|A5rffys`5>, :,Kʼ0A7{WԽ">܋2ş mj*grmAEA%>ü ·bNJ2ha)-(TI!$Gnt%? Wܚ)b_ġoV!B(Q8.=4֤3R,jk*渚oSŊ0TLժoqTU Ńf*YeN٤:MdȂb(n|+jkiDBsd޴#AS3v\z7U&ຉ"P:f*f K+s*˙f؈{J`2eNޗH8A^T]`h! ^Iӫâu\wZ㩲5ҸEЊ1rBd3//@sV8&:8czOuc$VD[jɸ*Iժ͚zjN#D2vaNp"nn 3F[J$D!TzZ*'KB>LmtA5v!xޜݭ8pROb=YA *zzTKF7ם8 ڇiQ$>&^i|Y5Zq8gUC'47"_ۡ؛Q ހ[h$@4~ #E.cÖƏf&NpG[|;(zE32yrs&2ȃGlgt+_ [[?:$?#Lnn4*ex2ͲCYغR7sF¹_@51xRD~S8@ѥ`4A(VRaK²!iVM"&NiJ_ !.xzK<#Zh ?] 鑼ٚs;1UESV壄Y٪cI_G;6΅`o m] qVmi1Gi92GUvQT-ʄew5BY,Tw\X2gf |x+]OVIAU|Ŭw Mv5+;#NWEV$asBm1. FEzfYcׂU1p͙#9a_DJu۬ 663U*uL#T #5kEf*A5wDUsr/EC&wIP* ؁p3(Q#֜[{0O3X7PH pڇQVpI {ߵa3FO;2 jE:(NdQ ȵOIf-JjxX&~zrԏ5$/|C A8 1V\t/PnPvcH?hf0Fb0NG`f7e es{JNNbH(λgc"sOe4$?3 =wDneVj3v:'"d涥~'yxJ o ҿ&t9bWzB%((1Q|uф3>qJ %ngCjqaw :Jq ׍j׏4eBYUaV;|:}HII0WDҠшH=Z;Y"]WGn"Qфд9k HQѹZJ!V\EN9Qs99#C 9]t p/+"QՑhZ_J+7'j%ɋ'9haZѝ@KHJMЪ6Tzty*sG]$#jxds4AsoV[ s ֻIII]LL|2Mv2,y)+>Zې;j!i -q JD.en?X:a:RL!XX27o.jQEOzmR}\w;0e~ ;dL-!8O-ʟ&X- Lg>gQy_]A~ \B. MC8Qj.H&>`4rh/S{(gf! p J4 -[\0uP+Iʌ6Yfyvri?Ync=@J&]}/&w8'ͰJ:ʍ:PUKUXՏQuu95r=n"T=>}{ X%X$5Ԯޞ%õd)j:Lr_=Ԩ^.+2͝w1Py}T:xS֧o$hi'̐(n7Z>"hͯT˦ zq㦱 Juʐ+F|#Ъ%p5ZWriÊޛCw8Z1!_tK : i.W:o]pth𘎕4f1Vg4Z'Ӵ_(veCVke1CUdFHpv~(EGZyOwY2i$9TG8{m8`!u,^iRF!Y[sZNZI>ւ]+;~- 8gK:VGa^!@9CuqJBw.ɘK;["R.R۠Lj(/n̓ E\>AW!CKX+\yA@|WY{Xax@uڟ%-cs&5cp7,|t!rɢX)*AY?Bt}:*^,{UMض\{o~e-p; 6ȇwGk3-GeJiy('wuv3uw7)//#8[@Or4 W--҄uywrVXu,> =1seiSu! Ԕ=ڇ.w_cN O[!'ka}ɤ۲![7%,Ø>j!ݿtn·7cIB찿E*q%lʯ _ jry}$~Q*Wl齃# F\]ːtd鈿E#u6t)ƲDqy"br.-y#EdX.̡~{kjDo`/Zxp+LV N߲z yԯAkvnlWU*h#f^PQJ5yf0 R8: /ic wYa{H8:a~HL'U"M+Ia>X?j%Z%>jy +[+u7(7ZX VQ*%!NYȃ#:EUu+)޻>8LjPf{R2"y$(Zfqnu^2>=0d{jt?| K.]bm=^3d!sEˣYh'<w?݌d3J(U'[1$U +禍b?/)fZ*#d YɣݠS4ذ'jc%9nPyȪRqmHkǺj(pm_,:_w/ʥ~ й3@Bg-: V%7)D|+\PiRcq՝0W^NwsoQA:!Dqt]նrOgxp_:ShYQ;v XC[̷#uw]?ܙPYCNHUG\5m>iU31rxd (z73wQ6Lu)o)\A>xh3}z!x_+(:f4$ }>Q?O20v {w(pxXI9C*htv 8DC2>5S\Q;5Q6vq ؈.<sGxV^[?qS6ׄP۝*>fS%‹M'5%CAܠU4%=ʫ&% tysnX\1-?|8"U9r$ou'Yho8b!-iAY3(u mv|PO>iMwEٱP ऱ*Mыa.e=M5yJ>f=a#vO*h~nhLq;ӥ%jBó}$Cx}_z7HO]uM Xث{`Mm/j BO$7n|z8qD#wf#<%֫L+ϹsN[2,9,ѦJJt)H<䭖u ia3C{{u݉q[ ;R:z+? y>L9x "ƨHc3)(qr^57*ok>D9vw~3kD`y5wmBR Yf*sQ &^,xt26t: d.4q“~x;gH^ G{/u]2FsL>fgMB6bJm7ᶝ;ˁ=t?P됙o:>\8 a\K"H|@*<_(i1yz97KL8j#X(rG iɆ3FHV;j!zK]r\^t@v8?`~d_FH5 H .h.YKf~9bAZQ70d~|r~]%%TGb)_b!]WzmkIK8'?BkMOK+}mzo?ԌuÒ+vJ2՗iyH0Q;JBwcIB4o〮6;H0rRTDJ992nx>7?<lhYϹzZL|ŠQiA.r[u3q)1+LIePQ4UY>`%YviN׀/AT.pWt\Xsh!mۗ iӮeQ/ȹ&2"U2-]v}A)-S4Y2 BX$Ӕ+"N^b=k`2A|`aoۺ^?,0o>,;$HTx&*O[\ޥ7K@REEs]8NZ]` 1Q ?j1 |q[¯^Npb r9p}>$2$6PT߇ϷqBg{o~4$9uv<n6'϶HWڍrJ}{eT>)1Lڛya=Q}l,*ШcK?׎%`b|x:zݗk# qAr{Z,΅ܾN43>oX5 &ػF<`K݇D.n.,* .ΪGR}fDP_li|rH{ Dƃu仝XKӋ8 *\!zs@ѸWJ\z%X_[;;&:}wV4|] խ]IMNKt|ǰumE(Qpc`uz8u?$ Q鐭-30MxӏA#/-ǚL DHGo*BQXiVyfsT(0)NRvjEԭ~3u9Tˎm։~\+۸#O;>mB൓orHʵ+ڎἃ'> h_@ SGA> ƅ7v.xC- :G[_Z~3>hLܕC>{`m6=G4f t)@?NT C)x!Fم:I:"7LC;aU#4lxyG,5gyhMsM?>kkd .H59pgY`vC$Mu9i:hUC?֦ri>n/Z'?LpT㑎w[=yB]{T.w`J`H]G/*Kꕟԟp0qy}ئp6y5̦Ba0M4A~=hק`غ ι­+_-rq9p_UZVY_@jϏoMYʩq츔L/!Gl76'"gEEX٣+Y4Y~o/} a@b"A/;؅򑇂hԼњV^e7Ҫ:fh,NNn |tLEJStR}*Sù*Yz nP/1<zҁLtowo WQ)'wy5R ]+&f[11\eZ_ޛߴըW3n6ﰅWύ%wpX:V< S&^WzROY9fꮝG~IQ>Ştv?}iR`WnZ:boҖ/g{jdtߧf4 iiPuĄdXb[Ɵ8]-M bZRu'Mհ-^IO{C1zHm]1UMDegi5{Nti%LH5c̬»_Z\jVՅt5w8IJPL??Reu;fsm7~WmCc2 O|k&+D_kM3Rjw ƌ'2w)\q+]f187~n=:%&8Lˮر9c}ϯ4y[>}wN.FvL_)+iۤ 2+[rI&Թf/Bȷ7e#7L]{%FwK%S7<әG _= xqW+^M༖'s;,P/gf㑐PwՃ 'ؔDyo9ۙ% zt5{7spNmXUӐ <Lw7k6֕4dꦡ'|vv\ͅ=ΨUFi KEK-^1NN=ZIɺPegK'd_QrEaK20c7{5cl-[ſ: ,>p ŰHcPn}z(\,%w+]#W%Ba=~kʶ9Av5!(@ l Juڱ~rv5\2١whSo*Zv{䋴xD %8}W4W?n!ORq #EȖ!iSwQY|8Jx6ڊ,iN5>8Fc)\:2^ H>{S~ƴ OAb8\*])}yޏ<w`5Mw{osTB2_r, >B8?b8f}ΘR$G[jaF0Owc'Hl?Qөl~8S}mf8n#i"EQ7Vp+g {S:I:Zc9>ڮ'hp*kw+Rb:mm lv5LJဦY&D˴GK͘r}=L[w).XTN@Ɠm:N}%((R_蟼R߲tp }߱x7ɢ}>hyl CKRE)(j{EdA9:t~'IJ?zk#K^šgӄEg-8ՆëJMMm쾛vQZsB "зRٵ/pgЬ@+33AxyČUgk{tg?/rKI{S")z  {KDjsEυ[ۊڹ!m5K\*R)wPr.v"FЋugYۮ8oڣS2rdϯΆCT Q6mrrXX蜒–hDAG,dwu.W(} fwV#,1I Iۜ*|4?|2;8r&4uϹAe0coKҒRn'ޯe׋G.u;( /?[Cö{wNZRGavыq*^/a g:ۭA_Wze> 8#bp9d$"q;2/<&9ڕl's[Bzo`>әΞRK,+n:>8%J:IBrW\v~=lBGěme9sʎ 7p_X]mtyHw޹~|ܚƯW !-d# >oX2Egٻh=嚋8k6rA=^N˒{-._mQw YV)|Nc^ ۞0=q|89WZv5lv>gfƵ .# ~۶L:S[4k6'^T-&6lA ;BPr'Y4\@X 0zIAge}sIw90V߬}5LO,j?r{ա{d}4Ɵ43}6{ζ (ī# ot MpHbo==|'sӗ}QjJ.h T~j1b]2g1O07>+ljgo=I*&w?=Ig^e5B1Dw'G#SsRVsXAJӷ~:Uw9K"D],]AbV֦R[yl P"k+}7+OrZg ԵBtƠA'(?( KCOKC gV|K6o%^'eu4)@e?$.5ioB Udk_1i=.6$ѻ X,궖)_]7̭ok0i6'}b XҮk8,˻ \\_؋jqܝf7$R98l҇UnN<ð @NQiSٕN:vßBù)25#nƋgSϤiůrr/Ft`ס KtT¥3 NFmժ{nuzrɫ?Wm3gn<lCkVE491څagx]?Cm M.Grxuf.7co}]*S'$\* o5]{Πz}YŗzcPЀRL햆oHrm<n˸+k7{Kx/Ehsl5qsGXf:hKn*hL3(&GSBT Ÿޕغjd|w:?b0, ;}}/L|)i,l.73aɣjtg!lNFi٫&JۃA&П!<]ϕ7pPm!|o^$Py)Zk,&Gs|i+=BII\>}zH /`ȱ}j[oCPq$VIT>!c,ڎ÷>ݿ`&I~ZC].r%f'ۤ̚". M\Δswr {CZWYXvԜ"O'dS7N]`U ^u{M^> `_{;4# v:˻ﵝ؇}5>*MZT5nO<>;lnr<+VvX;!!ڥk:p]i pFzwSb=>ٓ#m{کn6^==(tsYfN:q))׸O!ua_mqъvOKgNP ~J ۉ.ǦH@Ξ:-;2x7_#K8{v#-qH𖒎0"^?NdGG_ҧTF3Jxbb/ܜn{ :ܝ }3cIOM {*p1'!Nץ53ƗG!uQl9i.CIJ~(N9UGIZuGy۵_YS1ץǖ4:ײ]H]Ůf8̅7kAj.؊kR|9y//;.Mg wb^q|h|"Qo%,6#DHmMDOW[#ޝ75DFWMKh#WC[a8SПq㜋qlDĭg&߬R^xmG9өmæ1M23sM1J8"ڧP9*㒱asܑby#%<5{@8=P򺝒ΎK;21ۑ`&:^8=>CyF܇%Cu'(IIFx]^7E7fNKfP.\NyzIQ5Wy[xZhZ<0ڋfXiQ3xmˉڃ̷{L0|0y&4Bp^4l }Ўų?Nt{؛RtfF}l7;iY 2}EMJ .^oΛX Xcs ?p꿔6+ y0׎* $)p:_6W7'{.[tfOu(/xUw]wyQdR̵9CiW6iAL!Grpԧr$ҕ+Aͱ<3}4.z%w8dJVGa'pe,g)XJqZ'zziO-fZV$(VwV ~6(}/-+񱹬cl{ x`]ݗkM/W 3%O Ja ntxg^_:Pp-=/$QҢN$?Ix#'<T X~ė<=12vu;˷萻Ȓ<:WgP(v̻ƫ]vvhe`+g5Ɓ1'(zQAַ4nyPE1|KsNWj0reܭEÝޫ>;/7^·=drmn+E ͆Uq^$+?N+|/mF1W㿷ؾ'ys0Z*.x!q2Ԙ]O_^uN3*Wm:;ZO}JpYw'˻&a`sâg7& ƮdT`> +GjTl篥*Xȫp?a5P*6/ Moh3?Js[k'Yxrj_9w &'L ,u Ubmu\1v4 I! U>Jknې0sތm.=qZE~;.>:~϶eN!u`S'} o(F13|ʾ]ѥ(/ ҺOc'Ru|J}E=Z6 .c39MѤ? Joǯ\IA2 [w<|Q&į,R<莀 `aa$+YU?v%M*QiNfrZmAڗ/lBzKP7a][X)iG]GZ*_[Gע1(-=D?cا}a;xTZ^CZ}yڿ"e &)]G'?E8־ k:ޥEjs\4_eh;kx!=qZ;1.hg={?{?gZsbݠn~xkp+\VSYRwWN{֒cJG,yk9{ɖ޽_jNh>nMαikmٕ}pm[)|cp#(<v2^({i*;5%!"mF9]I{Eqb]R2c 4yJCXxzb; 0&2D.XʷຍYT^3 q:g%!2UZ(7*<~ۘZrh-0uspuĜƓR/\~EeR}B-MGkڏ*OI;M`e+BT GRƆuf_>97O2{ڐoi%y1C6I!QCX ńwS7D7 Zc5Y{?:kn.ގG"Nu"qfNc&UVwllҫPwGel`n/GV&66+,5 7Cۧg٣u;< lέ7#zλR"h^1,Ղ*1@6I !{/0F$!Z3eqC>ÕT]GW+o*K2w86HoʖcMO%z~Zz@m:m @ ZCkӖJd3?/nYsا<ڶ𤖏ϯ8,;m B7k@tF'ؙipwK"佥IcVR7jY3iiۉ>2vhX"18͛³;pgj'FGEFp|SF+L\ob8e\֟jU`xs`P+aF(c:Y1ǻSn-ȉo{1l:ӚZ ; WoIb&]~Zi:#Ț+'GQrqf[ߐME|Ks~HW2ҠЌҁZIA)[x3@o6T?uy,qGpsY__opw툺'|#p_圶OrIG86 >'U8`今BE'; gnMڨf۪n_8G%Kni_Y{U7pTJ"M۱ܮU+EЖ/K?z7`C1D/ۼ=BםPh&B<[?> _*4x_c8V3tvtKk s2ȕ!S 9Bv6M]|p7DӴwOq+OR'yw8_eݔ9Ӈ~׃} vuƤq^v㓏>I-)Qwv+ѷk,N0p$\&aSv>ᘼϩAsy:h\\+Zƃf}"qe#+R%R _4bİ>ϥan [m(a!ZOo|QqM> ~h[ܡ\K ]p}p疂L>'nu=C((% 5XӬV%H/ލFMxgͻ;'Aխyү f$G ]]ϗt_owLY?[7(Cǘ.VvX=oZtg'9ZpoQXQsH' 0[<5/8+i} ?W:D'[UzؽFx:܄6-dgY bN][)MvnܳHy nUCe4whkҤg -粮-u\&czeŽ`v }8q\&jFºCbŦϗIs${g)J\Wـ]5GN.0^BR3L57>_} a}R8mޝo_`g|1OQ,aJZ+y~@ [:V[ߧޡ'^rژOaU2LNj/1h6_G{1Is)RأwI9N JƩq z!ЃPXr"ifOx0)8951X|V,xQo c+ỐX8V@MĴui|>gA a~s4rØ?PŸs~yDRq~t9W0U].1%J?gf[uM [x_:}Z {G{_RSimt}9EڴlSY;"io>>CިrAW`j>Lrdq5`i9cޠwYgT+C*+KooNe ~~t}F88ID agruB꜊ou cٷec sނ^=VqwVKɺr֘Pj+ڒ4p?m_V/^hĈ}\w-l:HE yY]jpc?vr7eU73P蛏ˉμWrr%־~AwQ+2cN1AbUOUDe{BFcϟ/PNncs鷽b%jcAVNzEgtqNan\ƎZ~>½7vXOpJp$5;LvEt}Bp sԷ22w(+?G.mVS'|n'zJ:H#l)jC:q얠q:Flۙ_XیG+P*/P)z)v7vps|פ[BJg9UfM=):x- n؆zHfOJ3Rf>,%[>i9}y`<֜8_.Z)yp:qm]r3քԜ\uj_=x\Z)^?&֚|EsU/D^9vz7D-ܼh ( p+~5<k3zGHnozs~GDP-n8Tr(r| Zd ,A7JEqQEAoO2K]'ӟze}-~WT6RvXԭ]%nSFvyL>~yW_&Vpk7E\\D,Y;Q^Egy{zBoǭk:w!:A?ʽh;adpzex\drGu1VwfWnQds Y!GཉF+#Zmw  ;l}Q^̼e4>}e3Nop*Fz@p#ǘI4{_Su i{9\Fn4 j5sq[}o6ݼzR!#g˽]ޥ6_ c$>M Az^̰hϚmPx>S ~/]"D.*u,rwuXlu ;We{H KO˱ꯣ8=@}w#YT檺tlоRcd""Fu.rKbRԔ'rm6]gO?MB2/mҋ+-%B'Ӳ W2H<8^K-/()SGXw?x.m{AaXWXru*qKsgb}'8$r;NYuaO;r=G2Utp"ພ rN?SqںO}'~>49cwYu5ҴٵL^T7œ'2)VѝҰD67/(ԧ7jǟv8y#u0{gT4sdV`g޼4qW9K©Z$0d.+%[` 8 D|}6MJ?0^&_ sjPuګ+UE3 N0He`~k>YlFFB'{[^*{i|"[ӹZ:‚ 8#_;.z5zy|yߵ;Uؒt?(Ny1~84w ~ļIli7ĠõÛϥ䈇&Foz\QKع̮UUUQ}>hu+?sLI?>U-.7(O%շu}NmߝOUכ ܜaOu>&䰫T87ex?ܜ)hpN8;j_`eפu[{B@HA~.y9';{u:$ִl]\Qe& Cu?oV2d9:VY}A=U٠oeه:ڌG '"hܙ★ n,|n*$D Gu^S.b e5: TE|'K>HW>\Т\P`KRU,jiHӲ j9IGm4uJXUJtѶnWU?SZ8mZSzET)QdTсղē'i֙,p^+(ҪHPMU=5PdP%BᓤL_X2 JHQ;C ÕPYa;\rOvcʞ!ţ4}ߦ/wxݐ*Vh|G{TA +WRڲhB@Fe-uLԻaaVARFQ'6JAP{s =1;ǒ+2}62X42F!A/fR^ȗ 8V,u=D-ř)YRT%us*M% Ldٍl{y6]+#(`%Wӳ$*{ r6 4;\AJOC*eRV(wsXv˴ sgrrCuउy"@LY]IT6z"я,9v}=3 "0p3JD1a ME̬A:so)$RMj y؄vjh06{XRwS1XOj)qw q btS0tōm\.4fje.bw+N|o`wk;:D[i5d\6u8+f4yi(:X.oCXp y2|zﾴzm6wbQιZ'eѬIvJh&"YM V.|3p/h؏ *bޘјFU:몭ay[zhZM4#JLJQ6*5+뻶b&֍bLU$IY6j6͆Rɶ([bƄUIPmWWխj_Y>H@/)Rs{/:P/KNQu_t&c;(?V,  Hwy')Vz̯$_;2Sz)m^<۫Oz6ϵ:>)(F4,ޗi8ԂuIrTe"6 Y4T&TSYGAQEnrbvEAL,0zGXnM[^@2ͅot>yt#J]qx3ɗfH+nÜ.b<ʴeK'L õLnřsn1~He`cj!)wt<#y+ve㴦kd )U*v۰?E!1 oE$]eS TqQ͂m<ɿ&.IW[kԂbQ97L3 ORT[:&Yn=PK2)|Y"<حx䬧 qe.˕,\7_ jc؆F:\- PSFiV(-XCNCh>.CuwVÐDWnD]STX4~8tTͺ#ၚy2?*`&+P$P=ϒIӑ9;oZ g*(~ _oؠ*;v6.pY_ ł03L:įH=7Ѕ/:"pIױ̉k$,̵pYYnUQ0nD6MNlaOs/ PCrilBȮeFЧ[.SǖhmWY}ǎRHs-Yd: A_ۢu<$d!3}@Q aNh- h@ n|*DbUvٞnCD`hu,04I>\ kc5xd+ ֲ"&0* 'tHcRYK0٬T#$E< fZΧJ-OfiBLݣiPֱًtQH!L^[h#d<$Ә- i[e3 lE܊ {6YU=[PҢ:d+H♾ W\m[CbefeNVBEnO/Aw_|Y,Ŵ\bf|"Yןe$`'J$GZ=_ćȨV-|/>t~D!-z揯P$[^O҆t'.,A9+aj"q9՗JNY hT)&ĐI2,uuch5Dq"cBfS8n tJn( MT jHEvg &$&\^~=V~u j|1zVDv.LőZI9?nO/}X~y_UGHM-W4g"|X2Zqkj",Ց]=p-gj<铣-_NeaLbBFKU3ݟZʔ$JBwnw2j]bLӽEz?PLl(~~X6|תU$!˩@Vǩ4]^n"qpaUiaa@p/9QslƏ-#HQEgsd"y? Xjr]{T}xg3}cϴ%cԻQH2YX>_)\q",PEY욧B1f1 -§7Hzea6uo,i J= +$_vn#4BʁY% Ꞙr$ i\-Q#1كمyT1ɼǀԄdu!\RQ xS,4w "7MTec@ɍ*Q_][?C<1GdķUYa jdR)ɚB࡞J}ԚJSYtA܅:0Pa&U"kkZ&͖S,J~EjmtM j:#tN,ڱxPVz0s⠲7+'X,|ks.`_kGGDFtlHqmV*jO_'h_*z=n+5Ó|Jq>shs'qCmR=/p$5}@!: þ8P~A+jWިZ7{ P`$$ JOqqI9N}.T%&£OVuePUoe?e8nV!y |A#* JR~%'9V$JַQ&17ÎdYA?޲Ri W!UPmLxBLt d2u1{CFMًr !w#C6. /3"שu±(;1؁c"d1zp.'v&e1]FnBUE<7ZJ0;Y/xOopK1g$ittAi7ɣшS@ѐ˽]0 DTe`Ě̇5ݷ06!D鿑UPB`EѸi6[*/[rx ȑBD]z\Q؋to~_?-H}(>$AάjlچE+ EDi1H6eD=`ib8Uy7VAmI{⸏]͸dw!Ɔ:X(Bk&܋.iuʮ6@o2/q9.r1~r0)'w}Oc#.u2 5,˳}F^ O/uָ֠I"3763u*QِB8fnխ@yiЌ#եGdBd)I*HFhs3X۴Yx"Cb**$֤;۫oɏoYOYSF&pD+cr :ҩaͻˑ0ɉ؅-$F4 OUץw*8hYEi"v0.kُ H\P9"4yoILaQeuQ,!uXzV28J[cݍnˡͶc`%"NG:f0/L /f Y*YmB8[N p=IHKHvzlbTwKu ݿfEl =3ȝ9~sfg|ۯ :O GrX|ǒ!9P џ Ν(MO\l\  at3k؄,{>Q `j 3[-9>LYqYWHȂDo[T*=+$23@ItYlESv_O?v!e^'IQ />$4S3쀯*F\kI7mCӄ4&dIf?9W5e:.N}$ppUsPe=j³et2ѱ%"tr2U(P1HfӛS̥zM s*.1V c-Gg漰;Kv'kY[Tꨮ|'Ռϴj}~!yb4)1&lpc9|vL!^&Q`< ѯUm5]̩,]wwy62ɮY! <2]vU6&f lYA4(wHw0= 8諎N+FCṄqfQ:,qj6=@ʅw*+TF4/S8|h3A<Jd֬RtU8=Y+δDI!].w}MB@lߗ7J?ؗA*C[ ;r V~^ +[+}_X5ZҭHSq X^s} dˡ-jC$l{Y_egbC]uj8QbA4JB! @LP{pʓվXA Z LڌǍX[)aQ! <(~gZr'gtzKRI¢)"NV9),.,Z{y#o^xL:Kv;QwLb)9oRMΧB8'&kwi8F7R.SSBb2s0^b-Rݾ^->IK'hP5a3+7>!D]xhMTZhOUW`Gz̲΋~׳G sTV G{֦n,PT Ծ{PQ@): 1n|9*"ǠZ(*<]]bPoǼr.g2lVgfꜼdX㜳빞TMH8`rϚ*I[S{/UmE/q#m=HBvoǁp@#;Q@5/DOe=RrHO* yƳ9[BƸVy9LT(]RZCE4TVUFe ^ѥ>Sy<{ۜfCF=L=[|UxE8VS Y0V?> ݢ[}f$9++J H=.M|<<&VDP\ۿWNCHy6UP}]7Tj]2Rn}.hf缵^Sΐ¤7zF['NZM2`$AS qLļzj;: ID;-K.憑Jh ?рeű4:#4u~#ADq Q5Vb :g<,bغ3iB3XJ3DG ,yfӾ$`+@ϒ<Aٜ&%I` [h$r'wJ}Nօ/H ߽ ozuc) 'Z4茺i6ɚū|gto_!<Ɓђ>)]*sa: wS;$'q&BWsTuvS 65l# j~ djw ߣuƠ#895 G( xByt RxfYםn ?fiX!r~+Lŋ-!. S LCҪ0A 7nvFnPUb|8IE ]5i7;™BQ`&gAHWwWPCX0kX)v(ﲣG|%r7bL>eTN1&Ӧu1vfNaЂMV\-e]T|\fW?*\R3 #elQM-Y`a(!}게8r1Ge.f{G]OU{> Zt/$u)i4r;6 ]څ5㱕R1S!+B&DsEXpP۷JenK:Y"SS0dj(\ q.֙m n2;q K ;;4OHX +FlK[W Ow :AMmnmDV*R7u 6xcUT0Y ;%Jؑ%MZ U2",=+™A)3ȠuapQf%tIB+lB꬞w:|7΅~>ep}T丠U/}ޏSEV ѼF*80eEy_ZPa P{^u:kpt^ p!Zf ղĈRe!%Sg 9dMQ S'@pD3^/EF|^rLT>5|8֟ޔ13|xݠa+>$+ʘUП;Dr]g,dg$:{dԸ݋p;l,*mXvs-6$?!Qt/?w qG>4Oy;͏v29݄9Rc=;³F UqwimoZKS:ZkeޫNm'FmWܯ"ς䱗xPpo\g%t=iG1ޕ^T}ܿ<+7BjqsB[?Pra{6*2_,?Q7e_I'uCw\h{ΰC`]Z@r#8l#Ӌ eHܡVO8j{%|ypK>GFVu\Z{φ*8_Y\Z/ٿIc|՞q5m\?ģץ7,%}{I+n\pj ^]s5 'W'wϲ{]so;q:V'߭ r #/1gJd^0 Y 4K ᷿أ)`JHOE|M]+q2dtK.fM2bӻ'&61i $WsG쏷j?Crd:SY9+ׂˀB4O`KGokUn/Z3;l)kӽjttB+5cشE5[u @=RavnT@o)AUq" .ejԤ0m"NkXL\VUqݰjzRKsu򖒻%c-=(L,3FTRSO,8iPHyc5_E,yY^u.,L#eu]0:ȱdlQ0خw]NQ:,=E9! (S;߼PlZ*! vIՇ#~7|"kLQB͠+E2]# (1O$jOl~yf7XJ(T~r׊:|!;IA[ouՓ0s>2޼`?eݎL{m:BKd=la 0+qYp.Ze#PjD4^@7JJC'nۡZd#g(h3eKZ0Y!!_v-v 0t/a4;3Y?JyIL=ut_ jCvYagRDr#$X2xiN)Pj~gpIA9YUڹPﰋwOyJG$'|֧MO88jO v T l^dgvL` Qo\r5sL٘E+sʱGήxiSɭĢU?/9}sS4d 5]B;Ea؄yyE7M}/ç:%fU7&FȂ`LX-)OI I]ڵQ^4 C!LHL)%HC2Hb0$)1d0)RI dPA)dRDIXFP& FHIvj{?k~OW(#AKSQ3ʲ 4!*9aE)ќ;J;^deUl<;+yiE">EpFl Е-`)w{ R9#WeoK/7mr>V7]\ߓ3`@r;y?K^T[;C266aF5u 驋h͠浰*FEcjoMVUf՜V1WI)Zyqm d!#k7zjy=berqrOcۂa}YÃ:p!f -GjEsQU|Ң6/Q1y2Bս%]HˍWbO'g_\NtNŲAƞl=Xh]g^ gYyk~o4+7QdRG$P81g[#{y"l;.R1gVڝmxG{nwiiZkҨQl-qkpcFȫSACۺ޳t=%Wܖ3|UFC (LR9ľfU<:ͰuLjpe9cگ ݵ}J A{}k$ǥ #H>X؇ߋ^5)=_/97dX-]Yڙ?SfD^T.m~Iz"mR0b󊨸 zrQ'&f:G)Q%C)Rwؓ`y/h_O1Iu1]V{Mww3 l|yf~ OoEneiu54e!Oy@wP&Ď #&xva u@FTj'145 !!Ÿ4qPt#z/u_`vUҞgVx412Jw/Ԡ(rAeZX!H%Nҍ9+=<+#۪{ j3E6eE}ew}!&FLCu 0\u9QtPmϢ3[)t3E`\0=Z1Q=RMU3oEuV!;K%/+qEըF4C p)gǗw<5adL`w,S9)Ԕ+ʮ>f.o$" wS2nFdM]B{$RESG>O. '%\y(&uHZ}\KuuYW[ky$C?֎sq(˨p[`͹T.F uzJZZ[q:Ik*'Lq'Pwuﰦr@lo2-#-1rUjp#C$c- Ƙ#5Sb%Gc {E ux?Ae*v!YJѫ49 bB3R:R Z_9vrybv!djWQۂHz"H%tR3YYt%0NDǭ hq(~? 1Yn_ $&]7_lע!Etؿ9=<.!*7Cy';?̦~;)83yZïuh: /Y%M /n"'uVA0%4-cv&Wvb:E~yP5MQ d%U/Fw¤8rUa ͖UO0ʴh9 a ]I6@aG&0jj;);(Lb_9#r]rCy34ehb̿3%YeXBHIܒ&HM 2"цlMc P60HRi E Mȅ@2&H( i!%$h2)"$k&HoG{@{G.$JoɧZҵIVv֕Ac-2$y7E4܎u[ ^ifOyʑ7I&nTo*szZ2 UNBT3G+[]yB߽{nDTBIlwB~QR?zbݬ-ߟ#;*i3`LDִ#X_v<<=XuEB9j`gfZi lb*^Eh՘r!BS짎n:;1;Ozs3`anV7]TdU(v+9 *< ]IO&{4kՒh+jObTMxƞPf)TTBD9Mʭ :}hɑBmIYaTrOh24I7 ]Iڐ~ʷzp6\9۵cb٩kOiR{1>&uɆݻB3>v5ѪZda2c̡5n 06@j1-Hj3yE0T4mrt&'cx܈Sdفˆ nv*x ֙7m\ 'k7T1!9}'|YNJ]Mc0A}c7 ^9iN4z-.l$:%h'BơD6 Qz%rjј iC_XvN҂РMݕnM|<:%Ҩ~ NqҐqP,H,(o[ÿO!x`B%176L,Y7W su뼶K{:4^5DW~*n &ܥ] 3_RnBV#)!klkc&MLT<e:- Y%!?s\ Q^j#``]A@u^bDH@l&FCE35$L)`4$A12HH% A4$ ((I(@&"Ql$Đa033$H$&2D I H$@`d1RbR( !A$RP YdI$1D``TؚA3F5dh^a1C)Sx{ǎsXM!+#DIhS\ aq_ NU #Ƕ!䉃;~P 5hE \k1I%*D:×_ҧVK4W튔!N|a53HA7`V0G,K_j&]jWqR-@4cnWݩ[;#[J.-fŽF rHM3+'WS۩Pr*b ]bb}kC!+`me5u2/ bf4{αQ7..$hˇWI /T! /ju'Uj*H!ʄjgbADpŁVcb5vh=M(%TW.DMCO$xwc39wysyhH]rwtjnPFMZOJsdp"NZWwJe0B/jBQFh l d{Pp!V09rs X\)vD;ew$&"dtRZ"Vrg1(i/N(H^xvj V 4>RkՅ{g Xم:Yq5* ЧwLZ׼U-t#n?{kZJsuoc$Lܜ1qdR8-G{_=jJ<|=~,jUwasRh#:\+8;.(+so1ვPrxbh̄v#N^;%I" S[t It:O5@c0Ϊ;xF:QuQ }&5EPdU(Q-+Eoce`Pm\AK)6Kxle:ָ MraX1wod>i9n϶+*F"hāvb,ysUbCVcnS|‚ujM3wKEh2*n&+k#W֣eV9vc˭Ln~5W"SK Rׇ\B+xo.koxPd4E'E\c]vbdׯ 7 c ʞG./Z> Gݪfd`_ZUP}5r)K[IUS1?2e9  d Q`9(BCNŏƸK(zv<ȼt#OsANZVUzb)ADTWa DWo<.^ w!ܭ% Xe`#w޵' +nRեv+ <wpS`fwΡ(G0A*.w J]9~14ҝ)jJ,rZh ֆ^5C6[^apw'Ƶ @lJu׋L>ǰf|& ڼWC'iMmZ@xY?-hW f:+Bsl;iCZĹV)Qgo9((U+VւCW =;;yl~QNY-]nœguM{L{p42YH5# aZQH_'dTu`UWt#%~nwUMQ9[D˭wDL ~BF)Ҷ1t 8"sM74ϵVٝd#dU˙8!WPTp=6+z.F\5ei 뵚8ӦEɘEajuVӨGpWLt=er-VVZ1E\" E3-;?zq*B8LYPŤVO}tdٯ&ɣ8.8vsi}yOhX\B/rpq!{^ s2_ib`u!׵|qyhZUSt. טeKZlˋ)7yYԋWԻc0~5bLCy.NC +P% TtC \Ǝ, h(Ko:TS5KA7,wzz׏dwi]Ic'_Eđށ,^/ԋoHސh;"->!Z;Z*S!I({lVۯeH¾ȨJζq|t~/ߵؗuo'.7K`G 1NȪO=®ar?27J6:Uˊ.Ad<ݹ!إ4~({<$$2h`wFzA/]ڰnWuʶӰ\ 7y# T)t4r({8v[҆='gPCq[?x9/h-'KԶ|_xg4$VkZiOX*{;u 6R*JJS\͢s8'9w8Gyu~_ 9|TQgYUi;=;R4Ñs?K> ;PrbkU{ZWs4j){9Y&bhJ) %ʉJF(ˊzHΨR;[Ӛ_Z9b{ob[hOht_>ߧ\La")bA*Zn{%8wo,*Y!% i-`_Gl9cOst"~9;]첂VaዪuoFԸWX(cw'WƚδuI|gX/+"_SkJ:L*Po5aI ɵGGO~>[h=5;kz1q qh lޫ-j#1zw+arGgGUǶApLrSBTJ_ltlL:a(m*Pwm[@2uo̥s掗]kTa(ӽnIVpHW.4c_3H1*5 /czfvu脜tVWj?һhݯW&2h*[D `aڽVb47"$7l*tڛVa;i6p]}&V&;TFfjyy>X,`YH{w|3ўaϭ0U|WRkcB &pT\r)m|<rPNꅽM/eX Ed K](k[ŚppEMy¾bd2G$z3i.]8bBv5GR-Nt[d6$9|Xߵ6&kepr{(]7wGE'?FYtUK꫞/&kS&zA^~%UkRu\ 4QP:^7 $1{;K,1Nb(Mݬ+ -jJɝrFVՂyHԻbA'Ҭmfgظ9Eͫ[YFzG3V"UF{nvR| y`}2XU>Ut5jcy~Zr&Iڮ|Q.VG|q.k_y5>Jn^F-볾qn@=b\|+p!b_L)$;Y6 J߉l_\m*yM~0t\R4KůDu_Z[v$A:v1&|{KJ7-W7zpאMZ[\ע6+RpJ8Y^"_S_3id#b}R۲^$kYh% OkB:o}`gPA5Q.8wnxywj ^ ! 驩s?nƠ 5%Kcuk-,ErwBN [Y"фMO?MGNop&AhxSݠѩ/e÷yM;0nwCa-XJƼvQiwa3|iXǽ٭4rQWeۛZ;LYr2;n3OὫw2PD^S,Hv,}P{lT#xs8;v AeƚW>Cgg'n}Mwz8?< ?xoZ[Ec8.b$ ,~DެAì{ixVxk(q(M3?ĵ~}c'yd-\Z ib"glau^~>!/=y^@(4vKL}\rWKn' !\< c=sU+-G{U! A/c}(fR= A Mԍg IZoX]>iBu=|u[:3QadH^{>^)O E *P ˊ UbZjHEI}Xg^gcnUY'B5)˥$g_;{߰%#j"Cő.xHfb- Bu?~r_ݝBi"0wN%WpST})jL7=(/UZqH;$Bt~&٠[ֽ/;LpY6^6UHq\]zvIOjPCE3}h;L\OHNrik`?hB>|(\ӀYYⶣ}?zw{үP f*[d}]Os{Vm-vogRwpo.G׊t4ܕ70J<fN0t|+I{މ/wЕ+\k_  a6ti~f g_ORqs[j"ciWxb>ue:N>OP>QCJ1 %PRBxtr*}ZFE ~& ݛ^Wp_kz~%tΛkb>6&_GVio==O œ*Yf# 6$/*Of2aj1m^O9#:(˯wXs0l|%zd]@Pt. oZVD"s9 O}F {^_Xr_ Y񃪏@&% >?K NN|KHpO5i_& d('g.v4;%RhRY/CSҤlџl)jQNt4*E]~9[z&}\R '}rאGַn"yi}ҟh]5%`mnútφ~ڼe!Oc0]o(ܦMlՙ',.֥.=GBrkN/zN4s'qD UTtZLV 9fk,~gJ91'1W'liBfp՛7 A\-O_[ktʭۈֽhJ|z"{MIf &[G:7w Dz~)KmҎe7MTr/kV}w+N0$>%4{tRlyI&X%L swVbHe5,!o.ԂDqǟM;JH=S+k^~ϱvyF;,'ۮkYkӴwW>*p(ėhO \CR;<\pni|u6`;a'vBaxa$kJrm=4׬}kV|L=# lon_'Arg_Хߖwc2 SkGPe#L=.粊G0lu]Dk&%5r5hM*S=;Utk8ZWw> $fyq[rhnF<<dž0:f4vhay׫Ji]Ѡ#n[cPby>-~|lӾr6)\ƾLk i#ù.O o[UǙj 8ZkfsTUKʛADKMg H}$SafscʰPWvث7ӣ 9q{ȷDLl|iY(kJn8ѧIzu%pHy w &%QsuKYд⤲1I?NyX+N6י "r3@Q0 n۴-oYαigpk!ƺ1VPqBm& jlXOX qg#z,s59G3(_/{Ȯ<|^ANμ:!/.9$9@ _0T,hQjQ)d/)__{|56GfÔ rp=8*f]R||GE.zM'8BaSgioYgF>O'Of5S@^J.Sukp]϶Grs )qLL;V/C|O}vlhIn[Z 5,_ێi~.}K%.۷۷f;}˛x:L9hvj&ݱnUYC"N1#!Sdc|$#(\;3 Ó $j ZJ5'>N\Rv,w{.kcډI)J[%0\[:M 9Ad2K W#~!iӝwdffO9cY67ܚ#J XwGAM8‹Vf㑝-]v JƳ邬[RЁ} :H3EI%Q`sW0aҲ-MSMNsr@esiKLCEgv#]?Ft):c1"{BiJSE !BMB&hȽx=EGJȜwޯ\}uYk9-H5̰P"24c&kV;6:[|d+!,!#,b kI.:sG卐/>^M.k+Ly3pooˉ ;K8M/{C /D!n!ᓯ. c anyt@[&qXVcƆ yM#2bgn 嶾أ:oTbXcaO,BHDˁ0Ԛ4*eI!fO%!Z[uE^pdyc`6A݇/tId7,[%lj~˸ٌg${Zj X)|7QŨ vApgS:iSiyh$#"DX Z!9m!L ]F6a9w~foO'8XC*]gt~R"bQP9ɺ?.ODZU`%|?!8%RzpZoY_4ށ6 tL4ȩuYik| ź<)NnZĮ8uYM8ID, JcOƝwj:+*V<ېZ ˽6 ^"eņㆠ>X&;j^EƘ<񎙽w־vu.}RX<[_OED`58+3=189{ u5N/Y^^lY~Sfԭ^T݆!RݞkR5qJy};%) cIj=qu.-5yb {t4-X HcxCC; oON^P8X2U}gX*lf/81<ϤHu^(Kf˹Ntff(I.AAƛ_O0U.)`tp7{KO@Di5\0u@]RoJN h8![}uin>U Jv k*(S6T~m1ͦJE9N^p?+} TfnQ|9EۭoiM7r͚~VY6u.;esZqRʖ*6\B$ lZ㻺ٽK))·{!Ar >*W pJJo%([nsj7OBa?Kan[113J}ЎT\jG):٥x,V_fi&h XGk?:>朚ZmgqWXn=vj4xMҟr ԥӂocwFF&U҃nΑ=vjCša#1\3!ܿA7JU9'nlG5Z/,ڣ.ҥ*vܮlGr~ FU)$r{fKq9}>\#&0,򑜠׺V>nҬU9 ZM}js7jBއ-9Aޤ[iڊ3 &Lz\$%xN)U"`fE:$ fʽVЅOLk(Q4Oq;ji'3 Zj;vmoM3͌.E =ƼWL7dw֡ýv0E2 HYZ7V|_ El|Ppo佇4{nFGW17/4K^77tG[T'#\U~/DGW bʷ$BO@ ßmRnlz>4hM]n'RF.ׇ6hNhO}3O]_6]߯$(X +M=Nz+*ύwMչ.ee`qdo"tW8ӪsNL1{tn"(X3S xӡY(t~ԟaaМ>lؔr< ҳBo>g0ֶ-dsFi(FKCЈ&>{pԘ6r6֗+ ~;qh~WYw.rݖeg8Z24 ]a~vE16y;lE57nڔ|VoF[ s{Շ] @'Xa٣!|4> aNwH7@u e,rUV`*מҖ$"ʃORUJP}]"c0OG:qr)hIEkעbFTt f׷J|Ţм O-OW'ЧOA8b/jt-9x/-CVu s/~zc|;To3FKשbZ(s>%K})0.`ϟ>>٨T2cgHGͳ:,nuI ueaurpB0KFݵ@d>mF^aa-k>LpS~O'Фh|A-sP+% 5 sH>:=Wt)`ӆDƷv?fqꚡI>f#N7/f;<`F w{7_`TH]cĶeH/;Ou~& PxMGQszp_ YWn #A=Y~xп:}GXy{p)~g#8U}#_X% ۤJlc}OMvO~H#C&w,4^qVhq {NBǝuOS8^4T]^Ë'#u潊uWXnBe N.im ?ܪRvڙ0gjwh[Kkuw&F7FƗmG8^O5 RS. c{PLM,6^ }HנL^Skʲjg ĭ}_ǝ{TZ҅LfglApD|(/~^~5(0t3F-ʨ +y}5kfw^EJ3_wq}ljj^Kύ${~WG7VpY>#$5l7]gnܔ^ `rн E FM" UvKGbX[ {f5 g'mk%O^PBƵi6Kc9DU;6CLE&NC%a]RGʜ:M r ]2~` z_* UI>eyb ~2\]Glv2덿p IqA>w>"Is8;WsOzЖ*V|kG_,ѹZTװ)+i+Xaw k f׽j4 hP+n4v 5uDDdN!a'@ү}Utd~|BGbtbwJb,ݜBNWG8rؽ1[aKpǎ8Oo3PӔڷoXimBZv{iq,ns{9c{ 䔚bRz4d=oI  4w0`RO|1]q%j7IIk?6HQZJ]t!xJơ9ou]z{w_ܿ}oeQoީjӏ0ۍr==r㚏q'g 5P]H/h^h*VRO'Mg#U bH0I?fv]¥ǁtJTIm o2n#`(_}>c]0sVݦXP2"(,#Xs9Bhe+ A^E P1?C{qW^-4%I[NFrNrw,Q| Pqy'TatW,%D^ 9zv}t~kP~=j['q_e \#ޯx0!?q|l-lzZ3}Jj'ߠ'9Iڔ;|D DF@֑B 꾒|E%~c4pص{BZ6NOvUlEsG>ƿG\qRZ+.cHⴼZ2윉a1{/8_q7}c |1hzշޤtݭa@)W#X o9 խ4;QVd:N7L1U6uS@D_#BAVm4MNo1}@b^@<S .i0Ww?PX5hlgȅL&fNx;B&ϡݗa(ltnm-qyW }N#ցFU+ɀ?Xojurj'|i{~[Y֐CunjMWo - л;nz{3t廓b1Hэ[lG:O(;S87dTu݀c޾ ܹ!IxZ3PG;7_+S (ZX-GG%"5ci<JYmޅwb1%ZTـ.2ZvlO>˩+Q'aiF&]= o?5y1G+N %~tCWg*bfzܒ J"SAp-d__a7𤟽}Yw"֞:NΨu]nZu9=艹2u=ʌzY%]m3h:i!v=y‰Vl.ZN#x Sb%)ܯF%P9Bj HEg$N{rW;*!ms~uT3NMԢ)5_f{l}{H&Y'i]uʿ6^[XvIɚwP]o%J>@ i鳻yY1D:#n?fI0^vP%;'a Ͱ=g뿮>7r2+1FtsG~荕D\џ⪯!`ۭ|Q'M7B 5C7ru{ëuTӫ>=.ڌ˂S\6Mkʳ|[x)Jgq=7;l)JL8uz=o㮕7Ӻ7 _^uQˮڈ]\}e. ϴ헅M;LBء~:5I;Jl°dG9H^ pXrN}/xm{8Y8{@q PlKV.[CK&2TNenLAﶃ})p=L PiL4K5riC;K= !WrfԼ_K񧏶+{ ]7DVv!3jn[]nEc1HIeʣL8#g6|]#)db.~#iymF!":e?hYٝ J. 1C{R.ǜkH 3| u ,0lpVy/H/ϖ%ir6Y=/qX8$XX}y5glgY# a=FB66]q1U+h絥rg|;+o;SthN_ƾ vb#*Gn=vنK=]A5|YT AWy"}o#AݱwNA޹xC9}HV"GBWvy dJp f `y{/#~rH`|R3Wߩ9ۖ[ý,M4yJџ#o$/)jLi9z! ѹ]ܸ"y8؉nt'As[?n9sjOlRl뗠 BO)%'1zrZ ta1@ O5^Pf f*xM8w~|2^Ʃ ѭ1mʼb_䤠0f(zhMYtƑrfgcvFP!9?1,#x;9_4w]x[ْw{Դ<$w$Xvvsw'A0746 Ɠ.}Kur\ڏ;x{փ^}ħhKr;mP".&0Vc>\YF;~Zz q+!%?)_ܵ_K* I;=a.[u/YZ~uES Ő|⹽?"'`Ltgk?yJڏ0 x0 ;{u pwc D'r)Z̟Ӡce_y_G8Bn;_3K._7ea!bs8t? ؾƝV-9 >//?rxw_kK^r wgX;e-Och7].8X 8ogOSŻ8qz+:PnMTp8#5-W3-n$;s?go^̪)" hT{mn-8f {6$Rt [\&#}r[:73}_' ([l M˶3EH f5)y8ܶ|%/"&Mҫ֧5l,rqZ\wJ]:#t_Izzl(}noڰkjc%մ5psxt*"z+OI@[ism2BsEZ=>uX!&Fk]*Hd50Nfb$.@7Ŭ'< \|_K& dTʜ=x! Mb$;lԚjk{Hb]TOJt"<FtyTR1ijtv`$_ZTT'n CiJcbY&U==+U@Ј[T*;ᭆ(<\®p!vMt~Lx>vTfKMݰhJ0,1,Q\QF `Y.уEzɹ1UU ~@⑞]ǣ9Ie5v/p)w>M!Oc9/_t9j4g y᧠i|&q H:!7F&C۽h{[\P3!Bm7KWuɬ(D]6^^Ts0jHgY39۪\0"ǬxX[0ɖG1ya/"L;mh,7<=g߆ M~3YD209 ǃc3 gRu!K(F.&/F5Z +ZBYL0Y $tӟZ թr1ѐn Q "ަe=l˱dR*)cVxOSJAxCV Hy)WN,N|iqn"gcB=&]C$d#]7C*d50VIVwՠGZ_K(p,b଺w4ؒ3&_syc\u4",!T {ݣHm10#\ox睺LǗ 9(\:N//< E)mvyWTD|ds&NJ#ӵ[3o8j&M{/kPCۻSe\0!|=r#zp?sՃedˊ,ݿyȇ VZwVqv⻺CM-$H7ӷ_*p[*8qVE{n!jy}ũȥgD mBl,sc+i'$ 鶚J02Bd$P,I&Q@`dQ"e!XȦ#!$PLQ3&J#$aa1I aI%Umaa"LFLP҉ D E1LK 14V Fib4ȅFe"I #&HHѤhFLC$c2J2$1I(DH"l̳K)HE$RaX$DɊJeM%44Ĉ)L$I!4)!Dƙ@`d&i%MFXI f ɉ$d" D` L1&!IEFD"FBf32ћ RE6`YD @ŌF$S h#6A$RL€$3#,ƔI#(X&2C  cI1I fM$JfIB%3 0j!aH1$13BdI2( fLX E)("0$D121I4H4) $SJOma)ɔEF% $E0X LabPLD 2BȢ#e2IlLH2%l1uVm{/۟lxY 8E?Pc8PIRL'5q%k ȴtT gJsCóhRhdBk[#[-u_9F!ƷvRwL y+&t]]ssW[P Tb&t &@E,N$H?lS,$"b(a]P&'xyZ6UD-i2Zk]ഃu:0xlF,tJ) X\<‡0%+ ;8,PAaW!cˮc9J>^_g,HEV j |6vBo";X BieUӣD 2i0I3KU^bpDgerg;BIp{F Q7B0/(IrHQLw `#ā8Qt(C|׶z]y?աy7FGZNš& (I4f?9µ4-z Y؇Wu a; htȂdq\Sn{۪%vY@)"Vn\z[9") ]@|P.hႩXQ9tQwZa9}3\UvDlֳ3$"i*ꁫy'.lH3Nʣ/'ru->㬫;@1v-)|sLt&iS+` e=SR)1(KkU-ku* [%3o Yt JRY%UIp\&LsʽXԺwvP[t[2߾ߜs *ȣij8bA:\ZX_wr II R-$jԵLPJIv7VƻPFժcFTeZMm]vD0RS<[8qӊ$$tɣ$mW$^dV%[?ZޖO`dzyZO"m(DK<|9Z+8[;XN+u51#B!eX]u5djUCK{S3wG"黫Dы0&k<sF:^k'Nw<5뻿Z# ` bЄL?4`#")L]qvG0qL)4x6DN:깗gGmM:9y"'L.MJӱCt @= ȉ63DHĈ(1Di1DM $$M$(1",2 c!e`0B"E 1 ːc `DĂEf D"MFIdb $b6Xɉ,&&f%&H("ɍ 6BL&M(h4H14d@2$0ȆIdd IȒR!2D3$BiC!a$(e 02(͊DDf$ifbfdd&-2$̐aJF)$#DBH" a4#L%&I!dPi ("Lİ  $jL1HE2S@! F1)I)D1HD2f"2HHd(AٔȊ&a B!Hłi (ƣdhJ 2a R#& dC416 (-6e!D 22fb4BCML!&̐B!$fDa T) c 40#ĉLQ, &$`M"H̲!L4THE0$PR"BH$LS&$0d( )ɠ "R&3b0"HF0) D%FDdЁQJa,bSaL &ɘJ" LfPB@ b1B$$HH1 (PْH2LIF   "abA%I4A%&!% Т3&aɉ RA( F,$dP), % !1 !œ0JZ1a Ff&$hhFIBQC&BS%M$#%"@ Y2%$Jl6BL(AL͘R@bD" T1I("%fld H3L$šE&E0SHF H&b!Q$Ča$bP43"l&61S02""`ML*I"HfbMa 4"Q"fb %"!H$ fc4!Li&J&R@LJl"a$AC2,3F̉ )h@ FI`HQ2/?k[jw^C>N`2?@('` Ӻҙ6g).g,;Dec67X[Tql, ]1ּ洪д \ 4$ܔhKEmQNҭ}uڼroCgDc ~R2z8Xr#jA/$)Yotːh]LO.gq2B1ݹ"Qj-g774fEzZTp |G-Y$o{2z5#~c*] ;jm7asՅGZ(%ٍDz{hi-V[&(qSɺ#&Gɽ*-JUrHN:$W4Hg ִ}m/b,Ȗ t,xY1$IC^ 3-N:Gˎ Leӣ%m !\dp g8.12A˷uL]+/P~dB>N#]wڐٛˤarx?s*h"-/3qITcٮQ`ܮE̳w@h)sG~hx^NgԍL~٭ər;VuhM&66cS1 &I0&H!&F(Cd&Rd 20TA&QbLy>LFBQbh3o-η =툻1فj][S\*C;iX7+bj{B$TF8^d$-M+\V͜;[Xy*e1G(f;k":ÀC4˻Zm;!lLB^8Vsd-6`AK/*TWU;Bى %5F_Vd8<,4]8lr"q*jǸ͘+sEZeJ( bPKf\3ZPE> ʟN 3͈K.\k頳m`jOwt S\N^ {Pڑpd_Lg}b3)J }U#˥>B+ΠZk̞ƞcB | p\=Α=‰ =3 RD(1|Xp&ɹ̣ ;bUvOU77_$D Xz6v>bڄ[3Q؆pnzw:hß[twxqf+-"=,M;9M0uع9e$!$FnDĤDĒ"LI DR6bARĆHBDDHXA!J@  BdфNڛMCbơY3c1D I34%1MI2AR"!4H̔iц3&#P!T P,Q(dYY3@(ARh0L0 4S@ #@f##e&1dd3)H$"A1QHJdD%&F"ifBI`)I0%(1BIS$ĩ # !0ȦI$0"D$a"2P$fBAM3 &,&AJ`d0Idjh2"d"fd@i, T2 H32FBI !"F %A1LFf"dR`h$I )HDS `Q)fb"LIS&i0`L QiD )DJh2e$4)0E,B!hQ3)BaJJ"dR$ @""F FI"Q"#Ia1QJ1IDa$$hJfYL$F)@4d҅2I$!̒i&F@(M$3FlJ,Da403H"JFP6$`1$Fhc3K$X !,JCB@Y0hJ) !IbS!"Q4E)feBb$ e 4!b Q#RA(P $LK! 0B$f )"`L16 JD$LHL M"LئRE1!,2i@%1 Ec0ę̲3 $f`lf`) d!2 3)&$ИI% 2h SdLJRbeB"D%1L 0H,R$I$R&LF!4Bѱ$1P4!,2 `" IfeFfPPR$aJR$"D)$j!e &l ($!2%i"E0M i0$(d̢D4JF1I(2f ,H H4!P!6)"Ld26! IDʘIJed F%)F3BdM!LL%d,ƙJ D`Y"@efeBM3c,؉L4$b2"RDa%f12$HZ(b(%6`" hDf&26jI DLhI1hHD# Rbh!LЉQhL$1` LȦ@b$"M,Ѧ@ ("ȚiAHDJ@fabY 0BLbIDf"iL "a#EiR!șb,3#B D#2$"bd$cAi0 ̉)2dD$D!4#&C2L44Œd&HaR $)F1QAa!4Ibi(( dIIA "44LFQ"" 2D%6$!$DR"@ɨDiQfcDB0a"!HeCE2L d#BI4E1ILi4JQL  !23 d6DhL&1Y!4PD Ͱ`hA* 2Ia(F) &Y2!#a(P&QUN "3CIhH%HEd"# ,DDFd DR #!)2$ D}~[$[9u{yJRW,Ҍsw}5 Tf.(uWy mXJ t#a$;MPw{S̭];)2BJ(3Q=4ka=OO ].j2i/B o,r*8Wst샺$i`!=OkK\״6UVavCnK~E򯣘L bQϐ-hա]dJ=*"?KkZ 5EW NT%igS yhj94mYLa|bSy~ )Q%X7wU3>G;Y -{#HFTT4&T~,Q?)ri>wAjƑ@^y,p%7y60VzJ&T}E *̉0ǧeＣZ#;2(mZԼa4:P|'YЦ_uP铹-qp2w`W6kΝNn }SzȐǥYgZhuz*#YDxw1y']#hd.-FllFL>5[xy80\K GRtKҿu^K$J"£ ݇i`AWڀ]Ϧ}S͙ +v_xiҘ\*] Oo8L|tNeEV^=M<O:\4Ii;3瑩mѹw)P?]xo|Hc$kjB[!L#غ8'o|Ü^4,Պ}T rFDW7ej̤vls'(r4LJbȊKEҒWZ(f<\avHHB]LI@3$ȅ4CP/,ŕ/H✊ŷvnGuRA{S3]e(ą[=fNidQoe\L!GnW٪ZoUw]]tCqb>4ʚZO Y/wffj& "xPÐ)3`w4;![pw^syY4\-.W5f.-f ֪M.Wz( h(i+XQ9x:eDXZޮN^o2rxbyٓ\ty D3#q5A}2 uG wۤ' hΩ':I NIIܩ\9"tpbM2ggRHɔ:C&wq+B-&̈́E֦)NƓTUaݓ=ޫWEZ,RD4Auv&,g-25ךTOCYQ-F [wjrB /e#Z6c'mQm]Q{j_Y/Wjau{&#|ؓ02d:1NU (FaE@wUf0PG% x@-sGp*+Iݑu$qD2znl$Se0MTu}yUxPo.y>`2ZzuLk 3'PX" )L>vP7(}b>LFƙYrٶ*:+? &~TȴySzۄߑP$UuSt-86AJR6"(~-YhSYPbhv Ez,RW\ihK0H )QS U-õ *V!]+Zc.@d-ɪ5 AF(۶ m8~Bj24^0C[akZr(ojʚt\!֥wyaדMW"g ^'gf̮9܆~v.0 #fqt$* &q=zzk.es"BuVLxg7qFd@wYĨgi UF@He^~_10}). Currently, available only for distance \code{"correlation"} and \code{"abscor"}.} % \item{init.rand}{logical. If \code{init.rand=TRUE}, random number % generators are initialized at child processes. Random seeds can be % set by \code{seed} argument.} % \item{seed}{integer vector of random seeds. It should have the same % length as \code{cl}. If \code{NULL} is specified, % \code{1:length(cl)} is used as seed vector. The default is \code{NULL}.} \item{init.rand}{logical. If \code{init.rand=TRUE}, random number generators are initialized. Use \code{iseed} argument to achieve reproducible results. \strong{This argument is duplicated and will be unavailable in the future.}} % \item{seed}{integer vector of random seeds. It should have the same % length as \code{cl}. \strong{This argument is duplicated and will be unavailable in the future. Consider using \code{iseed} instead.} } \item{iseed}{An integer. If non-\code{NULL} value is supplied random number generators are initialized. It is passed to \code{set.seed} or \code{clusterSetRNGStream}.} \item{quiet}{logical. If \code{TRUE} it does not report the progress.} } \details{ Function \code{pvclust} conducts multiscale bootstrap resampling to calculate \eqn{p}-values for each cluster in the result of hierarchical clustering. \code{parPvclust} is the parallel version of this procedure which depends on package \pkg{parallel} for parallel computation. For data expressed as \eqn{(n \times p)}{(n, p)} matrix or data frame, we assume that the data is \eqn{n} observations of \eqn{p} objects, which are to be clustered. The \eqn{i}'th row vector corresponds to the \eqn{i}'th observation of these objects and the \eqn{j}'th column vector corresponds to a sample of \eqn{j}'th object with size \eqn{n}. There are several methods to measure the dissimilarities between objects. For data matrix \eqn{X=\{x_{ij}\}}{X}, \code{"correlation"} method takes \deqn{ 1 - \frac{ \sum_{i=1}^n (x_{ij} - \bar{x}_j) (x_{ik} - \bar{x}_k) } { \sqrt{\sum_{i=1}^n (x_{ij} - \bar{x}_j)^2} \sqrt{\sum_{i=1}^n (x_{ik} - \bar{x}_k)^2} } }{% 1 - cor(X)[j,k] } for dissimilarity between \eqn{j}'th and \eqn{k}'th object, where \eqn{\bar{x}_j = \frac{1}{n} \sum_{i=1}^n x_{ij} \mbox{and} \bar{x}_k = \frac{1}{n} \sum_{i=1}^n x_{ik}}{cor is function \code{cor}}. \code{"uncentered"} takes uncentered sample correlation \deqn{ 1 - \frac{ \sum_{i=1}^n x_{ij} x_{ik} } { \sqrt{\sum_{i=1}^n x_{ij}^2} \sqrt{\sum_{i=1}^n x_{ik}^2} } }{% 1 - sum(x[,j] * x[,k]) / (sqrt(sum(x[,j]^2)) * sqrt(sum(x[,k]^2))) } and \code{"abscor"} takes the absolute value of sample correlation \deqn{ 1 - \ \Biggl| \frac{ \sum_{i=1}^n (x_{ij} - \bar{x}_j) (x_{ik} - \bar{x}_k) } { \sqrt{\sum_{i=1}^n (x_{ij} - \bar{x}_j)^2} \sqrt{\sum_{i=1}^n (x_{ik} - \bar{x}_k)^2} } \Biggl|. }{% 1 - abs(cor(X)[j,k]). } } \value{ \item{hclust}{hierarchical clustering for original data generated by function \code{hclust}. See \code{\link[stats]{hclust}} for details.} \item{edges}{data frame object which contains \eqn{p}-values and supporting informations such as standard errors.} \item{count}{data frame object which contains primitive information about the result of multiscale bootstrap resampling.} \item{msfit}{list whose elements are results of curve fitting for multiscale bootstrap resampling, of class \code{msfit}. See \code{\link{msfit}} for details.} \item{nboot}{numeric vector of number of bootstrap replications.} \item{r}{numeric vector of the relative sample size for bootstrap replications.} \item{store}{list contains bootstrap replications if \code{store=TRUE} was given for function \code{pvclust} or \code{parPvclust}.} \item{version}{\code{\link[base]{package_version}} of pvclust used to generate this object.} } \seealso{\code{\link{lines.pvclust}}, \code{\link{print.pvclust}}, \code{\link{msfit}}, \code{\link{plot.pvclust}}, \code{\link{text.pvclust}}, \code{\link{pvrect}} and \code{\link{pvpick}}.} \references{ Suzuki, R. and Shimodaira, H. (2006) "Pvclust: an R package for assessing the uncertainty in hierarchical clustering", \emph{Bioinformatics}, 22 (12): 1540-1542. Shimodaira, H. (2004) "Approximately unbiased tests of regions using multistep-multiscale bootstrap resampling", \emph{Annals of Statistics}, 32, 2616-2641. Shimodaira, H. (2002) "An approximately unbiased test of phylogenetic tree selection", \emph{Systematic Biology}, 51, 492-508. Suzuki, R. and Shimodaira, H. (2004) "An application of multiscale bootstrap resampling to hierarchical clustering of microarray data: How accurate are these clusters?", \emph{The Fifteenth International Conference on Genome Informatics 2004}, P034. \url{http://www.sigmath.es.osaka-u.ac.jp/shimo-lab/prog/pvclust/} } \examples{ ### example using Boston data in package MASS data(Boston, package = "MASS") ## multiscale bootstrap resampling (non-parallel) boston.pv <- pvclust(Boston, nboot=100, parallel=FALSE) ## CAUTION: nboot=100 may be too small for actual use. ## We suggest nboot=1000 or larger. ## plot/print functions will be useful for diagnostics. ## plot dendrogram with p-values plot(boston.pv) ask.bak <- par()$ask par(ask=TRUE) ## highlight clusters with high au p-values pvrect(boston.pv) ## print the result of multiscale bootstrap resampling print(boston.pv, digits=3) ## plot diagnostic for curve fitting msplot(boston.pv, edges=c(2,4,6,7)) par(ask=ask.bak) ## print clusters with high p-values boston.pp <- pvpick(boston.pv) boston.pp ### Using a custom distance measure ## Define a distance function which returns an object of class "dist". ## The function must have only one argument "x" (data matrix or data.frame). cosine <- function(x) { x <- as.matrix(x) y <- t(x) \%*\% x res <- 1 - y / (sqrt(diag(y)) \%*\% t(sqrt(diag(y)))) res <- as.dist(res) attr(res, "method") <- "cosine" return(res) } result <- pvclust(Boston, method.dist=cosine, nboot=100) plot(result) \dontrun{ ### parallel computation result.par <- pvclust(Boston, nboot=1000, parallel=TRUE) plot(result.par) } } \author{Ryota Suzuki \email{suzuki@ef-prime.com}} \keyword{cluster} pvclust/man/print.pvclust.Rd0000644000176200001440000000305413453562724015664 0ustar liggesusers\name{print.pvclust} \alias{print.pvclust} \title{Print Function for Pvclust Object} \description{print clustering method and distance measure used in hierarchical clustering, \eqn{p}-values and related statistics for a \code{pvclust} object. } \usage{ \method{print}{pvclust}(x, which=NULL, digits=3, ...) } \arguments{ \item{x}{object of class \code{pvclust}.} \item{which}{numeric vector which specifies the numbers of edges (clusters) of which the values are printed. If \code{NULL} is given, it prints the values of all edges. The default is \code{NULL}.} \item{digits}{integer indicating the precision to be used in rounding.} \item{...}{other parameters used in the function.} } \value{this function prints \eqn{p}-values and some related statistics. \item{au}{AU (Approximately Unbiased) \eqn{p}-value, which is more accurate than BP value as unbiased \eqn{p}-value. It is computed by multiscale bootstrap resampling.} \item{bp}{BP (Bootstrap Probability) value, which is a simple statistic computed by bootstrap resampling. This value tends to be biased as \eqn{p}-value when the absolute value of \code{c} (explained below) is large.} \item{se.au, se.bp}{estimated standard errors for \code{au} and \code{bp}, respectively.} \item{v, c}{values related to geometric aspects of hypotheses. \code{v} is signed distance and \code{c} is curvature of the boundary.} \item{pchi}{\eqn{p}-values of chi-square test based on asymptotic theory.} } \author{Ryota Suzuki \email{suzuki@ef-prime.com}} \keyword{print}pvclust/man/msfit.Rd0000644000176200001440000000557013453562724014160 0ustar liggesusers\name{msfit} \alias{msfit} \alias{plot.msfit} \alias{lines.msfit} \alias{summary.msfit} \title{Curve Fitting for Multiscale Bootstrap Resampling} \description{\code{msfit} performs curve fitting for multiscale bootstrap resampling. It generates an object of class \code{msfit}. Several generic methods are available. } \usage{ msfit(bp, r, nboot) \method{plot}{msfit}(x, curve=TRUE, main=NULL, sub=NULL, xlab=NULL, ylab=NULL, ...) \method{lines}{msfit}(x, col=2, lty=1, ...) \method{summary}{msfit}(object, digits=3, ...) } \arguments{ \item{bp}{numeric vector of bootstrap probability values.} \item{r}{numeric vector of relative sample size of bootstrap samples defined as \eqn{r=n'/n} for original sample size \eqn{n} and bootstrap sample size \eqn{n'}.} \item{nboot}{numeric value (vector) of the number of bootstrap replications.} \item{x}{object of class \code{msfit}.} \item{curve}{logical. If \code{TRUE}, the fitted curve is drawn.} \item{main, sub, xlab, ylab, col, lty}{generic graphic parameters.} \item{object}{object of class \code{msfit}.} \item{digits}{integer indicating the precision to be used in rounding.} \item{...}{other parameters to be used in the functions.} } \details{ function \code{msfit} performs the curve fitting for multiscale bootstrap resampling. In package \code{pvclust} this function is only called from the function \code{pvclust} (or \code{parPvclust}), and may never be called from users. However one can access a list of \code{msfit} objects by \code{x$msfit}, where \code{x} is an object of class \code{pvclust}. } \value{\code{msfit} returns an object of class \code{msfit}. It contains the following objects: \item{p}{numeric vector of \eqn{p}-values. \code{au} is AU (Approximately Unbiased) \eqn{p}-value computed by multiscale bootstrap resampling, which is more accurate than BP value (explained below) as unbiased \eqn{p}-value. \code{bp} is BP (Bootstrap Probability) value, which is simple but tends to be unbiased when the absolute value of \code{c} (a value in \code{coef} vector, explained below) is large.} \item{se}{numeric vector of estimated standard errors of \eqn{p}-values.} \item{coef}{numeric vector related to geometric aspects of hypotheses. \code{v} is signed distance and \code{c} is curvature of the boundary.} \item{df}{numeric value of the degree of freedom in curve fitting.} \item{rss}{residual sum of squares.} \item{pchi}{\eqn{p}-value of chi-square test based on asymptotic theory.} } \references{ Shimodaira, H. (2004) "Approximately unbiased tests of regions using multistep-multiscale bootstrap resampling", \emph{Annals of Statistics}, 32, 2616-2641. Shimodaira, H. (2002) "An approximately unbiased test of phylogenetic tree selection", \emph{Systematic Biology}, 51, 492-508. } \author{Ryota Suzuki \email{suzuki@ef-prime.com}} \keyword{htest}pvclust/man/lung.Rd0000644000176200001440000000301013453562724013766 0ustar liggesusers\name{lung} \docType{data} \alias{lung} \title{DNA Microarray Data of Lung Tumors} \description{ DNA Microarray data of 73 lung tissues including 67 lung tumors. There are 916 observations of genes for each lung tissue. } \usage{data(lung)} \format{data frame of size \eqn{916 \times 73}{(916, 73)}.} \details{ This dataset has been modified from original data. Each one observation of duplicate genes has been removed. See \code{source} section in this help for original data source. } \examples{ \donttest{ ## Reading the data data(lung) ## Multiscale Bootstrap Resampling lung.pv <- pvclust(lung, nboot=100) ## CAUTION: nboot=100 may be too small for actual use. ## We suggest nboot=1000 or larger. ## plot/print functions will be useful for diagnostics. ## Plot the result plot(lung.pv, cex=0.8, cex.pv=0.7) ask.bak <- par()$ask par(ask=TRUE) pvrect(lung.pv, alpha=0.9) msplot(lung.pv, edges=c(51,62,68,71)) par(ask=ask.bak) ## Print a cluster with high p-value lung.pp <- pvpick(lung.pv, alpha=0.9) lung.pp$clusters[[2]] ## Print its edge number lung.pp$edges[2] } ## We recommend parallel computing for large dataset as this one \dontrun{ library(snow) cl <- makeCluster(10, type="MPI") lung.pv <- parPvclust(cl, lung, nboot=1000) } } \source{\url{http://genome-www.stanford.edu/lung_cancer/adeno/}} \references{ Garber, M. E. et al. (2001) "Diversity of gene expression in adenocarcinoma of the lung", \emph{Proceedings of the National Academy of Sciences}, 98, 13784-13789. } \keyword{datasets} pvclust/DESCRIPTION0000644000176200001440000000161213564755632013500 0ustar liggesusersPackage: pvclust Version: 2.2-0 Date: 2019-11-19 Title: Hierarchical Clustering with P-Values via Multiscale Bootstrap Resampling Author: Ryota Suzuki , Yoshikazu Terada , Hidetoshi Shimodaira Maintainer: Ryota Suzuki Depends: R (>= 2.10.0) Suggests: MASS, parallel Description: An implementation of multiscale bootstrap resampling for assessing the uncertainty in hierarchical cluster analysis. It provides SI (selective inference) p-value, AU (approximately unbiased) p-value and BP (bootstrap probability) value for each cluster in a dendrogram. License: GPL (>= 2) URL: http://stat.sys.i.kyoto-u.ac.jp/prog/pvclust/ NeedsCompilation: no Packaged: 2019-11-19 10:31:59 UTC; suzuki Repository: CRAN Date/Publication: 2019-11-19 12:10:02 UTC pvclust/R/0000755000176200001440000000000013564706031012160 5ustar liggesuserspvclust/R/pvclust-internal.R0000644000176200001440000003173413564727633015640 0ustar liggesusers### internal function for non-parallel pvclust pvclust.common.settings <- function(data, method.dist, use.cor, method.hclust, r) { # data: (n,p) matrix, n-samples, p-variables n <- nrow(data); p <- ncol(data) # hclust for original data if(is.function(method.dist)) { # Use custom distance function distance <- method.dist(data) } else { distance <- dist.pvclust(data, method=method.dist, use.cor=use.cor) } data.hclust <- hclust(distance, method=method.hclust) # ward -> ward.D # only if R >= 3.1.0 if(method.hclust == "ward" && getRversion() >= '3.1.0') { method.hclust <- "ward.D" } # multiscale bootstrap size <- unique(floor(n*r)) rl <- length(size) if(rl == 1) { if(r != 1.0) warning("Relative sample size r is set to 1.0. AU p-values are not calculated\n") r <- list(1.0) } else r <- as.list(size/n) return(list(data.hclust=data.hclust, method.hclust=method.hclust, rl=rl, r=r)) } pvclust.nonparallel <- function(data, method.hclust, method.dist, use.cor, nboot, r, store, weight, iseed, quiet) { # initialize random seed if(!is.null(iseed)) set.seed(seed = iseed) # set setting parameters pars <- pvclust.common.settings(data=data, method.dist=method.dist, use.cor=use.cor, method.hclust=method.hclust, r=r) mboot <- lapply(pars$r, boot.hclust, data=data, object.hclust=pars$data.hclust, nboot=nboot, method.dist=method.dist, use.cor=use.cor, method.hclust=pars$method.hclust, store=store, weight=weight, quiet=quiet) result <- pvclust.merge(data=data, object.hclust=pars$data.hclust, mboot=mboot) return(result) } ### internal function for parallel pvclust pvclust.parallel <- function(cl, data, method.hclust, method.dist, use.cor, nboot, r, store, weight, init.rand=NULL, iseed, quiet, parallel.check) { if(parallel.check) { check.result <- check.parallel(cl=cl, nboot=nboot) if(!check.result) { msg <- paste(attr(check.result, "msg"), ". non-parallel version is executed", sep = "") warning(msg) return(pvclust.nonparallel(data=data, method.hclust=method.hclust, method.dist=method.dist, use.cor=use.cor, nboot=nboot, r=r, store=store, weight=weight, iseed=iseed, quiet=quiet)) } } # check package versions pkg.ver <-parallel::clusterCall(cl, packageVersion, pkg = "pvclust") r.ver <- parallel::clusterCall(cl, getRversion) if(length(unique(pkg.ver)) > 1 || length(unique(r.ver)) > 1) { node.name <- parallel::clusterEvalQ(cl, Sys.info()["nodename"]) version.table <- data.frame( node=seq_len(length(node.name)), name=unlist(node.name), R=unlist(lapply(r.ver, as.character)), pvclust=unlist(lapply(pkg.ver, as.character))) if(nrow(version.table) > 10) table.out <- c(capture.output(print(head(version.table, n=10), row.names=FALSE)), " ...") else table.out <- capture.output(print(version.table, row.names=FALSE)) warning("R/pvclust versions are not unique:\n", paste(table.out, collapse="\n")) } if(!is.null(init.rand)) warning("\"init.rand\" option is deprecated. It is available for back compatibility but will be unavailable in the future.\nSpecify a non-NULL value of \"iseed\" to initialize random seed.") # if(init.rand) { # if(is.null(iseed) && !is.null(seed)) { # warning("\"seed\" option is deprecated. It is available for back compatibility but will be unavailable in the future.\nConsider using \"iseed\" instead.") # # if(length(seed) != length(cl)) # stop("seed and cl should have the same length.") # # # setting random seeds # parallel::parLapply(cl, as.list(seed), set.seed) # } else { # parallel::clusterSetRNGStream(cl = cl, iseed = iseed) # } # } if(!is.null(iseed) && (is.null(init.rand) || init.rand)) parallel::clusterSetRNGStream(cl = cl, iseed = iseed) # set setting parameters pars <- pvclust.common.settings(data=data, method.dist=method.dist, use.cor=use.cor, method.hclust=method.hclust, r=r) ncl <- length(cl) nbl <- as.list(rep(nboot %/% ncl, times=ncl)) if((rem <- nboot %% ncl) > 0) nbl[1:rem] <- lapply(nbl[1:rem], "+", 1) if(!quiet) cat("Multiscale bootstrap... ") mlist <- parallel::parLapply(cl, nbl, pvclust.node, r=pars$r, data=data, object.hclust=pars$data.hclust, method.dist=method.dist, use.cor=use.cor, method.hclust=pars$method.hclust, store=store, weight=weight, quiet=quiet) if(!quiet) cat("Done.\n") mboot <- mlist[[1]] for(i in 2:ncl) { for(j in 1:pars$rl) { mboot[[j]]$edges.cnt <- mboot[[j]]$edges.cnt + mlist[[i]][[j]]$edges.cnt mboot[[j]]$nboot <- mboot[[j]]$nboot + mlist[[i]][[j]]$nboot mboot[[j]]$store <- c(mboot[[j]]$store, mlist[[i]][[j]]$store) } } result <- pvclust.merge(data=data, object.hclust=pars$data.hclust, mboot=mboot) return(result) } hc2axes <- function(x) { A <- x$merge # (n,n-1) matrix n <- nrow(A) + 1 x.axis <- c() y.axis <- x$height x.tmp <- rep(0,2) zz <- match(1:length(x$order),x$order) for(i in 1:(n-1)) { ai <- A[i,1] if(ai < 0) x.tmp[1] <- zz[-ai] else x.tmp[1] <- x.axis[ai] ai <- A[i,2] if(ai < 0) x.tmp[2] <- zz[-ai] else x.tmp[2] <- x.axis[ai] x.axis[i] <- mean(x.tmp) } return(data.frame(x.axis=x.axis,y.axis=y.axis)) } hc2split <- function(x) { A <- x$merge # (n-1,n) matrix n <- nrow(A) + 1 B <- list() for(i in 1:(n-1)){ ai <- A[i,1] if(ai < 0) B[[i]] <- -ai else B[[i]] <- B[[ai]] ai <- A[i,2] if(ai < 0) B[[i]] <- sort(c(B[[i]],-ai)) else B[[i]] <- sort(c(B[[i]],B[[ai]])) } CC <- matrix(rep(0,n*(n-1)),nrow=(n-1),ncol=n) for(i in 1:(n-1)){ bi <- B[[i]] m <- length(bi) for(j in 1:m) CC[i,bi[j]] <- 1 } split <- list(pattern=apply(CC,1,paste,collapse=""), member=B) return(split) } pvclust.node <- function(x, r, ...) { # require(pvclust) mboot.node <- lapply(r, boot.hclust, nboot=x, ...) return(mboot.node) } boot.hclust <- function(r, data, object.hclust, method.dist, use.cor, method.hclust, nboot, store, weight=FALSE, quiet=FALSE) { n <- nrow(data) size <- round(n*r, digits=0) if(size == 0) stop("invalid scale parameter(r)") r <- size/n pattern <- hc2split(object.hclust)$pattern edges.cnt <- table(factor(pattern)) - table(factor(pattern)) st <- list() # bootstrap start rp <- as.character(round(r,digits=2)); if(r == 1) rp <- paste(rp,".0",sep="") if(!quiet) cat(paste("Bootstrap (r = ", rp, ")... ", sep="")) w0 <- rep(1,n) # equal weight na.flag <- 0 for(i in 1:nboot){ if(weight && r>10) { ## <- this part should be improved w1 <- as.vector(rmultinom(1,size,w0)) # resampled weight suppressWarnings(distance <- distw.pvclust(data,w1,method=method.dist,use.cor=use.cor)) } else { smpl <- sample(1:n, size, replace=TRUE) if(is.function(method.dist)) { suppressWarnings(distance <- method.dist(data[smpl,])) } else { suppressWarnings(distance <- dist.pvclust(data[smpl,],method=method.dist,use.cor=use.cor)) } } if(all(is.finite(distance))) { # check if distance is valid x.hclust <- hclust(distance,method=method.hclust) pattern.i <- hc2split(x.hclust)$pattern # split edges.cnt <- edges.cnt + table(factor(pattern.i, levels=pattern)) } else { x.hclust <- NULL na.flag <- 1 } if(store) st[[i]] <- x.hclust } if(!quiet) cat("Done.\n") # bootstrap done if(na.flag == 1) warning(paste("inappropriate distance matrices are omitted in computation: r = ", r), call.=FALSE) boot <- list(edges.cnt=edges.cnt, method.dist=method.dist, use.cor=use.cor, method.hclust=method.hclust, nboot=nboot, size=size, r=r, store=st) class(boot) <- "boot.hclust" return(boot) } pvclust.merge <- function(data, object.hclust, mboot){ pattern <- hc2split(object.hclust)$pattern r <- unlist(lapply(mboot,"[[","r")) nboot <- unlist(lapply(mboot,"[[","nboot")) store <- lapply(mboot,"[[", "store") rl <- length(mboot) ne <- length(pattern) edges.bp <- edges.cnt <- data.frame(matrix(rep(0,ne*rl),nrow=ne,ncol=rl)) row.names(edges.bp) <- pattern names(edges.cnt) <- paste("r", 1:rl, sep="") for(j in 1:rl) { edges.cnt[,j] <- as.vector(mboot[[j]]$edges.cnt) edges.bp[,j] <- edges.cnt[,j] / nboot[j] } ms.fitted <- lapply(as.list(1:ne), function(x, edges.bp, r, nboot){ msfit(as.vector(t(edges.bp[x,])), r, nboot)}, edges.bp, r, nboot) class(ms.fitted) <- "mslist" p <- lapply(ms.fitted,"[[","p") se <- lapply(ms.fitted,"[[","se") coef <- lapply(ms.fitted,"[[","coef") si <- unlist(lapply(p,"[[","si")) au <- unlist(lapply(p,"[[","au")) bp <- unlist(lapply(p,"[[","bp")) se.si <- unlist(lapply(se,"[[","si")) se.au <- unlist(lapply(se,"[[","au")) se.bp <- unlist(lapply(se,"[[","bp")) v <- unlist(lapply(coef,"[[","v")) cc <- unlist(lapply(coef,"[[","c")) pchi <- unlist(lapply(ms.fitted,"[[","pchi")) edges.pv <- data.frame(si=si, au=au, bp=bp, se.si=se.si, se.au=se.au, se.bp=se.bp, v=v, c=cc, pchi=pchi) row.names(edges.pv) <- row.names(edges.cnt) <- 1:ne version <- packageVersion("pvclust") result <- list(hclust=object.hclust, edges=edges.pv, count=edges.cnt, msfit=ms.fitted, nboot=nboot, r=r, store=store, version=version) class(result) <- "pvclust" return(result) } dist.pvclust <- function(x, method="euclidean", use.cor="pairwise.complete.obs") { if(!is.na(pmatch(method,"correlation"))){ res <- as.dist(1 - cor(x, method="pearson", use=use.cor)) attr(res,"method") <- "correlation" return(res) } else if(!is.na(pmatch(method,"abscor"))){ res <- as.dist(1 - abs(cor(x,method="pearson",use=use.cor))) attr(res,"method") <- "abscor" return(res) } else if(!is.na(pmatch(method,"uncentered"))){ if(sum(is.na(x)) > 0){ x <- na.omit(x) warning("Rows including NAs were omitted") } x <- as.matrix(x) P <- crossprod(x) qq <- matrix(diag(P),ncol=ncol(P)) Q <- sqrt(crossprod(qq)) res <- as.dist(1 - P/Q) attr(res,"method") <- "uncentered" return(res) } else dist(t(x),method) } corw <- function(x,w, use=c("all.obs","complete.obs","pairwise.complete.obs") ) { if(is.data.frame(x)) x <- as.matrix(x) x <- x[w>0,,drop=F] w <- w[w>0] n <- nrow(x) # sample size m <- ncol(x) # number of variables if(missing(w)) w <- rep(1,n) r <- matrix(0,m,m,dimnames=list(colnames(x),colnames(x))) diag(r) <- 1 use <- match.arg(use) pairu <- F if(use=="all.obs") { u <- rep(T,n) } else if(use=="complete.obs") { u <- apply(x,1,function(y) !any(is.na(y))) } else if(use=="pairwise.complete.obs") { pairu <- T ux <- is.finite(x) } else stop("unknown use") for(i in 1+seq(length=m-1)) { for(j in seq(length=i-1)) { if(pairu) u <- ux[,i] & ux[,j] wu <- w[u]; xi <- x[u,i]; xj <- x[u,j] ws <- sum(wu) if(ws > 1e-8) { xi <- xi - sum(wu*xi)/ws xj <- xj - sum(wu*xj)/ws vxi <- sum(wu*xi*xi)/ws vxj <- sum(wu*xj*xj)/ws if(min(vxi,vxj) > 1e-8) { vxij <- sum(wu*xi*xj)/ws rij <- vxij/sqrt(vxi*vxj) } else { rij <- 0 } } else { rij <- 0 } r[i,j] <- r[j,i] <- rij } } r } ### calculate distance by weight distw.pvclust <- function(x,w,method="correlation", use.cor="pairwise.complete.obs") { if(!is.na(pmatch(method,"correlation"))){ res <- as.dist(1 - corw(x,w, use=use.cor)) attr(res,"method") <- "correlation" return(res) } else if(!is.na(pmatch(method,"abscor"))){ res <- as.dist(1 - abs(corw(x,w, use=use.cor))) attr(res,"method") <- "abscor" return(res) } stop("wrong method") } ### check whether parallel computation is appropriate check.parallel <- function(cl, nboot) { res <- FALSE ### will be used when defaultCluster(cl) becomes publicly available # # check whether cl is a cluster, or a default cluster is available # if(!inherits(cl, "cluster")) { # try_result <- try(cl <- parallel:::defaultCluster(cl), silent=TRUE) # if(class(try_result) == "try-error") { # attr(res, "msg" <- "cl is not a cluster") # return(res) # } # } ncl <- length(cl) if(ncl < 2) { attr(res, "msg") <- "Cluster size is too small (or NULL)" } else if (ncl > nboot) { attr(res, "msg") <- "nboot is too small for cluster size" } else { res <- TRUE } return(res) }pvclust/R/pvclust.R0000644000176200001440000003345713564722517014026 0ustar liggesuserspvclust <- function(data, method.hclust="average", method.dist="correlation", use.cor="pairwise.complete.obs", nboot=1000, parallel=FALSE, r=seq(.5,1.4,by=.1), store=FALSE, weight=FALSE, iseed=NULL, quiet=FALSE) { p <- parallel if(is.null(p) || (!is.logical(p) && (!is.integer(p) || p <= 0) && !inherits(p, "cluster"))) stop("parallel should be a logical, an integer or a cluster object.") if(is.logical(p)) { par.flag <- p par.size <- NULL cl <- NULL } else if(is.integer(p)) { par.flag <- TRUE par.size <- p cl <- NULL } else if(inherits(p, "cluster")) { par.flag <- TRUE cl <- p } if(par.flag && !requireNamespace("parallel", quietly=TRUE)) { warning("Package parallel is required for parallel computation. Use non-parallel mode instead.") par.flag <- FALSE } if(par.flag) { if(is.null(cl)) { if(is.null(par.size)) par.size <- parallel::detectCores() - 1 if(!quiet) cat("Creating a temporary cluster...") try_result <- try(cl <- parallel::makePSOCKcluster(par.size)) if(inherits(try_result, "try-error")) { if(!quiet) cat("failed to create a cluster. Use non-parallel mode instead.") par.flag <- FALSE } else { if(!quiet) { cat("done:\n") print(cl) } on.exit(parallel::stopCluster(cl)) } } pvclust.parallel(cl=cl, data=data, method.hclust=method.hclust, method.dist=method.dist, use.cor=use.cor, nboot=nboot, r=r, store=store, weight=weight, iseed=iseed, quiet=quiet, parallel.check=TRUE) } else { pvclust.nonparallel(data=data, method.hclust=method.hclust, method.dist=method.dist, use.cor=use.cor, nboot=nboot, r=r, store=store, weight=weight, iseed=iseed, quiet=quiet) } } parPvclust <- function(cl=NULL, data, method.hclust="average", method.dist="correlation", use.cor="pairwise.complete.obs", nboot=1000, r=seq(.5,1.4,by=.1), store=FALSE, weight=FALSE, init.rand=NULL, iseed=NULL, quiet=FALSE) { warning("\"parPvclust\" has been integrated into pvclust (with \"parallel\" option).\nIt is available for back compatibility but will be unavailable in the future.") if(!requireNamespace("parallel", quietly=TRUE)) stop("Package parallel is required for parPvclust.") pvclust.parallel(cl=cl, data=data, method.hclust=method.hclust, method.dist=method.dist, use.cor=use.cor, nboot=nboot, r=r, store=store, weight=weight, init.rand=init.rand, iseed=iseed, quiet=quiet, parallel.check=TRUE) } plot.pvclust <- function(x, print.pv=TRUE, print.num=TRUE, float=0.01, col.pv=c(si=4, au=2, bp=3, edge=8), cex.pv=0.8, font.pv=NULL, col=NULL, cex=NULL, font=NULL, lty=NULL, lwd=NULL, main=NULL, sub=NULL, xlab=NULL, ...) { if(is.null(main)) main="Cluster dendrogram with p-values (%)" if(is.null(sub)) sub=paste("Cluster method: ", x$hclust$method, sep="") if(is.null(xlab)) xlab=paste("Distance: ", x$hclust$dist.method) plot(x$hclust, main=main, sub=sub, xlab=xlab, col=col, cex=cex, font=font, lty=lty, lwd=lwd, ...) if(!isFALSE(print.pv)) { # back-compatibility for pvclust <= 2.0-0 if(isTRUE(print.pv) && length(col) == 3 && is.null(names(col))) { names(col) <- c("au", "bp", "edge") } # Set default p-values to plot if(isTRUE(print.pv)) { print.pv <- c("au", "bp") } col.text <- col.pv[print.pv] if(print.num && "edge" %in% names(col.pv)) { col.text <- c(col.text, col.pv["edge"]) } text(x, col=col.text, cex=cex.pv, font=font.pv, float=float, print.num=print.num) } } text.pvclust <- function(x, col=c(au=2, bp=3, edge=8), print.num=TRUE, float=0.01, cex=NULL, font=NULL, ...) { # back-compatibility for pvclust <= 2.0-0 if(length(col) == 3 && is.null(names(col))) names(col) <- c("au", "bp", "edge") axes <- hc2axes(x$hclust) usr <- par()$usr; wid <- usr[4] - usr[3] # list with character vecotr of p-values num_str <- lapply( x$edges[seq_len(which(names(x$edges) == "bp"))], function(p) round(p * 100)) # change the last elemnt to the name of p-value for(i in names(num_str)) { num_str[[i]][length(num_str[[i]])] <- i } # add edge numbers if(print.num) { num_str$edge <- as.character(row.names(x$edges)) num_str$edge[length(num_str$edge)] <- "edge #" } else { col <- col[names(col) != "edge"] } if(length(col) <= 1) { range <- 1 pos <- 1 y_offset <- 0 } else if(length(col) <= 3) { range <- seq_len(min(3, length(col))) pos <- c(2, 4, 1) y_offset <- float * wid * c(1, 1, 0) } else { range <- 1:4 pos <- c(2, 4, 2, 4) y_offset <- c(float, float, 0.01, 0.01) * wid * c(1, 1, -2, -2) } for(i in range) { name <- names(col)[i] text(x=axes[,1], y=axes[,2] + y_offset[i], num_str[[name]], col=col[name], pos=pos[i], offset=.3, cex=cex, font=font) } } print.pvclust <- function(x, which=NULL, digits=3, ...) { if(is.null(which)) which <- 1:nrow(x$edges) cat("\n") cat(paste("Cluster method: ", x$hclust$method, "\n", sep="")) cat(paste("Distance : ", x$hclust$dist.method, "\n\n", sep="")) cat("Estimates on edges:\n\n") print(round(x$edges[which,], digits=digits)) cat("\n") } summary.pvclust <- function(object, ...){ class(object) <- "list" summary(object, ...) } pvrect <- function(x, alpha=0.95, pv="au", type="geq", max.only=TRUE, border=NULL, ...) { len <- nrow(x$edges) member <- hc2split(x$hclust)$member order <- x$hclust$order usr <- par("usr") xwd <- usr[2] - usr[1] ywd <- usr[4] - usr[3] cin <- par()$cin if(is.null(border)) { border <- c(si=4, au=2, bp=3)[pv] } ht <- c() j <- 1 if(is.na(pm <- pmatch(type, c("geq", "leq", "gt", "lt")))) stop("Invalid type argument: see help(pvrect)") for(i in (len - 1):1) { if (pm==1) wh <- (x$edges[i,pv] >= alpha) # Greater than or EQuals else if(pm==2) wh <- (x$edges[i,pv] <= alpha) # Lower than or EQuals else if(pm==3) wh <- (x$edges[i,pv] > alpha) # Greater Than else if(pm==4) wh <- (x$edges[i,pv] > alpha) # Lower Than if(wh) { mi <- member[[i]] ma <- match(mi, order) if(max.only == FALSE || (max.only && sum(match(ma, ht, nomatch=0)) == 0)) { xl <- min(ma) xr <- max(ma) yt <- x$hclust$height[i] yb <- usr[3] mx <- xwd / length(member) / 3 my <- ywd / 200 rect(xl - mx, yb + my, xr + mx, yt + my, border=border, shade=NULL, ...) j <- j + 1 } ht <- c(ht, ma) } } } msplot <- function(x, edges=NULL, ...) { if(is.null(edges)) edges <- 1:length(x$msfit) d <- length(edges) mfrow.bak <- par()$mfrow on.exit(par(mfrow=mfrow.bak)) par(mfrow=n2mfrow(d)) for(i in edges) { if(i == 1 || (i %% 10 == 1 && i > 20)) main <- paste(i, "st edge", sep="") else if(i == 2 || (i %% 10 == 2 && i > 20)) main <- paste(i, "nd edge", sep="") else if(i == 3 || (i %% 10 == 3 && i > 20)) main <- paste(i, "rd edge", sep="") else main <- paste(i, "th edge", sep="") plot(x$msfit[[i]], main=main, ...) } } lines.pvclust <- function(x, alpha=0.95, pv="au", type="geq", col=2, lwd=2, ...) { len <- nrow(x$edges) member <- hc2split(x$hclust)$member order <- x$hclust$order usr <- par("usr") xwd <- usr[2] - usr[1] ywd <- usr[4] - usr[3] cin <- par()$cin ht <- c() j <- 1 if(is.na(pm <- pmatch(type, c("geq", "leq", "gt", "lt")))) stop("Invalid type argument: see help(lines.pvclust)") for(i in (len - 1):1) { if (pm==1) wh <- (x$edges[i,pv] >= alpha) # Greater than or EQuals else if(pm==2) wh <- (x$edges[i,pv] <= alpha) # Lower than or EQuals else if(pm==3) wh <- (x$edges[i,pv] > alpha) # Greater Than else if(pm==4) wh <- (x$edges[i,pv] > alpha) # Lower Than if(wh) { mi <- member[[i]] ma <- match(mi, order) if(sum(match(ma, ht, nomatch=0)) == 0) { xl <- min(ma) xr <- max(ma) yt <- x$hclust$height[i] yb <- usr[3] mx <- xwd/length(member)/10 segments(xl-mx, yb, xr+mx, yb, xpd=TRUE, col=col, lwd=lwd, ...) j <- j + 1 } ht <- c(ht, ma) } } } pvpick <- function(x, alpha=0.95, pv="au", type="geq", max.only=TRUE) { len <- nrow(x$edges) member <- hc2split(x$hclust)$member order <- x$hclust$order ht <- c() a <- list(clusters=list(), edges=c()); j <- 1 if(is.na(pm <- pmatch(type, c("geq", "leq", "gt", "lt")))) stop("Invalid type argument: see help(pickup)") for(i in (len - 1):1) { if (pm==1) wh <- (x$edges[i,pv] >= alpha) # Greater than or Equals else if(pm==2) wh <- (x$edges[i,pv] <= alpha) # Lower than or Equals else if(pm==3) wh <- (x$edges[i,pv] > alpha) # Greater Than else if(pm==4) wh <- (x$edges[i,pv] < alpha) # Lower Than if(wh) { mi <- member[[i]] ma <- match(mi, order) if(max.only == FALSE || (max.only && sum(match(ma, ht, nomatch=0)) == 0)) { a$clusters[[j]] <- x$hclust$labels[mi] a$edges <- c(a$edges,i) j <- j + 1 } ht <- c(ht, ma) } } a$edges <- a$edges[length(a$edges):1] a$clusters <- a$clusters[length(a$edges):1] return(a) } msfit <- function(bp, r, nboot) { if(length(bp) != length(r)) stop("bp and r should have the same length") nboot <- rep(nboot, length=length(bp)) min.use <- 3 # >= 2 eps <- 0.001 # > 0 use <- bp > eps & bp < 1-eps p <- se <- c(0,0,0); names(p) <- names(se) <- c("si", "au", "bp") coef <- c(0,0); names(coef) <- c("v", "c") a <- list(p=p, se=se, coef=coef, df=0, rss=0, pchi=0); class(a) <- "msfit" if(sum(use) < min.use) { if(mean(bp) < .5) a$p[] <- c(0, 0, 0) else a$p[] <- c(1, 1, 1) return(a) } bp <- bp[use]; r <- r[use]; nboot <- nboot[use] zz <- -qnorm(bp) vv <- ((1 - bp) * bp) / (dnorm(zz)^2 * nboot) a$use <- use; a$r <- r; a$zz <- zz X <- cbind(sqrt(r), 1/sqrt(r)); dimnames(X) <- list(NULL, c("v","c")) fit <- lsfit(X, zz, 1/vv, intercept=FALSE) a$coef <- coef <- fit$coef h.au <- c(1, -1); h.bp <- c(1, 1) z.au <- drop(h.au %*% coef); z.bp <- drop(h.bp %*% coef) p.au <- pnorm(-z.au); p.bp <- pnorm(-z.bp) d0 <- pnorm(-coef[2]) # selection probability p.iau <- pnorm(z.au) # 1-p.au p.si <- 1 - p.iau/d0 if(p.si<0) p.si <- 0 else if(p.si>1) p.si <- 1 a$p["au"] <- p.au; a$p["bp"] <- p.bp; a$p["si"] <- p.si V <- solve(crossprod(X, X/vv)) vz.au <- drop(h.au %*% V %*% h.au); vz.bp <- drop(h.bp %*% V %*% h.bp) if(p.si > 0 && p.si < 1) { d1 <- dnorm(z.au)/d0; d2 <- p.iau*dnorm(coef[2])/d0^2 h.si <- c(d1,-d1+d2) v.si <- drop(h.si %*% V %*% h.si) } else { v.si <- 0 } a$se["au"] <- dnorm(z.au) * sqrt(vz.au); a$se["bp"] <- dnorm(z.bp) * sqrt(vz.bp) a$se["si"] <- sqrt(v.si) a$rss <- sum(fit$residual^2/vv) if((a$df <- sum(use) - 2) > 0) { a$pchi <- pchisq(a$rss, lower.tail=FALSE, df=a$df) } else a$pchi <- 1.0 return(a) } plot.msfit <- function(x, curve=TRUE, main=NULL, sub=NULL, xlab=NULL, ylab=NULL, ...) { if(is.null(main)) main="Curve fitting for multiscale bootstrap resampling" if(is.null(sub)) { sub <- paste("AU = ", round(x$p["au"], digits=2), ", BP = ", round(x$p["bp"], digits=2), ", v = ", round(x$coef["v"], digits=2), ", c = ", round(x$coef["c"], digits=2), ", pchi = ", round(x$pchi, digits=2)) } if(is.null(xlab)) xlab=expression(sqrt(r)) if(is.null(ylab)) ylab=expression(z-value) a <- sqrt(x$r); b <- x$zz if(!is.null(a) && !is.null(b)) { plot(a, b, main=main, sub=sub, xlab=xlab, ylab=ylab, ...) if(curve) lines(x, ...) } else if (!is.null(a)){ plot(0, 0, main=main, sub=sub, xlab=xlab, ylab=ylab, type="n", xaxt="n", yaxt="n", ...) a <- text(mean(a), 0, "No fitting") } } lines.msfit <- function(x, col=2, lty=1, ...) { v <- x$coef["v"]; c <- x$coef["c"] curve(v * x + c / x, add=TRUE, col=col, lty=lty) } summary.msfit <- function(object, digits=3, ...) { cat("\nResult of curve fitting for multiscale bootstrap resampling:\n\n") cat("Estimated p-values:\n") pv <- data.frame(object$p, object$se) names(pv) <- c("Estimate", "Std. Error"); row.names(pv) <- names(object$p) print(pv, digits=digits); cat("\n") cat("Estimated coefficients:\n") coef <- object$coef print(coef, digits=digits); cat("\n") cat(paste("Residual sum of squares: ", round(object$rss,digits=digits)), ", p-value: ", round(object$pchi, digits=digits), " on ", object$df, " DF\n\n", sep="") } seplot <- function(object, type=c("au", "si", "bp"), identify=FALSE, main=NULL, xlab=NULL, ylab=NULL, ...) { cand <- c("si", "au", "bp") cand <- cand[cand %in% names(object$edges)] if(!is.na(pm <- pmatch(type[1], cand))) { wh <- cand[pm] if(is.null(main)) main <- "p-value vs standard error plot" if(is.null(xlab)) xlab <- c("SI p-value", "AU p-value", "BP value")[pm] if(is.null(ylab)) ylab <- "Standard Error" plot(object$edges[,wh], object$edges[,paste("se", wh, sep=".")], main=main, xlab=xlab, ylab=ylab, ...) if(identify) identify(x=object$edges[,wh], y=object$edges[,paste("se", wh, sep=".")], labels=row.names(object$edges)) } else stop("'type' should be \"si\", \"au\" or \"bp\".") } pvclust/MD50000644000176200001440000000117413564755632012305 0ustar liggesusersbaf1889a91fe13fc5b5bb5929fc584ff *DESCRIPTION 1f57e41b26da7e6583622d4d3001b5ff *NAMESPACE 32c8eb59a04f5c2bdf976fb7f5e92065 *R/pvclust-internal.R 2156be4ee3c0762c366355e2e156442a *R/pvclust.R 4ce445fdf8be068ed0f770d3c7bafd17 *data/lung.RData d4137b4bb2fc7b26f40719391597a20a *man/lung.Rd 305eedf26b855648f7456e9da01e5094 *man/msfit.Rd 7fb48846f78962a79e748621b99ba738 *man/msplot.Rd b103b3c9f747876144c2408118c9420c *man/plot.pvclust.Rd 3ccb94ceeb320278445c2be3fd41bcbb *man/print.pvclust.Rd fda3c415ba70a2fc54dc3a6103d9a082 *man/pvclust.Rd e2a6241cfbccd749a0507f60e120ed0d *man/pvpick.Rd d8e7f3098671c6c9a76370e9371ad846 *man/seplot.Rd