waveslim/0000755000176200001440000000000013632657122012110 5ustar liggesuserswaveslim/NAMESPACE0000644000176200001440000000066213430347451013330 0ustar liggesusersuseDynLib("waveslim", .registration = TRUE, .fixes = "C_") exportPattern("^[^C_]") importFrom("grDevices", "rainbow") importFrom("graphics", "axis", "box", "image", "lines", "mtext", "par", "plot") importFrom("stats", "convolve", "fft", "filter", "integrate", "lsfit", "mad", "median", "mvfft", "optim", "optimize", "pchisq", "qchisq", "qnorm", "rnorm", "runif", "spec.taper") S3method(plot, dwt.2d) waveslim/LICENSE0000644000176200001440000000013013430347451013104 0ustar liggesusersYEAR: 1997-2013 COPYRIGHT HOLDER: Brandon Whitcher ORGANIZATION: Rigorous Analytics Ltd.waveslim/README.md0000644000176200001440000000144513621325453013370 0ustar liggesusers# waveslim The R packages **waveslim** contains basic wavelet routines for time series (1D), image (2D) and array (3D) analysis. The code provided here is based on wavelet methodology developed in Percival and Walden (2000); Gencay, Selcuk and Whitcher (2001); the dual-tree complex wavelet transform (CWT) from Kingsbury (1999, 2001) as implemented by Selesnick; and Hilbert wavelet pairs (Selesnick 2001, 2002). Travis-CI build for bjw34032/waveslim [![Travis-CI Build Status](https://travis-ci.org/bjw34032/waveslim.svg?branch=master)](https://travis-ci.org/bjw34032/waveslim) [![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/waveslim/)](https://CRAN.R-project.org/package=waveslim) [![](http://cranlogs.r-pkg.org/badges/grand-total/waveslim)](https://CRAN.R-project.org/package=waveslim) waveslim/data/0000755000176200001440000000000013621325567013024 5ustar liggesuserswaveslim/data/tourism.rda0000644000176200001440000000113013430347452015204 0ustar liggesusersmKSqBADxcFyTt..D+]<%d2Yiv4+b Nqks !uDxMљo<]8]v8,W! & I6? %l"t~ޡ]B7CC&2/΀`.*ֺuGPið5ιJ븾NS+ox6q]}b6 wrNةZ6s{l?w6򼭟g缃 U|wm\Ͼv8?s} y5k[ x=<ԡaE8sC.3^OvQ,>z/0_0peb ca) _O)+E{1NatÅ>w #ߑ p΅`s<0wc}A~%pLFb}9?`=0m#/~P_S!]a}JUeϝ@_'>!+s e]SM2߁ h}tڅJM3?ط$%=y_Ĕwaveslim/data/acvs.andel10.rda0000644000176200001440000014037413430347452015677 0ustar liggesusers7zXZi"6!X@])TW"nRʟx8Og0ܲ%|< }!$իj1|fz[yè3̉X4/Rh45ެ)YHq2ݚ <^䢏7w7a,v=ыs X{#`LJprKFXp]m@L&nN3ZXAiOq$ /?src;Ʉ7GW1wil3b.KiʵpܣzT‡Bor?nA[ҨF_kbvaş-BpGR6Myy;Mm6h:Šb;1އ\DSGL\&vgsڰ`vs{iQV%ޛr9*yٺL>) Iݓa7¦Drꄅіx &6\9ܑ6RC_@K[Mrĝ$֝&l9676%ά/ȌHZW5wvXXui}uJB/y %~3ɱh&% +r{<1&g\t!>V dW)jףZ-3+cɦiȞŮl.o7\*Q,~C5hJ!R)pg*,mu*^_!@?d%HFHE;#ۈf.s,.[6 hd:7j62sE^nx"rz}FxN{d6H mJz5fdFl, ^ X>Og@,0dTKSjNm@UT欇CpRDX+'K3g @٠4au׮@uњ1UOє 1إn^b֥7%1;5^}r e^H v|v8"fj}$PF}i]Yjy‹~>'vqdfݸ_Gą^ŝ^hVF^}1^}@:w+=ޫrbDrHvV J GqIi+9"^ K|%<ś[Wj{55. @# H:^(K]S1J[rmI"فfvIziIyM<)XaN馊e);:(C;M ^6UUKa3&L'5i|*|6ٝq":/tc[)0AUSKݒFrҗ^tGu&$30}a3s&H.|b;vz{ߪ*yEχteeN}uQti4fC1?p5McM3&++V<%E{sD%n׻UEa8]; צ`%LjgCm҆*vs)EM]=9aWPQKߏ9@#Ple+ym TRޒʝb E<$*ǃ#GLbo]h\Sc(>%1m_^*"6XN?]ԯx ݜ*2A4f̝ѬY O8.b?p`AL+݀*f`!y6 [s䢋8rϮbdj]AeФizݓP[s Z,c K$ Pħ}( &vDK&ė 8x:Jƻ8ړ!qoOu5XNj' KIbZXV2,mq 2oVa*"⧤fQvh &N1y*&7h _xBßh];_ErSZYǥ"TY%6`TzBn@E~t)ck^Q3D¼"u/|cx!ȝI$$,BmI )•P0JM^I"`Q;?[ASUh}[=@gu}2{}{QݙlNý8u4dc^9^ہ}l>Y(δ:C;֙%&",hԗ#_Nlq++87IB7kK0𐖷M;OT0? r;(nYYe mD5}1TB10~ Ԕ2At諅 9H\T}Sڄ/oG4tr҄t՚T}J4j30R diWk*zAw7r̬O 4ᎈރ4q =U5_^ka;OC{ ?*S^T#^HyiVnTty>V^ǨHxnEز禔52;^d'(t-JIzqŗO bDŽe~~NJ|Qk#!qm8Un4d]+2wbw7Gx.o6O^r839&Vle'/\2IJ3~& bL A!Onez{Ds꫻dÿ}Xz M6X2HET>4u߭Q9Z9l#Ο`7>O )_2ao(4!; .+ძdR08(*>;9iʅȢ8IQ xPy׿&B.14pZ 2jsХb<쇞ʼI[lu3E>\~G5Xx@9(˷GO8ט빯fRΝ6=Z.t~&*f𙸋t⹴FHdWK-]91(ج4+[O]$5Dx uHPo<7Ņx<E"ӎj "B\6LjۃBW#f<.ee()K3@7Z?rҬ۠I DB F4_SMѤtz9P} {S,?R~/c}2;\1+{ U[={" h4 M\O ]mg~[f}XNN8A2 >fͧ8vs,r30]݄.nFvybdNu^l[0ߪbh~2 =0u[Wl,lUpʘOЉж!׻oPk#sؖ+@:chJ#)fUpuTdZ6y7pqEXDD#I1ӽ6D"ÿkXcƦIVCO'SwCp'AQqVåw#U>YKXj܍/H<ɸqw3]oџWS F JeF1d X)@  }:ycg~ae;$|>fQh9+;GXLT.2=mhNؐqWoCǯm sN\&, 5 8[/ܛ'? Úx_o-JcW*dAQe$B!qP,΀GOTa獒Gdxb斒;pv0dA`E5RYIHmklMQIn\Nu#EC{\%" q;PݙۚIKzV'?峴(35 SKI!RN< ЀԤQ2I( VJS# mT8wӴ9fN&Q51)ɘبiRG,?6hbsIO<\!C(OVڰ 5 Ƒ3ǃ$oۧ_H$ O %{ʇ} I#w |ԖR*fW!WYUc؊%n8hZ&tw7C/z!&uh~l 81[-R26"_0<$ÆZ,4H`B[~aOMUB4][).ϔtLg:x1z>Z%CV)oۂ! ?ȪUǿZp %aHS)!{~|*# 5C|;uJ^ޅ${^W׆V~\=b;c}ik]J{}M^U޿\!i3E@5fDT8_9'0[i :L Aq7|qt`z?/jۉt k[W78Rۄ&rY8j% ^Y/mT;` XԎC o(OkNȍ$V.-ƶfwx o be,=;p'"Kʑ&1* Xn%2FN AʥuP`M1s$NXq(H֤Sb[x%"W5^1fHvNʫ&=Eޡ0~pLOn (?J5tMCuu:vUF}QDdP/} {mqS,_{QW:XbQpUn{҄YV2#WSH/g}dVopV mIҠ_1ž zCYZPg"8}Nt/!Fd]9#ԍ b?Nb%:kMHZ{ "B:~p {e7"Ml/w?0 a7̇g =$+m|gjw$b[V.ŷSwԴmg<_bax١ w{IßxS&/)Xa~/>mL:(aM`\ O3ѡ(0I4`[[6*U'754Ki DXܜѸݸ_M0lչ!3}e_>ۼ Ӎ 厭ݓ#C$,ѓ.Ok GQtOZړ z71,ZЫ ݪ+&cv|~J0S,+ ZXy zy )PzLH(LP*|-Oާ/ivWqnl@2oGUUxzbqxM7BEIA,! ibܱbP@l9gcn#ɚ(FIWk qRG䪫jJ-fv&,4x=ptL!4֪l@: k4 d(jm+&x^>>Jigrt*R6FM|7T e6vh4i*p<l+fnAĉsZ9 -< A"Փ { ddE$p*F)֌ݶz }4 S͗c Sew&v0W̢mXrC2?:hRǕ5l``d)"$ saH|#*wl+"㆙uת>΃{S .pyЪss;TC[N_~Q }7e@_y_iN&Q,H4b8T9-W~  h蚎L~<ȱJ$ywc'ۋ3؞2d;(g&AGBxSO҂OҌ57c=m{D}ͩ3L@H{In= 1.i~2ܕsB.1_LLHCu vcSEE L,₧P?DدO:x|ok ʎҗI eaHmQ Qε" ro"Ղ'X!}Z.w Gx'G\ؾTN(EqzZ, M, }= 3C@iC^}* ((j;qBqOaϡ2s_Ĕ= ]t+Z!mtubNy/U='XV sY>RmYEeؕCu"ʾCIszUwP+]er ɓ;i_0ӓ ʽKt9m3۝ hYf|uirʥGSYkd'NWI[;MT? xoiM2frѪxDOn2U^;;ܙWͣ$M%(OEQ1{A$mG1EB=NvdZ*uF;p䢴KˁTFخCb[+$A^&~u"MNHI2] 9ؙ7>2ל1q1Q}RX9odt ZÁ ^ ę0{NF07gqߦp{7/u%Z-!Lv:>,^~*|9]cJ!Rj:.W&ɒj>su,QmMQҏ48@ސv;R 랪YD]*}3`7ik=<6kH]6ƫc)juf}AcWO;Ch N&ZoE؅T+n:@7uKy2<*5zK^ aYG |ݶ+s*tK-I]_ټ*SC ъav7$Cr6$W/@M1(a'[LgI f<1uwMwtZlv`dٲ:')Qk).Xn?m8X&Uz2,Ov;4Zсs*vb+;Q <oΡ6^,)+M{>8x)f{O7i<\R_Qv5.~e}D-r-6\\7xrx~3ݎwX-\ɛrRmVa8+PN\uoi06R^~v뜽Է^v^6 3 זbxD8?P f.2 3}R \ 'ID%ЎA"`İ&z־b/;] 8ݵ2p-6@g7eej]KqC=2ƌ]+x=u9\FVtӞ||O=Do[ @Aɬcgs2P[뵧F#578o/¯j.ߍwK_|Ùf˲ZKEYt!ѢPtsµ=1q±cKDYڽEk+Ko:2]˷]wjCѳ3>OXa2aGk.ICzuq!8#ت )>.D@U; JSLq|$ՔνB8/,tE#7 7e5_0hZդCǜrx5'<[vЦ՜Vߔ)H$zg2%<>8AKU"^%A[{ŅBaf[vw#ܗV6Z2q>f @5IPP =qD''T&_'Gb <=uaѴK 53 32[xT3`un +i4 ZBB^Q~%-{K$I(q{D 5%nN%@.Rqarǭ=J̑3g\pm̝ CbH9d.ɫ28YVRWӍHY[XyBLN\?'=2c/C x%lZco1u(܁k5ޅTä#Nq%'Tݞ?I14RC Ы;P}glPta$A!y(|b]"yAVRLy`勑દp#Ssԕ ܄߷jw{F>LYC3R,%FJRs#V-[M&5Vl/<'ŀ*ޣ6$29V[ۗ>oQ}bH`33p8<+|>>=&ssӼP,p1mPhLK ڀ2#o3lԏU.tSεB; XeAsp7' wWDO֗t/$Nm5+i|<["a`wjLvWj:G` 㥗l#:Bh'A@؜xMb:8~ېS08|B[X rR%!SIo%U,sLe}!6#4'?rd3H]*lREvA؏T x҃4:]k@{]~,t+SٖA12Uuf<ЂCHZ$*uw)p&˚N˰njhg%)MۗR6&7 ɍc. dn'gs??U[ gtI[B>Nf֦IC=R}|t,ۏ*#4Ps@>J>/Z~XkH8F!I+c]'ih\ ?4gu] /QZ{gN>99tzSg彊Sյ۰=r3=76B'=9Vq*za0`>Jװ "QS62o(p뒾BC\R"|U΅jYTA]U {Sk5( E*s'_IQU.?_\d /`!/l&FzAKRy)egG7yb$!Lv"V4ůӎ*QF]s({ulApD4KY} ڼ#/d Uև_U[0TbMwh`ӎɱ!Ht;C$PRZ@N?mZ"Bn\IHgJgQG-dDD"-<оhӴ}GO~J }uC-;B^R'+_@xӹieB-=r_{k/޷C&6O7KekE9.ͧtݚJg[~֙`ۉ!PBy򣲕("{`dboˠZ>8`:z[ ͐V V,S&YcTsxcnv1Е$ 6k(:_!ѩ}6-A˧"x}i?%29} }ͩĹsЇr"Y,A`8ޮ>9ϴnG) _Z ug?%&9%YO8웈w]; N`@!>B).D/I+?咴{IukCJd7H`QMvuY36c[p-y-*P){MN|R-#0cvu)ĐgHy[5׈1^)3iͶYQZ^781)i1!K\a3M`ܻ̃FQ{ ĤWJunԸˎSZBpw&gSæcБ8`3Lօ_ZC3Ob볬ܳjo4B.3- *^ŗ*Ew!H~y]Jk `QPGe1Y((ϏTyPm#5@]Sz @S9C",#  '-#KIaDnJISH![Փ.pJ>iT\lJ#ǝw*ª99mp<Kz|~,UUJp~kQo/UX 3P@ u ?PTJT+,(f"(|+v%'GuCV(p$7AYY'\XtVaTE쟈{orS QaM[wʭiH:hԛn$h=&չ;ErgŎDVO6uu&ZRS"Т ]jC7\gM?4?,\傺_+s}Ef~%~ nih H(ݝsK1 Ӝ>̈́CB>XBj0KgFpxi5[^eB; ;)|1U!8O*x11}?EUJlcaa  ):[?K~\+I=Am);'uaXqK݉onJ#jfe0=ŝ@}=B`4'y/:/ eJBe`ApJ߅6Z:.#ĂvvfOg&\]\guq~7wLjލ@sM+)[9ȉQ =3 ߓm87x9 i7A+,9Zqzi,9;auwyGITT'd Qism} *t3l2=%3حE>Yⶾ˾'Pm;df΃?ȶ2f"\P6:R=wlI >UF+#:w]eO+8_]1ި~OXJ_e^:S^/;P(dIWM+F._|xJe)ٛ(܃) +`W;4om2tRYف5!ɋP*MCs 7{͐\堮͝Zv_-3ts2jnwyBv~33ϬPK v&#7ر&6C3Q/"@" UYM EHjzN=A ѽ:Ad\d2(o#aѼ3"+ aDs[nU?/vQ]>7j py3ѡ̾ \Gan7]Fy!?ZAy|5%O Q7Ffd]:ёi[;A0z:mR:[Φ$2-4̗lಇPd j %[o{1h*ZI}\WURe(< ɶ0AJ*>+.>(Ѩ-#Ikrx+Os]\LG4kM^?ABgawNub OW8 +9oSrWcze. SGNlj_g!x+wȹh4iWZC 2acM/lӂTn'TХc܉%9pUָ-_8]d*WqZƳT]4qSLG:pAB "+6x8w"gZJ.<`W)}fƁ18_TD>I̐2!L79ǓhCn,o*ʡƯ+.KWAua7P2+ni&K~qMEfXo`M"tʧU1/l܆)=IO|92Ռ' t7j2#n񥊿QSE^'2JHe#߭'I]&vj.Q7oRwi8˰xG-g;6F 5xa/,uV+ t2#}߷d{M΢YX0ATL\"Y]065^~4ckb0?]nQ@MLq2++:#XrmMAYELj$Uͳ{0p4q8 y?[q"4n6º)jq`&OP>+2}u5n=Ieؤ,Hei建e5pdqaCGsH}}j&Hobt#M> @i1+:*Y\zrBoƧrPCUqiyk CzEfZs1se1EЦ͌ 3hOhYZ^bU]*K!p7'v7g:gi1:#t\9wak.Mk[m*Sk @@u(X*sB] mZIS'y5ҪU'0DL X {ſ.a&>x$5B􌨨RBcCƋUݭU>(z9.V֞-_u!0;зGB|G\Ll.Y[E3a/Ghtnn 1\q?A?Mh]C⪰B`{q(^~0>|ۢCp^:*JR%qo889.&J&Ҷ/84=h:6k%T|$lY'hH^Va7P]"ǩFV Y=d_H?D[W  ~,71Uܯm~׺]eP'*'զU"Ҁ?4QP-0Tx!}wOF )lzHLa(#*$bGq>TQ+3aoz_Ug( $A~1/;3+Nk-'`4R.x>;j\WpL* E/, v1/uiǢHw\1ձ8KzE& 2Pe-@,X QY \FfzB:"ӘY)Ka@zɞ/o LՔzF˗ UZ93SF W{Wzqz☹aI^Bl!M3ȨѼ\:4!3= d](|2a4ZO5ISt\[ Ft^G;QRXl4lb~=Jd ʋel Dt}Sl`YsIUϋԒȌK+DL&i$(+h /N9pL/`yrإe3 Ҧ?VB 0'ՏHg.H1\`5Ma*d)frl^Z[Xv9KL`dVD#F[ߎ2]h4k'IV 0f]:{TZΧĥ'ZB|Q_ou܁fG5|u70g(&xrWqDa ]4FmƬnjQh{:,"MPb;b3da 4 AIד]?H{@}03Wy?qS p߉}^b^Ƣ'Q dȤb\Ey*S-&wDppא@:|L DlY]+iY.V?"mҔu(_*DbYS'yQrߛ: L@Nz8'F4N|%LZt6M$i!6,_/ F>C)ŭyeS`h@+E"U ڇi$q<z:b"'yTc./gx%c"&3?[8~d!+ pұdVIp mG.j|z%j)S ?l9^U4l'SAEg&27M(tl7aH!{J"Psvl,p, ?T_9-/\^$'a>6UWD#B-( poxOƨԥ`8TnN5)'j"@M._rclnN=F_*Bǀ»y4dd5!UdE`UÖh)Ma .ߣHETS%5z%b]ںv{ū|_Hs]"siZQ+R2 kOEQPP@k JoER@k\vf(946 >:Kp ^G >) J㈊nlԩݞΘ HِGo͗!_=GIۊ;FKm"?>nJ ;Hwf}Jv'H9,w(uRJ564dSaw[ YiGoj elc0MOR^8xz@;v 0/zvjʗ1"pjMNP&xUng-9\z=ntuK gxR;oYTU 6olwkSr㷠J^v(B!0AۥN&1g(uQl}m9>˿Af4UtqAnP-y ³unϐY4c2. 71 vYy`1$֯ p-Rye9g/wsO'0vi nPV qM϶d?v~K؆sN'P>=> W+w"s8#| P#m^[Ì'Z@c69U#'zЂ-x;ǓwNEP'2;?)X*FZY:B䳄Ozhx( PQF@M#8PE`1PXYF9p>~g9g7%3jV E]~]:gCj1< u+n񓶛ƬIeh92ǧS/|DrTuDf2&i pXCV`k11ҭ-0vPD*ymp /ek&~ёnj\JE[7 A-&%R]OpBAm/vj7#iQςӳ"()Jܖ'''ɣFUVBT"]"e_ְj?ϽFz.J ;oLFa^!$;yzgoi)]f|wy-g j#C#r] |wqh9X(ΘQX,WМ5?#aoũ$_@p AgdO?$۾& J/t`N lh`Ne kN<O5m5EsA3p= MPhk8/Z6[=GI3/w%^="OF΁MLS nCG]#RUA@ =+niCK72ڒB8(M*Pp7,f]\Ak3ybT$;ǭ2'R*R'w g:LhpR҆g۲ӽ q*yG'ZT]I'*! þZCIi3)Y~(\/~]ߍϿ!x1nĪͻj*BԦ9ys~xrJt-6_eaB/]uA0c(-! OJs{z{>C>I AT,Z(yf 2!V"6k;ãmD$_3A0Lk_3{i񌰬孼_: Ɖ8ݒ,(o()$M-4ˌx,/EiPdV\u$gl ܾ"sEq4?3nL+85zTU*1,J|[ˈ.K0G7ì^kKQn9w,(D^yԿbضomW|ӨX2ofP|h!` U>920iFƫ? y 2!@ԅNCT|CTCF6į3Tō^QOٙ~'r4рz'u( ]Xp6i:CFGieQo@+_J& bQw `&=XpvmEJ %v|xۆiѪt~ށ殕ېx(>[VVQb9abe<HTIe [lY:.ac.p/RnyJ{\ܻxp"s)PqW߄uF)LKi6 @^lR ] }1 Cs;RSʱkNo ǽTJiICBjA0 G&UD NB |Ҥ$׀oo^LO ,rۅ!蝟Pa ˂8iՂ(Q@QQ 4%@% r8}"s&90m^iCZ'E珖p˜}[*2YU%bl| bK1)פBeh<8,z02קҜr:#oJ!At~E.)B8W=V0}17EA|ܥ`; zTe1Cm<#B:;l )!֧HQ0Wly* :7 U*W~gᦒV c&7AAZ\PB4,wQ\%M3Ȣ-=UW5͉U8qr: 4T:eple#kC6B!39F)61~kɫNhrzcfZn$L$-ۧ8RZ} +F2i).g 9_Zv ͷ4 M^#v] ocs$/P>A`Pslڹ8j߲3bhEVT71~so~ CŶV)~XČR`Kx4Ն `Bkku@tJ [ʟbk| 57uBKĠs1[X$.7 0Zf3w57B5,TvjK~WI}( ۰/ D(jS XsDT͸&l榩eJ<" #yL`[3 ,!-<%>c9*I؞-2)'Ѿb56,n?oA*4[Fpیܜtu] uzdrsCgک0*jnzr0-P(lwdbd0o?0Y-\(53aL#(e6(M:՝*J>AɞTTiYՖ;<$k ÊR2Io6b&d_OﮚOOO =[,y;*hv\h*L=2Ұ"1%F^hG3W$r^n];:{f.vq2+[tN?`b qe/VȆQO#! {Y;X#EGaq)̌|>(eZ*,Ŵ<Җ&VG TRcs $G-^}f-.V%)\+Vuqp,.|~$K*C :7s a]xyN`p$85aXᖎ&z bގdISP4Q}e`>u|"&Тa$ۆpP Xgl?挥X2 ߕsEҺ)l`cY%B.͕ IQ)4I#{Ze!v4/~]+[u{tA}G<DgXȓ$'I/{S8},.0S:sfdHn>vиDZG6Xo%Ws 0[[b3p}Y:(U& e*ͳrq&R~r8ȳ8b%ȁ (,} Z_`Qv #iaı0Z|Ħ酄կj$K'žLs`PkH ?W?l`E\6 j#_dn|?Eww+?ZX:''onquC8N$L|3\_=U,nEB@DH<ؤG;"Sw9l0L§2]%#8jyA7R+̼}`hI'CbI%+k}IG-t RwyҔ^gg"FE"zyK 线B#x}R̷U,SM<['UHF5`Kt۱@ sd֘i`d]nqM?q ŮLOG7UU P˚z !p3mF:mt֡3Wwy&k5IjU.g,[я^rKmsH,zydfNRE|鲶**_Vr;HD' FOmify x"} 4".GЛvSf޶|sOE'^5#aik@u ԻO tr;a6Vjf]_u7gDZ%xDuW,L'2r@*8[@:N[?k/mW7EQk(,q+*EǨ`tkevG:zZRTv!ŏNpZhM4{ȲX/yxr_1$FiTr ( 0K.3_ >p$FqLU'&˱j&eJӮXIt(oW*qI#qƋA5Y'Y7ɫNv8Qzǐͮ54Ǫ fqIzZ[*!'Y6gU˒aj^, HdxZbv1O-%Q5hT2 ZƉD Q֦w"}y9n'<|C/ڍ *k& !c,l9?)Rni{7ǪbX,Q5<4t-C.4zs?TRiC].p!yJqm+LFM͊lѾPIQ]<(L\24B|QkґLHf9>+ZM9X_#ft" RW!GĥT<>IFVE#!Zk'nzE̲(U!ѥn=DC[O0t'AQq]0~7%D Uu ^@;xAR :׏AY[Bi?_1pfw<B 䧛yXCqòxpɔ h%wq< N[n 5޾#WB?\B Gfg0?Ż-6; U|g}Vg沱y_JG?RCdZ9__J]|ET~=Wv]|NoógJ9J@rd~Gj\(\0g dP6%щM x&;Wr۬_KfyMX&cU5 lFӦ2mѐVNG e$!%*D1^] ~Z}R ?z(S8k=@g *9^,odA6S-G^ow-s"/czN;IgPf s4Vb#|G s ]XgAsncuJV,,Msz~ڋc`\d IOB/doQ8갉K!(@ pssaS08p aUV(ߑ~1hO8q[iEC 6λ=MD'0V;(h4WF2W(abu) 9tNWSE<" QdwˏWthpP/#9JtX~el rfTל%7P AyL mF[֡C)Ǯ"H+'k`m aE/끄9@S<>Px^I,v& A+")YM0Uk5Ϋ"Q({'Xe^ë;yԯMIA<VQ&$#mp狞#6da+`Qp V\_I* G< AE><.PT~ -XA Llp?-fs cRxV_drX(ޠ7&$>%m}~5"s+:%*o0kIb2bjI1]!.YQ%>'2o,c &1.Yh8 {拉IAf{mH}6w ީE)Վ$ xYTh9&lEO Ob+`>SVsF|;y9*n[#F7a﷣|M6\Vƈw܋[j`F:YS+ s-$P5np v9r_JSA% 0V)cBbaz?LLLo{9]˝_Fb$cRGф'RPFX0Ɂf]. ۲F]_X%04 ICvm'fX§rҊё-;gZGI|1kөIhYHzsQ!2+N6B3& ߂#,+J}sjDc8D #/#u. Zl {eq}wGAA1˜ c)S;`'|{%rQM 6cR.S}7dVٜ b\O_5xOlit>mn6mop I̯GQ=/w&QPQi5șGʷ1d]i*GqwZy!iewAH.OQÀ]"q@ŜDa2zC$) I ""% m` $d{Tw~QQ;N![2EeQߖ0R ʃ$P֔ e4BI,?-+x.l3Ϛq0gy/>ar3bo|rhgCS`GCĆ*_E,%c"u:jr S]9\A1"0Gjҍ2Ɩ=s:ܖh(mOZX%w"Is2~u79ńM>ެ滳%묔<8p\kKvõ>$d$&.Xx`e3]9pg )~HխD&TP,⌱݊ ̺4ހR6xM?Uj/lt~oȁQ dh6f)nR lш]U";Vr01B ɭ5b&xeGOU;4 O@Zc"'OM.?%ML*Y`S.(oO<\Gb0 !.w߳2ÍkWQU?> 4Jj/΀6 y@Ej )?%s \` %*?zcwuBxgß9!oYTfaW;% FߛX}_gJVljĸ̆Yz:&D^:a}R۷-F:Lܖ ^%x|\7`=3|-"Vh<ˤR?c ,:9}ĥ d-CuVHsT41""%%LYeQCD+sc6J&s@5Տ06oʣ:.MА"⩒Q^xc{jJM7`il}*< [;G&Sv"`qԔbjk1"rsgG] POW 6-4zVU +jGcr-m5gEJ'4alGT?ܕH%_7)b$3Hgsz 7DCqMxXz'WfB-tLpOϣrF HzZ¿9 }.5fMǚW|2E :ʵ˲ɴc#XvUYV)8>hHѹv?twϻ insYxၾI*b+%7$^IR> #?$ LF~^#m5[dw&M5wՎtئ3Dc)Ц/B-R|{,x7OE^3u^(N- M,0WN!Yvہx#_4WO-^3rP [nvpn|c*iS. 5PHFOz'¾|Fn/5]HGvR;$n2U Ot/s~Ѳ̏? &ReEN6.]142o' 4H_}ݖgJ;uM pf8N}`--3'lV mb%zQQV`EvN["7b%=N ]R ORZNm7Be=;\&'Je=d%c9،6=k?r$eލ}P\ڢAK A6okA,ɜǏK83849+`hFN>@k O|.{䌒qT;Ska(#iU\Xd%o'iMfT&KAv{a3 Fl]=:Xlsk3bǛ(֘l>E$wAdfKk'|FX#8NߎS\3y>2D/t:Yb'2ƺ02$_4+17tz@ \0Ӫi:@ǝߞs8IfP]M rtH$O WpkuǞ-lHWVC2$'[g51(E8 3rX+\TSڶ:, fs(rbmCOQ4<̞Ap}X_9A\_V0i/q/x\k7IO5{B!GԨz`JĨy/K$ F_}䌬 WL&54Sj>˃bG6i-h.ZqJ#T]EntY,(!^- n:KFyd&Hfw BnrC϶=>W׎><3}z&’[zܘ,D?>;ˍ4Kv/b}e0^9L˃ Hy ;Ѽ}D9lj_?xHQW#t^4DA_x!.PtO;+"ITeEp :aXb:"  8Y'^V,%Tw|aeMѝs9H0KLc4%Q Ncw-OyaXFgdv#WGQ-: `dFqKܓ'\"mu*bƍ6/v4t)W<QfT|C GǓOXٹM֨hy6+DҪ;oIjbQ! 揔Wauߏ͞#%8av=qNHTRA#݁;?+SJו~Tٯ:Hz|XʞAJc-U#(;Lm&R6,<56I!qQsjiFTj${OԬesT~6ʌߗ?[DlIZ7{{2[rweUԶtgqxcxX1e~B[a"a nf@34nQXZRa3Dkhbps)\%u$ˇRL셏v6A 'W1DpzBx6*G{Ye1t MVۆ9)c`!r~uUvBִ%*+ӼAm3YUE y! C_F2 p] g9y~| BVveV~PDAVZ݆C-LK/%R,>2k4&\R ʔ7c7gcbE$N2;/E(>p[epnq6=2f? 5]bUTlAQq9ƌ^x$}*]sc,Snan_4S1gt`qL X(86.@T0(gQ{-僈w~ڂ!s8|W-jpGQM,Cm!VG} A3ҧ&ZEjZTo@K]h2]V oeE7̙S qX5e ;:0wMrxb WɲwL\,|q?>`d֐:bҧHBh/MX5D7)"Iy|Dhk]PJϸ%X?\Fی-ݦ/EZlp<|Zw#F[Hvb\tmU" >~1cTqk¯v ѰјN^+/,F,"c LF!@- U=AmAi%@ML<>}4pcS6./N=X T/1Sc<30y .YԴ) 7moB޴gs$ݦQ*P]MqsČn s(Þꕁ YILUxe`v-Î[ݟ:-*}1}63l)V_YNၳ%mv(A⮞2Ot""f^pI`ЯHQ7|{V6l}!<^bV(0t+F<_IH*y巟z%ѝ-j +y6vCO773h%s1:/韪gn W4.r7ȿ3DZPQ 70#ݶ 3` nq%-Ou s ނI /F-y(&h Q&af{|r`yZ ,syz M5hA,|| ˄,AsYO;B>f;k:kwUKkC1a0|N n72'zWGy~"vG q٘4:MKj,픞 ov5)dÏ '[@U(]Ebccx>_ –Lє tN&#V TFM=dOڈB}Y}U 3|YUD>hx=2wUx\uU'yżb@*ө)!&Cð@t{N󹀚x:>ޛs6I,{%v^<}V;uİw ~Sնh8-+QMSBg E{yY TCP0TpmlJmć-&p+RaV^ax]I긁8Pm3Amnh?4is'_f|&f|^1/ cuOn2Vt͒4Z#b*Y@Кǃ Jf٫)1K'a1MˤU+PN׎4n}7=7PqM4]l`>6$&M=fӀ(#OJ_,NjILKݮwD*(*zcUgHʜ(ϗQ;K^„#TA#~@읪o<_4;]8щp?OHgjgQnѾf}|niSD=(V{ ]iBR6xpq,m:bÁY叹vD/`~ySt2&Rb1۳ {2HUvo*24QD4VNP>9ma%V|27mg#W{y )U}Ŀ^{a)%\C- G<.S1dضU8N \rfNh=Os@3S)m190;'*ENtC{w*軤ul%#ü~5ӭ(/}%rd>/.C :6{V_BoB'VYDk3,ҋF4 F@]wDdRdw[ZFç .'jpnͳksM)Ip 2<~tfP]^9p!e\xvĂP7ޥ)lů@9e\./O(Iĉ_ʑ@;fu8hu p'dY撟o}oAɃQdR2:iv>&2Τ65'}.){N1qB6ΌCPw |{oU~,.ZN7p]Z6|\ 5G #<%[,.FR\0zj\NnDƀ8y7b] v@if?f#ob͌5{M\m!"fGgOi@61*%ՁnVqo(`{L0os G+BDQzKN,nD!gˇ莈] G"G+{Q(9MT eS/ƕ]f:1f,#+IɗaNʨ}I#z Ș臦oaw kS0`"6TҒ&L;^mScE l8hHhK"&o֫a5l\%[a;ԇk&(h> 1 :h Ϟy}qbզ*[#w4oO3j0]YW,>Y9cGi鹒PjV(á+cl\4j`p-i3+,E{Z"(]1B& nI9K zt΢%fN a Fڳy;6F!~sk}@29I= .q1RM_#S p9 GّP653ۉ=DchF:-K3E`-"Ha}D H7.uFhW~-ݥ қ @v\wO'z<7;mI jwoJ~)A{ C~̙i9&@\ʺƎZ+ :E-]1%q-uǥ+iyv-Iu@q6#5 Ѷ2#YէBDVDO[JNO { 0we4Ko&QA ݀/iކFщ$y8:؅AG}G_#/`JAF2w3D`kӘ݀HS,Y֩Q Tu2WxqE}܉)GD6%L2Rpٝ+,nZ*]P]}'U8d@pb~x^3,k "f@~Pkh>V*Kp`.'X4̒.f> tFC,IGঔ84ufxSP,uH^燐gU?<W׎sjܷm(Fړ%!?Ex(.cㅰj*贉 |(حH'x w\hn(&=s6*tBgf F$0ujmdarsEW2Ԓae=oCitڬ`p^?HmPs# ,C5;] Y |X3~  +Q9LXڂ|͸(gvԫ`%hf/u2eA5Zj'}G2n!3+5E7^Ì#e'ncɭX6LQnI4TnY:8]S44n'BU:zNʣjX,j=!/hJmE(B<@VC_-IW#jU?ԡ}64$B†//^Axjs{4->x'&AQvlٓb.hR6X$Eǧפ@)y#P_"=?fP6y_3+:ҧ fkjB k\ ֆz-yn$l&2|3!״9.TD aYAe\ÑnrOJW 0َEK흨/J@E&/ҪQMf!7;㧜'PB36%t=ﬗ m100ygl¬fz {wRDѷք-@_`qR3ݹgx+DЅo֝7kaO!%~%S\0D'1 j8ö! ~ *k Y!ђ1qgvRֲ!ЙǛ5kϰY.sⲺaXnjfZcȟOwIi 㹸_}k/$ry(ܧ`k(:pw64J%e9Hb.z%vk:-CuǃYNe+zdͨb[U] 2ٚ~sӧ_h\88rէj3s⻘m? [ɀv Bt#jei%uy2Pwc-ur9v.{.i{8Q ' CP,5.Ym_.Kx$<=pZZ۴8­=W?k{N7<]t;++ao L, 8|̯% ? rQ'//Yٵ?t4}`'/)pyBXhΐkŚh">]@Uoaݤ qL eõ29f'3){6=zdNXB6 ^`+dMh4HCx^}@ﲥA3rztkx/ş< :ki0ǭzoNʡxm!:I2Dr)v &WUШe"P6@٢+l%e8IPed5ʘ7QFF&N X`yퟲXЅ~F{w``$U ķ> h`^$ӿMwH:$.bJ)j့=\ϖy@TP*A_ÉYQg9;ra.;,15n:@)b|_@8f3M7^!.!~:&Ӛ4udcp x 2:Fmܹ\cOI~eOܵg731&^+FZ:w[xqlNȺ̙=ʅhcWe6`B| )=`6È^A -Jf@E=i; Vk瀽9Jj&Ƣc8,W5ȁ `wg2-|?<$d"LgeRc*2wY7ݛ/ $D^0!ћq4nN5=Ƈn\KSף4ʧRUUX!wS+z]" $`=oBTA l93 GvY592pm¸1g!.FI`C8SCd3ra(jg&;#0|Δ9 .[ jn%p :qwVq.^3&IpT~̠/, >^=U_PNmZddtԅFs 0$jC Ja*ZÑ :SbpE >XC۽pgO50uh2LRS!mŞgҊAt.s(U3RI)6|}-1pە[)n=W&Ysߡ_u֕}Epv鼃KYbK-uo ƈSb`jRJJr=1s0wj whE}<;5&ۘՅ٪q**"5{'nC&&w1qpq!~[9,B0[{FZ y(,œ_g52W{poU*hfΆ!D%M^*E(gKGz["cg6@Z 9b*P)-&&i OH>Za{m{OeqKz8Z]uU2h! s^eA o pdRa*  XїevC"!\0/?^|x? kdj*:p<*~(衮]Zwز3e!*-ѐ[r]z)f+*lxL%)(\S@c<@,Sf^6ٕ&zկ8ɶC磋_ci1m.DAPƸL[BĆ*:坷:FG,A*)=8/Ï%W|~!)xR&@V^H8m%ZfBr\LSOi±2ii: M;NDsX5AFa۾nM4FT}TrR:wlE* _#uvo@ ]NuDo٥\v:MYu[dIѧ}VQ5o~ڠyr3ͱAl؜n݂ ?b,&$2~9 ԡ@C U4 {D'=T9mŃGf"37K\N(irW@R L@chhWipd$>-\,Zz~ (LBwK#NF@h(5nZ4WGs=)O'[氐 1[ (9tN[6x5sğ3sJkqV :⨣4 ͳ@"b|FR,(vPeЇ6Cp] WI}y8; ~t.1KPɮYb RPARcx}"'Eƅ3šEY~G]?Tx/ŋ+5l:|ZohrxCZ%=E₶5H"m`H !_y1t%w7bc5Q?~FF(|ǩb?x+,~\b+ );+j&y|=9p Su.Ѐ z E75Jf"_$Eڗ]#o +.^^_YW:D2]䪞(jm[YS['1CJ3e**2}c|q %N'x &Q4v{PS">ex6BЯ-r9aMirX6B_EdXYUeZȑkYƾs Hk I:x{h#rP<~_ݿ}ǻIu -+0ټDjVz /R+d@L=x#Lu/_} Z1nW/Ӥӟ f-aCqZxd\(fD:XZ:DΘ.ob36͋(uDXNR64`3Tty1g;HaݰY]E%Zv+^BYVmPcbܔX:H^+sғ >`4JB2+ VʴC]af XNu.v]ek̵ظHoYAW4wCgFm 8Qq<s5PkKs g| *j [M-|٨׸^X\-u9kThY#ډ!'C[+-)?foK>\wZB.Hчe>|A:~!1^ɫ. -=c)k tvReƒPm{ZBu0U p4Z|,A^͡f_@t_X sFr[ 1,a˓iܝ¿5D<82Aѯ(+mL zY'm@#˸ߨ^i4xV3x4;V (y(t\;- CkSW`6~!;Y|I[Pĭޘ% !;֙fL_dGwQ}%+-9uLsz=,_=ȽUk|dDʄ:"Z#閪I Ȩ 9OJ GMi,=j3bD:~X3ebFH-Ɣ?vwo=&+,k4įy[K;Cx7t(^J&LeeRzm^tMG|F QcPUE '"|$΀CI:ݠP$Rz!FK85v}[ܬO%3汁u<5D{2|t{ ޾>2&!-ׁnӣ>0 YZwaveslim/data/blocks.rda0000644000176200001440000000025713430347452014770 0ustar liggesusers r0b```b`fab`b24# 'fKO.f``)8 uiQ*sң4`o΀QzG;Âf2-004(mtH  459'@d*a\iwaveslim/data/mexm.rda0000644000176200001440000000354113430347452014460 0ustar liggesusers]T/<"bptK\eGtJgjisSK?9q[ijNˎSYMvv |Ω/yyToQZtQwDD;#sD:+HYW'(v6 Seۃ F[Wlo|gO<<<7^̣ϓIc;G=GswuMܼN=&^o8|ռW<}U'ݾWӜ}ϧww>S9>ݟ?p^&}J=/έU#ЛGKՓnuO&kys>M3OɛEK*}ݥOAG8ߥ]);N_纈[~炉`y7/JB-"E:K+_ *Z(M[̭*@O sUccZթ_W֞^L|_zOf}g[V2yg޹3 3gyֳAyN ݿn7 VޚNqVk寽~pc:^pAEfp*Ᏽ>ܨMFxTi+U 82Y}Zo] nm5oap@pgغE)T=˄һGzn}T >n&xX9 |c6tPbwbsf/ﶁ' 8'Z;:.Nw ?^~({xz(gf) 䝝KG%b3qէ/+nq'≻0\yvh/'a=>Hܧؗc_m~%Gs/m ^ ]'XLWӳ~LG >{/owݎ¸V Yr-t@Oo2z{qCKEPڤ˅>'}}^K;f-?c׵"BOD+:#\1rw~ E4{?a 1;l?=^Ŏb?֠X^ǠD>N?c# ԏ2DSAidM4dh&jT i&Ƅ<*~S&j&FBh2ILLi221=!4i{AII<Ӏ1^F:6+Ϛ-(/hV .G6rd,Ad&6gy[TNdl],fD|v#m4.Vy1t7Bٙ q{43aXI-z;Ÿ7E.a=q}eS͂ _%ǭLvPVǟm.+4&6gޗ.\:H!dmw4;.kX s}".J܈} W_km<-$\&E8B~3<5x?QݢB H6r=|,c(7}k} ?95%W~>=X4HP5DTyy{ȫƽEm#˱]=aC FĵG%ibkǙp >Z󱰅UPӴoqI+v z*[>cFH@\+]E$')>y_PFB8OwmVPA:9"XT&ugGV *,f1A'3R.=VWlo&>fjJjE=u*\RIv݉(Ltu.V-"𯾗tEwI[_%kX5vzwr "Yi0r XH5:G,G|(:bx&d/nN(ͻ`Ap[EG/qC ;I&y;蟥L&c@IXʮ|һjC1w޹[ƙW{6 k' 29S!? ɜyC-w}a#"/\[\uP,=Q˞oCιL%Nm}D" W,Û*QPA9Rp-RTȱv>?~FmZlv=r9H'S'n /;"#).(ߑ/c3SZ^(KA;b n m$$jhdLљ$pOng;S@&F:>`&>~iPekRDd .OCZnv9H2i^~P-{"{M7u>ky>M0|v?r+r*vr 铐Wd_j1oxm0Bpd dF2Z!Ihʫ[tg^A NjaT\+l9G=iҪo{+)RL\4u!&U$4cx9Z::t :6qn8I( %l^Z˅SW:O**[[`ҶfLDUb1nL~:'zp;4~G{rPb4T?]0@x_|Cnt8 ܶR8J a&Y4*-IɃoK[ƌ vLElnpzڨt@7B:lӀfq*SOKqr# r6J~^lHz&ÂGFǪxkVr/&{Vxf1\Oowa@H 2ZQ I d*R Ӓ:J@Y!TAFH9PSHR9YfJ  P 9&@PJd+@Y-@ (- &T4JU SM AC@QfeU(Q* 220#̌*$)Ħ) !i (Y &IabXdDI0Rc `1!HFE%#$)2( )" D vρ mVت#ap2 KF]rKRL;/os/|$cn_/}$^ϼh%iأNo)I,MI6hE%Jwh:$ Ii@5w[vu9jS'3*ֵ!*En7&t a!{5D9FҶvKK57 Q-Df12p <}RCM推]>Qfn|FާSp1oI } m\'$Ꮖ͊XZI_5*9SvNqd>TB}G;%ɀqYHNcgH t h_c8L{fK08(CjA0@vI8nKv\zYlډ &KEJ:mjCD6UmӾ*݋$zf TGb y:; j!Ah ϱpR-oXBxvdJh=,#zW"n_HX=S.5-]m.xMP+Y$ 0%]5.as9mŋo}UhRVs[v`>` ΰxԐLa vwOgrZ\TY`Cv}9P PaSW5I-O0(ڐ(VjDؙT'鬦拎sbTv^?Ōx;>\(+L"[\wj9pF >_(/=.ͳ"?*)쀊O\}݄=[i|o$ofå޷|R>#$arA.UWV~ӹ:R*,{=ۦ;$)zN{^?H"Rk'h}*Гķ{v#y>tAs D_"\VNLaOˈ)<v[h.q_kvV3oܽ;:Ђ5VJhhIt[ lQSr {|}L`y)Q `CEp%/q H.wu|N4=|r.3qs"+ ѠJOC_|wgnle;7ߎ_gKA\i0,Ģ/%Uy0rqkWҐ ɷ}L}>bM-:t!9LX*=Mxb u{wm*a̳]}*W5Ta;9WfI骥1`bL}M(`IpZ:1Y?Q1+`@-/-u!iJe )bdؼ}ѓ{N,lJ4l;Z{Yn@Ir])ޭn+EXgR.iq}nP#7 7mS40$-<ǁ5\*U*}W[+no~ȅȿX$!g46/qy%c)~((%6?v;+,g'ᆘӓf/i4  >j( tiZ Ir P#Hd)J idHIJ)HPӤ&@Rid&B:U12"3J,AP$$f0)F-uZ ;`Eq7)o{lMza&8зM1%f a|=޷N-afdn|;6q7_lnѐPRUt-9-I84Ҙm>۲r%ݧV 0'k~u=)Q%[<@2&mr1,][xi!1i +8\_9K NTdSv߃ʐ$G`9ךq3%CiKrr +>jǰ'sJ_>=;XTL JxRcYz! c8V.Œu XK֨4;:Ԫªk*S-rJ ҼFʻ B<Aח? ݘR[P{\ʋ3`IBymfܺM**zuIDԕ5#0>hVH =Nwaveslim/data/acvs.andel11.rda0000644000176200001440000014235013430347452015674 0ustar liggesusers7zXZi"6!X@Ī])TW"nRʟx8Og0ܲ%|< }!$ֵj1|fz[yè3̉X4/Rh45ެ)YHq2ݚ <^䢏7w7a,v=ыs X{#`LJprKFXp]m@L&nN3ZXAiOq$ /?src;Ʉ7GW1wil3b.KiʵpܣzT‡Bor?nA[ҨF_kbvaş-BpGR6Myy;Mm6h:Šb;1އ\DSGL\&vgsڰ`vs{iQV%ޛr9*yٺL>) Iݓa7¦Drꄅіx &6\9ܑ6RC_@K[Mrĝ$֝&l9676%ά/ȌHZW5wvXXui}uJB/y %~3ɱh&% +r{<1&g\t!>V dW)jףZ-3+cɦiȞŮl.o7\*Q,~C5hJ!R)pg*,mu*^_!@?d%HFHE;#ۈf.s,.[6 hd:7j62sE^nx"rz}FxN{d6H mJz5fdFl, ^ X>Og@,0dTKSjNm@UT欇CpRDX+'K3g @٠4au׮@uњ1UOє 1إn^b֥7%1;5^}r e^H v|v8"fj}$PF}i]Yjy‹~>'vqdfݸ_Gą^ŝ^hVF^}1^}@:w+=ޫrbDrHvV J GqIi+9"^ K|%<ś[Wj{55. @# H:^(K]S1J[rmI"فfvIziIyM<)XaN馊e);:(C;M ^6UUKa3&L'5i|*|6ٝq":/tc[)0AUSKݒFrҗ^tGu&$30}a3s&H.|b;vz{ߪ*yEχteeN}uQti4fC1?p5McM3&++V<%E{sD%n׻UEa8]; צ`%LjgCm҆*vs)EM]=9aWPQKߏ9@#Ple+ym TTh >z\B1 Z^[2Ù-GQyd~W=#> Kde~dS h{.HAU yfMǬ5Fn.ͮn291L|%_SRRjT5l9݆]$B uEqpGz8'{&qZvy8+]' w ;mNɹu.gFB劢}l6$yۉ%߰RR_7O><-]Y8h|7WAwҙcWm iKaS_Là@IѫWB(N,b[&}ia)Vw~[ F/eҚp3Т5*~a`n ~< oə,.nCKmcqs+]4c 8:gľ=:YXF5+l@V ¯:PX-{2+HfxE,dZoW;bF>Rj7 '(_;9=?{Q1bt Ct;j)#xG`FgeYӜlϩJEխzpG&y S2*.]vx6Í[y[\_ AjdR+gW5rvүY:\K596X#'&ݟjCzWvZU0Mkx<2T QvɮFT=k߷)Bۧ(kh;c-^.>nAav&m-j/$3s[jA/@~f%nFZ:pJ="RNlvZB&G"xZfShٽ,o8Hº<-IF]e.V>Z;}qĪf47bAHF">(?Bc$FLQ>ޮkFBT&J,T|^"+Eڇ+2}nu>_2DIuv=C$uf 5iwO x[$s4,Onмoꢋf<1!Ǝ' }k۬'7ʟwC|ڹB6um\. lSGV|+ X|qN1hAT8 bB>* 8<-q:?2O\O6PqZXAqOP&Şoy!ƌ[43_ ,Xx!_")aޫEU,w@2TvFQϰJE*jeNP1Nuݘb<  ,Ȃ, P#f#iI > z'FRsT.߶grm3*/nw*r?'D KߠP0e}Jtzh䛣)1pQC/֏aa-r5=+!/ 8-i^]Z63OήJXIxfC/hYl_MYܪN>f.V?Q*.ZB,1E31>>8\cl7̱,C ҘGh[5i\˕;T =̽,%tAG($VRaӅlzL6GoۢQ0BP&6o\>;+y^]ވ4$f>~/1nRy+_SAT,k^rk(%+ۓD 9T%IC/Z ?pH3oꞃ(beSщ%-摖 VU2  *(.YpېE^Ȁ|g?^$bdzc HmB``;E/YANݟ&.s_hQ$(~˺/Fwwǝ 8b9 1 xkcM;vè*҆O<\|s'ܗG{Dz9$"^3x7P\Y X67w 9QYf‚pC ؞'&}`qRN{~? =54<)};)s4~ v:{u: {t6D cbS)1&le RΡeDC KB48y8Ӧ3/ՋN$K !f#?;Do?- $((]ˁ[WjA,Msc)ҳA?^*KfF8L/"&Pf-YW\+DK̈#"l#+B%ثV2;nnAlғ`4 TmoH\`/ r|(4w*TC銰Hu;b^s>Q"hmVMHHHm&XlM]Rng[]Gl7L~t9"C(_]b215m߱gJE@ ސ8/f}IИbNE' N-m; Y|y~AyB[ wYT!Iisz_SR 㳹343^l9sֳW_%9w:+SN/ň(Ltb1Ⱦh'XAщhN@-${'c;ҦͅRL} нf(Q͂ٝ̋7h2cUq0-h!*rg}qFAH0_aVv7g]oON<>&:R;zT':0m/n˜cy!_?p0VKb]dxåab[)9,j 2_w؜dQaK"$RP+"Y @%.G)z1J!G~:zBCgw|D^4,ANCPX;~vҼ{1A(R}! o6os3Bs*}m8ő8*yѳWhBkv2#U7-3ޅJv΄j1J㤢sBchIgjY$&'vznֿl/e6$Fh.n"T?M}Gqm8 nzGfBr~{j9dGm}#fg^*py'گ(8A3V.8mE`Y9C瑴/KF kyMG?r ŗθA0c;fi.ȏāv1<.,|Gq5'ho׮N?]J%mWhba:Ɛ9d3a).DQ4<&bSS"H=c z>lR !+R*`ݧkbHGpڪdK ^D檣I-9*K@m·fl2|㯣1y!6U _%ON@"EI\ՑliI,8ک&cCON;} =`'|q=; :3mu~S)9<`,΄P]z X%[kiL]2DjhUy`1m9r!к'Qh SmӪ*q8gsXjf^?/΀aomma]haB0V.k[B+,rBOfdzx ©eGRL$X1g"[8 1# )IAsxɒI}fT噬4lĄ2rkL3#2<>elX9kbQJm >:Z.SW'0A -LԅKFwTݮ;H!{0?ѽ)I] v1idw,4rȤ) p%S.pyDҍZv8-9 ƧՓ7( CkN[Dj֌"#*֙ymWPӀrdVE({@)T* r\X-g%6.A,7%_wu/Qkt:r*w7dFy셹 ix@IZ[Di#;$żKJ !D C(SK/[͵%⼣OO'~UVq|9$_33lʫ7DXI}9{qڕ/l#Fvd)GZqXP_6[n}$7 lٟY|jBt2IE.Pŋy7HD)gp\҇ HNr芠=xz%)0(ƯJ9Sjƽz;ґg`Cfvc&] ݅($# .Tכ3$FSnV!p)P p8dƗG+>$^H oʹ$Yd]vB< R;Xog>4+ƷU.g+og Cxpz, >dYHr ԱjU XjL EJWLY?4Ռq{;";6%z"DKp0hM_,af7v%Z&EL}czxvޖӵOۚ}u^V ]KycDk-@k+"ICLFH_49m~Jv_UB{;&M҂sly4&u3#Foƚ) z_Yu&?/|-06(wsc,4SYF$xR)$@mke.R+m<}G_{!*%3>s5DMx'条P~,2\ 嗈Y"_ě- pk/ʍ7OdX*F,+@W@:Bl6#m! PC4IILkɜf4aK{}[!lW~23!t =Nnav'1=q5K~g4)5]82Bg"G% %{̵NOQlFɬPfn( ig''zrX⫞akڧ^ 20α$(ة˹ -3v0GIZ6#zVc^pb%20.33wRtx8)B2%rS(ticکR> R<vaO= AifG5MG&4&L$)ohOEd 2{JBwH녑$nϕad=-.da61_3uˇ*#ih(X|A.L\rVG ]CV9r5 ٙg~4SrXd-$l*;uj'6Y> 0熹5J6(" _Ƒ:)0lM ;UEUPJzmFiLbN '(Uۯu2vԜI^g]D[&cV#sa@A\K)(@"gŮ *o2'ЎP.*9b]h-,d `EXPuη҂ncn/ o)t*{ԃsؑ8&|]bQeNt'8:mē39,1TRkp˅׶+CU9ҿnD߽:Ns]~+S)K7 O vTsO~DH W Y7N@,e7Uq ZPB-O62ZC$'סR8.Hu^}dy]'hTX/>f$C 18Q!qlW5 k"Cbqdqؤ"IMN@r4+9(JC,t.nK\1h7PCv2n*nQI|&œR({I%|wck rk !4uʗ:xTڡ;e"7+߱e˧]ce*U{d1>#1` azjZ9Hb:J'DMUamCm#=z8sUGnSd+.:O7Dp< \c9*MO%%3+QlF'cW4A6ݝcmBNQ04FU8׬ Us)N pkëjc'؀_>څ=̜O-9<3u9.bWDڨ~T)bw5(}ᅵ d !3ZUϳ GlH TkbwdtoJȚ\bt+VavEgN_J=tQ2OKv7iX^a)(S8!-p_S* ڄf_Pg6afES\uxuZ@=pCCJ+Dz7Ӣ]#@;^X}DZ5kti@\7I~h q+yoӇw|uas|p(<{? YsXm¿ڴ ~7N}mʁ r/UoΥG1O(Xr)ٴW X\Pwnaޔ еBx~zllhvcE0*!HW䕣 ]`jkDCW DTaV~ۑc\]pNgl$` UQYv4Y[J| 2w\yHe-3LLθO1;#+տV2<{Mh "HE$1@Z)X¾;TlD AOAٜR+ juv(j!~nR~('"5)+fbG%P5+H Qg9t&o7͵G GOi}uzFFZ.ɓLT:dP]ZT4mwgL޳?,z6 xs|g}wvH]SA%"{sIK]rUrUqT1f^5QFqLf+#UUC LnĪy.IAEg(9FpO<@;}Vi?"}2Zğãr$K&_mC*;j$uI2zaj7O)L6a+C %.u>~r64[uE-GYk6s {!,,ꅠͪYA(v7O'I(`1lTSN~u-˒9K>"J}iGyڈ{9 \ c`S,,^RhSOk!ض#jyV!Ф*U3wM 2V5j9ݪ( ƊySg)X( $ 9WjJໝv6綦;5#[O@ nU1;<_='/$OI- ϻK!wae,[͐x*i^ǧq<1AX"P8) ~QY=_\p1^7oC@(jm}WTUtAwr YntϬeƐ^aF^32qb#')F2.Zj6N eW2ĢCbnGN M3)̣p,6q%Vo.e$h9z~LS _V'/{`cS|t`O \=_,a-Ek. *B =k+Qh~־o &#Hb{N+s*2gqb`Xf%*w;ק/% Ny"Gq{z*sڍor& @Vg=0y[4jЕ$`Vr`8K|ݔnރ{޶WIEiT>f?p_ez:,S'T]F{"#ѶaϹyJg>SNOA `XYA-DRrS;c"BT(dW+G }~tkoKvsӾ?C/UlX6onU*ntmg $(Vu@pN# *y P2ԑU X{cU{ ülou:cnDlVu]rg:Br9:\Z);/L,p@Q$e : &-4vau @Z`/>hYI*b:ee}pZc[?pgN,E1U~>IJdv XP$ > L#sGSrie{r>gEbOՋs;O:KVO3ǞnJ2-|X>x r'Ё 4SW8e1S-gYr0p| 98gֶUᧈ'B;П]c+*-e'Y}ӨA*Xώ'Rbİ@-Ry">8/T[ 0L@3rW9w\{y'xcQt bN5Akʙ{9c8y_бW2̋gxUS53#s4 nؘhT2b|Rkd<̻,݌nvbgJtN=HzJPw?ɑ%ȕJ|>6v[x˳2<=@B-ݒ@.{: >E46TrWWA@hXibΪ huK'SŜK!>i- V4̬ gY.EZ0jqBCoZ5(@'9g #]SS ⸮&q\MYtQ.4`\tM}eoTT)i]ʭ?V1jeX~U6)/|8HN\#u)r`!Nw蠪@mxi|KWЕmvcW8vGLBy.^S`gPs: pn]p(l h 3jeB9յ-cwi6Űtr%}ʍEN l< KcwAKwhߜҍ Q ͥ$R,%X7{zсX<ؼ7a wfLd9:VZ:SolܹzC9uIPl -i1&rMk$uq΄8S) ҒFcGd Yb C "gI١S!RJ){NYN!l=eT*yCW)]jo9;A#k0U],*p@lN&K'nFljujԳo$ggqRa>8(U7%RSR$gX{@ GXi!Oi k^.T JmIe#@O P&owmxj leK/Yd住zڞe-HLbca#+.`r3?C"!zXk}Ny z_snj|o=+]FX۫j>{|KqMqcs }=ft|kg6wW%_Jg=خXhwa]FlBɬ/h p:,5a-99gEߚpŻXSYHo6HvE,[.p(7qx@u_x ]ޗD#ُrU5Ou9}˱<(#ĩBݾ_:G_ ھ'+B#)A)wH|SE|]"̕1mXyl+Ǧm$\lq0={uֿ+wªW&[g*}v}Z!l1'H|b< >Aۢ>Ltϩ(͝ߌbXtZ9 iߺv"V9dbgx\(QRt:F+u۪!dXMY ,\2e;FLec|RJw}6P\{($cG .0ˆ3vn7~PzF`b NߑfFwΈ=gSw;?Vh3a@ ⿶m'pM.ҥ1BKmq6> JX_6oeIore #R=DFA{RAܲjBG%eap#FʉclȒd`UO`'}%jd2C.Azak>:l>EMhC%EQ]˼'_yT)uZ}z`JESZgH>Dq(0\i9L,M"XnN-76`vu^\Q?*0N^'b"ھis':Q1Is鄷;`~C($k CL">S5~S'C@M$_O0؊6{ѡ8}7c/o4-%W.TÉ4׭j^yC,?`GPb4uID [J P|+\ҚIXET={DU8nwc_AxoLuv]qz hVMWЪYk/~powL3L\!CLݘ__#_.Fmn2FdqN[;r}m_Yc ]HSjl4&l42Sl7"@#FИM`m/T 7ŕCᨪV~$x3nߣ(:V8âteϩI-[3>o/E H9`q–M1'L{m(>/]~XOU ~ 8. q3ՑSOҰoIk<Ra_X`^J)BөhDV{wMf1\bL1u 9sO&X߱V&K=YIҍ7.)PM wB*5xfV³B5 . Tw$[(?6q>Q4*9mgaY򨽮%)zRD=B^G*H;"tmKD,p7[p #܅󣉃BlUU: rrKb/AThQKH+iyn#;b$NNM%-]'g&P" bǙ+b]":|QF'5G"g1̨nPo, ӽcUr Mz@Q{XI 暝L(E;… : yCit'[[XG݈8?F {&JYRV%5X'QцdV, 8i1(pK]B4!jXυ <Ҝ=ۺΟ"@~oLfDv`ifʭtQh-;}'D*ݧLn_+)7o)1TFm{UĭL` 신7E7w`c ƋpnvQ5 pt[K4u3 vhP+˱G",4kD;\ۭڤ>?U^$6P] 8}F<">c~?YnMًo@J(`a5cbcE4 )@d di C+ܕfvx/P ¿vV¿|3TГZ3+JJAP` Ld>FS#Xs@EC-4ꂈ*|\[3/u;Q\S+Y?@kU8IJ-&i2kgXhIJ3TWB,٬ʁ ]c$R%l>~O$[/.ZݴA bJENo}9GIJTe]]îvEY.h|*eg&&nw6 5y{OLd=>6L2c,T a )!J ULNf5 43Wu!/Cloý859xҤ/Wf~rk"9׸;uO~iš+H~ԱXIQf kIVH!mG'_뜹vH7,8w1/Qb (@23l3+&YTmMwQ?,[i !ʷ;;t3*\,jN3 JYtm7: ق4&QqUp)L' bob91BCK#OcvsOTk _~Bvj͖nYyļC'bƱa}Y_}nzu.\WT#9O_H-k[Q.8r?"8mK 3KN\N?ׁoÃvE {m$ #>'*<b ڛ/V"66inqH9-(`@,|7ݾ|V3;88Qx(Tt}5}NC*.)@IoSXįb[%U$x6ܨ5'_}ʈ *8Q(⏴(+mݏ1- o(Ws}-8S5KxB IHR&RZ?:' 8iE8 i f}jS[Dp6`MN.zm'Xxzd1.Ԑ&czX7-_u&gk0ݷx}:rU {qD%G}a5{)#۰Ff5z[~Vy-Pao8IN%^)ģَMG?ڈKz%-g`L;NGB(ꄣDKO0v*r2fVЩKE$gY !!mshˑpGM|/pG'ܢY` EsL6G.> <˄9'C@R`b íK:|uTrt8%~:k2 CHC96M9XW?Sz9fm +vN 얭#,8}R7BV9y)yѭ/'/gHq@c-k '"H[0!Ȇ8vHW8@xQ G]odx'` ̟pPݫtO) m5i zޤOPx &y 9džVSd2Bb${@#.6"N5Lu+aIC 1C_?E"h'hJ51yVɨbነG,\~%3V#CAR$YםUr )LC]qِ"=M9Z؝?ã񸺕RW]Ǧ d܍%n<݃## *ijQrO忇{Fhj9K3VCڥ<"h"55xpx6njj^xhYApvC*>)ZM| ŖPAu|,]X ER`M֐\\+.}ɲjl2=ͳdG QL`yFw߿"FfL|7u0eB0~4hGJTOB'~u4nFڿ *o8{G~P6#=Qm4SX X#L%Cʟ׻^&#'9^~TQtqV-i$frk{ LOg<t_œ*R7 jJ S af= FiO [ _Ѧ fP(-Dug\ʚ& =cJXU>#i\< ׌?펔AK%~֊zCM]̮ƿ[$6P@$Qp˻xpI ZI'=̶BFe<"@鳜S0iXwlǯ<Έ04?窋/}q53>7 7zxo>._e֤mK{,{w:Rt<.R7QNj Yy'8G~pIc>"g'Ξ|fٙ .#gl@_ B˛ݓz(7,7 |̂w̽bTN~P_wt.f6.R:mqPaل w!)̫"?Huպ?W=7ZT +JA#{[xݦ{PuٔmN~wS/tush[s9[Z'qI:m1Βdw C[Y+VMg4Mz/jLn:!`%/'2Kebw\q#{ -/o2Ya@܏'90J RotR>|if`<*䳘"wzSKBS,[r{wN +F*3V:zRi[ya\+p&]@uD< %] fBlL[jLtH)f1PXB /ukW !GK; 6Ґ'^Kk&8vݩ׆٤4(?-Ѝ}"$pR(CHAFT:QZ&ޝPM#jU5"dgØ'Pyl"7n] <#"@p|'?g f*LbK*M5qkޑ0.TV{t)'<[z mP&bXޕ$H5_͡K OfhhdhRlMʱVȂWe 喴+w}Ll#;2ʃ.zMfw6T@] V=uӤO)MeqcK}|Dw~nQK/~p 8L 0!dI|*ͺzi}=qQm2@YjWp\z,ɨ_z"+eɀa=kH-/@x [w3[`  AMtDZӬ(hHu ,;Nf pnΘ6{Y2٧>1_ta2}Оf2IĂK7;)³]?D릩-[O v0[|z~Έ4m1f!."*?tVVpp^y< j߃޽Omi=^nxs%3&z)HKٹ|T<Y8nFGaQdu?iQxMC:ó?r fMJ2b*9>BBr x`sغ2\S.[:a'DZiV[y74r/N#*ݦKsq-éh&>4.g- <KAUD+@qGMD/{,w0Bd~2EM'8'͘Ր`10'`^Ҷ ۑ 0o?ʂ+`^OdhCךxK9cNZ5纭vGu}4Te%gD)[ ;e@oczl&yzXhh骓\#\ Q23iV 6>Z"jX! [iSQQpMluB2Gg#>&*(M䯏E¼X|kF_#w!gq5CC?0Dqۉ0c^HpNg& %#T3An'8!'ݳm֭C*~k88 g (iugŊV\G2@|FYչz?:Z>R]kƞsYBǕDDMc;HVD6|+VtH{km-#{S)le}8e- Z{ sROoO[P?=;ȚϽ02իB$f&Q=2P\@nd.!@@lj+xPW'(GtLv}[F+&jv':U`z]*ze"`5G^Fxa16LKb ,5!2 cFG.eyGx\Mݢ焐%ԫ_sS4W:r#򲿌BjHRu~#7U+5eW3 k#gxqXDx G _fHMBTEQ#tWouL | \aQ*}ϢMXt1Ldߐdf%*vQ-g8D뼐yFЍS=҆ɭƽ ]n6m_kmyÖfi)$L^f߂48qXD f7\Ȉ{R%_R!o>9B7O**yJ#гCmdly XE2m*$}Br=ׂ̇PǜώlW]ы Phz9? Љ}F>A$.Rf"f-p8،"-B|"}2JHRё9:Q1\\OK䂎t~t{GF#tcA]YVu/;,FLY5')~p,փ ,V{еOo6ż΅,.ǚ,njEF q0T;֦_;7+̂ t<ˀIyg4H8Hh2h҇0Dȃ \`vKS(tT%.BYfW%ts/sP{6 C&PEIP0||fTZ ; 7F$Md9w=Kۖkrj4h5"dc$Cwĥ-"ʆL;aՎXh61x9y» 5.OOI5*^ցc>uU"ŋ):՛:)?=DK{~mfKf$iϏm xG,W7JΜ LQ alcvjJ׳ɒArgR-.ө?w\gk2QpGPM4)\Md{?ےrhf4u/!Jޑn BJnKƿa kG^ҲΝ'Q4Ɨ~ϻs *#6,vm(dBF%)<ɩP~ȴ\RKEӯOs!1aDVI+e8  Ȍb`[F8{HIXnpZ( N"Fǩm;’(Ef8)2O8&uN,)!Ai b:PaJbftf-ܶIdl)!@On8^]Z20eeqw9Q8y<L>\kTɞ2tE>|g,z[$B,VXhc7 ȻHpkHp 3"9\u(\Ac80kށ.E:lrJʅ05b#Fʐ>*m5ޚSdOFZg9ƕߖO<@!g) ?NXP?VmkVt*L͑4/SZnR8Z $XRC_nr w,UP|F*+\7r@wh%Nr| <=8)*΃OT*ǡLHѿT+"[qYh!CйhQusvKaWDc]$o'HRmW5bD25I+MϿݮgBQplBQޘcH_t} jbK x mål @bLLi!n,(ڞyMR%xȾ]8t%22 2@ܚݛKJl}x%FH컌-&rlԵ{cH33xa*q!bTcVdY2-N'*Z,d2g8:Ɨs_!އ($P1T=hz\ ?uJЩ~PA j6A pl4ױ-bh}NetTE3"*|ܮ;L'nA62oj)(H\l;L:NnA@6&0B$/Ba_fHt>U,̙/ a[Ty?0%F<9h-HX71i Jda9x/9`z}pE?/`6+:y7Z Rk$V~Cȯx]2aԄ#NKHK*LԬ7;* YƂ>c;F/I׉8~ʭ+Z'rbEAqq) l΁8ܝJ:&NESp5jIj :vy3LV4L [RAj1˾GYEsI3%B>@P=犚(Vס|,58ڠׇ|/{B G0Nuk q RKϿA 9$-]:TSgXll7SĘKޝ;MZs%c-j$,*,$!!Ђ@ [ $^'G(;̶hu+XhŅ:wjV* ujIX˱Q1q~o >;WUI+ֳ{s*f./&qE}6 ~3Y?FZ9hHF=$]E#LyrBTvAG^ă|6z}!y)^0 >ĥONM~\e;Nt$,0k'iWx5ZoSX5ԊƖ~3_Z0`iP1޺hD2xTuq׻"0$T2@.5@_7 &Ndɑŀxӽ:5Mry'/Y"ԙ+M*y;qП -| IEt[}i)2txҌGN?%c%"[܇_$ۗAnFyD(= wvz*-OPN{Y} u+!fNRFspx6L#ZhcbTшW0xnS1\Nѓ=Nq<l@1W7kT]YcQ ѹ dHYlj\K#v=ҫwmKi|I)2d5dx\a#J@m)TcOl;b)oVELvhXXIvGI.h:rBqLPM˾yrrUܬWQfK,0)%F*l³=2YK X*_*2/ /Ƈt=Quq#z4IfN{u$yaz`1s"ڑ_%Efҳn&E.ɗHXyuESLEKbL Nd֤[1a;-l9eED,s?!*\NGijPk^dg:1u<? FRCmSyCp*%2OFz ]uWKQ+-Z#)X`k{!Zί>W'DŽœfKrl|*TvQ)LMGh@nFQc=ܑ5.R0ZvBnjdlNmqpg`M$PuoX=q=ǧ:[pl{#=K#?YFEz*6 m OjP!ϰ~yΧlNtGŒނk>p:6ѩ:Oi&XPfI#G{㈽?Hև늑y*i +Jᄔ4# ~'OV2}W!p07*IO^[u8W YAXҐ1Zi#x~-I[ъ4b,(jk*HS]<.}*G]CK%'[P2̞{k['G5);蛞IL[br$gTEL3fpD+d`ÚcCB?Ϳ}"*5$f☔i4~q3)yV7,sg֍3hBU{xd[[ך?MNw5D:V&ب!ݒc-D< ny#SE8DžACf`è-'[F%f[5ж1 Q≻ QMJtJ%5['wDR:y#LN<@߸\lr1&dɎ>y$:%dQzJ,+q a($v q*ݯ[޹8\&*rG":Cp,E Xp06^3Pg?h C磰F029H+;$;•mU^e,c[-9GЅm`?RiDn1=,7$%YJcR)P&t,Rn-cf 踜nY:vQkai|gF $+X -I{*=;Q…p »JO#HŤyf6@W>K:M803[gM f`2m)J(%#ЄWt"nNSbNF~e B`#bx/$r|E\^S2 ~ rQz!)KܳY9]n_{5#Y..C?:_Q#)OvafIGc4B:lDгpd 84{&Dm3BdY3=9mFC!MAQDz㺽5s?* D" ʛ#QeCjdxy QmҲÆ;<8{t:(YL'­ ϡ=$𿝀U׻rgXl5 r겟R[; UfJWi_M;FK1GAvg5qª!ق }Е"K!{<G#=ӴT2elJQZⵉDTMJ'cxDB0:B[6N/wKq Aq8Ah;[떛j oL0|RMD2%-q~‚5W;+j0v4 7] !t6NE)ײ{G=xv>߳ap,܉ <Ñv:Cc~׬eB9t-Fa)[NMV_ٙ|yz\&}>C1# gGvߪFr x5NjX@G)2, ]y' C53u.MFYj+{(]Z>:u tE\-|.'+0㭭V,jz!bMr/%{\.>d|ӖB&,,r*=4u챫/Va4тPp[Twh9ҝLr'bM+e i>0߹oEgxuqƚ=\/@tgT6,@2H=V̐$ C>*^16DJy]S,?jP1IuH\9Ǘ{@:^s w[3zk$:g*qC;:0P;9-vC'949\Hr|VxZhVx͆fֽEsmdZܖчʭX=5`YQFZA1i;mBI.O1 أP~5fk ܹ/&ݯK OOmQ: ЗyxE,`\B߳~=?zAHe=[" i&1wtTEjU:Ծ@FD(D> gy'_nL K/Q'NUb"#k8~}[J(2kZSA WHx~[m|j)&舘26e"ȏowOm?Iޝ2 o[tN=w43WvWqO;Zt -[7 6slE >t5+osJn)9[9}G`<˗cc0Jw8lMS`毆#L]~GO 52JmT'Qم\cӶr],!2i OR@R%7D>6="K x$Q'8̟c1]nm}&i>֛PcZ $gniܷwG}kZ/n3կN2޴}o@ ZdmUVV_فS܊FnHsl@q;Âtr]^DYr'0|Rnʵ$vsDTɌZ|;9R7sLfK E5Y14ǿY?<_Y '~h\|˻794֎ZP[b'ZNZ2nrɎܮ6лi rͥdg 6hC'1Fl/shPĶ*BXH;m#1u)$C.[sR-9YG^GELb_G()s1O2}[r7DUg uoo3o#m(]n,c $w!Pt:7A[2wP!>Ҧ񞛐BXMvۄFGIdSxl&-__8̷?1{5P^9lˀEp(Q]N"/( b+*BVat&(\K2HU} sOb.%#:RtuHnTJbBZ5THƸ; hLfamMG a @gVi3'nz6ϟ]U-%|K8~Xhu(7/!Rb}::&<p^;4IboRU)]AVsRvXv$\x |yłӦY FQ}Y;ثc‚K@|k-?π1s%$fV}~6 1ȼ ,|{1Ń<88sa+)P7,h:9ie[L8ϻ86IQr Kk0=z|,PUpS`2rO+t•LYMHy,g̻s5~"l"l͋KlPpA y(CX z| T$+_̓P^FM,.JܨL531mR.Z.x:v 9`'`%S*ېm$=q&4.iI@ dJ(o- hW?QNjxPy[ztƍ$PuqE.1FL=hB()7x۶$I1/Y+ qʛ,!C|Ǔo8{7&3Cc##,9Y8)ཟG# M6Ke;c .RZk&k0 OMĈ-:&BB=.wƠF[,lM:. i*KVLL=_^GWi Z/v ` yVTs$";ݮ$-{?̀N <-=EAhMZނ=,A)U;زZF7t< 9A*(jAzUeO(7hL`@I$_3p juO5z< KdPv;p1y/]j7-p@@"qxY8VA'a<*ܧPX[Zn~ib59{'.C=Yb]؞=/>Ҟ.E (\jy oLDk iwqZ&8Q|BB2 j~Mk[Ҡn1 lX Лm y: UX{i\џ/%8 R(GQ(_-+SB!Ê膳? 3U}v$N$ȹ75n1h-|@>Uapsoot-d |A L)rޖŽBPVŠUNZ:>_[n.)0xfj[n)пVpw@ٷ;?Y]G\Kģ;M% {K]-z& XV532Pɉ.n{L0m:{@s{NŽ™\FPU39D lXu SGhꊣ3)؊Lv]խg2*p%-)^K|>T\2f:S:L<7`JOT6d戟Sfƶ#} 9u&yYd%GO _ΘL˵^-"}{<{G߹&L]t]¶*,-5QBLl=M ͍,̮HVsSf9cuS -Y%=TFtß/i\>go)L븛cQi;^(W<*nDu>s@I<9n a%nKEzP旙zcZz* K. mefZ:d5 RIPKQNq,߿)bJ9'|tudP!()I=V=ApX\A⤍@SguWΏ!^s 5g":)V҆,B[bv5M7 HP&+EȜ^e$';q5"ޣHqC,n̎R`&cEW(gC䄊G\%ftA1WΈ@2͗PL0U\ڊG0m U )FڶϪ~ ZͰs_B[$)891d ynI|jTfR0oT{O?tc~ypɑW4A9W>mvA^㰎m2:M`\eXBr/2UQ~6o?զ?f7Ph{-n 1fA[(%gẔbL'3Ķdd}(x +CkRp+X#թD)<`8V;*L3d*ܨ1GeU,3S' :M(8)&u%Vp4*x*A/R!%3' $Q|ʄiƢ$?:Y<z׋vvGl-iPBfOTh#0?MWiL?sNv5ܴ)+P^}Xozlc=!CעK{TQ6?qRQ#위cC=]\:,OCt!A!F xd׈7o +5_d.iTRnmTgI 6 l!ѹѲg~y7^SWza;CPr86O~Tg= oh0s_c6 Tk²F2 {3몤_JSB&[5,,\L',בsPL4 lm7r"~"b\I>^r! F|rޭ\7K>GEj_KKtB`y.pu.|TɞS$5=kPM?YwpAGUEqݛˉ&6VsrBTyay#щDEmag,'kywXk;C[T !H=fNN=H #Inxbds'/Ozķ*7ݩK֊Dyܣ)TglV_q<05HT6vt]ꊘ;asԜSR~ӑX9:[RNY`"4LmANS2~ w{IV[Qc{H^;_H9 eCA"FT mjFޓǖԆ<'f~P%X{P0Kд{>`biZgbvePrT4;UGagKoEU!n=cX'?0޷+f~0?T@e{4b#l|N5pBL`t1x`%5?D zHFG+T%Cߞɞ3<1BOiUҋ&'aߝ&kr ~TldJN?1.;aHK=Rq_KꙜs( `ekZ(k 7"2=xVLqĊ 2@1F-ُ !C9>y|h=^\dsz гwr\7 k%eBj~}?~~kybf8TtCņAZ,S@;="FUAhCt>QaI:- 70e Av w_c(9J'5M7!Ex`:KigW.U+!Dg[H$ܮ['~]hؽ!\V=쒪f{>/jLu$_ގ=]p?O&^m+2Z-'yo}ܣ4蓢a.fFw#c^;NŰ]&kjH-/xJx&(uPRlQ\K(]] #{~B",}'rxIƏҶzS{l9hj@!L ]f7SULw[12pMWЦ?|XN?2p\B/bS #͌W];KWwl3vg޽}qA,@U+r@;b-.+EW;{|s.1GMoyMD@ ;n6 EB,=ŇĒ\YeA͵2pݺ^}y6oC& awڶlw.#kJx$I, 8j^ZVY,.y,K22cX[XsS-erEڎV9b}~Bv^91Uĉq۵8&.3>^5\ۅ } 7J]"C{0z<R'22{\QFY]O pkYG1Zع+y?x2Q"a-(%zV:hzb] eRDi| 3'^o]HyHǼ%j }lZ]AQ9{nL(dv_*ɳX(UA?Ϭx^ HZɜRU×aV{+Nٸ;I4Su0oCٴL>,g@m.؅%>5v J ~9 DF]W )[_|.ǝG_d:AeoX5 (sv^zNT*.C5Ec]wby8IX}>Kq$ )%E e%C Lʺ󙳹ɕO[bPPf? O-_;Sd;dXL= *֟givB |f+6CPO Vb0O +'uu!͆b:Kjԟnn7bϽtq7#h_b[qyz,cV$&o yf/5xKPY7,7O`Yf=/ЁB|n}|O+]{x8CV[fM8R.r+PVVzP$}RCԧ_o KwDs%`+FEZNd M=lIjn@qF3ڞH?%#ڼU( ˘j[#Z4r[id:n@.!5TD+y(`ny 5ZL8\cptWw׶ŃIrJ?wKޚx4BJznCc>^r/q8G(43-Q|˰dҙ OR!]1;d UB<z+"HbJ\W2^D/!OV0,>xs,1$`F#y:|+5-pVl8 /SsQE'P"dqAYK?%4B Y*5tZkye@) #ĺUE$:TJyPle&ö5 -%‚21$!IVJt6M..TX3BhA|F)̂ǎ9O6Ńϔ2>ob<}J[ &4nhFoXۜT>5VhApY s%5?iQJwsc.SNŭ)ZCek+aӵ:1[IQ٫ SYi}Eڊ??TI.)3ѫ#$],`c-`||5[ƂڧJq~P?>!":3XuSrKyGvfV ͙ao9y GLxK{o mo*lޞW0-O?lS(fJrҕɦZDܨ5Av~\ B˫ `۳ӂev TbxA;w&wp o$$S2ʦyF1` y/6?&s&1ͺC@N% 誡ٓI~p 1P"_a{@\D B~˂l ^Os_.jV_w#8Q2,#bÄbQ"[2St3^7YrFM VUZK.6O(0+5d'n翙ʂ ,zP۫k~V=w 7n^ DLp'I1OHj}_7XG)"Rރ hy+i_SӵQLGܛ!W%ġtʑSyÞ5Z6 :<#!J@rgKotlĿO_~JPBI>-kE05H=y=JX2 ]l()*N-TG_734 !!}=IP_e`J?k++'PcT5 BHWY^gv{[;/)] 5Ȭ­/S} S牢SrfII~Q=RyШvT+WJl@4d8ޑiK6ͮ'ju KC_OcLשC3^ZY ur<>g> 4twH ʃcJt)фv3l)ЀsBJyQցF& [='Fd[>c*RJws_ -ulc:2%(b9IgZE#X/E*K[cz̤D/'w# f" jネrVw;ʑ*SLt.;D!qX@ԮLJ- BE]Bcu C]Bka6$1.?$duyG{ۈq>l9Mgǣ/e+V: &񱛁xQu n+jN~$&󾂏zJY@mkzMv2[p᫋Ijosx5!(Ě[箶';&TEYZgKa(UD! c4k;CF]S=cyQ%P.3ȹ=wk>J)< >dHՙ6#m{o!|h Oavm%M{ MSGQ,#UoIvޡq =},-`"V(Vh}!2Y(nY3]gI!2s`upkwKڥ Vlw}H'8:$Wh/HGH4G!`ӗ.҃cf lgY(ux粖B&|Gv fF5('2dfԅ7T,A= 53ƖO]V1%v;7d<I9F^%mrA{َw5>\󸮨>t;dGA 굢q#4 ބn.g)C:@7ԥ4R@m.#W3z+ ?>Vv.+-S{Z!Q(1wӫPa( jlsLv"\JtrHtkpZDF33 ed!L> zMHt&hky#ĄRS w[4@9%X) fq#YJg&n괙]Y<<:t\;(DeĎHVI|׬ajw)b1 \kt}@RЫݺ#Pǫ(G!Г騕#my9\?s&y +LH#z=ǗF5~(HX*$LdFwM]PEA2o,69d= VVyzo=û&{fw'}o2=amUx]] b!Gvs=DӇ5Ž}rY>bʂE1 /} ܸWL;roʴ%H?m )aus+$LsŮ/,3NH%uV~WB>Łe׼($&:C%k5()_uM<4۵+!{Zjab  ~WSk@= 5cPJ޺3H|Z6{4;nS]yeUB{uEmf L0 RݠpϺJ/A!P'F~""IPQ+Jvuޫ'o-AR'@)6]צ$[`3"!4>"ZMЦԳO\GL-9yv\ieZ40us{Znb%CL'Y??Ր%.,0p_SHXfW&2ᠡe4ïX35ZV \B~pZ^T@.]cJR[]+1z5ߚ"ߓcI\UegV\]%1RW: |DwO2S66E[u&@yhy/3a]~uMsYOn )#å+8w ɵ1&W֣ջlBI8lRүC*5p@r" a"Qa I;TSh&{m:`Ue *;g/?m_(0 YZwaveslim/data/nile.rda0000644000176200001440000000176113430347452014443 0ustar liggesusersBZh91AY&SY1nuDDDDTDDTDneLDLGDDDDDDDDDDDEPiP^LOBzOSOOS5d=0@ #E<4AfmM4@@= zHdшhb 2F9F@4h!F#CdIBj4bd 12@@h HԀRk\o?%h$NOq Lv7c-]A"VcxW遁hv x YTv*${X rVKI!dZ ǭVƶbbA ($@\@XD",Y@QgoO_APU6a߁}88 }FO0K|j#kΏ@hXΡrtSRTN2k>`2PsUs+O"I{L4oATT!Z)>`@]Fh.SIMN4vK (]:l:+ ?> o5hOPPXT Y#.6=/cof#WRGwҍvnt%4,i+~߰" )=X}&(`lZs @٠]D8*ϻnZ} t~RI!1xs kRRuC=bN)GS]u:S;kjtx_ƕ?+9A ;rΪ ѩ.^E{˚%O@\&#hݜ92Jտu.~6o O~B1m/_"MR#2H5n4 ޟڽṕ;1RPZB* y"@kU_1_ZtHtVwd#0ldz>0._+"|ir6?t$"x#ͤfK"adf;rȪ[fe6y)*Lۥ+;ѫVv;/bUhp ,Y5txqP tFCC@y [+ tw%9-YaCrI TYĥҟI=Ƕ;;{ͼb@[1y%'K{7#=0ބuZgCH$[u4ʟB嘔 m2.ػ!k@th +9>yܑ͓ٚc_l=e9vNEa$dݯٹz 2ڟVDnlsﴍk$F=x7V/$KUn"BsT \rPG#KzIj6XҕSw {A@ ӋGN@ GP<'1 R̔Ot(?p =cZ[סV kǞ̘ Iq_'tώ6N{lyRij-'yuFL,I[!+M>w|6ce߷)DmHu2M~JL{3rӲ [[>JuE1]W'm{݄t[vaܺ!^oo a?L}C߉D1MFZ-ulY1$Ed|-POt*clZٜŖ$dB\cP aέ$"9_\xev\1EMȀ?k(~)|DYZj"Z5bY^ H!̈~>[K 뼧Aj@.8oTRle( d[CCˀgB.@Y}OnQ]:}!CZՉlPeZ,Q%f. rX |obm_Oyܧ9y /O5̜>ut{t'Kos`绩LI5Ң SfIWRikslGBi`TXYFz6з+<CNO VaII6V.@7ZzdGKtmQmm;x\{}N\ p$3 _l$Udzrҡ-/.A*">® }I6݅ѹlv\>:i }|.*uzRȯ<mmKϜ)[|z[k#7iYD~O8sM.ECNP19$u_GsS:/[$@`o4o].YvkȎ N[s9a:Fމ-<6{ wR?OڥĐ}nX `2- <F2u]C5COo¦5ѕ y뼞X65Vs]*MVe8{+ޫ~z%;YaKJVu.@@->UÇxc}רEKG yGd_S/a7B!P YUL ^Yڎ)܀}do bV@dʝP5tKM1gP/J< k7 gvg&4v>Y/|Y!hUޖr_ C>3v#PƉc%@]nj'4mꔰW@X?LA-- Rs(?0w4zAk̇k#z0-0؍S=`3J+`rsĀ^cƪG5&׌j*`TU 8kLK=E~dp_lXi JpXyp83^NWFW_UƁkIS+խL,zB u)p[^f ?|z`a|yM¼L$p/ 2z8x&YGϱUGױ5]; =_K e6TNɡgSu+2 龜gT<%,iשB6҆h;  q yoA_J4s?waveslim/data/xbox.rda0000644000176200001440000000100213430347452014460 0ustar liggesusersBZh91AY&SY{ i;X:P\X@\EA*jO*45=LOP h0a4ѣb4ɉ4 d@h 0#LL #@Lb4 @44 hѦM $%)RRJ)JR(*QJTE)jXE**%TUETUETUETUUUUYVUUTJQ$cC?6 1FHn$ذG&̱!4T,H"A2"}Zi̤Deaq_Fm+eZ<6jW}[̌?*6Xn+0Mä1@O2&tNӻե̭轕WWaX5~/ɟP=O7Y)U5Ъ][V*iDCJ躬:j0+MaVUZeBBS!*HD#,f)Щ7hM489I"p ܑN$#waveslim/data/linchirp.rda0000644000176200001440000000770613430347452015331 0ustar liggesusers]X 4U&* i): %I E !BT(B)SLsc8δ+S!}~^kݿڿ}gkڋ,_ij[rG§=Μp8'kZ+7.*oFR^lڮb gLLHD z֓W>AT8x;y&_a":^a?`}v~W D=9vlw+gB ND 'K Q檲4߶Cz#KQAYi^eʻ8: S z^BBo5xs*cP1eWu%Cd93(sؿjZYSPv*%E_>7>!l _Rh>,P\jf*|xyOS"gk _3юΏ{*_݆f& :) }GDe?W),}0oʟYǃX[ir;igl ~!xeFb `4dd秽06v׃Y^0MuU`HhRڶtۤC"4XW{J3} ou]Y*p(ޝU ܗpbdՖ@,tb:6c Nޭ/5BBp$Ӌ1{ ,Pe`cMw*ity{ah̽q0l=FjˮeNG%WBx_}_#Lb]_*!)[6t ,ʲxvlZە m o`wܗ68\inƫky)"]+uHEF@"+XU-gF(EB'anBK_a_I$fnʺ{̶hEzz|dXyy7{᧑6fc+0/_fdf, 6Dïh+/>&*2_.ORaC/`׉/KuX!B5)v@!8w?}}[fot=􅙟oW&k Au5Mc~"Q=8gbs=g՗_E g@@$ K‘lvcn+^^i3T=ؽ]]'D+V>B\RhXX6 4N\?7A9J4'- k? *\ Z!8( m?,0HW.~a9?02H 9J!d`ueOq|CeCeJ,Ri\kyS#JȂQ-}"; p{W5pF T`|faMށF"XP8OeK~-9EL34 z7`Iv/#ЍRa62>17# jo# 4?^=>utP8[R@uoDAv .ҙ..;}4(>B:KDBC~Q0]| +~r-{7JR@ _' CO6淓8W2]Rjq@۶3y\-*^;k"Å]G4.A;s6ӪZu!>Yve5Ҵ# l鼩;)@}zD1GP'+\ kU#G"s#: gUAi{?.N4w>DOS*FF\\>~J㐐Ο?s#4#i]CUjl0~Mٵ@XD̦$|=H4 9z!6&P=(WM u\Ϻ{pu [ta}'OM^&,,-Ul> n Q!j*p6դ7@OFh4 {:l$IȤ$]Z|16 nz4i5f@ ^Q6RB&P>dX$p,S{ecғcWCgtqee9m0VEEOcTB,~*[MMC#S hwM<;uUh+i6MC}N8:Y{"WnM2[oqr#6;obZ5hG&fdn8ՙ ާ"Ym m bI}fp%-[:nDjx4tW;wO&fјF@.="S#150;v٨y)h#-`w5/z݃٫_#oceUЭ#+ן3m{_z""Ճ,(/PW I)=J/Go:&5EVHzd3cHQf-L\Id($%Ay3A : Mɧ"U~F+M$Xp[,`b{R :0\6_jCs n<~6T#%jwx0\\,`^]Y{Tжw@N:M}wuylH#h{F !6H!hu4ˬ>by8+4Yk˖ͻGm @BRW 0E--yG'$#H%1.|L '}<{rAَJ$csnFtR1$Jy(CˆD޻vOvp}6ma (k]T.z9O[ief]'ښ},^溵Ѥ';x(w/p:5vm-ҫH;Ps|TO; !BYo6 EsŬ@۸,IQ=_pYwazw9^n*C*!!.(fhgP6䬶)1U,bf+~ -c۸9 nsWod5>\@ Έ[ȎT z:'O-=^=@J Bܻ$U$aF;Sv{:xǕWhgM?_6J:O†J@1Y;LًNdjC%oJ{nFݩ5z y rZV[ScF_o.H]vyON>-"߿W΅Zwaveslim/data/acvs.andel9.rda0000644000176200001440000012774013430347452015631 0ustar liggesusers7zXZi"6!X@쯣])TW"nRʟx8Og0܅>_U3{@!jkUT0ʁ\v~szHyk7#,@ιGc뼌_Pܸ@sȭ_}5vvdWU?ӭ#?*ln[KA]!xl0 iլyh@f-X/zуH0qR M|HSgWk{ҕ3[CˡW2qKt'uҍ.s(#58V@`&l^6LŁ(kmYt;"Ý)&OO cZrR"^q|!JQ*nY|*)~yAZ 2$zY}/4֦_AgՏͳH-CsJW j<9gO @<6xN1ŶH>VL.>4Ѽa!f;4K,=(+ ֪G[)#eRп^ >n%br쮾 JLR:e7XpmqzC4Iܕ`vղkyC[,;C=KE.~23Tzձv5S.sǽ3e ^03r,A<}d^%:+3hh*߁[D,i ]Hh $Мllקpefrޱ^!WJ!}dМ".,r319 L_\xքg+Ӊr,s M8 ~k`_fSaKMX9UL:N c^x7FV=Cths2X'6*aZKs4QˌX+6'ްү Pp 񖨠yJLQdΩ5 `w޶V9Mžb>i@}F?vyM,/ oe RBoGC!NLoS""5O w.`W9XB|7 ం-~d h1H:ޫ4Ҿtsoo8OY? U.RmwU >F5.⽪b񉽿?҅CZgj͗WȤy' %9UnH)R0 ~4&k]))h@ކ¦||Ldb!\5-/Veͩ-ȒjL#OdzIQrQZxpch+HaX63m'e=Q{0e#w |*xb8ŞLl'/8-/*CPRVr>ؙlaX _|Y%C QGc~Ƕ4IA 6]B7!$I'dCdC8 VhjҊ?>9B%)D\fԗ0CnQc$*6Hy/4gOn i^ a$7#?$#wlҮsg|NhxWv/kI}Lvy}Ԁa&HT7Bq0սཙdwO- v;./&m4W&+Ja}_6EOzHjRIjo|wW:ظ7:/a8c"LdbK)[YbЏ%½XZ%އ?̣hUԧ"©}6ɤS=rM7Dw ᵜ9@Zp O16=exsݟK%FɱȐÈ&,UckZN ԍ쎫Fyꦩ[C?'-SW΂;Y>kDQŒJL:5ie/_d-i3Iڿ!WJv_ HFWXX<8s` $j!kAhǠGw?ǭco)1i9O R*BH‹[xqȰ+WNoUӐ&*uJ(f&0${&3F%l^t6hS@4ƚnJ`WNzu%o|{/ĆuWdx'7p'G.3:5:ǗOӣ)R~ G0 e )񺯋Tū?$`h-!W`B`5 fYN 2lN҄oyHJSuG `ү4` }RWjroq3P'@MXR55 iE "⬓5~fykAI5DK-5Ի_+.sq!178//[Ќ&">d]L1vqn(*ykEծDa]Da\ 9^Y꒪)i'ڦXɚj4b˕+09ק֘Lgdlwq׃#cw]aLgyzj^[UYr4´X r`}UVzs{`IBZ9T +aL^y2""4A͒f0Ru H\o~dqepjP8yn6űS3`:{mޛOR:{ús|sĚ::;,IMT yTL@ݡOqל]WM8VWS毢`x3iހE&: oap"4k7A~ohu:_RfB@UO+)jp Hy'ǛouuGQS~)`sx|z@׎Tz]jAǥ4xt׏ʷ"eD\ޏEd`%yP\pꊈ+' /s[3Z<3` 'w3y{ `z.kO;CYfA(*sԮ`aGI >NXՃEq۪G9-uM}p&|cƗ$]ÀލoM!?IG2vgc_[MOn3>zq_g|dVDƌlHA*xvLn, 3,!"{RRYו(ŜHcfDfH͌a;O ݼ9֣yQ;/tz'R-W_>6I`*VxN504|POY2ƙs8j,BvUFΆj}V /(=`wM&*н/~ j/>0[g>K^ѶKGز3=1RZtkBYp< UI~q ~OP^Hd#|Ҕ0E1::-~c츤 G/ } H_zW+yx:tѩ.a[>fI/UZnJNI {Irt#Vy'C/6;sf&2_+"`4tPwhY^xoWIN≜|:wC6ԷZKGǩ*8WW= QМ-Z/猜:TDɢUMr G/dZIJtzhx^we=K%wD=s :J0t!J7ƚNtVa~lK.T-:,zX:mFҴ.W\"$L@`v&F~r$/q v]ǻlnLzCʔv5bͰPS?3U( T[Բ 9#c,eiͭį>$0Oǂ^|+![8+}1TNESl5O|mSd K5wURKVBThټ7$,E stYb`ěҝl.X ǁ̡t,m 57/LZ= lWu3` j4z>rh7 LV5-tD aʺ?8e=V‚h{iKTeb?2FXa':7Jkcl g2I?&Oq YUrj0# LR@]Xެ4_Awfd>77("6>m`Y>;r~]nf^ȓ'K~~C]%+KGf5qtk>*X7ńPhy$5I6*ZwEq/zZєτi8YOFGWF'W/=Hn&ZP#A+h(;+ٕd0{Zkca{fsG.sv_dJABxq\&ʔt %ӢԜ3T.( $svȰYo $q:3{i~x=Yfdn-G{2h jdx(zKFĂ#4g$nr>5Je'!nى] GAq<ޮhN/qf/(4anGft^o{ҺӤ;谦P0![b^ʲs:́*pO6^wՁ( bSmqg '}êV oqUD*EƅΝ8cԸ鑯˷uX0}tfp 2JuE"iYv[an`ʅ!gH,f|?B?ې).̳8i4ۋxO'aqC` |?}uCL[tʐ; j@@LNG}ƨI:X9OVדF}3_K]|3r ѻ5%O1{w buY'`{*eBS!@U|tğRZr<1? Qm;uHȗC9o[v(hޅkrՕDu(/TSaŷ=;X_(YuHJ%TڵzU-XAZ ]#֯G+jG2KZ+F]q*?M%&}t&\O3Q^1x(*g`GC zŀ#"$}ݾ ŝ+SaLNG;-8KғBJL5!<"Ez*ZV`yIԪx@bnlZܤii%++|s݀ Ql%]h!n ڏJh$_`Wh8Jݲf`Ŭ}_迼wVپ{W̿*Hv -`^e܈˕4j '5dֽ csS0XHOx43=:2b5~p4B``IUoQ}2_ @t,($BD''e߄a4+4h F`+JQqlĈv |џ-a\RV4> TG\1moZeY̏hp]PʩB>ǫ91גK~LĈ!Ípj\o˳⒚YmHmbWIe z4a*`FoR-pj9/k 62! _bznwm<@}zym.1CXZH#Ee9c*ErB*s-1. Tu}o"ۛonݿ?3ibe|*>Kc͜/EFlH)%ΣT>gXU#9I<>&1F▬{wfaEx;Q3ތPK#M2/+g>E:NZp2вh"> a š\2FvDŽ((y쇅6g ▱ AWx~Z4*:ecvNF ҸmM p6HcL+1RsVo9, ޟ/IٵdEC峡VPti Ftp !e!@Eu5Kߣ Y Rv%=x`W+We|J'ux,Qao|)r;ѴEwa&51bk=4KH|-@n$F؉=Qah@aa9$|_٩W#"rة^qn1 ~ck|d*Q/tH2Ynڔڵ{W{ehv8SV(`54Cnɱ׶ڗEmek}ZѣztC^E)6l;CE"'kΩlYX!]g o@ǡpo< .шbfb\#3Wn䔶o=$I~{Θk|,N{ǟʶzuApPErh*Q!ր6!54*KL|ۻ]=zе-,5X!ƖR V}> &K9_i5uVb:HٲؚKn>Lskw@5&@rO<1VNt+7ݨϮ 3xI-]XVW/`{E i~˯Dc;F>ۻ»yy`+'R()bO!EX†OSACv̧42EP„T _4`PG8ҚG ( (/͌ }5:+i`a;k=I GƎs&V9CnWE 9A5mlJؘJ?CCSF_gKW?+/Wka~VADV-u]+kCrę],e;X_YcrҞ_(oZ3cBGmr/]lһISq?eBلIΓ<Z*<ܿI8{XZNdF'a|ӮQ*~0xZ_-/gE\5M[C M^+J6^?,'dv?t%Bt S(XNY:13qOŦIQ^,)ɨ|A$`u| |b6m=4!/6M4&gaLI*Y\H1*`k\w8? &(`Qp{Z1U@x+uBͫv+IUF8;]5e>$3] o>un@4\ a~T,ˁC*}~ NmbǰZ \1V?WiABT/k"t#j@ahj`>BG԰?|᱑_I{ 5TRy 4(OUc5nD?-᪞ -W`*b=(S-@mdVMwBWhGr ~ Z3͘1/7kC ;uCw*^r Gm]EI 3Yh랔 b=s{{!T\l)LJrՄ-#5ˢ% zS#V,òf6"q;| V٩X!Z+|mO#I|d(N'/2Jjۢ`$u>t|y{%NiyV @ Ia'Q^ 6PsyջߎE:A)2NTbx5CI6V[w %g|jK^ӢAl8Vu]?kmnkpa[**ihNld+-޽.[R€H4i0_V9?۔ ~|\G[6^.UQadV{@p6_׳]p =~,EeSzwkymG{V/z+?%-m䮾h.ɆZ˲C@HR \%LZ1-t} RHĦ7j/kͅTSF'z/-95uy}b9ӕ?XGů[7 g'>~NxIpl\fs lA05dz%MWq(]WT1ls3o>0Ժ_ב{ ^Cġx|h2HVz"$ sX0V.xJIdq0ߜUܰOgTYrq\=inHKpxN=Cϒ^xCW5C. E =yy2xO{rc Etw_iIV@,&#j .I(9DUUcEk8qD>IJd9XߊnC@j "ԀYҳwm~ lQV>4f?|JѮv>aQXԲ7AazF<"1'攺xjKL$1i ޷hvH3.3:|a esyOx7!vP *6-F2AIo Y|?޾~y^yغ K͊埒3 Tsv5}! 0 ]NZOx +Lf4g}"BOp{#ycS!(yYA($" `XS?,ςvx~ze/R4ZV LghUmc6\[ 1ŏMVyE*j~-q^mM`c m7Zh&-^xli~׊>'^&IK~X J>0 CDg -wP ZAI{xn&}4`prMMo$EN_eTfpQc@%Ўo?Pp3wjdl_esf$ m7 7ȟӗ_%Kd׌0J~SNH3:Gtl\rIiͱn6tI^ k 1/I#/{)m ΕXH a4:W^0_jo1$؃]o56z][;`N5pn@0nٷv[b8A q-?(CC4*M- .*kk(bZdC}Nm.nZFg*WoMdίt n/zs3*'^{b?M9bQ(KG'E tB16LWJԩpUͤ*nA;OQpK1(spÚ6ZՃ2[IA:b 4v bu R*j 5=o5PZPtN;ru Zj'ЛBE$]]&lڬkhy+ dE}o ^Vőwy~~VݍްƒL3_v5S?C9_nSne(㇔CB]yViVfҁ%&QfBB-QAͅoHz]-U;_7'hUXt ֦-[I Axzaf W5(rM6LP`msB1mu|W%nqY/1M@%g,ͪ8I,"` y[04448O9G68YT:f!;R=mN Q4CDknmżH'Tu7}D^4!P𘞼#B1P_A`qm}R 5H=g| !b$c 䮝n`u KZؘ>I[ǁEָ*btO1a#!d%(TI4|LruIF c\=wt !Ү @ TMW;m[')l{P!/ זf=8ѫ8 MGbYğ>Sw-; ^f@SD1-cꔵu}YZb ! o!\ ~8VBzUq)}czۼÑC=v>h3g)qzuPiĹ: Z_U6x@$0 OHoKYc9*O8bƂ#rwh QzIB*0\~j/-P7|3-@Z_tܑyJppO23 >D> 0qI (XE'Ëu3N`ܤaf,/xNYխ-%l4BV(;he=P+7f5gdUL^?Q}5[b` J a[A|I;D3V̂ƺWSv[q1n=oAZki: aN*Qc\ZP_ 1eQ4]9!ҽ='A 37H|76}ڤXrbu(rWzH Uҷ! iw[uł0[bqݤOJ*5^4>qmyY'dڂT& #j}ܺE48nL}jP3??[㻡@bs?PC|W%=bŘe*6o ?%)l|CheQf KM kc`A!W*Ĝ^~Y^OoFG%ݩ((hb:<_-#XegvYenzODgT 2hTV͒Lg B2˳y-rUWcU)5eovm1}zKr !lh*Sr_eES[*o8EFdS_/Dc/6nSz5gܢZ`yOLdILqLfa9%ڼSϒ)o<#PX $}r ;.odot&aALc$0q_8p`,p PsTEF+'G[=h7.Z X d<">WW#3?sgh.h˭D}'}T=ϓ|~/#hɬQ 8:@^FD7tփoAQ/JT+DzR`ēż$y&Zwa&;(=R_D`k>jF bJ"hl/ {V5o(LVˁ{=80ҿ ;R v+~|ĻHC"nb#sXH)AzErq}v" [u>Eiw/p4IS"4vW4X^ܪ/q]־oykd儊+Ib4AYY|Glt^|qܳ'6]ǒfI3^Ld!|[H`V%?*@K}Цp)An9PeIOr䊊^HOutTq4 |} N yr" - ͵>/ ; N]:$8ͤ"_!Ari ABu8pQ7sV(O ֎$gj>o3ZAU+d]lz4\tj>J -q G- >{t z_Iz=֍{zH!4l~r9Ɲ3d_:}Wqp) )B+-fzCWBA8!8x >ұ[HtFK/ʚڮ@>1/qbHE@cB-\.d̏L|Hȏg 9=D=9UZADghHZBSxKQp !h`:6u1n| 8fo Nj|AxkiuM?v;n3O-5^W'i҃(yC&U=gw:oTE{dIf2bx jBF:J;[g$E`9'|݉F8@ :ay?n)UCJtюsO Fo4'hDuۘs(+ENF:C0&T0u5fѣ2q4 ԩF$.?bG8뱍iʎ2amޕJ0b ;}U|+PF|(;b|'.(VT͏Rna,f-̚`j-Q5ѐ ɧrG;kƞd.Hae<.;V(Ar##?vY`69 w9 3 t:s1ie_N?Xfy2A˦0*Tʖ I/7C a[,[=ݟ쇄r& :.r"1ry/YKrΠR0M\8rUc_7 {SŖ,@;Kn? =b攛5/xʺB:?lǼ; 4+5p'Vt>FQ(:,3ovc|1h :^Ux@wR꾆5$B{@iy, >I0bԥZ 8;XFez#jpCS^}^g.5FƩR wKgW q)Ӣ~(Hԛ*߃A\?5B™EuvWlL(k mo$?tퟵxvgBIĐ%Kju-:JfOܗ%`&ͣ)Yj8Ef}Ttlvh;&A7".uZ29 k%DxE;/&EAO qcDTqh+TH{"}/ GyTĂ-gx?1 Z"0sI`wsM)B$yyAIV<5v( ZC88l GJQS6@V; ѹ9 C]y^ptL}Β;d;-Ӥ>c`|UD\-,Khrى"R#LX"dSv+0}pt SvoV H:5 h\4nhw@--7f ԇ5=}d.__:W򱂻5Y:m h =p!R)Xrz;m;rXAq6fӧͺT{jOP4QQʠ{5n&1V _#,׹ڹ<&&@e/(f/'^*gŘ](u"``r9+{E JANgXZrz,̷IKQ|tbĎNN9LGhe;׵DiE*V>TD5 &ڷ WFečH+?Mr{6p)u\Զ}>#>AlfPwzMM\.;6!D ,q.՟:;k6Xڵ8(>,V&5o;Q>_D_Zgޒ!ͽ'@R=ox,uߑ< LCmphB-݉d{(!PA=l%Jד5(6C}Bq^ CC# fl^bYg5wf1*_/a)tìJ4ͅ{3<'e:6K9S dp0w= ^>'lmkNH\ŸxT>v#^0(/(etkKW3 Ƽ~aG%14ڙjH a ]< V 0.g}(bqfQyU9X  [p~\- 3Gυ}U+DuRn(Oŕl 8@9G,-*rNƢI2-z#?#! ].yPǞaSUk]lEIET"Xx- ])TܸYYU" !L_;/t~~{.,IS%[Jl8Й: sb@C`ŃϛⲻG_UZߔGm/.p^73L<~TX7VjїoP{4*~9;fN0Nf+z U!P*Ád8n䲢 hYU[U{\BQA0 Q QԪF4z;k60Vvq洐Z&72+{Su8~: K08a+LTy IXe wŨ9O`Gm".::p>ǵ˕U[30T')eN;QC({iY$h\rB61jn6OݪM)cK{mZ)bCT;~3a*C\Ĺ!90ivh$Iy;`Ȯ)}5M yҌVhڃ*~Kv5VMQ+\g>Loތۋ9&}>"*6ϟ.İ,;jyA¼k^?5u B#ӳPȕ#C&tvr'Gj%Zf@@6^p*+FЗ.|79\|{BtTyLoFj V~Ejڴ5d$e8 ~"~+Dz ZV޸]=˾ؾ`IJhiJҎa;ZwaQfͲm;X`ސ#^i D2QId> Y@U3QTX۵dOQq d-z," a8] G+Mv|)&lw<`\y*&jd0Ď@B-4(DYD2fzyD@|_&b[QbĊp&ڕi#{E+Qsyϵ*9Ǔ'`+1L!}"U7As0޶ЪLoCA#_flz 0Wl oP7[ Y(3(a-[Zڬ+-dt_=]=f"#Vw؊'ғHmJw6ue.a)li"Ñy$cۓkZI!C39;Bz![5ECZ DY zN|z4|N3zIpoVu])//JcEƞ[׎Rz ?6BܒUnI#[N` _29 IEP/nѫɹ+} fF4;g(Kԑ ieǥtQA]ʼvNO)xkEuy}+75~Ö:w9=#)"BYRԭ(T[o DDhƲDֽ*hm$"/w(_)Ҍ''Ӳe֭ɺ^ U FyjlaTǮ 1d/ .g awϥ]| Ҍ%Q_i2b2iHMxNoza¨u"I!cSVS;T@ mז7QSC$#c:r޲iIPfbPjZl9Yh|;qlqg|W{gVܩ` Sj!,u5BcIdH{w:#w1acyR2=A ΢eN'ALp^Έ:5Af礆ͻݭ FA['%Ў _Z$H}=Q%v6" ?}@\"Fğ5 ;$Z fNu$OI.`C_bQ/;_ثs%ʑolavjnQ):^8QG0~{ȽpaG;sgʳiX'=9*o=2} j}^E@?\Bq {`d&q+5Zߟ SZӺ|S?*^J)O3 TtV&Mi&H!]`!g~Mǥhr֥S0/䦼:+(EQ؎ԡϳU(Zz*NN]ZǡFեE1 SWm:I |NzݿUc}o6.U>Px ))y=l'N ,}23\(9>.@6]T_$)WjJnۥpB 6oVR'-F3ޑĜ J# %ٗ]9P m‡O+X3EL4vFf75#$t+ZRx/OW<-uμqΕWcN4'K:xpMZ+cOsߜh(zdcn[@k~W!,Cy7ɤۗM N.B2;KNMlz~XF'1itf5[UW7lI1b81& 0]5iOBR\Jb5g?;8-W8=DcFs;4 0kqSYѥD`xPw8MWVG}khiO=6n:>`DU|`W듀F/aӒ%cu/o E7Csm㗵ߪa`? O*]\1qiZhz欙Sh].g&+=_U2B$A]"NHbιRc,@ ?+'h^/v4)mnՔ1JZu1_vLNl`jTxE?&J*pTT)VjUJ߷s)9a*NNe{b9-#gd ls/6s0~]oG ϲS'~I29 @`hDޏ.pE_~:n %7!M$:4HN9OLCG؛Z3 Ahk; J2SE+Rw- VHuϸ5s`/dN2fY <7iD/:L;#h'h`NT;K +ARE@K0Iu'(超&JIFK d-z!*LukYݐA09㳳 &mg.Iέy!t{&xŪ (E>0 rsJ #{O!ǫSTC%tyRUM uo4:ٜ$^M%E U8V14o-š)(X?(U9S,CW˥3f%Qg]QZ`ҿHA/L XY6]6jǾ;y ܧ\2tm~FjMΎfkr6P}!XɾOyTlH:(.4H=O2Lzx[o&kboԎg@yݱ-mms2+7bN^D.XYw|ߗ8 pO}ap޳@!~7@KHnC'%rxfq}'ȇE~̣0vo,`YefތL #PЃ"@6c<$ C^dgfXfE83Ё?rx%cQʦ9i/0P-q}p"R '6 '9 ƫ %45' 6|?p[v:Qʵp(|nB8ZWE)싅ؾo|zj6Bhy/.?Ƀ` T'`t=otbid'q/%`]y]խoq&V_'>jSJ&ׅ;';Og3H!FT>)|ՐTLTIk:CBlV9E+6'WX3B<L7]_ zQè<_";iz_[H2!$t !Wy.4\^KU;ScXg^e-+r(t~!_de9QU66mj"nYY*`*E }jT\HRmxZϭV7ֽUXwûsK]ŴcKwKpWi*>qw{e -yfEfHixrJGU܎ȒRm懩D$' R 4S-V5ːei&?8fFXE(Tmp~8ٵ0^}%$Q(DOJ;>ߏWĉeS9/E1Jieȡ7ͮ+8o>$0YyYVH B  `oTdE7(&a3ÄW?o02n":a-J:2 )8FV:Et%C:niOqHZ'0GFXo]GcEeR swI;ӳsi΢v(bFS`wX}ԶSR7v QVLA4,agz5DPpK)E{OE3?0ZUEn,X[fɤP( V=FcX]JloH}*թؓ$< -;:CruIժn~~| 0Lt /?H/10)sKFG81R }bc,{`{}jo?5%Ld(g?[ogeFmmhrKu` |'ɒ$֒1YnkPjE(򏻡Ӛ`ݾ/.{Ml4RE_0REielmʢ5RG ( 7">gS̴L|e\]1Yu,(x/Ww 9*5 sג($$\mݭԦW܄{2ASagĿ#lrd?>zTūw@V6QK/Buћxa w{E呮hܑd㪘 Z Pĥ8La *} ,N</0 !h8`nɊL&rՖL<>#Hh|laY#WTΈ;rߙ TRKeޗ@S*7aQ/ޢre$ :} ?c{r^kl)%Wxǵ6:RԚ!\iWW{B !K,,Sˍ[ꎦjtjŁ0t( +T$[}v7(*X;QthƳߔsA!)eV@,=MQbY^p^שR u#V{β,?'u(7CfE6+A.0e:;~ÆFO-Z)wuc+`hC,'0}ڌnF7Y!uC6ᢚZ!ߑ[64P}r_aA&:DI D GZP1=]4=0O<gf]{;xIS%H(o;d4z# X^@4ޮ%u6!`BytJ9 ^1 sG㽑ɭG1qen"WMco\|CE1&`\ۀˍn!293؍DYW`+oČI55( ])ڔ2FW9uhq=zK-Y>D<|W%"_ f 8u7t3fN-}dO~n (>ihB,CdpEPC ,ɞat^@nj|3'AA%zꊖSE4Z^ KS6+Ի< h Q9@X8H|%)y wB)߭dheYӝnyeC”Ŧ=ю0'*d^xlb NŨJIX;萚j?`x,2Zʄ>(- KiߟXh[||>"|E汙>/$uMs-v[ߛpYa ,m<*+ƚo2Նc74-\+8Op |F5DeBqZ65eb I2i#-hJI*& 8=uqY HJh b+ye ;cXˀeh}|,l Ճ! /قB yTd"8)3375϶v %7.{RYw@*Tց>[԰Gm8f`xy]eA-^2Wŝ/x~Ne3]YϽ&.ߒF vڽ"3˻yA}߷ܣ/z%z_WEh~l;5~=ƣ| YWN߲lh YC1G,eFX&dIx ĥiKU_^3Z5@6ګ;y :obJp4/yRM,.Y, P bF'3{䫽 qNρ3 "u\ʶ Uyϯ _+W3w[S |Ey'7Ķ0c\njCnXMM\H=Ck)մ؁vOq]Alz ܹE\:gljzN7c)rgYTH{3oR1ZF*^h/[)FDJBّ;J؅zᖵ3!9Vz؁)0[T&4b+D5˳e"139=+)F2|Y(U焎 (mR5_|Xdg=yѮm7z9ҙn&4k KTZ-bXFΉKgB/xTd>-lN*ZuԒ2Nyލ!+%T>3VS*W:͞z?)u~ҞyJRR$4e κQovK{HZיnk"P! i1#0T/W.,AZ%E"6ʢm {Չ3æsZކW08@i.@3b(urqh=v73״A\q\FUn8 2wt\Fuz|L!ƞ'/E(*kʼnyc}ߨu8c]p) 65j0-8"d?fM9C8(II>U!9 aUܫص|}!nv,iCf_G+qХ&1Sb(zkK:ZlfxOX-M?J%fIq^?^❥Xs/r8~OWO0K ro*ܒ1Ьc+d67Sv]'T\ }|sl;k ]rhgOh.UD낮ٶkV䟗nj8D T`bɲo`;y7(6TZ4Ĥ x mb}DOy|T3n{Qpm ] L0-:Q%p9`7Byf_;\p}+o2'=Jn@%[~NP+)>J5.C\Ԗh==mZ.z]yi<" e!p}NdQX[uOP2! {aMonhq\pKX_dTS4.{rIA=ж?!*S~ig?T4pu]#B8KlF!SKA f=銸ﲺwUJɡ+aX6{@pڈpå$~sT~Ck\,+왢ZuGhZ5ȾLδF ;Ɔ402у ɺbZșttS_^4K4T<@ G*sbw1$ y ,Ф ZXvݐЉ?O-_W@0XT )_2 {"DvC&?_dZ4QL=羑*ٞb.p[=mwxOgtf#P.Ԇ=駱{gA(U^Xo-6fo>q4-[Jԣr1BҵmǺ΍uTǧ:1LLIQ+8a׳"n<M I7"3Fr!.!**37H \í> 5tUQ"Q +i脬 (Xs%fq W)U.8I0(+]1l*v֥Qo#Fa\ZuJ a9}Ȳg}i1v1ۿqy)߆gifN< 'Nk³slbr̰(.db }@@}o@Ca &asM*ZX@PP u\"iVgE3O.`=yģ4f1FY#RҨǦh*^jNY09ڗe ,q-tA)2hfe-L9Xx9n_.ʂqu@2&_Gn; N *P?` SxPbelЗ4]@}mP6:6CtEP>6 5@؂3sc@*'w~)o|f>.݄[Cۦ;fP[ tkgB4.mg9K @'BQyq+ C<݊-ye|CNViH.1G&ۇ*((K?,A{F06jeh>Z4d}5Y)<} bUT[1^1} =/ďY;=3STjJ) Rmbj9N|5@c߉%&n=+!~44MG,7Wb,(t#2%|GO/ gV} 6ÞqB@9AADf" vO>Rݵ_nU Ax\>~gLw|:x-!.Y+ByMj\l b&AqOѼVܙ挅UpxJޖ=*~' ?\ &wquZL+G9&;k" X!ⳬqIXk$z:˧Ax`ʂ7Sy BH9~R+pQE5Һ^<D0^QH1̫@[yG!Vk>/(rplleC~w&?lQkG#yHCc`뤪2Ηs  z*p+Wܻ#S5Ke[[v֘\i <3Vw:׃zDl R-TŢ1prq8*Hի=@`jl6ǵNGRnJ Iկ.iAoQ9bD0&$&WVdj/*մPL{u]/YK0wAe?U4?%LB.4 ǴD^QUTw3LN}vn0{C)?{c'{mvkr.N|J։yv:ݰ5aTI3o18]gmΣ~ՖvY;!*M"s`%*rg9 <ћHoW5baxUqjf3ך c)^9NS^25z># mNj&HTn\m ;2__SzF:e.S?߭iHOC=?AH0#ӭ R[Anp+ L#57Oo#@,(I KEujiڴ.,M+`B\ņ˩HkMkum&ԧ]k i'XQS:dF>԰YFV3$R*I?d [l*nInrpnEg͉08V9Up(@Z!08Z8Cq߶;SJ!3q⨝FYf.Q Z+XT~Z?2!{Ч>|+Fp9:6p|fCW2ltɈխ~Omf[dP]⍺#$OC@~ɯ8T+GiRdmm,Z-^m5ZUwt*zܘ90/]dXrhH>ϼ%1a~ݯ Hc +QA)+|qz0*;8_㯆 J4H*O #A΃Ha @9y~)p!,2tQ50rGdu"DE$#?IZe}UPA[0+-ˆal2f2+x l:8|O* F==!xRu7Q.>|I83 טz=\YEbelB V;YfI{p73Vqrk|ܛZtJυxcEBWuCZ>uF:\T)[ 0O94$d::uʎ&Ֆ5%auf1Xvbe!rz1D6alܮ%dCe^ ^gq1o=ut({ouZ@X`G\ZS''Ȑ8j]&Z.zh#ݑ(7_*!0[K->e M,vxUtXoq*> ~<~S2|je `ŝ|=;حs!9U`ݤ~.1/4RWN7wIGWA<Ъiys?; AdmjԈr+kK÷ôzkv&0YHNJgCփv=p9XEa.ʻc|R` f"TmȻBL YfBG"NpF*p~Jis7֦ OL#NnSrDy 7(՟prwZ ! wd ˶1pQ!4ERi2'fN j,,By(J7LͰ\bЧ_¾x9U4$ 1+$-2zw/!9E"Ȧ l۵jp#s[j2%q*}ܦȋ(4tA/d5}Sjitl3=)ws7#\_,& u˽=9JGUt@mD6I&q d{գo$^ͻ"n7myIX^s48C.מ(&z2_2kN؁3C{恞Z# 3 .$j4&: .Z}=˥zw= 9%C :z WtvmosyPeTOCRZ #eٲIq#3z\,}eFan#d D=nl JbvO31;&Xb {I =Z5;DY_51"s!`q9=)tƗ0\n%85'(@LO"^*Vټ4}hI2χsBN_ 7ÎdGP" ݜ Y*jo 7ZSpϬV/d'vD.wz]t% |<}aז)iN!wYNI:mz glŭUb'':-ܪ~k+SD '''Ѕ:9uT 38/V3_0,rkn>8n=;)}+uB~|WM]@ pcٵgn_Ww79#l$;3Zs^_֭wёBo>nzDh0TZ<i,Kfēa?'۬bR1fK%B)A|~=$yb6U{2GS!e:"chKZ~ɛ(w}l>d]1Jy2w!uSZ|&nq U;XuQG.Tm[4n)Oe0Y0> s{z:4-Kb GhJ^yWf\/ƀ0l˯揦؝dI8/dee͈$1|B9E_PMYPZ910^ n:Y{۹~0.T51{`̱U$R9mktޓ6h,h,]}5Ʃ%,S{Fl-Ajv ue-7'w8Nab.PnNP*lڽCV9I׀E9;n@|mE" dAwc/Di: B58x'oYlhD5X+@ش2ld7dt!l+n= r"zBѤZ\ fdˉF~SgtD '1;l`7eatrFf0u΂|bWΆ Y9GMK(z)p04j|ַ |ů5'_'_nx \ @Ekʓ`0Z;*42dyV=1=˓Qطca?~  \'yW {tq4`*Ű{F&MIlbtSQ!!qI"_%;\Hܮ- O01['Su< B|:YA!P*{\RY\ҁx?zK( r+KY^se'Vgd/)2egQջ$\>S O}( 9 NRܯy3uٔ"b4JTc&D2gba灁g)*La< " -lã#Ag%z.jЄg&[N-3A@T( 4*o~d3N.+߶@ߊ>5RFIF q؄d*{2_z1+ 82'µ'l( eR|'Us?iCq_ ]V`8ƊDQbG}/}4)L^5qzwV0s,](rϻn [O9\fAo}Š@ Wxط#jNvEp۶d"/uI۽Q`1=hi $ò)v,p'j>(zZ> DHG\G;0%Bh'zvG7Ǯ{%,-ڏX3eR(ɿ*{mcP .< &bV4mf=YwJ/#NT0F2dE*W* 1(DZ&W"SB*fYDl>u HՅ_fgf~ x#ɱIۗTo)?_Y̩Ug=KDKRnP(ʥ9=p,|L^Sl6͈;R/|NTgH}BEw讶~ce\8ESpLB4dS ~dkGy]ִx T),C7]zXuAOk%XD8~.ŋ[mw#w_FK*y_cKU& VKors[%Fv%b)K}IX2!ԵU">8&J#"iՔQù4D{b2zL%Z,BoK+QsyGH~p"y%a/ʬgT)ד6&,L[ox/uz43ތJSCmmZFǂuX?x.#sCy`љ$?DbL0M}PC +7ٛE'^txR?nFOAG 9R-jw͂/z0.3!C_8Uzqhh=%MW>F ˧6ʞZj5hGT61PO(hW;TLB 0ɾJ_xѭ[ĮMc:hտFVbb+GU—%$B.u=(N~]6i]ѩS̶MlSt; Tc:sʾskU-Y ['\HJ^C,֦ 08;VqV'yTu~a6YD:\ s37*mQI'¦^A4i),o;vu~ {Əl(2^Ȓ}B8),s0jeELBn{c&)e+v 0>NM7'׿mtqSiGq~)U s£ o}RZL1=bDt L~ű VhvUR-(ᕱ$ |F@%a5*- V+9UqONs8)obPq=J!$HS7Ngtw%-6>'0TU"hY,dtj,y"?2C2 }SUc:fwΕ~lo3&3UpfJqwE_4r8֧v'%~lmFF ")n>T7: :< s/jA U^xŠ8@C?Z"68%;(/=l1XP-3P)3n etYacJB^#h%} ֟Y3tj(~p,F )H÷|9N2n,^ =?LA%xlr˹N Gä K_f|_aO_VZn1.cBS~XVL /c֠&j]?xWByA^6j'U6P CM C:f,&V:o-/JZh{v:!|u)RP#ݟXÅۡ4IjǍuƃʇ^:bh"oFJJ228\|"=0:O+`km Rl@w} QfrAgiW8Au/J'I3,0$&΅qù!.\RaEU^13 (Q0'lVR4l__#_$ FIc : V>ɫuNDD+![ꞽ%^& JK-duʖ<*zjҔG0@e&|tlZl8 N/%~_J.+wsKwvPdؤ/T!WxȓLXMC }N[2{ ݯ˰p9( yήz= >J0frcPuT ==M{,4+Pl;kWbCeWn}Pajt%"Ĥ;CJ/='CfߎFPrY ͎:1S޲\N8M@2gGꗍ^\VBC, sc} os^yq𹞫tYʏ+\0Ƒ ZqMo Iz:ˉL)D qS`%jԏwjT׼O ܶibڄdHzuV-{e,|cxk9[bAҔg-huC;yTuq'R>q-a:j"#ntsTBK;6ށ-uHuCv(#쓆\Ȑ$L3I((#uɐ5 L߁7uqu,xt "Ŋ%ꦦ +//W:;O~zJD>Y 6t-5!-{:"5Xg $QYK\$| 6$ ׭Ǯ4hsiTzu8 5zJT+ލu=-fx+H>'a;b+-YsZ@5e[>?%z9Vj2 i!+::8:e }vQiRiF*b/sО$'bNߵ%IF\nYFìJV6Yeqķ ^XϪ!&.al9{f3yqIN7is\ eP黄GtfmbF4\րujUQ喇OT7c_P'P Q>8nF|h_ І*" fW]%{r=f˺939SM<4MRĭ$.mґdAxt:XK}U7Ŗ`{o%8#y7egٚyEcxCV_DYzXL;:.:jIZUߎ QqDȚWzyev+ܨw( f]iI3mWuFbxGpn d,0;8re)4j5 6N˒D=6c᫬+/RBT{o Hld_rh_RDD^>Zք{u5ﵱoϴhqy:Fd)pvl 9NnHݧ#qPv،xct  wJqO=aۭ *$4P8aʹ eZ{p0 YZwaveslim/data/ar1.rda0000644000176200001440000000267413430347452014203 0ustar liggesusers- 8Ti̸3fHhmlXieu"e B(.JWRm>tY6VbSKQTI!Rb'F~߱yy9yg_pqa>#03|$+FDVArwpmu/i<]37Af%^yGqT#NCUK@`7omxͭ% ݿZ{[6B`.Id׆aMfs;c7#Uuwl[W,ճkݐ:v0: j雹Y#^Js@^|f4놮 ;u^#B!M`ȋgkw@e f> [i`~<(i׎3A7fY[;8Z 1~/d]b],/nZpczZ˘<|'$[W헉slp#mJB7tb[c;7̻L>W]q4򺵀`ޯVI9 '![S3 }- u}aaͻ;~۝v}_CKӀaGܲz((Ɣą@0,Z &Kl|]׀x6g9ւ>U'"߁NsT0'$])`yNB_ Xz.xTǬ!rtŒ`[LetR ySCƜYe[c)GM$+&2`W`J%ù`%Y-3`5o_*A]@z:Ai"L?0:X=tZ'l.t9%5Rq܂*sxdu q6HYi Y  @l sE` q2'Zg ~;=ݘ##D1{!wZwG/Iw2#7iumYlO.q ۬XzpWI Nb{ţz&Ʒ;9p#Hsq7S~k)u˰FQeg0_^-PÃ8#G\IHYJ@=l3'&p#zɿBa {qs56Rf'j- RFUkhVdV-|oBWR<2hk"; ,,eېc5H]#{ɴH>3(9Y}lrW&/`6q$ɿu!ie?=aNZdZv+ F^V4-G/?Q^gI$q N]8 H֟w,2rh"#}ZMAgG:%HcDΛHȪ8|Re"U})r YbϑVuf[Ց4Tz;HXdq!TAl$ӓ\zQ$?Ӥf6arwaveslim/data/ibm.rda0000644000176200001440000000116213430347452014256 0ustar liggesusersBZh91AY&SY}q@@@@P@@P@xfo@@@@@@@@@@@@@@A@pMO%=' &iMTmM&@OS0`0)*=z6@4 R5?n*^}WgE_ZjŴ.vy)IbɜPs|lyf@]86\3VL#qLZ#8MC89wtfusxQܦP~VJߞ0lEB++b+pJDK\t[e@ bZsжUjE'H\u;lihH_zll[f}m[Uʜ}vl,;7 9挑}eQ ʹMe&SU9u= [׍˕=uY\˸ޢN˂0t#i 2tэ@U9j77 pɺ9l]pisM 7*oĒnc`n\T?QWL>{+>M ɟRMj`z_—ſpӃ 4qmS<۞MjnK稸CvBCO'7JH͏sܼ_UGLJELC\9 We6\>pɀQ \yš\y?҅+_޺ߟ+m q`qOi,=<:^~~G #<%|oŸ ~/$~o@ ~HO/$J%=IB!?o?#J%?c^~x#> _`?د!x O  ? `Ck`ƃe2*ghFX^>}2Za6X-wYVE`01 ?Ӣm@` fr{"|@m]-)=f9/ۭ߬͸囚V_N睠|)^ hT'u6FiM}1hUloObցO3@>+HQllGЦGw_ڂuUk--<ZCdxUi0.H<-um׊|S8hxղC<1U5N+^T9GLi^\sʘS@dh.ľx~lx8~nvh*L\V<ݏ<(dq^.VWv+==8~+N1{m){TrfO˃K/cOW:unu1xլkڄ2Wmi%ff6֓+h= >sL5p&{uѩ~9{r2P}V[nɭـ׼Ҷh6p~ -`ޮDG!s󏱡ߥ8kα G5lxqng9^^ )/u>`w xwitpjovNyNi=GytTGRGRCx~'KxC|'K|Cz"}HG'U/MzG?zc>k 0; `>̋0OK ?(`>̫0[ 0`>ˀ0Ok 8`>0{zڏ|zG< /ďE !?%B!=Ho?#*L& D"ȏO+L7EmeN|Eӗo [5ru7djwaveslim/data/exchange.rda0000644000176200001440000000626013430347452015275 0ustar liggesusersXwtn , "R"(½" !ND@ދH4i(J7[ށsrޙ;`)iI&ͤjZf֬FMiz!mKw&e<3{:ۺG8NF?nm咻m.?1~yAcĶ213 lm@#lk_5gZl+9w[:{Q܄ikt&%r)_isK׸Ta&(X>^VzRcgٺ&I58q}gZ|ִ?֏_<[g~6[^l]ZPXfbށKl] Ԅ|f~k@8'gMǯ8ێo3K]Xyo)*O룿 , 9?UaK!ޟțnTcͭU[f# sؼEq!S--tc̆oz~wn|MFfSߣk%lڷ1ty&SYEfcsNill ͨ50ͻw=ݜ{vKl!76HS?>-/=ºQ-85(|YYk7*z2;.|lMgj.N'S.;WVfrVf)5Ma2q5M\kWC ~o&֎xyZ{zфJJTb8"fuTe;%L(xzKOQP՛=(Kx9Ѳށa)8E;;QW);;POl{:xZk2P , 3J'ɾWhe*A;&0(>vUwI?*^h:u4p""?בÖ|z*gӐcgEDz.۶ =:U>M+U/if]'YTu_',˃{leb$;uc`uzq\\Xx>FcقbY:Zl1Nl}-KByͿHټ'hʽ17*0Gvy# #_[tsxN3K ZUQ#s(r-Fd#yth;*)xyL:@9n__|©ʼnb4WkEjF~uO՝ex; OV?N9*RѵgOEjΑ$%;_䀥@P֛O~#yK>96'ArW_ r5.  y@Eh;P˯Q!ȋ90;~|j>8Ž}"J~՟I{oȄ~۱vKs'1`ۑO|'.g&W(u֗o!1%*#ib b֔"Y@ȹJ4J *|C*$B9Gw]A*.G_ XfPo^9 _ ɡT*:o4a*{OEc\֟ȃ-T8ۧ wyBg|Ǒ@coEː_7T~ȏ)(a%S(x[!|kC@_Ff,qhA7t߅D>8SOP5G H S3 L3 k< }.b~T|~1j~>}d>nοRzQz(>~؏T43ܓ^6OU_OUrFs!WaA)9sC]=a?$#Bu'|oЗlP}h*{ye-- ~x 4+~<(}**Zq9#v.>WgR4~ejJ.%>U ;覢iL@KQɧC >|| B; BŻ*>UWfX_!pB/h+P鰛:ҏ~ˀ}m%~!3\-8Pz]keP?8Zӽs!{C3<=c@}1x3ڀ_Efyq&BY4Џ@߅\ ㆾBMiӿ@7g?+SM}I%.^+>LOj? s@ =X@=ԺspމN{Iu sSԾ }ȟ+ uu9Iq¿/z n2pR r#?.tqZ7=e-v#{{EcbqA1Uo}3չX O-nz?š/ƍw^Oj`CŗOQDSpDuGeǨ4%H¼I ț8?_C(pB\a_Џ) eU)w~inAl/`-,AG,D2]<׊_9]Dtx[>:.=b%<9_yAVg5y%%ÕkzH;?_M]iC\=r!waveslim/data/barbara.rda0000644000176200001440000016144013430347452015107 0ustar liggesusersBZh91AY&SYt| ) @DHH")@A>}  P}еfNݹf6Zr˻uY,ĪUi33$[ DU6ŬÑ!lbb֣ ksh[ 6&nX'0ۃsYݷaո7N`` . aa9g wEsupN7 ɃU ;pva6fmuAs̻v6;u0nWqaۍX;qn-5we ;w..cnqn\s]ssγۮv;wvw;k\fM6ͻ6bnnl휻qT"(HD$"@A(@!*@"@PP@((@!E!TFa2@ 0 L @@TOH4@ESL4h@&Bh*~4ih4bFj6 $JUT# щiG40Кd`0L&ѠѓLFɡFLMOI144=OSOLHzbL)xj6L&52m4j{S4$򞉵)&k6+tQTb65EMڍ61F6*ebX`lY4Z6ARm&i5¾%UOg* Z*LbĔlmcchFcjlUElj*J6) ƿ&bՕIjUjP}lͶ6L$4`IbRdQlQm#V-c))I"#)$ѢmQk%&RPb IK_uh:^K OHy$xZIwJ*l–QEVڅ m m bBD| $iɢFF4Rb 2),ƚbf0d ɤɄb %TmVBUѓ*2FbX(Sd(qd (siDAٔ/|$9(|>.Vo[Z[\ٛF5D$J2jk]-yNkλO;v9;yu⼊"XwrJ!s(A).E%GG .H\Pvկ Ci#XEѣdb$)Bj )BYI&FP hІY*66fִjmUl,Q16 T3`ڶ36MT_՟D\I.aQ:_6EUVmF4IE!b3dI21`֣k%6A9$/8z|8em8e 3QjDZ6*̴4m\! c)M4dP+ILLmʹ*Dhƈɵl;bK¹ڈq'vTC {$\J%QtVLDQ־4I hъ4mIbEQE2& MbLL3$iAĀ&Y$HIDmLhє5" cFbZ6Be#E@!S4hE&(ѨD5JjѨ%%$YMD1c( E"$Q4Xz4UB%"Wkl6mͨ؂ԻiQ;;J&9;u;wmKdۖbfwWMvYw;3w\kIӠd8ܻuw`wKsn&b"5wvq4h\+rۺkkcj7*lk1ʮdlIEs.ZEE˕m7 q"Cd RC]*Ukb#"ko_GUCԪiܕT⃹"C؊Oa`q쑊4e64H4Qd#)4$fEFaLlPXJ!M6#R& K P hL@Ś@h&ńIHJŴ)j"4[lb%HF$4HR4 66,b5Db+!LJ`FdhX$$i H[Z6*jkmW+ʑ|"%!DOor o^"6*;MX`)OF~ؿ 'sqR2)=i"fti#L!8" 97r9ݠ]EE R4r_T)%Qt4f#fG$ % n/.۽0쥵$ J|Wf35S$U/" ,+#+H^D)DS!yNYWS9!:g ds19MdZ{nX:Ėw0 W$p:"i>p6u%Þs}K kG7}JVR.Uh@FNHTQ yЅ !S o ́<[ )C 9 [&**J6pJNIyJUl3FrRjb!(Qg:I12z~$ LQ0-hf$aT'eg0:^jP@YO!AQr2ZP.>-+3K#@~D;i2QIf NgnEOKY{m&( İ"#5Y 둑*ȄZu`J.TQS0U " K u-s&xT AJɨgv+Cd$P/ QH5JDǍadDyI̟ ac ZPM—:T~IGvҿ9p6:K=ʭ@"qD\\;e6th LrL=+I-ԂꓛWp$V'mxe3Bٞ+R䀨˯5>jw҆BG% C$Qtzޓ$=J\Iƭ88zRnB8pU2U+QGiIܒo"#-9IAZpbU',>l8e)tZ.AAh0=ҠPLyӞW3*ťo,K9lieFS|JHt>uJ0#ak޾7QF/dLH;> 3iU:^fH GdUu [ "q1!|9Cs-E92c\ JʼnPDYTIrR@Q,5U\V9DA8/-x,[!fnl8w+S6>/k7w?lw@o?,]\ؖW:Kإga))i=l3-}Wf0u*pʳq2S ҙpΦ@u BY3B2aJ#8C-]n-RER^WmBђTJa+HuY!S`z;XBYSQ;yzNۤΙey*{P|2Y$HʽlKF/nZ_Ma3tTO}6;^uۉؤ$!f撋unHkj! b;~reZЫڕؐ~klIߨ )m鹱JH_wjzhM!,*gj+6 &#IkQFD rj%"<(" Gdi6[n-J"3DAdii8Ъ&LS/9|ٜ(RH,_q5_]#Uõă=kQ p7.τׄ[3QvN5BkjAZ~ԛ Uh7,3@:Yg|;P'`6Fyl5ԁ:o>+r!@Vb&[ZBPóX-#f2脰xcEqܨn֛.~(Tk{`୯<8:]O2fC*E9zܞ~ ҚcLS+|0]98ZZ;wĵhfW[AcdoQF!!dӏ^ '(]G:T|iN{_5^IYջpjeem<ne3G@{qjJ0]E"Qxg{+j\69`d'gsyO-y|Hqsm*S2X f5緿B\tU_Fyɮ[p/)t~]=$rtyoz'"0"&[L{O10M9DrE[㩕W}hһmσH-3]T^^XnAxK#\vfKiCFZ;,$6zyt@"Y3;G 4;2s 1ַqm ;\D+ĈZ`r!M&, CnTL$ %{{gz^DgA v; ԁ+ # Zl4e)ta4d.L4v7Uc<ΎbmO9>{SNƔu`RO~֓G1އlu.@m!nA$֜YDdMyh0 |-KZ 4_}Ve;Yo|i#}$+wLgcG1.82l C9b6ݯ {N٨%hѵ~U 1{a9Xv(*_i.m8~LygY@ʂ*YZfֲd>玵qVmꦙ[m+߃'O=rC+՜QDV|%x ; ~\ZM$5N,iOJCHmI5)^p7:XB`Yh<8ܼhYXB\\)MvUM0N' r3Sŀ(_'aJԓ\2WXBxTl"8 CdU}P d]O&ιZjkZ# et'!_ot,:QȤ\ Ȕ(i%h+>`˕z's9Z8?k~12"_J߮˞a!K0ە#67\SUVB˱:9@ڶC;ԯƥ0 ]V3 P4vKrU1x[:2*^G4ͫu1q-kS)h y]~'3Ϸ9\'kqr!Qx$%ZtlR&#ܛ=pY%RQ!!/p[ ,8Ǵp^9<ӫDjј7 {#h-Fs 9=tRfPБ_YLԝ"O݄kP%8m|5 -lj]rrZwCƻC3ɓ5ݝ{4=sk@sF'ɪ|LxHtb;n$7:38SJe2,/Su)@Cӿ:J6 Xׄt Q#5Wцl2V1 0VQZ֭ZhޘbK}N1yқ0IJ( ENitb2#rݞ,goEa+,SGY=>%ébcۙX߾ ΰsLPfyy8h h܆x+b" P=N$UnUwus_FZ߳Xi4o{]HYOYrRw+ &?f3Ѱlsxy9S ~^Zf}!* TiБt^{mX&,I=K8WY'om{XEm{1lnG> 5wd9vۂi`ٕ:80lgTή-BBVuaBDEDYJPI4G O=y@nT}φ"5Mb=X`IЅP(%9w ڜܖ}o[)ç~UB KvSM;[V{6[HlCaɷ9QtC؀:3 mEj*B |rB~ LژK+JC3lRn>7NJ_r{ؑLqTw |fq.0m @: {1VBTn=]iL=_:LFNrG7{vΦբᎾ,6·nNusR-5f\&G<]$p'W ive*yv PܳM[h+`6}%. 94AF";&֋c3v:\Tmڹb̺TEDGPWnug?i\Y,m.Y@ j鋺!]h n >TdN㇞!Jbpj[0Jy.pԆ 2,I*s=,ӭaŷ A.dBCQɗS9:F\Ac}-KTPsX^/xDְ2VSc)2;zFf=G^R2x捠a[ Cs- !աS(dޒ +m"Ƅ\Rՙ{ʎKE~ÐvC]ˎ.>fa %>B'>kVDgRcTvg+]&VA%LoE]=r[[W[R iۀk-}N@fBTzIޣ crY} |_0kmu Ukžt"R|xɺ JB&r?Ep@TH"KU93jTdΞB )$mI+3РL3~ t5RdҰ#WLȁԇb~`obKDwd{&j<)RC/4Ս/,t/9zۼ\+@0aٺc g rGX89,e/Ί.j<,c8Z "7:pCN!,ًTR{EYɫ'o1s0J;z1;:Pȍ QDU0 <\ĉhzeTDxyc2WPBjW0V"U:Ƨ`RiIjfRfNmUoat՘g-qȹ7r.{ӛ(Q5͙߬bsa/^l;[w؞P-f^4a+EYBPnL=/TC<JU'Y^Y|v{5Y{S*&4D q~$T@=]c}}8#$Puڎ1b#Ŧ")iڦ_OPN}=݆ xN\l'yPcT% &Co\ɋ%l2~K4YrǕ*_KStҜacd}M'8#b* +ceJ' DyL XDf^(tP婗{QAtDyxܓX syvxrY9h\jz>w SUL .79Ipzh \Hth>{|_}:cKS ƍ$>Qktֺzu?#Tp]x9/I;*0bc~cz؆T()~b3uW1̧24UCC]k*pWf5isluvb* ~|kՍjxIPqW\LԂyVeC'$ V4w$6ms./:1fn^jF1KHĆD<lCE qǜ=UNGؼu^웻hG˝nHIuQ(ҹM"sk *_&Ot5xNdɃ;tH|!Z\i/- >kagdžLcsD,mq.Zp]@GѾ{-ʁ(Go9*&w0,%bf PO{d-sjfyQH i:Jwy3? =Ysif>kT V'*(yag4K4!E0s-gEZJJX)T&e )`17izM :;1JL^"B9(z}.!eq -j AOױXM"D)3!K*7Uټ3چQZd845,#qKTRrBs2y+VԖ~_~~/~ #Wm[!Wb:]F6':m-]d6.$}lp.Պi3&7ڗH8.q@Jam;WYݲ  ;;EwςV܆V+XK *\}*m~Ũ)O΅>`-fai#YPY%( Q/9ӻ]5PW;.ӋoƋRJYs}ۺiG\9~O5Uzu(DNKlmV=y02O`7h)J%JGNQ!s;UDŽ"[k5 (W@Z@%/PXK>lfii\TjF| h!ūǗvkTѮSJ KNS9zڤ͒^0R+^thB\v.~B.j1WÑub:A\$]j3` @x$.]I3KqCܫP&do`M)0R_}"5ʡiB,Ɣr.ۦ6Am'Z-=ϧctbAx.D ,CoDWc TT ;; eYO>iE!鍷| _ 'Cu4Щ;N,7&sgÍ|Vz*C6~ھ3< osV{gwgwJO.zF<u].A V@@^2w À=2$ erH˵ؕ1X~RwX ӎW+51<تKWq-g/; 2NAi4H+ $C 8g\ u0xL;p,w}<34FVv*m{JqΝYX4>-wpM19? bz$?Ozf}H aWゥȆ+6$ 18f [0,nT8"zoA7ZZg( ќyU`$XƳ7=u8]"meI (j2Ac`b :"f y`{L[5FB. /5uD gZ@fFlCMѡ<\_39 ;=+X#T *nf.LQ-R4ԢKjT FP{sW4a7+e PWi3 3DUz©fDjZax>Ka;_-||ڨyP|k.l7Z,Ss./0ipÐo8-PȚ 'B¯Fhh廸?[7·.yC2sA۲(fدNuB 00Azܭ~R1w6(ȾQ9/ҹرmsKeyuQX+{̍?%iե++Qk}xQ\c.|\´c NFob^䎵6/ ;`^W<lNڸr^kVŔ#؈7C"k##zmXw¨ü}#Kf Wxu˗z8Bo^F)W> cրuȮMD>dM\WWP-Z;R,GfFN+&)!} -sݸzkb3l'WN6"b%u3R\'[Zj#(ifa3|PµI-0ISp[|;L' (U~aza;QA]ݰ$xs=Z^u^yNR̴ tg>{;D͐Ykk&3КtY@+9~!{Hp:TDyٍ._5vs0bzô';QGu:Ѫ҆0'o 30!8w!p Ǯ r[f&3tr mc&е-HQ-q]$҄=E4>sjRQRXg֔*Ie OAg] {c\ĐSuV51N-H1d"v !4$=M6y3ӐLFJD隺ʹ w%\}ytlb mX,^˩xO" ~^ӓZc=yxiD` *\/dUX*~y"-98lP$p)Qu ,CdR(Yq8X'lgP /1|ʾ?>?kFR+U\ ~qF᧊!xwr o!Jo1^)hrerYuX\_~=oVtQ-7/h% (Nߢ FR i P sdr0@GG7v{ &NcSVR,<(2@vSȏOMX$VBB$fAߥetb{5lS8x=5,uBL%Si:S vK:vL1rkl$(:k6EylaKѺer_)v?MvPe.}u-RNVӔ| zKu\$qH~Ķ*T]Յi}e/RէЍߎk0fB 1٢+:Olن < mW1G3e8$ S}0Xv#{uA  =ܛWV-Px _(\Qu 5I0I6Fl'=/S$w!2{9` ][չs0dazrVME(Jzͷ?v{y!p(bh)GcbM:rlE;Es@XL~!|T n[4+4~Xb{\ƞ xsr<T#LmyL@}쿩=sVoGؙn,nt'[HR n|^ޚ7CK8{^ߓ@ۿfxu4+M(> ||lx4ǒVӪHT߇7@ ku(N|"fmOkİ &G8N=}r߬ݾxz3'v2ԙUQgZ/b: |δy"~l&-\{";Y}_Dݥ9)!-9\P5%5ɱMqH˒Yz7h![,q>PqSwl_̘qX4ͽn/bѓ5C`]V}1&e鿏u$;Sݼpn{􊢤pOE˕nB]Em=/wgL)*Ky ̒B{W 06j$.@xb/+ Y+5-"ry##ɚK0b|{>ls~yqAs ,Ӧe(![%F$= "vۻ[nz}x+5Yq_[ayI-I^vqj|xMLN)%A_*mʞ5(CHnG1vׇ~ vKX+߆Ŵfvؔ{z2Pί=>p@ߥPY6u&eK (ZsF\29&n$J摲j[""ȭ(MTCnZvJxOXdAfŮ hMd#,[YQQ;1XnmTfs#Ӆ ~KuAB 7!Gҡtoڨ`w/S܊ an8T!$B\zJu߸F]M~ ~WT޴_[.oX%ՉtQ ,P⫧8uGmc޴&Y2E&S(Z d*F/qץʵ*qgz޽|)nd>ct'7;+ٻwRC z`=\m;NؒsICV">k#">UΛJj̠ O\QMI"5#\(0 kQ,0|z6DY()C'fr'Hs\2(->iI}ʖaa~Z먪)Yr>,腹::cp fHh%{Y'ƾ)C[Xm9E1ou}6e+&+  % *F W@+)GMKk3 (ϘlkF6٥whD\OvlOi]y?=VX{T쩣q$y=SN$2Wd.&Mqm dڵ:.x9N@,0O\!jsP{xLK觭?h.4hFU;0eM2Rc?H@D p ljD/\[Fk~6}1=nKA+DP8C}ש7pZjz4Q17U;A%~+2vGvFa^q;f,G!nS+W1gZV.N\TfDX_з79|n`΅J>I{Ԑ4}" X0&,y#X*ke4y,x(\]!MUZL|+^QPUTjBu aB'VKJȝ-jRmOUˀ{jNPG=`cA%xԆm|%axj)..5h qTl|AY.m\k0`d" u\X !;a5t,ďj`NH%T*`ߑQeD4kxa91Spm4 Iͳݑ@5$)+mw8%kp,`3&cJ..D O \TN`UW/pbw.i;Tq$B~6ݢ;qB4WMdrHs(UjVЯ W߷o~ǞOKxJ3{2WťO4Zg!A~=%oXT\I+WuwL5j–{)O7)+Z lj: TcwexTΞ7s2T̟eβ-`ptV mBԈ%ۙ*HQ;ᖸJ~K92 fM3XÑ<޿ӫX,TA[aQO=Rflk?֋=Q/j QA!vroS$6БTX߫UjĹllG0..褢7KX´g06,R*nlL+f;ˏ"^%w#LdN^<\3WO IWkZW7=3R2mQ UqZ)CBN+2 EON;bxs7ZLoyJ+ 3I/vmOձ315>*dHp {xL@_f@r~_u^XT+zjsMZx@Ly与:Ll[gك \ lEHζI nhKɽHKLњ_8>#dC:nyL̼0*wCD}35lS!ƃ70ބW`}5M,Ơ+>ma1IdkoʼnE:da IOwnDJ856@lJ՛\\賜*W)9/|xzǟvwS9>M5>d3Zlvv#=I][Ϸƚ$hlZ_ڼ*k=?(_S"PM6 } %ƅqE H7kli' ^wpOsNu/әc hS@Q%JUd%Mpvfp򬏻) 0T-Ib@|(0mTW <]չ,S` Zd*h& 22GdMHJ2*\ %%.Y04]VU{a%hbj-K^ tfI8#w KMk ߾Б-Y ]BO;݁ QN~fcl?2z_jO Bؘ16>s2 "]sܲNwiZWʽB#tRT\_lM{QcV_4k :4jl;j^ts}DMOe-\ ofvѼk?|\BfssRw- 1gK  7,JTG_bRabt^Mgݺ'C~(6Q\ԇ?9ZvaQ:q$U7@2 9z Be&|S{HGXʁsO&o[$,\iO=]ʚkb;V\qRziEoIlD([C=Kմ.{cqWneV0qr7+EjҥX3vH >Wo_K/Ưeb\jٙAZB'K}RX׺QyxPދoO؄&g[e[x@wP3܁^F>w ZEqo+M<[dPo)i00]2D)팾Vܥ~iqfnE8*{?#Z, p0kBۣa!bɐ#ʯĴ %c9ֳTa=X3.ݾlJXIp[QPDT\69tWnH vk`$+/Nχщ g KI$z9}1(UxBsUSQ6'D@aB/^E^ə{M<ҽRѦpI'S)Dދo~nq쓺;m6`@;}>l.BgU*EAdkܾ}PTgv5 lyθPy~9@˚cn= 2Abuƿs֍pg2YkZPڭi%f !lB6'Ef*dTmhzZ@tvԱy9ACȟ`wrZ 8k+$@B`_JWn(' O i.sY{tҳLFp|mBrթ0zY-fgjoWwurjV5xa#LHWr&w fL2+}aRPLiQP5 x:`]y -\H&yH ! zUd~RXbjLmCfԷ6k Kf/%syPqKzc<+L7 V!M^clN}JEkz#E> ~ HWCAA-m+m%xwT$e|f MnB 0e %ˊm*??πqqbi9.()or+ !2fJB򌍍7 -w0Q*[C^U\9ꚍKx`,A3 jF앯l(v)!b _;{LBD=g<GޝF'x>Jż3FSuws|n1A"&Cja {?ۓlf̓pk,16zoRBN'7gzWf |_~>2W.Gjel_fBgŖb$އܼ'֪_σ6j_ fn"[5d{nY,5J_!fAh8@ 8 XЪ.PjObȏ~MΙy}K!XwN8B _4EF#( & @"q9*c C;I^ oEG?0aI%00lڗ4:[!/@e}[BAqNot+!H7BdܥUqzNdK>^GjNć}W͂wm|m;y}[ v=K^dF?31O젋lyƸsv4O^_dWedПz@8L>aM9{ dѹTG;$A.ڻx YJ.[spMR=H- N+
}- 'ES>kH>/s7qznBaIH@PGQqx 2d@ΰ"Tvjk`T)OR{.Όv0@[ āք Kdn4#Wu8l/6Cd0dDN׳c{0D.z}|-@H5u-r/{ D4TtN?LQū'aMDGcb2L S9)c~?njqy#nx@Aߺ2N|w$A }>0zB_l_Nft'ހ&WbHd&tEU&[qS%WFl[QG:m;YVw',ZW3C e\&0{cn ZV@VQ2N+Iq3dN=؃ ɦ9iBсy׃6:~,n5#*!oIs#\خ% [ےhDAc ܱTLc34ц{Mq]O IY'aĀo\OF,c(fNUXݪyL8^)w~_ 70r8Lu^e"7+sU$)`5{ؠͲ%4}as}27O;Ʀ [adkeU+I#=" ʝdiÀwkzr /F)ǒsDEB&VGΥNPh6#I? .-r*_["O Y %z6mSr$ƲY?ߎ8naz~bط(bmAi4 6 r 0ȸ )ȵ>طq_喖5]u C៣D8>wWUJ: &ŗr\R(nuOM+$qVև3yEK-5h UY$%XGx,Y>GS滏 v8ǔ^&Z82NJ2 Lм򹦷XTo\'Hv2bx4va{nj3AKMW9#JH~-kH.$}Kf7Iu쭡8VDML$4i`5t^ګ9eYˏ +w&Jx{zBBJDm2LvF3a@խHX_0>_="΁fBPɜ|b]P\-dJHBVğBǜK,#H2y}\L l%h;řw-=#緐_9^po dk7\eˡ|.:aqM!PN ʧ\"qb:o#"+B1UoPir͍WY|(._er&/[JjTYGwrR&wFTL;kPlZ֥fěs?CsjrBs.J|%ϕx:#7 IFl`|Uxk B2MGz+JawT\Y!OlwXBzP&GKFuiG̑m@srd$@گr3qW.Z28'(kTMmVW$ XO( j SQ3Ql 8)Ov` YH 01R! ף4qc)-n"kfSiסZ%ɋzD%LU nx{?h[gbL>(UE5)nƯ$SѩrzʞQYetUQ=*y*`Bwox#ܗ랈INǀkRԁONMܲ!9TZ@k$:7ayg-a)E%# K wQ!XKiԿTVi[Ͳd0H'k{:'GCW,k2&; w>VWICebu8U[30o^e6 MqI*ɍtCET){]SUL`M3y /3-I BqnSA.+"ތţ;_WkMiYԪL{'#;M5\fC3o飽 Ox=5OC̮7Jۏl7gi:7雖Z?1x-[TwZB^N'NILUg_Hus10k^YFzdMt.YH{͒zKf®1;Sf~(7r/ SZ."g/k0؝t❃NWP[]X6q q:DOά@r aJ/'yTIR!-حqg@Lh4Խ,[Q ߋ@1:ӻk>woD2Ҏ h"m<ǍMV;ޚU1jd%UfWP"r*4d*@8k' +9/ 2X: EbjI:(=(V1Koݯ"~;;X;|~2W1mMwّ+BuHB@.?"DPyg@Uw4j:<$b֕R%_݃Y 04F?rːWukݗ ӴTG2t+Ԓ9 3|7oۅF6Ƭ6i {(e, q䵶/_=ª!]?VFwMwpq] TD$-}~Jcq'+^|kX%rN_؄q~oSƶll}̎lE"o;?u6r`[b=BTQ` dռY,ѠP반_pl}+]ǚDaa M,T/8uYqCK 1ZOߡsn LqY@uhYRԢ='7ƩGY*2tX 2SRF*zLC^6͎JafR9'Y/99zz4ֽ\Z r#>TGe5yL#AEpC NFY$)=V{϶͓t.ﬣ3: JK6 Rm-[tڹT:~ާfJ>MN5{{p2~zK3 }+UV-g 0dS[/93V߈߅eJq &AS} t"9g 1[w+DYZ-t1Af?l`dh [dz[V1iV-/y{а|=,[E+B]B9uui98HHqуAb^Rd̀'$Xy'+Ԋ$:6zHo),z֞~-Fzm>JJb-*V`*J˳j{IO r\(ـF?;E.=WpQ@0"ꩱ扴3fH<[sR;A4tkRǠ):2A0Lm=t]kZN0#sD{cW!${ KC~e~4gPT"8ҲHn =6`i2} ]zfuVͥiKﯭ5k~`0y7-*lC5i8 xLv:̍L=t 4pW5Y\fC%[!N^x yImps67d'mrF3R\Q3#*.nZJ8Ad$-l$ٴW3fmS鼦-8lHϬVhan{umë'ψ]uv:eQ嬶F}Cu2+ѮKBe xg5[5xTuFK!&(R7_ N;&!+٧]#gRНq*K_v{3sz!l>B2sg_eX{aP>ҵwpwV?jzu4S3zIE8 ' g:,fdMy5 SP"2U{R|Fܧ)C~jG,0 ()`yԁԩSJ .X‘~kɒ&>x*CBeN\7AYS]4sFr)Vȥ-+ @GѬR1uۡE(8gJLbd^/G,=u;q௳EQVޭJb 3Yj6"|8)H԰Ό"nM:\4 tD s7\3y6xEAO5;5yz<)=$X}GT#5yW[-~[+ċ*Au޼PpmL]>q 250FdO_ î偸85eEDAjަ嵑M|Կ;2v޴G["rL?Rhh((FZ t!Hu"aeعo|X]YqZOUZ jb۴ ,i2VZFCԴ'KՏ7]vㇶ_oo%d~KkEӱ2Pt{]b)W4iztj n4v,.^K{̤juj,ߒqRL6|0ĈO\+׊;^D;OJ>a٥I3Cp.|LL(2_4ګ66'+9ٖ!ҕI?-E{xh7{-%q\jЧGζY!uL_3 ƍayȫU/-b1ts()"~Rw[lg:n]t؂[\Wau{7i$Hލ ?k4DC-^˒s24 6[iofG~" @ ,گ2ӥtѴ.brk6+ełs:_Z1 e9ժD ]lţ Ee%U#z] Kj(Q!4ůc 0&eʾGEmǂA_J%2\(8GIU֕HcHUfCPPi;'q8dٹGjʖ Ʋ!n#xg,.iz *{ H)m^=wx/_+(yA`AwݰƆBeH멧udlzuV XIc/Yx <^F;G) ԥ\52~n*OM!)׹ GW*[4;u>fk@Ǐ Y1Naʆ>&4O*m= &ֵ[ί\)%Y޵?e ハTYQ> jRغo1j o&`Χ65CJL[q#((yU_Yg[c"p]j% aRhF7%`(G FZit޵ߔRH{CyҖQW xr3 S kҹmy.Ora_η۲U7uV1t>Qo)s/*R6)ҷ3/s6;ʠ{ߌO#D󃐤Ǯ>k?|9K}D?636'.{{ݜ=Iib^>dfiBl/XNȁ/Fv=l2zl4g[: uh|#l; 1"+ W6W)7c}|zK]EP| :TwO1(f {)XsxS"oC.PgޑRIsc4v;14Un_MLSHAFw1Q3eFH x=^&/vڃo3q0#&qUuR)G}ڧRwli-_(DTl9eل}ҍP6Ҷ39dtަ^`lRcf1.+) M] b.`{@V6~r1R2C%zzL({i~|}Ԛ{|,?}>ј2L*ՇP,>,EOp'Gbvn$:6_PW~IL:#m8nS +)NR,(\kyԟjպʀH]i8z+B1/WУxGQRl֬j~{MX:ԩ%чd+l,ÏG+6 Vz+KNeIAy6%Ӫ fmԪv\J;]ѲRUBϊ׊fHo Nȳ%LnQcqB}{>ZThE,Xj#Xc)ˣh5s3?8Oyj5_6}鶍b>W+h"H܈4'3'1;_);0,"; u0۵g oE*- x]z) =s=/eᮅZ0Mz]~V(|vU7 `0׺n8g=pT  i ]J6ѰusBՖz@4ny^czz,@eE߇ #oڛi{޳ QϭSx &iT<dZa{A5]EhHUD8ƌV9LPB)y Bb[#s0mo#rx,f+QNL_Vo[ <3${nn@`l ֆg,B%9XpJT(xsB~J>w Ha];PgMtN*bOO)a=S01lWvU1C8M~k]ݦ="Sg+(p`(l[0\tsW0T#EF}5i~$wX=wzH}ŋ$^y:j8 :u*Sy_I(-i5 pp;A80U]}(W]w*T+-\[ tr&瀫?טt҄iẠ|!.t>;JbH0u@f,R#2~('0Dz(( ge-a fҮ9|3+οJ|l :+1ԁ\a]9FY1UuxS^BO*{: Uz.l '.$DltzS;4]Rs~(RG_ 8_u-@0M g𪛣lZyPff߀ЎuP|}^1p:uy~ѝBuMS^4zep8Cm94 j=O9k,#D2T*^3.+rO_^Sq`+&-=/=Xo`UϏv5g[(/Sy\~*/a-YQs$83}!O>lLyV@q @d1NdÓ?~y3ýr%z D2w%:ߛom`FD1 FGBHً)i&0gpNqӂ 7IID#- m[>'byDRm8_zkGi9;> dfX~9ֲ*DWƛUsv+e|{3=vtSe "!ӳQT xEf1Fnd47dxo{]{<θĖ9Y0is<4w2+0.W "8QdI#C+hȠD#7C ZY@յ_lqrXRC4y?-!f~,2g)b 9ܥrt?h|滈"rQNhnj";X럀/zM]^2| d;G2O`qF;-n@ # ʥsOf2oKPh!5 :gl!E:Ϸ <=j z`P̔j&;7sCyúO(z&VM[]iL#Hx_ JûP3xuCRpKlRHsHoy|S~ǀa"J_C.=Y3зIOCs0d@dlQ4ZxںX4~ `iu*@ GSߺF O԰_b_*kO]mQ {j& 9;qurQ^Z.]&U#rä܂AO.а1ɋZ9+[jiuMt3v;aݸdž;SʩH*MO ѷߢ8eܺ|,1YoFȴHoIƎPsq:/G=c^ Gﭬ sȤ2G )pѨ!],FZJL#[jh&S=>e-zGi6, ,2.f|@dT\S1~ZFY=-53-:?zX͸[<. =j^{ՙZu{?c=ß'߽N 7td3}}@\YH2bȶ>J(XUE6Yk6go􎯛 RXk/PؑR;ZfՂ< HPKIz)#w*)\ 2lB!s'tSmg3hf㳓) mpp*ﴆKkF$!@f|A#< _#z҉'ZkҸ̷SC)YaҪIE{R"?Bhr'}|N!ߞܷT 3 e[,{V")aL7oޞvKT?x )nFG`~zl8iVQ`CCR%/ }2dk)[}A"Lb])mW#~Ђ|tP MTLC7nibs06 %Mxq~Ѵ>5zu˘ϔh2naJc؉]MC4J\)czv)'~_ʊ"a`L"^rR>bȏoM9_rƽCO w*Y;ʛ kvdBYb &Ġv.ExțPڽ;8ƚ5(J]+aN e9B FJaO%J5%zPn i>o6Z\q K\ӣ%ndK|LqP3ܲ5dV'pNs5*9~2=m[64f]&j1eDB bdUBkD3nj. 5,ЏB\#5SЎť/O Z\FHx9QhK&Z=q{W2f&]V.Hq8mh0D J.{ ЦW1 ?0.4jMkF6$ b^ 3quQ.V:e)׸{&]|#516/Q\c2SFgf~Gn/u aޗ*bXo;n3"00*y~bC9&dFI}ԭ-^g} sd[L̓wC t<ڛք}T롴ArJ~r]:9ڛ g-&NGl )Zyv|n9 ϺIq ay# {V&Rͱ'nEߑ2JƝC s‚Qk^}ml9ﵼە9tп~5 `PVJ2!U͎Q;VMX}Q2;X8fޘB,3h^1/-*Ew"kAo 3*Ƀy4 ,7s0Ds,5^; :{ (wU$8`Ѷ zR`CL VVon=EJ4%eE%$q贱'Aj=;KHfZ8*gNS^pIl|,1m ;jkZyW?d( q|ۆ`38l*"(ud-йl\-Aޫ QDfu+7FfqZRt.k|7|yX kHuk:T;IeZՃ6 |ȦUˢ5 Dv1n<8JAv=k觤f72f com&UU&lՋxJLQ-DĘ^=<#<%<̊ +}<6f\LJ"?Tao[t }Mt\u!Ũ{7X0dl3\`[NF]ŋaX$/ozϾN{؇^%z)k3GQGA9L|⶷> ޝU*G|1c6nPBt#RVT,pc@1bD>b&H1p5w ]6kّ3T]v(6nX~1T^*p~\8׻؜zػ8eFT#WFش|žb.=KB5xbfvG#XNf^QB4Rv1|"HB|"rhJ>SYOag].m"eFAfr>K+m& U@~,1s %Yc[Ax{wCjF mqtr$bQr9sr 43p+`g|JPќ^j`tm,qr.\^ FҚ&}rS̱#7gKVDA#$nyJK C\=2k4j!w%Tv`<HB§l^?Y3TM5\H=ff,0%[8Xy>M3?!0 Іz WF\G/֑IlquFK{gB~|Ş j2\HtI~xAH49in:bjeHM]t "(|مDPg+CaLU_C9΢% ɺ=8ERBrAU%䐀X鰈상zJRy%rS2xT p2sEeXPHD[~PeyHAp.&mi_Rjgي]c#Irf?#LnbD")ANSTDNo[eb[7 }3ufJjp&j2;Ml= 6S&j?8>ςܖ *KQS=RaS ]* nJĘ|gA0h_P)Tӱ`f$==NރB;v K%!6ez [(doy[*ys&7G7" \ `u~]B6*]Xa22Wj,"d5S?REMMn tĮd7Y#7@(DIݳH%IHsA7e1$$0 IuPy J3r% ऄy`uڡQ5'cr8*I;nT^Qt='}W(x`@pd^r=ʿ? >k۵.]j{Ol(Tb\z~`wEZЅaBĢʃ}M|3N: pZXXfH#ܻwy|}qRWZEErQ\mhL_W 01'sQD̲?F;A4 P gП'Q[HH\+G9PqvZgkMmC%+V])zOpbʀ]07+@HYu1TB,`=fE91˝(4Lbf-i?{W+~呫G?ooW*HY|C~Gojvh}D2cL:aŅC8^>~#3E`E&TY hoe3#<_ܼ!4C"vWXkܔq\TBnT.*#Idbt0 Dp! ~Ɩ#Z20MXEqfcfb#|jgD) U:wˇN~V|8 F1@Hg@YeCS3u ǿ22 {fy⼁9b6P >r̀! K2_C,Gu"漴F?[⢝3uZFDO"$ߍeq86"tćU<ʒa[dσ$%sE O4:ub1p [Ļ|;ǝ ϗXt<[qwHs'Ƨ1UTHFd1nJ# [Ͼw#HAǯ.oBlB8d!GR_XYښWw]ߕ mn?mx˧_6N=1oײEZ w"}#i῕D<mڣdM$j^8cI䛭g<[ <_? 8vWd R<KU:cQDi`@dk]hD1Q K"N17O^! т Yqwaj ry0KXvbu#e3EN+Ѭ.2HAEal`=m2LxTi3ךKJƶv>fQr2uih+@Yl޵H|єluy%| Oyk#j7b f^Ƃi4.y<Bj !X,'V ȟBuՙR-#kMx#ly£TxT^,#+hl3*4LkCRPc5)XvJ mFQD, \NGyMkbZ57i?~aB-ğ/g="2='!F10~[v6uzy(?n6ɵ/];+EG†0=dɗ b̯2Go&f\ֶZi|/\Kb m+m0N=_o*WCWB)G! -/T |ƒw:ZZ$zU8'7kk]$\lL$Bpfguql|DWb]V_Ղ*]\{4#I fUJu!Z/?גl~vҮ*̡[`-iJz5a~sE}+{$%QqC,VMu U*a,B!82 D+;#rAESՁf)N 2z+vW~cg&쯊{ cjGJqIw/M:9Bϧ߷AV *m[.5+q? ZV,-b1kJ__ 4}( >\PW3x|a#$c-=c;w?v2έ*M\a'|q\|#EөomT61HKE2KO/HIVjgIcLb Fza)ִ&_3_&}qαJ0ՠ)h[)YÇ.wpZүB&41.]jiW2&iEe#ȊI9ǵ;e>bղ<~h*xVu `G~ʐ]݅owRWpy#49hy#۴ƈpWysԬ>eNYw QY>j$ b @l@'[~zoc}w{rX[,w0-D,+b|v- >51Q^)$m޹30 (,Ncȫ5ccsD*]e94`.?9{Bˋ[ t _7Y[4!*h,b+ӼhQ;`᫏H]7u E+,%'O5V19b/2_)k-p7CmIWJNv<(?sgaq+oLxP86 e Uwg |ozza`K4'c{K֮ Ρ"flA*nٸ|) t.m¦+5eA3yˑl27p=]]r 8|R+^0h`9wxL'&~YI]yoJG|umXkg q+t@w)ҺпƲ3#cIM.G$(ME&,4lҤ/.wkvonX+Y6ni^nY==-hLҳmnlA`9[PK$nc8i0F"6>-mfPpNJ۟;J]r(L.3L3.ƿ&}tjVkU:j[ {vArevHPeZ%Q}tk~'LAr$hX N˙`!  ـJ޼Gkb;ݴ؛&,G%;|Y-xc[oڹ^j5w!%=7:5-, P36 $1i!CzRM}h%* ʓx.C:!/@uϓJU]"ܓgQY4Lu C}Q0ƶ@4lFb^JGHV2prUHgև0 /~4X8φ.| ݺ$nb_q*fayVaӮjSC@,S^?J0u`=.4cA!E6ዘ eJߒrKS mW15l" nO /i 2oǞr)-F г nuZuI(ot-U`^2yUO>3ӥcX .I:J XdBq|U1ArhK y8QHт4hI.qL&|ՐйCU3e Qٴ=bٽh=;w?ƳЖl{n6)aRP<SËSsw{ղ\ɏH5)s+*E U(đ}z!c5)o\A{\|ֳSq}jlK;Is:ɄF!Zax0 }Mh[#=fjPw1lgںN㏁o2u = t|\@& [o@*~l?VP7k?T8 !T:N)"^],"nԲON#_fvѿTΑ}(tZk  };dkíЊbE^}SJrZ>V5͛ο)LboIצCY$n:/Y2昡SeoƺASj6D:d\/Ԣ%Xۺ cd{W`g <^EH."){8qwWʫ-{}yV/y.\,]:.ꚳa.3'-4vQ#<-!z,1R<[klixe[Iam~L[RtJF'!jWgD+yMB,., I`x<ګ3|nUR03<9bk׹rŀ&T̗\۝8bcEt Hb |hc!BHD%%z-45秭0$&G)-sUIE/}/e&+땼 eC=WEs rnElD15!+˦b2z'ֵt@DIDO ōfʣ0ҘH{-S`<4374h_#+(*QTK3IN3"PZo?߶Ux:Y`& '`]AM`Yp?Djޡغ1t^Yj^M_{2ؗŅ 0R1}&=rd YijKJ?LQQCZjou;) Êm?VfzA+ǟZGڙËNndkXnhٰ602g`u"3~ ޥvAH&O_|֣M@MDbSnV?Ԧ.{lkSڻp"}8v; `G/vIW]h0BХr@Gu+2压-k/N˩n4g 4EL"+dC)B6X CŬNʤN_w5︳ɀM&>!z;׸'$ ޱŁ ܺ)߆KVu ҅rn^ Ylq]ucm]J]l7Fŭ* DiwKT NH3"I4k=UT $: BJ%}{KB=j8 gL榏n"վ*tZ={{@8:(G'V k?8xNd%`UDr(E*KF=ZBJ+,,uG1Sc啕ܙ]ȕE' >ףrjM4֕&Lܳ%4ô=u&se?L MMUh'ň+I[*Ӑ TЬ cg 1rUyhU-2hd7|]^Zкk73#,zEyـ3%5ϺM<݊G=~ωWll!*ӍhjN`yȍ=r*<9hf8Bk)d&FRi5\j@N R msap.53S&-\:И44ko6έ+ӻ̀Yl#ˏJ(iGqn|/E,b^6*Qh^}(h5[6e)UQT ;J^Gjwr:{qܥT#V"XV:yd[ŦP'~\[(ATxg1!-{1=#?$SśђNVvW& ;I$1,@7!aiplbE҄5{ș1JNc灷-tŭ޺߀alȝ;X`h{+ߺǎʝX/&Qb3`OO+zҺ;&:Er:S]hH۴D> i "ш@rܚI5P! UUepbR!>2WzMҟ&usbZMC 9zI)$7!C~oճHvS47P9핝FAAUwl2%Ő,s13] g.QsShr"A$`nR$$&R1+XVs=.b9H:6?0,"r`VGjPV!8x'-EKg3Y=4tV^iާ!XL_Z*V #ڄڀ(AWƠ'k(.$j.5]ڛ(s8of]^a$ #܊.&,'R4@A ^0aURa@ !i-9P{gj;dR Z8UfRyqf++7x9v ѳ#3U5pm冿Rii&[ÔMZφ2io3L](.YTlrV%i 9$a_l0{aIDa }%B͉Ʉ?z!mhq*oJ9$ygD'#@]=NmOf{|n}zvw zRrMdnl jԫ8ZÂpwNv4vDLj@ve23čDG&IS²x5EۦQS<mad1H*{lp(&zxNl*44kEϫx?E>MNӆWH19g$jz֌jM l $v̴~RKl֨9RVrstL-H:ض,qA2f ͒d)s.^3 ھxޒ~1KO2 aCF iNgGYOKj7nv&f+N' 6x\@a1HUtA,S^\`*w$*T/7 ;h8Xu K:w&LFJʶ\ӫ*U]^^yP9kHorq~qNw~%5zY`8svͯ{Sx/UOiΎbyx+;zO)l/gr?.Fy DOyi աE lrFUX ^;gfluwu߹B'FLJjF:˫,@\@phTEDVgKDBG8e71*8`g&|f3䏁giU4ze)5gPloyCplNKvflҘ~՗6ܖZ."и͒b8 nm[ L+i/- rm H!sSA-a&WAw*sCö5?D/b"-b}v۲sBmYLw{2ѪPi}~w-ȧ>#S "Aja@<kTN||y:#:&v~֒D}W>Zɂ0Iӳ*a8]<1}`4r[Q$F/K[Wfmo/}B۩* <}j٥J^;܂UnIۦ:[JA9m翄X望_:@ v9/P@kV гtDQ]%įh`*-26̀Ss ÚU뢕׳{ VԹ 4elaao%?3m_ fy^[}wup*e46B#jso Emfp!U ΢UeQUD>!-|牝tS-B(1tX(yͪb;Oc(͔ IEs[I;N!Eev{'WV:̖bYG bC3Y ºL*k:HphWroLmwCtS#xu.nJϔZsԚ7LT9\\?w fWźY/3ZL@!TZ6ThQTmX`ﶪ i!@ԛ&Պ5(IC[o~̟}mk54Z,mF6*5$T6PQHͤذb4e4DdRfZ&!,CcXVi cd2U-RT F(@^QITE㤋Djt6[)ٶmlhdI AIlXTIE6C  Hb`ŊMDPFƢ5ŬV6ѵTU@VlTj,cTPi,1ֶ^T|yEGRJb'hm 51V5XlVF6- JQcCBɅ$ DAFLZi-hŨlX lwzPKߩSCje$H B`# #&d̍0PID4h4)TBdm1&2!(abHLę!@33@ I i% D$16-ųB5Im"I[&R a(4DFJ"`dɒ0APaP,XF14E2ă2&) LB"`A-[[kb-AhFZVѶ4FƊ160R1LY4)DRRAEl&-XMQlhXSjzVzJ#$X12RcQ"X#F"XRX-ihE TQԚƣPVBUѱQ[%jhMBj=P=@(+ PKԪ,|jڳњmSbRmTڨh54cQh5L$F)&FFRm5m66"V (ԂjbƭV*֐bJQDY2J4Z"jJJE- e!ΠRTNS$ 6CiJ ,(¤13"1[hu[UkSEWEW%$ECG]ڤ%b16ͳfߠ^Bqw$y*qWpqOQ_ݑAA=*zj(l)HY,I&J*C0TڤXMTkd6,$QTJ4*LZP$$0Bi3&(H` &cZMT-Y6AQAS2S,PFБBV5&+٦[65+^!ԋݢE+)'G_)},3;*7*-J5&j L-몹ZZ*ZNR[l@JI꒒WwfC%ƒ+ɢU\ۛr.˦Qwh-{E}yʔD"WbBOĂ4$i .>BK!SUȊ!zʏ6mb*jIcKţchMV5Eb4bbD֤HmV͚|TurwJ>B ,.r*2DUЅ^HINaH%#h#uAWГ/[I/ TUR_EORH`ZڠUeAޅKlj-A"!lbbmmml[#B& DŢ[%Q-ZέDJ+6ڵzmj%%6J b؍b4j6%[FFXjE!I 6[Pjcm,cD1R!Q$OEGC sQ>RU66J6uAi5LQsUh"Y6@ntnnU۶ܣ\ -W"KARL!h5&TV6*MQj6T5h%ƍ`!!KF5ѨkFՈ"4jދj+j"j-ƶ,lZ hţlQcY 2MEd*"Z1AddāBDET!%! )2F-i4EXmZ-*61"HRf٢"0C6k1n=UxR伅$梓P(v é_><:cj+T ܚuwb9MsurwnkpWW;Qr95IrrwkAsh6\݄TX%dFƢbbLQcAmmchd֋","$+jW[jJ(YdjI*31(0bbEB"Y0aA a(Q)bi42  2d)"LfA(Chشk6ōض-h6آ@mci6ō b(-E"lUlڶʛG=r-fb 6"lkF,Z+TjQmFH!c Qd)5-Vl ҙmU-4-1F&cLUVű5DԓRNQ]!ȪE` Tb{G ͦ"&6)m$"HLtwD40wc9΍&smtۻj-nv]uλQ;Mr5r˺qi(t;u]\`w@;wqݻ)\ݮ\I\,adpb6!TLڶuձk\MEa8fTW{]U#"^Y)9^-j-[Qj65F,AIAF EdK&"e)bѓTڍcXFF, ш1^m%xnwC$:ЃAI搩TAu}Ѳ7NNrs-ؤj64%*HH."92d@Q4DICYJݨjVJ-XmVkڤw:.WKuss,[']9s9\һ++.t7ݚM)q-ڹmr5mz)@wZI$:(C҃H@Cl֢JQjEXb((`Q4LfڣdAnB!y!Q=$:p͵ FضқD͊ E$TPEƄѲd$FHM(MI5A֍Z llFb-F(6MUE>tA;lm`X=dh4I%.HM$ŌQh7:FѤQLڹ]+cm[BZ*ۛ-&T! 6棋]ݻ;WL)tI88n lKӥEe!U+Ԕ9Ae,콜 *_A @TU?_XIAdD&Z*-Z m/M(x!TƮx: pq$'F5%E5D25kU&ִm+Z*EEj1dQj)"6jmSj̬I;!zH~j%|ڎn"R} /)"ѵ&Vlmb% fmKmL6;NMB]͛6M$WERQ)8%O_B^=~q]'.%q)9(UP r9$tHD7UKQ̡UX552QDEQh|ۜ8E )j.Xkt-ͷ6ԛnk,ZC@QsVޙZu)U%rb^DHA!D01D*1I&YXePDK1@dL,b RH&,Z+")mDX1dX!FL1I) F1YrhJQG5m٢,[hڍEr56EchشP(,,hE Z2Uڋ Qz:u*q'M%;i)ʩISآjYAUʤΕWjU_ rQWH\j}\NW*KRYW8 .jO^GmZsslm Ms#www9p'pa r;\s).n\$wa˥d˝&Q%AͅݫmC i50 dBR+L$e)!lC 0i)Mvsh3QAhň"JfF$.BfB bR)s"wmh7W2W9+(G $Oa~+bRkkQFc Qc5hm[Xɴk$Z5fbb4lBi4iѴXjd*63Q"#L`mWNr/H=(WaJ2JO,*/ڔ% $UJ'ɤKE /*ԋR.&R[Vō( bPȱEh-F(-jmmd@2h 6iQSƤ]HT*$TȩRKECHyWI$zI:CW1hFd A`%[&+bmF&ڊjM`CZ4ʋ3C # H ,h 3$k&Ơ3mF6kTZ6ح&H4h))bI&M& HFjɪMQQIDEoGk|%OuTmE[j1h#IEJa)dTIZLbŶ-Q[Q65ţk~8)„ݤwaveslim/data/dau.rda0000644000176200001440000011705513430347452014271 0ustar liggesusersBZh91AY&SY/b?.!3TTr@@@@a]EP((P@(P( 4lkF$z-4wdmӧZ* "( JUARRJ*JDJE@%)URR$J R%B**)BTR$R/ Z i ærnݲR٥JRAJ_mP hh )kYiTlԅ^.[Q_l-B@r">(Lx @(XBf-3`-3uLTJ :/gvFD Ǧ!b 4 Efʢ-XRѫX[HOZmV(h G ҆h(SE(OThTM ѡLdb410کD~hhh$STbF&@ 4"I OHɲIL#5 CM%"DS#h@O(44+1`4uܺk,uSjDdgI%]&ZXn0R)s*iqD"֋3ҨIjZ+Z#k*K,XjV951յINf:WhT'ThE+l5:HEpZuic#D֚'rIh)1+)j5k1eijdm&Z9˷"aEfYfZQVeQYXV!dHMZ1Qlf:AwQKEۦ4&dV4he1EѺ3f[Pbf7TRuuEk8jNr&kY\[n-udI3U3MN9*Vul.Fi@JюYc[gsi1Nų]SG5:[SMZFMĪε+::ZjhcUkfm]6elΘ5'PG%QJFPZgjV55-ҍM[&4֥Y!&\V-5dt]kSC]@bjQEUMeZ\ֺ :β0IcY\gDIrjM V"jMjik.5ک4,YdLL4ى4TZ5Rhk%[-M5agkL%usjYhZYUhjr[JӑRcc2VbJiNkZVIV\hk-Mf)cl&dŒԅUI--U+We\UԖ%UkJՕ+01#\k4ժ쵫. 9JeXF:ȶe&B5K`֢%Z[T֬VƬKkM ѵiru.rg9 1rۛItw3"4,D,5f̌&46jVu4gYƙՊUU1nABSpYZLŒk]S%HEZqFv4m3k\&W5̦]cԖV-9 rZM5UYfJ:]WYFծU&nN!YgNZem˦ %*%$DI˻ӱ+Qk+9%ZT5lf-l.8L՛Y1֣R 0VUJgD\᮵iWW]Ub-4s2]-NiԚ 5ԭ555Uf:fҴ.[-AִgTVleFifqҙԜ-V5ZfUSaDmuT֌fj]rus -fZVJЇB*4$rerMIW]4*Աi%3224Yda]fʖiժ).q#sE컹;d\隬VaaT]H cTh'eĺӣS,7RYˮg&ZNLMrVZfuj'LYőiFgc3U-4ņY֝SdkLj PH bn6k#\XZȘf4[VCPfIcPΛ5RZ+59v]YZ,jjG Zi]bл;$裡t2ʝbZUHiiƍj1':Y"˫.39e7+:'u4YdQL:pSI\I1 Mmht!5$*ӢZgj6RMiJmi\`iө5 hTZN#hvd*l(SCafZ#kR-e54iZZS ]K0Ufd ]c1qΦWga܈wt*Xεk9-jYeu:&2fƄխfZiZֲZ!I֮Q)SK[LMi4eٖ-C[ 9.Mk.9FbQVVM9e4%\jvfŢKBnŦ*NPԵK2Ԭ[G22V+qb,K\Y[W.j SVSJihmiV-+Rf,p:k-V֣JՂɕֹ 9Za6fͭmJ֎[MjhC3#S3-9*vZӖZӅ9ֲ!ZP努ImgYKafˌԔ)֦MXYK!ih36V֦K4XLLӢ-ګ5Vk ZWk"ֲVUT`NdUYk[ZkVf&FY¤JKY&vZLڪ,cCR$g8(g+KktNsLY(YHӌeV,kRֱeV&VVQVqMkeQfj[-+#vu)ӝR.☲c5mYDUZe-d$MYVir-16Z4rrZK#YؓS2:9puT6kfřFFu)TZ(5uv2iY:Lh[LZٔ\FbsVe9]%jMFJY'%kf+i:j[VTZ uU\Y9.aLKH٭VVP,*m+26IwN̺93vI.TkS9]m90ifk2)E4,GbDk+*MVdMVLƺ-ZVFZ[+1R\ecjTk+RQu-:ƥ\՘˫NF(ZάsE4lJ.*]ZQTv鬰I3e` j3MƅF1`]rmkV9Ze1-aPkEE*Z,ukYtT4VMsW1[T&+Vak'U:r.:$9CMb f¢SIj5;JUUJL\%9UWE3+Zl'TӮ!UZjMlZrdia5MIjҕ(9+dJ&(fr6S#`#4JtK:&jƭӮsep7cZQiQd+i5hr4&\Le,e*tUtmZ%5KΚ4tEN;iYٌ\uUe]ֳ+! 9:ņeRTS1ZʌR]܌q.\ݓ$Wb#-lSEk9L9\ZvRisK,ueԭJIImilt̳M 1֬4-r5Z٩HbXsg[ E֮,uSWkjXjƚ2MEʫ`a:LliZ) *\b%eLjbZUfYJФ96H)["ֲ XiZPS'fm":΄s-femald5k; a["Td,.tAVKjkJ9 ģ:ٌfZM,:3bX,UR ,#2bFՖ˪֠ks%VR5IHZUdNNntvebYt\"fɲTMhW-iN]*Wv\j֍buuRV4-jƵUZb,MPrtDPYkZʉDj*,W:ZլlV331s$&c4iiZѦ\[GAY[V*襎jVK&cIں.: LZYV\3NeR4_玘QEf9Kc[#5(V]dZb̙RUZV:6:6),S3(H5:ڝʵGYRfs2:֩+1S2T'Zefҳi 7IBc\6TUk54i+4"թ[e5k4JVu*XjY)sYaZ&G'Zjզ6YZ32jC1:i3&5fjX)VsWY31Vحbj͊eb-iYFmJ5jfY; fqF٪j]nc4c\R,lg]e Hj\֬)jk2ZZKl,D֦TV5;FVFtɄ9̺Λ%]rqeX5դ5Ү$S27YUPeYcZRӕ#d-Eu ma\c\]:-c5(Z2&[9U2LL:ʥѓ4]fu qd1EYmf`%\"Z+JԒ%Ek c)YZL2e'3-tMZlullP-լ2UteaY]i-.S:\ke$eY- @U,Җ4g,e\IP LuUJAuu:r ֝%GIÒv:l\6.ZŽ[u.[S%ڋfv­j:[;|ϞWVVkAEÁ]tkSuÈӭjլ4Kri9VT[NtUXW5*`kJ j65f ek6MZ.aekY:(eQ )J-[VfZək 5G(Mla+Khɦps'i.ffYZJֵWb1KYb9dTu2g4Է MLAƴ+ kMSUHVrF4V.EE$9jٹv-cVdVXΚk-j3HjR]]pl-VD0Z-,:u\.9NquQAJ\3kNi[Zjj9g,sEj5FZֳ,Hң6d5M,L7R #r;g7rMV[5]Ae4ɩ*X43WQծYkU*He˪j U53Fk35"V8\[6UkT橫+#u0X.ZTk-ZRmZ骬KCfZ15I34SUYelMi l˦M]ZҴfJZMUd-U֝8&٪siI,1ղadZ+MưTu.V0VZd2ΐTY3+bu4:m eZ 3'ULLYZˍeփe&VNeeWhZZ̕rVkH5BNΩ&ʓLjҤrvbԻ.FSYSM$jG՗"ō-+MGSM5ffY4K\sY3ESS4jk2Lh1|{݄ʬj9Rkr4Y"c0͝QKc[XիEGK 3%,j-\GD YJMJ2DM!v9uQIdS3Vk3tWjզR`dWqv+hDe]DһY$֦r[ӬPjaQjZB\sWQ&Y[]RXjeVN:YgJS[6Gc(F64V2VaLՌT5:Xg0,a'UWV$KV4U3kFXMUG3ArZTESf(jƺUZaˣFc5kjLc[2խ:ȋRѵj \_pSƵkcGu3*sS jY+VRڋ2bruVNjD&UkIDtRfeHѮ gZ]2M\+" Pk4ffMVYK [IVJf%TؤVSFV]4)"2Fք¾Yr+V1Luj͙iĮ6WHVD̴QkW!kIS[ZblLE4cV-uu3EV U-l5iʋ.ƭ.ZʧS-k:,Riiϵ]ufUJJ8N eC¶ڛS.ժ*YWbM&rW9KkkZe!q5֚mkSt&vkE ͅ&uV;2Ġ+J$t.+;>UYhs)WLZ5QsB Ue[RʦrS*d)rWY:(9e,aIl2րShVU%;YXՙM 5jV"qjCWURZ{7ϊk*"8дk:`i:YL8!JRejVKQu*jUIkY&[maa\r骍E\g]VLi޽Cs՜gW]KYUX̦\j5]RV Q3MNU´4WjֹeKi"IfZcά4miNufVu|n*Rjm GjS%saR!;GI8nZ425\jVTӎr&QjfsN0K3.s#Es82eZ3H)TN\ɎL2z*譙`Vգ$ZZ宪bNXNI0IFnzieAYkJ=λbvqRg_]Զӆj2Ub>U2Ո֍+1u .ZuVƴJ(;om־y-ԳGZ[s2\g.sq7OKw5$[TbX4fd;[u.JQk:PAeO]=u%\,jTYkIjju:SC33*Ru dթMfE,NmK$$i@ H\Ԭc(E Z1R.5j2:Fgc)fd+V]W9ѥjڤvO+_6 i/mzuji{{{b MZYF:6~=^fΪ켪ūJڗ2ljյmXՏϻnyE-mF8MeZ׶G*j8NZHyM(u#t%YgHՕeUR\"mqN!j7XoxեZN7z֛"-~}]}lZưZty[]i$Qmk[NX14#|)SRD+ڝӖEmŪQ ZkvR*̜V5ZZ?%n)9^ʸ=)vSYm3-K8ATMkZѩt֬` v,CeŁDRR$*-Vo8SتE;ұ[[ dog^mjy<|)Zx ʥ,؊^c-:׏ulV7#1ƅexn#u*y3q7*ѥlb6n}hiK:\-+-5񺖞w{q3:摛ijSv|v!mqםEvmW(xl3 zP\@V.g\HԎJvnB&Klqzr3<&Dj+ґνokU2hTST69zTQVD*YאXьc\S;1ֻ.'$dPhN16JIQ-XbcK Z˺e;V8Z]Y[o<4iU5[ R3[טv @zݹj9]6k0LjVf6훵zSA.()rH"ORr< #9:^{ՃB|Ӳ;'6Z)(J\a WEAtᲂ3\۝/*b]wZ+棭UFܓyW-<5v*sBr=n kC vô6n5iYSq֌LL!DMéB.YN[wij{"y5+ ׊@x@ԶΊs0n݇*k-̪!  [umǵ.ם[n^.5[W̍Z5ש`]pR;:NTlglDŘPB6LG@NT1&g\]#eIe{, ;9 3t$2RX׷O8-S[EYs M;iLec%|ӎ Z*vm75!,9 PI" H\v) $ނCZs 9 ">cONXxٜke3BkHh;`]N;n]tWKyإk>6!M*39ѹ"#D6k(;kDC*CC#X3{h bQO@lWo;VUR2LV2D'w\ueϷ AΎ477U 1-)v孻j.;Zfgm*횙 s'H YINEξW{зb却m^]%ͽxM\۠rFҕ>}s,Z1vUJ=v.lL|M[0vD-S`s"]ZdW+:֞#ֲRmVɺs[Pal謲]XWI.sEb\" mU*Y[E7X j]`,R,,h8\30вZzj7t#*fᜣo(lrDdLhg0LF2HjJKcHpײdb"mn jw^*%13S\B[nne5h$ Vf+rvr5s؞IN fSأ`B.51(G Ws6^̬hԺe*PVE O:j>No3sM_i%̽RբL#:͢X23i7rٺ)%XN ٬.EWohc=(9YI.umuqIJM\E&:l\mD:K2aɮor&66F;2A1i,j )i,>YS-AyH&bQ2l6TChNt|#k6 RU-m3IשkZN*."heLӄ<^6m"Z"lx"XB՘.&XuNH=n4ٞ}RQBJgy^ka,$dV0rTf"bv ;)5qqx:ROuJ4Bp/QJ>#Ubd&#e%4NO0EK#Ug!d.by9[dqn̏8۶ |4a$+ )5D¨'sb]VU[3qc-锜 V7*vۙ9sz!@|8l8. (PaN#8{PdӬyIj-ԳHJWrK\`뺸l:9m4Y1 xjBq)c X$ZhˡN6qDL745&ˢצldm(][A-2("]}d)Nw]rnfU,Bl%+vg- :fj-2a;ǥr];꫍S(K1ULnhۇe׻:5,˻ 9ָ:7ʩ7A2:w4Uan&X`e&J|ZE 3 qѧ %Ʌ9eeܝjr(tVʂg x!.fWf856t;dZ-պs3Mqf+=('˫G$$𑌔X%L9&blВŴ,UYV[#%MS>#[_8r (gsD$VJf`v⬁M^fƞ}B#!r40RSel) ru<]8liI,Ɯwiqgɋ(| tnd՘c":UQ, IٍYR Z3vώʔ[6lRFAl˚:KgX}+RHnZN2F̬(E;őgJe oA-bNkҡ>z# ר4C3'm2ãslؙh e)JaJ2Ht^M,rJ+(Jޔjo=  V@ʸqfōkx*AvzmnZ^EgX [n;+<:UaW2j&a4Bn !Jd155)TYXdN&F([uF uSY&AyM'm&PYE3HMX69ց5 ,^]1Yxq9߶)I1B㦊ͮPU":aE+SqSi"ζJs >. /ifH%$$yXb20g$O~Suo:-ld'e.])Sv1ɋMÁvI'2䜑VA"Ҕ#$;zZs+$Q'%+pt!P"˱#U)Lcy+g@H"=i!l4&5h$!Nh]XDYHOH("h-C KeFř蝁,m&ym=&ڲgsp`Rq9Sfq^s5SG)n60s>=ҕ=ȏtWZ$J!˰m4] ڜt~1`o Lj!i90;ؤNeZ&!;|𢡄;1IEDeuD{Euj;N%1<&.URzؤb-tRKx*GYZѢj&22PBQ4NJT˦xQ6GqV“jt T P%SuJRL7QeD45#wֳgAl赜֯X8"5L܂8ʅRB'w=[̻xX:NrPn1r硻\DvEhxRbA.̘EYldΥMz4`;z<+.FHxgSYᠠ`h\VEڤ) Z`Rv;D6"dn·ftC(Q3*blajmM5$_>#Xī5nFZ202]EuR iLeN {^\|лJμ9%dڨs5E㑵Xc4fڣR26[5rZFQ|10MlMwS˝T%@DѧHykAEavińW*uȝݷvM+UvGEEuÉJ%1.gRs);PW"n7-[Fه& ӆ5t훑]Qw;9$( !ld!-4`JI)iAcre:CWaWhv#tKTu6lO)IR܅EfNmq1U]S[,4#(x 0;ܵ \06훜&=^F%$r='u 1 NSm58N5&L*٤%Cc,0?S<ZKku@5(7m:gn,O.JL8U^P\RLBgNsM;*ld`cέljHE Gx[*Cx]tvbP%ڛv;#tŷcgNZl a0LЕU$XvW{28N+y1qb˯ 9>ۯAyZM;;m !p\v芩:㑮0v椬R8y\^ ;8xB,@V-2u[wC7 59qؔaHX) yHh,.osӢ2L&ȳ dh<'' # sC1L'i9cUfWn{ԎѮÄtP4f;`m-.EjIe4M6AFsnrt[r`,APDTY**ԚjЦg508AE*RDwS `hAVn+S5f镔mHޥ@Aˢ(q/1VL޵4'q%{,Ngukg+<,dʾqo:^{fqtY|1ml&UGDsvbUլ6s]OIvKVQ՝Mar=}d9nm +=3f{d1%MX"B2 aLQX8VBUUaB(E|IrZ9qxCPTKC-#i&VmYuPƝY1pRR'^)ՉΏ+Sa "*FXձBRuH KM P:(w&,t6S@LT[wQ-sAF F z.1 ]%JK\ۚp^ku+E "yK<}=s`9]ݲIs,97uv(kX1g 5!ɓyGw{i󩚓 wgpuE1F$k,k[Φu׻r0\$${W~w(ڀRgy`b#iB$W"w4̉Et0D $ܐ A糺Mˠ2Iov܉M9u=M_?=,6DbvW4JI0QR"#1#!rgu^HL3$\w<M$u3찢*[KZsY"6 eETNܛ+ԣ:؂v**Szd#&\vXwB%w |k]90%H樆kVm6T*sk$}}ˣ?qWS blQ*:ec%]v[,QCE+XQ?=5w(w]C:uȌq˳=\LV\R([?,*Q|}قOv<-\>YڄDEEcRəb ݹ9ALK{^wtQ p(A[Fا/=O6~_7,E߼we. &c&Zhyѫκ_]3~PPs 3F6[<·Pw=7T'-3b=j̊j `f[Z2(1EQV(ZTrSZžXsC5ݤ3(3Q8Xǯ_BW6UAS20# yv\s;oԿ>[?>/m0 !KlDkG': D=>n]>Pl&"D\߽iq.pХ əGE5;R"kM6:-fQQm]fy~uO, Ef=p(2Mq\p1Y@ΎP CD~r sCst0!q1 .+d]F .9&n!~{$9#IF3D}HC1߳seժJ[;4" PcBBnk݋FvfA'.1';-\rM4j]C2..6 (d6*\=su$9t|W$mkwͪ3' 3;燁I$𴶭jnV>.ZY7ĶU6Vjja4o~71 Fij/ nj!\-C9MK,ףh+|׫hn TJ`;5fҵ| $e~vOr7,QWWT%O((fBBzW҂~_y9Q_(^'رA6A G}<]oFԑ%QIю_~~=e9dn? B3ѫ"&oZ^hf,owsF%ꃶƃ[S 'P(~A[TQ&?^?Te`+ļ ϳߔt6Q*%+x:|e>dxG|̣ϟD/:v?-#D0_|#࠙0?Z>}z=>F i$q0gY' (N 88!B3.>A$3`7PG}ݬ<}w45 -E"*'S6|޲V,U-=v`I659#Id6"-W/[|6$Dj-QA1j@ II3[3}uZQ/E`B1D%O-SUإ^[tX5K1>ЧzSemIh2ޛVQo 6tFsɌ&'0pYmXs "\9 2oA<;$#Wyܸ湹6LE]W p1Au*u c9{ IPu܉4 TcFEeB}Rc/UXX\ W.H +5fyId r,Ơ*²)eD6@?H o :25V :&V>沧 [V*MvU+D(b"?>_bͶsfu[|J,Si-|VJ ޻^L%"B5?^iݿjQ܄3W9˻ǫ_;} (JR^y*ee|J̌0D`ڻhY:ɶRչ"#Q/ŪBݬ*jJXrkZw;(uYK,9߳Hi=! _־fkSYfBZ(ҋfaU*L²(UnBͶ_L*^ַy;:iYi,$՜.*n+wtGL-Jp-a:~;aD۬R O%D DD[dŬiiEj4Ыc`R')!C:fXUd(}IQ?iu'm_UwwE9-O1AcԈ-ϵp0V1mvO6'K٠"S!5'xmb~훹|<dgGH]%`r?~w6$Q0"P(ʾ)LM(l4K ]>}r5pzUhT_&  )Hy8MI&-r(ϟnK|SAUS U~w,[W(yaTXyyk!X󖨢PFu.MwA027sK뫈\BGw$2VBVT=bSām+B,PFfJ0""#2kRo{W`I"tGuwD.ԉ4U y{-]j,K`VEC;yl mͽ|Eѱt{\_5srDXwv \\ƨQ`Nr0R\$Eܟ"E6SBmق$0)$I#%r hf+סo9FEo+sr,[Jʹ06Kr$b,2Bc,cڊ_mEj62 fѨHI -UDFf"  V,%13!-[EE EF4XM%hchhXɍRiV6e@ThIM"DhQEQj ,50 $I$Ejfb,b,FĕL,!HIb"D"E6J *!hlhSE٘DLX$4b,`bF-cDZ,Y#dDhԘ20 ,$PȤɳ-AfdX4)MADbɣE5Hm 4Q&6Ơ,lI1,F(Lbi*4j(BBQR&-TFfcRLf̢$,JEI1&LQX lBŌFAX jFF&h * I%SER"jB4T&ThL& LTc&S)(ZB1D&Y-%PfmD"2#),hdɌATlX "d&0RI&PI F25Y5I+cF4!L2TAДQb4D" (b2Q ,cRI-&44f4Z#$lLbF00kh-2Ɠh2EFCF h"*1h(R"J"A4bJBJ[*D*bEF56JcX 4QDRPe** (MDRF3#X4D̘M, 44Ik6,0EI@&cRT`AflؤII$E26-+Ed6H(5lTBM*SImѢ-a(ڋEdHC`i%Dh#E4mUѤ 1DX6JbŋE!LD5Q،Ab FAi1QDlTE P-FDaC$QQb66QJ4aѨ34Ebe&24Bi#RhC`Dh#Ȋ1$E$1cdA,lbK3EjB#!Ab 5h0kZ b bll,ch "0P2b1L!DT2I#h 0e!S 4Ed"+%ʌFQ,QIIFPXIԚ%Qd4 "Ji"d4TP5I-I E&( E5%&RlY6#i(($R4QAb1QfIk*0TF(""T@dČlZ1QHFFcE IIF@lb$f B QbF$&0i "DXXRThY I664cIAQ2`$1%F4(d #%  KT!I "61b)"(**fX61AQM!XlT 1I%2eЕ20IJ(S&eQh4[1ML$DEETQLcL1F2P!B"X(F6E $Ɗ XDbBƢ `lcAb$"4XĐ EITVb"SDl HF1(1dh(l4b()dF1%%hF5&+&4͢BX 2E`6 5hR 2hThِmĆLEFJb$!LJ1LAl1h -d%4 dDL+MY5%cXэEPk!PP IQƋR3T!d6#3ccDj4!b-$h 4lXHF$0QQK 4H!(LA" PFƂEDlBTȊ65b""+%$lll-(Lh QFdi$F#L&h4رhKRQb6DX*$F`hL4k c%04QE!6fc (dTdM4Z I$j(%$hƤXm(A`2Z2X1QcEI`,"DbѱJ@Ě,(`ѩ&AE1E%IY-h2dA"0 "6IHؠRTd%lXQIɌ%5FcH%3d 30BDi"B $Z& *LEV5%c, QI)&RTJŊSbB2DEآ65cleDX1S1@ʙѩ$Di*Rd 1ME$`EkLRUF)()0[b(2lh2"ɢ LL" IT+hAF0I [A&Ţ1EADY2CIDlh# F#1hĤƑL)(QH!%&-Lڍ Q$El 6MHjK(Ee4QDEb$H͓B QhiFōAbb f1I4Ql5C# *D5#BU%`RhJ3Q 2dQh$FH"ɢ)1$b,d &ыDj*,T@E65 RTJ6-EAFe,AF Dh؈$TDPHѨA bZ,b4QfY41IFE$Td,dRIlE!QLc3DK E!h4F5D BAb$Lh((L(6D34cьIQIRi*MQPb1FhL"(͉2EH,Rf( "64TFI"L͘ l)IX4QPX֊),hf$!A3Ici(ch,B!#QɍX!4QHi4Rh5&H6"QRlQh&Db0I4MQ LL(R"Ć6B4DJ`RTbj cI)5U0aFf-% ɍD10cS6bAT`Ţbh”jM@F&F$cF2kT`I3Q"1I$XJhɋ3dbd2cdMBQ *5I&M3LFDF4AaƋhŠ$Z&((eT)$%%&5(* ő6LFjBƴ&I5)4(0Qj6Ih -"54i ,XBED#C52,b F*M,IQ23$ 2XX1D(04T(QD ȈȘhF F a)hY4ZfF&1H$%3Q! 6Y&TFX,I0fa)$HPEFQb 1ѓD@$(F4ES"Pj"B2ca*͊(E#cF) &`H5bbʼn,!BE(Q A*L&M5c$ID-F&J1db $1F #PmDI6H(R6Q$0*0V2IQ %4mPm؈4"2hABI2!D"MbX # 4ẖQ4,"ll$&KIMhAcؓE%I)*C jH4Db1RQƢKEXcPT$`(ƌFL2CѶ60b $ lbMƴBI2Ba*BC%h̰Bd,dcf ѱDm)hԔZ, PXEE4b$XmcLebi"bFXŢѤhMAElbH4l4mM`,J,Q$Dh+a"Ɉh4Ԓ[f*I,+ER&eeA(I#i*1LI6E`&EQl46h0FQJ XFli"ea4YQE2b ES1e,$lE*"ԖfQE e(Q*E&4 $ID UQdY*( bD`(I( ZabɤV X1ID$T&5)!Ŋh "YHll5h(`#!F,BchKd1%&F i$ARF4Q& fATX4RlkDFرA0bFɈY4$%lXPZș(F̃3&AcX(6HT*LI L30lFŌa4X,L Ʊ4 2lhD`21REDBbP$A%J(lX E4$j6K-`M VH"#5J &5A4E(ĤZ4a1(KAYaJeQ1E%&J#%DbAD$bJF ЉBHlZ" ,Z@(DEFjL!Lb)&a*4A4hbMFbKI&HE@ThL, 1Eъ,h F,#(*Jc$X((DI4bi X̌B#jJ* $`hFIQ52),lEc@lRIJbTcDFjfbTm ,ZH h`IId(J1&"6" Ō4h0 VMƱ&4Ib1Fōb4PAEhd&(Bŋ2jMF"5&F4LX$E`1If 3dR 2I&ad*5*"MF*+&"I&6"1d$Z3X("1Ah$+!I (Fэ"EIAh 1T2e lLJL$ll"IP`Պ"5Ţ,HXB5DŒE 66((hbj4DkI!Pa0`4R&6,bb FДFImX6l+!b)&Cc`Qhج[%$j,l%b$4"a`آ(Ƣf4DlQc&#d$V1%MHEm,hbؠTcHQDؐ&h)6щPlE1b*HfXF5 (hɍ@1 hXRhAlTll$b2QbJRh6&D1IDhѢJ)Q%&"ŌLi4IF,Ae,B&I6"4Qj R4DT2F&6)!)M QAEQI4hH4Qm$0#!Ac$LXƍLEb2 QE 35F6$ AE#lQ ( d-%DhF"Uh`d$jlFI1Q#Fň%%ImcE&1-",ęҔT*F$i0cc%A# kQ"4&ƍF,lhY 1#بZ$D%L $j رb1fZJeb  0flZ21-(Q& mIA,Lcc&Ȗ3 F5IDb0m!$V m!*52EDŊ 0h$F&bH,FjJ!2E!A% D)IlQcFX@ @m$Fd`dlQ$I h" FH4Eh53F"1IRblF63#QQ2jDE4h*CF$mŤbƊ ARRAPI(Bh i$DE$RXM+QX*$AZ6ɬD!M+$bQZ$5+hMD%Qd؍&JV-5cɍF"ѓlXd-4F- HQhB& "؍bR6Y653jf0ZLThK),AhQfcDlb4FA6Pi*1lRFŲVFѨi1,Z F1b1h2cF#Aa4lV6Ebd1lZfi(1XE&DhجZ4mEE66(QQThѱmc&-h5m f`ƒ#jmEAPZ-&X+EQţTmi6-ckh$Rj *&6(1E(h65EjɣbѨb4Y(mTƤj"*6M$TTbشcbF F[EXXlѣmh6-% -`hCQQchcF-4UEc*6+QcTlZ6-E"ѭƨBƍبTj5Eэ-QlAmEEccXj%QDlU"VKbj5֓jDm-TZA(*-Flj-ѵƂ21T-lQ,ZŊ5b*V*$MbĕAƋl` F6hƓXbEJѢ6c1+EX[*6F(Dd5dllVIQkDhѣmDXبՂ1R-&EcchEEQcPQEEQ Y cIX4TcѶTm&4Z%شfX" 5Z-Q cb-PF1hBE%FUأdmb-Z5Z-V1chZƊhQIXRPmLmi"h64mbѱdFű1IL,Z"[&VMljɲT64ZQlV666AƃFѵFF6bQbh-Rk H6*M#F6+&ōZŨF(mI6-`ŊFLEQcXDj4Z* b̭l[hXbb5b-%E 40i,bd`Xڂ`m4mj+ETlZ"IL(Ѩ1T E$m!ZmF&-&h2Z"5TA*DBX5J1bb@lmF#cd,LEd+lh5E[&TX5%h24cRlbQdť,m&1Ia1k%,i6(5H$bƢF 4j6JƍKbLk3mXب"QQF,Xؤ5Z(4chѭVX655b lUب(ch*elFh1%+dXZ5(4F1chت6#hbѣQE,6+Di6bcZmEF5F(ljYAkEXmb-Fdlب6["dkDllmcEQ*4j66FŶBQTY"%Z4m`ړb*XljhU5E6ƋF66 6ELhm lcj(*6lAlVQXlZ5l[KhF,Fcmb6,EEb66#RhX#h6Ѫ5FMѬ[2VDb#hQcmlE6(FhKQ6X*,QhZ5Dj#Rm,[4Xh6 Eb4Z6,֌mcld+%EF4bd66Qj+ "ѣIQb- XFEcX 5(h4j4FѲk,bX2mEhC% j*6h1$lAF(hF4E&1-b6ɱcl&Ѷ ֌lh[FحBhClU%XEchUX1V5EQlj EF ԥX"*)K"mj&VQ`-QfEj6jڍF#d66+h5&hj4b- hX- EImQc`1kFj2Dk[VKQH,J5QVk6i#&5bŶAIF*mDXB-lhQTb,h1cAmEFi 6,[F `PjmQfmclb-IbcRQ4DQIm2جZ1hѨUEdi-khY4lk`i-+2@FbY HF+6"fcFBHX**@(dbZAS"i6ű5-IF1T[ŃQhd5"ZL6,hLl%l[bfV(X""ذcj5ŊŴd1ڍFj*M H, ާ"@DâTD3FAI*ֱJ%BeFFVh[6[5v0)SԬ;Zes 5tL4MSǻL7ɦyQ5[ȥ/dٵUeVjDw<ثzꖤDtkF,TWU/5 ͂_(*yyueFyJEDa3yܭ j3D+´b+R_4<|Ո+(̖>)K֥&1Np&;1o:$7By^Uro;x/RT"t"1iݍ;t`9h˻[-}i Q73g(#Ml[naM$ng‰"Q4E#^nxmwH &MhB"I6,tl\%jJkEr/oW؋y&1'*-{^>c\4m$L(@(|Ww~|wsd0~{$T[cnrV؋[h;nQ2^ ,!R,S\4Je}ļLV %_PhG (*-dݩˢ2c stoϗzUQy|_c&"KA~:"#/ӻUU}bNs/}L 'shRWoU|8XBųE=ZPEmG$BIwZPkv㢕%gݷرeqQ]5’R.ZLBMmrrI=뾼P_2+Pu(kMyIQs`/뻻syƹnI.)7uhDYHrUW:~_Y̫s&F *۝i#(B拻 D /. L~ +lmߺ15`.hպM~{FE=kn292P~sg$]&)9mwdW(( LZݮQENŻ0Hi XJ\quħ%9;PP=R}|_~o~YYRc&Pϟ/}@COuBh\wsn1dQ# i(F;t]øFM9I3_72mt+˛BowCmJփr+* ROޛVru*Eձ[xZVbŭT* lA&/\1E˺[ssnAGu:hslPZ-mUνs(󲮤ܰ]uuW,h~}4q,R59 n9}2AsnnPd IӎQ9ԜKW q^rrdQSAg][qð\]8k]Kymyȍ7P)=ǻd(YHaSZ2Vio˩S3P~kw_Md euXW%ѕ5r4܈UKUd|^bʋ+mVP+mkiK޴ɷqQܑ%+6]uztBpq7wKb*5*VTqRZoj+཭6kw'[Er^Bڣ9FOw__H ,{/]K&}hѶoiVW [xװ-bJGj_2y6+YUmjJ eG%{ẙ.J]v25k&*մr t/箌hʕmQ,a3,_|^>~()V*RD3XAB.a [WJ#\r[d g89I^kKѓ{ ENhٿsZ:LJs>%Hsm4-,"qȣ, 6>IfEDL'[VdeÄ`ZȳZ|hhh]pkYhۗeKe˵'Vq4j*ŎV`<^.ZI]/vw_rP^f׻^ #( v_km5/bJ-(~!(x/:g022J漼ݤe*VɭC?Q :boԢ1?蔟-;VQr2-ea!\AAEXJBRV $t1 @E wQ't=F32M"_?\3MIWw\$ܝj띏wno'e)%l`f*]*'RNbB,V,fQ,]uE,[Ew\DNKUkmpys墳~U07~^Lo*2Ugu`;h1\NE/;眑5]Wv2YUYQѵAVF{Ejmʕk_>wGÍSX쭹OdE*,Ej δU`(m3R4Pȵ+=ayQw]]v?#+tRZXZ·̈́jj{K~/~;ʨELQOֹbeR/\׮-u&ޞʕPKnhBmY?>}|ǗUSYfU6)V+]h){chռo̗o WO=%Bȇ<+tP:E&y7)?0Ff/ߨo(āK/B<4>ҹ-Z^b],"lD,Ilr#e{~ȋ*[\>qTH5|>}DϩO}/3Ea7&F#J!yK\ 䴤 @Ob DXog-M h@$DBd@j$ UAP$O{,cc<Pr|CEk\ùz,û!('E)1~҉H A.zI>uG=yo3/+$=z;ђHWNk"-|f]X(0*]=OSUܳ?;QA;$Qk|D_}y+*%G߾k,bDE)m&w bK _tX0_y=DXmDHFyeYcª jBX^@O!ȫNܫsFܹ9~{$ch#%BXѱE!PԞ&T,@s~^^J1B.v{/?FdRL A<$AP1$$h1b#Te[bE[+ԞvhV4߻wt*+kͮ[~~EQU4k{30bѲI}u;]hH'u̒KJi&Tߛ_y%ЫFAccmcQFɧ !IȳrJ6E[嫚Y?9lj]ܱVh_ܓ.fQFJmJ\"Vk5(1TQCUfЬ1FMu[/͓_npe]v.]R%0Sn&9U[g8سiP|mkErg)*ZE .j9Nf*P*M]תce=G0UDwzb+Z6[J R@95u,Yes~aL#I䶫"Els(QǞoE"'W?B/D3c|\+ܴr湵J3\\-pܮŗ\omdۜ~}|FѿCgwBdDX w\I %__ FR 1o޸'}}cFJLK?6Dhw~td-tر6ܫ6 tn^jjW-Nch6cZ}5rы$jJ65/8E )`fL(DY4M QA,RbF 6';XEۘڋ]ѱwU=Z e/9%/PK>GN~r0aCA""Hu޵A?"|wMlmWjegƧE& {*S:͖]>lO||usN[ߣ|EVZj*ǣbd`U^!Y !mTyhC[6uk DdhawoϞ>BDfԻkaDaXVTPHJ^v_{^F*Ν h:r$!\4l9ڍsLHܸcGw[FC^LC[Wo˹ZŻ}ܐ_}5T+ ʋqs\JZ\W +^f;X$F,"J3I*=ݎs Pyb*VQ)AT~W;F(xˌe[Uj^yyu M`5vc$J)ICg~LIKDy>wflD3=wW$b="svg˛{7u>=緎ڠeǛwBGn#rFkAHOu;MsG/Ie"s^G,c!!M^tvvܳ]֔gKk?Yt}zWYYh-VNs/>.&.qLW Иd!.7=׺b/S1NAKmJ;_}FCeW7wG E*) j>{J'^L*)*(A ؾv(Sz9G]5.f[]ʘ]#.n}@Ҙ $wyJҭ;17?N*}NIi2EP^9`b25Ҙ@O#76`:ydkj[#)Dkzu(GjF,_/YXV]ffh(IRrYR3^6{<)SiT,FasDdy7* d((Z뵅bmi907u@QS!땇5*ѧ8b3Yu$&.j{^ T1[2kPzzUwDlPGQ L+u~V]v]-7X7Wj蝓Iwpb]}uwL Dwq.v1Uѐ/s{ډ]aZ"өUȢ({5LE%}umGSݭ쳐X}lh˪rѹeyfVuU'VMwTLߛuEwqF.[rMXJrwXv"*R_w`BѠT-m\(ur]sWZkurb8#2_ 1 "*|jJd/%LͶ օL&IX4e'3%r$Ѵn/7^erݭus^(d )j ¥@" J%AP5K[_ɐQ ƥLn0TʊdUkvQ&Cu'K}QߺƂȹEscWR*8au9-*K^Ri8ZAG;*?6+^f8xbgs?z}fV0r|=|GbV햑E;l[6ڵm|{bԜ|ht%MV-$@%I-3nv1ɪ[g?|g\I|O;ơ+W6'Ekx{>Ÿ<̉$J2M~IΎVHB?Gvߟ62:L N) B"dgwEx٧2(=[MPGw^;$@(?;l* y<= k> N.rI.~G{xXm5O㷽,WDm}C$a h{u}ZoV󽞪J8y{Ev <|P7wF̢w(Wϟ izD,υG;P VDΎΔoj =,yҼkQܻrAoqi hA~(`N#yE>|̈B(=QHy^ :f <-.!`C`i )u͖BMuOwZ+"ѵ~guhks]5 ~Ky͉"fBeN޼XfE=׭+Rb#X1Zq)n> &ŋF4cLǻ߷ᑱ<&4߻t^fĒ 1AIDȰ2FLȣb1m%y{sk*krkݯ*FTyrV-tkTiTZr9\#vッ1LR@I_F(Ԗh,cbm*6sd[X(mͫѪ#w\tl/Y"`RTiW1e疮[U+և˔S<׺p)r8J*^CzyL^l6xׁv{շmfnJ&[DV/&ovճ%-bA+E+/XRs+a6zک{ A0~_*(~q~G[侩.\e6}Jzbdd=߷ 2J 7#\?hD,op$軹0 wp;#6%3Dwi &B :ȠrQ$U5bZcϾbsQDS<չV۰h *VjZRu0`6!ݮтK݉Bi"a Q~1~m2^ph+#ѹj0dƤѨrwyjk&-sskFˑs[rŢ$ѱ堵279WKƱX.]"S'n$"0;H(in"JdVf΄> %ڍE"ʊ6PmFmnh;FQܑN$ ؏ˀwaveslim/data/jumpsine.rda0000644000176200001440000000376313430347452015352 0ustar liggesusers혉WW5Ьt"vE#P0"h) 2D$ P`> !afPI@A"-L_H8[{Uo\#QP+HJ99"GU/&>|)= ؖ4]؞5;0;ˮU|tɃZJؙiC}Oy6 =8ԣP?VşwPG,Pozp2hoWuU&F&`IUWa+E;e<^3Э:z+ aqKGE[ЧxU}/nDatIO1?uV0b6pL v>Q; < KNm+ft 0}Z[fYgf7 |f/yߡ*s-Q#//U//Tt3Au`C>2 sGYxtjs2A0[WY!7P ͓v ,㥗AX[QxdI*m5)჏A>k=t[U ,{baײx<q?^Z?#1%b޲qt>8/# O!'"7O ~/~S1}-bz'~b?ZZ??yyy/y? t>΋:OBK ?<<<'/<7?>>>'/>7s<p}z>֏~̃y+>Mzg cBydç֚\X/y&ӏF;=`tf,05Bz(`SW Lj`"vxǻUgy[a`,Ͻc ?-~3J W'6Ż@mOeŵfѻ6& Q< .Mp賊f7C[ !%m{pp9tN5_}༿g%j{wK8`l.6;_It$]u/jw 5tZܦu`?`='o=9zZwq{dXyf|Lz'f`塱.c$+| e{^>н+8+GnyWպ"G<,Ic X~xf@iX8])u*@W T11>^F]ns\\]\ϖ9/pyF“yd }PKvy/8yбL\gz:J `Tz^ْ$I }UbqA577|,W]z^+袶9);s5Mzħd}oh[s:-=AϹ M)W UV#k6sR٧Ojf$W%]}3slsٮq}SvҖytr:m1j>T:$Fc 87[>}cf^oc.^ذ}A>#yД>eG!~E/ 9E)8jO|) }gN+<waveslim/data/cpi.rda0000644000176200001440000000252713430347452014270 0ustar liggesusersI\e2 A\(t=Uu5WW{Y: WB+a!• Jʝ+AnhEX~{-7ܼ.f.^]9srsNp&s+'w^;g_Ν~~s6?K<Ƚ[9s#2Xx'}{QWsЭ~N<{<集 -e87瀡A?\8gj8Wqf߱{-Ǣ9gFoD/_¿dONE"⏈)_SD;L?"oD~ύ@9ܰg Ή|.7ϩ2?韊|D#`x#0oeο}/u-ȯ@o: t(QпA})S4y)-ɿGވ+]xʫO2e}r*Qn_2ezQBGE+tUS["<+tgEUWխk5k^ou^g ~6φUQ_U_忪O5ܣoMߚ5sY~ͽM6tӽM}t˩W]>u}¿ߖ-uۏerؾ ~~ضgۿfu;e<;+>;r)nWݮ]u==<{@V׾ex`,}qH!C:AӐ_C~ }7aM~54_iߚź54&-ђsK?eZx[eZm>m9M m6Ƕk:|t)>ۃUg>ӡ#;rc9vۡ=WOu3\{ۓ_ޞݗWOO_N}>w#w$#+?x8{?x433XlrED B{>0C| 0h^C0gXRg_m?PO\_83wDޑE4SGDBs#3#{4t$gZ&'W?B<>$](լob_{Н={Bg"rO=;Rv??JJwJw>nF{Oj>Aj>_r.ޥ=;5}rc'O|u䇫xy?Oȧwaveslim/data/japan.rda0000644000176200001440000000152213430347452014600 0ustar liggesuserseTiHTa}9[-B^)aaLR)!ESSh# 0m#HҠ0:j9::Ό9Q=;~%&z&{ "\]* \ Wg3A-b]4TwIܧQqk axM 5 q%1OP9zyeO_ՈNk4|;Dme~ЩQ5R56S V{Rk;K3]Aܕz=?C]w_Q{>Σq0@ЋNoe]G |x x Xp$~57$ ?VOI |on9Myl NʇNF ;&N )cѽ!_:Sgx/t85c=_ n&)f= QX+ t ~z9}d4ȫ M^o8{b4ps~[o\FUyo! 4a= PMaEϭz˺*g?!p,p;qX?w}\oӼq3tfL-9Q[rBX^޼9zrb"l] c /r_ oK7;CY[c|=CŐ;}@rWI{O[^ pI9/p>hwxIu;u|deyN{'V&a'Dwt<7Wz+vѮwaveslim/data/acvs.andel8.rda0000644000176200001440000012640413430347452015624 0ustar liggesusers7zXZi"6!X@])TW"nRʟx8Og0܅>_U3{ũ@!jkUT0ʁ\v~szHyk7#,@ιGc뼌_Pܸ@sȭ_}5vvdWU?ӭ#?*ln[KA]!xl0 iլyh@f-X/zуH0qR M|HSgWk{ҕ3[CˡW2qKt'uҍ.s(#58V@`&l^6LŁ(kmYt;"Ý)&OO cZrR"^q|!JQ*nY|*)~yAZ 2$zY}/4֦_AgՏͳH-CsJW j<9gO @<6xN1ŶH>VL.>4Ѽa!f;4K,=(+ ֪G[)#eRп^ >n%br쮾 JLR:e7XpmqzC4Iܕ`vղkyC[,;C=KE.~23Tzձv5S.sǽ3e ^03r,A<}d^%:+3hh*߁[D,i ]Hh $Мllקpefrޱ^!WJ!}dМ".,r319 L_\xքg+Ӊr,s M8 ~k`_fSaKMX9UL:N c^x7FV=Cths2X'6*aZKs4QˌX+6'ްү Pp 񖨠yJLQdΩ5 `w޶V9Mžb>i@}F?vyM,/ oe RBoGC!NLoS""5O w.`W9XB|7 ం-~d h1H:ޫ4Ҿtsoo8OY? U.RmwU >F5.⽪b񉽿?҅CZgj͗WȤy' %9UnH)R0 ~4&k]))h@ކ¦||Ldb!\5-/Veͩ-ȒjL#OdzIQrQZxpch+HaX63m'e=Q{0e#w |*xb8ŞLl'/8-/*CPRVr>ؙlaX _|Y%C QGc~Ƕ4IA 6]B7!$I'dCdC8 VhjҊ?>9B%)D\fԗ0CnQc$*6Hy/4gOn i^ a$7#?$#wlҮsg|NhxWv/kI}Lvy}Ԁa&HT7Bq0սཙdwO- v;./&m4W&+Ja}_6EOzHjRIjo|wW:ظ7:/a8c"LdbK)[YbЏ%½XZ%އ?̣hUԧ"©}6ɤS=rM7Dw ᵜ9@Zp O16=exsݟK%FɱȐÈ&,UckZN ԍ쎫Fyꦩ[C?'-f763vSݡa,<PDpMͨ?MV)_"һ!u'rM@o;/zF>QwAxvҚ|qa=d_c햢(],AbY@w?9/Y} ~g0Ӈy|Q%PW>fS;Y2`q:3zHIG7lГhɛ#v[\_ \Cy,cSzZ[--(O6 :Tm5CFO+Tg42)MѵRfƒ4.%x2 IpeiY{jé^LDPmɗ5jޤlG6E9*[΢Va|0z?$,`wzAcxI6w*8E_L=OmoǙYZYUG6+ؖ'ìŵAtKZ8!m? g&^q\tOȣ ȆD*ԡR, 2qDE6*%p ;o1b.\)>Ls^B&ʕP*弻ߊSpbcM:H{zG͔```kO/8BUQ+l,p*i-(5<Юe^/ˢva*6tD']Xޚa  E:Oץ$U~?JaP0Ly6 =<) Fqz N F[_jz"c14Xp% ɜPm;"QDtSUS)QNC&%{B.w"=12QӃmfCo#*|NhՃՄ»xyկN'WڻpZrx> *o=QYvpX(IkneA1UǖꁐJSRpՇ1D^Ro ]rHz1$:oּTi\iyÏ>1+6t,@EZ knjxL8sB]),`IOwuybF*F+*AϩFx+{,T !k5_!<ߩm~|j] zDx3rMjYU.<\bqɘKH@/Q#+A <@)Blژq.d{} EE`Q)' }4OZ!ЎP]W !Ih D9&EQA%/X80IKj_ˉdFzX*fT)(H mdP a Ѓt]qD8衩܌7}D֠Hp@|3prNgX&Mۄۥbrk. 旀'tPKh?,Gt0kFoig!_=wk,/϶'"}:OCU,!9.h/ÆM :Af ߩ%1PHY"_vQaHQ WؿWKp;!L,"bsf0I?J_T#cϞ8#22.бByҎ bW|l$7BFd!ˬa^2>7\.h;ǛPd` !U Z_}+gi{<iQ[ӵ (}ᢏӬxDsA^hދ3`3S"}8BdFJY9|RKK5nn@nI aB4Y=nO fBTw OP⼌gvP]}3 #%0(!ڲa9(nto-]q*sHȀ1Xe1JoωBf1&Vtڍ I G. ?7‘NF@co,D.\]x9]Q pQDd?L8B5OR"+ON5lS3dFq"e$_YpqFCQxVQyH}"eh%֡2@nЍTH#=ЛVp:ko#@ζXo䭒4 q?# e!G$vg  `hXA2"t.CqB=~y^JɰUD#Eh 0{2/"" n"V =ec*S iyuJ1 :+Hf  ;h^pLڕk<{ApU;I˒#ϝ5_R(Яԍ IU +b+p{F V;(8MwQ\Bzm@i.d菝X1? ?wnXZ]ׇ: ]t13|-"l34_͒d9U Z\c}|Ηw$ p1q'Hp;ڣlky̼\-'分wKk JE d24񳭈!k '=]Է=Q7MG񴮭 +GsRN$*DD pK|2Ę ƅqpG S=䛮sN%Ѯ/Tigq5UQQRqD-&#*ɺBqjubId%Z8M3?<$e]c~C)g~fӱA$0oKRɯ &ka\Gv=o,'j5sm)f\y+&(mWI:iEu$=c[RRBл&>%{F1,/sɖ>6dpwu,bZ(nwGtTs\ ><99x:G?&f!Cz#8iV-`+d-<6s)ria2$[mʇƬlÅA_=dY.v/`8nV "!Ene .R}l5jı$ùÈ"O"N`oP_hѹqa 0æ)ne ;^迫b*?, JU1\ ]4܆u ?m<˾rEzצEh̔"^xӭ1:`$}C"=Z FY9M՜v8Cf`+nl56^9tѰ&4AHiӔuNLr,'0(1naN "R3S?`cj o&7*&@xӑڮHQ`iLNY_y2.*p1ɍԆUVHtS&ʟ4{\hwL+|~q<3?K \Mڔ)P$+>|$aB 7}b#KaRT]oeS/ >i:tV?2NkI l ,[bu)qAu1r&hUjӻ GM%@HxqWmJκȨLƟ~0nD5ÞR )1 -p^"0KNZ:y^] TqGޅ Dh4 7@ w[$2٘=X"8tHj79w%mw`XPwC!J9fDsZ uu7L8\. XDa:mȊ@Qڰǫ eW$> 8QtNvK2Ld8@3- T`9 W ~ B6w*0(+_eQ;ʁv/6@V{kM,>=s=w`(#AXζNA5),i 4JZF2V#^~wځRA8|8'&HX<  <$!SK#F9S ]pǎ؏X2)Q&u kW. y pX2Yu<߬T6@ Qd7phYgOp>6)<*b3oQ9>#FR(@WM|tP5 ??̏4|'kߜ K&Y428m|VzMOjpaՄP џMDC1tm bl4V%&zFzm/@'o3gӕ}vwC{})/9$Be>&Zҵy2"&`ƵҮ 2Y[t~S8LB P#>,P*߈H,ǼԻ֩R#QAԠY0U(,짧&[ 0;8,Rˡ)>wҠ[Yi%RUjJ2.St]; `l%2PoVϘI/ Q*+_maqސ{B$at vOYw4 6ʞ^%p7 tߵG'Um*o @Yy{];;$c%*ȝ&e8 *Fc)vo`џj2rB -9N>6ǫEF=@s!0s`_i4 ^B 7 *O+G49@2&.u߹e"J~}4r^rS y]%Ōw Fߡ0=6LŸzjIHTVܽ2l{6 Qas>k`0~.{v Wpmhl̜v0aǬo1#uk_2;:_)mg V Y}yۭ[}9}1`zoC]b`惢 W\yj0&- _xXɅUOC}uѕ"GXedWO8NDm-?&Z<Vrx( _B*Qez7YO(j$}ܟa O_Q$÷&鳗a:dYB܋ Yl1`'+N((a@)K6k.x\^F( _T͐46\+cqTȸ0 ?v[#hzQ.kc8 ,j>VF䁳unyznV5-wOWBPϑ s/F{4&J=gr_;/a+ZNXnH6KjQta!5Fˈb袥J{@Q:n. Ѻm]k5s B@Ŵ ]OaO8ӶKolӗKEܢpdt[ʏSx<:YL3d^.rp~xȢ=[VË \V M2;|w{[5Wx:b*-n8e6A"\AOp'}SlJv^,$7$'00+΍1].7u&~3+@q*F*K> v Yӑes IߢJBDz="d._{Z؈uAɪ>Qi`d @F#y 0jiSЃDuۓsf/lE )!b崅" ]H[2bEI[{kEI:О"_%kc_Fƒб2I3&17$6ßfȸokZi OiypsGW9[K=ZnANJO|fx:$-~@V QJù}PbFP٢Ӝm ì7"q(Uc;#^yE۠"z~JE"uA9 g#6Ю_\cDD"R s%r; oO<"v)I"WxVYy9m!rh-2@EQbe ڑڽw#joM@ި{6=ύX9# K'$:$VTb ='Ŝ*0jE(cX3(la+8ksأTfFy&Ah#jגŷ0(#= p/#kTNIj'b,+U"i 7l8l`orW#dDn'Hv7:mL;b[ d7wP&w'n>'rEwt*_?Ӟ1(!2acd!LIG~aV]HEl=WNGB20%>Ng_CgWj^æC33p1kcffzN<")]68k!:VVSjI X2mF9YeB3Ds>U4WJid80PD90,RE@z5{ bn\{Kp聘2>'~./L/0;9 |JDf>ӵ8N#"{Z8chajzB;쁴15c Fwwc،z.6Lƥ?Abߣz"Nrx,1qOf`BS81/»Sڎj0Yof}#eɤKGY\Z=wJ>?gb)*azS 5oz{SKb{_Fꖜʁ(;8 Ƴ/}rK;g 5N ^𒟤=[z⍞8GϐO'?"(cj,dMH-V$꧸IF '+x),/H@BC"3eh6 Tb9ceĴTb'ME3A?kOJ1/KȈ t[kKiw)jyx=NdoUhzZ BG;9l=¬+}A>,Y" ;lKJaOj Gݹ ν?+[1@74t/6@Rd* c-B#0pc o=_qok30HA2qSGˆ}:6@U⼱V~fsIso@o>Z~;s{i82t:4hx@biĠXUSӆTG tz d%/Jϐ~C =H%>FsYN'AZfeNӴqAjD>pzGTW",Q7(RjHT1|P#| EJ8z<ۂP}|! ^M'e(? r:PF >9Z O y͜j(Ġ,QUq5Qliç=$fŽ3OXZ0bkو&X(v"s*[;iphe-*@iZ[Np ߂Sl←"t;^Do ޏ]~Ѽ=z8܎ۉa#wZ5W;P;ܤ9-]"$yg :6D56 ]ވLGX흋>p5ټ52Y[I3W-iIbПh䭆W2٥B2N  [!QiN8/r60{Q2[pk9Xঃ׹n1{ ڱU U|j~M[`/.*Wt~ެk$NBP)A?q_"WOyMa&d! /ot =-m Dcrd;npGY;OPc S.s2P1Ӫ+];4 ;lp1(:Xd?Iakg|VoCʽ 쁘=Vyjy7cdL+p^9j=B.s`zzB3ɠG%x12ʑ-M4ykb}mb. " Wk 4 !#0o0.5,R=HYJ,jD<+ |-ut> e eËچ(B^ 7/("&Lnx_R7<) x+t=S>jf!G{ Շ|7͆C k)Kb Ag#z~_ŕfEߝ3`n`C[vC[ ?AV9-l5@Pg+8x_1$"!͑~fFRws"5p|)&kTζΨe=^^gr;IwjާeI̋J/j\UjXB,c9"L =ltսYiDZߴdA<<,bω=C8Hze }CMT"Ǜ[gqװTdW"k]Dž zܬ=;Ջhio/#u i1=vJIqLjߣxi\ݲńI|%w-MãZӓ'6U"{܌t-،3L 9Ƶ/D6檫}}WkrwH~~d*3< IB^'"+3+3O}bz`AP~mr`;!:?[Ւ_FI6?̸0|xxڌ8\TAqS}"2CE܅YD7&(R" 83h `f);|⠟( F֍?ȧ2 ~R˺[_!hzcTf7&I}M2XˉS3l F ծA(a Rlېuw>4Azypvj(ޛZE^m5sݼm8[Yׁ_>$$ۧ>2DuJܳ)ۀpƏz~T&Ym蘷%3u~h•̠L}'}]zBe"9ɮ{~b!O9)˦>җmSj!GHv HQ`9K|Z ʸq?lRMI m^(s5ry I%N+1< Mu,VYoU(5$> Ez6jȢ<) 6cb+P# 'd r2Jk1nA.l7D\ t. `V7D||X|#oxs[%ۗgơү$JOgafXl(WxEw6x2ڹ…kFwf6g7K~sP9hH؛ TÝMoaB@z=gJn%]=0ûlчhw"[ 縿'f<`lULӑ"?1 HA|]qa%8pK/:; hKzf^&q7@ $4N̰48,:~;²ל uAGQ"-{E5 62gCzCC4U 509eugsQ0O;  dQ"M[<5 Ŭ[734qlB榋48T1ewZ3~'w-uSYKǬV+NTb-?nsEpzHJ Gk47anWs(Zhh;xj~Wn )}``ty~u/p9C^^bډA_ [r* d U)jA/V d0[ d#a_É Nox@FX'_/\a6_k:%uD -ٮ),nF*d$o9CðR´10c*J5,PP⑧ );J]} ,⑃Ĉ|`q͙A;p/]9x` yHe7g-1w{somkt!SDCAFXՂ ? 5Lrj" M$fG7A,冲a>6F`pڑ׳yJLt-[lX[7B鈮_ǝJDj]UREjF^mw-/N'*SATd1UFU";i7@qʼo2${;2s({? V-(4—Q߻օDuIQNd3\CYR;_j?k^EdC06`Quȼ*u J䅘~/0TTXhǚ^4Y|cʋ$f1h W$ !P )b#vqZ-'PXwxV鎪vY5~sI . &dbA@nWFWrUɶeӶIp$BDDZ05|xAoAWW/2,%>AkOy*C`t1)O# lԏz"M ycV4PLpwjdqdʛ%UM>^T7=AW@&5U*ǝ2H޾L9Ayϧ\& o 1 iX ,5v퐾 /BjF,(_m~\3':s' mRWvuAGH x2mZ@6!^k@i4ᎉ^9ѭcx*3G*Nm"֚Έ+"%޼ HH+\LM9D!!`?<'TIwEǩ4XȻқq+ RyEE4sHg٩#1e!(.Qfd ǼY%r mFF-s?S۲J*yS:abFVg?QsჇ~"ӋZȎ^]arڿuK?bf.% r՜G.SCJBt/ Ha˄uQp* gmbA9l_}E҂p`+^=!} ʑ|4 ĵG"nLۯU~J#T4ZzPe֑I䶩 mszuqvWΨR~(.d2[*L'^B古:Sl]!kK Jӭ'͔G^!mԌqbGD圳.{"-Ldxd6\_p0Ly9Q=8x2# 3l4[vtaD A+{T b VrBEBSܠz\\2,{\0KO5Cc>'^'m;:5s UQ21{5]3JZ)3=vܗ'{<5-S,xaĘ^sGv4CLUgy;f ]hG3$:o"0FXati`LT&r=Ix }9~jaM,^1B3Š'LYE{bXG=G |٤Kn E3D9 -Ef(oާk9vw)=ιD+"^dSN[Bye.JΣ.&eUcc@Ҧ>ϕBwtBiK͊M|D9r K#TNgYMPHwK2XVJ"83팼 xUFoc7 JOa93Sݣ>32H9Aü߰H jH"NeJpK(C=K$ĭyt8e"q^ h" fve|*.!h;J7G!1}ۅ3` R[hNyTp5d VTUMyZWTX8SPGp9U!\V q Xy$7n^bCu%O C.UGYfWam%fB,C[n 0w#۠@՝ N;6 x 2*EJWGu1}{y(:XNB3AI b^lZշv߹!|v."Bmaw{ 㡐wE>9JX^ 8`d,ʚQK0+û(evj`56u- VTfijR1 D;p)rB!('r3F|O48L"I!m~YDrӎ5ȟ0*@, XkkeOP7s61),/.aIpܩKvqW e0^CdcIg;Ȝo$#>S5]N1gztp%m,ڲ r,P)l D_ -Wo7 S#\킒ʛ3@jP0-B'"Vi6e+@DR/. ";[8ӱ53Nv|@C(Wz[[e ޸E~r|B7v Gfɳ,xX|* /#MMsYXw4ܤim#ǟ K_(k7:3#pj(*TJSEYU윌 ֵ+ л(Ud7$**ÛBvPSu*x 5:eN ٹhɍ% Ð0a944!cb>Q5(J|{OC\nEyVJ*wo";?5dcNj3:@50s*UJN_-bε"`*17M^JCe :LS":RjqIuP}% m%K'B΃mmv!}|<Ϲ[|C^~V'@T?7KEp!\pG_=Mk D^>1` u1剌֡>6*_ᵠ_'}~ۂAhbi8WFfXp6u WNLP:Xj $UVsvNYQzp.:aCs]Дk'YxeKp;^ Rg3)sfQ]A H8(".*X^I<\Cxi-2:MXN㥛I7JX4M\×&lXfz[8kFh}TuO@i `A-5|K䗞AGD f&:d:qŇY?16L$y6R9KYha%Ph ێ, J&@)n]ۓe0g Mڋ38Oānyrs6Uj[9|R`48$WJIUȅLaQ@V\@P^u v*^jf_B5?Q)S7 n={Ϣ$6)3סk I)mG} )S!o$"#;/$ hPfNS O>aZe<~}2(k^!y_[5cČ3CC1WQ#g#򏫚[F`N7uᗝmq?B|AQ|Aojk˥;Ȑg[{p- ^cӄŐR]BKF;]astKJE=!&#Nn;?elM+ovD>5QSprIHJ3'-ÝX;tr36W'FuHq6qfQ_i`1V8YLjxL4 3?mU̒@wO iYº Oj/JCr -Ajah+@#A ;f9cVE)>(kY`\n@6onUis[)1Zݓ4膡Ѡ}w*B,wYǮY;Zt>|6<~ Cl'W5)$XsyӞ~Z>C]a QY,HS9׹J]Ng8||A$‡wok m׎v,pjlΟgQ'Mtb}w礳եS0JD&wIшd5WN WXyԟÒQ2wBqvg;ԅԒ /j.Nf `/}XZo:)wCڅkORږs7<YHtYZZ0i;l ޕ EHI#_KAJoiz}BoP"S\koY4SB#LZ@,Eտ.1HKy|_Ry|n޺60Sm+QLܟNldOނ(՛G7Sk'g(w:L͸409l|V)T].?;E9OO+Hbrhb+P= /KV@:tpEz@ ][~S# $P"-"zm?H8k {{ihBra_.g˪5Z+%Og–XG7[cXB: S";g$ZTzr^F @ =U9&i1^!Hl٫ty5.x,_I@w*i6g `U;"p!/WmXZj&ylM˥-6U/j{E#̪>&w[]*Ґ9a4&'{8`q s oKm^G/ERs;'DMN|!E3[W3Tc "HA7!-6ݗhϟm TD>z,'Zcmssz_Z_ߪY}{륒T!mR,zPVqz0[vySR1V={h#wAi᠕iKx軯>֩@Y, e% c*MǴhai 3y+0"UL취fLͳC܋͞0+-ZmBB 헻b'wVԤcUoż+!{柰lSHSɻ5ߣUxU~JƎB9QvO!Ϳ+WM˒ngS4\of_F3l^t.f2׆_^_MhK%bb~+-pMm* 5m`P~lV\moWzVU^rb0dR<&xX>FL&NreKcxYm]2!9Pd< ?'( 1H ؏:Ƈqx`U$iU,3|6f/m*(8]w9aD(a"X-9ƘM(i+iFJw5&lhʍi.|15eL]88R`pg\Wwr#Vre[5 o;&vl6ԞPMO/B@X/Ev_1h=BVDκ S>LKF9 ![>ZJQ5{˫0U5`J1Qԣ(!EYu|rT~okydC'֘3R47,$ 7|fOK]cI/-oֺ3Dk]B^NG&ew1ӅJYEXVn= `e%7$?%O1 LUgƎf[Ã|JFlR܈u?v  r@"86z{.Gf5G7e csd/+UP{wq#0 1NFry^( Y΍ h[Ʒȕ,y&g{5!Ru+}F bv :`GECˉC78`P>+/ iD6k^&vw$B&?y* b8jrk)CAjEmIϡYX?޲JHevjmj6Zg#uGf(Uʽ|H ^P'.}wA?e[jRFizT=N+&#iᢂE[:WB7Mr@IǜZVnl;چPBp+e @dHV_ؐ+CeҶmͥ|QO4ā[.&>[]"; G ɄЏԱ WK;} ;E>K_FIEZ-vq4N*ȵ}s|B=)BBfhirվR-$%C:{v(ԄGz3o~d2]GQNm~"Up_ (eX4Ȣ䏖]zDҐpwgH1EAm':.{o7A6=(8 j{KCPSUެCҏ2so uVKہYOm<(1\fLlߚ^&UJ IBhdцIu},mb<wcs$¤.`q[X*a ĥpW(ַdܶFt16Uo~C@5܆9^,rѤI,.BG_ˏB;bcU2 <嘣UlzhzKɕ.Kj8l_T"j7ahRc Y׏skcrQb&d] b JUrd؟z:5C^BH>in!I?ڧ {BQB_fwq R갽P}( 5$7n*U4N w_n7# f@#a!{!r1f]WrgW(Tv8ˎ3 ? cv &L3E]~$ŴR'4tk?% LbDdk$kGtgQDe7Oż&3%N,f_cB b0\gdXj 0w{5/MN{qY0>DU'Q?8 (Pe!,`豅D(K*ǜ,S|GHBJ2 qBǿ{eF¿Cԏ}RpMt=*1"XƝ:!EmՄYݟ,b uڏ]1ML)߇LhKi|cDBr/wS">WoSyK "clG= 埽qv3WR3܋,``_SctF~Ϋ;WGDj&=|baw'3J;vKkOf<<O@se>)>;S%Li(yئA8 81]wͣ/qZ-~"J} O^E*?àVqD LE=ꌟu5,{2 qq/RMfY!?BgU y x'- m։wy ü[$kVx%ed1E& _$DĤ ^W/C︆ H)Ժz |ݬ K{a3m`/^8B҄p{ qKΖyzڧ^c9UѺ9 '\ A,#wڌσKqI=jipHܸ_JaNK=}_ 5G*>fiHq*D&Ad@scA4͞ ',, Y +NO޴aSPТwWR_m=F !uꛠ쫭^1<-VfW;SK! 29$&4^q~h+]p;w1孍ذؑZt*q00?xt< :! |}QmӣCy49r4I- p &(Q.̮K${`Zl?/ x{Du+~)z,ݴ{I=W:rpV KFRSA-[(‚1H c?$PeTښN#y74Tz7&>:;X>+.2_Q\ph/>T{>wF$U\D!촇c0ff{"(D R .ض7G_Ƒ4z-4v%_wc A֎alo.т؜!)̡XvvaW`4,7hoLf Y0w _w5~b Al}C7J nDYc?Kٵ!cZHұ\>6FWcH:C-RJtNԡ|( u]w p,]$T\%pXF}Zfi-aV>̦׵&O%5E<;|lnҟ{n̯i a6};\.D6htƄ*8n8!=ƕGJTkU[ nx(g7  V^5^F=ּ[9ymMt+ʢBPt(t~vMB]Ǿ|KV|6%_jY0YMZE;t4QvRFW^1DQ+###:y:]I?EIR=D3Pw@V~0`M2JwV9_ArSJP3F~JvQq?! jVݢЮVese#;KC%CCf>1&o|N皲=C}rXzUQsGp-NۜHḿ8^҅V,fmw/ <=qICҲv~\sysohƹbV@K+&~E㐀ƎfABofčpd7 G8jtS6f$K99t~uxTI;>Db㾴__8Dd:Rc[803Ij)hb5)Zߏ& }"q^R-P^%txtfkvb7i1 8Q!}f~1n'<{nc&b6h^oTH5JlEq#UĥOh,+rA p{9li/8٧=fVY~4{{E4PF$]p%Rۂޗ$g 8&ĝVCBx|8O"=5] mWG+:fѡԶ+Mq=?wL쵶 ~ʼn[m[*Zi# zFlV`Qb*nz}:}Wp9D 1k,g>ѹ!Umd8WixV?ҌtmԞ6pIG:zc4&q3WvGH[F vJl^ODc(W&=/jbe'H% R 4P˱zʞS 7ݛGHzyZTɭ予:(k5 2C|q*?ԙ#r92qB>Xw~c|W;o2j*E&FL;}; kq-UAq?تɨ7jkR8J/XDQwM!q*3w'^]eT7]cfCnGq/JTN!09M@Wo]S̍~Ճ{>[o4zv:hY6XΉl o " ;6$ڬN0Sk5 ghC9C|¤, czIv1\/qڝS~ͷRА$!́J!/;!cc _cG.1#W^ג H{l9ڢXH^F [g_גn>\F[plD35 * Ts..ߧh+5% aD.Z-![-)EkKqN@FrgD~~c$J} [~ `3İ0$B b|BYzSU޸Rv`VdNz-vR|$e"bSu̳xw.@W2(BaM9fE3Msi>+N@ou ˦XL%h<9pA)<(OðzlBV(cMDHaO|eLC{z幵GA?|x]<\XZtw&RЌV%e<<@ HE@’. [z1F*~u cj*M? \Al|<} ??aQIO4`.h&j0ߧܦ,[rATt7 Gꮲv;ŀ͟"5 ſJtǎz+Ia*q3EZuhQ]׎vO`yVl1Y@ˤG_LHvnIe/IUIf\3X%GպmOY-[r?xS){Ic,u(nDk}"D bET|X9!a-V$ _w#\{,o'}Pg\ O($P ûT6 p䣯~k/_GE42(;O*6g4 ;v2'/quDϥ rǓ"F߼y=y(2A:4b$}SiZ8P2 :xw݇ xQou`,ׯZJʋ5[AJ%1Fp>0݉T$BBLٗo"0+z|7B{*O@>^lCyFfSleeRn S"Pt_`l 9a ,ׇtzpfaoM4avo>$sNw9IS[-Fn"3!C9W& s/Ou8Gs뢤ɮJi1S8c-cd\8p;@|!=  >t?j)bD)Vt"zx)8Xv3fwn<7THsd3*WۄDC2 _$GUV;>QƜ$:68wz?)`\pj뼶bI5kTh_8t 7T$?]Faxsӈ#HR"vWn#T#).?y`L&F~E}L͚w"R~ݒ}+JsqO\s{n$kؤT>zyV7vWe~WRӸ|3` qr:J?"J_b˧ݯ0To¹bI$řp0:Ylv; +od8H.9MQvG1'a<݅_U\k=`>S+Tr*zGuζ[ ctqJ t '@(AOw{wzt̻>s6t?u}T )չ%/knYYq2WKxq>Ƽ_O`ڠ.P;9i.5j5sd10\Mgt c_Ϙn+# K  @4*{ M%%5S Tdmfcp#mMX*j0U)#{n̬GKMWPBޛך!O TvpSR@*:l EzjA`}kuFj&_BRle[{-/Cv~G^po|pū<"KJu@х#8rI$r5nNW]>*v#"&=R(cL'U+(Yr+#))cK+%L6|aުU 0#*{l*[{aw@nRZ;h(уbzjୁ xiV'(%iմ(6X[2S5(߉ޢA]nv)a8 QAYugOb1Gَ'uqJ,`32&GLdʾˣP,<̰D8P'b)ɏ畮$qj% @d*4^\/b~X֨]>,vH|73y/Y0YvhG _(X?9Y-9ľԙW5<1frdjn%۽ 5 lm\;Jֻ׽X }ЄK?diZ6Mkq*kf(-QNX*FY+ c~cUM3a/)5]};;S"#aJn rMF]r+@,[;h\B،dxՁjUܺsC rsk OKfa1 nA-7N2쯸uY(⩡ﶖYRfT =.uwWSnlccrs FnܽWirA-6d BdSınFـJpRZ+~3iޮlTl&yrTAvʒ4W*\1Ti;F{{n9dQK0"IrrJRwLZo_/?fR/fT<^l/K88GNu59LglB"Ǔ+ɲuO*x0qgM0JKUkIz`Ęh.G> ^D;? vTX<ʋ%A\MOr$,zi|9>2qqBC-MP '#ͶfSV@IX MٟSEMJ!!W u~>%쐗Fi wqCD al_2b5.FdDFH5d% 83RӏL;#8KiP7#Emu@Nn8 zoΦt0 ilpXuNXZ;QQEQ7.Ni=hzXHe#&[~Ĩ=|H쿠wi\.w0:=)=΃P4)5 NdA,2`?GGTq\Y@T׬ nvpA%B`6c9. ]N=y/Df tgys+ؔ&|+{3_.գxT?FLvmn4cTGrd^ 4in zQE=.WrߖgrOŁ~VVhî56$]t|e_ʗqQhRkI~Ќ8M6Y{yTŴ&Ru28Yzw&W2bB,N6$Wvm@IW ޑ@5KrjH ^iXyGӪq;)!mb*MV=c&ӂA:hvmUiƋL;<Xr,\Mj~Mm g-ǝʶj_Z@O1fN=]G4vhtgΞ}21)arAr\(1fk^b?1W0,"7[OƐЩ[1(A伅)V+8wWÀ}fvLq^&7?f*qõ ݖΣ[3ypI4 q9ifbw:M!1, yl$6Mskrn\b݀-G$KMys^Du֙ 7Z* {dSqR. %*+soUn;e/ewq3(N.QbaV3˃"Bہ6i7O'r4$4EVzޛȪ-^_3S[Y,l?N.ѵ`jN-EndƧ(M)M#6J?>&FPkLKh}\̝{l .`G{ʼnDv˷z[vvCؑptrb? ;#C<kooP} ƺn#粰Xg. LgJ:a3+R4 Bb1oѢ];mL"ܴS11OMI( /E~L P ջBUJmo_Nhcg y"=kQm6#6PAyvj.a׊5u?XsZt0n͛f)f+M:dbwSXKY4- kp%Lz M*c\ "Ly7`73:U-Nb=y9TW ]ih@QBȆg%; 8J:)u|9?uhP0:/OeSKvs$wSCS$X<5p''U w$g,q`'Cew&ê9LύMN܇Jܟ.2-Ir:v LZ67 BpGGBX,B@{;"8Qn{nu{4N+U !2xhRz iO09nEJ[\˞yJJXc$ELfܫ5%> QMƟ"Aqȑ0BKkef vֽ8w{Drμe{(ola.:mV+EHdzl/nL^ZkuH*鏢l/\ŽlQ6/ǟvZϓ(gW/>H.^9*X4\Щݝ;P9NcmWy{cw}mu ܑԝHly6`7#U֏G#'h6~p2 ZFzi̋ ةYach•>Xț񰥏4`2:谀+ z(<ݑojaBrѫ/+cstM6y Z5?eYk[vݳ'ɟ_4xSբ+s07)άiF!MClesBm14滱iw~$A &9M{U(M X]۞xl7›FIDcNR{ d}uo |X6͒ d5 G+\V& 72S,1 :0Q,ֈ?쐨>kG);€MoDW. \llEhLh@ye|'daًͯΙHxAsit `pRGXzJڕ^y6 E|Y--rZ qA5wq3̷xvsʍ*9QͿ+ o;FɪW }_$k$W(&ӡer;'*+*`yI_jxT WLwˮfgx.|vTOʊeVJa+ jU7KȺT92N&|EKGCv4LR"PhՐ"Ux@lw ɔ;L92E h2y;h==hi֧ǼKLۛZ!XRG΃CIMσh[9]VY@-u!,wH ,BgvTߧIl+QG U ^Z:"]/Fq èbVVLJW0zq1-Η{趥`)|,LUg|!.[m[}wDwQ/X J+ȁ U` U50Z1DMJ}7ߤ?)eWT*C{ɶq4{5&2wOO;,3-L[s-rKM3 -um}QpT} @f,pbw5?-bKg0Qorװ%ܲ,PipUPg?s|Y{J\z3i!G֩[w(rM j a<4*|9.()+PXp _0^7 SiATN5eڟDc@:=TJr5mDU:{3_bʋL3BAN#FNgD؍6= M?-uGGL׮='=қoʄ-G4AsZHVPp]FPu`]X[Q^\hc<eNNN\ŏOcqh Nu22ެ/5yF_-%*Vr"V'90WdRiFff?xv-AkÁ[aX4'K%~)M;*ŝ&AEMX`4o}Ӆnf suwQ1.v I/SB}}͇ eūju@ʹzI"1wEWnRM~B M!o2A)_wp@ >yt`у~QjPDqslRj@`Dg{Q6o^O#ީK&? ?ȴ%ޜl&-_$@?]I&TݠkѯoڅÄD bUM !tDSg[Cd?i-՝b>-x(3vT]Z Z6h'4TI6H/0K8jSHbG2ą7v]VӬSRa[<7MJZw]nʟw01(GgmrU1g`~xE k 1} l՗;Q gBnoE'?U(},ܮ15ozGi=BNm#f~^7Ã̲8HQߌt;]M~=SLРΩǂ`r]Bd8H΋欓evy~l 5n|t˪FNõ:cmwctsH!;{1޼$||8'GqN ;d|ev)]EQh"6k| PW)ɞb:b|ήHy5d'ò$O#@)ji.6L6rn;RJ!8)x.GKd>|ۖ5hʜp@ !* ɞ:y!ck˒Q[HUiܦB*p DH-(\_( &\ `;v!FHƛ~TwL}9-ܭYY;9Tl pQs,ǶP`H= i =-t'k4"&>6̰؍D$xYq?ޞs}K8-T,ėr+t[ܖMڤ=0WIP-DPp[eM?8 켎ga Hx]wb.M4Pk m.4ڲ}F^HQ+uR 1%ehdN&-VR[D?A/{&+d3mc[úNBXQ^MOdpL#$RRKw lLC$] S-_U-kydF `Xߌ0T^GV4Y}0_Xibe L Ց-c]r4ўvKW.8Pp d&{^Ha6}ZƋKޟz\f!vHX "4K53#p+T|Q l,r7+' ri̩hz(f4L(>]&nP [g-±Zu~Iii4 Sjfk@̨ @Z@ )Bu[}zrqO݊AoݘXF>Ys4O^)[BCQ  @$>]TwyE*W}߈ 0L^#C/4ATD5GgC+LemYn@']PDvNn M76D4e4#YQT;mݩ~ 7rX2n ݆I]l{vvV5] lZv{ʶo?j}kKxT\' 7}+KLr8R_RrWLM^0)#4'5Yt~E+8 :{s.O8񥉺c3P-OF dm'|"g۠vŽ9@Cp]L(E9&i /Uxi4wg JEhԂ\ʬlJ'Pővcm}gHW[:%>>@{=5.}wb/F2|va!0O X'& w3؅IUmO27ޯdw-\dޙ(Oɮ侔$/>i&w|Bx7q\3>)cw 0^#T-`D- -V1bgv ŹE#0HQZ]`\=ǟ)rNb*WIT1"AY+Q=)=#\˦m2Ec±kr дr lpc>"b|5/?m9!XJd?,~ڊD/[9M/ / dq[D}1P*e( c grn/4tQWd7?iu#?I%[U*eHf뛹U}ό)> v}YC%eGѕfKN}Z{3 gܩտ& _ݧUy+*dTuK(Y4WX:niLw/5_^KbaI1]ڴ{ ^GL $G^Pa6P&&^0b΢p#`%}3Iޥ>HrXZkiLzlKC{lsZ@dHrx f《}̣k`!~(AYX wfۙ) ep4[ "FkCg9!Sdոx.bms|YQy֥0,iP\ݒ{&UI("4umk4[=`M^&IX BvܷԪaXY-7I{4GF Lp͌.!3;4+Ds?>Њlz?M]~GGYs9 Y_P$re-MR-nRHdbO=»kT B)#cL|*N첀|J8IN*¹ YW1w+~&,ʘ⌦co.ͤjcKj.L!miWtM@g$ɲ>JŞ'?|[Ìxq +y$gf܁Blɷn16ܙ4-r@ݞd<=GLL!'eٙ ]u𽡦<*_×yfYn/953"m吐SHE' Q@0~x:ړs6pb,}M=`i\JAǭ[q\fd3(k#'3M>t =ifnd!Pt/):)N5>0 YZwaveslim/data/unemploy.rda0000644000176200001440000000132213430347452015355 0ustar liggesusersBZh91AY&SYB 9@@+ 1P+@Q@ P 2L4`L &II@d@ 4PhsLLiF&ڕ6m{y("hJ))'v8MKqz1HN@U|r_/ # Ly@ԒI9'ő&tTHū. FD% P"FIԫeIg0BDX3XTjID4t:AYDeIWTRڝOX8<HCd!Y$ihzTT_mLJM.¥JꍹРvٖes c?rlX@FQE "5LL8x"$Z)K,KR+-$驛")H i'T(At4X*dl,2Sr!+V hsifkD"!ZvqDT(!ZUAP$$-;?݌l{MSacSȍfhIOhB1H@ISWŕbу%A3`8iZ!\(ڛyh0DEE #V®Ԫ Q'!|eVI8FCv,; UT.pT0grkm?H @a waveslim/man/0000755000176200001440000000000013430347452012661 5ustar liggesuserswaveslim/man/dualfilt1.Rd0000644000176200001440000000166513621324400015033 0ustar liggesusers\name{dualfilt1} \alias{dualfilt1} \alias{AntonB} \title{Kingsbury's Q-filters for the Dual-Tree Complex DWT} \description{ Kingsbury's Q-filters for the dual-tree complex DWT. } \usage{ dualfilt1() } \arguments{ None. } \details{ These cofficients are rounded to 8 decimal places. } \value{ \item{af}{List (\eqn{i=1,2}) - analysis filters for tree \eqn{i}} \item{sf}{List (\eqn{i=1,2}) - synthesis filters for tree \eqn{i}} Note: \code{af[[2]]} is the reverse of \code{af[[1]]}. } \references{ Kingsbury, N.G. (2000). A dual-tree complex wavelet transform with improved orthogonality and symmetry properties, \emph{Proceedings of the IEEE Int. Conf. on Image Proc.} (ICIP). WAVELET SOFTWARE AT POLYTECHNIC UNIVERSITY, BROOKLYN, NY\cr \url{http://eeweb.poly.edu/iselesni/WaveletSoftware/} } \seealso{ \code{\link{dualtree}} } %\examples{} \author{Matlab: S. Cai, K. Li and I. Selesnick; R port: B. Whitcher} \keyword{ts} waveslim/man/find.adaptive.basis.Rd0000644000176200001440000000235113430347452016765 0ustar liggesusers\name{find.adaptive.basis} \alias{find.adaptive.basis} \title{Determine an Orthonormal Basis for the Discrete Wavelet Packet Transform} \description{ Subroutine for use in simulating seasonal persistent processes using the discrete wavelet packet transform. } \usage{find.adaptive.basis(wf, J, fG, eps) } \arguments{ \item{wf}{Character string; name of the wavelet filter.} \item{J}{Depth of the discrete wavelet packet transform.} \item{fG}{Gegenbauer frequency.} \item{eps}{Threshold for the squared gain function.} } \value{ Boolean vector describing the orthonormal basis for the DWPT. } \details{ The squared gain functions for a Daubechies (extremal phase or least asymmetric) wavelet family are used in a filter cascade to compute the value of the squared gain function for the wavelet packet filter at the Gengenbauer frequency. This is done for all nodes of the wavelet packet table. The idea behind this subroutine is to approximate the relationship between the discrete wavelet transform and long-memory processes, where the squared gain function is zero at frequency zero for all levels of the DWT. } %\references{} \seealso{ Used in \code{\link{dwpt.sim}}. } %\examples{} \author{B. Whitcher} \keyword{ts} waveslim/man/Selesnick.Rd0000644000176200001440000000145713621324422015071 0ustar liggesusers\name{Selesnick} \alias{cshift} \alias{cshift2D} \alias{pm} \title{Miscellaneous Functions for Dual-Tree Wavelet Software} \description{ Miscellaneous functions for dual-tree wavelet software. } \usage{ cshift(x, m) cshift2D(x, m) pm(a, b) } \arguments{ \item{x}{\eqn{N}-point vector} \item{m}{amount of shift} \item{a,b}{input parameters} } \value{ \item{y}{vector \eqn{x} will be shifed by \eqn{m} samples to the left or matrix \eqn{x} will be shifed by \eqn{m} samples down.} \item{u}{\eqn{(a + b)/sqrt(2)}} \item{v}{\eqn{(a - b)/sqrt(2)}} } %\details{} \references{ WAVELET SOFTWARE AT POLYTECHNIC UNIVERSITY, BROOKLYN, NY\cr \url{http://eeweb.poly.edu/iselesni/WaveletSoftware/} } %\seealso{} %\examples{} \author{Matlab: S. Cai, K. Li and I. Selesnick; R port: B. Whitcher} \keyword{ts} waveslim/man/heavisine.Rd0000644000176200001440000000073413430347452015127 0ustar liggesusers\name{heavisine} \alias{heavisine} \title{Sine with Jumps at 0.3 and 0.72} \description{ \deqn{heavisine(x) = 4\sin(4{\pi}x) - \mathrm{sign}(x-0.3) - \mathrm{sign}(0.72-x)}{% heavisine(x) = 4*sin(4*pi*x) - sign(x-0.3) - sign(0.72-x)} } \usage{data(heavisine) } \format{A vector containing 512 observations. } \source{S+WAVELETS. } \references{ Bruce, A., and H.-Y. Gao (1996) \emph{Applied Wavelet Analysis with S-PLUS}, Springer: New York. } \keyword{datasets} waveslim/man/testing.hov.Rd0000644000176200001440000000375613430347452015433 0ustar liggesusers\name{testing.hov} \alias{testing.hov} \title{Testing for Homogeneity of Variance} \description{ A recursive algorithm for detecting and locating multiple variance change points in a sequence of random variables with long-range dependence. } \usage{testing.hov(x, wf, J, min.coef=128, debug=FALSE) } \arguments{ \item{x}{ Sequence of observations from a (long memory) time series. } \item{wf}{ Name of the wavelet filter to use in the decomposition. } \item{J}{ Specifies the depth of the decomposition. This must be a number less than or equal to \eqn{\log(\mbox{length}(x),2)}{log(length(x),2)}. } \item{min.coef}{ Minimum number of wavelet coefficients for testing purposes. Empirical results suggest that 128 is a reasonable number in order to apply asymptotic critical values. } \item{debug}{ Boolean variable: if set to \code{TRUE}, actions taken by the algorithm are printed to the screen. } } \value{ Matrix whose columns include (1) the level of the wavelet transform where the variance change occurs, (2) the value of the test statistic, (3) the DWT coefficient where the change point is located, (4) the MODWT coefficient where the change point is located. Note, there is currently no checking that the MODWT is contained within the associated support of the DWT coefficient. This could lead to incorrect estimates of the location of the variance change. } \details{ For details see Section 9.6 of Percival and Walden (2000) or Section 7.3 in Gencay, Selcuk and Whitcher (2001). } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. } \seealso{\code{\link{dwt}}, \code{\link{modwt}}, \code{\link{rotcumvar}}, \code{\link{mult.loc}}. } %\examples{} \author{B. Whitcher} \keyword{ts} waveslim/man/jumpsine.Rd0000644000176200001440000000072613430347452015007 0ustar liggesusers\name{jumpsine} \alias{jumpsine} \title{Sine with Jumps at 0.625 and 0.875} \description{ \deqn{jumpsine(x) = 10\left( \sin(4{\pi}x) + I_{[0.625 < x \leq 0.875]}\right)}{% jumpsine(x) = 10*(sin(4*pi*x) + I_[0.625 < x <= 0.875])} } \usage{data(jumpsine) } \format{A vector containing 512 observations. } \source{S+WAVELETS. } \references{ Bruce, A., and H.-Y. Gao (1996) \emph{Applied Wavelet Analysis with S-PLUS}, Springer: New York. } \keyword{datasets} waveslim/man/per.Rd0000644000176200001440000000051313430347452013735 0ustar liggesusers\name{per} \alias{per} \title{Periodogram} \description{ Computation of the periodogram via the Fast Fourier Transform (FFT). } \usage{per(z) } \arguments{ \item{z}{time series} } %\value{} %\details{} %\references{} %\seealso{} %\examples{} \author{Author: Jan Beran; modified: Martin Maechler, Date: Sep 1995.} \keyword{ts} waveslim/man/plot.dwt.2d.Rd0000644000176200001440000000172413430347452015233 0ustar liggesusers\name{plot.dwt.2d} \alias{plot.dwt.2d} \title{Plot Two-dimensional Discrete Wavelet Transform} \description{ Organizes the wavelet coefficients from a 2D DWT into a single matrix and plots it. The coarser resolutions are nested within the lower-lefthand corner of the image. } \usage{\method{plot}{dwt.2d}(x, cex.axis = 1, plot = TRUE, ...) } \arguments{ \item{x}{input matrix (image)} \item{cex.axis}{\code{par} plotting parameter that controls the size of the axis text} \item{plot}{if \code{plot = FALSE} then the matrix of wavelet coefficients is returned, the default is \code{plot = TRUE}} \item{...}{additional graphical parameters if necessary} } \value{ Image plot. } \details{ The wavelet coefficients from the DWT object (a list) are reorganized into a single matrix of the same dimension as the original image and the result is plotted. } %\references{} \seealso{ \code{\link{dwt.2d}}. } %\examples{} \author{B. Whitcher} \keyword{ts} waveslim/man/dwpt.sim.Rd0000644000176200001440000000454513430347452014725 0ustar liggesusers\name{dwpt.sim} \alias{dwpt.sim} \title{Simulate Seasonal Persistent Processes Using the DWPT} \description{ A seasonal persistent process may be characterized by a spectral density function with an asymptote occuring at a particular frequency in \eqn{[0,\frac{1}{2})}{[0,1/2)}. It's time domain representation was first noted in passing by Hosking (1981). Although an exact time-domain approach to simulation is possible, this function utilizes the discrete wavelet packet transform (DWPT). } \usage{dwpt.sim(N, wf, delta, fG, M=2, adaptive=TRUE, epsilon=0.05) } \arguments{ \item{N}{Length of time series to be generated.} \item{wf}{Character string for the wavelet filter.} \item{delta}{Long-memory parameter for the seasonal persistent process.} \item{fG}{Gegenbauer frequency.} \item{M}{Actual length of simulated time series.} \item{adaptive}{Logical; if \code{TRUE} the orthonormal basis used in the DWPT is adapted to the ideal spectrum, otherwise the orthonormal basis is performed to a maximum depth.} \item{epsilon}{Threshold for adaptive basis selection.} } \value{ Time series of length \code{N}. } \details{ Two subroutines are used, the first selects an adaptive orthonormal basis for the true spectral density function (SDF) while the second computes the bandpass variances associated with the chosen orthonormal basis and SDF. Finally, when \eqn{$M>N$}{\code{M} > \code{N}} a uniform random variable is generated in order to select a random piece of the simulated time series. For more details see Whitcher (2001). } \references{ Hosking, J. R. M. (1981) Fractional Differencing, \emph{Biometrika}, \bold{68}, No. 1, 165-176. Whitcher, B. (2001) Simulating Gaussian Stationary Time Series with Unbounded Spectra, \emph{Journal of Computational and Graphical Statistics}, \bold{10}, No. 1, 112-134. } \seealso{ \code{\link{hosking.sim}} for an exact time-domain method and \code{\link{wave.filter}} for a list of available wavelet filters. } \examples{ ## Generate monthly time series with annual oscillation ## library(ts) is required in order to access acf() x <- dwpt.sim(256, "mb16", .4, 1/12, M=4, epsilon=.001) par(mfrow=c(2,1)) plot(x, type="l", xlab="Time") acf(x, lag.max=128, ylim=c(-.6,1)) data(acvs.andel8) lines(acvs.andel8$lag[1:128], acvs.andel8$acf[1:128], col=2) } \author{B. Whitcher} \keyword{ts} waveslim/man/convolve2D.Rd0000644000176200001440000000240613430347452015173 0ustar liggesusers\name{convolve2D} \alias{convolve2D} \title{Fast Column-wise Convolution of a Matrix} \description{ Use the Fast Fourier Transform to perform convolutions between a sequence and each column of a matrix. } \usage{ convolve2D(x, y, conj = TRUE, type = c("circular", "open")) } \arguments{ \item{x}{\eqn{M{\times}N} matrix.} \item{y}{numeric sequence of length \eqn{N}.} \item{conj}{logical; if \code{TRUE}, take the complex \emph{conjugate} before back-transforming (default, and used for usual convolution).} \item{type}{character; one of \code{circular}, \code{open} (beginning of word is ok). For \code{circular}, the two sequences are treated as \emph{circular}, i.e., periodic. For \code{open} and \code{filter}, the sequences are padded with zeros (from left and right) first; \code{filter} returns the middle sub-vector of \code{open}, namely, the result of running a weighted mean of \code{x} with weights \code{y}.} } %\value{} \details{ This is a corrupted version of \code{convolve} made by replacing \code{fft} with \code{mvfft} in a few places. It would be nice to submit this to the R Developers for inclusion. } %\references{} \seealso{ \code{\link{convolve}} } %\examples{} \author{Brandon Whitcher} \keyword{ts} waveslim/man/fdp.mle.Rd0000644000176200001440000000467213430347452014506 0ustar liggesusers\name{fdp.mle} \alias{fdp.mle} \title{Wavelet-based Maximum Likelihood Estimation for a Fractional Difference Process} \description{ Parameter estimation for a fractional difference (long-memory, self-similar) process is performed via maximum likelihood on the wavelet coefficients. } \usage{fdp.mle(y, wf, J=log(length(y),2)) } \arguments{ \item{y}{Dyadic length time series.} \item{wf}{Name of the wavelet filter to use in the decomposition. See \code{\link{wave.filter}} for those wavelet filters available.} \item{J}{Depth of the discrete wavelet transform.} } \value{ List containing the maximum likelihood estimates (MLEs) of \eqn{d} and \eqn{\sigma^2}, along with the value of the likelihood for those estimates. } \details{ The variance-covariance matrix of the original time series is approximated by its wavelet-based equivalent. A Whittle-type likelihood is then constructed where the sums of squared wavelet coefficients are compared to bandpass filtered version of the true spectrum. Minimization occurs only for the fractional difference parameter \eqn{d}, while variance is estimated afterwards. } \references{ M. J. Jensen (2000) An alternative maximum likelihood estimator of long-memory processes using compactly supported wavelets, \emph{Journal of Economic Dynamics and Control}, \bold{24}, No. 3, 361-387. McCoy, E. J., and A. T. Walden (1996) Wavelet analysis and synthesis of stationary long-memory processes, \emph{Journal for Computational and Graphical Statistics}, \bold{5}, No. 1, 26-56. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. } %\seealso{} \examples{ ## Figure 5.5 in Gencay, Selcuk and Whitcher (2001) fdp.sdf <- function(freq, d, sigma2=1) sigma2 / ((2*sin(pi * freq))^2)^d dB <- function(x) 10 * log10(x) per <- function(z) { n <- length(z) (Mod(fft(z))**2/(2*pi*n))[1:(n \%/\% 2 + 1)] } data(ibm) ibm.returns <- diff(log(ibm)) ibm.volatility <- abs(ibm.returns) ibm.vol.mle <- fdp.mle(ibm.volatility, "d4", 4) freq <- 0:184/368 ibm.vol.per <- 2 * pi * per(ibm.volatility) ibm.vol.resid <- ibm.vol.per/ fdp.sdf(freq, ibm.vol.mle$parameters[1]) par(mfrow=c(1,1), las=0, pty="m") plot(freq, dB(ibm.vol.per), type="l", xlab="Frequency", ylab="Spectrum") lines(freq, dB(fdp.sdf(freq, ibm.vol.mle$parameters[1], ibm.vol.mle$parameters[2]/2)), col=2) } \author{B. Whitcher} \keyword{ts} waveslim/man/hwt.analysis.Rd0000644000176200001440000000345013430347452015576 0ustar liggesusers\name{HWP Analysis} \alias{modhwt.coh} \alias{modhwt.phase} \alias{modhwt.coh.seasonal} \alias{modhwt.phase.seasonal} \title{Time-varying and Seasonal Analysis Using Hilbert Wavelet Pairs} \description{ Performs time-varying or seasonal coherence and phase anlaysis between two time seris using the maximal-overlap discrete Hilbert wavelet transform (MODHWT). } \usage{ modhwt.coh(x, y, f.length = 0) modhwt.phase(x, y, f.length = 0) modhwt.coh.seasonal(x, y, S = 10, season = 365) modhwt.phase.seasonal(x, y, season = 365) } \arguments{ \item{x}{MODHWT object.} \item{y}{MODHWT object.} \item{f.length}{Length of the rectangular filter.} \item{S}{Number of "seasons".} \item{season}{Length of the "season".} } \value{ Time-varying or seasonal coherence and phase between two time series. The coherence estimates are between zero and one, while the phase estimates are between \eqn{-\pi}{-pi} and \eqn{\pi}{pi}. } \details{ The idea of seasonally-varying spectral analysis (SVSA, Madden 1986) is generalized using the MODWT and Hilbert wavelet pairs. For the seasonal case, \eqn{S} seasons are used to produce a consistent estimate of the coherence and phase. For the non-seasonal case, a simple rectangular (moving-average) filter is applied to the MODHWT coefficients in order to produce consistent estimates. } \references{ Madden, R.A. (1986). Seasonal variation of the 40--50 day oscillation in the tropics. \emph{Journal of the Atmospheric Sciences\/} \bold{43\/}(24), 3138--3158. Whither, B. and P.F. Craigmile (2004). Multivariate Spectral Analysis Using Hilbert Wavelet Pairs, \emph{International Journal of Wavelets, Multiresolution and Information Processing}, to appear. } \seealso{ \code{\link{hilbert.filter}} } %\examples{} \author{B. Whitcher} \keyword{ts} waveslim/man/basis.Rd0000644000176200001440000000216313430347452014253 0ustar liggesusers\name{basis} \alias{basis} \title{Produce Boolean Vector from Wavelet Basis Names} \description{ Produce a vector of zeros and ones from a vector of basis names. } \usage{basis(x, basis.names) } \arguments{ \item{x}{Output from the discrete wavelet package transfrom (DWPT).} \item{basis.names}{Vector of character strings that describe leaves on the DWPT basis tree. See the examples below for appropriate syntax.} } \value{ Vector of zeros and ones. } \details{ None. } %\references{} \seealso{ \code{\link{dwpt}}. } \examples{ data(acvs.andel8) \dontrun{ x <- hosking.sim(1024, acvs.andel8[,2]) x.dwpt <- dwpt(x, "la8", 7) ## Select orthonormal basis from wavelet packet tree x.basis <- basis(x.dwpt, c("w1.1","w2.1","w3.0","w4.3","w5.4","w6.10", "w7.22","w7.23")) for(i in 1:length(x.dwpt)) x.dwpt[[i]] <- x.basis[i] * x.dwpt[[i]] ## Resonstruct original series using selected orthonormal basis y <- idwpt(x.dwpt, x.basis) par(mfrow=c(2,1), mar=c(5-1,4,4-1,2)) plot.ts(x, xlab="", ylab="", main="Original Series") plot.ts(y, xlab="", ylab="", main="Reconstructed Series") } } \keyword{ts} waveslim/man/sdf.Rd0000644000176200001440000000312713430347452013727 0ustar liggesusers\name{Spectral Density Functions} \alias{fdp.sdf} \alias{spp.sdf} \alias{spp2.sdf} \alias{sfd.sdf} \title{Spectral Density Functions for Long-Memory Processes} \description{ Draws the spectral density functions (SDFs) for standard long-memory processes including fractional difference (FD), seasonal persistent (SP), and seasonal fractional difference (SFD) processes. } \usage{fdp.sdf(freq, d, sigma2 = 1) spp.sdf(freq, d, fG, sigma2 = 1) spp2.sdf(freq, d1, f1, d2, f2, sigma2 = 1) sfd.sdf(freq, s, d, sigma2 = 1) } \arguments{ \item{freq}{vector of frequencies, normally from 0 to 0.5} \item{d,d1,d2}{fractional difference parameter} \item{fG,f1,f2}{Gegenbauer frequency} \item{s}{seasonal parameter} \item{sigma2}{innovations variance} } \value{ The power spectrum from an FD, SP or SFD process. } %\details{} %\references{} \seealso{ \code{\link{fdp.mle}}, \code{\link{spp.mle}}. } \examples{ dB <- function(x) 10 * log10(x) fdp.main <- expression(paste("FD", group("(",d==0.4,")"))) sfd.main <- expression(paste("SFD", group("(",list(s==12, d==0.4),")"))) spp.main <- expression(paste("SPP", group("(",list(delta==0.4, f[G]==1/12),")"))) freq <- 0:512/1024 par(mfrow=c(2,2), mar=c(5-1,4,4-1,2), col.main="darkred") plot(freq, dB(fdp.sdf(freq, .4)), type="l", xlab="frequency", ylab="spectrum (dB)", main=fdp.main) plot(freq, dB(spp.sdf(freq, .4, 1/12)), type="l", xlab="frequency", ylab="spectrum (dB)", font.main=1, main=spp.main) plot(freq, dB(sfd.sdf(freq, 12, .4)), type="l", xlab="frequency", ylab="spectrum (dB)", main=sfd.main) } \author{Brandon Whitcher} \keyword{ts} waveslim/man/dwt.3d.Rd0000644000176200001440000000126513430347452014257 0ustar liggesusers\name{dwt.3d} \alias{dwt.3d} \alias{idwt.3d} \title{Three Dimensional Separable Discrete Wavelet Transform} \description{ Three-dimensional separable discrete wavelet transform (DWT). } \usage{ dwt.3d(x, wf, J=4, boundary="periodic") idwt.3d(y) } \arguments{ \item{x}{input array} \item{wf}{name of the wavelet filter to use in the decomposition} \item{J}{depth of the decomposition, must be a number less than or equal to \eqn{\log_2(\min\{X,Y,Z\})}{log(min{Z,Y,Z},2)}} \item{boundary}{only \code{"periodic"} is currently implemented} \item{y}{an object of class \code{dwt.3d}} } %\value{} %\details{} %\references{} %\seealso{} %\examples{} \author{B. Whitcher} \keyword{ts} waveslim/man/my.acf.Rd0000644000176200001440000000157513430347452014335 0ustar liggesusers\name{my.acf} \alias{my.acf} \alias{my.ccf} \title{Autocovariance Functions via the Discrete Fourier Transform} \description{ Computes the autocovariance function (ACF) for a time series or the cross-covariance function (CCF) between two time series. } \usage{my.acf(x) my.ccf(a, b) } \arguments{ \item{x,a,b}{time series} } \value{ The autocovariance function for all nonnegative lags or the cross-covariance function for all lags. } \details{ The series is zero padded to twice its length before the discrete Fourier transform is applied. Only the values corresponding to nonnegative lags are provided (for the ACF). } %\references{} %\seealso{} \examples{ data(ibm) ibm.returns <- diff(log(ibm)) plot(1:length(ibm.returns) - 1, my.acf(ibm.returns), type="h", xlab="lag", ylab="ACVS", main="Autocovariance Sequence for IBM Returns") } \author{B. Whitcher} \keyword{ts} waveslim/man/ibm.Rd0000644000176200001440000000056513621325031013714 0ustar liggesusers\name{ibm} \alias{ibm} \title{Daily IBM Stock Prices} \description{ Daily IBM stock prices spanning May~17, 1961 to November~2, 1962. } \usage{data(ibm) } \format{A vector containing 369 observations. } \source{ Box, G. E.~P. and Jenkins, G.~M. (1976) \emph{Time Series Analysis: Forecasting and Control}, Holden Day, San Francisco, 2 edition. } \keyword{datasets} waveslim/man/dwt.2d.Rd0000644000176200001440000000321413430347452014252 0ustar liggesusers\name{dwt.2d} \alias{dwt.2d} \alias{idwt.2d} \title{Two-Dimensional Discrete Wavelet Transform} \description{ Performs a separable two-dimensional discrete wavelet transform (DWT) on a matrix of dyadic dimensions. } \usage{dwt.2d(x, wf, J = 4, boundary = "periodic") idwt.2d(y) } \arguments{ \item{x}{input matrix (image)} \item{wf}{name of the wavelet filter to use in the decomposition} \item{J}{depth of the decomposition, must be a number less than or equal to \eqn{\log_2(\min\{M,N\})}{log(min{M,N},2)}} \item{boundary}{only \code{"periodic"} is currently implemented} \item{y}{an object of class \code{dwt.2d}} } \value{ List structure containing the \eqn{3J+1} sub-matrices from the decomposition. } \details{ See references. } \references{ Mallat, S. (1998) \emph{A Wavelet Tour of Signal Processing}, Academic Press. Vetterli, M. and J. Kovacevic (1995) \emph{Wavelets and Subband Coding}, Prentice Hall. } \seealso{ \code{\link{modwt.2d}}. } \examples{ ## Xbox image data(xbox) xbox.dwt <- dwt.2d(xbox, "haar", 3) par(mfrow=c(1,1), pty="s") plot.dwt.2d(xbox.dwt) par(mfrow=c(2,2), pty="s") image(1:dim(xbox)[1], 1:dim(xbox)[2], xbox, xlab="", ylab="", main="Original Image") image(1:dim(xbox)[1], 1:dim(xbox)[2], idwt.2d(xbox.dwt), xlab="", ylab="", main="Wavelet Reconstruction") image(1:dim(xbox)[1], 1:dim(xbox)[2], xbox - idwt.2d(xbox.dwt), xlab="", ylab="", main="Difference") ## Daubechies image data(dau) par(mfrow=c(1,1), pty="s") image(dau, col=rainbow(128)) sum(dau^2) dau.dwt <- dwt.2d(dau, "d4", 3) plot.dwt.2d(dau.dwt) sum(plot.dwt.2d(dau.dwt, plot=FALSE)^2) } \author{B. Whitcher} \keyword{ts} waveslim/man/ar1.Rd0000644000176200001440000000063313430347452013635 0ustar liggesusers\name{ar1} \alias{ar1} \title{Simulated AR(1) Series} \description{ Simulated AR(1) series used in Gencay, Selcuk and Whitcher (2001). } \usage{data(ar1) } \format{A vector containing 200 observations. } %\source{} \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. } \keyword{datasets} waveslim/man/modwt.2d.Rd0000644000176200001440000000506013430347452014607 0ustar liggesusers\name{modwt.2d} \alias{modwt.2d} \alias{imodwt.2d} \title{Two-Dimensional Maximal Overlap Discrete Wavelet Transform} \description{ Performs a separable two-dimensional maximal overlap discrete wavelet transform (MODWT) on a matrix of arbitrary dimensions. } \usage{modwt.2d(x, wf, J = 4, boundary = "periodic") imodwt.2d(y) } \arguments{ \item{x}{input matrix} \item{wf}{name of the wavelet filter to use in the decomposition} \item{J}{depth of the decomposition} \item{boundary}{only \code{"periodic"} is currently implemented} \item{y}{an object of class \code{dwt.2d}} } \value{ List structure containing the \eqn{3J+1} sub-matrices from the decomposition. } \details{ See references. } \references{ Liang, J. and T. W. Parks (1994) A two-dimensional translation invariant wavelet representation and its applications, \emph{Proceedings ICIP-94}, Vol. 1, 66-70. Liang, J. and T. W. Parks (1994) Image coding using translation invariant wavelet transforms with symmetric extensions, \emph{IEEE Transactions on Image Processing}, \bold{7}, No. 5, 762-769. } \seealso{ \code{\link{dwt.2d}}, \code{\link{shift.2d}}. } \examples{ ## Xbox image data(xbox) xbox.modwt <- modwt.2d(xbox, "haar", 2) ## Level 1 decomposition par(mfrow=c(2,2), pty="s") image(xbox.modwt$LH1, col=rainbow(128), axes=FALSE, main="LH1") image(xbox.modwt$HH1, col=rainbow(128), axes=FALSE, main="HH1") frame() image(xbox.modwt$HL1, col=rainbow(128), axes=FALSE, main="HL1") ## Level 2 decomposition par(mfrow=c(2,2), pty="s") image(xbox.modwt$LH2, col=rainbow(128), axes=FALSE, main="LH2") image(xbox.modwt$HH2, col=rainbow(128), axes=FALSE, main="HH2") image(xbox.modwt$LL2, col=rainbow(128), axes=FALSE, main="LL2") image(xbox.modwt$HL2, col=rainbow(128), axes=FALSE, main="HL2") sum((xbox - imodwt.2d(xbox.modwt))^2) data(dau) par(mfrow=c(1,1), pty="s") image(dau, col=rainbow(128), axes=FALSE, main="Ingrid Daubechies") sum(dau^2) dau.modwt <- modwt.2d(dau, "d4", 2) ## Level 1 decomposition par(mfrow=c(2,2), pty="s") image(dau.modwt$LH1, col=rainbow(128), axes=FALSE, main="LH1") image(dau.modwt$HH1, col=rainbow(128), axes=FALSE, main="HH1") frame() image(dau.modwt$HL1, col=rainbow(128), axes=FALSE, main="HL1") ## Level 2 decomposition par(mfrow=c(2,2), pty="s") image(dau.modwt$LH2, col=rainbow(128), axes=FALSE, main="LH2") image(dau.modwt$HH2, col=rainbow(128), axes=FALSE, main="HH2") image(dau.modwt$LL2, col=rainbow(128), axes=FALSE, main="LL2") image(dau.modwt$HL2, col=rainbow(128), axes=FALSE, main="HL2") sum((dau - imodwt.2d(dau.modwt))^2) } \author{B. Whitcher} \keyword{ts} waveslim/man/tourism.Rd0000644000176200001440000000063013430347452014651 0ustar liggesusers\name{tourism} \alias{tourism} \title{U.S. Tourism} \description{ Quarterly U.S. tourism figures from 1960:1 to 1999:4. } \usage{data(tourism) } \format{A vector containing 160 observations. } \source{Unknown. } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. } \keyword{datasets} waveslim/man/modwt.Rd0000644000176200001440000000737013430347452014311 0ustar liggesusers\name{modwt} \alias{modwt} \alias{imodwt} \title{(Inverse) Maximal Overlap Discrete Wavelet Transform} \description{ This function performs a level \eqn{J} decomposition of the input vector using the non-decimated discrete wavelet transform. The inverse transform performs the reconstruction of a vector or time series from its maximal overlap discrete wavelet transform. } \usage{modwt(x, wf = "la8", n.levels = 4, boundary = "periodic") imodwt(y) } \arguments{ \item{x}{ a vector or time series containing the data be to decomposed. There is \bold{no} restriction on its length. } \item{y}{ Object of class \code{"modwt"}. } \item{wf}{ Name of the wavelet filter to use in the decomposition. By default this is set to \code{"la8"}, the Daubechies orthonormal compactly supported wavelet of length \eqn{L=8} (Daubechies, 1992), least asymmetric family. } \item{n.levels}{ Specifies the depth of the decomposition. This must be a number less than or equal to \eqn{\log_2(\mbox{length}(x))}{log(length(x),2)}. } \item{boundary}{ Character string specifying the boundary condition. If \code{boundary=="periodic"} the defaulTRUE, then the vector you decompose is assumed to be periodic on its defined interval,\cr if \code{boundary=="reflection"}, the vector beyond its boundaries is assumed to be a symmetric reflection of itself. } } \value{ Object of class \code{"modwt"}, basically, a list with the following components \item{d?}{Wavelet coefficient vectors.} \item{s?}{Scaling coefficient vector.} \item{wavelet}{Name of the wavelet filter used.} \item{boundary}{How the boundaries were handled.} } \details{ The code implements the one-dimensional non-decimated DWT using the pyramid algorithm. The actual transform is performed in C using pseudocode from Percival and Walden (2001). That means convolutions, not inner products, are used to apply the wavelet filters. The MODWT goes by several names in the statistical and engineering literature, such as, the ``stationary DWT'', ``translation-invariant DWT'', and ``time-invariant DWT''. The inverse MODWT implements the one-dimensional inverse transform using the pyramid algorithm (Mallat, 1989). } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. Percival, D. B. and P. Guttorp (1994) Long-memory processes, the Allan variance and wavelets, In \emph{Wavelets and Geophysics}, pages 325-344, Academic Press. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. } \seealso{ \code{\link{dwt}}, \code{\link{idwt}}, \code{\link{mra}}. } \examples{ ## Figure 4.23 in Gencay, Selcuk and Whitcher (2001) data(ibm) ibm.returns <- diff(log(ibm)) # Haar ibmr.haar <- modwt(ibm.returns, "haar") names(ibmr.haar) <- c("w1", "w2", "w3", "w4", "v4") # LA(8) ibmr.la8 <- modwt(ibm.returns, "la8") names(ibmr.la8) <- c("w1", "w2", "w3", "w4", "v4") # shift the MODWT vectors ibmr.la8 <- phase.shift(ibmr.la8, "la8") ## plot partial MODWT for IBM data par(mfcol=c(6,1), pty="m", mar=c(5-2,4,4-2,2)) plot.ts(ibm.returns, axes=FALSE, ylab="", main="(a)") for(i in 1:5) plot.ts(ibmr.haar[[i]], axes=FALSE, ylab=names(ibmr.haar)[i]) axis(side=1, at=seq(0,368,by=23), labels=c(0,"",46,"",92,"",138,"",184,"",230,"",276,"",322,"",368)) par(mfcol=c(6,1), pty="m", mar=c(5-2,4,4-2,2)) plot.ts(ibm.returns, axes=FALSE, ylab="", main="(b)") for(i in 1:5) plot.ts(ibmr.la8[[i]], axes=FALSE, ylab=names(ibmr.la8)[i]) axis(side=1, at=seq(0,368,by=23), labels=c(0,"",46,"",92,"",138,"",184,"",230,"",276,"",322,"",368)) } \author{B. Whitcher} \keyword{ts} waveslim/man/qmf.Rd0000644000176200001440000000121013430347452013725 0ustar liggesusers\name{qmf} \alias{qmf} \title{Quadrature Mirror Filter} \description{ Computes the quadrature mirror filter from a given filter. } \usage{qmf(g, low2high=TRUE) } \arguments{ \item{g}{Filter coefficients.} \item{low2high}{Logical, default is \code{TRUE} which means a low-pass filter is input and a high-pass filter is output. Setting \code{low2high=F} performs the inverse.} } \value{ Quadrature mirror filter. } \details{ None. } \references{ Any basic signal processing text. } \seealso{ \code{\link{wave.filter}}. } \examples{ ## Haar wavelet filter g <- wave.filter("haar")$lpf qmf(g) } \author{B. Whitcher} \keyword{ts} waveslim/man/mra.2d.Rd0000644000176200001440000000554213430347452014241 0ustar liggesusers\name{mra.2d} \alias{mra.2d} \title{Multiresolution Analysis of an Image} \description{ This function performs a level \eqn{J} additive decomposition of the input matrix or image using the pyramid algorithm (Mallat 1989). } \usage{mra.2d(x, wf = "la8", J = 4, method = "modwt", boundary = "periodic") } \arguments{ \item{x}{A matrix or image containing the data be to decomposed. This must be have dyadic length in both dimensions (but not necessarily the same) for \code{method="dwt"}.} \item{wf}{Name of the wavelet filter to use in the decomposition. By default this is set to \code{"la8"}, the Daubechies orthonormal compactly supported wavelet of length \eqn{L=8} least asymmetric family.} \item{J}{Specifies the depth of the decomposition. This must be a number less than or equal to \eqn{\log(\mbox{length}(x),2)}{log(length(x),2)}.} \item{method}{Either \code{"dwt"} or \code{"modwt"}.} \item{boundary}{Character string specifying the boundary condition. If \code{boundary=="periodic"} the default, then the matrix you decompose is assumed to be periodic on its defined interval,\cr if \code{boundary=="reflection"}, the matrix beyond its boundaries is assumed to be a symmetric reflection of itself.} } \value{ Basically, a list with the following components \item{LH?}{Wavelet detail image in the horizontal direction.} \item{HL?}{Wavelet detail image in the vertical direction.} \item{HH?}{Wavelet detail image in the diagonal direction.} \item{LL\eqn{J}}{Wavelet smooth image at the coarsest resolution.} \item{\eqn{J}}{Depth of the wavelet transform.} \item{wavelet}{Name of the wavelet filter used.} \item{boundary}{How the boundaries were handled.} } \details{ This code implements a two-dimensional multiresolution analysis by performing the one-dimensional pyramid algorithm (Mallat 1989) on the rows and columns of the input matrix. Either the DWT or MODWT may be used to compute the multiresolution analysis, which is an additive decomposition of the original matrix (image). } \references{ Mallat, S. G. (1989) A theory for multiresolution signal decomposition: the wavelet representation, \emph{IEEE Transactions on Pattern Analysis and Machine Intelligence}, \bold{11}, No. 7, 674-693. Mallat, S. G. (1998) \emph{A Wavelet Tour of Signal Processing}, Academic Press. } \seealso{ \code{\link{dwt.2d}}, \code{\link{modwt.2d}} } \author{B. Whitcher} \examples{ ## Easy check to see if it works... ## -------------------------------- x <- matrix(rnorm(32*32), 32, 32) # MODWT x.mra <- mra.2d(x, method="modwt") x.mra.sum <- x.mra[[1]] for(j in 2:length(x.mra)) x.mra.sum <- x.mra.sum + x.mra[[j]] sum((x - x.mra.sum)^2) # DWT x.mra <- mra.2d(x, method="dwt") x.mra.sum <- x.mra[[1]] for(j in 2:length(x.mra)) x.mra.sum <- x.mra.sum + x.mra[[j]] sum((x - x.mra.sum)^2) } \keyword{ts} waveslim/man/ortho.basis.Rd0000644000176200001440000000237613430347452015413 0ustar liggesusers\name{ortho.basis} \alias{ortho.basis} \title{Derive Orthonormal Basis from Wavelet Packet Tree} \description{ An orthonormal basis for the discrete wavelet transform may be characterized via a disjoint partitioning of the frequency axis that covers \eqn{[0,\frac{1}{2})}{[0,1/2)}. This subroutine produces an orthonormal basis from a full wavelet packet tree. } \usage{ortho.basis(xtree) } \arguments{ \item{xtree}{is a vector whose entries are associated with a wavelet packet tree.} } \value{ Boolean vector describing the orthonormal basis for the DWPT. } \details{ A wavelet packet tree is a binary tree of Boolean variables. Parent nodes are removed if any of their children exist. } %\references{} %\seealso{} \examples{ data(japan) J <- 4 wf <- "mb8" japan.mra <- mra(log(japan), wf, J, boundary="reflection") japan.nomean <- ts(apply(matrix(unlist(japan.mra[-(J+1)]), ncol=J, byrow=FALSE), 1, sum), start=1955, freq=4) japan.nomean2 <- ts(japan.nomean[42:169], start=1965.25, freq=4) plot(japan.nomean2, type="l") japan.dwpt <- dwpt(japan.nomean2, wf, 6) japan.basis <- ortho.basis(portmanteau.test(japan.dwpt, p=0.01, type="other")) # Not implemented yet # par(mfrow=c(1,1)) # plot.basis(japan.basis) } \author{B. Whitcher} \keyword{ts} waveslim/man/Andel.Rd0000644000176200001440000000140513430347452014173 0ustar liggesusers\name{Andel} \alias{acvs.andel8} \alias{acvs.andel9} \alias{acvs.andel10} \alias{acvs.andel11} \title{Autocovariance and Autocorrelation Sequences for a Seasonal Persistent Process} \description{ The autocovariance and autocorrelation sequences from the time series model in Figures 8, 9, 10, and 11 of Andel (1986). They were obtained through numeric integration of the spectral density function. } \usage{data(acvs.andel8) data(acvs.andel9) data(acvs.andel10) data(acvs.andel11) } \format{ A data frame with 4096 rows and three columns: lag, autocovariance sequence, autocorrelation sequence. } \references{ Andel, J. (1986) Long memory time series models, \emph{Kypernetika}, \bold{22}, No. 2, 105-123. } \keyword{datasets} waveslim/man/hilbert.filter.Rd0000644000176200001440000000243413430347452016070 0ustar liggesusers\name{hilbert.filter} \alias{hilbert.filter} \title{Select a Hilbert Wavelet Pair} \description{ Converts name of Hilbert wavelet pair to filter coefficients. } \usage{ hilbert.filter(name) } \arguments{ \item{name}{Character string of Hilbert wavelet pair, see acceptable names below (e.g., \code{"k3l3"}).} } \details{ Simple \code{switch} statement selects the appropriate HWP. There are two parameters that define a Hilbert wavelet pair using the notation of Selesnick (2001,2002), \eqn{K} and \eqn{L}. Currently, the only implemented combinations \eqn{(K,L)} are (3,3), (3,5), (4,2) and (4,4). } \value{ List containing the following items: \item{L}{length of the wavelet filter} \item{h0,g0}{low-pass filter coefficients} \item{h1,g1}{high-pass filter coefficients} } \references{ Selesnick, I.W. (2001). Hilbert transform pairs of wavelet bases. \emph{IEEE Signal Processing Letters\/}~\bold{8}(6), 170--173. Selesnick, I.W. (2002). The design of approximate Hilbert transform pairs of wavelet bases. \emph{IEEE Transactions on Signal Processing\/}~\bold{50}(5), 1144--1152. } \seealso{ \code{\link{wave.filter}} } \examples{ hilbert.filter("k3l3") hilbert.filter("k3l5") hilbert.filter("k4l2") hilbert.filter("k4l4") } \author{B. Whitcher} \keyword{ts} waveslim/man/mexm.Rd0000644000176200001440000000062513430347452014121 0ustar liggesusers\name{mexm} \alias{mexm} \title{Mexican Money Supply} \description{ Percentage changes in monthly Mexican money supply. } \usage{data(mexm) } \format{A vector containing 516 observations. } \source{Unknown. } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. } \keyword{datasets} waveslim/man/up.sample.Rd0000644000176200001440000000071413430347452015056 0ustar liggesusers\name{up.sample} \alias{up.sample} \title{Upsampling of a vector} \description{ Upsamples a given vector. } \usage{up.sample(x, f, y = NA) } \arguments{ \item{x}{vector of observations} \item{f}{frequency of upsampling; e.g, 2, 4, etc.} \item{y}{value to upsample with; e.g., NA, 0, etc.} } \value{ A vector twice its length. } %\details{} \references{ Any basic signal processing text. } %\seealso{} %\examples{} \author{B. Whitcher} \keyword{ts} waveslim/man/dwt.Rd0000644000176200001440000001022513430347452013746 0ustar liggesusers\name{dwt} \alias{dwt} \alias{dwt.nondyadic} \alias{idwt} \title{Discrete Wavelet Transform (DWT)} \description{ This function performs a level \eqn{J} decomposition of the input vector or time series using the pyramid algorithm (Mallat 1989). } \usage{ dwt(x, wf="la8", n.levels=4, boundary="periodic") dwt.nondyadic(x) } \arguments{ \item{x}{a vector or time series containing the data be to decomposed. This must be a dyadic length vector (power of 2).} \item{wf}{ Name of the wavelet filter to use in the decomposition. By default this is set to \code{"la8"}, the Daubechies orthonormal compactly supported wavelet of length \eqn{L=8} (Daubechies, 1992), least asymmetric family. } \item{n.levels}{ Specifies the depth of the decomposition. This must be a number less than or equal to \eqn{\log(\mbox{length}(x),2)}{log(length(x),2)}. } \item{boundary}{ Character string specifying the boundary condition. If \code{boundary=="periodic"} the default, then the vector you decompose is assumed to be periodic on its defined interval,\cr if \code{boundary=="reflection"}, the vector beyond its boundaries is assumed to be a symmetric reflection of itself. } } \value{ Basically, a list with the following components \item{d?}{Wavelet coefficient vectors.} \item{s?}{Scaling coefficient vector.} \item{wavelet}{Name of the wavelet filter used.} \item{boundary}{How the boundaries were handled.} } \details{ The code implements the one-dimensional DWT using the pyramid algorithm (Mallat, 1989). The actual transform is performed in C using pseudocode from Percival and Walden (2001). That means convolutions, not inner products, are used to apply the wavelet filters. For a non-dyadic length vector or time series, \code{dwt.nondyadic} pads with zeros, performs the orthonormal DWT on this dyadic length series and then truncates the wavelet coefficient vectors appropriately. } \references{ Daubechies, I. (1992) \emph{Ten Lectures on Wavelets}, CBMS-NSF Regional Conference Series in Applied Mathematics, SIAM: Philadelphia. Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. Mallat, S. G. (1989) A theory for multiresolution signal decomposition: the wavelet representation, \emph{IEEE Transactions on Pattern Analysis and Machine Intelligence}, \bold{11}, No. 7, 674-693. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. } \seealso{ \code{\link{modwt}}, \code{\link{mra}}. } \examples{ ## Figures 4.17 and 4.18 in Gencay, Selcuk and Whitcher (2001). data(ibm) ibm.returns <- diff(log(ibm)) ## Haar ibmr.haar <- dwt(ibm.returns, "haar") names(ibmr.haar) <- c("w1", "w2", "w3", "w4", "v4") ## plot partial Haar DWT for IBM data par(mfcol=c(6,1), pty="m", mar=c(5-2,4,4-2,2)) plot.ts(ibm.returns, axes=FALSE, ylab="", main="(a)") for(i in 1:4) plot.ts(up.sample(ibmr.haar[[i]], 2^i), type="h", axes=FALSE, ylab=names(ibmr.haar)[i]) plot.ts(up.sample(ibmr.haar$v4, 2^4), type="h", axes=FALSE, ylab=names(ibmr.haar)[5]) axis(side=1, at=seq(0,368,by=23), labels=c(0,"",46,"",92,"",138,"",184,"",230,"",276,"",322,"",368)) ## LA(8) ibmr.la8 <- dwt(ibm.returns, "la8") names(ibmr.la8) <- c("w1", "w2", "w3", "w4", "v4") ## must shift LA(8) coefficients ibmr.la8$w1 <- c(ibmr.la8$w1[-c(1:2)], ibmr.la8$w1[1:2]) ibmr.la8$w2 <- c(ibmr.la8$w2[-c(1:2)], ibmr.la8$w2[1:2]) for(i in names(ibmr.la8)[3:4]) ibmr.la8[[i]] <- c(ibmr.la8[[i]][-c(1:3)], ibmr.la8[[i]][1:3]) ibmr.la8$v4 <- c(ibmr.la8$v4[-c(1:2)], ibmr.la8$v4[1:2]) ## plot partial LA(8) DWT for IBM data par(mfcol=c(6,1), pty="m", mar=c(5-2,4,4-2,2)) plot.ts(ibm.returns, axes=FALSE, ylab="", main="(b)") for(i in 1:4) plot.ts(up.sample(ibmr.la8[[i]], 2^i), type="h", axes=FALSE, ylab=names(ibmr.la8)[i]) plot.ts(up.sample(ibmr.la8$v4, 2^4), type="h", axes=FALSE, ylab=names(ibmr.la8)[5]) axis(side=1, at=seq(0,368,by=23), labels=c(0,"",46,"",92,"",138,"",184,"",230,"",276,"",322,"",368)) } \author{B. Whitcher} \keyword{ts} waveslim/man/mra.3d.Rd0000644000176200001440000000374513430347452014245 0ustar liggesusers\name{mra.3d} \alias{mra.3d} \title{Three Dimensional Multiresolution Analysis} \description{ This function performs a level \eqn{J} additive decomposition of the input array using the pyramid algorithm (Mallat 1989). } \usage{mra.3d(x, wf, J=4, method="modwt", boundary="periodic") } \arguments{ \item{x}{A three-dimensional array containing the data be to decomposed. This must be have dyadic length in all three dimensions (but not necessarily the same) for \code{method="dwt"}.} \item{wf}{Name of the wavelet filter to use in the decomposition. By default this is set to \code{"la8"}, the Daubechies orthonormal compactly supported wavelet of length \eqn{L=8} least asymmetric family.} \item{J}{Specifies the depth of the decomposition. This must be a number less than or equal to \eqn{\log(\mbox{length}(x),2)}{log(length(x),2)}.} \item{method}{Either \code{"dwt"} or \code{"modwt"}.} \item{boundary}{Character string specifying the boundary condition. If \code{boundary=="periodic"} the default and only method implemented, then the matrix you decompose is assumed to be periodic on its defined interval.} } \details{ This code implements a three-dimensional multiresolution analysis by performing the one-dimensional pyramid algorithm (Mallat 1989) on each dimension of the input array. Either the DWT or MODWT may be used to compute the multiresolution analysis, which is an additive decomposition of the original array. } \value{ List structure containing the filter triplets associated with the multiresolution analysis. } \references{ Mallat, S. G. (1989) A theory for multiresolution signal decomposition: the wavelet representation, \emph{IEEE Transactions on Pattern Analysis and Machine Intelligence}, \bold{11}, No. 7, 674-693. Mallat, S. G. (1998) \emph{A Wavelet Tour of Signal Processing}, Academic Press. } \seealso{ \code{\link{dwt.3d}}, \code{\link{modwt.3d}} } %\examples{} \author{B. Whitcher} \keyword{ts} waveslim/man/Farras.Rd0000644000176200001440000000170113621324324014360 0ustar liggesusers\name{Farras} \alias{farras} \alias{FSfarras} \title{Farras nearly symmetric filters} \description{ Farras nearly symmetric filters for orthogonal 2-channel perfect reconstruction filter bank and Farras filters organized for the dual-tree complex DWT. } \usage{ farras() FSfarras() } \arguments{ None. } \value{ \item{af}{List (\eqn{i=1,2}) - analysis filters for tree \eqn{i}} \item{sf}{List (\eqn{i=1,2}) - synthesis filters for tree \eqn{i}} } %\details{} \references{ A. F. Abdelnour and I. W. Selesnick. \dQuote{Nearly symmetric orthogonal wavelet bases}, Proc. IEEE Int. Conf. Acoust., Speech, Signal Processing (ICASSP), May 2001. WAVELET SOFTWARE AT POLYTECHNIC UNIVERSITY, BROOKLYN, NY\cr \url{http://eeweb.poly.edu/iselesni/WaveletSoftware/} } \seealso{ \code{\link{afb}}, \code{\link{dualtree}}, \code{\link{dualfilt1}}. } %\examples{} \author{Matlab: S. Cai, K. Li and I. Selesnick; R port: Brandon Whitcher} \keyword{ts} waveslim/man/exchange.Rd0000644000176200001440000000107013430347452014730 0ustar liggesusers\name{exchange} \alias{exchange} \title{Exchange Rates Between the Deutsche Mark, Japanese Yen and U.S. Dollar} \description{ Monthly foreign exchange rates for the Deutsche Mark - U.S. Dollar (DEM-USD) and Japanese Yen - U.S. Dollar (JPY-USD) starting in 1970. } \usage{data(exchange) } \format{A bivariate time series containing 348 observations. } \source{Unknown. } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. } \keyword{datasets} waveslim/man/wavelet.filter.Rd0000644000176200001440000000432313430347452016105 0ustar liggesusers\name{wavelet.filter} \alias{wavelet.filter} \title{Higher-Order Wavelet Filters} \description{ Create a wavelet filter at arbitrary scale. } \usage{wavelet.filter(wf.name, filter.seq = "L", n = 512) } \arguments{ \item{wf.name}{Character string of wavelet filter.} \item{filter.seq}{Character string of filter sequence. \code{H} means high-pass filtering and \code{L} means low-pass filtering. Sequence is read from right to left.} \item{n}{Length of zero-padded filter. Frequency resolution will be \code{n}/2+1.} } \value{ Vector of wavelet coefficients. } \details{ Uses \code{cascade} subroutine to compute higher-order wavelet coefficient vector from a given filtering sequence. } \references{ Bruce, A. and H.-Y. Gao (1996). \emph{Applied Wavelet Analysis with S-PLUS}, Springer: New York. Doroslovacki, M. L. (1998) On the least asymmetric wavelets, \emph{IEEE Transactions on Signal Processing}, \bold{46}, No. 4, 1125-1130. Daubechies, I. (1992) \emph{Ten Lectures on Wavelets}, CBMS-NSF Regional Conference Series in Applied Mathematics, SIAM: Philadelphia. Morris and Peravali (1999) Minimum-bandwidth discrete-time wavelets, \emph{Signal Processing}, \bold{76}, No. 2, 181-193. Nielsen, M. (2001) On the Construction and Frequency Localization of Finite Orthogonal Quadrature Filters, \emph{Journal of Approximation Theory}, \bold{108}, No. 1, 36-52. } \seealso{ \code{\link{squared.gain}}, \code{\link{wave.filter}}. } \examples{ ## Figure 4.14 in Gencay, Selcuk and Whitcher (2001) par(mfrow=c(3,1), mar=c(5-2,4,4-1,2)) f.seq <- "HLLLLL" plot(c(rep(0,33), wavelet.filter("mb4", f.seq), rep(0,33)), type="l", xlab="", ylab="", main="D(4) in black, MB(4) in red") lines(c(rep(0,33), wavelet.filter("d4", f.seq), rep(0,33)), col=2) plot(c(rep(0,35), -wavelet.filter("mb8", f.seq), rep(0,35)), type="l", xlab="", ylab="", main="D(8) in black, -MB(8) in red") lines(c(rep(0,35), wavelet.filter("d8", f.seq), rep(0,35)), col=2) plot(c(rep(0,39), wavelet.filter("mb16", f.seq), rep(0,39)), type="l", xlab="", ylab="", main="D(16) in black, MB(16) in red") lines(c(rep(0,39), wavelet.filter("d16", f.seq), rep(0,39)), col=2) } \author{B. Whitcher} \keyword{ts} waveslim/man/fb.Rd0000644000176200001440000000601113621324376013537 0ustar liggesusers\name{Dual-tree Filter Banks} \alias{afb} \alias{afb2D} \alias{afb2D.A} \alias{sfb} \alias{sfb2D} \alias{sfb2D.A} \title{Filter Banks for Dual-Tree Wavelet Transforms} \description{ Analysis and synthesis filter banks used in dual-tree wavelet algorithms. } \usage{ afb(x, af) afb2D(x, af1, af2 = NULL) afb2D.A(x, af, d) sfb(lo, hi, sf) sfb2D(lo, hi, sf1, sf2 = NULL) sfb2D.A(lo, hi, sf, d) } \arguments{ \item{x}{vector or matrix of observations} \item{af}{analysis filters. First element of the list is the low-pass filter, second element is the high-pass filter.} \item{af1,af2}{analysis filters for the first and second dimension of a 2D array.} \item{sf}{synthesis filters. First element of the list is the low-pass filter, second element is the high-pass filter.} \item{sf1,sf2}{synthesis filters for the first and second dimension of a 2D array.} \item{d}{dimension of filtering (d = 1 or 2)} \item{lo}{low-frequecy coefficients} \item{hi}{high-frequency coefficients} } \details{ The functions \code{afb2D.A} and \code{sfb2D.A} implement the convolutions, either for analysis or synthesis, in one dimension only. Thus, they are the workhorses of \code{afb2D} and \code{sfb2D}. The output for the analysis filter bank along one dimension (\code{afb2D.A}) is a list with two elements \describe{ \item{lo}{low-pass subband} \item{hi}{high-pass subband} } where the dimension of analysis will be half its original length. The output for the synthesis filter bank along one dimension (\code{sfb2D.A}) will be the output array, where the dimension of synthesis will be twice its original length. } \value{ In one dimension the output for the analysis filter bank (\code{afb}) is a list with two elements \item{lo}{Low frequecy output} \item{hi}{High frequency output} and the output for the synthesis filter bank (\code{sfb}) is the output signal. In two dimensions the output for the analysis filter bank (\code{afb2D}) is a list with four elements \item{lo}{low-pass subband} \item{hi[[1]]}{'lohi' subband} \item{hi[[2]]}{'hilo' subband} \item{hi[[3]]}{'hihi' subband} and the output for the synthesis filter bank (\code{sfb2D}) is the output array. } \references{ WAVELET SOFTWARE AT POLYTECHNIC UNIVERSITY, BROOKLYN, NY\cr \url{http://eeweb.poly.edu/iselesni/WaveletSoftware/} } %\seealso{} \examples{ ## EXAMPLE: afb, sfb af = farras()$af sf = farras()$sf x = rnorm(64) x.afb = afb(x, af) lo = x.afb$lo hi = x.afb$hi y = sfb(lo, hi, sf) err = x - y max(abs(err)) ## EXAMPLE: afb2D, sfb2D x = matrix(rnorm(32*64), 32, 64) af = farras()$af sf = farras()$sf x.afb2D = afb2D(x, af, af) lo = x.afb2D$lo hi = x.afb2D$hi y = sfb2D(lo, hi, sf, sf) err = x - y max(abs(err)) ## Example: afb2D.A, sfb2D.A x = matrix(rnorm(32*64), 32, 64) af = farras()$af sf = farras()$sf x.afb2D.A = afb2D.A(x, af, 1) lo = x.afb2D.A$lo hi = x.afb2D.A$hi y = sfb2D.A(lo, hi, sf, 1) err = x - y max(abs(err)) } \author{Matlab: S. Cai, K. Li and I. Selesnick; R port: B. Whitcher} \keyword{ts} waveslim/man/Thresholding.Rd0000644000176200001440000000451013430347452015602 0ustar liggesusers\name{Thresholding} \alias{Thresholding} \alias{da.thresh} \alias{hybrid.thresh} \alias{manual.thresh} \alias{sure.thresh} \alias{universal.thresh} \alias{universal.thresh.modwt} \alias{bishrink} \alias{soft} \title{Wavelet Shrinkage via Thresholding} \description{ Perform wavelet shrinkage using data-analytic, hybrid SURE, manual, SURE, or universal thresholding. } \usage{ da.thresh(wc, alpha = .05, max.level = 4, verbose = FALSE, return.thresh = FALSE) hybrid.thresh(wc, max.level = 4, verbose = FALSE, seed = 0) manual.thresh(wc, max.level = 4, value, hard = TRUE) sure.thresh(wc, max.level = 4, hard = TRUE) universal.thresh(wc, max.level = 4, hard = TRUE) universal.thresh.modwt(wc, max.level = 4, hard = TRUE) } \arguments{ \item{wc}{wavelet coefficients} \item{alpha}{level of the hypothesis tests} \item{max.level}{maximum level of coefficients to be affected by threshold} \item{verbose}{if \code{verbose=TRUE} then information is printed to the screen} \item{value}{threshold value (only utilized in \code{manual.thresh})} \item{hard}{Boolean value, if \code{hard=F} then soft thresholding is used} \item{seed}{sets random seed (only utilized in \code{hybrid.thresh})} \item{return.thresh}{if \code{return.thresh=TRUE} then the vector of threshold values is returned, otherwise the surviving wavelet coefficients are returned} } \value{ The default output is a list structure, the same length as was input, containing only those wavelet coefficients surviving the threshold. } \details{ An extensive amount of literature has been written on wavelet shrinkage. The functions here represent the most basic approaches to the problem of nonparametric function estimation. See the references for further information. } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. Ogden, R. T. (1996) \emph{Essential Wavelets for Statistical Applications and Data Analysis}, Birkhauser. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. Vidakovic, B. (1999) \emph{Statistical Modeling by Wavelets}, John Wiley \& Sons. } %\seealso{} %\examples{} \author{B. Whitcher (some code taken from R. Todd Ogden)} \keyword{ts} waveslim/man/rotcumvar.Rd0000644000176200001440000000231713430347452015175 0ustar liggesusers\name{rotcumvar} \alias{rotcumvar} \title{Rotated Cumulative Variance} \description{ Provides the normalized cumulative sums of squares from a sequence of coefficients with the diagonal line removed. } \usage{rotcumvar(x) } \arguments{ \item{x}{vector of coefficients to be cumulatively summed (missing values excluded)} } \value{Vector of coefficients that are the sumulative sum of squared input coefficients. } \details{ The rotated cumulative variance, when plotted, provides a qualitative way to study the time dependence of the variance of a series. If the variance is stationary over time, then only small deviations from zero should be present. If on the other hand the variance is non-stationary, then large departures may exist. Formal hypothesis testing may be performed based on boundary crossings of Brownian bridge processes. } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. } %\seealso{} %\examples{} \author{B. Whitcher} \keyword{ts} waveslim/man/hilbert.Rd0000644000176200001440000000301213430347452014575 0ustar liggesusers\name{Hilbert} \alias{dwt.hilbert} \alias{dwt.hilbert.nondyadic} \alias{idwt.hilbert} \alias{modwt.hilbert} \alias{imodwt.hilbert} \alias{modwpt.hilbert} \title{Discrete Hilbert Wavelet Transforms} \description{ The discrete Hilbert wavelet transforms (DHWTs) for seasonal and time-varying time series analysis. Transforms include the usual orthogonal (decimated), maximal-overlap (non-decimated) and maximal-overlap packet transforms. } \usage{ dwt.hilbert(x, wf, n.levels=4, boundary="periodic", ...) dwt.hilbert.nondyadic(x, ...) idwt.hilbert(y) modwt.hilbert(x, wf, n.levels=4, boundary="periodic", ...) imodwt.hilbert(y) modwpt.hilbert(x, wf, n.levels=4, boundary="periodic") } \arguments{ \item{x}{Real-valued time series or vector of observations.} \item{wf}{Hilbert wavelet pair} \item{n.levels}{Number of levels (depth) of the wavelet transform.} \item{boundary}{Boundary treatment, currently only \code{periodic} and \code{reflection}.} \item{y}{Hilbert wavelet transform object (list).} \item{\ldots}{Additional parametes to be passed on.} } %\value{} %\details{} \references{ Selesnick, I. (200X). \emph{IEEE Signal Processing Magazine} Selesnick, I. (200X). \emph{IEEE Transactions in Signal Processing} Whither, B. and P.F. Craigmile (2004). Multivariate Spectral Analysis Using Hilbert Wavelet Pairs, \emph{International Journal of Wavelets, Multiresolution and Information Processing}, to appear. } \seealso{ \code{\link{hilbert.filter}} } %\examples{} \author{B. Whitcher} \keyword{ts} waveslim/man/bandpass.Rd0000644000176200001440000000265013430347452014746 0ustar liggesusers\name{Band-pass variance} \alias{bandpass.fdp} \alias{bandpass.spp} \alias{bandpass.spp2} \alias{bandpass.var.spp} \title{Bandpass Variance for Long-Memory Processes} \description{ Computes the band-pass variance for fractional difference (FD) or seasonal persistent (SP) processes using numeric integration of their spectral density function. } \usage{ bandpass.fdp(a, b, d) bandpass.spp(a, b, d, fG) bandpass.spp2(a, b, d1, f1, d2, f2) bandpass.var.spp(delta, fG, J, Basis, Length) } \arguments{ \item{a}{Left-hand boundary for the definite integral.} \item{b}{Right-hand boundary for the definite integral.} \item{d,delta,d1,d2}{Fractional difference parameter.} \item{fG,f1,f2}{Gegenbauer frequency.} \item{J}{Depth of the wavelet transform.} \item{Basis}{Logical vector representing the adaptive basis.} \item{Length}{Number of elements in Basis.} } \value{ Band-pass variance for the FD or SP process between \eqn{a} and \eqn{b}. } \details{ See references. } \references{ McCoy, E. J., and A. T. Walden (1996) Wavelet analysis and synthesis of stationary long-memory processes, \emph{Journal for Computational and Graphical Statistics}, \bold{5}, No. 1, 26-56. Whitcher, B. (2001) Simulating Gaussian stationary processes with unbounded spectra, \emph{Journal for Computational and Graphical Statistics}, \bold{10}, No. 1, 112-134. } %\seealso{} %\examples{} \author{Brandon Whitcher} \keyword{ts} waveslim/man/spp.mle.Rd0000644000176200001440000000353313430347452014532 0ustar liggesusers\name{spp.mle} \alias{spp.mle} \alias{spp2.mle} \title{Wavelet-based Maximum Likelihood Estimation for Seasonal Persistent Processes} \description{ Parameter estimation for a seasonal persistent (seasonal long-memory) process is performed via maximum likelihood on the wavelet coefficients. } \usage{spp.mle(y, wf, J=log(length(y),2)-1, p=0.01, frac=1) spp2.mle(y, wf, J=log(length(y),2)-1, p=0.01, dyadic=TRUE, frac=1) } \arguments{ \item{y}{Not necessarily dyadic length time series.} \item{wf}{Name of the wavelet filter to use in the decomposition. See \code{\link{wave.filter}} for those wavelet filters available.} \item{J}{Depth of the discrete wavelet packet transform.} \item{p}{Level of significance for the white noise testing procedure.} \item{dyadic}{Logical parameter indicating whether or not the original time series is dyadic in length.} \item{frac}{Fraction of the time series that should be used in constructing the likelihood function.} } \value{ List containing the maximum likelihood estimates (MLEs) of \eqn{\delta}, \eqn{f_G} and \eqn{\sigma^2}, along with the value of the likelihood for those estimates. } \details{ The variance-covariance matrix of the original time series is approximated by its wavelet-based equivalent. A Whittle-type likelihood is then constructed where the sums of squared wavelet coefficients are compared to bandpass filtered version of the true spectral density function. Minimization occurs for the fractional difference parameter \eqn{d} and the Gegenbauer frequency \eqn{f_G}, while the innovations variance is subsequently estimated. } \references{ Whitcher, B. (2004) Wavelet-based estimation for seasonal long-memory processes, \emph{Technometrics}, \bold{46}, No. 2, 225-238. } \seealso{ \code{\link{fdp.mle}} } %\examples{} \author{B. Whitcher} \keyword{ts} waveslim/man/kobe.Rd0000644000176200001440000000071013621325046014063 0ustar liggesusers\name{kobe} \alias{kobe} \title{1995 Kobe Earthquake Data} \description{ Seismograph (vertical acceleration, nm/sq.sec) of the Kobe earthquake, recorded at Tasmania University, HobarTRUE, Australia on 16 January 1995 beginning at 20:56:51 (GMTRUE) and continuing for 51 minutes at 1 second intervals. } \usage{data(kobe) } \format{A vector containing 3048 observations. } \source{Data management centre, Washington University. } \keyword{datasets} waveslim/man/dau.Rd0000644000176200001440000000077113430347452013726 0ustar liggesusers\name{dau} \alias{dau} \title{Digital Photograph of Ingrid Daubechies} \description{ A digital photograph of Ingrid Daubechies taken at the 1993 AMS winter meetings in San Antonio, Texas. The photograph was taken by David Donoho with a Canon XapShot video still frame camera. } \usage{data(dau) } \format{A 256 \eqn{\times}{x} 256 matrix. } \source{S+WAVELETS. } \references{ Bruce, A., and H.-Y. Gao (1996) \emph{Applied Wavelet Analysis with S-PLUS}, Springer: New York. } \keyword{datasets} waveslim/man/unemploy.Rd0000644000176200001440000000064413430347452015024 0ustar liggesusers\name{unemploy} \alias{unemploy} \title{U.S. Unemployment} \description{ Monthly U.S. unemployment figures from 1948:1 to 1999:12. } \usage{data(unemploy) } \format{A vector containing 624 observations. } \source{Unknown. } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. } \keyword{datasets} waveslim/man/phase.shift.Rd0000644000176200001440000000240613430347452015366 0ustar liggesusers\name{phase.shift} \alias{phase.shift} \alias{phase.shift.packet} \title{Phase Shift Wavelet Coefficients} \description{ Wavelet coefficients are circularly shifted by the amount of phase shift induced by the wavelet transform. } \usage{phase.shift(z, wf, inv = FALSE) phase.shift.packet(z, wf, inv = FALSE) } \arguments{ \item{z}{DWT object} \item{wf}{character string; wavelet filter used in DWT} \item{inv}{Boolean variable; if \code{inv=TRUE} then the inverse phase shift is applied} } \value{ DWT (DWPT) object with coefficients circularly shifted. } \details{ The center-of-energy argument of Hess-Nielsen and Wickerhauser (1996) is used to provide a flexible way to circularly shift wavelet coefficients regardless of the wavelet filter used. The results are not identical to those used by Percival and Walden (2000), but are more flexible. \code{phase.shift.packet} is not yet implemented fully. } \references{ Hess-Nielsen, N. and M. V. Wickerhauser (1996) Wavelets and time-frequency analysis, \emph{Proceedings of the IEEE}, \bold{84}, No. 4, 523-540. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. } %\seealso{} %\examples{} \author{B. Whitcher} \keyword{ts} waveslim/man/modwt.3d.Rd0000644000176200001440000000121713430347452014610 0ustar liggesusers\name{modwt.3d} \alias{modwt.3d} \alias{imodwt.3d} \title{Three Dimensional Separable Maximal Ovelrap Discrete Wavelet Transform} \description{ Three-dimensional separable maximal overlap discrete wavelet transform (MODWT). } \usage{ modwt.3d(x, wf, J = 4, boundary = "periodic") imodwt.3d(y) } \arguments{ \item{x}{input array} \item{wf}{name of the wavelet filter to use in the decomposition} \item{J}{depth of the decomposition} \item{boundary}{only \code{"periodic"} is currently implemented} \item{y}{an object of class \code{modwt.3d}} } %\value{} %\details{} %\references{} %\seealso{} %\examples{} \author{B. Whitcher} \keyword{ts} waveslim/man/dwpt.2d.Rd0000644000176200001440000000525013430347452014434 0ustar liggesusers\name{dwpt.2d} \alias{dwpt.2d} \alias{idwpt.2d} %\alias{modwpt.2d} \title{(Inverse) Discrete Wavelet Packet Transforms in Two Dimensions} \description{ All possible filtering combinations (low- and high-pass) are performed to decompose a matrix or image. The resulting coefficients are associated with a quad-tree structure corresponding to a partitioning of the two-dimensional frequency plane. } \usage{dwpt.2d(x, wf="la8", J=4, boundary="periodic") idwpt.2d(y, y.basis) %modwpt.2d(x, wf="la8", J=4, boundary="periodic") } \arguments{ \item{x}{ a matrix or image containing the data be to decomposed. This ojbect must be dyadic (power of 2) in length in each dimension. } \item{wf}{ Name of the wavelet filter to use in the decomposition. By default this is set to \code{"la8"}, the Daubechies orthonormal compactly supported wavelet of length \eqn{L=8} (Daubechies, 1992), least asymmetric family. } \item{J}{ Specifies the depth of the decomposition. This must be a number less than or equal to \eqn{\log(\mbox{length}(x),2)}. } \item{boundary}{ Character string specifying the boundary condition. If \code{boundary=="periodic"} the default, then the vector you decompose is assumed to be periodic on its defined interval,\cr if \code{boundary=="reflection"}, the vector beyond its boundaries is assumed to be a symmetric reflection of itself. } \item{y}{\code{dwpt.2d} object (list-based structure of matrices)} \item{y.basis}{Boolean vector, the same length as \eqn{y}, where \code{TRUE} means the basis tensor should be used in the reconstruction.} } \value{ Basically, a list with the following components \item{w?.?-w?.?}{Wavelet coefficient matrices (images). The first index is associated with the scale of the decomposition while the second is associated with the frequency partition within that level. The left and right strings, separated by the dash `-', correspond to the first \eqn{(x)} and second \eqn{(y)} dimensions.} \item{wavelet}{Name of the wavelet filter used.} \item{boundary}{How the boundaries were handled.} } \details{ The code implements the two-dimensional DWPT using the pyramid algorithm of Mallat (1989). } \references{ Mallat, S. G. (1989) A theory for multiresolution signal decomposition: the wavelet representation, \emph{IEEE Transactions on Pattern Analysis and Machine Intelligence}, \bold{11}, No. 7, 674-693. Wickerhauser, M. V. (1994) \emph{Adapted Wavelet Analysis from Theory to Software}, A K Peters. } \seealso{ \code{\link{dwt.2d}}, \code{\link{modwt.2d}}, \code{\link{wave.filter}}. } %\examples{} \author{B. Whitcher} \keyword{ts} waveslim/man/wpt.test.Rd0000644000176200001440000000340313430347452014740 0ustar liggesusers\name{wpt.test} \alias{cpgram.test} \alias{css.test} \alias{entropy.test} \alias{portmanteau.test} \title{Testing the Wavelet Packet Tree for White Noise} \description{ A wavelet packet tree, from the discrete wavelet packet transform (DWPT), is tested node-by-node for white noise. This is the first step in selecting an orthonormal basis for the DWPT. } \usage{cpgram.test(y, p = 0.05, taper = 0.1) css.test(y) entropy.test(y) portmanteau.test(y, p = 0.05, type = "Box-Pierce") } \arguments{ \item{y}{wavelet packet tree (from the DWPT)} \item{p}{significance level} \item{taper}{weight of cosine bell taper (\code{cpgram.test} only)} \item{type}{\code{"Box-Pierce"} and \code{other} recognized (\code{portmanteau.test} only)} } \value{ Boolean vector of the same length as the number of nodes in the wavelet packet tree. } \details{ Top-down recursive testing of the wavelet packet tree is } \references{ Brockwell and Davis (1991) \emph{Time Series: Theory and Methods}, (2nd. edition), Springer-Verlag. Brown, Durbin and Evans (1975) Techniques for testing the constancy of regression relationships over time, \emph{Journal of the Royal Statistical Society B}, \bold{37}, 149-163. Percival, D. B., and A. T. Walden (1993) \emph{Spectral Analysis for Physical Applications: Multitaper and Conventional Univariate Techniques}, Cambridge University Press. } \seealso{ \code{\link{ortho.basis}}. } \examples{ data(mexm) J <- 6 wf <- "la8" mexm.dwpt <- dwpt(mexm[-(1:4)], wf, J) ## Not implemented yet ## plot.dwpt(x.dwpt, J) mexm.dwpt.bw <- dwpt.brick.wall(mexm.dwpt, wf, 6, method="dwpt") mexm.tree <- ortho.basis(portmanteau.test(mexm.dwpt.bw, p=0.025)) ## Not implemented yet ## plot.basis(mexm.tree) } \author{B. Whitcher} \keyword{ts} waveslim/man/shift.2d.Rd0000644000176200001440000000316413430347452014575 0ustar liggesusers\name{shift.2d} \alias{shift.2d} \title{Circularly Shift Matrices from a 2D MODWT} \description{ Compute phase shifts for wavelet sub-matrices based on the ``center of energy'' argument of Hess-Nielsen and Wickerhauser (1996). } \usage{shift.2d(z, inverse=FALSE) } \arguments{ \item{z}{Two-dimensional MODWT object} % \item{wf}{Character string for wavelet filter.} \item{inverse}{Boolean value on whether to perform the forward or inverse operation.} } \value{ Two-dimensional MODWT object with circularly shifted coefficients. } \details{ The "center of energy" technique of Wickerhauser and Hess-Nielsen (1996) is employed to find circular shifts for the wavelet sub-matrices such that the coefficients are aligned with the original series. This corresponds to applying a (near) linear-phase filtering operation. } \references{ Hess-Nielsen, N. and M. V. Wickerhauser (1996) Wavelets and time-frequency analysis, \emph{Proceedings of the IEEE}, \bold{84}, No. 4, 523-540. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. } \seealso{ \code{\link{phase.shift}}, \code{\link{modwt.2d}}. } \examples{ n <- 512 G1 <- G2 <- dnorm(seq(-n/4, n/4, length=n)) G <- 100 * zapsmall(outer(G1, G2)) G <- modwt.2d(G, wf="la8", J=6) k <- 50 xr <- yr <- trunc(n/2) + (-k:k) par(mfrow=c(3,3), mar=c(1,1,2,1), pty="s") for (j in names(G)[1:9]) { image(G[[j]][xr,yr], col=rainbow(64), axes=FALSE, main=j) } Gs <- shift.2d(G) for (j in names(G)[1:9]) { image(Gs[[j]][xr,yr], col=rainbow(64), axes=FALSE, main=j) } } \author{Brandon Whitcher} \keyword{ts} waveslim/man/mra.Rd0000644000176200001440000000656213430347452013740 0ustar liggesusers\name{mra} \alias{mra} \title{Multiresolution Analysis of Time Series} \description{ This function performs a level \eqn{J} additive decomposition of the input vector or time series using the pyramid algorithm (Mallat 1989). } \usage{mra(x, wf = "la8", J = 4, method = "modwt", boundary = "periodic") } \arguments{ \item{x}{A vector or time series containing the data be to decomposed. This must be a dyadic length vector (power of 2) for \code{method="dwt"}.} \item{wf}{Name of the wavelet filter to use in the decomposition. By default this is set to \code{"la8"}, the Daubechies orthonormal compactly supported wavelet of length \eqn{L=8} least asymmetric family.} \item{J}{Specifies the depth of the decomposition. This must be a number less than or equal to \eqn{\log(\mbox{length}(x),2)}{log(length(x),2)}.} \item{method}{Either \code{"dwt"} or \code{"modwt"}.} \item{boundary}{Character string specifying the boundary condition. If \code{boundary=="periodic"} the default, then the vector you decompose is assumed to be periodic on its defined interval,\cr if \code{boundary=="reflection"}, the vector beyond its boundaries is assumed to be a symmetric reflection of itself.} } \value{ Basically, a list with the following components \item{D?}{Wavelet detail vectors.} \item{S?}{Wavelet smooth vector.} \item{wavelet}{Name of the wavelet filter used.} \item{boundary}{How the boundaries were handled.} } \details{ This code implements a one-dimensional multiresolution analysis introduced by Mallat (1989). Either the DWT or MODWT may be used to compute the multiresolution analysis, which is an additive decomposition of the original time series. } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. Mallat, S. G. (1989) A theory for multiresolution signal decomposition: the wavelet representation, \emph{IEEE Transactions on Pattern Analysis and Machine Intelligence}, \bold{11}, No. 7, 674-693. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. } \seealso{ \code{\link{dwt}}, \code{\link{modwt}}. } \examples{ ## Easy check to see if it works... x <- rnorm(32) x.mra <- mra(x) sum(x - apply(matrix(unlist(x.mra), nrow=32), 1, sum))^2 ## Figure 4.19 in Gencay, Selcuk and Whitcher (2001) data(ibm) ibm.returns <- diff(log(ibm)) ibm.volatility <- abs(ibm.returns) ## Haar ibmv.haar <- mra(ibm.volatility, "haar", 4, "dwt") names(ibmv.haar) <- c("d1", "d2", "d3", "d4", "s4") ## LA(8) ibmv.la8 <- mra(ibm.volatility, "la8", 4, "dwt") names(ibmv.la8) <- c("d1", "d2", "d3", "d4", "s4") ## plot multiresolution analysis of IBM data par(mfcol=c(6,1), pty="m", mar=c(5-2,4,4-2,2)) plot.ts(ibm.volatility, axes=FALSE, ylab="", main="(a)") for(i in 1:5) plot.ts(ibmv.haar[[i]], axes=FALSE, ylab=names(ibmv.haar)[i]) axis(side=1, at=seq(0,368,by=23), labels=c(0,"",46,"",92,"",138,"",184,"",230,"",276,"",322,"",368)) par(mfcol=c(6,1), pty="m", mar=c(5-2,4,4-2,2)) plot.ts(ibm.volatility, axes=FALSE, ylab="", main="(b)") for(i in 1:5) plot.ts(ibmv.la8[[i]], axes=FALSE, ylab=names(ibmv.la8)[i]) axis(side=1, at=seq(0,368,by=23), labels=c(0,"",46,"",92,"",138,"",184,"",230,"",276,"",322,"",368)) } \author{B. Whitcher} \keyword{ts} waveslim/man/spin.covariance.Rd0000644000176200001440000000473713430347452016245 0ustar liggesusers\name{spin.covariance} \alias{spin.covariance} \alias{spin.correlation} \title{Compute Wavelet Cross-Covariance Between Two Time Series} \description{ Computes wavelet cross-covariance or cross-correlation between two time series. } \usage{spin.covariance(x, y, lag.max = NA) spin.correlation(x, y, lag.max = NA) } \arguments{ \item{x}{first time series} \item{y}{second time series, same length as \code{x}} \item{lag.max}{maximum lag to compute cross-covariance (correlation)} } \value{ List structure holding the wavelet cross-covariances (correlations) according to scale. } \details{ See references. } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. Whitcher, B., P. Guttorp and D. B. Percival (2000) Wavelet analysis of covariance with application to atmospheric time series, \emph{Journal of Geophysical Research}, \bold{105}, No. D11, 14,941-14,962. } \seealso{ \code{\link{wave.covariance}}, \code{\link{wave.correlation}}. } \examples{ ## Figure 7.9 from Gencay, Selcuk and Whitcher (2001) data(exchange) returns <- diff(log(exchange)) returns <- ts(returns, start=1970, freq=12) wf <- "d4" demusd.modwt <- modwt(returns[,"DEM.USD"], wf, 8) demusd.modwt.bw <- brick.wall(demusd.modwt, wf) jpyusd.modwt <- modwt(returns[,"JPY.USD"], wf, 8) jpyusd.modwt.bw <- brick.wall(jpyusd.modwt, wf) n <- dim(returns)[1] J <- 6 lmax <- 36 returns.cross.cor <- NULL for(i in 1:J) { blah <- spin.correlation(demusd.modwt.bw[[i]], jpyusd.modwt.bw[[i]], lmax) returns.cross.cor <- cbind(returns.cross.cor, blah) } returns.cross.cor <- ts(as.matrix(returns.cross.cor), start=-36, freq=1) dimnames(returns.cross.cor) <- list(NULL, paste("Level", 1:J)) lags <- length(-lmax:lmax) lower.ci <- tanh(atanh(returns.cross.cor) - qnorm(0.975) / sqrt(matrix(trunc(n/2^(1:J)), nrow=lags, ncol=J, byrow=TRUE) - 3)) upper.ci <- tanh(atanh(returns.cross.cor) + qnorm(0.975) / sqrt(matrix(trunc(n/2^(1:J)), nrow=lags, ncol=J, byrow=TRUE) - 3)) par(mfrow=c(3,2), las=1, pty="m", mar=c(5,4,4,2)+.1) for(i in J:1) { plot(returns.cross.cor[,i], ylim=c(-1,1), xaxt="n", xlab="Lag (months)", ylab="", main=dimnames(returns.cross.cor)[[2]][i]) axis(side=1, at=seq(-36, 36, by=12)) lines(lower.ci[,i], lty=1, col=2) lines(upper.ci[,i], lty=1, col=2) abline(h=0,v=0) } } \author{B. Whitcher} \keyword{ts} waveslim/man/squared.gain.Rd0000644000176200001440000000375113430347452015537 0ustar liggesusers\name{squared.gain} \alias{squared.gain} \title{Squared Gain Function of a Filter} \description{ Produces the modulus squared of the Fourier transform for a given filtering sequence. } \usage{squared.gain(wf.name, filter.seq = "L", n = 512) } \arguments{ \item{wf.name}{Character string of wavelet filter.} \item{filter.seq}{Character string of filter sequence. \code{H} means high-pass filtering and \code{L} means low-pass filtering. Sequence is read from right to left.} \item{n}{Length of zero-padded filter. Frequency resolution will be \code{n}/2+1.} } \value{ Squared gain function. } \details{ Uses \code{cascade} subroutine to compute the squared gain function from a given filtering sequence. } %\references{} \seealso{ \code{\link{wave.filter}}, \code{\link{wavelet.filter}}. } \examples{ par(mfrow=c(2,2)) f.seq <- "H" plot(0:256/512, squared.gain("d4", f.seq), type="l", ylim=c(0,2), xlab="frequency", ylab="L = 4", main="Level 1") lines(0:256/512, squared.gain("fk4", f.seq), col=2) lines(0:256/512, squared.gain("mb4", f.seq), col=3) abline(v=c(1,2)/4, lty=2) legend(-.02, 2, c("Daubechies", "Fejer-Korovkin", "Minimum-Bandwidth"), lty=1, col=1:3, bty="n", cex=1) f.seq <- "HL" plot(0:256/512, squared.gain("d4", f.seq), type="l", ylim=c(0,4), xlab="frequency", ylab="", main="Level 2") lines(0:256/512, squared.gain("fk4", f.seq), col=2) lines(0:256/512, squared.gain("mb4", f.seq), col=3) abline(v=c(1,2)/8, lty=2) f.seq <- "H" plot(0:256/512, squared.gain("d8", f.seq), type="l", ylim=c(0,2), xlab="frequency", ylab="L = 8", main="") lines(0:256/512, squared.gain("fk8", f.seq), col=2) lines(0:256/512, squared.gain("mb8", f.seq), col=3) abline(v=c(1,2)/4, lty=2) f.seq <- "HL" plot(0:256/512, squared.gain("d8", f.seq), type="l", ylim=c(0,4), xlab="frequency", ylab="", main="") lines(0:256/512, squared.gain("fk8", f.seq), col=2) lines(0:256/512, squared.gain("mb8", f.seq), col=3) abline(v=c(1,2)/8, lty=2) } \author{B. Whitcher} \keyword{ts} waveslim/man/cpi.Rd0000644000176200001440000000063513430347452013727 0ustar liggesusers\name{cpi} \alias{cpi} \title{U.S. Consumer Price Index} \description{ Monthly U.S. consumer price index from 1948:1 to 1999:12. } \usage{data(cpi) } \format{A vector containing 624 observations. } \source{Unknown. } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. } \keyword{datasets} waveslim/man/hosking.sim.Rd0000644000176200001440000000275713430347452015414 0ustar liggesusers\name{hosking.sim} \alias{hosking.sim} \title{Generate Stationary Gaussian Process Using Hosking's Method} \description{ Uses exact time-domain method from Hosking (1984) to generate a simulated time series from a specified autocovariance sequence. } \usage{hosking.sim(n, acvs) } \arguments{ \item{n}{Length of series.} \item{acvs}{Autocovariance sequence of series with which to generate, must be of length at least \code{n}.} } \value{ Length \code{n} time series from true autocovariance sequence \code{acvs}. } %\details{} \references{ Hosking, J. R. M. (1984) Modeling persistence in hydrological time series using fractional differencing, \emph{Water Resources Research}, \bold{20}, No. 12, 1898-1908. Percival, D. B. (1992) Simulating Gaussian random processes with specified spectra, \emph{Computing Science and Statistics}, \bold{22}, 534-538. } %\seealso{} \examples{ dB <- function(x) 10 * log10(x) per <- function (z) { n <- length(z) (Mod(fft(z))^2/(2 * pi * n))[1:(n\%/\%2 + 1)] } spp.sdf <- function(freq, delta, omega) abs(2 * (cos(2*pi*freq) - cos(2*pi*omega)))^(-2*delta) data(acvs.andel8) n <- 1024 \dontrun{ z <- hosking.sim(n, acvs.andel8[,2]) per.z <- 2 * pi * per(z) par(mfrow=c(2,1), las=1) plot.ts(z, ylab="", main="Realization of a Seasonal Long-Memory Process") plot(0:(n/2)/n, dB(per.z), type="l", xlab="Frequency", ylab="dB", main="Periodogram") lines(0:(n/2)/n, dB(spp.sdf(0:(n/2)/n, .4, 1/12)), col=2) } } \author{Brandon Whitcher} \keyword{ts} waveslim/man/blocks.Rd0000644000176200001440000000066713430347452014436 0ustar liggesusers\name{blocks} \alias{blocks} \title{A Piecewise-Constant Function} \description{ \deqn{blocks(x) = \sum_{j=1}^{11}(1 + {\rm sign}(x-p_j)) h_j / 2}{% blocks(x) = sum[j=1,11] (1 + sign(x - p_j)) h_j/2} } \usage{data(blocks) } \format{A vector containing 512 observations. } \source{S+WAVELETS. } \references{ Bruce, A., and H.-Y. Gao (1996) \emph{Applied Wavelet Analysis with S-PLUS}, Springer: New York. } \keyword{datasets} waveslim/man/sine.taper.Rd0000644000176200001440000000115113430347452015216 0ustar liggesusers\name{sine.taper} \alias{sine.taper} \title{Computing Sinusoidal Data Tapers} \description{ Computes sinusoidal data tapers directly from equations. } \usage{sine.taper(n, k) } \arguments{ \item{n}{length of data taper(s)} \item{k}{number of data tapers} } \value{ A vector or matrix of data tapers (cols = tapers). } \details{ See reference. } \references{ Riedel, K. S. and A. Sidorenko (1995) Minimum bias multiple taper spectral estimation, \emph{IEEE Transactions on Signal Processing}, \bold{43}, 188-195. } \seealso{ \code{\link{dpss.taper}}. } %\examples{} \author{B. Whitcher} \keyword{ts} waveslim/man/phase.shift.hilbert.Rd0000644000176200001440000000200113430347452017005 0ustar liggesusers\name{phase.shift.hilbert} \alias{phase.shift.hilbert} \alias{phase.shift.hilbert.packet} \title{Phase Shift for Hilbert Wavelet Coefficients} \description{ Wavelet coefficients are circularly shifted by the amount of phase shift induced by the discrete Hilbert wavelet transform. } \usage{ phase.shift.hilbert(x, wf) phase.shift.hilbert.packet(x, wf) } \arguments{ \item{x}{Discete Hilbert wavelet transform (DHWT) object.} \item{wf}{character string; Hilbert wavelet pair used in DHWT} } \value{ DHWT (DHWPT) object with coefficients circularly shifted. } \details{ The "center-of-energy" argument of Hess-Nielsen and Wickerhauser (1996) is used to provide a flexible way to circularly shift wavelet coefficients regardless of the wavelet filter used. } \references{ Hess-Nielsen, N. and M. V. Wickerhauser (1996) Wavelets and time-frequency analysis, \emph{Proceedings of the IEEE}, \bold{84}, No. 4, 523-540. } \seealso{ \code{\link{phase.shift}} } %\examples{} \author{B. Whitcher} \keyword{ts} waveslim/man/dwpt.boot.Rd0000644000176200001440000000372313430347452015075 0ustar liggesusers\name{dwpt.boot} \alias{dwpt.boot} \title{Bootstrap Time Series Using the DWPT} \description{ An adaptive orthonormal basis is selected in order to perform the naive bootstrap within nodes of the wavelet packet tree. A bootstrap realization of the time series is produce by applying the inverse DWPT. } \usage{dwpt.boot(y, wf, J=log(length(y),2)-1, p=1e-04, frac=1) } \arguments{ \item{y}{Not necessarily dyadic length time series.} \item{wf}{Name of the wavelet filter to use in the decomposition. See \code{\link{wave.filter}} for those wavelet filters available.} \item{J}{Depth of the discrete wavelet packet transform.} \item{p}{Level of significance for the white noise testing procedure.} \item{frac}{Fraction of the time series that should be used in constructing the likelihood function.} } \value{ Time series of length $N$, where $N$ is the length of \code{y}. } \details{ A subroutines is used to select an adaptive orthonormal basis for the piecewise-constant approximation to the underlying spectral density function (SDF). Once selected, sampling with replacement is performed within each wavelet packet coefficient vector and the new collection of wavelet packet coefficients are reconstructed into a bootstrap realization of the original time series. } \references{ Percival, D.B., S. Sardy, A. Davision (2000) Wavestrapping Time Series: Adaptive Wavelet-Based Bootstrapping, in B.J. Fitzgerald, R.L. Smith, A.T. Walden, P.C. Young (Eds.) \emph{Nonlinear and Nonstationary Signal Processing}, pp. 442-471. Whitcher, B. (2001) Simulating Gaussian Stationary Time Series with Unbounded Spectra, \emph{Journal of Computational and Graphical Statistics}, \bold{10}, No. 1, 112-134. Whitcher, B. (2004) Wavelet-Based Estimation for Seasonal Long-Memory Processes, \emph{Technometrics}, \bold{46}, No. 2, 225-238. } \seealso{ \code{\link{dwpt.sim}}, \code{\link{spp.mle}} } %\examples{} \author{B. Whitcher} \keyword{ts} waveslim/man/stack.plot.Rd0000644000176200001440000000215413430347452015234 0ustar liggesusers\name{stackPlot} \alias{stackPlot} \title{Stack Plot} \description{ Stack plot of an object. This function attempts to mimic a function called \code{stack.plot} in S+WAVELETS. It is mostly a hacked version of \code{plot.ts} in \R. } \usage{stackPlot(x, plot.type = c("multiple", "single"), panel = lines, log = "", col = par("col"), bg = NA, pch = par("pch"), cex = par("cex"), lty = par("lty"), lwd = par("lwd"), ann = par("ann"), xlab = "Time", main = NULL, oma = c(6, 0, 5, 0), layout = NULL, same.scale = 1:dim(x)[2], ...) } \arguments{ \item{x}{\code{ts} object} \item{layout}{Doublet defining the dimension of the panel. If not specified, the dimensions are chosen automatically.} \item{same.scale}{Vector the same length as the number of series to be plotted. If not specified, all panels will have unique axes.} \item{plot.type,panel,log,col,bg,pch,cex,lty,lwd,ann,xlab,main,oma,...}{See \code{plot.ts}.} } %\value{} \details{ Produces a set of plots, one for each element (column) of \code{x}. } %\references{} %\seealso{} \author{Brandon Whitcher} %\examples{} \keyword{hplot} waveslim/man/nile.Rd0000644000176200001440000000177113430347452014105 0ustar liggesusers\name{nile} \alias{nile} \title{Nile River Minima} \description{ Yearly minimal water levels of the Nile river for the years 622 to 1281, measured at the Roda gauge near Cairo (Tousson, 1925, p. 366-385). The data are listed in chronological sequence by row. The original Nile river data supplied by Beran only contained only 500 observations (622 to 1121). However, the book claimed to have 660 observations (622 to 1281). The remaining observations from the book were added, by hand, but the series still only contained 653 observations (622 to 1264). Note, now the data consists of 663 observations (spanning the years 622-1284) as in original source (Toussoun, 1925). } \usage{data(nile) } \format{A length 663 vector. } \source{ Toussoun, O. (1925) M\'emoire sur l'Histoire du Nil, Volume 18 in \emph{M\'emoires a l'Institut d'Egypte}, pp. 366-404. } \references{ Beran, J. (1994) \emph{Statistics for Long-Memory Processes}, Chapman Hall: Englewood, NJ. } \keyword{datasets} waveslim/man/japan.Rd0000644000176200001440000000104713430347452014243 0ustar liggesusers\name{japan} \alias{japan} \title{Japanese Gross National Product} \description{ Quarterly Japanese gross national product from 1955:1 to 1996:4. } \usage{data(japan) } \format{A vector containing 169 observations. } \source{Unknown. } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. Hecq, A. (1998) Does seasonal adjustment induce common cycles?, \emph{Empirical Economics}, \bold{59}, 289-297. } \keyword{datasets} waveslim/man/dpss.taper.Rd0000644000176200001440000000452513430347452015241 0ustar liggesusers\name{dpss.taper} \alias{dpss.taper} \title{Calculating Thomson's Spectral Multitapers by Inverse Iteration} \description{ The following function links the subroutines in "bell-p-w.o" to an R function in order to compute discrete prolate spheroidal sequences (dpss). } \usage{dpss.taper(n, k, nw = 4, nmax = 2^(ceiling(log(n, 2)))) } \arguments{ \item{n}{length of data taper(s)} \item{k}{number of data tapers; 1, 2, 3, ... (do not use 0!)} \item{nw}{product of length and half-bandwidth parameter (w)} \item{nmax}{maximum possible taper length, necessary for FORTRAN code} } \value{ \item{v}{matrix of data tapers (cols = tapers)} \item{eigen}{eigenvalue associated with each data taper} \item{iter}{total number of iterations performed} \item{n}{same as input} \item{w}{half-bandwidth parameter} \item{ifault}{0 indicates success, see documentation for "bell-p-w" for information on non-zero values} } \details{ Spectral estimation using a set of orthogonal tapers is becoming widely used and appreciated in scientific research. It produces direct spectral estimates with more than 2 df at each Fourier frequency, resulting in spectral estimators with reduced variance. Computation of the orthogonal tapers from the basic defining equation is difficult, however, due to the instability of the calculations -- the eigenproblem is very poorly conditioned. In this article the severe numerical instability problems are illustrated and then a technique for stable calculation of the tapers -- namely, inverse iteration -- is described. Each iteration involves the solution of a matrix equation. Because the matrix has Toeplitz form, the Levinson recursions are used to rapidly solve the matrix equation. FORTRAN code for this method is available through the Statlib archive. An alternative stable method is also briefly reviewed. } \references{ B. Bell, D. B. Percival, and A. T. Walden (1993) Calculating Thomson's spectral multitapers by inverse iteration, \emph{Journal of Computational and Graphical Statistics}, \bold{2}, No. 1, 119-130. Percival, D. B. and A. T. Walden (1993) \emph{Spectral Estimation for Physical Applications: Multitaper and Conventional Univariate Techniques}, Cambridge University Press. } \seealso{ \code{\link{sine.taper}}. } %\examples{} \author{B. Whitcher} \keyword{ts} waveslim/man/mult.loc.Rd0000644000176200001440000000272013430347452014706 0ustar liggesusers\name{mult.loc} \alias{mult.loc} \title{Wavelet-based Testing and Locating for Variance Change Points} \description{ This is the major subroutine for \code{\link{testing.hov}}, providing the workhorse algorithm to recursively test and locate multiple variance changes in so-called long memory processes. } \usage{mult.loc(dwt.list, modwt.list, wf, level, min.coef, debug) } \arguments{ \item{dwt.list}{ List of wavelet vector coefficients from the \code{dwt}. } \item{modwt.list}{ List of wavelet vector coefficients from the \code{modwt}. } \item{wf}{ Name of the wavelet filter to use in the decomposition. } \item{level}{ Specifies the depth of the decomposition. } \item{min.coef}{ Minimum number of wavelet coefficients for testing purposes. } \item{debug}{ Boolean variable: if set to \code{TRUE}, actions taken by the algorithm are printed to the screen. } } \value{ Matrix. } \details{ For details see Section 9.6 of Percival and Walden (2000) or Section 7.3 in Gencay, Selcuk and Whitcher (2001). } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. } \seealso{ \code{\link{rotcumvar}}, \code{\link{testing.hov}}. } %\examples{} \author{B. Whitcher} \keyword{ts} waveslim/man/dwpt.Rd0000644000176200001440000000545413430347452014136 0ustar liggesusers\name{dwpt} \alias{dwpt} \alias{idwpt} \alias{modwpt} \title{(Inverse) Discrete Wavelet Packet Transforms} \description{ All possible filtering combinations (low- and high-pass) are performed to decompose a vector or time series. The resulting coefficients are associated with a binary tree structure corresponding to a partitioning of the frequency axis. } \usage{dwpt(x, wf="la8", n.levels=4, boundary="periodic") idwpt(y, y.basis) modwpt(x, wf = "la8", n.levels = 4, boundary = "periodic") } \arguments{ \item{x}{ a vector or time series containing the data be to decomposed. This must be a dyadic length vector (power of 2). } \item{wf}{ Name of the wavelet filter to use in the decomposition. By default this is set to \code{"la8"}, the Daubechies orthonormal compactly supported wavelet of length \eqn{L=8} (Daubechies, 1992), least asymmetric family. } \item{n.levels}{ Specifies the depth of the decomposition. This must be a number less than or equal to \eqn{\log(\mbox{length}(x),2)}{log2[length(x)]}. } \item{boundary}{ Character string specifying the boundary condition. If \code{boundary=="periodic"} the default, then the vector you decompose is assumed to be periodic on its defined interval,\cr if \code{boundary=="reflection"}, the vector beyond its boundaries is assumed to be a symmetric reflection of itself. } \item{y}{Object of S3 class \code{dwpt}.} \item{y.basis}{Vector of character strings that describe leaves on the DWPT basis tree.} } \value{ Basically, a list with the following components \item{w?.?}{Wavelet coefficient vectors. The first index is associated with the scale of the decomposition while the second is associated with the frequency partition within that level.} \item{wavelet}{Name of the wavelet filter used.} \item{boundary}{How the boundaries were handled.} } \details{ The code implements the one-dimensional DWPT using the pyramid algorithm (Mallat, 1989). } \references{ Mallat, S. G. (1989) A theory for multiresolution signal decomposition: the wavelet representation, \emph{IEEE Transactions on Pattern Analysis and Machine Intelligence}, \bold{11}, No. 7, 674-693. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. Wickerhauser, M. V. (1994) \emph{Adapted Wavelet Analysis from Theory to Software}, A K Peters. } \seealso{ \code{\link{dwt}}, \code{\link{modwpt}}, \code{\link{wave.filter}}. } \examples{ data(mexm) J <- 4 mexm.mra <- mra(log(mexm), "mb8", J, "modwt", "reflection") mexm.nomean <- ts( apply(matrix(unlist(mexm.mra), ncol=J+1, byrow=FALSE)[,-(J+1)], 1, sum), start=1957, freq=12) mexm.dwpt <- dwpt(mexm.nomean[-c(1:4)], "mb8", 7, "reflection") } \author{B. Whitcher} \keyword{ts} waveslim/man/wave.filter.Rd0000644000176200001440000000227713430347452015406 0ustar liggesusers\name{wave.filter} \alias{wave.filter} \title{Select a Wavelet Filter} \description{ Converts name of wavelet filter to filter coefficients. } \usage{wave.filter(name) } \arguments{ \item{name}{Character string of wavelet filter.} } \value{ List containing the following items: \item{L}{Length of the wavelet filter.} \item{hpf}{High-pass filter coefficients.} \item{lpf}{Low-pass filter coefficients.} } \details{ Simple \code{switch} statement selects the appropriate filter. } \references{ Daubechies, I. (1992) \emph{Ten Lectures on Wavelets}, CBMS-NSF Regional Conference Series in Applied Mathematics, SIAM: Philadelphia. Doroslovacki (1998) On the least asymmetric wavelets, \emph{IEEE Transactions for Signal Processing}, \bold{46}, No. 4, 1125-1130. Morris and Peravali (1999) Minimum-bandwidth discrete-time wavelets, \emph{Signal Processing}, \bold{76}, No. 2, 181-193. Nielsen, M. (2000) On the Construction and Frequency Localization of Orthogonal Quadrature Filters, \emph{Journal of Approximation Theory}, \bold{108}, No. 1, 36-52. } \seealso{ \code{\link{wavelet.filter}}, \code{\link{squared.gain}}. } %\examples{} \author{B. Whitcher} \keyword{ts} waveslim/man/brick.wall.Rd0000644000176200001440000000260713430347452015205 0ustar liggesusers\name{brick.wall} \alias{brick.wall} \alias{dwpt.brick.wall} \title{Replace Boundary Wavelet Coefficients with Missing Values} \description{ Sets the first \eqn{n} wavelet coefficients to \code{NA}. } \usage{brick.wall(x, wf, method="modwt") dwpt.brick.wall(x, wf, n.levels, method="modwpt") } \arguments{ \item{x}{DWT/MODWT/DWPT/MODWPT object} \item{wf}{Character string; name of wavelet filter} \item{method}{Either \code{\link{dwt}} or \code{\link{modwt}} for \code{brick.wall}, or either \code{\link{dwpt}} or \code{\link{modwpt}} for \code{dwpt.brick.wall}} \item{n.levels}{depth of the wavelet transform} } \value{ Same object as \code{x} only with some missing values. } \details{ The fact that observed time series are finite causes boundary issues. One way to get around this is to simply remove any wavelet coefficient computed involving the boundary. This is done here by replacing boundary wavelet coefficients with \code{NA}. } \references{ Lindsay, R. W., D. B. Percival and D. A. Rothrock (1996). The discrete wavelet transform and the scale anlaysis of the surface properties of sea ice, \emph{IEEE Transactions on Geoscience and Remote Sensing}, \bold{34}, No.~3, 771-787. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. } %\seealso{} %\examples{} \author{B. Whitcher} \keyword{ts} waveslim/man/barbara.Rd0000644000176200001440000000044713430347452014547 0ustar liggesusers\name{barbara} \alias{barbara} \title{Barbara Test Image} \description{ The Barbara image comes from Allen Gersho's lab at the University of California, Santa Barbara. } \usage{data(barbara) } \format{A 256 \eqn{\times}{x} 256 matrix. } \source{Internet. } %\references{} \keyword{datasets} waveslim/man/wave.variance.Rd0000644000176200001440000000725413430347452015711 0ustar liggesusers\name{wave.variance} \alias{wave.variance} \alias{wave.covariance} \alias{wave.correlation} \title{Wavelet Analysis of Univariate/Bivariate Time Series} \description{ Produces an estimate of the multiscale variance, covariance or correlation along with approximate confidence intervals. } \usage{wave.variance(x, type="eta3", p=0.025) wave.covariance(x, y) wave.correlation(x, y, N, p=0.975) } \arguments{ \item{x}{first time series} \item{y}{second time series} \item{type}{character string describing confidence interval calculation; valid methods are \code{gaussian}, \code{eta1}, \code{eta2}, \code{eta3}, \code{nongaussian}} \item{p}{(one minus the) two-sided p-value for the confidence interval} \item{N}{length of time series} } \value{ Matrix with as many rows as levels in the wavelet transform object. The first column provides the point estimate for the wavelet variance, covariance, or correlation followed by the lower and upper bounds from the confidence interval. } \details{ The time-independent wavelet variance is basically the average of the squared wavelet coefficients across each scale. As shown in Percival (1995), the wavelet variance is a scale-by-scale decomposition of the variance for a stationary process, and certain non-stationary processes. } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. Percival, D. B. (1995) \emph{Biometrika}, \bold{82}, No. 3, 619-631. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. Whitcher, B., P. Guttorp and D. B. Percival (2000) Wavelet Analysis of Covariance with Application to Atmospheric Time Series, \emph{Journal of Geophysical Research}, \bold{105}, No. D11, 14,941-14,962. } %\seealso{} \examples{ ## Figure 7.3 from Gencay, Selcuk and Whitcher (2001) data(ar1) ar1.modwt <- modwt(ar1, "haar", 6) ar1.modwt.bw <- brick.wall(ar1.modwt, "haar") ar1.modwt.var2 <- wave.variance(ar1.modwt.bw, type="gaussian") ar1.modwt.var <- wave.variance(ar1.modwt.bw, type="nongaussian") par(mfrow=c(1,1), las=1, mar=c(5,4,4,2)+.1) matplot(2^(0:5), ar1.modwt.var2[-7,], type="b", log="xy", xaxt="n", ylim=c(.025, 6), pch="*LU", lty=1, col=c(1,4,4), xlab="Wavelet Scale", ylab="") matlines(2^(0:5), as.matrix(ar1.modwt.var)[-7,2:3], type="b", pch="LU", lty=1, col=3) axis(side=1, at=2^(0:5)) legend(1, 6, c("Wavelet variance", "Gaussian CI", "Non-Gaussian CI"), lty=1, col=c(1,4,3), bty="n") ## Figure 7.8 from Gencay, Selcuk and Whitcher (2001) data(exchange) returns <- diff(log(as.matrix(exchange))) returns <- ts(returns, start=1970, freq=12) wf <- "d4" J <- 6 demusd.modwt <- modwt(returns[,"DEM.USD"], wf, J) demusd.modwt.bw <- brick.wall(demusd.modwt, wf) jpyusd.modwt <- modwt(returns[,"JPY.USD"], wf, J) jpyusd.modwt.bw <- brick.wall(jpyusd.modwt, wf) returns.modwt.cov <- wave.covariance(demusd.modwt.bw, jpyusd.modwt.bw) par(mfrow=c(1,1), las=0, mar=c(5,4,4,2)+.1) matplot(2^(0:(J-1)), returns.modwt.cov[-(J+1),], type="b", log="x", pch="*LU", xaxt="n", lty=1, col=c(1,4,4), xlab="Wavelet Scale", ylab="Wavelet Covariance") axis(side=1, at=2^(0:7)) abline(h=0) returns.modwt.cor <- wave.correlation(demusd.modwt.bw, jpyusd.modwt.bw, N = dim(returns)[1]) par(mfrow=c(1,1), las=0, mar=c(5,4,4,2)+.1) matplot(2^(0:(J-1)), returns.modwt.cor[-(J+1),], type="b", log="x", pch="*LU", xaxt="n", lty=1, col=c(1,4,4), xlab="Wavelet Scale", ylab="Wavelet Correlation") axis(side=1, at=2^(0:7)) abline(h=0) } \author{B. Whitcher} \keyword{ts} waveslim/man/denoise.dwt.2d.Rd0000644000176200001440000000460513430347452015704 0ustar liggesusers\name{denoise.2d} \alias{denoise.dwt.2d} \alias{denoise.modwt.2d} \title{Denoise an Image via the 2D Discrete Wavelet Transform} \description{ Perform simple de-noising of an image using the two-dimensional discrete wavelet transform. } \usage{ denoise.dwt.2d(x, wf = "la8", J = 4, method = "universal", H = 0.5, noise.dir = 3, rule = "hard") denoise.modwt.2d(x, wf = "la8", J = 4, method = "universal", H = 0.5, rule = "hard") } \arguments{ \item{x}{input matrix (image)} \item{wf}{name of the wavelet filter to use in the decomposition} \item{J}{depth of the decomposition, must be a number less than or equal to \eqn{\log_2(\min\{M,N\})}{log(min{M,N},2)}} \item{method}{character string describing the threshold applied, only \code{"universal"} and \code{"long-memory"} are currently implemented} \item{H}{self-similarity or Hurst parameter to indicate spectral scaling, white noise is 0.5} \item{noise.dir}{number of directions to estimate background noise standard deviation, the default is 3 which produces a unique estimate of the background noise for each spatial direction} \item{rule}{either a \code{"hard"} or \code{"soft"} thresholding rule may be used} } \value{ Image of the same dimension as the original but with high-freqency fluctuations removed. } \details{ See \code{\link{Thresholding}}. } \references{ See \code{\link{Thresholding}} for references concerning de-noising in one dimension. } \seealso{\code{\link{Thresholding}}} \examples{ ## Xbox image data(xbox) n <- NROW(xbox) xbox.noise <- xbox + matrix(rnorm(n*n, sd=.15), n, n) par(mfrow=c(2,2), cex=.8, pty="s") image(xbox.noise, col=rainbow(128), main="Original Image") image(denoise.dwt.2d(xbox.noise, wf="haar"), col=rainbow(128), zlim=range(xbox.noise), main="Denoised image") image(xbox.noise - denoise.dwt.2d(xbox.noise, wf="haar"), col=rainbow(128), zlim=range(xbox.noise), main="Residual image") ## Daubechies image data(dau) n <- NROW(dau) dau.noise <- dau + matrix(rnorm(n*n, sd=10), n, n) par(mfrow=c(2,2), cex=.8, pty="s") image(dau.noise, col=rainbow(128), main="Original Image") dau.denoise <- denoise.modwt.2d(dau.noise, wf="d4", rule="soft") image(dau.denoise, col=rainbow(128), zlim=range(dau.noise), main="Denoised image") image(dau.noise - dau.denoise, col=rainbow(128), main="Residual image") } \author{B. Whitcher} \keyword{ts} waveslim/man/cplxdual.Rd0000644000176200001440000000300513621324402014752 0ustar liggesusers\name{Dualtree Complex} \alias{cplxdual2D} \alias{icplxdual2D} \title{Dual-tree Complex 2D Discrete Wavelet Transform} \description{ Dual-tree complex 2D discrete wavelet transform (DWT). } \usage{ cplxdual2D(x, J, Faf, af) icplxdual2D(w, J, Fsf, sf) } \arguments{ \item{x}{2D array.} \item{w}{wavelet coefficients.} \item{J}{number of stages.} \item{Faf}{first stage analysis filters for tree \eqn{i}.} \item{af}{analysis filters for the remaining stages on tree \eqn{i}.} \item{Fsf}{last stage synthesis filters for tree \eqn{i}.} \item{sf}{synthesis filters for the preceeding stages.} } %\details{} \value{ For the analysis of \code{x}, the output is \item{w}{wavelet coefficients indexed by \code{[[j]][[i]][[d1]][[d2]]}, where \eqn{j=1,\ldots,J} (scale), \eqn{i=1} (real part) or \eqn{i=2} (imag part), \eqn{d1=1,2} and \eqn{d2=1,2,3} (orientations).} For the synthesis of \code{w}, the output is \item{y}{output signal.} } \references{ WAVELET SOFTWARE AT POLYTECHNIC UNIVERSITY, BROOKLYN, NY\cr \url{http://eeweb.poly.edu/iselesni/WaveletSoftware/} } \seealso{ \code{\link{FSfarras}}, \code{\link{farras}}, \code{\link{afb2D}}, \code{\link{sfb2D}}. } \examples{ \dontrun{ ## EXAMPLE: cplxdual2D x = matrix(rnorm(32*32), 32, 32) J = 5 Faf = FSfarras()$af Fsf = FSfarras()$sf af = dualfilt1()$af sf = dualfilt1()$sf w = cplxdual2D(x, J, Faf, af) y = icplxdual2D(w, J, Fsf, sf) err = x - y max(abs(err)) } } \author{Matlab: S. Cai, K. Li and I. Selesnick; R port: B. Whitcher} \keyword{ts} waveslim/man/doppler.Rd0000644000176200001440000000072313430347452014617 0ustar liggesusers\name{doppler} \alias{doppler} \title{Sinusoid with Changing Amplitude and Frequency} \description{ \deqn{doppler(x) = \sqrt{x(1 - x)} \sin\left(\frac{2.1\pi}{x+0.05}\right)}{% doppler(x) = sqrt{x(1-x)} sin[(2.1*pi)/(x+0.05)]} } \usage{data(doppler) } \format{A vector containing 512 observations. } \source{S+WAVELETS. } \references{ Bruce, A., and H.-Y. Gao (1996) \emph{Applied Wavelet Analysis with S-PLUS}, Springer: New York. } \keyword{datasets} waveslim/man/linchirp.Rd0000644000176200001440000000060113430347452014755 0ustar liggesusers\name{linchirp} \alias{linchirp} \title{Linear Chirp} \description{ \deqn{linchirp(x) = \sin(0.125 \pi n x^2)}{% linchirp(x) = sin(0.125*pi*n*x^2)} } \usage{data(linchirp) } \format{A vector containing 512 observations. } \source{S+WAVELETS. } \references{ Bruce, A., and H.-Y. Gao (1996) \emph{Applied Wavelet Analysis with S-PLUS}, Springer: New York. } \keyword{datasets} waveslim/man/Dualtree.Rd0000644000176200001440000000505213621324307014713 0ustar liggesusers\name{Dualtree} \alias{dualtree} \alias{idualtree} \alias{dualtree2D} \alias{idualtree2D} \title{Dual-tree Complex Discrete Wavelet Transform} \description{ One- and two-dimensional dual-tree complex discrete wavelet transforms developed by Kingsbury and Selesnick \emph{et al.} } \usage{ dualtree(x, J, Faf, af) idualtree(w, J, Fsf, sf) dualtree2D(x, J, Faf, af) idualtree2D(w, J, Fsf, sf) } \arguments{ \item{x}{\eqn{N}-point vector or \eqn{M{\times}N}{MxN} matrix.} \item{w}{DWT coefficients.} \item{J}{number of stages.} \item{Faf}{analysis filters for the first stage.} \item{af}{analysis filters for the remaining stages.} \item{Fsf}{synthesis filters for the last stage.} \item{sf}{synthesis filters for the preceeding stages.} } \value{ For the analysis of \code{x}, the output is \item{w}{DWT coefficients. Each wavelet scale is a list containing the real and imaginary parts. The final scale (\eqn{J+1}) contains the low-pass filter coefficients.} For the synthesis of \code{w}, the output is \item{y}{output signal} } \details{ In one dimension \eqn{N} is divisible by \eqn{2^J} and \eqn{N\ge2^{J-1}\cdot\mbox{length}(\mbox{\code{af}})}. In two dimensions, these two conditions must hold for both \eqn{M} and \eqn{N}. } \references{ WAVELET SOFTWARE AT POLYTECHNIC UNIVERSITY, BROOKLYN, NY\cr \url{http://eeweb.poly.edu/iselesni/WaveletSoftware/} } \seealso{ \code{\link{FSfarras}}, \code{\link{farras}}, \code{\link{convolve}}, \code{\link{cshift}}, \code{\link{afb}}, \code{\link{sfb}}. } \examples{ ## EXAMPLE: dualtree x = rnorm(512) J = 4 Faf = FSfarras()$af Fsf = FSfarras()$sf af = dualfilt1()$af sf = dualfilt1()$sf w = dualtree(x, J, Faf, af) y = idualtree(w, J, Fsf, sf) err = x - y max(abs(err)) ## Example: dualtree2D x = matrix(rnorm(64*64), 64, 64) J = 3 Faf = FSfarras()$af Fsf = FSfarras()$sf af = dualfilt1()$af sf = dualfilt1()$sf w = dualtree2D(x, J, Faf, af) y = idualtree2D(w, J, Fsf, sf) err = x - y max(abs(err)) ## Display 2D wavelets of dualtree2D.m J <- 4 L <- 3 * 2^(J+1) N <- L / 2^J Faf <- FSfarras()$af Fsf <- FSfarras()$sf af <- dualfilt1()$af sf <- dualfilt1()$sf x <- matrix(0, 2*L, 3*L) w <- dualtree2D(x, J, Faf, af) w[[J]][[1]][[1]][N/2, N/2+0*N] <- 1 w[[J]][[1]][[2]][N/2, N/2+1*N] <- 1 w[[J]][[1]][[3]][N/2, N/2+2*N] <- 1 w[[J]][[2]][[1]][N/2+N, N/2+0*N] <- 1 w[[J]][[2]][[2]][N/2+N, N/2+1*N] <- 1 w[[J]][[2]][[3]][N/2+N, N/2+2*N] <- 1 y <- idualtree2D(w, J, Fsf, sf) image(t(y), col=grey(0:64/64), axes=FALSE) } \author{Matlab: S. Cai, K. Li and I. Selesnick; R port: B. Whitcher} \keyword{ts} waveslim/man/spp.var.Rd0000644000176200001440000000175313430347452014547 0ustar liggesusers\name{spp.var} \alias{spp.var} \alias{Hypergeometric} \title{Variance of a Seasonal Persistent Process} \description{ Computes the variance of a seasonal persistent (SP) process using a hypergeometric series expansion. } \usage{ spp.var(d, fG, sigma2 = 1) Hypergeometric(a, b, c, z) } \arguments{ \item{d}{Fractional difference parameter.} \item{fG}{Gegenbauer frequency.} \item{sigma2}{Innovations variance.} \item{a,b,c,z}{Parameters for the hypergeometric series.} } \value{ The variance of an SP process. } \details{ See Lapsa (1997). The subroutine to compute a hypergeometric series was taken from \emph{Numerical Recipes in C}. } \references{ Lapsa, P.M. (1997) Determination of Gegenbauer-type random process models. \emph{Signal Processing} \bold{63}, 73-90. Press, W.H., S.A. Teukolsky, W.T. Vetterling and B.P. Flannery (1992) \emph{Numerical Recipes in C}, 2nd edition, Cambridge University Press. } %\seealso{} %\examples{} \author{B. Whitcher} \keyword{ts} waveslim/man/xbox.Rd0000644000176200001440000000101113430347452014121 0ustar liggesusers\name{xbox} \alias{xbox} \title{Image with Box and X} \description{ \deqn{xbox(i,j) = I_{[i=n/4,\;3n/4,\;j;~ n/4 \leq j \leq 3n/4]} + I_{[n/4 \leq i \leq 3n/4;~ j=n/4,\;3n/4,\;i]}}{% xbox(i,j) = I_[i = n/4, 3n/4, j; n/4 \leq j \leq 3n/4] + I_[n/4 \leq i \leq 3n/4; j = n/4, 3n/4, i]} } \usage{data(xbox) } \format{A 128 \eqn{\times}{x} 128 matrix. } \source{S+WAVELETS. } \references{ Bruce, A., and H.-Y. Gao (1996) \emph{Applied Wavelet Analysis with S-PLUS}, Springer: New York. } \keyword{datasets} waveslim/DESCRIPTION0000644000176200001440000000203413632657122013615 0ustar liggesusersPackage: waveslim Version: 1.8.2 Date: 2020-02-13 Title: Basic Wavelet Routines for One-, Two-, and Three-Dimensional Signal Processing Author: Brandon Whitcher Maintainer: Brandon Whitcher Depends: R (>= 2.11.0), graphics, grDevices, stats, utils Suggests: fftw, covr Description: Basic wavelet routines for time series (1D), image (2D) and array (3D) analysis. The code provided here is based on wavelet methodology developed in Percival and Walden (2000); Gencay, Selcuk and Whitcher (2001); the dual-tree complex wavelet transform (DTCWT) from Kingsbury (1999, 2001) as implemented by Selesnick; and Hilbert wavelet pairs (Selesnick 2001, 2002). All figures in chapters 4-7 of GSW (2001) are reproducible using this package and R code available at the book website(s) below. License: BSD_3_clause + file LICENSE URL: http://waveslim.blogspot.com biocViews: RoxygenNote: 7.0.2 NeedsCompilation: yes Packaged: 2020-02-13 20:03:03 UTC; brandon Repository: CRAN Date/Publication: 2020-03-13 10:20:02 UTC waveslim/src/0000755000176200001440000000000013621325567012702 5ustar liggesuserswaveslim/src/dwt.c0000644000176200001440000000722413430347452013644 0ustar liggesusers#include #include #include #include /*************************************************************************/ void dwt(double *Vin, int *M, int *L, double *h, double *g, double *Wout, double *Vout) { int n, t, u; for(t = 0; t < *M/2; t++) { u = 2 * t + 1; Wout[t] = h[0] * Vin[u]; Vout[t] = g[0] * Vin[u]; for(n = 1; n < *L; n++) { u -= 1; if(u < 0) u = *M - 1; Wout[t] += h[n] * Vin[u]; Vout[t] += g[n] * Vin[u]; } } } /*************************************************************************/ void idwt(double *Win, double *Vin, int *M, int *L, double *h, double *g, double *Xout) { int i, j, l, t, u; int m = -2, n = -1; for(t = 0; t < *M; t++) { m += 2; n += 2; u = t; i = 1; j = 0; Xout[m] = h[i] * Win[u] + g[i] * Vin[u]; Xout[n] = h[j] * Win[u] + g[j] * Vin[u]; if(*L > 2) { for(l = 1; l < *L/2; l++) { u += 1; if(u >= *M) u = 0; i += 2; j += 2; Xout[m] += h[i] * Win[u] + g[i] * Vin[u]; Xout[n] += h[j] * Win[u] + g[j] * Vin[u]; } } } } /*************************************************************************/ void modwt(double *Vin, int *N, int *j, int *L, double *ht, double *gt, double *Wout, double *Vout) { int k, n, t; for(t = 0; t < *N; t++) { k = t; Wout[t] = ht[0] * Vin[k]; Vout[t] = gt[0] * Vin[k]; for(n = 1; n < *L; n++) { k -= (int) pow(2.0, (double) *j - 1.0); if(k < 0) k += *N; Wout[t] += ht[n] * Vin[k]; Vout[t] += gt[n] * Vin[k]; } } } /*************************************************************************/ void imodwt(double *Win, double *Vin, int *N, int *j, int *L, double *ht, double *gt, double *Vout) { int k, n, t; for(t = 0; t < *N; t++) { k = t; Vout[t] = (ht[0] * Win[k]) + (gt[0] * Vin[k]); for(n = 1; n < *L; n++) { k += (int) pow(2.0, (double) *j - 1.0); if(k >= *N) k -= *N; Vout[t] += (ht[n] * Win[k]) + (gt[n] * Vin[k]); } } } /*************************************************************************** *************************************************************************** This DWT algorithm is shifted to the left by one in order to match with the interval boundary conditions. *************************************************************************** ***************************************************************************/ void dwt_shift(double *Vin, int *M, int *L, double *h, double *g, double *Wout, double *Vout) { int n, t, u; for(t = 0; t < *M/2; t++) { /* u = 2 * t + 1; */ u = 2 * t + 2; Wout[t] = h[0] * Vin[u]; Vout[t] = g[0] * Vin[u]; for(n = 1; n < *L; n++) { u -= 1; if(u < 0) u = *M - 1; Wout[t] += h[n] * Vin[u]; Vout[t] += g[n] * Vin[u]; } } } /*************************************************************************** *************************************************************************** shifted iDWT *************************************************************************** ***************************************************************************/ void idwt_shift(double *Win, double *Vin, int M, int L, double *h, double *g, double *Xout) { int i, j, l, t, u; int m = -2, n = -1; for(t = 0; t < M; t++) { m += 2; n += 2; u = t; i = 1; j = 0; Xout[m] = h[i] * Win[u] + g[i] * Vin[u]; Xout[n] = h[j] * Win[u] + g[j] * Vin[u]; if(L > 2) { for(l = 1; l < L/2; l++) { u += 1; if(u >= M) u = 0; i += 2; j += 2; Xout[m] += h[i] * Win[u] + g[i] * Vin[u]; Xout[n] += h[j] * Win[u] + g[j] * Vin[u]; } } } } waveslim/src/init.c0000644000176200001440000000531313430347452014006 0ustar liggesusers#include #include // for NULL #include /* FIXME: Check these declarations against the C/Fortran source code. */ /* .C calls */ extern void dwt(void *, void *, void *, void *, void *, void *, void *); extern void hosking(void *, void *, void *); extern void idwt(void *, void *, void *, void *, void *, void *, void *); extern void imodwt(void *, void *, void *, void *, void *, void *, void *, void *); extern void modwt(void *, void *, void *, void *, void *, void *, void *, void *); extern void three_D_dwt(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void three_D_idwt(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void three_D_imodwt(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void three_D_modwt(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void two_D_dwt(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void two_D_idwt(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void two_D_imodwt(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void two_D_modwt(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); /* .Fortran calls */ extern void F77_NAME(dpss)(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); static const R_CMethodDef CEntries[] = { {"dwt", (DL_FUNC) &dwt, 7}, {"hosking", (DL_FUNC) &hosking, 3}, {"idwt", (DL_FUNC) &idwt, 7}, {"imodwt", (DL_FUNC) &imodwt, 8}, {"modwt", (DL_FUNC) &modwt, 8}, {"three_D_dwt", (DL_FUNC) &three_D_dwt, 15}, {"three_D_idwt", (DL_FUNC) &three_D_idwt, 15}, {"three_D_imodwt", (DL_FUNC) &three_D_imodwt, 16}, {"three_D_modwt", (DL_FUNC) &three_D_modwt, 16}, {"two_D_dwt", (DL_FUNC) &two_D_dwt, 10}, {"two_D_idwt", (DL_FUNC) &two_D_idwt, 10}, {"two_D_imodwt", (DL_FUNC) &two_D_imodwt, 11}, {"two_D_modwt", (DL_FUNC) &two_D_modwt, 11}, {NULL, NULL, 0} }; static const R_FortranMethodDef FortranEntries[] = { {"dpss", (DL_FUNC) &F77_NAME(dpss), 12}, {NULL, NULL, 0} }; void R_init_waveslim(DllInfo *dll) { R_registerRoutines(dll, CEntries, NULL, FortranEntries, NULL); R_useDynamicSymbols(dll, FALSE); } waveslim/src/dwt3.c0000644000176200001440000005657213430347452013741 0ustar liggesusers#include #include #include #include #include "dwt.h" /*************************************************************************** *************************************************************************** 3D DWT *************************************************************************** ***************************************************************************/ void three_D_dwt(double *X, int *NX, int *NY, int *NZ, int *L, double *h, double *g, double *LLL, double *HLL, double *LHL, double *LLH, double *HHL, double *HLH, double *LHH, double *HHH) { int i, j, k, l, index; /* int printall = 0; */ double *data, *Wout, *Vout, *Xl, *Xh, *Yll, *Ylh, *Yhl, *Yhh; /* printf("Original Data (N = %d)...\n", *NX * (*NY) * (*NZ)); printdvec(X, *NX * (*NY) * (*NZ)); */ /* * Perform one-dimensional DWT on first dimension (length NX). */ Wout = (double *) malloc((*NX) * sizeof(double)); Vout = (double *) malloc((*NX) * sizeof(double)); data = (double *) malloc((*NX) * sizeof(double)); /* * Create temporary "hyperrectangles" to store DWT of X-dimension. */ Xl = (double *) malloc((*NZ*(*NY)*(*NX/2)) * sizeof(double)); Xh = (double *) malloc((*NZ*(*NY)*(*NX/2)) * sizeof(double)); for(i = 0; i < *NZ*(*NY); i++) { /* * Must take column from X-dimension and place into vector for DWT. */ for(j = 0; j < *NX; j++) { index = i * (*NX) + j; data[j] = X[index]; /* printf("X[%d][%d] = %f\n", i, j, X[index]); */ } /* * Perform DWT and read into temporary matrices. */ dwt(data, NX, L, h, g, Wout, Vout); for(j = 0; j < (int) *NX/2; j++) { index = i * (*NX/2) + j; Xl[index] = Vout[j]; Xh[index] = Wout[j]; /* printf("Low[%d][%d] = %f\n", i, j, Low[index]); printf("High[%d][%d] = %f\n", i, j, High[index]); */ } } free(Wout); free(Vout); free(data); /* printf("X Low...\n"); printdvec(Xl, (*NX/2) * (*NY) * (*NZ)); printf("X High...\n"); printdvec(Xh, (*NX/2) * (*NY) * (*NZ)); */ /* * Perform one-dimensional DWT on second dimension (length NY). */ Wout = (double *) malloc((*NY) * sizeof(double)); Vout = (double *) malloc((*NY) * sizeof(double)); data = (double *) malloc((*NY) * sizeof(double)); /* * Create temporary "hyperrectangles" to store DWT of X-dimension. */ Yll = (double *) malloc((*NZ*(*NY/2)*(*NX/2)) * sizeof(double)); Ylh = (double *) malloc((*NZ*(*NY/2)*(*NX/2)) * sizeof(double)); Yhl = (double *) malloc((*NZ*(*NY/2)*(*NX/2)) * sizeof(double)); Yhh = (double *) malloc((*NZ*(*NY/2)*(*NX/2)) * sizeof(double)); k = 0; l = 0; for(i = 0; i < *NZ * (int) *NX/2; i++) { /* * Must adjust for 3D array structure. * k: vertical dimension (Z) adjustment when reading in data * l: vertical dimension (Z) adjustment when writing wavelet coeffs. */ if(i > 0 && fmod(i, (int) *NX/2) == 0.0) { k = k + (*NY - 1) * ((int) *NX/2); l = l + ((int) *NY/2 - 1) * ((int) *NX/2); } /* printf("fmod(%d, %d) = %f\n", i, (int) *NX/2, fmod(i, (int) *NX/2)); printf("i = %d\tk = %d\tl = %d\n", i, k, l); */ /* * Must take row from "Xl" and place into vector for DWT. */ for(j = 0; j < *NY; j++) { index = i + j * ((int) *NX/2) + k; data[j] = Xl[index]; } /* * Perform DWT and read into temporary "Yll" and "Yhl" hyperrectangles. */ dwt(data, NY, L, h, g, Wout, Vout); for(j = 0; j < (int) *NY/2; j++) { index = i + j * ((int) *NX/2) + l; Yll[index] = Vout[j]; Ylh[index] = Wout[j]; /* if(printall == 1) printf("Y.LL[%d][%d] = %f\nY.HL[%d][%d] = %f\n", i, j, Yll[index], i, j, Ylh[index]); */ } /* * Must take row from "Xh" and place into vector for DWT. */ for(j = 0; j < *NY; j++) { index = i + j * ((int) *NX/2) + k; data[j] = Xh[index]; } /* * Perform DWT and read into temporary "Yhl" and "Yhh" hyperrectangles. */ dwt(data, NY, L, h, g, Wout, Vout); for(j = 0; j < (int) *NY/2; j++) { index = i + j * ((int) *NX/2) + l; Yhl[index] = Vout[j]; Yhh[index] = Wout[j]; /* if(printall == 1) printf("Y.LH[%d][%d] = %f\nY.HH[%d][%d] = %f\n", i, j, Yhl[index], i, j, Yhh[index]); */ } } free(Wout); free(Vout); free(data); free(Xl); free(Xh); /* printf("Y Low-Low...\n"); printdvec(Yll, (*NX/2) * (*NY/2) * (*NZ)); printf("Y High-Low...\n"); printdvec(Yhl, (*NX/2) * (*NY/2) * (*NZ)); printf("Y Low-High...\n"); printdvec(Ylh, (*NX/2) * (*NY/2) * (*NZ)); printf("Y High-High...\n"); printdvec(Yhh, (*NX/2) * (*NY/2) * (*NZ)); */ /* * Perform one-dimensional DWT on third dimension (length NZ). */ Wout = (double *) malloc((*NZ) * sizeof(double)); Vout = (double *) malloc((*NZ) * sizeof(double)); data = (double *) malloc((*NZ) * sizeof(double)); for(i = 0; i < (int) *NY/2 * (int) *NX/2; i++) { /* * Must take vertical column from "Yll" and place into vector for DWT. */ for(j = 0; j < *NZ; j++) { index = i + j * ((int) *NY/2 * (int) *NX/2); data[j] = Yll[index]; } /* * Perform DWT and read into final "LLL" and "LLH" hyperrectangles. */ dwt(data, NZ, L, h, g, Wout, Vout); for(j = 0; j < (int) *NZ/2; j++) { index = i + j * ((int) *NY/2 * (int) *NX/2); LLL[index] = Vout[j]; LLH[index] = Wout[j]; /* if(printall == 1) printf("LLL[%d][%d] = %f\nLLH[%d][%d] = %f\n", i, j, LLL[index], i, j, LLH[index]); */ } /* * Must take row from "Yhl" and place into vector for DWT. */ for(j = 0; j < *NZ; j++) { index = i + j * ((int) *NY/2 * (int) *NX/2); data[j] = Yhl[index]; } /* * Perform DWT and read into final "HLL" and "HLH" hyperrectangles. */ dwt(data, NZ, L, h, g, Wout, Vout); for(j = 0; j < (int) *NZ/2; j++) { index = i + j * ((int) *NY/2 * (int) *NX/2); HLL[index] = Vout[j]; HLH[index] = Wout[j]; /* printf("HLL[%d][%d] = %f\n", i, j, HLL[index]); printf("HLH[%d][%d] = %f\n", i, j, HLH[index]); */ } /* * Must take row from "Ylh" and place into vector for DWT. */ for(j = 0; j < *NZ; j++) { index = i + j * ((int) *NY/2 * (int) *NX/2); data[j] = Ylh[index]; } /* * Perform DWT and read into final "LHL" and "LHH" hyperrectangles. */ dwt(data, NZ, L, h, g, Wout, Vout); for(j = 0; j < (int) *NZ/2; j++) { index = i + j * ((int) *NY/2 * (int) *NX/2); LHL[index] = Vout[j]; LHH[index] = Wout[j]; /* printf("LHH[%d][%d] = %f\n", i, j, LHH[index]); printf("LHL[%d][%d] = %f\n", i, j, LHL[index]); */ } /* * Must take row from "Yhh" and place into vector for DWT. */ for(j = 0; j < *NZ; j++) { index = i + j * ((int) *NY/2 * (int) *NX/2); data[j] = Yhh[index]; } /* * Perform DWT and read into final "HHL" and "HHH" hyperrectangles. */ dwt(data, NZ, L, h, g, Wout, Vout); for(j = 0; j < (int) *NZ/2; j++) { index = i + j * ((int) *NY/2 * (int) *NX/2); HHL[index] = Vout[j]; HHH[index] = Wout[j]; /* printf("HHH[%d][%d] = %f\n", i, j, HHH[index]); printf("HHL[%d][%d] = %f\n", i, j, HHL[index]); */ } } free(Wout); free(Vout); free(data); free(Yll); free(Ylh); free(Yhl); free(Yhh); } /*************************************************************************** *************************************************************************** 3D iDWT *************************************************************************** ***************************************************************************/ void three_D_idwt(double *LLL, double *HLL, double *LHL, double *LLH, double *HHL, double *HLH, double *LHH, double *HHH, int *NX, int *NY, int *NZ, int *L, double *h, double *g, double *image) { int i, j, k, l; /* int printall = 0; */ double *Win, *Vin, *Xl, *Xh, *Yll, *Ylh, *Yhl, *Yhh, *Xout; /* * Create temporary "hyperrectangles" to store iDWT of Z-dimension. */ Yll = (double *) malloc((2*(*NZ)*(*NY)*(*NX)) * sizeof(double)); Ylh = (double *) malloc((2*(*NZ)*(*NY)*(*NX)) * sizeof(double)); Yhl = (double *) malloc((2*(*NZ)*(*NY)*(*NX)) * sizeof(double)); Yhh = (double *) malloc((2*(*NZ)*(*NY)*(*NX)) * sizeof(double)); Win = (double *) malloc((*NZ) * sizeof(double)); Vin = (double *) malloc((*NZ) * sizeof(double)); Xout = (double *) malloc(2*(*NZ) * sizeof(double)); for(i = 0; i < *NY * (*NX); i++) { /* * Must take row from LLL and LLH and place into vectors for iDWT. */ for(j = 0; j < *NZ; j++) { Win[j] = LLH[i + j * (*NY) * (*NX)]; Vin[j] = LLL[i + j * (*NY) * (*NX)]; } idwt(Win, Vin, NZ, L, h, g, Xout); for(j = 0; j < 2 * (*NZ); j++) Yll[i + j * (*NY) * (*NX)] = Xout[j]; /* * Must take row from HLL and HLH and place into vectors for iDWT. */ for(j = 0; j < *NZ; j++) { Win[j] = HLH[i + j * (*NY) * (*NX)]; Vin[j] = HLL[i + j * (*NY) * (*NX)]; } idwt(Win, Vin, NZ, L, h, g, Xout); for(j = 0; j < 2 * (*NZ); j++) Yhl[i + j * (*NY) * (*NX)] = Xout[j]; /* * Must take row from LHL and LHH and place into vectors for iDWT. */ for(j = 0; j < *NZ; j++) { Win[j] = LHH[i + j * (*NY) * (*NX)]; Vin[j] = LHL[i + j * (*NY) * (*NX)]; } idwt(Win, Vin, NZ, L, h, g, Xout); for(j = 0; j < 2 * (*NZ); j++) Ylh[i + j * (*NY) * (*NX)] = Xout[j]; /* * Must take row from HHL and HHH and place into vectors for iDWT. */ for(j = 0; j < *NZ; j++) { Win[j] = HHH[i + j * (*NY) * (*NX)]; Vin[j] = HHL[i + j * (*NY) * (*NX)]; } idwt(Win, Vin, NZ, L, h, g, Xout); for(j = 0; j < 2 * (*NZ); j++) Yhh[i + j * (*NY) * (*NX)] = Xout[j]; } free(Vin); free(Win); free(Xout); /* printf("Y Low-Low...\n"); printdvec(Yll, (*NX) * (*NY) * 2 * (*NZ)); printf("Y High-Low...\n"); printdvec(Yhl, (*NX) * (*NY) * 2 * (*NZ)); printf("Y Low-High...\n"); printdvec(Ylh, (*NX) * (*NY) * 2 * (*NZ)); printf("Y High-High...\n"); printdvec(Yhh, (*NX) * (*NY) * 2 * (*NZ)); */ Xl = (double *) malloc((2*(*NZ)*2*(*NY)*(*NX)) * sizeof(double)); Xh = (double *) malloc((2*(*NZ)*2*(*NY)*(*NX)) * sizeof(double)); Vin = (double *) malloc((*NY) * sizeof(double)); Win = (double *) malloc((*NY) * sizeof(double)); Xout = (double *) malloc(2*(*NY) * sizeof(double)); k = 0; l = 0; for(i = 0; i < 2 * (*NZ) * (*NX); i++) { /* * Must adjust for 3D array structure. * k: vertical dimension (Z) adjustment when reading in data * l: vertical dimension (Z) adjustment when writing wavelet coeffs. */ if(i > 0 && fmod(i, *NX) == 0.0) { k = k + (*NY - 1) * (*NX); l = l + (2 * (*NY) - 1) * (*NX); } /* printf("k = %d \t l = %d\n", k, l); */ /* * Must take columns from Yll and Ylh and place into vectors for iDWT. */ for(j = 0; j < *NY; j++) { Vin[j] = Yll[i + j * (*NX) + k]; Win[j] = Ylh[i + j * (*NX) + k]; } idwt(Win, Vin, NY, L, h, g, Xout); for(j = 0; j < 2 * (*NY); j++) Xl[i + j * (*NX) + l] = Xout[j]; /* * Must take columns from Yhl and Yhh and place into vectors for iDWT. */ for(j = 0; j < *NY; j++) { Vin[j] = Yhl[i + j * (*NX) + k]; Win[j] = Yhh[i + j * (*NX) + k]; } idwt(Win, Vin, NY, L, h, g, Xout); for(j = 0; j < 2 * (*NY); j++) Xh[i + j * (*NX) + l] = Xout[j]; } /* printf("X Low...\n"); printdvec(Xl, (*NX) * 2 * (*NY) * 2 * (*NZ)); printf("X High...\n"); printdvec(Xh, (*NX) * 2 * (*NY) * 2 * (*NZ)); */ free(Vin); free(Win); free(Xout); free(Yll); free(Ylh); free(Yhl); free(Yhh); Vin = (double *) malloc((*NX) * sizeof(double)); Win = (double *) malloc((*NX) * sizeof(double)); Xout = (double *) malloc(2*(*NX) * sizeof(double)); for(i = 0; i < 2 * (*NZ) * 2 * (*NY); i++) { /* * Must take columns from Xl and Xh and place into vectors for iDWT. */ for(j = 0; j < *NX; j++) { Vin[j] = Xl[i * (*NX) + j]; Win[j] = Xh[i * (*NX) + j]; } idwt(Win, Vin, NX, L, h, g, Xout); for(j = 0; j < 2 * (*NX); j++) image[i * 2 * (*NX) + j] = Xout[j]; } free(Vin); free(Win); free(Xout); free(Xl); free(Xh); } /*************************************************************************** *************************************************************************** 3D MODWT *************************************************************************** ***************************************************************************/ void three_D_modwt(double *X, int *NX, int *NY, int *NZ, int *J, int *L, double *h, double *g, double *LLL, double *HLL, double *LHL, double *LLH, double *HHL, double *HLH, double *LHH, double *HHH) { int i, j, k, index; double *data, *Wout, *Vout, *Xl, *Xh, *Yll, *Ylh, *Yhl, *Yhh; /* printf("Original Data (N = %d)...\n", *NX * (*NY) * (*NZ)); printdvec(X, *NX * (*NY) * (*NZ)); */ /* * Perform one-dimensional MODWT on first dimension (length NX). */ Wout = (double *) malloc((*NX) * sizeof(double)); Vout = (double *) malloc((*NX) * sizeof(double)); data = (double *) malloc((*NX) * sizeof(double)); /* * Create temporary "hyperrectangles" to store MODWT of X-dimension. */ Xl = (double *) malloc((*NZ*(*NY)*(*NX)) * sizeof(double)); Xh = (double *) malloc((*NZ*(*NY)*(*NX)) * sizeof(double)); for(i = 0; i < *NZ*(*NY); i++) { /* * Must take column from X-dimension and place into vector for DWT. */ for(j = 0; j < *NX; j++) { index = i * (*NX) + j; data[j] = X[index]; } /* * Perform MODWT and read into temporary matrices. */ modwt(data, NX, J, L, h, g, Wout, Vout); for(j = 0; j < *NX; j++) { index = i * (*NX) + j; Xl[index] = Vout[j]; Xh[index] = Wout[j]; } } free(Wout); free(Vout); free(data); /* printf("X Low...\n"); printdvec(Xl, (*NX) * (*NY) * (*NZ)); printf("X High...\n"); printdvec(Xh, (*NX) * (*NY) * (*NZ)); */ /* * Perform one-dimensional MODWT on second dimension (length NY). */ Wout = (double *) malloc((*NY) * sizeof(double)); Vout = (double *) malloc((*NY) * sizeof(double)); data = (double *) malloc((*NY) * sizeof(double)); /* * Create temporary "hyperrectangles" to store MODWT of X-dimension. */ Yll = (double *) malloc((*NZ*(*NY)*(*NX)) * sizeof(double)); Ylh = (double *) malloc((*NZ*(*NY)*(*NX)) * sizeof(double)); Yhl = (double *) malloc((*NZ*(*NY)*(*NX)) * sizeof(double)); Yhh = (double *) malloc((*NZ*(*NY)*(*NX)) * sizeof(double)); k = 0; for(i = 0; i < *NZ * (*NX); i++) { /* * Must adjust for 3D array structure. * k: vertical dimension (Z) adjustment when reading in data * l: vertical dimension (Z) adjustment when writing wavelet coeffs. */ if(i > 0 && fmod(i, *NX) == 0.0) k = k + (*NY - 1) * (*NX); /* * Must take row from "Xl" and place into vector for DWT. */ for(j = 0; j < *NY; j++) { index = i + j * (*NX) + k; data[j] = Xl[index]; } /* * Perform MODWT and read into temporary "Yll" and "Ylh" hyperrectangles. */ modwt(data, NY, J, L, h, g, Wout, Vout); for(j = 0; j < *NY; j++) { index = i + j * (*NX) + k; Yll[index] = Vout[j]; Ylh[index] = Wout[j]; } /* * Must take row from "Xh" and place into vector for DWT. */ for(j = 0; j < *NY; j++) { index = i + j * (*NX) + k; data[j] = Xh[index]; } /* * Perform MODWT and read into temporary "Yhl" and "Yhh" hyperrectangles. */ modwt(data, NY, J, L, h, g, Wout, Vout); for(j = 0; j < *NY; j++) { index = i + j * (*NX) + k; Yhl[index] = Vout[j]; Yhh[index] = Wout[j]; } } free(Wout); free(Vout); free(data); free(Xl); free(Xh); /* printf("Y Low-Low...\n"); printdvec(Yll, (*NX) * (*NY) * (*NZ)); printf("Y High-Low...\n"); printdvec(Yhl, (*NX) * (*NY) * (*NZ)); printf("Y Low-High...\n"); printdvec(Ylh, (*NX) * (*NY) * (*NZ)); printf("Y High-High...\n"); printdvec(Yhh, (*NX) * (*NY) * (*NZ)); */ /* * Perform one-dimensional MODWT on third dimension (length NZ). */ Wout = (double *) malloc((*NZ) * sizeof(double)); Vout = (double *) malloc((*NZ) * sizeof(double)); data = (double *) malloc((*NZ) * sizeof(double)); for(i = 0; i < *NY * (*NX); i++) { /* * Must take vertical column from "Yll" and place into vector for MODWT. */ for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); data[j] = Yll[index]; } /* * Perform MODWT and read into final "LLL" and "LLH" hyperrectangles. */ modwt(data, NZ, J, L, h, g, Wout, Vout); for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); LLL[index] = Vout[j]; LLH[index] = Wout[j]; } /* * Must take row from "Yhl" and place into vector for MODWT. */ for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); data[j] = Yhl[index]; } /* * Perform MODWT and read into final "HLL" and "HLH" hyperrectangles. */ modwt(data, NZ, J, L, h, g, Wout, Vout); for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); HLL[index] = Vout[j]; HLH[index] = Wout[j]; } /* * Must take row from "Ylh" and place into vector for MODWT. */ for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); data[j] = Ylh[index]; } /* * Perform MODWT and read into final "LHL" and "LHH" hyperrectangles. */ modwt(data, NZ, J, L, h, g, Wout, Vout); for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); LHL[index] = Vout[j]; LHH[index] = Wout[j]; } /* * Must take row from "Yhh" and place into vector for MODWT. */ for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); data[j] = Yhh[index]; } /* * Perform MODWT and read into final "LHH" and "HHH" hyperrectangles. */ modwt(data, NZ, J, L, h, g, Wout, Vout); for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); HHL[index] = Vout[j]; HHH[index] = Wout[j]; } } free(Wout); free(Vout); free(data); free(Yll); free(Ylh); free(Yhl); free(Yhh); } /*************************************************************************** *************************************************************************** 3D iMODWT *************************************************************************** ***************************************************************************/ void three_D_imodwt(double *LLL, double *HLL, double *LHL, double *LLH, double *HHL, double *HLH, double *LHH, double *HHH, int *NX, int *NY, int *NZ, int *J, int *L, double *h, double *g, double *image) { int i, j, k, index; double *Win, *Vin, *Xl, *Xh, *Yll, *Ylh, *Yhl, *Yhh, *Xout; /* * Create temporary "hyperrectangles" to store imodwt of Z-dimension. */ Yll = (double *) malloc(((*NZ)*(*NY)*(*NX)) * sizeof(double)); Ylh = (double *) malloc(((*NZ)*(*NY)*(*NX)) * sizeof(double)); Yhl = (double *) malloc(((*NZ)*(*NY)*(*NX)) * sizeof(double)); Yhh = (double *) malloc(((*NZ)*(*NY)*(*NX)) * sizeof(double)); Win = (double *) malloc((*NZ) * sizeof(double)); Vin = (double *) malloc((*NZ) * sizeof(double)); Xout = (double *) malloc((*NZ) * sizeof(double)); for(i = 0; i < *NY * (*NX); i++) { /* * Must take row from LLL and LLH and place into vectors for imodwt. */ for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); Win[j] = LLH[index]; Vin[j] = LLL[index]; } imodwt(Win, Vin, NZ, J, L, h, g, Xout); for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); Yll[index] = Xout[j]; } /* * Must take row from HLL and HLH and place into vectors for imodwt. */ for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); Win[j] = HLH[index]; Vin[j] = HLL[index]; } imodwt(Win, Vin, NZ, J, L, h, g, Xout); for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); Yhl[index] = Xout[j]; } /* * Must take row from LHL and LHH and place into vectors for imodwt. */ for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); Win[j] = LHH[index]; Vin[j] = LHL[index]; } imodwt(Win, Vin, NZ, J, L, h, g, Xout); for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); Ylh[index] = Xout[j]; } /* * Must take row from HHL and HHH and place into vectors for imodwt. */ for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); Win[j] = HHH[index]; Vin[j] = HHL[index]; } imodwt(Win, Vin, NZ, J, L, h, g, Xout); for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); Yhh[index] = Xout[j]; } } free(Vin); free(Win); free(Xout); /* printf("Y Low-Low...\n"); printdvec(Yll, (*NX) * (*NY) * (*NZ)); printf("Y High-Low...\n"); printdvec(Yhl, (*NX) * (*NY) * (*NZ)); printf("Y Low-High...\n"); printdvec(Ylh, (*NX) * (*NY) * (*NZ)); printf("Y High-High...\n"); printdvec(Yhh, (*NX) * (*NY) * (*NZ)); */ Xl = (double *) malloc(((*NZ)*(*NY)*(*NX)) * sizeof(double)); Xh = (double *) malloc(((*NZ)*(*NY)*(*NX)) * sizeof(double)); Vin = (double *) malloc((*NY) * sizeof(double)); Win = (double *) malloc((*NY) * sizeof(double)); Xout = (double *) malloc((*NY) * sizeof(double)); k = 0; for(i = 0; i < (*NZ) * (*NX); i++) { /* * Must adjust for 3D array structure. * k: vertical dimension (Z) adjustment when reading in data */ if(i > 0 && fmod(i, *NX) == 0.0) k = k + (*NY - 1) * (*NX); /* * Must take columns from Yll and Ylh and place into vectors for imodwt. */ for(j = 0; j < *NY; j++) { index = i + j * (*NX) + k; Vin[j] = Yll[index]; Win[j] = Ylh[index]; } imodwt(Win, Vin, NY, J, L, h, g, Xout); for(j = 0; j < (*NY); j++) { index = i + j * (*NX) + k; Xl[index] = Xout[j]; } /* * Must take columns from Yhl and Yhh and place into vectors for imodwt. */ for(j = 0; j < *NY; j++) { index = i + j * (*NX) + k; Vin[j] = Yhl[index]; Win[j] = Yhh[index]; } imodwt(Win, Vin, NY, J, L, h, g, Xout); for(j = 0; j < (*NY); j++) { index = i + j * (*NX) + k; Xh[i + j * (*NX) + k] = Xout[j]; } } /* printf("X Low...\n"); printdvec(Xl, (*NX) * (*NY) * (*NZ)); printf("X High...\n"); printdvec(Xh, (*NX) * (*NY) * (*NZ)); */ free(Vin); free(Win); free(Xout); free(Yll); free(Ylh); free(Yhl); free(Yhh); Vin = (double *) malloc((*NX) * sizeof(double)); Win = (double *) malloc((*NX) * sizeof(double)); Xout = (double *) malloc((*NX) * sizeof(double)); for(i = 0; i < (*NZ) * (*NY); i++) { /* * Must take columns from Xl and Xh and place into vectors for imodwt. */ for(j = 0; j < *NX; j++) { index = i * (*NX) + j; Vin[j] = Xl[index]; Win[j] = Xh[index]; } imodwt(Win, Vin, NX, J, L, h, g, Xout); for(j = 0; j < (*NX); j++) { index = i * (*NX) + j; image[index] = Xout[j]; } } free(Vin); free(Win); free(Xout); free(Xl); free(Xh); } waveslim/src/dwt.h0000644000176200001440000000065513430347452013652 0ustar liggesusersextern void dwt(double *Vin, int *M, int *L, double *h, double *g, double *Wout, double *Vout); extern void idwt(double *Win, double *Vin, int *M, int *L, double *h, double *g, double *Xout); extern void modwt(double *Vin, int *N, int *j, int *L, double *ht, double *gt, double *Wout, double *Vout); extern void imodwt(double *Win, double *Vin, int *N, int *j, int *L, double *ht, double *gt, double *Vout); waveslim/src/dwt2.c0000644000176200001440000002674613430347452013740 0ustar liggesusers#include #include #include #include #include "dwt.h" /*************************************************************************** *************************************************************************** 2D DWT *************************************************************************** ***************************************************************************/ void two_D_dwt(double *X, int *M, int *N, int *L, double *h, double *g, double *LL, double *LH, double *HL, double *HH) { int i, j, k; double *data, *Wout, *Vout, *Low, *High; // Perform one-dimensional DWT on columns (length M). Wout = (double *) malloc((*M) * sizeof(double)); Vout = (double *) malloc((*M) * sizeof(double)); // Create temporary "matrices" to store DWT of columns. Low = (double *) malloc((*N*(*M/2)) * sizeof(double)); High = (double *) malloc((*N*(*M/2)) * sizeof(double)); for(i = 0; i < *N; i++) { // Must take column from X and place into vector for DWT. data = (double *) malloc((*M) * sizeof(double)); for(j = 0; j < *M; j++) { data[j] = X[i*(*M)+j]; //printf("X[%d][%d] = %f\n", i, j, X[i*(*M)+j]); } //Perform DWT and read into temporary matrices. dwt(data, M, L, h, g, Wout, Vout); for(k = 0; k < (int) *M/2; k++) { Low[i*(*M/2)+k] = Vout[k]; High[i*(*M/2)+k] = Wout[k]; // printf("Low[%d][%d] = %f\n", i, k, Low[i*(*M/2)+k]); //printf("High[%d][%d] = %f\n", i, k, High[i*(*M/2)+k]); } free(data); } free(Wout); free(Vout); // Perform one-dimensional DWT on rows (length N). Wout = (double *) malloc((*N) * sizeof(double)); Vout = (double *) malloc((*N) * sizeof(double)); for(i = 0; i < (int) *M/2; i++) { // Must take row from "Low" and place into vector for DWT. data = (double *) malloc((*N) * sizeof(double)); for(j = 0; j < *N; j++) { data[j] = Low[i+j*(*M/2)]; // printf("Low[%d][%d] = %f\n", i, j, Low[i+j*(*M/2)]); } // Perform DWT and read into final "Low" matrices. dwt(data, N, L, h, g, Wout, Vout); for(k = 0; k < (int) *N/2; k++) { LL[i+k*(*M/2)] = Vout[k]; HL[i+k*(*M/2)] = Wout[k]; //LL[i+k*(*N/2)] = Vout[k]; // Original ones //HL[i+k*(*N/2)] = Wout[k]; // Original ones // printf("LL[%d][%d] = %f\n", i, k, LL[i+k*(*N/2)]); // printf("LH[%d][%d] = %f\n", i, k, HL[i+k*(*N/2)]); } free(data); //Must take row from "High" and place into vector for DWT. data = (double *) malloc((*N) * sizeof(double)); for(j = 0; j < *N; j++) { data[j] = High[i+j*(*M/2)]; // printf("High[%d][%d] = %f\n", j, i, High[i+j*(*M/2)]); } // Perform DWT and read into final "High" matrices. dwt(data, N, L, h, g, Wout, Vout); for(k = 0; k < (int) *N/2; k++) { LH[i+k*(*M/2)] = Vout[k]; HH[i+k*(*M/2)] = Wout[k]; //LH[i+k*(*N/2)] = Vout[k]; //Original ones //HH[i+k*(*N/2)] = Wout[k]; //Original ones // printf("HL[%d][%d] = %f\n", i, k, LH[i+k*(*N/2)]); // printf("HH[%d][%d] = %f\n", i, k, HH[i+k*(*N/2)]); } free(data); } free(Wout); free(Vout); free(Low); free(High); } /*************************************************************************** *************************************************************************** printdvec() *************************************************************************** ***************************************************************************/ /* void printdvec(double *v, int n) { int i; for(i = 0; i <= n-1; i++) printf("%f ", v[i]); printf("\n"); } */ /*************************************************************************** *************************************************************************** 2D iDWT *************************************************************************** ***************************************************************************/ void two_D_idwt(double *LL, double *LH, double *HL, double *HH, int *M, int *N, int *L, double *h, double *g, double *image) { int i, j, k; /* int debug = 0; */ double *Win, *Vin, *Low, *High, *Xout; Low = (double *) malloc((*M)*2*(*N) * sizeof(double)); High = (double *) malloc((*M)*2*(*N) * sizeof(double)); Win = (double *) malloc((*N) * sizeof(double)); Vin = (double *) malloc((*N) * sizeof(double)); Xout = (double *) malloc(2*(*N) * sizeof(double)); for(i = 0; i < *M; i++) { /* * Must take row from LL and HL and place into vectors for iDWT. */ for(j = 0; j < *N; j++) { Win[j] = HL[i+j*(*M)]; Vin[j] = LL[i+j*(*M)]; } idwt(Win, Vin, N, L, h, g, Xout); for(k = 0; k < 2*(*N); k++) { Low[i+k*(*M)] = Xout[k]; /* if(debug) printf("Low[%d][%d] = %f\n", k, i, Low[i+k*(*M)]); */ } /* * Must take row from LH and HH and place into vectors for iDWT. */ for(j = 0; j < *N; j++) { Win[j] = HH[i+j*(*M)]; Vin[j] = LH[i+j*(*M)]; } idwt(Win, Vin, N, L, h, g, Xout); for(k = 0; k < 2*(*N); k++) { High[i+k*(*M)] = Xout[k]; /* if(debug) printf("High[%d][%d] = %f\n", k, i, High[i+k*(*M)]); */ } } free(Vin); free(Win); free(Xout); Vin = (double *) malloc((*M) * sizeof(double)); Win = (double *) malloc((*M) * sizeof(double)); Xout = (double *) malloc(2*(*M) * sizeof(double)); for(i = 0; i < 2*(*N); i++) { /* * Must take columns from High and Low and place into vectors for iDWT. */ for(k = 0; k < *M; k++) { Vin[k] = Low[i*(*M)+k]; Win[k] = High[i*(*M)+k]; } idwt(Win, Vin, M, L, h, g, Xout); for(j = 0; j < 2*(*M); j++) image[i*2*(*M)+j] = Xout[j]; } free(Vin); free(Win); free(Xout); free(Low); free(High); } /*************************************************************************** *************************************************************************** 2D MODWT *************************************************************************** ***************************************************************************/ void two_D_modwt(double *X, int *M, int *N, int *J, int *L, double *h, double *g, double *LL, double *LH, double *HL, double *HH) { int i, j, k, index; /* int debug = 0; */ double *data, *Wout, *Vout, *Low, *High; /* * Perform one-dimensional MODWT on columns (length M). */ Wout = (double *) malloc((*M) * sizeof(double)); Vout = (double *) malloc((*M) * sizeof(double)); /* * Create temporary "matrices" to store MODWT of columns. */ Low = (double *) malloc((*N*(*M)) * sizeof(double)); High = (double *) malloc((*N*(*M)) * sizeof(double)); for(i = 0; i < *N; i++) { /* * Must take column from X and place into vector for MODWT. */ data = (double *) malloc((*M) * sizeof(double)); for(j = 0; j < *M; j++) { /* index = i * (*N) + j; */ index = i * (*M) + j; data[j] = X[index]; /* if(debug) printf("X[%d][%d] = %f\n", i, j, X[index]); */ } /* * Perform MODWT and read into temporary matrices. */ modwt(data, M, J, L, h, g, Wout, Vout); for(k = 0; k < *M; k++) { /* index = i * (*N) + k; */ index = i * (*M) + k; Low[index] = Vout[k]; High[index] = Wout[k]; /* *if(debug) { *printf("Low[%d][%d] = %f\n", i, k, Low[index]); *printf("High[%d][%d] = %f\n", i, k, High[index]); * } */ } free(data); } free(Wout); free(Vout); /* * Perform one-dimensional MODWT on rows (length N). */ Wout = (double *) malloc((*N) * sizeof(double)); Vout = (double *) malloc((*N) * sizeof(double)); for(i = 0; i < *M; i++) { /* * Must take row from "Low" and place into vector for DWT. */ data = (double *) malloc((*N) * sizeof(double)); for(j = 0; j < *N; j++) { index = i + j * (*M); data[j] = Low[index]; /* if(debug) printf("Low[%d][%d] = %f\n", i, j, Low[index]); */ } /* * Perform MODWT and read into final "Low" matrices. */ modwt(data, N, J, L, h, g, Wout, Vout); for(k = 0; k < *N; k++) { index = i + k * (*M); LL[index] = Vout[k]; LH[index] = Wout[k]; /* *if(debug) { *printf("LL[%d][%d] = %f\n", i, k, LL[index]); *printf("LH[%d][%d] = %f\n", i, k, LH[index]); * } */ } free(data); /* * Must take row from "High" and place into vector for MODWT. */ data = (double *) malloc((*N) * sizeof(double)); for(j = 0; j < *N; j++) { index = i + j * (*M); data[j] = High[index]; /* if(debug) printf("High[%d][%d] = %f\n", j, i, High[index]); */ } /* * Perform MODWT and read into final "High" matrices. */ modwt(data, N, J, L, h, g, Wout, Vout); for(k = 0; k < *N; k++) { index = i + k * (*M); HL[index] = Vout[k]; HH[index] = Wout[k]; /* * if(debug) { * printf("HL[%d][%d] = %f\n", i, k, HL[index]); * printf("HH[%d][%d] = %f\n", i, k, HH[index]); * } */ } free(data); } free(Wout); free(Vout); free(Low); free(High); } /*************************************************************************** *************************************************************************** 2D iMODWT *************************************************************************** ***************************************************************************/ void two_D_imodwt(double *LL, double *LH, double *HL, double *HH, int *M, int *N, int *J, int *L, double *h, double *g, double *image) { int i, j, k, index; double *Win, *Vin, *Low, *High, *Xout; Low = (double *) malloc((*M)*(*N) * sizeof(double)); High = (double *) malloc((*M)*(*N) * sizeof(double)); Win = (double *) malloc((*N) * sizeof(double)); Vin = (double *) malloc((*N) * sizeof(double)); Xout = (double *) malloc((*N) * sizeof(double)); for(i = 0; i < *M; i++) { /* * Must take row from LL and LH and place into vectors for iMODWT. */ for(j = 0; j < *N; j++) { index = i + j * (*M); Win[j] = LH[index]; Vin[j] = LL[index]; } imodwt(Win, Vin, N, J, L, h, g, Xout); for(k = 0; k < *N; k++) { index = i + k * (*M); Low[index] = Xout[k]; } /* * Must take row from HL and HH and place into vectors for iMODWT. */ for(j = 0; j < *N; j++) { index = i + j * (*M); Win[j] = HH[index]; Vin[j] = HL[index]; } imodwt(Win, Vin, N, J, L, h, g, Xout); for(k = 0; k < *N; k++) { index = i + k * (*M); High[index] = Xout[k]; } } free(Vin); free(Win); free(Xout); Vin = (double *) malloc((*M) * sizeof(double)); Win = (double *) malloc((*M) * sizeof(double)); Xout = (double *) malloc((*M) * sizeof(double)); for(i = 0; i < *N; i++) { /* * Must take columns from High and Low and place into vectors for iMODWT. */ for(k = 0; k < *M; k++) { /* index = i * (*N) + k; */ index = i * (*M) + k; Vin[k] = Low[index]; Win[k] = High[index]; } imodwt(Win, Vin, M, J, L, h, g, Xout); for(j = 0; j < *M; j++) { /* index = i * (*N) + j; */ index = i * (*M) + j; image[index] = Xout[j]; } } free(Vin); free(Win); free(Xout); free(Low); free(High); } waveslim/src/hosking.c0000644000176200001440000000377613430347452014520 0ustar liggesusers#include #include void hosking(double *Xt, int *N, double *vin) { int i, j, t; int nrl = 1, nrh = *N-1, ncl = 1, nch = *N-1; int nrow=nrh-nrl+1,ncol=nch-ncl+1; double *vt, *mt, *Nt, *Dt, *rhot; double **phi; /* = dmatrix(1, *N-1, 1, *N-1); */ vt = (double *) malloc((size_t) ((*N + 2) * sizeof(double))); mt = (double *) malloc((size_t) ((*N + 2) * sizeof(double))); Nt = (double *) malloc((size_t) ((*N + 2) * sizeof(double))); Dt = (double *) malloc((size_t) ((*N + 2) * sizeof(double))); rhot = (double *) malloc((size_t) ((*N + 2) * sizeof(double))); /*** Begin dmatrix code ***/ /* allocate pointers to rows */ phi=(double **) malloc((size_t)((nrow+1)*sizeof(double*))); /* if (!phi) nrerror("allocation failure 1 in matrix()"); */ phi += 1; phi -= nrl; /* allocate rows and set pointers to them */ phi[nrl]=(double *) malloc((size_t)((nrow*ncol+1)*sizeof(double))); /* if (!phi[nrl]) nrerror("allocation failure 2 in matrix()"); */ phi[nrl] += 1; phi[nrl] -= ncl; for(i=nrl+1;i<=nrh;i++) phi[i]=phi[i-1]+ncol; /*** End dmatrix code ***/ for(i = 1; i <= *N-1; i++) for(j = 1; j <= *N-1; j++) phi[i][j] = 0.0; vt[0] = vin[0]; Nt[0] = 0.0; Dt[0] = 1.0; Xt[0] *= sqrt(vt[0]); rhot[0] = 1.0; /* phi[1][1] = d / (1.0 - d); */ for(t = 1; t <= *N-1; t++) { rhot[t] = vin[t] / vin[0]; Nt[t] = rhot[t]; if(t > 1) for(j = 1; j <= t-1; j++) Nt[t] -= phi[t-1][j] * rhot[t-j]; Dt[t] = Dt[t-1] - (Nt[t-1] * Nt[t-1]) / Dt[t-1]; phi[t][t] = Nt[t] / Dt[t]; for(j = 1; j <= t-1; j++) phi[t][j] = phi[t-1][j] - phi[t][t] * phi[t-1][t-j]; } for(t = 1; t <= *N-1; t++) { mt[t] = 0.0; for(j = 1; j <= t; j++) mt[t] += phi[t][j] * Xt[t-j]; vt[t] = (1.0 - phi[t][t] * phi[t][t]) * vt[t-1]; Xt[t] = Xt[t] * sqrt(vt[t]) + mt[t]; } free((char*) (vt)); free((char*) (mt)); free((char*) (Nt)); free((char*) (Dt)); free((char*) (rhot)); free((char*) (phi[1])); free((char*) (phi)); } waveslim/src/bell-p-w.f0000644000176200001440000002301313430347452014462 0ustar liggesusers SUBROUTINE DPSS(NMAX, KMAX, N, W, V, SIG, TOTIT, SINES, VOLD, * U, SCR1, IFAULT) C C CALCULATES DISCRETE PROLATE SPHEROIDAL SEQUENCES FOR USE AS DATA C TAPERS. C C FORTRAN 77 C C SUBMITTED BY BRAD BELL, DON PERCIVAL AND ANDREW WALDEN. C Comments/queries to C dbp@apl.washington.edu OR a.walden@ic.ac.uk C C This software may be freely used for non-commercial purposes and can C be freely distributed. C C Equation numbers and comments refer to the article: C C Bell, B., Percival, D.B. and Walden, A.T. "Calculating Thomson's C Spectral Multitapers by Inverse Iteration", J. Comput. and Graph. C Stat., 1993. C C Calls auxiliary routines SYTOEP and SPOL also given below. C C C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C NMAX integer input: maximum possible length of taper C C KMAX integer input: dpss orders 0 to KMAX required C C N integer input: length of sequence to generate C C W real input: half-bandwidth, W < 1/2 C C V(NMAX, KMAX+1) C real array output: columns contain tapers C C SIG(KMAX+1) C real array output: eigenvalues are 1+SIG(j) C C TOTIT integer output: total number of iterations C C SINES(0:N-1) C real array work array C C VOLD(N) real array work array C C U(N) real array work array C C SCR1(N) real array work array C C IFAULT integer output: 0 indicates success C 1 if W > 1/2 C 2 if N < 2 C 3 if NMAX < N; matrix too small C 4 if KMAX < 0 C 5 failure in SYTOEP C 6 > MAXIT its required for some order C (Output values are undefined for C IFAULT in the range 1 to 5.) C C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C INTEGER J, K, K1, KMAX, M, N, TOTIT, ISIG, ILOW, * IHIG, IT, MAXIT, IFAIL, IFAULT DOUBLE PRECISION V(NMAX,0:KMAX), SIG(0:KMAX), U(N), * VOLD(N), SINES(0:N-1), SCR1(N), ZERO, ONE, TWO, FOUR, * EPS, DELTA, PI, W, ROOTN, PROJ, SNORM, SSNORM, DIFF, * SUM, HALF, RONE DATA ZERO, HALF, ONE,TWO,FOUR,EPS * /0.0D0, 0.5D0, 1.0D0,2.0D0,4.0D0,0.5D-6/ C C initialize max number of iterations flag C IFAIL=0 C C check input parameters C IFAULT=1 IF(W .GT. HALF) RETURN IFAULT=2 IF(N .LT. 2) RETURN IFAULT=3 IF(NMAX .LT. N) RETURN IFAULT=4 IF(KMAX .LT. 0 .OR. KMAX .GT. N-1) RETURN C C set up SINES so that S in eqn. (1) is given by C S(n,m)=SINES(n-m) for n not equal to m. C PI=FOUR*ATAN(ONE) DO 5 M=1,N-1 SINES(M)=SIN(TWO*PI*W*M)/(PI*M) 5 CONTINUE C C set total iteration counter and constant C TOTIT=0 ROOTN=SQRT(FLOAT(N)) RONE=ONE/ROOTN C C major loop over dpss orders 0 to KMAX C C modify SINES(0) so that B_k in Section 2.2 is given by C B_k(n,m)=SINES(n-m) C DO 200 K=0,KMAX IF(K .EQ. 0) THEN SINES(0)=TWO*W-ONE ELSE SINES(0)=TWO*W-(ONE+SIG(K-1)) END IF C C define suitable starting vector for inverse iteration; C see Section 2.2. C ISIG=1 K1=K+1 DO 15 J=1, K1 ILOW=((J-1)*N/K1)+1 IHIG=(J*N/K1) DO 20 JJ=ILOW,IHIG U(JJ)=ISIG*RONE 20 CONTINUE ISIG=ISIG*(-1) 15 CONTINUE IF(MOD(K,2).GT.0 .AND. MOD(N,2).GT.0) U((N/2)+1)=ZERO C C maximum number of iterations C MAXIT=(K+3)*ROOTN IT=0 C C carry out inverse iteration C DO 180 IT=1,MAXIT C C copy U into old V; VOLD = previous iterate C DO 50 J=1,N 50 VOLD(J)=U(J) C C solve symmetric Toeplitz matrix equation B_k*U=VOLD for U C CALL SYTOEP(N, SINES, VOLD, U, SCR1, IFAIL) C C check no problems C IFAULT=5 IF(IFAIL .NE. 0) RETURN C C new vector must be orthogonal to previous eigenvectors C IF(K .GT. 0) THEN DO 80 K1=0,K-1 C C projection of U onto V(*,K1): C PROJ=ZERO DO 85 J=1,N 85 PROJ=PROJ + U(J)*V(J,K1) C C subtract projection C DO 90 J=1,N 90 U(J)=U(J) - PROJ*V(J,K1) C 80 CONTINUE END IF C C normalize C SNORM=ZERO DO 100 J=1,N 100 SNORM=SNORM+U(J)*U(J) SSNORM=SQRT(SNORM) DO 105 J=1,N 105 U(J)=U(J)/SSNORM C C check for convergence C SUM=ZERO DIFF=ZERO DO 120 J=1,N C C first previous-current: C DIFF=DIFF+(VOLD(J)-U(J))**2 C C next, previous+current C 120 SUM=SUM+(VOLD(J)+U(J))**2 DELTA=SQRT(MIN(DIFF,SUM)) IF(DELTA .LE. EPS) GOTO 190 180 CONTINUE C C if here, max number of iterations exceeded for this order dpss C IT=MAXIT IFAIL=1 190 CONTINUE TOTIT=TOTIT+IT IF(SUM .LT. DIFF) THEN IF(K .EQ. 0) THEN SIG(0)= - ONE/SSNORM ELSE SIG(K)=SIG(K-1) - ONE/SSNORM END IF ELSE IF(K .EQ. 0) THEN SIG(0)= ONE/SSNORM ELSE SIG(K)=SIG(K-1) + ONE/SSNORM END IF END IF C C ensure tapers satisfy Slepian convention C CALL SPOL(N, U, K, IFAULT) DO 220 J=1,N 220 V(J,K)=U(J) C 200 CONTINUE C C if one order of dpss did not converge set IFAULT to 6 C IFAULT=0 IF( IFAIL .EQ. 1) IFAULT=6 RETURN END SUBROUTINE SYTOEP(N, R, G, F, W, IFAULT) C C FINDS FILTER CORRESPONDING TO A SYMMETRIC TOEPLITZ MATRIX C WITH FIRST ROW R(.) AND CROSSCORRELATION VECTOR G(.) C C I.E., "R" F = G C C To be used with DPSS and SPOL. See C Bell, B., Percival, D.B. and Walden, A.T. "Calculating Thomson's C Spectral Multitapers by Inverse Iteration", J. Comput. and Graph. C Stat., 1993. C C +++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C N integer input: dimension of Toeplitz matrix and C cross-correlation vector C C R(N) real input: autocovariances from lag 0 to N-1 C C G(N) real input: cross-correlation vector C C F(N) real output: required filter C C W(N) real input: work array C C IFAULT integer output: 0 indicates successful C 1 if N < 1 C C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C THIS PROGRAM IS A SUBSTANTIALLY CORRECTED AND MODIFIED VERSION OF C "EUREKA" IN ROBINSON, E.A. (1967) MULTICHANNEL TIME SERIES ANALYSIS C WITH DIGITAL COMPUTER PROGRAMS, HOLDEN-DAY. C C C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C DOUBLE PRECISION R(0:N-1), G(N), F(N), W(N), V, D, Q, * HOLD, ZERO, ONE DATA ZERO,ONE /0.0D0,1.0D0/ C C check for special "matrix" sizes C IFAULT=1 IF(N .LT. 1) RETURN V=R(0) F(1)=G(1)/V IFAULT=0 IF(N .EQ. 1) RETURN C D=R(1) W(1)=ONE Q=F(1)*R(1) DO 5 L=2,N W(L)=-D/V IF(L .GT. 2) THEN L1=(L-2)/2 L2=L1+1 IF(L .NE. 3) THEN DO 10 J=2,L2 HOLD=W(J) K=L-J+1 W(J)=W(J)+W(L)*W(K) 10 W(K)=W(K)+W(L)*HOLD END IF IF((2*L1 .NE. L-2) .OR. L .EQ. 3) W(L2+1)= * W(L2+1)+W(L)*W(L2+1) END IF V=V+W(L)*D F(L)=(G(L)-Q)/V L3=L-1 DO 15 J=1,L3 K=L-J+1 15 F(J)=F(J)+F(L)*W(K) IF(L .EQ. N) RETURN D=ZERO Q=ZERO DO 5 I=1,L K=L-I+2 D=D+W(I)*R(K-1) 5 Q=Q+F(I)*R(K-1) RETURN END SUBROUTINE SPOL(N, V, K, IFAULT) C C SCALES THE DISCRETE PROLATE SPHEROIDAL SEQUENCE AND SETS THE C POLARITY TO AGREE WITH SLEPIAN'S CONVENTION. C C To be used with DPSS and SYTOEP. See C Bell, B., Percival, D.B. and Walden, A.T. "Calculating Thomson's C Spectral Multitapers by Inverse Iteration", J. Comput. and Graph. C Stat., 1993. (Section 1.2.) C C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C N Integer input length of dpss sequence C C V Real(N) input eigenvector (dpss) with unit energy C output unit energy dpss conforming to C Slepian's polarity convention C C K Integer input the order of the dpss 0= M1) stop("x is too long\n") else x <- c(x, rep(0, M1 - N)) xj <- c(rep(0, M), x, rep(0, M)) yj <- rep(0, M2) for(i in 1:L) yj <- yj + f[L - i + 1] * xj[1:M2 + (i - 1) * 2^j] yj } if(is.character(wf.name)) wf <- wave.filter(wf.name) else wf <- wf.name J <- nchar(filter.seq) key <- rev(substring(filter.seq, 1:J, 1:J)) f <- 1 fl <- wf$lpf fh <- wf$hpf for(k in 1:J) { if(key[k] == "H") f <- cascade(fh, f, k - 1) else if(key[k] == "L") f <- cascade(fl, f, k - 1) else stop("Invalid filter.seq\n") } f } squared.gain <- function(wf.name, filter.seq = "L", n = 512) { cascade <- function(f, x, j) { L <- length(f) N <- length(x) M <- (L - 1) * 2^j M1 <- M - L + 2 M2 <- 2 * M - L + 2 if(N > M1) stop("x is too long\n") else x <- c(x, rep(0, M1 - N)) xj <- c(rep(0, M), x, rep(0, M)) yj <- rep(0, M2) for(i in 1:L) yj <- yj + f[L - i + 1] * xj[1:M2 + (i - 1) * 2^j] yj } if(is.character(wf.name)) wf <- wave.filter(wf.name) else wf <- wf.name J <- nchar(filter.seq) key <- rev(substring(filter.seq, 1:J, 1:J)) f <- 1 fl <- wf$lpf fh <- wf$hpf for(k in 1:J) { if(key[k] == "H") f <- cascade(fh, f, k - 1) else if(key[k] == "L") f <- cascade(fl, f, k - 1) else stop("Invalid filter.seq\n") } Mod(fft(c(f, rep(0, n - length(f))))[1:(n/2 + 1)])^2 } waveslim/R/shift.2d.R0000644000176200001440000000317013430347452014054 0ustar liggesusersshift.2d <- function(z, inverse=FALSE) { ## "Center of Energy" coe <- function(g) { sum(0:(length(g)-1) * g^2) / sum(g^2) } wf <- attributes(z)$wavelet h <- wave.filter(wf)$hpf g <- wave.filter(wf)$lpf J <- (length(z) - 1) / 3 m <- nrow(z[[1]]) n <- ncol(z[[1]]) nu.H <- round(2^(1:J-1) * (coe(g) + coe(h)) - coe(g), 0) nu.Hm <- ifelse(nu.H/m < 1, nu.H, nu.H - trunc(nu.H/m) * m) nu.Hn <- ifelse(nu.H/n < 1, nu.H, nu.H - trunc(nu.H/n) * n) nu.G <- round((2^(1:J) - 1) * coe(g), 0) nu.Gm <- ifelse(nu.G/m < 1, nu.G, nu.G - trunc(nu.G/m) * m) nu.Gn <- ifelse(nu.G/n < 1, nu.G, nu.G - trunc(nu.G/n) * n) if (!inverse) { ## Apply the phase shifts for (j in 0:(J-1)) { Hm.order <- c((nu.H[j+1]+1):m, 1:nu.H[j+1]) Hn.order <- c((nu.H[j+1]+1):n, 1:nu.H[j+1]) Gm.order <- c((nu.G[j+1]+1):m, 1:nu.G[j+1]) Gn.order <- c((nu.G[j+1]+1):n, 1:nu.G[j+1]) z[[3*j+1]] <- z[[3*j+1]][Gm.order, Hn.order] z[[3*j+2]] <- z[[3*j+2]][Hm.order, Gn.order] z[[3*j+3]] <- z[[3*j+3]][Hm.order, Hn.order] } z[[3*J+1]] <- z[[3*J+1]][Gm.order, Gn.order] } else { ## Apply the phase shifts "reversed" for (j in 0:(J-1)) { Hm.order <- c((m-nu.H[j+1]+1):m, 1:(m-nu.H[j+1])) Hn.order <- c((n-nu.H[j+1]+1):n, 1:(n-nu.H[j+1])) Gm.order <- c((m-nu.G[j+1]+1):m, 1:(m-nu.G[j+1])) Gn.order <- c((n-nu.G[j+1]+1):n, 1:(n-nu.G[j+1])) z[[3*j+1]] <- z[[3*j+1]][Gm.order, Hn.order] z[[3*j+2]] <- z[[3*j+2]][Hm.order, Gn.order] z[[3*j+3]] <- z[[3*j+3]][Hm.order, Hn.order] } z[[3*J+1]] <- z[[3*J+1]][Gm.order, Gn.order] } return(z) } waveslim/R/bishrink.R0000644000176200001440000000064213430347451014244 0ustar liggesusersbishrink <- function(y1, y2, T) { ## Bivariate Shrinkage Function ## Usage : ## [w1] = bishrink(y1,y2,T) ## INPUT : ## y1 - a noisy coefficient value ## y2 - the corresponding parent value ## T - threshold value ## OUTPUT : ## w1 - the denoised coefficient R <- sqrt(abs(y1)^2 + abs(y2)^2) R <- R - T R <- R * as.numeric(R > 0) return(y1 * R/(R+T)) } waveslim/R/dwpt.R0000644000176200001440000002051413430347451013411 0ustar liggesusersdwpt <- function(x, wf="la8", n.levels=4, boundary="periodic") { N <- length(x) J <- n.levels if(N/2^J != trunc(N/2^J)) stop("Sample size is not a power of 2") if(2^J > N) stop("wavelet transform exceeds sample size in dwt") dict <- wave.filter(wf) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf storage.mode(h) <- "double" g <- dict$lpf storage.mode(g) <- "double" y <- vector("list", sum(2^(1:J))) crystals1 <- rep(1:J, 2^(1:J)) crystals2 <- unlist(apply(as.matrix(2^(1:J) - 1), 1, seq, from=0)) names(y) <- paste("w", crystals1, ".", crystals2, sep="") for(j in 1:J) { jj <- min((1:length(crystals1))[crystals1 == j]) for(n in 0:(2^j/2-1)) { if(j > 1) x <- y[[(1:length(crystals1))[crystals1 == j-1][n+1]]] W <- V <- numeric(N/2^j) if(n %% 2 == 0) { z <- .C(C_dwt, as.double(x), as.integer(N/2^(j-1)), L, h, g, W=as.double(W), V=as.double(V)) y[[jj + 2*n + 1]] <- z$W y[[jj + 2*n]] <- z$V } else { z <- .C(C_dwt, as.double(x), as.integer(N/2^(j-1)), L, h, g, W=as.double(W), V=as.double(V)) y[[jj + 2*n]] <- z$W y[[jj + 2*n + 1 ]] <- z$V } } } attr(y, "wavelet") <- wf return(y) } idwpt <- function(y, y.basis) { J <- trunc(log(length(y), 2)) dict <- wave.filter(attributes(y)$wavelet) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf storage.mode(h) <- "double" g <- dict$lpf storage.mode(g) <- "double" for(j in J:1) { a <- min((1:length(rep(1:J, 2^(1:J))))[rep(1:J, 2^(1:J)) == j]) b <- max((1:length(rep(1:J, 2^(1:J))))[rep(1:J, 2^(1:J)) == j]) n <- a while(n <= b) { if(y.basis[n]) { m <- length(y[[n]]) XX <- numeric(2 * m) if(floor((n-a)/2) %% 2 == 0) X <- .C(C_idwt, as.double(y[[n+1]]), as.double(y[[n]]), as.integer(m), L, h, g, out=as.double(XX))$out else X <- .C(C_idwt, as.double(y[[n]]), as.double(y[[n+1]]), as.integer(m), L, h, g, out=as.double(XX))$out if(j != 1) { y[[a-(b-a+1)/2 + (n-a)/2]] <- X y.basis[[a-(b-a+1)/2 + (n-a)/2]] <- 1 } n <- n + 2 } else { n <- n + 1 } } } return(X) } ##plot.dwpt <- function(x, n.levels, pgrid=TRUE) ##{ ## J <- n.levels ## scales <- rep(1:J, 2^(1:J)) ## y <- matrix(NA, 2*length(x[[1]]), J) ## for(j in 1:J) { ## a <- min((1:length(scales))[scales == j]) ## b <- max((1:length(scales))[scales == j]) ## y[, j] <- unlist(x[a:b]) ## x.length <- length(y[, j]) ## } ## plot(ts(y), ylim=c(-.45,.45)) ## if(pgrid) { ## lines(x.length * c(0,1), c(0,0), lty=2) ## for(j in 1:J) { ## lines(x.length * c(0,1), c(-j,-j), lty=2) ## for(n in 0:2^j) lines(x.length * c(n/2^j, n/2^j), c(-j,-(j-1)), lty=2) ## } ## } ## title(ylab="Level") ##} basis <- function(x, basis.names) { m <- length(x) n <- length(basis.names) y <- numeric(m) for(i in 1:n) { y <- y + as.integer(names(x) == basis.names[i]) } return(y) } ortho.basis <- function(xtree) { J <- trunc(log(length(xtree), 2)) X <- vector("list", J) X[[1]] <- xtree[rep(1:J, 2^(1:J)) == 1] for(i in 2:J) { for(j in i:J) { if(i == 2) X[[j]] <- xtree[rep(1:J, 2^(1:J)) == j] X[[j]] <- X[[j]] + 2 * c(apply(matrix(xtree[rep(1:J, 2^(1:J)) == i-1]), 1, rep, 2^(j-i+1))) } } X[[J]][X[[J]] == 0] <- 1 ifelse(unlist(X) == 1, 1, 0) } ##plot.basis <- function(xtree) ##{ ## J <- trunc(log(length(xtree), base=2)) ## j <- rep(1:J, 2^(1:J)) ## n <- unlist(apply(matrix(2^(1:J)-1), 1, seq, from=0)) ## basis <- ifelse(xtree, paste("w", j, ".", n, sep=""), NA) ## pgrid.plot(basis[basis != "NA"]) ## invisible() ##} phase.shift.packet <- function(z, wf, inv=FALSE) { ## Center of energy coe <- function(g) sum(0:(length(g)-1) * g^2) / sum(g^2) J <- length(x) - 1 g <- wave.filter(wf)$lpf h <- wave.filter(wf)$hpf if(!inv) { for(j in 1:J) { ph <- round(2^(j-1) * (coe(g) + coe(h)) - coe(g), 0) Nj <- length(x[[j]]) x[[j]] <- c(x[[j]][(ph+1):Nj], x[[j]][1:ph]) } ph <- round((2^J-1) * coe(g), 0) J <- J + 1 x[[J]] <- c(x[[J]][(ph+1):Nj], x[[J]][1:ph]) } else { for(j in 1:J) { ph <- round(2^(j-1) * (coe(g) + coe(h)) - coe(g), 0) Nj <- length(x[[j]]) x[[j]] <- c(x[[j]][(Nj-ph+1):Nj], x[[j]][1:(Nj-ph)]) } ph <- round((2^J-1) * coe(g), 0) J <- J + 1 x[[J]] <- c(x[[j]][(Nj-ph+1):Nj], x[[j]][1:(Nj-ph)]) } return(x) } modwpt <- function(x, wf="la8", n.levels=4, boundary="periodic") { N <- length(x); storage.mode(N) <- "integer" J <- n.levels if(2^J > N) stop("wavelet transform exceeds sample size in modwt") dict <- wave.filter(wf) L <- dict$length storage.mode(L) <- "integer" ht <- dict$hpf/sqrt(2) storage.mode(ht) <- "double" gt <- dict$lpf/sqrt(2) storage.mode(gt) <- "double" y <- vector("list", sum(2^(1:J))) yn <- length(y) crystals1 <- rep(1:J, 2^(1:J)) crystals2 <- unlist(apply(as.matrix(2^(1:J) - 1), 1, seq, from=0)) names(y) <- paste("w", crystals1, ".", crystals2, sep="") W <- V <- numeric(N) storage.mode(W) <- storage.mode(V) <- "double" for(j in 1:J) { index <- 0 jj <- min((1:yn)[crystals1 == j]) for(n in 0:(2^j / 2 - 1)) { index <- index + 1 if(j > 1) x <- y[[(1:yn)[crystals1 == j-1][index]]] if(n %% 2 == 0) { z <- .C(C_modwt, as.double(x), N, as.integer(j), L, ht, gt, W = W, V = V)[7:8] y[[jj + 2*n + 1]] <- z$W y[[jj + 2*n]] <- z$V } else { z <- .C(C_modwt, as.double(x), N, as.integer(j), L, ht, gt, W = W, V = V)[7:8] y[[jj + 2*n]] <- z$W y[[jj + 2*n + 1 ]] <- z$V } } } attr(y, "wavelet") <- wf return(y) } dwpt.brick.wall <- function(x, wf, n.levels, method="modwpt") { N <- length(x[[1]]) m <- wave.filter(wf)$length J <- n.levels crystals1 <- rep(1:J, 2^(1:J)) crystals2 <- unlist(apply(as.matrix(2^(1:J) - 1), 1, seq, from=0)) if(method=="dwpt") { ## for DWPT for(j in 1:J) { jj <- min((1:length(crystals1))[crystals1 == j]) L <- switch(j, (m-2)/2, ((m-2)/2 + floor(m/4)), ((m-2)/2 + floor((m/2 + floor(m/4))/2))) if(is.null(L)) L <- (m-2) for(n in 0:(2^j-1)) x[[jj+n]][1:L] <- NA } } else { ## for MODWPT for(j in 1:J) { jj <- min((1:length(crystals1))[crystals1 == j]) L <- min((2^j - 1) * (m - 1), N) for(n in 0:(2^j-1)) x[[jj+n]][1:L] <- NA } } return(x) } css.test <- function(y) { K <- length(y) test <- numeric(K) for(k in 1:K) { x <- y[[k]] x <- x[!is.na(x)] n <- length(x) plus <- 1:n/(n - 1) - cumsum(x^2)/sum(x^2) minus <- cumsum(x^2)/sum(x^2) - 0:(n - 1)/(n - 1) D <- max(abs(plus), abs(minus)) if(D < 1.224/(sqrt(n) + 0.12 + 0.11/sqrt(n))) test[k] <- 1 } return(test) } entropy.test <- function(y) { K <- length(y) test <- numeric(K) for(k in 1:K) { x <- y[[k]] test[k] <- sum(x^2 * log(x^2), na.rm=TRUE) } return(test) } cpgram.test <- function(y, p=0.05, taper=0.1) { K <- length(y) test <- numeric(K) for(k in 1:K) { x <- y[[k]] x <- x[!is.na(x)] x <- spec.taper(scale(x, center=TRUE, scale=FALSE), p=taper) y <- Mod(fft(x))^2/length(x) y[1] <- 0 n <- length(x) x <- (0:(n/2))/n if(length(x) %% 2 == 0) { n <- length(x) - 1 y <- y[1:n] x <- x[1:n] } else y <- y[1:length(x)] mp <- length(x) - 1 if(p == 0.05) crit <- 1.358/(sqrt(mp) + 0.12 + 0.11/sqrt(mp)) else { if(p == 0.01) crit <- 1.628/(sqrt(mp) + 0.12 + 0.11/sqrt(mp)) else stop("critical value is not known") } D <- abs(cumsum(y)/sum(y) - 0:mp/mp) if(max(D) < crit) test[k] <- 1 } return(test) } portmanteau.test <- function(y, p = 0.05, type = "Box-Pierce") { K <- length(y) test <- numeric(K) for(k in 1:K) { x <- y[[k]] x <- x[!is.na(x)] n <- length(x) h <- trunc(n/2) x.acf <- my.acf(x)[1:(h+1)] x.acf <- x.acf / x.acf[1]; if(type == "Box-Pierce") test[k] <- ifelse(n * sum((x.acf[-1])^2) > qchisq(1-p, h), 0, 1) else test[k] <- ifelse(n*(n+2) * sum((x.acf[-1])^2 / (n - h:1)) > qchisq(1-p, h), 0, 1) } return(test) } waveslim/R/two_D.R0000644000176200001440000003763713430347452013526 0ustar liggesusers########################################################################### ########################################################################### ########################################################################### dwt.2d <- function(x, wf, J=4, boundary="periodic") { m <- dim(x)[1] storage.mode(m) <- "integer" n <- dim(x)[2] storage.mode(n) <- "integer" dict <- wave.filter(wf) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf storage.mode(h) <- "double" g <- dict$lpf storage.mode(g) <- "double" z <- matrix(0, m/2, n/2) storage.mode(z) <- "double" x.wt <- vector("list", 3*J+1) x.names <- NULL for(j in 1:J) { out <- .C(C_two_D_dwt, "Image"=as.double(x), "Rows"=m, "Cols"=n, "filter.length"=L, "hpf"=h, "lpf"=g, "LL"=z, "LH"=z, "HL"=z, "HH"=z)[7:10] if(j < J) { index <- (3*j-2):(3*j) x.wt[index] <- out[-1] x.names <- c(x.names, sapply(names(out)[-1], paste, j, sep="")) x <- out[[1]] m <- dim(x)[1] storage.mode(m) <- "integer" n <- dim(x)[2] storage.mode(n) <- "integer" z <- matrix(0, m/2, n/2) storage.mode(z) <- "double" } else { index <- (3*j):(3*(j+1)) - 2 x.wt[index] <- out[c(2:4,1)] x.names <- c(x.names, sapply(names(out)[c(2:4,1)], paste, j, sep="")) } } names(x.wt) <- x.names attr(x.wt, "J") <- J attr(x.wt, "wavelet") <- wf attr(x.wt, "boundary") <- boundary attr(x.wt, "class") <- "dwt.2d" x.wt } ########################################################################### ########################################################################### ########################################################################### idwt.2d <- function(y) { J <- attributes(y)$J dict <- wave.filter(attributes(y)$wavelet) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf storage.mode(h) <- "double" g <- dict$lpf storage.mode(g) <- "double" LL <- paste("LL", J, sep="") y.in <- y[[LL]] for(j in J:1) { LH <- paste("LH", j, sep="") HL <- paste("HL", j, sep="") HH <- paste("HH", j, sep="") m <- dim(y.in)[1] storage.mode(m) <- "integer" n <- dim(y.in)[2] storage.mode(n) <- "integer" x <- matrix(0, 2*m, 2*n) storage.mode(x) <- "double" out <- .C(C_two_D_idwt, as.double(y.in), as.double(y[[LH]]), as.double(y[[HL]]), as.double(y[[HH]]), m, n, L, h, g, "Y"=x) y.in <- out$Y } zapsmall(y.in) } ########################################################################### ########################################################################### ########################################################################### modwt.2d <- function(x, wf, J=4, boundary="periodic") { m <- dim(x)[1] storage.mode(m) <- "integer" n <- dim(x)[2] storage.mode(n) <- "integer" dict <- wave.filter(wf) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf / sqrt(2) storage.mode(h) <- "double" g <- dict$lpf / sqrt(2) storage.mode(g) <- "double" z <- matrix(0, m, n) storage.mode(z) <- "double" x.wt <- vector("list", 3*J+1) x.names <- NULL for(j in 1:J) { out <- .C("two_D_modwt", "Image"=as.double(x), "Rows"=m, "Cols"=n, "Level"=j, "filter.length"=L, "hpf"=h, "lpf"=g, "LL"=z, "LH"=z, "HL"=z, "HH"=z, PACKAGE="waveslim")[8:11] if(j < J) { index <- (3*j-2):(3*j) x.wt[index] <- out[-1] x.names <- c(x.names, sapply(names(out)[-1], paste, j, sep="")) x <- out$LL } else { index <- (3*j):(3*(j+1)) - 2 x.wt[index] <- out[c(2:4,1)] x.names <- c(x.names, sapply(names(out)[c(2:4,1)], paste, j, sep="")) } } names(x.wt) <- x.names attr(x.wt, "J") <- J attr(x.wt, "wavelet") <- wf attr(x.wt, "boundary") <- boundary x.wt } ########################################################################### ########################################################################### ########################################################################### imodwt.2d <- function(y) { J <- attributes(y)$J dict <- wave.filter(attributes(y)$wavelet) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf / sqrt(2) storage.mode(h) <- "double" g <- dict$lpf / sqrt(2) storage.mode(g) <- "double" LL <- paste("LL", J, sep="") y.in <- y[[LL]] for(j in J:1) { LH <- paste("LH", j, sep="") HL <- paste("HL", j, sep="") HH <- paste("HH", j, sep="") m <- dim(y.in)[1] storage.mode(m) <- "integer" n <- dim(y.in)[2] storage.mode(n) <- "integer" x <- matrix(0, m, n) storage.mode(x) <- "double" out <- .C(C_two_D_imodwt, as.double(y.in), as.double(y[[LH]]), as.double(y[[HL]]), as.double(y[[HH]]), m, n, j, L, h, g, "Y"=x) y.in <- out$Y } zapsmall(y.in) } ########################################################################### ########################################################################### ########################################################################### plot.dwt.2d <- function(x, cex.axis=1, plot=TRUE, ...) { J <- attributes(x)$J X <- x[[paste("LL", J, sep="")]] for(j in J:1) { x.names <- sapply(c("LH","HL","HH"), paste, j, sep="") X <- rbind(cbind(X, x[[x.names[2]]]), cbind(x[[x.names[1]]], x[[x.names[3]]])) } M <- dim(X)[1]; N <- dim(X)[2] if(plot) { image(1:M, 1:N, X, col=rainbow(128), axes=FALSE, xlab="", ylab="", ...) x.label <- NULL lines(c(0,N,N,0,0) + 0.5, c(0,0,M,M,0) + 0.5) for(j in J:1) { lines(c(M/2^j,M/2^j) + 0.5, 2*c(0,N/2^j) + 0.5) lines(2*c(0,M/2^j) + 0.5, c(N/2^j,N/2^j) + 0.5) } at <- c((3*N+2)/2^(1:J+1),(N+2)/2^(J+1)) labs <- c(paste("H",1:J,sep=""), paste("L",J,sep="")) axis(side=1, at=at, labels=labs, tick=FALSE, cex.axis=cex.axis) axis(side=2, at=at, labels=labs, tick=FALSE, cex.axis=cex.axis) } else return(X) invisible() } ########################################################################### ########################################################################### ########################################################################### denoise.dwt.2d <- function(x, wf = "la8", J = 4, method = "universal", H = 0.5, noise.dir = 3, rule = "hard") { soft <- function(x, delta) sign(x) * pmax(abs(x) - delta, 0) hard <- function(x, delta) ifelse(abs(x) > delta, x, 0) n <- length(x) x.dwt <- dwt.2d(x, wf, J) if(noise.dir == 3) sigma.mad <- list(HH = mad(x.dwt$HH1), HL = mad(x.dwt$HL1), LH = mad(x.dwt$LH1)) else { noise <- x.dwt$jj sigma.mad <- list(HH = mad(noise), HL = mad(noise), LH = mad(noise)) } thresh <- list(HH = rep(sqrt(2 * sigma.mad$HH^2 * log(n)), J), HL = rep(sqrt(2 * sigma.mad$HL^2 * log(n)), J), LH = rep(sqrt(2 * sigma.mad$LH^2 * log(n)), J)) if(method == "long-memory") thresh <- lapply(thresh, function(x,J,H) 2^(0:(J-1)*(H-1/2))*x, J=J, H=H) for(j in 1:J) { jj <- paste("HL", j, sep = "") if(rule == "hard") x.dwt[[jj]] <- hard(x.dwt[[jj]], thresh$HL[j]) else x.dwt[[jj]] <- soft(x.dwt[[jj]], thresh$HL[j]) jj <- paste("LH", j, sep = "") if(rule == "hard") x.dwt[[jj]] <- hard(x.dwt[[jj]], thresh$LH[j]) else x.dwt[[jj]] <- soft(x.dwt[[jj]], thresh$LH[j]) jj <- paste("HH", j, sep = "") if(rule == "hard") x.dwt[[jj]] <- hard(x.dwt[[jj]], thresh$HH[j]) else x.dwt[[jj]] <- soft(x.dwt[[jj]], thresh$HH[j]) } idwt.2d(x.dwt) } ########################################################################### ########################################################################### ########################################################################### denoise.modwt.2d <- function(x, wf = "la8", J = 4, method = "universal", H = 0.5, rule = "hard") { soft <- function(x, delta) sign(x) * pmax(abs(x) - delta, 0) hard <- function(x, delta) ifelse(abs(x) > delta, x, 0) n <- length(x) x.modwt <- modwt.2d(x, wf, J) sigma.mad <- list(HH = sqrt(2) * mad(x.modwt$HH1), HL = sqrt(2) * mad(x.modwt$HL1), LH = sqrt(2) * mad(x.modwt$LH1)) thresh <- list(HH = rep(sqrt(2 * sigma.mad$HH^2 * log(n))/2^(1:J), J), HL = rep(sqrt(2 * sigma.mad$HL^2 * log(n))/2^(1:J), J), LH = rep(sqrt(2 * sigma.mad$LH^2 * log(n))/2^(1:J), J)) if(method == "long-memory") thresh <- lapply(thresh, function(x,J,H) 2^(0:(J-1)*(H-1/2))*x, J=J, H=H) for(j in 1:J) { jj <- paste("HL", j, sep = "") if(rule == "hard") x.modwt[[jj]] <- hard(x.modwt[[jj]], thresh$HL[j]) else x.modwt[[jj]] <- soft(x.modwt[[jj]], thresh$HL[j]) jj <- paste("LH", j, sep = "") if(rule == "hard") x.modwt[[jj]] <- hard(x.modwt[[jj]], thresh$LH[j]) else x.modwt[[jj]] <- soft(x.modwt[[jj]], thresh$LH[j]) jj <- paste("HH", j, sep = "") if(rule == "hard") x.modwt[[jj]] <- hard(x.modwt[[jj]], thresh$HH[j]) else x.modwt[[jj]] <- soft(x.modwt[[jj]], thresh$HH[j]) } imodwt.2d(x.modwt) } ########################################################################### ########################################################################### ########################################################################### dwpt.2d <- function(x, wf="la8", J=4, boundary="periodic") { ## x <- xbox ## Define image dimensions (assign mode for C) and perform simple ## diagnostics. m <- dim(x)[1] storage.mode(m) <- "integer" n <- dim(x)[2] storage.mode(n) <- "integer" if(log(m, 2) != trunc(log(m, 2)) | log(n, 2) != trunc(log(n, 2))) stop("One dimension is not a power of 2") if(2^J > m | 2^J > n) stop("Wavelet transform exceeds sample size in one dimension of DWPT") ## Extract wavelet and scaling filter coefficients, along with filter ## length, from the filter name provided. dict <- wave.filter(wf) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf storage.mode(h) <- "double" g <- dict$lpf storage.mode(g) <- "double" ## Create names for wavelet packet nodes (quad-tree structure). N <- sum(4^(1:J)) level <- rep(1:J, 4^(1:J)) x.wpt <- vector("list", N) c1 <- rep(1:J, 2^(1:J)) c2 <- unlist(apply(as.matrix(2^(1:J) - 1), 1, seq, from=0)) cry <- paste("w", c1, ".", c2, sep="") x.wpt.names <- NULL for(j in 1:J) { xx <- matrix(cry[c1 == j], 2^j, 2^j) yy <- matrix(cry[c1 == j], 2^j, 2^j, byrow=TRUE) x.wpt.names <- c(x.wpt.names, as.matrix(paste(xx, "-", yy, sep=""))) } names(x.wpt) <- x.wpt.names rm(j,xx,yy,c1,c2,cry) ## Define initial zero matrix to store wavelet sub-images. z <- matrix(0, m/2, n/2) storage.mode(z) <- "double" ## Implement the 2D DWPT in a nested loop structure. for(j in 1:J) { ## cat("j =", j, fill=TRUE) for(k in 0:(4^j/4-1)) { if(j > 1) { ## if j > 1, grab wavelet coefficient image and also its name. index <- min((1:N)[level == j-1]) + k parent <- x.wpt.names[index] ## cat("parent =", parent, fill=TRUE) x <- x.wpt[[parent]] tmp <- unlist(strsplit(parent, "\\-")) } else tmp <- c("w0.0", "w0.0") ## Deconstruct name into nodes for the x and y dimensions. node <- unlist(strsplit(tmp, "\\.")) node <- as.integer(node[-c(1,3)]) ## Preliminary assignments in order to keep wavelet coefficient ## sub-images in sequency order. if(node[1] %% 2 == 0) { Xlow <- paste("w", j, ".", 2 * node[1], sep="") Xhigh <- paste("w", j, ".", 2 * node[1] + 1, sep="") } else { Xlow <- paste("w", j, ".", 2 * node[1] + 1, sep="") Xhigh <- paste("w", j, ".", 2 * node[1], sep="") } if(node[2] %% 2 == 0) { Ylow <- paste("w", j, ".", 2 * node[2], sep="") Yhigh <- paste("w", j, ".", 2 * node[2] + 1, sep="") } else { Ylow <- paste("w", j, ".", 2 * node[2] + 1, sep="") Yhigh <- paste("w", j, ".", 2 * node[2], sep="") } ## Create names for the new wavelet coefficient images. LL <- paste(Xlow, "-", Ylow, sep="") LH <- paste(Xlow, "-", Yhigh, sep="") HL <- paste(Xhigh, "-", Ylow, sep="") HH <- paste(Xhigh, "-", Yhigh, sep="") ## cat(matrix(c(LH,LL,HH,HL), 2, 2), fill=TRUE) ## Perform the DWPT out <- .C(C_two_D_dwt, "Image"=as.double(x), "Rows"=m, "Cols"=n, "filter.length"=L, "hpf"=h, "lpf"=g, "LL"=z, "LH"=z, "HL"=z, "HH"=z)[7:10] ## Pass wavelet coefficient images into the DWPT object. x.wpt[[LL]] <- out[["LL"]] x.wpt[[LH]] <- out[["LH"]] x.wpt[[HL]] <- out[["HL"]] x.wpt[[HH]] <- out[["HH"]] } ## Redefine zero matrix to its new (decimated) size. m <- dim(out[["LL"]])[1] storage.mode(m) <- "integer" n <- dim(out[["LL"]])[2] storage.mode(n) <- "integer" z <- matrix(0, m/2, n/2) storage.mode(z) <- "double" } attr(x.wpt, "J") <- J attr(x.wpt, "wavelet") <- wf attr(x.wpt, "boundary") <- boundary return(x.wpt) } ########################################################################### ########################################################################### ########################################################################### idwpt.2d <- function(y, y.basis) { ## Error checking if(length(y) != length(y.basis)) stop("DWPT object and basis selection must be the same length") ## Number of wavelet scales J <- attributes(y)$J ## Define wavelet/scaling filter coefficients and length dict <- wave.filter(attributes(y)$wavelet) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf storage.mode(h) <- "double" g <- dict$lpf storage.mode(g) <- "double" ## Nested for loops names(y.basis) <- names(y) for(j in J:1) { for(nx in seq(0, 2^j - 1, by = 2)) { for(ny in seq(0, 2^j - 1, by = 2)) { ## Name the four wavelet coefficients sub-images LL <- paste("w", j, ".", nx, "-", "w", j, ".", ny, sep="") LH <- paste("w", j, ".", nx, "-", "w", j, ".", ny+1, sep="") HL <- paste("w", j, ".", nx+1, "-", "w", j, ".", ny, sep="") HH <- paste("w", j, ".", nx+1, "-", "w", j, ".", ny+1, sep="") if(any(y.basis[LL], y.basis[LH], y.basis[HL], y.basis[HH])) { m <- nrow(y[[LL]]) storage.mode(m) <- "integer" n <- ncol(y[[LL]]) storage.mode(n) <- "integer" XX <- matrix(0, 2*m, 2*n) storage.mode(XX) <- "double" ## parent indices to construct string pnx <- floor(nx / 2) pny <- floor(ny / 2) if((pnx %% 2 != 0) & (pny %% 2 != 0)) ## Upper right-hand corner out <- .C(C_two_D_idwt, as.double(y[[HH]]), as.double(y[[HL]]), as.double(y[[LH]]), as.double(y[[LL]]), m, n, L, h, g, "Y"=XX)$Y else { ## Upper left-hand corner if((pnx %% 2 == 0) & (pny %% 2 != 0)) out <- .C(C_two_D_idwt, as.double(y[[LH]]), as.double(y[[LL]]), as.double(y[[HH]]), as.double(y[[HL]]), m, n, L, h, g, "Y"=XX)$Y else { ## Lower right-hand corner if((pnx %% 2 != 0) & (pny %% 2 == 0)) out <- .C(C_two_D_idwt, as.double(y[[HL]]), as.double(y[[HH]]), as.double(y[[LL]]), as.double(y[[LH]]), m, n, L, h, g, "Y"=XX)$Y else { ## Lower left-hand corner if((pnx %% 2 == 0) & (pny %% 2 == 0)) out <- .C(C_two_D_idwt, as.double(y[[LL]]), as.double(y[[LH]]), as.double(y[[HL]]), as.double(y[[HH]]), m, n, L, h, g, "Y"=XX)$Y else stop("Ouch!") } } } if(j > 1) { pname <- paste("w", j-1, ".", pnx, "-", "w", j-1, ".", pny, sep="") y[[pname]] <- out y.basis[pname] <- 1 } } } } } return(out) } waveslim/R/fdp.R0000644000176200001440000000310613430347451013202 0ustar liggesusersfdp.mle <- function(y, wf, J=log(length(y),2)) { fdpML <- function(d, y) { y.dwt <- y[[1]] n <- y[[2]] J <- y[[3]] ## Establish the limits of integration for the band-pass variances a <- c(1/2^c(1:J+1), 0) b <- 1/2^c(0:J+1) ## Define some useful parameters for computing the likelihood length.j <- n / c(2^(1:J), 2^J) scale.j <- c(2^(1:J+1), 2^(J+1)) ## Initialize various parameters for computing the approximate ML bp.var <- numeric(J+1) ## Compute the band-pass variances according to d omega.diag <- NULL for(j in 1:(J+1)) { bp.var[j] <- integrate(fdp.sdf, a[j], b[j], d=d)$value omega.diag <- c(omega.diag, scale.j[j] * rep(bp.var[j], length.j[j])) } ## Compute approximate maximum likelihood n * log(sum(y.dwt^2 / omega.diag) / n) + sum(length.j * log(scale.j * bp.var)) } n <- length(y) y.dwt <- as.vector(unlist(dwt(y, wf, n.levels=J))) ## Compute MLE of d (limited to stationary region) result <- optimize(fdpML, interval=c(-0.5,0.5), maximum=FALSE, y=list(y.dwt, n, J)) ## Compute MLE of sigma_epsilon^2 a <- c(1/2^c(1:J+1), 0) b <- 1/2^c(0:J+1) length.j <- n / c(2^(1:J), 2^J) scale.j <- c(2^(1:J+1), 2^(J+1)) bp.var <- numeric(J+1) omega.diag <- NULL for(j in 1:(J+1)) { bp.var[j] <- integrate(fdp.sdf, a[j], b[j], d=result$minimum)$value omega.diag <- c(omega.diag, scale.j[j] * rep(bp.var[j], length.j[j])) } sigma2 <- sum(y.dwt^2 / omega.diag) / n list(parameters=c(result$minimum, sigma2), objective=result$objective) } waveslim/R/multiple.R0000644000176200001440000000700313430347451014264 0ustar liggesusersrotcumvar <- function(x) { x <- x[!is.na(x)] n <- length(x) plus <- 1:n/(n-1) - cumsum(x^2)/sum(x^2) minus <- cumsum(x^2)/sum(x^2) - 0:(n-1)/(n-1) pmax(abs(plus), abs(minus)) } testing.hov <- function(x, wf, J, min.coef=128, debug=FALSE) { n <- length(x) change.points <- NULL x.dwt <- dwt(x, wf, J) x.dwt.bw <- brick.wall(x.dwt, wf, method="dwt") x.modwt <- modwt(x, wf, J) x.modwt.bw <- brick.wall(x.modwt, wf) for(j in 1:J) { cat("##### Level ", j, " #####", fill=TRUE) Nj <- n/2^j dwt.list <- list(dwt = (x.dwt.bw[[j]])[!is.na(x.dwt.bw[[j]])], left = min((1:Nj)[!is.na(x.dwt.bw[[j]])]) + 1, right = sum(!is.na(x.dwt.bw[[j]]))) modwt.list <- list(modwt = (x.modwt.bw[[j]])[!is.na(x.modwt.bw[[j]])], left = min((1:n)[!is.na(x.modwt.bw[[j]])]) + 1, right = sum(!is.na(x.modwt.bw[[j]]))) if(debug) cat("Starting recursion; using", dwt.list$left, "to", dwt.list$right - 1, "... ") change.points <- rbind(change.points, mult.loc(dwt.list, modwt.list, wf, j, min.coef, debug)) } dimnames(change.points) <- list(NULL, c("level", "crit.value", "loc.dwt", "loc.modwt")) return(change.points) } mult.loc <- function(dwt.list, modwt.list, wf, level, min.coef, debug) { Nj <- length(dwt.list$dwt) N <- length(modwt.list$modwt) crit <- 1.358 change.points <- NULL if(Nj > min.coef) { ## test statistic using the DWT P <- cumsum(dwt.list$dwt^2) / sum(dwt.list$dwt^2) test.stat <- pmax((1:Nj) / (Nj-1) - P, P - (1:Nj - 1) / (Nj-1)) loc.dwt <- (1:Nj)[max(test.stat) == test.stat] test.stat <- max(test.stat) ## location using the MODWT P <- cumsum(modwt.list$modwt^2) / sum(modwt.list$modwt^2) loc.stat <- pmax((1:N) / (N-1) - P, P - (1:N - 1) / (N-1)) loc.modwt <- (1:N)[max(loc.stat) == loc.stat] if(test.stat > sqrt(2) * crit / sqrt(Nj)) { if(debug) cat("Accepted!", fill=TRUE) ## Left if(debug) cat("Going left; using", dwt.list$left, "to", loc.dwt + dwt.list$left - 1, "... ") temp.dwt.list <- list(dwt = dwt.list$dwt[1:(loc.dwt-1)], left = dwt.list$left, right = loc.dwt + dwt.list$left - 1) temp.modwt.list <- list(modwt = modwt.list$modwt[1:(loc.modwt-1)], left = modwt.list$left, right = loc.modwt + modwt.list$left - 1) change.points <- rbind(c(level, test.stat, loc.dwt + dwt.list$left, loc.modwt + modwt.list$left), Recall(temp.dwt.list, temp.modwt.list, wf, level, min.coef, debug)) ## Right if(debug) cat("Going right; using", loc.dwt + dwt.list$left + 1, "to", dwt.list$right, "... ") temp.dwt.list <- list(dwt = dwt.list$dwt[(loc.dwt+1):Nj], left = loc.dwt + dwt.list$left + 1, right = dwt.list$right) temp.modwt.list <- list(modwt = modwt.list$modwt[(loc.modwt+1):N], left = loc.modwt + modwt.list$left + 1, right = modwt.list$right) change.points <- rbind(change.points, Recall(temp.dwt.list, temp.modwt.list, wf, level, min.coef, debug)) } else if(debug) cat("Rejected!", fill=TRUE) } else if(debug) cat("Sample size does not exceed ", min.coef, "!", sep="", fill=TRUE) return(change.points) } waveslim/R/zzz.R0000644000176200001440000000054313430347452013271 0ustar liggesusers## .First.lib <- function(lib, pkg) library.dynam("waveslim", pkg, lib) .onAttach <- function(lib, pkg) { txt <- paste("\n", pkg, ": Wavelet Method for 1/2/3D Signals (version = ", utils::packageDescription(pkg, lib)[["Version"]], ")\n", sep="") packageStartupMessage(txt) } waveslim/R/dualtree.R0000644000176200001440000001144313430347451014241 0ustar liggesusersdualfilt1 <- function() { af1 <- c(0.03516384000000, 0, 0, 0, -0.08832942000000, -0.11430184000000, 0.23389032000000, 0, 0.76027237000000, 0.58751830000000, 0.58751830000000, -0.76027237000000, 0, 0.23389032000000, -0.11430184000000, 0.08832942000000, 0, 0, 0, -0.03516384000000) af1 <- matrix(af1, ncol=2, byrow=TRUE) af2 <- c(0, -0.03516384000000, 0, 0, -0.11430184000000, 0.08832942000000, 0, 0.23389032000000, 0.58751830000000, -0.76027237000000, 0.76027237000000, 0.58751830000000, 0.23389032000000, 0, -0.08832942000000, -0.11430184000000, 0, 0, 0.03516384000000, 0) af2 <- matrix(af2, ncol=2, byrow=TRUE) sf1 <- af1[nrow(af1):1, ] sf2 <- af2[nrow(af2):1, ] list(af = list(af1, af2), sf = list(sf1, sf2)) } FSfarras <- function() { af1 <- c(0, 0, -0.08838834764832, -0.01122679215254, 0.08838834764832, 0.01122679215254, 0.69587998903400, 0.08838834764832, 0.69587998903400, 0.08838834764832, 0.08838834764832, -0.69587998903400, -0.08838834764832, 0.69587998903400, 0.01122679215254, -0.08838834764832, 0.01122679215254, -0.08838834764832, 0, 0) af1 <- matrix(af1, ncol=2, byrow=TRUE) sf1 <- af1[nrow(af1):1, ] af2 <- c(0.01122679215254, 0, 0.01122679215254, 0, -0.08838834764832, -0.08838834764832, 0.08838834764832, -0.08838834764832, 0.69587998903400, 0.69587998903400, 0.69587998903400, -0.69587998903400, 0.08838834764832, 0.08838834764832, -0.08838834764832, 0.08838834764832, 0, 0.01122679215254, 0, -0.01122679215254) af2 <- matrix(af2, ncol=2, byrow=TRUE) sf2 <- af2[nrow(af2):1, ] list(af = list(af1, af2), sf = list(sf1, sf2)) } farras <- function() { af <- c(0, -0.01122679215254, 0, 0.01122679215254, -0.08838834764832, 0.08838834764832, 0.08838834764832, 0.08838834764832, 0.69587998903400, -0.69587998903400, 0.69587998903400, 0.69587998903400, 0.08838834764832, -0.08838834764832, -0.08838834764832, -0.08838834764832, 0.01122679215254, 0, 0.01122679215254, 0) af <- matrix(af, nrow=10, byrow=TRUE) sf <- af[nrow(af):1, ] list(af = af, sf = sf) } cshift <- function(x, m) { N <- length(x) n <- 0:(N-1) n <- (n-m) %% N y <- x[n+1] y } afb <- function(x, af) { N <- length(x) L <- nrow(af)/2 x <- cshift(x,-L) ## lowpass filter lo <- convolve(x, af[,1], conj=FALSE, type="open") lo <- cshift(lo,-(2*L-1)) lo <- lo[seq(1, length(lo), by=2)] lo[1:L] <- lo[N/2+(1:L)] + lo[1:L] lo <- lo[1:(N/2)] ## highpass filter hi <- convolve(x, af[,2], conj=FALSE, type="open") hi <- cshift(hi,-(2*L-1)) hi <- hi[seq(1, length(hi), by=2)] hi[1:L] <- hi[N/2+(1:L)] + hi[1:L] hi <- hi[1:(N/2)] list(lo = lo, hi = hi) } dualtree <- function(x, J, Faf, af) { ## normalization x <- x/sqrt(2) w <- vector("list", J+1) ## Tree 1 w[[1]] <- vector("list", 2) temp <- afb(x, Faf[[1]]) x1 <- temp$lo w[[1]][[1]] <- temp$hi if(J > 1) { for(j in 2:J) { w[[j]] <- vector("list", 2) temp <- afb(x1, af[[1]]) x1 <- temp$lo w[[j]][[1]] <- temp$hi } } w[[J+1]] <- vector("list", 2) w[[J+1]][[1]] <- x1 ## Tree 2 temp <- afb(x, Faf[[2]]) x2 <- temp$lo w[[1]][[2]] <- temp$hi if(J > 1) { for(j in 2:J) { temp <- afb(x2, af[[2]]) x2 <- temp$lo w[[j]][[2]] <- temp$hi } } w[[J+1]][[2]] <- x2 w } sfb <- function(lo, hi, sf) { N <- 2*length(lo) L <- nrow(sf) ## lo <- upfirdn(lo, sf[,1], 2, 1) lo <- c(matrix(c(rep(0, N/2), lo), nrow=2, byrow=TRUE)) lo <- convolve(lo, sf[,1], conj=FALSE, type="open") lo <- cshift(lo, -L) ## hi <- upfirdn(hi, sf[,2], 2, 1) hi <- c(matrix(c(rep(0, N/2), hi), nrow=2, byrow=TRUE)) hi <- convolve(hi, sf[,2], conj=FALSE, type="open") hi <- cshift(hi, -L) y <- lo + hi y[1:(L-2)] <- y[1:(L-2)] + y[N+1:(L-2)] y <- y[1:N] ## y = cshift(y, 1-L/2); y <- cshift(y, 1-L/2) y } idualtree <- function(w, J, Fsf, sf) { ## Tree 1 y1 <- w[[J+1]][[1]] if(J > 1) { for(j in J:2) { y1 <- sfb(y1, w[[j]][[1]], sf[[1]]) } } y1 <- sfb(y1, w[[1]][[1]], Fsf[[1]]) ## Tree 2 y2 <- w[[J+1]][[2]] if(J > 1) { for(j in J:2) { y2 <- sfb(y2, w[[j]][[2]], sf[[2]]) } } y2 <- sfb(y2, w[[1]][[2]], Fsf[[2]]) ## normalization y <- (y1 + y2)/sqrt(2) y } waveslim/R/wave.filter.R0000644000176200001440000001752613430347452014673 0ustar liggesuserswave.filter <- function(name) { select.haar <- function() { L <- 2 g <- c(0.7071067811865475, 0.7071067811865475) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.d4 <- function() { L <- 4 g <- c(0.4829629131445341, 0.8365163037378077, 0.2241438680420134, -0.1294095225512603) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.mb4 <- function() { L <- 4 g <- c(4.801755e-01, 8.372545e-01, 2.269312e-01, -1.301477e-01) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.bs3.1 <- function() { L <- 4 g <- c(0.1767767, 0.5303301, 0.5303301, 0.1767767) h <- qmf(g) gd <- c(0.3535534, 1.06066, -1.06066, -0.3535534) hd <- qmf(g) return(list(length = L, hpf = h, lpf = g, dhpf = hd, dlpf = gd)) } select.w4 <- function() { L <- 4 g <- c(-1, 3, 3, -1) / 8 h <- c(-1, 3, -3, 1) / 8 return(list(length = L, hpf = h, lpf = g)) } select.fk4 <- function() { L <- 4 g <- c(.6539275555697651, .7532724928394872, .5317922877905981e-1, -.4616571481521770e-1) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.d6 <- function() { L <- 6 g <- c(0.3326705529500827, 0.8068915093110928, 0.4598775021184915, -0.1350110200102546, -0.0854412738820267, 0.0352262918857096) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.fk6 <- function() { L <- 6 g <- c(.4279150324223103, .8129196431369074, .3563695110701871, -.1464386812725773, -.7717775740697006e-1, .4062581442323794e-1) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.d8 <- function() { L <- 8 g <- c(0.2303778133074431, 0.7148465705484058, 0.6308807679358788, -0.0279837694166834, -0.1870348117179132, 0.0308413818353661, 0.0328830116666778, -0.0105974017850021) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.fk8 <- function() { L <- 8 g <- c(.3492381118637999, .7826836203840648, .4752651350794712, -.9968332845057319e-1, -.1599780974340301, .4310666810651625e-1, .4258163167758178e-1, -.1900017885373592e-1) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.la8 <- function() { L <- 8 g <- c(-0.07576571478935668, -0.02963552764596039, 0.49761866763256290, 0.80373875180538600, 0.29785779560560505, -0.09921954357695636, -0.01260396726226383, 0.03222310060407815) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.mb8 <- function() { L <- 8 g <- rev(c(-1.673619e-01, 1.847751e-02, 5.725771e-01, 7.351331e-01, 2.947855e-01, -1.108673e-01, 7.106015e-03, 6.436345e-02)) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.bl14 <- function() { L <- 14 g <- c( 0.0120154192834842, 0.0172133762994439, -0.0649080035533744, -0.0641312898189170, 0.3602184608985549, 0.7819215932965554, 0.4836109156937821, -0.0568044768822707, -0.1010109208664125, 0.0447423494687405, 0.0204642075778225, -0.0181266051311065, -0.0032832978473081, 0.0022918339541009) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.fk14 <- function() { L <- 14 g <- c(.2603717692913964, .6868914772395985, .6115546539595115, .5142165414211914e-1, -.2456139281621916, -.4857533908585527e-1, .1242825609215128, .2222673962246313e-1, -.6399737303914167e-1, -.5074372549972850e-2, .2977971159037902e-1, -.3297479152708717e-2, -.9270613374448239e-2, .3514100970435962e-2) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.d16 <- function() { L <- 16 g <- c(0.0544158422431049, 0.3128715909143031, 0.6756307362972904, 0.5853546836541907, -0.0158291052563816, -0.2840155429615702, 0.0004724845739124, 0.1287474266204837, -0.0173693010018083, -0.0440882539307952, 0.0139810279173995, 0.0087460940474061, -0.0048703529934518, -0.0003917403733770, 0.0006754494064506, -0.0001174767841248) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.la16 <- function() { L <- 16 g <- c(-0.0033824159513594, -0.0005421323316355, 0.0316950878103452, 0.0076074873252848, -0.1432942383510542, -0.0612733590679088, 0.4813596512592012, 0.7771857516997478, 0.3644418948359564, -0.0519458381078751, -0.0272190299168137, 0.0491371796734768, 0.0038087520140601, -0.0149522583367926, -0.0003029205145516, 0.0018899503329007) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.mb16 <- function() { L <- 16 g <- rev(c(-1.302770e-02, 2.173677e-02, 1.136116e-01, -5.776570e-02, -2.278359e-01, 1.188725e-01, 6.349228e-01, 6.701646e-01, 2.345342e-01, -5.656657e-02, -1.987986e-02, 5.474628e-02, -2.483876e-02, -4.984698e-02, 9.620427e-03, 5.765899e-03)) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.la20 <- function() { L <- 20 g <- c(0.0007701598091030, 0.0000956326707837, -0.0086412992759401, -0.0014653825833465, 0.0459272392237649, 0.0116098939129724, -0.1594942788575307, -0.0708805358108615, 0.4716906668426588, 0.7695100370143388, 0.3838267612253823, -0.0355367403054689, -0.0319900568281631, 0.0499949720791560, 0.0057649120455518, -0.0203549398039460, -0.0008043589345370, 0.0045931735836703, 0.0000570360843390, -0.0004593294205481) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.bl20 <- function() { L <- 20 g <- c(0.0008625782242896, 0.0007154205305517, -0.0070567640909701, 0.0005956827305406, 0.0496861265075979, 0.0262403647054251, -0.1215521061578162, -0.0150192395413644, 0.5137098728334054, 0.7669548365010849, 0.3402160135110789, -0.0878787107378667, -0.0670899071680668, 0.0338423550064691, -0.0008687519578684, -0.0230054612862905, -0.0011404297773324, 0.0050716491945793, 0.0003401492622332, -0.0004101159165852) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.fk22 <- function() { L <- 22 g <- c(.1938961077599566, .5894521909294277, .6700849629420265, .2156298491347700, -.2280288557715772, -.1644657152688429, .1115491437220700, .1101552649340661, -.6608451679377920e-1, -.7184168192312605e-1, .4354236762555708e-1, .4477521218440976e-1, -.2974288074927414e-1, -.2597087308902119e-1, .2028448606667798e-1, .1296424941108978e-1, -.1288599056244363e-1, -.4838432636440189e-2, .7173803165271690e-2, .3612855622194901e-3, -.2676991638581043e-2, .8805773686384639e-3) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.mb24 <- function() { L <- 24 g <- rev(c(-2.132706e-05, 4.745736e-04, 7.456041e-04, -4.879053e-03, -1.482995e-03, 4.199576e-02, -2.658282e-03, -6.559513e-03, 1.019512e-01, 1.689456e-01, 1.243531e-01, 1.949147e-01, 4.581101e-01, 6.176385e-01, 2.556731e-01, -3.091111e-01, -3.622424e-01, -4.575448e-03, 1.479342e-01, 1.027154e-02, -1.644859e-02, -2.062335e-03, 1.193006e-03, 5.361301e-05)) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } switch(name, "haar" = select.haar(), "d4" = select.d4(), "mb4" = select.mb4(), "w4" = select.w4(), "bs3.1" = select.bs3.1(), "fk4" = select.fk4(), "d6" = select.d6(), "fk6" = select.fk6(), "d8" = select.d8(), "fk8" = select.fk8(), "la8" = select.la8(), "mb8" = select.mb8(), "bl14" = select.bl14(), "fk14" = select.fk14(), "d16" = select.d16(), "la16" = select.la16(), "mb16" = select.mb16(), "la20" = select.la20(), "bl20" = select.bl20(), "fk22" = select.fk22(), "mb24" = select.mb24(), stop("Invalid selection for wave.filter")) } qmf <- function(g, low2high = TRUE) { L <- length(g) if(low2high) h <- (-1)^(0:(L - 1)) * rev(g) else h <- (-1)^(1:L) * rev(g) return(h) } waveslim/R/three_D.R0000644000176200001440000002120213430347452014001 0ustar liggesusers########################################################################### ########################################################################### ########################################################################### dwt.3d <- function(x, wf, J=4, boundary="periodic") { nx <- dim(x)[1] storage.mode(nx) <- "integer" ny <- dim(x)[2] storage.mode(ny) <- "integer" nz <- dim(x)[3] storage.mode(nz) <- "integer" dict <- wave.filter(wf) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf storage.mode(h) <- "double" g <- dict$lpf storage.mode(g) <- "double" z <- array(0, dim=c(nx,ny,nz)/2) storage.mode(z) <- "double" x.wt <- vector("list", 7*J+1) x.names <- NULL for(j in 1:J) { out <- .C(C_three_D_dwt, "cube"=as.double(x), "NX"=nx, "NY"=ny, "NZ"=nz, "filter.length"=L, "hpf"=h, "lpf"=g, "LLL"=z, "HLL"=z, "LHL"=z, "LLH"=z, "HHL"=z, "HLH"=z, "LHH"=z, "HHH"=z)[8:15] if(j < J) { index <- (7*(j-1)+1):(7*j) x.wt[index] <- out[-1] x.names <- c(x.names, sapply(names(out)[-1], paste, j, sep="")) x <- out[[1]] nx <- dim(x)[1] storage.mode(nx) <- "integer" ny <- dim(x)[2] storage.mode(ny) <- "integer" nz <- dim(x)[3] storage.mode(nz) <- "integer" z <- array(0, dim=c(nx,ny,nz)/2) storage.mode(z) <- "double" } else { index <- (7*(j-1)+1):(7*j+1) x.wt[index] <- out[c(2:8,1)] x.names <- c(x.names, sapply(names(out)[c(2:8,1)], paste, j, sep="")) } } names(x.wt) <- x.names class(x.wt) <- "dwt.3d" attr(x.wt, "J") <- J attr(x.wt, "wavelet") <- wf attr(x.wt, "boundary") <- boundary return(x.wt) } ########################################################################### ########################################################################### ########################################################################### idwt.3d <- function(y) { J <- attributes(y)$J LLL <- paste("LLL", J, sep="") wf <- attributes(y)$wavelet dict <- wave.filter(wf) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf storage.mode(h) <- "double" g <- dict$lpf storage.mode(g) <- "double" y.in <- y$LLL for(j in J:1) { HLL <- paste("HLL", j, sep="") LHL <- paste("LHL", j, sep="") LLH <- paste("LLH", j, sep="") HHL <- paste("HHL", j, sep="") HLH <- paste("HLH", j, sep="") LHH <- paste("LHH", j, sep="") HHH <- paste("HHH", j, sep="") nx <- dim(y.in)[1] storage.mode(nx) <- "integer" ny <- dim(y.in)[2] storage.mode(ny) <- "integer" nz <- dim(y.in)[3] storage.mode(nz) <- "integer" z <- array(0, dim=2*c(nx, ny, nz)) storage.mode(z) <- "double" out <- .C(C_three_D_idwt, as.double(y.in), as.double(y[[HLL]]), as.double(y[[LHL]]), as.double(y[[LLH]]), as.double(y[[HHL]]), as.double(y[[HLH]]), as.double(y[[LHH]]), as.double(y[[HHH]]), nx, ny, nz, L, h, g, "Y"=z) y.in <- out$Y } zapsmall(y.in) } ########################################################################### ########################################################################### ########################################################################### modwt.3d <- function(x, wf, J=4, boundary="periodic") { nx <- dim(x)[1] storage.mode(nx) <- "integer" ny <- dim(x)[2] storage.mode(ny) <- "integer" nz <- dim(x)[3] storage.mode(nz) <- "integer" dict <- wave.filter(wf) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf / sqrt(2) storage.mode(h) <- "double" g <- dict$lpf / sqrt(2) storage.mode(g) <- "double" z <- array(0, dim=c(nx,ny,nz)) storage.mode(z) <- "double" x.wt <- vector("list", 7*J+1) x.names <- NULL for(j in 1:J) { out <- .C(C_three_D_modwt, "cube"=as.double(x), "NX"=nx, "NY"=ny, "NZ"=nz, "J"=j, "filter.length"=L, "hpf"=h, "lpf"=g, "LLL"=z, "HLL"=z, "LHL"=z, "LLH"=z, "HHL"=z, "HLH"=z, "LHH"=z, "HHH"=z)[9:16] if(j < J) { index <- (7*(j-1)+1):(7*j) x.wt[index] <- out[-1] x.names <- c(x.names, sapply(names(out)[-1], paste, j, sep="")) x <- out[[1]] nx <- dim(x)[1] storage.mode(nx) <- "integer" ny <- dim(x)[2] storage.mode(ny) <- "integer" nz <- dim(x)[3] storage.mode(nz) <- "integer" z <- array(0, dim=c(nx,ny,nz)) storage.mode(z) <- "double" } else { index <- (7*(j-1)+1):(7*j+1) x.wt[index] <- out[c(2:8,1)] x.names <- c(x.names, sapply(names(out)[c(2:8,1)], paste, j, sep="")) } } names(x.wt) <- x.names class(x.wt) <- "modwt.3d" attr(x.wt, "J") <- J attr(x.wt, "wavelet") <- wf attr(x.wt, "boundary") <- boundary return(x.wt) } ########################################################################### ########################################################################### ########################################################################### imodwt.3d <- function(y) { J <- attributes(y)$J LLL <- paste("LLL", J, sep="") wf <- attributes(y)$wavelet dict <- wave.filter(wf) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf / sqrt(2) storage.mode(h) <- "double" g <- dict$lpf / sqrt(2) storage.mode(g) <- "double" y.in <- y$LLL for(j in J:1) { HLL <- paste("HLL", j, sep="") LHL <- paste("LHL", j, sep="") LLH <- paste("LLH", j, sep="") HHL <- paste("HHL", j, sep="") HLH <- paste("HLH", j, sep="") LHH <- paste("LHH", j, sep="") HHH <- paste("HHH", j, sep="") nx <- dim(y.in)[1] storage.mode(nx) <- "integer" ny <- dim(y.in)[2] storage.mode(ny) <- "integer" nz <- dim(y.in)[3] storage.mode(nz) <- "integer" z <- array(0, dim=c(nx, ny, nz)) storage.mode(z) <- "double" out <- .C(C_three_D_imodwt, as.double(y.in), as.double(y[[HLL]]), as.double(y[[LHL]]), as.double(y[[LLH]]), as.double(y[[HHL]]), as.double(y[[HLH]]), as.double(y[[LHH]]), as.double(y[[HHH]]), nx, ny, nz, j, L, h, g, "Y"=z) y.in <- out$Y } zapsmall(y.in) } ########################################################################### ########################################################################### ########################################################################### mra.3d <- function(x, wf="la8", J=4, method="modwt", boundary="periodic") { nx <- dim(x)[1] ny <- dim(x)[2] nz <- dim(x)[3] if(method == "modwt") { x.wt <- modwt.3d(x, wf, J, "periodic") } else { x.wt <- dwt.3d(x, wf, J, "periodic") } x.mra <- vector("list", 7*J+1) names(x.mra) <- c(matrix(rbind(paste("HLL", 1:J, sep=""), paste("LHL", 1:J, sep=""), paste("LLH", 1:J, sep=""), paste("HHL", 1:J, sep=""), paste("HLH", 1:J, sep=""), paste("LHH", 1:J, sep=""), paste("HHH", 1:J, sep="")), nrow=1), paste("LLL", J, sep="")) ## Smooth zero <- vector("list", 7*J+1) names(zero) <- names(x.mra) attr(zero, "J") <- J attr(zero, "wavelet") <- wf attr(zero, "boundary") <- boundary zero[[7*J+1]] <- x.wt[[7*J+1]] if(method == "modwt") { class(x.wt) <- "modwt.3d" for(k in 1:(7*J)) zero[[k]] <- array(0, dim=c(nx,ny,nz)) x.mra[[7*J+1]] <- imodwt.3d(zero) } else { class(x.wt) <- "dwt.3d" for(k in 1:J) zero[[7*(k-1)+1]] <- zero[[7*(k-1)+2]] <- zero[[7*(k-1)+3]] <- zero[[7*(k-1)+4]] <- zero[[7*(k-1)+5]] <- zero[[7*(k-1)+6]] <- zero[[7*k]] <- array(0, dim=c(nx,ny,nz)/2^k) x.mra[[7*J+1]] <- idwt.3d(zero) } ## Details for(j in (7*J):1) { Jj <- ceiling(j/7) zero <- vector("list", 7*Jj+1) names(zero) <- c(matrix(rbind(paste("HLL", 1:Jj, sep=""), paste("LHL", 1:Jj, sep=""), paste("LLH", 1:Jj, sep=""), paste("HHL", 1:Jj, sep=""), paste("HLH", 1:Jj, sep=""), paste("LHH", 1:Jj, sep=""), paste("HHH", 1:Jj, sep="")), nrow=1), paste("LLL", Jj, sep="")) attr(zero, "J") <- Jj attr(zero, "wavelet") <- wf attr(zero, "boundary") <- boundary zero[[j]] <- x.wt[[j]] if(method == "modwt") { for(k in names(zero)[-charmatch(names(zero)[j], names(zero))]) zero[[k]] <- array(0, dim=c(nx,ny,nz)) x.mra[[j]] <- imodwt.3d(zero) } else { for(k in 1:Jj) zero[[7*(k-1)+1]] <- zero[[7*(k-1)+2]] <- zero[[7*(k-1)+3]] <- zero[[7*(k-1)+4]] <- zero[[7*(k-1)+5]] <- zero[[7*(k-1)+6]] <- zero[[7*k]] <- array(0, dim=c(nx,ny,nz)/2^k) zero[[7*Jj+1]] <- array(0, dim=c(nx,ny,nz)/2^Jj) zero[[j]] <- x.wt[[j]] x.mra[[j]] <- idwt.3d(zero) } } return(x.mra) } waveslim/R/up.sample.R0000644000176200001440000000016013430347452014333 0ustar liggesusersup.sample <- function(x, f, y=NA) { n <- length(x) as.vector(rbind(x, matrix(rep(y, (f-1)*n), nrow=f-1))) } waveslim/R/Anton.R0000644000176200001440000000505513430347451013515 0ustar liggesusersAntonB <- function() { a0 <- c(0, 0.02674875741081, -0.01686411844287, -0.07822326652899, 0.26686411844288, 0.60294901823636, 0.26686411844287, -0.07822326652899, -0.01686411844287, 0.02674875741081, 0, 0) a1 <- c(0, 0, 0, 0.04563588155712, -0.02877176311425, -0.29563588155712, 0.55754352622850, -0.29563588155713, -0.02877176311425, 0.04563588155712, 0, 0) s0 <- c(0, 0, 0, -0.04563588155712, -0.02877176311425, 0.29563588155712, 0.55754352622850, 0.29563588155713, -0.02877176311425, -0.04563588155712, 0, 0) s1 <- c(0, 0.02674875741081, 0.01686411844287, -0.07822326652899, -0.26686411844288, 0.60294901823636, -0.26686411844287, -0.07822326652899, 0.01686411844287, 0.02674875741081, 0, 0) s0 <- 2 * s0 s1 <- 2 * s1 aa0 <- c(0, 0, 0.02674875741081, -0.01686411844287, -0.07822326652899, 0.26686411844288, 0.60294901823636, 0.26686411844287, -0.07822326652899, -0.01686411844287, 0.02674875741081, 0) aa1 <- c(0, 0, 0, 0, 0.04563588155712, -0.02877176311425, -0.29563588155712, 0.55754352622850, -0.29563588155713, -0.02877176311425, 0.04563588155712, 0) ss0 <- c(0, 0, -0.04563588155712, -0.02877176311425, 0.29563588155712, 0.55754352622850, 0.29563588155713, -0.02877176311425, -0.04563588155712, 0, 0, 0) ss1 <- c(0.02674875741081, 0.01686411844287, -0.07822326652899, -0.26686411844288, 0.60294901823636, -0.26686411844287, -0.07822326652899, 0.01686411844287, 0.02674875741081, 0, 0, 0) ss0 <- 2 * ss0 ss1 <- 2 * ss1 list(af = list(cbind(a0, a1), cbind(aa0, aa1)), sf = list(cbind(s0, s1), cbind(ss0, ss1))) } waveslim/R/soft.R0000644000176200001440000000012113430347452013377 0ustar liggesuserssoft <- function(x, T) { y <- max(abs(x) - T, 0) return(y/(y+T) * x) } waveslim/R/cplxdual2D.R0000644000176200001440000000551513621323172014435 0ustar liggesuserscplxdual2D <- function(x, J, Faf, af) { ## Dual-Tree Complex 2D Discrete Wavelet Transform ## ## USAGE: ## w = cplxdual2D(x, J, Faf, af) ## INPUT: ## x - 2-D array ## J - number of stages ## Faf{i}: first stage filters for tree i ## af{i}: filters for remaining stages on tree i ## OUTPUT: ## w{j}{i}{d1}{d2} - wavelet coefficients ## j = 1..J (scale) ## i = 1 (real part); i = 2 (imag part) ## d1 = 1,2; d2 = 1,2,3 (orientations) ## w{J+1}{m}{n} - lowpass coefficients ## d1 = 1,2; d2 = 1,2 ## EXAMPLE: ## x = rand(256); ## J = 5; ## [Faf, Fsf] = FSfarras; ## [af, sf] = dualfilt1; ## w = cplxdual2D(x, J, Faf, af); ## y = icplxdual2D(w, J, Fsf, sf); ## err = x - y; ## max(max(abs(err))) ## ## WAVELET SOFTWARE AT POLYTECHNIC UNIVERSITY, BROOKLYN, NY ## http://eeweb.poly.edu/iselesni/WaveletSoftware/ ## normalization x <- x/2 w <- vector("list", J+1) for (m in 1:2) { w[[1]][[m]] <- vector("list", 2) for (n in 1:2) { w[[1]][[m]][[n]] <- vector("list", 2) temp <- afb2D(x, Faf[[m]], Faf[[n]]) lo <- temp$lo w[[1]][[m]][[n]] <- temp$hi if (J > 1) { for (j in 2:J) { temp <- afb2D(lo, af[[m]], af[[n]]) lo <- temp$lo w[[j]][[m]][[n]] <- temp$hi } w[[J+1]][[m]][[n]] <- lo } } } for (j in 1:J) { for (m in 1:3) { w[[j]][[1]][[1]][[m]] <- pm(w[[j]][[1]][[1]][[m]]) w[[j]][[2]][[2]][[m]] <- pm(w[[j]][[2]][[2]][[m]]) w[[j]][[1]][[2]][[m]] <- pm(w[[j]][[1]][[2]][[m]]) w[[j]][[2]][[1]][[m]] <- pm(w[[j]][[2]][[1]][[m]]) } } return(w) } icplxdual2D <- function(w, J, Fsf, sf) { ## Inverse Dual-Tree Complex 2D Discrete Wavelet Transform ## ## USAGE: ## y = icplxdual2D(w, J, Fsf, sf) ## INPUT: ## w - wavelet coefficients ## J - number of stages ## Fsf - synthesis filters for final stage ## sf - synthesis filters for preceeding stages ## OUTPUT: ## y - output array ## See cplxdual2D ## ## WAVELET SOFTWARE AT POLYTECHNIC UNIVERSITY, BROOKLYN, NY ## http://eeweb.poly.edu/iselesni/WaveletSoftware/ for (j in 1:J) { for (m in 1:3) { w[[j]][[1]][[1]][[m]] <- pm(w[[j]][[1]][[1]][[m]]) w[[j]][[2]][[2]][[m]] <- pm(w[[j]][[2]][[2]][[m]]) w[[j]][[1]][[2]][[m]] <- pm(w[[j]][[1]][[2]][[m]]) w[[j]][[2]][[1]][[m]] <- pm(w[[j]][[2]][[1]][[m]]) } } y <- matrix(0, 2*nrow(w[[1]][[1]][[1]][[1]]), 2*ncol(w[[1]][[1]][[1]][[1]])) for (m in 1:2) { for (n in 1:2) { lo <- w[[J+1]][[m]][[n]] if (J > 1) { for (j in J:2) { lo <- sfb2D(lo, w[[j]][[m]][[n]], sf[[m]], sf[[n]]) } lo <- sfb2D(lo, w[[1]][[m]][[n]], Fsf[[m]], Fsf[[n]]) y <- y + lo } } } ## normalization return(y/2) } waveslim/R/periodogram.R0000644000176200001440000000012613430347451014740 0ustar liggesusersper <- function(z) { n <- length(z) (Mod(fft(z))**2/(2*pi*n)) [1:(n %/% 2 + 1)] } waveslim/R/sdf.R0000644000176200001440000000602213430347452013206 0ustar liggesusersfdp.sdf <- function(freq, d, sigma2=1) sigma2 / ((2*sin(pi * freq))^2)^d bandpass.fdp <- function(a, b, d) 2 * integrate(fdp.sdf, lower=a, upper=b, d=d)$value spp.sdf <- function(freq, d, fG, sigma2=1) sigma2 * abs(2 * (cos(2*pi*freq) - cos(2*pi*fG)))^(-2*d) spp2.sdf <- function(freq, d1, f1, d2, f2, sigma2=1) { sigma2 * abs(2 * (cos(2*pi*freq) - cos(2*pi*f1)))^(-2 * d1) * abs(2 * (cos(2*pi*freq) - cos(2*pi*f2)))^(-2 * d2) } sfd.sdf <- function(freq, s, d, sigma2=1) sigma2 / (2 * (1 - cos(s * 2*pi*freq)))^d bandpass.spp <- function(a, b, d, fG) { if(fG > a && fG < b) { result1 <- integrate(spp.sdf, lower=a, upper=fG, d=d, fG=fG)$value result2 <- integrate(spp.sdf, lower=fG, upper=b, d=d, fG=fG)$value } else { result1 <- integrate(spp.sdf, lower=a, upper=b, d=d, fG=fG)$value result2 <- 0 } return(2*(result1 + result2)) } bandpass.spp2 <- function(a, b, d1, f1, d2, f2) { a1 <- a b1 <- b if(a1 < f1 && b1 > f2) { a2 <- f1 b2 <- f2 result1 <- integrate(spp2.sdf, a1, a2, d1=d1, f1=f1, d2=d2, f2=f2)$value result2 <- integrate(spp2.sdf, a1, b2, d1=d1, f1=f1, d2=d2, f2=f2)$value result3 <- integrate(spp2.sdf, b2, b1, d1=d1, f1=f1, d2=d2, f2=f2)$value } else { if(a1 < f1 && b1 < f2) { a2 <- f1 result1 <- integrate(spp2.sdf, a1, a2, d1=d1, f1=f1, d2=d2, f2=f2)$value result2 <- integrate(spp2.sdf, a2, b1, d1=d1, f1=f1, d2=d2, f2=f2)$value result3 <- 0 } else { if(a1 < f1 && b1 > f1 && b1 < f2) { a2 <- f1 result1 <- integrate(spp2.sdf, a1, a2, d1=d1, f1=f1, d2=d2, f2=f2)$value result2 <- integrate(spp2.sdf, a2, b1, d1=d1, f1=f1, d2=d2, f2=f2)$value result3 <- 0 } else { if(a1 > f1 && a1 < f2 && b1 > f2) { a2 <- f2 result1 <- integrate(spp2.sdf, a1, a2, d1=d1, f1=f1, d2=d2, f2=f2)$value result2 <- integrate(spp2.sdf, a2, b1, d1=d1, f1=f1, d2=d2, f2=f2)$value result3 <- 0 } else { result1 <- integrate(spp2.sdf, a1, b1, d1=d1, f1=f1, d2=d2, f2=f2)$value result2 <- 0 result3 <- 0 } } } } return(2*(result1 + result2 + result3)) } Hypergeometric <- function(a, b, c, z) { ## Recursive implementation taken from Numerical Recipes in C (6.12) ## Press, Teukolsky, Vetterling and Flannery (1992) fac <- 1 temp <- fac aa <- a bb <- b cc <- c for(n in 1:1000) { fac <- fac * (aa * bb) / cc fac <- fac * z / n series <- temp + fac if(series == temp) return(series) temp <- series aa <- aa + 1 bb <- bb + 1 cc <- cc + 1 } stop("convergence failure in Hypergeometric") } spp.var <- function(d, fG, sigma2=1) { ## Hypergeometric series representation of the variance taken from ## Lapsa (1997) omega <- 2*pi*fG A <- sigma2/2/sqrt(pi) * gamma(1-2*d) / gamma(3/2 - 2*d) * sin(omega)^(1-4*d) P1 <- Hypergeometric(1-2*d, 1-2*d, 3/2 - 2*d, sin(omega/2)^2) P2 <- Hypergeometric(1-2*d, 1-2*d, 3/2 - 2*d, cos(omega/2)^2) return(A * (P1 + P2)) } waveslim/R/spp.R0000644000176200001440000001465113430347452013243 0ustar liggesusersspp.mle <- function(y, wf, J=log(length(y),2)-1, p=0.01, frac=1) { sppLL <- function(x, y) { delta <- x[1] fG <- x[2] ## cat("Parameters are: d =", delta, ", and f =", fG, fill=TRUE) y.dwpt <- y[[1]] y.basis <- y[[2]] n <- y[[3]] J <- y[[4]] ## Establish the limits of integration for the band-pass variances a <- unlist(apply(matrix(2^(1:J)-1), 1, seq, from=0, by=1)) / 2^(rep(1:J, 2^(1:J))) / 2 b <- unlist(apply(matrix(2^(1:J)), 1, seq, from=1, by=1)) / 2^(rep(1:J, 2^(1:J))) / 2 ## Define some useful parameters for the wavelet packet tree # n <- length(y) length.jn <- n / rep(2^(1:J), 2^(1:J)) scale.jn <- rep(2^(1:J+1), 2^(1:J)) ## Initialize various parameters for the reduced LL Basis <- (1:length(y.basis))[y.basis] bp.var <- numeric(length(Basis)) delta.n <- 100 ## Compute the band-pass variances according to \delta and f_G omega.diag <- NULL for(i in 1:sum(y.basis)) { jn <- Basis[i] bp.var[i] <- bandpass.spp(a[jn], b[jn], delta, fG) omega.diag <- c(omega.diag, scale.jn[jn] * rep(bp.var[i], length.jn[jn])) } ## Compute reduced log-likelihood rLL <- n * log(1/n * sum(y.dwpt^2 / omega.diag, na.rm=TRUE)) + sum(length.jn[y.basis] * log(scale.jn[y.basis] * bp.var)) rLL } n <- length(y) x0 <- numeric(2) ## Perform discrete wavelet packet transform (DWPT) on Y y.dwpt <- dwpt(y, wf, n.levels=J) n <- length(y) if(frac < 1) { for(i in 1:length(y.dwpt)) { vec <- y.dwpt[[i]] ni <- length(vec) j <- rep(1:J, 2^(1:J))[i] vec[trunc(frac * n/2^j):ni] <- NA y.dwpt[[i]] <- vec } } y.basis <- as.logical(ortho.basis(portmanteau.test(y.dwpt, p))) y.dwpt <- as.matrix(unlist(y.dwpt[y.basis])) ## Compute initial estimate of the Gegenbauer frequency y.per <- per(y - mean(y)) x0[2] <- (0:(n/2)/n)[max(y.per) == y.per] ## Compute initial estimate of the fractional difference parameter muJ <- (unlist(apply(matrix(2^(1:J)-1), 1, seq, from=0, by=1)) / 2^(rep(1:J, 2^(1:J))) + unlist(apply(matrix(2^(1:J)), 1, seq, from=1, by=1)) / 2^(rep(1:J, 2^(1:J)))) / 4 y.modwpt <- modwpt(y, wf=wf, n.levels=J) y.varJ <- rep(2^(1:J), 2^(1:J)) * unlist(lapply(y.modwpt, FUN=function(x)sum(x*x,na.rm=TRUE)/length(x[!is.na(x)]))) x0[1] <- min(-0.5 * lsfit(log(abs(muJ[y.basis] - x0[2])), log(y.varJ[y.basis]))$coef[2], 0.49) cat(paste("Initial parameters are: delta =", round(x0[1],4), "freqG =", round(x0[2],4), "\n")) result <- optim(par=x0, fn=sppLL, method="L-BFGS-B", lower=c(0.001,0.001), upper=c(0.499,0.499), control=list(trace=0, fnscale=2), y=list(y.dwpt, y.basis, n, J)) return(result) } spp2.mle <- function(y, wf, J=log(length(y),2)-1, p=0.01, dyadic=TRUE, frac=1) { spp2LL <- function(x, y) { d1 <- x[1] f1 <- x[2] d2 <- x[3] f2 <- x[4] ## cat("Parameters are: d1 =", round(d1,6), ", and f1 =", round(f1,6), ## ", d2 =", round(d2,6), ", and f2 =", round(f2,6), fill=TRUE) y.dwpt <- y[[1]] y.basis <- y[[2]] n <- y[[3]] J <- y[[4]] ## Establish the limits of integration for the band-pass variances a <- unlist(apply(matrix(2^(1:J)-1), 1, seq, from=0, by=1)) / 2^(rep(1:J, 2^(1:J))) / 2 b <- unlist(apply(matrix(2^(1:J)), 1, seq, from=1, by=1)) / 2^(rep(1:J, 2^(1:J))) / 2 ## Define some useful parameters for the wavelet packet tree length.jn <- n / rep(2^(1:J), 2^(1:J)) scale.jn <- rep(2^(1:J+1), 2^(1:J)) ## Initialize various parameters for the reduced LL Basis <- (1:length(y.basis))[y.basis] bp.var <- numeric(length(Basis)) delta.n <- 100 ## Compute the band-pass variances according to \delta and f_G omega.diag <- NULL for(i in 1:sum(y.basis)) { jn <- Basis[i] bp.var[i] <- bandpass.spp2(a[jn], b[jn], d1, f1, d2, f2) omega.diag <- c(omega.diag, scale.jn[jn] * rep(bp.var[i], length.jn[jn])) } ## Compute reduced log-likelihood n * log(1/n * sum(y.dwpt^2 / omega.diag, na.rm=TRUE)) + sum(length.jn[y.basis] * log(scale.jn[y.basis] * bp.var), na.rm=TRUE) } n <- length(y) x0 <- numeric(4) ## Perform discrete wavelet packet transform (DWPT) on Y y.dwpt <- dwpt(y, wf, n.levels=J) if(!dyadic) { for(i in 1:length(y.dwpt)) { vec <- y.dwpt[[i]] ni <- length(vec) j <- rep(1:J, 2^(1:J))[i] vec[trunc(frac * n/2^j):ni] <- NA y.dwpt[[i]] <- vec } } y.basis <- as.logical(ortho.basis(portmanteau.test(y.dwpt, p, type="other"))) y.dwpt <- as.vector(unlist(y.dwpt[y.basis])) ## Compute initial estimate of the Gegenbauer frequencies if(dyadic) y.per <- per(y - mean(y)) else y.per <- per(y[1:(frac*n)] - mean(y[1:(frac*n)])) freq.y <- (0:(frac*n %/% 2))/(frac*n) x0[2] <- freq.y[max(y.per) == y.per] x0[4] <- freq.y[max(y.per[freq.y > x0[2] + freq.y[10] | freq.y < x0[2] - freq.y[10]]) == y.per] if(x0[2] > x0[4]) { xx <- x0[2] x0[2] <- x0[4] x0[4] <- xx rm(xx) } ## Compute initial estimate of the fractional difference parameters muJ <- (unlist(apply(matrix(2^(1:J)-1), 1, seq, from=0, by=1)) / 2^(rep(1:J, 2^(1:J))) + unlist(apply(matrix(2^(1:J)), 1, seq, from=1, by=1)) / 2^(rep(1:J, 2^(1:J)))) / 4 y.modwpt <- modwpt(y, wf=wf, n.levels=J) y.varJ <- rep(2^(1:J), 2^(1:J)) * unlist(lapply(y.modwpt, FUN = function(x) sum(x*x,na.rm=TRUE)/length(x[!is.na(x)]))) x0.mid <- (x0[2] + x0[4]) / 2 muJ <- muJ[y.basis] y.varJ <- y.varJ[y.basis] x0[1] <- min(-0.5 * lsfit(log(abs(muJ[muJ < x0.mid] - x0[2])), log(y.varJ[muJ < x0.mid]))$coef[2], 0.49) x0[3] <- min(-0.5 * lsfit(log(abs(muJ[muJ > x0.mid] - x0[4])), log(y.varJ[muJ > x0.mid]))$coef[2], 0.49) cat(paste("Initial parameters: d1 = ", round(x0[1],4), ", f1 = ", round(x0[2],4), ", d2 = ", round(x0[3],4), ", f2 = ", round(x0[4],4), sep=""), fill=TRUE) result <- optim(par=x0, fn=spp2LL, method="L-BFGS-B", lower=rep(0.001,4), upper=rep(0.499,4), control=list(trace=1, fnscale=2), y=list(y.dwpt, y.basis, n, J)) return(result) } waveslim/R/denoise.R0000644000176200001440000002155713430347451014071 0ustar liggesusersmanual.thresh <- function(wc, max.level=4, value, hard=TRUE) { wc.fine <- wc[["d1"]] factor <- median(abs(wc.fine)) / .6745 wc.shrink <- wc if(hard) { # Hard thresholding for(i in names(wc)[1:max.level]) { wci <- wc[[i]] unithresh <- factor * value wc.shrink[[i]] <- wci * (abs(wci) > unithresh) } } else { # Soft thresholding for(i in names(wc)[1:max.level]) { wci <- wc[[i]] unithresh <- factor * value wc.shrink[[i]] <- sign(wci) * (abs(wci) - unithresh) * (abs(wci) > unithresh) } } wc.shrink } universal.thresh <- function(wc, max.level=4, hard=TRUE) { n <- length(idwt(wc)) wc.fine <- wc[["d1"]] factor <- median(abs(wc.fine)) / .6745 wc.shrink <- wc if(hard) { # Hard thresholding for(i in names(wc)[1:max.level]) { wci <- wc[[i]] unithresh <- factor * sqrt(2 * log(n)) wc.shrink[[i]] <- wci * (abs(wci) > unithresh) } } else { # Soft thresholding for(i in names(wc)[1:max.level]) { wci <- wc[[i]] unithresh <- factor * sqrt(2 * log(n)) wc.shrink[[i]] <- sign(wci) * (abs(wci) - unithresh) * (abs(wci) > unithresh) } } wc.shrink } universal.thresh.modwt <- function(wc, max.level=4, hard=TRUE) { n <- length(wc[[1]]) wc.fine <- wc[["d1"]] factor <- sqrt(2) * median(abs(wc.fine)) / .6745 wc.shrink <- wc j <- 1 if(hard) { ## Hard thresholding for(i in names(wc)[1:max.level]) { wci <- wc[[i]] unithresh <- factor * sqrt(2 * log(n)) / 2^(j/2) wc.shrink[[i]] <- wci * (abs(wci) > unithresh) j <- j+1 } } else { ## Soft thresholding for(i in names(wc)[1:max.level]) { wci <- wc[[i]] unithresh <- factor * sqrt(2 * log(n)) / 2^(j/2) wc.shrink[[i]] <- sign(wci) * (abs(wci) - unithresh) * (abs(wci) > unithresh) j <- j+1 } } wc.shrink } sure.thresh <- function(wc, max.level=4, hard=TRUE) { wc.shrink <- wc sure <- function(t, x) { ax <- sort(abs(x)) num <- match(FALSE, ax <= t, nomatch = length(ax) + 1) - 1 length(ax) - 2 * num + sum(pmin(ax, t)^2) } for(i in names(wc)[1:max.level]) { wci <- wc[[i]] ni <- length(wci) factor <- median(abs(wci)) / .6745 xi <- wci / factor sxi <- sort(abs(xi))^2 s <- cumsum(sxi) + ((ni - 1):0) * sxi risk <- (ni - (2 * (1:ni)) + s) / ni surethresh <- sqrt(sxi[order(risk)[1]]) if(hard) { ## Hard thresholding wc.shrink[[i]] <- wci * (abs(xi) > surethresh) } else { ## Soft thresholding wc.shrink[[i]] <- sign(wci) * (abs(wci) - factor*surethresh) * (abs(xi) > surethresh) } } return(wc.shrink) } hybrid.thresh <- function(wc, max.level = 4, verbose = FALSE, seed = 0) { shrinkit <- function(coeffs, thresh) sign(coeffs) * pmax(abs(coeffs) - thresh, 0) sure <- function(t, x) { ax <- sort(abs(x)) num <- match(FALSE, ax <= t, nomatch = length(ax) + 1) - 1 length(ax) - 2 * num + sum(pmin(ax, t)^2) } wc.shrink <- wc n <- length(unlist(wc)) nlev <- log(n + 1, 2) - 1 i <- 1 iloc <- 1 while(i <= max.level) { ## Extract current level coefficients from all wavelet coefficients raw <- wc[[names(wc)[i]]] d <- length(raw) ## Test: if the variance is small enough, just use threshold sqrt(2logd) if((sum(raw^2) - d)/d <= sqrt(i^3/2^i)) { if(verbose) cat(paste("At level ", i, " the threshhold is sqrt(2log(d)): ", sqrt(2 * log(d)), "\n", sep = "")) wc.shrink[[names(wc)[i]]] <- shrinkit(wc[[names(wc)[i]]], sqrt(2*log(d))) } else { ## Generate random subset if(length(seed) != 1) .Random.seed <- seed Iset <- sort(sample(d, d/2)) rawI <- raw[Iset] / (median(abs(raw[Iset])) / .6745) rawIp <- raw[ - Iset] / (median(abs(raw[ - Iset])) / .6745) ggI <- sort(abs(rawI)) ggIp <- sort(abs(rawIp)) ## Calculate SURE for all possible thresholds surevecI <- sapply(c(ggI[ggI < sqrt(2 * log(d))], 0, sqrt(2 * log(d))), sure, ggI) surevecIp <- sapply(c(ggIp[ggI < sqrt(2 * log(d))], 0, sqrt(2 * log(d))), sure, ggIp) ## Threshold that minimizes risk llI <- length(surevecI) llIp <- length(surevecIp) ## The minimum occurs either at sqrt(2logd), if(min(surevecI) == surevecI[llI]) threshI <- sqrt(2 * log(d)) else if(min(surevecI) == surevecI[llI - 1]) threshI <- 0 else threshI <- ggI[match(min(surevecI), surevecI)] ## or at 0, if(min(surevecIp) == surevecIp[llIp]) threshIp <- sqrt(2 * log(d)) else if(min(surevecIp) == surevecI[llIp - 1]) threshIp <- 0 else threshIp <- ggIp[match(min(surevecIp), surevecIp)] ## or at 0, if(verbose) { cat(paste("At level ", i, ", threshold1 is ", threshI, "\n", sep = "")) cat(paste("At level ", i, ", threshold2 is ", threshIp, "\n", sep = "")) } ## Perform shrinking newI <- shrinkit(rawI, threshIp) newIp <- shrinkit(rawIp, threshI) new <- rep(0, d) new[Iset] <- newI new[ - Iset] <- newIp wc.shrink[[names(wc)[i]]] <- new } ## Otherwise, go through all this stuff iloc <- iloc + 2^i i <- i + 1 } wc.shrink } da.thresh <- function(wc, alpha=.05, max.level=4, verbose=FALSE, return.thresh=FALSE) { onebyone2 <- function(dat, alpha) { kolsmi.chi2 <- function(dat) { n <- length(dat) return(max(abs(cumsum(dat)-(1:n)*sum(dat)/n))/sqrt(2*n)) } crit <- c(seq(0.28,1.49,by=.01), seq(1.50,2.48,by=.02)) alph <- c(.999999,.999996,.999991,.999979,.999954,.999909,.999829, .999697,.999489,.999174,.998715,.998071,.997192,.996028, .994524,.992623,.990270,.987410,.983995,.979978,.975318, .969983,.963945,.957186,.949694,.941466,.932503,.922817, .912423,.901344,.889605,.877240,.864282,.850771,.836775, .822247,.807323,.792013,.776363,.760418,.744220,.727811, .711235,.694529,.677735,.660887,.644019,.627167,.610360, .593628,.576998,.560495,.544143,.527959,.511970,.496192, .480634,.465318,.450256,.435454,.420930,.406684,.392730, .379072,.365714,.352662,.339918,.327484,.315364,.303556, .292060,.280874,.270000,.259434,.249174,.239220,.229566, .220206,.211140,.202364,.193872,.185658,.177718,.170050, .162644,.155498,.148606,.141962,.135558,.129388,.123452, .117742,.112250,.106970,.101896,.097028,.092352,.087868, .083568,.079444,.075495,.071712,.068092,.064630,.061318, .058152,.055128,.052244,.049488,.046858,.044350,.041960, .039682,.037514,.035448,.033484,.031618,.029842,.028154, .026552,.025030,.023588,.022218,.019690,.017422,.015390, .013574,.011952,.010508,.009223,.008083,.007072,.006177, .005388,.004691,.004078,.003540,.003068,.002654,.002293, .001977,.001703,.001464,.001256,.001076,.000921,.000787, .000671,.000572,.000484,.000412,.000350,.000295,.000250, .000210,.000178,.000148,.000126,.000104,.000088,.000074, .000060,.000051,.000042,.000035,.000030,.000024,.000020, .000016,.000013,.000011,.000009) if(alpha < min(alph) || alpha > max(alph)) stop("alpha =",alpha,"is out of range") ind <- match(TRUE, alpha > alph) critval <- crit[ind-1]+(alph[ind-1]-alpha)*(crit[ind]-crit[ind-1]) / (alph[ind-1]-alph[ind]) i <- length(dat) cc <- kolsmi.chi2(dat) while(cc[length(cc)] > critval && i > 1) { i <- i-1 cc <- c(cc,kolsmi.chi2(dat[sort(order(dat)[1:i])])) } return(cc) } getthrda2 <- function(dat, alpha) { a <- onebyone2(dat, alpha) if(length(a) == length(dat)) if(1 - pchisq(min(dat),1) < alpha) ggg <- 0 else ggg <- sqrt(min(dat)) else ggg <- sqrt(max(dat[sort(order(dat)[1:(length(dat)-length(a)+1)])])) return(ggg) } shrinkit <- function(coeffs, thresh) sign(coeffs) * pmax(abs(coeffs) - thresh, 0) if(alpha <= .000009 || alpha >= .999999) stop("alpha out of range") ans <- wc n <- length(unlist(wc)) nlev <- log(n+1, 2)-1 i <- 1 iloc <- 1 while(i <= max.level) { gg <- wc[[names(wc)[i]]] thresh <- getthrda2(gg^2,alpha) if(verbose) cat(paste("At level ",i,", the threshold is ",thresh, "\n",sep="")) if(return.thresh) if(i == nlev) rt <- thresh else rt <- c(thresh, rt) else ans[[names(wc)[i]]] <- shrinkit(wc[[names(wc)[i]]], thresh) iloc <- iloc + 2^i i <- i+1 } if(return.thresh) return(rt) else return(ans) } waveslim/R/dwpt_sim.R0000644000176200001440000000426313430347451014264 0ustar liggesusersdwpt.sim <- function(N, wf, delta, fG, M=2, adaptive=TRUE, epsilon=0.05) { M <- M*N J <- log(M, 2) jn <- rep(1:J, 2^(1:J)) jl <- length(jn) if( adaptive ) { Basis <- find.adaptive.basis(wf, J, fG, epsilon) } else { Basis <- numeric(jl) a <- min((1:jl)[jn == J]) b <- max((1:jl)[jn == J]) Basis[a:b] <- 1 } Index <- (1:jl)[as.logical(Basis)] Length <- 2^jn variance <- bandpass.var.spp(delta, fG, J, Basis, Length) z <- vector("list", jl) class(z) <- "dwpt" attr(z, "wavelet") <- wf for(i in Index) z[[i]] <- rnorm(M/Length[i], sd=sqrt(Length[i]*variance[i])) x <- idwpt(z, Basis) xi <- trunc(runif(1, 1, M-N)) return(x[xi:(xi+N-1)]) } find.adaptive.basis <- function(wf, J, fG, eps) { H <- function(f, L) { H <- 0 for(l in 0:(L/2-1)) H <- H + choose(L/2+l-1,l) * cos(pi*f)^(2*l) H <- 2 * sin(pi*f)^L * H return(H) } G <- function(f, L) { G <- 0 for(l in 0:(L/2-1)) G <- G + choose(L/2+l-1,l) * sin(pi*f)^(2*l) G <- 2 * cos(pi*f)^L * G return(G) } L <- wave.filter(wf)$length jn <- rep(1:J, 2^(1:J)) jl <- length(jn) U <- numeric(jl) U[1] <- G(fG, L) U[2] <- H(fG, L) for(j in 2:J) { jj <- min((1:jl)[jn == j]) jp <- (1:jl)[jn == j-1] for(n in 0:(2^j/2-1)) { if (n%%2 == 0) { U[jj + 2 * n + 1] <- U[jp[n+1]] * H(2^(j-1)*fG, L) U[jj + 2 * n] <- U[jp[n+1]] * G(2^(j-1)*fG, L) } else { U[jj + 2 * n] <- U[jp[n+1]] * H(2^(j-1)*fG, L) U[jj + 2 * n + 1] <- U[jp[n+1]] * G(2^(j-1)*fG, L) } } } return(ortho.basis(U < eps)) } bandpass.var.spp <- function(delta, fG, J, Basis, Length) { a <- unlist(sapply(2^(1:J)-1, seq, from=0, by=1)) / (2*Length) b <- unlist(sapply(2^(1:J), seq, from=1, by=1)) / (2*Length) bp.var <- rep(0, length(Basis)) for(jn in (1:length(Basis))[as.logical(Basis)]) { if(fG < a[jn] | fG > b[jn]) bp.var[jn] <- 2*integrate(spp.sdf, a[jn], b[jn], d=delta, fG=fG)$value else { result1 <- 2*integrate(spp.sdf, a[jn], fG, d=delta, fG=fG)$value result2 <- 2*integrate(spp.sdf, fG, b[jn], d=delta, fG=fG)$value bp.var[jn] <- result1 + result2 } } return(bp.var) } waveslim/R/hilbert.R0000644000176200001440000004233213430347451014066 0ustar liggesusers######################################################################## dwt.hilbert <- function(x, wf, n.levels=4, boundary="periodic", ...) { switch(boundary, "reflection" = x <- c(x, rev(x)), "periodic" = invisible(), stop("Invalid boundary rule in dwt.hilbert")) N <- length(x) J <- n.levels if(N/2^J != trunc(N/2^J)) stop("Sample size is not divisible by 2^J") if(2^J > N) stop("Wavelet transform exceeds sample size in dwt") dict <- hilbert.filter(wf) L <- dict$length; storage.mode(L) <- "integer" h0 <- dict$lpf[[1]]; storage.mode(h0) <- "double" g0 <- dict$lpf[[2]]; storage.mode(g0) <- "double" h1 <- dict$hpf[[1]]; storage.mode(h1) <- "double" g1 <- dict$hpf[[2]]; storage.mode(g1) <- "double" y <- vector("list", J+1) names(y) <- c(paste("d", 1:J, sep=""), paste("s", J, sep="")) x.h <- x.g <- x for(j in 1:J) { W <- V <- numeric(N/2^j) out.h <- .C(C_dwt, as.double(x.h), as.integer(N/2^(j-1)), L, h1, h0, W = W, V = V)[6:7] out.g <- .C(C_dwt, as.double(x.g), as.integer(N/2^(j-1)), L, g1, g0, W = W, V = V)[6:7] y[[j]] <- complex(real = out.h$W, imaginary = out.g$W) x.h <- out.h$V x.g <- out.g$V } y[[J+1]] <- complex(real = x.h, imaginary = x.g) attr(y, "wavelet") <- wf attr(y, "levels") <- n.levels attr(y, "boundary") <- boundary return(y) } ######################################################################## dwt.hilbert.nondyadic <- function(x, ...) { M <- length(x) N <- 2^(ceiling(log(M, 2))) xx <- c(x, rep(0, N - M)) y <- dwt.hilbert(xx, ...) J <- length(y) - 1 for(j in 1:J) { y[[j]] <- y[[j]][1:trunc(M/2^j)] } return(y) } ######################################################################## idwt.hilbert <- function(y) { switch(attributes(y)$boundary, "reflection" = x <- c(x, rev(x)), "periodic" = invisible(), stop("Invalid boundary rule in dwt.dbp")) J <- attributes(y)$levels dict <- hilbert.filter(attributes(y)$wavelet) L <- dict$length; storage.mode(L) <- "integer" h <- dict$hpf; storage.mode(h) <- "double" g <- dict$lpf; storage.mode(g) <- "double" jj <- paste("s", J, sep="") X <- y[[jj]] for(j in J:1) { jj <- paste("d", j, sep="") XX <- numeric(2 * length(y[[jj]])) X <- .C(C_idwt, y[[jj]], as.double(X), as.integer(length(X)), L, h, g, XX=XX)$XX } return(X) } ######################################################################## modwt.hilbert <- function(x, wf, n.levels=4, boundary="periodic", ...) { switch(boundary, "reflection" = x <- c(x, rev(x)), "periodic" = invisible(), stop("Invalid boundary rule in modwt")) N <- length(x) storage.mode(N) <- "integer" J <- n.levels if(2^J > N) stop("wavelet transform exceeds sample size in modwt") dict <- hilbert.filter(wf) L <- dict$length; storage.mode(L) <- "integer" h0 <- dict$lpf[[1]] / sqrt(2); storage.mode(h0) <- "double" g0 <- dict$lpf[[2]] / sqrt(2); storage.mode(g0) <- "double" h1 <- dict$hpf[[1]] / sqrt(2); storage.mode(h1) <- "double" g1 <- dict$hpf[[2]] / sqrt(2); storage.mode(g1) <- "double" y <- vector("list", J+1) names(y) <- c(paste("d", 1:J, sep=""), paste("s", J, sep="")) W <- V <- numeric(N) x.h <- x.g <- x for(j in 1:J) { out.h <- .C(C_modwt, as.double(x.h), N, as.integer(j), L, h1, h0, W = W, V = V)[7:8] out.g <- .C(C_modwt, as.double(x.g), N, as.integer(j), L, g1, g0, W = W, V = V)[7:8] y[[j]] <- complex(real = out.h$W, imaginary = out.g$W) x.h <- out.h$V x.g <- out.g$V } y[[J+1]] <- complex(real = x.h, imaginary = x.g) attr(y, "wavelet") <- wf attr(y, "boundary") <- boundary attr(y, "levels") <- n.levels return(y) } ######################################################################## imodwt.hilbert <- function(y) { if(attributes(y)$boundary != "periodic") stop("Invalid boundary rule in imodwt") J <- length(y) - 1 dict <- hilbert.filter(attributes(y)$wavelet) L <- dict$length ht <- dict$hpf / sqrt(2) gt <- dict$lpf / sqrt(2) jj <- paste("s", J, sep="") X <- y[[jj]]; N <- length(X) XX <- numeric(N) for(j in J:1) { jj <- paste("d", j, sep="") X <- .C(C_imodwt, y[[jj]], X, as.integer(N), as.integer(j), as.integer(L), ht, gt, XX)[[8]] } return(X) } ######################################################################## hilbert.filter <- function(name) { select.K3L3 <- function() { L <- 12 h0 <- c(1.1594353e-04, -2.2229002e-03, -2.2046914e-03, 4.3427642e-02, -3.3189896e-02, -1.5642755e-01, 2.8678636e-01, 7.9972652e-01, 4.9827824e-01, 2.4829160e-02, -4.2679177e-02, -2.2260892e-03) h1 <- qmf(h0) g0 <- c(1.6563361e-05, -5.2543406e-05, -6.1909121e-03, 1.9701141e-02, 3.2369691e-02, -1.2705043e-01, -1.5506397e-02, 6.1333712e-01, 7.4585008e-01, 2.1675412e-01, -4.9432248e-02, -1.5582624e-02) g1 <- qmf(g0) return(list(length = L, hpf = list(h1, g1), lpf = list(h0, g0))) } select.K3L5 <- function() { L <- 12 h0 <- c(5.4258791e-06, -2.1310518e-04, -2.6140914e-03, 1.0212881e-02, 3.5747880e-02, -4.5576766e-02, 3.9810341e-03, 5.3402475e-01, 7.8757164e-01, 2.6537457e-01, -1.3008915e-01, -5.9573795e-02, 1.2733976e-02, 2.8641011e-03, -2.2992683e-04, -5.8541759e-06) h1 <- qmf(h0) g0 <- c(4.9326174e-07, 3.5727140e-07, -1.1664703e-03, -8.4003116e-04, 2.8601474e-02, 9.2509748e-03, -7.4562251e-02, 2.2929480e-01, 7.6509138e-01, 5.8328559e-01, -4.6218010e-03, -1.2336841e-01, -6.2826896e-03, 9.5478911e-03, 4.6642226e-05, -6.4395935e-05) g1 <- qmf(g0) return(list(length = L, hpf = list(h1, g1), lpf = list(h0, g0))) } select.K4L2 <- function() { L <- 12 h0 <- c(-1.7853301e-03, 1.3358873e-02, 3.6090743e-02, -3.4722190e-02, 4.1525062e-02, 5.6035837e-01, 7.7458617e-01, 2.2752075e-01, -1.6040927e-01, -6.1694251e-02, 1.7099408e-02, 2.2852293e-03) h1 <- qmf(h0) g0 <- c(-3.5706603e-04, -1.8475351e-04, 3.2591486e-02, 1.3449902e-02, -5.8466725e-02, 2.7464308e-01, 7.7956622e-01, 5.4097379e-01, -4.0315008e-02, -1.3320138e-01, -5.9121296e-03, 1.1426146e-02) g1 <- qmf(g0) return(list(length = L, hpf = list(h1, g1), lpf = list(h0, g0))) } select.K4L4 <- function() { L <- 16 h0 <- c(2.5734665593981519e-05, -6.6909066441298817e-04, -5.5482443985275260e-03, 1.3203474646343588e-02, 3.8605327384848696e-02, -5.0687259299773510e-02, 8.1364447220208733e-03, 5.3021727476690994e-01, 7.8330912249663232e-01, 2.7909546754271131e-01, -1.3372674246928601e-01, -6.9759509629953295e-02, 1.6979390952358446e-02, 5.7323570134311854e-03, -6.7425216644469892e-04, -2.5933188060087743e-05) h1 <- qmf(h0) g0 <- c(2.8594072882201687e-06, 1.9074538622058143e-06, -2.9903835439216066e-03, -1.9808995184875909e-03, 3.3554663884350758e-02, 7.7023844121478988e-03, -7.7084571412435535e-02, 2.3298110528093252e-01, 7.5749376288995063e-01, 5.8834703992067783e-01, 5.1708789323078770e-03, -1.3520099946241465e-01, -9.1961246067629732e-03, 1.5489641793018745e-02, 1.5569563641876791e-04, -2.3339869254078969e-04) g1 <- qmf(g0) return(list(length = L, hpf = list(h1, g1), lpf = list(h0, g0))) } select.K5L7 <- function() { L <- 24 h0 <- c(-2.5841959496364648e-10, 6.0231243121018760e-10, 2.1451486802217960e-06, -4.9989222844980982e-06, -2.2613489535132104e-04, 5.1967501391358343e-04, 3.4011963595840899e-03, -7.1996997688061597e-03, -1.7721433874932836e-02, 3.5491112173858148e-02, 3.0580617312936355e-02, -1.3452365188777773e-01, 2.1741748603083836e-03, 5.8046856094922639e-01, 7.4964083145768690e-01, 2.6775497264154541e-01, -7.9593287728224230e-02, -4.3942149960221458e-02, 1.9574969406037097e-02, 8.8554643330725387e-03, -7.2770446614145033e-04, -3.1310992841759443e-04, 1.4045333283124608e-06, 6.0260907100656169e-07) h1 <- qmf(h0) g0 <- c(-3.8762939244546978e-09, 2.9846463282743695e-07, 5.6276030758515370e-06, -7.7697066311187957e-05, -2.1442686434841905e-04, 2.1948612668324223e-03, 9.5408758453423542e-04, -1.7149735951945008e-02, 1.5212479104581677e-03, 5.6600564413983846e-02, -4.8900162376504831e-02, -1.3993440493611778e-01, 2.7793346796113222e-01, 7.6735603850281364e-01, 5.4681951651005178e-01, 3.6275855872448776e-02, -8.8224410289407154e-02, 3.2821708368951431e-05, 1.7994969189524142e-02, 1.8662128501760204e-03, -7.8622878632753014e-04, -5.8077443328549205e-05, 3.0932895975646042e-06, 4.0173938067104100e-08) g1 <- qmf(g0) return(list(length = L, hpf = list(h1, g1), lpf = list(h0, g0))) } select.K6L6 <- function() { L <- 24 h0 <- c(1.4491207137947255e-09 -3.4673992369566253e-09, -6.7544152844875963e-06, 1.6157040144070828e-05, 4.0416340595645441e-04, -9.4536696039781878e-04, -4.2924086033924620e-03, 9.0688042722858742e-03, 1.8690864167884680e-02, -3.7883945370993717e-02, -2.7337592282061701e-02, 1.3185812419468312e-01, -2.1034481553730465e-02, -5.9035515013747486e-01, -7.4361804647499452e-01, -2.5752016951708306e-01, 9.2725410672739983e-02, 4.9100676534870831e-02, -2.4411085480175867e-02, -1.1190458223944993e-02, 1.7793885751382626e-03, 7.4715940333597059e-04, -6.2392430013359510e-06, -2.6075498267775052e-06) h1 <- qmf(h0) g0 <- c(1.8838569279331431e-08, -1.1000360697229965e-06, -1.4600820117782769e-05, 1.6936567299204319e-04, 2.6967189953984829e-04, -3.1633669438102655e-03, -7.2081460313487946e-04, 1.9638595542490079e-02, -3.0968325940269846e-03, -5.6722348677476261e-02, 5.2260784738219289e-02, 1.2763836788794369e-01, -2.9566169882112192e-01, -7.6771793937333599e-01, -5.3818432160802543e-01, -2.4023872575927138e-02, 9.9019132161496132e-02, -1.2059411664071501e-03, -2.2693488886969308e-02, -1.8724943382560243e-03, 1.7270823778712107e-03, 1.5415480681200776e-04, -1.1712464100067407e-05, -2.0058075590596196e-07) g1 <- qmf(g0) return(list(length = L, hpf = list(-h1, -g1), lpf = list(-h0, -g0))) } switch(name, "k3l3" = select.K3L3(), "k3l5" = select.K3L5(), "k4l2" = select.K4L2(), "k4l4" = select.K4L4(), "k5l7" = select.K5L7(), "k6l6" = select.K6L6(), stop("Invalid selection for hilbert.filter")) } ######################################################################## phase.shift.hilbert <- function(x, wf) { coe <- function(g) sum(0:(length(g)-1) * g^2) / sum(g^2) J <- length(x) - 1 h0 <- hilbert.filter(wf)$lpf[[1]] h1 <- hilbert.filter(wf)$hpf[[1]] for(j in 1:J) { ph <- round(2^(j-1) * (coe(h0) + coe(h1)) - coe(h0), 0) Nj <- length(x[[j]]) x[[j]] <- c(x[[j]][(ph+1):Nj], x[[j]][1:ph]) } ph <- round((2^J-1) * coe(h0), 0) J <- J + 1 x[[J]] <- c(x[[J]][(ph+1):Nj], x[[J]][1:ph]) return(x) } ######################################################################## modwpt.hilbert <- function(x, wf, n.levels=4, boundary="periodic") { N <- length(x) storage.mode(N) <- "integer" J <- n.levels if(2^J > N) stop("wavelet transform exceeds sample size in modwpt") dict <- hilbert.filter(wf) L <- dict$length; storage.mode(L) <- "integer" h0 <- dict$lpf[[1]] / sqrt(2); storage.mode(h0) <- "double" g0 <- dict$lpf[[2]] / sqrt(2); storage.mode(g0) <- "double" h1 <- dict$hpf[[1]] / sqrt(2); storage.mode(h1) <- "double" g1 <- dict$hpf[[2]] / sqrt(2); storage.mode(g1) <- "double" y <- vector("list", sum(2^(1:J))) yn <- length(y) crystals1 <- rep(1:J, 2^(1:J)) crystals2 <- unlist(apply(as.matrix(2^(1:J) - 1), 1, seq, from=0)) names(y) <- paste("w", crystals1, ".", crystals2, sep="") W <- V <- numeric(N) storage.mode(W) <- storage.mode(V) <- "double" for(j in 1:J) { ## cat(paste("j =", j, fill=T)) index <- 0 jj <- min((1:yn)[crystals1 == j]) for(n in 0:(2^j / 2 - 1)) { index <- index + 1 if(j > 1) x <- y[[(1:yn)[crystals1 == j-1][index]]] else x <- complex(real=x, imaginary=x) if(n %% 2 == 0) { zr <- .C(C_modwt, as.double(Re(x)), N, as.integer(j), L, h1, h0, W = W, V = V)[7:8] zc <- .C(C_modwt, as.double(Im(x)), N, as.integer(j), L, g1, g0, W = W, V = V)[7:8] y[[jj + 2*n + 1]] <- complex(real=zr$W, imaginary=zc$W) y[[jj + 2*n]] <- complex(real=zr$V, imaginary=zc$V) } else { zr <- .C(C_modwt, as.double(Re(x)), N, as.integer(j), L, h1, h0, W = W, V = V)[7:8] zc <- .C(C_modwt, as.double(Im(x)), N, as.integer(j), L, g1, g0, W = W, V = V)[7:8] y[[jj + 2*n]] <- complex(real=zr$W, imaginary=zc$W) y[[jj + 2*n + 1 ]] <- complex(real=zr$V, imaginary=zc$V) } } } attr(y, "wavelet") <- wf return(y) } ######################################################################## phase.shift.hilbert.packet <- function(x, wf) { coe <- function(g) sum(0:(length(g)-1) * g^2) / sum(g^2) dict <- hilbert.filter(wf) h0 <- dict$lpf[[1]]; h1 <- dict$hpf[[1]] g0 <- dict$lpf[[2]]; g1 <- dict$hpf[[2]] xn <- length(x) N <- length(x[[1]]) J <- trunc(log(xn,2)) jbit <- vector("list", xn) jbit[[1]] <- FALSE; jbit[[2]] <- TRUE crystals1 <- rep(1:J, 2^(1:J)) for(j in 1:J) { jj <- min((1:xn)[crystals1 == j]) for(n in 0:(2^j - 1)) { if(j > 1) { jp <- min((1:xn)[crystals1 == j-1]) if(n %% 4 == 0 | n %% 4 == 3) jbit[[jj + n]] <- c(jbit[[jp + floor(n/2)]], FALSE) else jbit[[jj + n]] <- c(jbit[[jp + floor(n/2)]], TRUE) } Sjn0 <- sum((1 - jbit[[jj + n]]) * 2^(0:(j-1))) Sjn1 <- sum(jbit[[jj + n]] * 2^(0:(j-1))) ph <- round(Sjn0 * coe(h0) + Sjn1 * coe(h1), 0) x[[jj + n]] <- c(x[[jj + n]][(ph+1):N], x[[jj + n]][1:ph]) } } return(x) } ######################################################################## modhwt.coh <- function(x, y, f.length = 0) { filt <- rep(1, f.length + 1) filt <- filt / length(filt) J <- length(x) - 1 coh <- vector("list", J) for(j in 1:J) { co.spec <- filter(Re(x[[j]] * Conj(y[[j]])), filt) quad.spec <- filter(-Im(x[[j]] * Conj(y[[j]])), filt) x.spec <- filter(Mod(x[[j]])^2, filt) y.spec <- filter(Mod(y[[j]])^2, filt) coh[[j]] <- (co.spec^2 + quad.spec^2) / x.spec / y.spec } coh } ######################################################################## modhwt.phase <- function(x, y, f.length = 0) { filt <- rep(1, f.length + 1) filt <- filt / length(filt) J <- length(x) - 1 phase <- vector("list", J) for(j in 1:J) { co.spec <- filter(Re(x[[j]] * Conj(y[[j]])), filt) quad.spec <- filter(-Im(x[[j]] * Conj(y[[j]])), filt) phase[[j]] <- Arg(co.spec - 1i * quad.spec) } phase } ######################################################################## modhwt.coh.seasonal <- function(x, y, S=10, season=365) { J <- length(x) - 1 coh <- shat <- vector("list", J) for(j in 1:J) { xj <- x[[j]] yj <- y[[j]] ## Cospectrum co <- matrix(Re(xj * Conj(yj)), ncol=season, byrow=TRUE) co.spec <- c(apply(co, 2, mean, na.rm=TRUE)) gamma.c <- my.acf(as.vector(co)) omega.c <- sum(gamma.c[c(1, rep(seq(season+1, S*season, by=season), each=2))]) ## Quadrature spectrum quad <- matrix(-Im(xj * Conj(yj)), ncol=season, byrow=TRUE) quad.spec <- c(apply(quad, 2, mean, na.rm=TRUE)) gamma.q <- my.acf(as.vector(quad)) omega.q <- sum(gamma.q[c(1, rep(seq(season+1, S*season, by=season), each=2))]) gamma.cq <- my.ccf(as.vector(co), as.vector(quad)) omega.cq <- sum(gamma.cq[S*season + seq(-S*season+1, S*season, by=season)]) ## Autospectrum(X) autoX <- matrix(Mod(xj)^2, ncol=season, byrow=TRUE) x.spec <- c(apply(autoX, 2, mean, na.rm=TRUE)) ## Autospectrum(Y) autoY <- matrix(Mod(yj)^2, ncol=season, byrow=TRUE) y.spec <- c(apply(autoY, 2, mean, na.rm=TRUE)) shat[[j]] <- 4 * (co.spec*omega.c + quad.spec * omega.q + 2*co.spec*quad.spec*omega.cq) / x.spec^2 / y.spec^2 coh[[j]] <- (co.spec^2 + quad.spec^2) / x.spec / y.spec } list(coh = coh, var = shat) } ######################################################################## modhwt.phase.seasonal <- function(x, y, season=365) { J <- length(x) - 1 phase <- vector("list", J) for(j in 1:J) { co.spec <- Re(x[[j]] * Conj(y[[j]])) co.spec <- c(apply(matrix(co.spec, ncol=season, byrow=TRUE), 2, mean, na.rm=TRUE)) quad.spec <- -Im(x[[j]] * Conj(y[[j]])) quad.spec <- c(apply(matrix(quad.spec, ncol=season, byrow=TRUE), 2, mean, na.rm=TRUE)) phase[[j]] <- Arg(co.spec - 1i * quad.spec) } phase } waveslim/R/tapers.R0000644000176200001440000000214713430347452013734 0ustar liggesusersdpss.taper <- function(n, k, nw = 4, nmax = 2^(ceiling(log(n,2)))) { if(n > nmax) stop("length of taper is greater than nmax") w <- nw/n if(w > 0.5) stop("half-bandwidth parameter (w) is greater than 1/2") if(k <= 0) stop("positive dpss order (k) required") v <- matrix(0, nrow = nmax, ncol = (k + 1)) storage.mode(v) <- "double" out <- .Fortran(C_dpss, nmax = as.integer(nmax), kmax = as.integer(k), n = as.integer(n), w = as.double(w), v = v, sig = double(k + 1), totit = integer(1), sines = double(n), vold = double(n), u = double(n), scr1 = double(n), ifault = integer(1)) ##list(v = out$v[1:n, 1:k], eigen = out$sig[-1] + 1, iter = ## out$totiTRUE, n = out$n, w = out$w, ifault = out$ifault) return(out$v[1:n, 1:k]) } sine.taper <- function(n, k) { tapers <- NULL for(i in 1:k) tapers <- cbind(tapers, sqrt(2/(n+1)) * sin((pi*i*1:n)/(n+1))) return(tapers) } waveslim/R/dwt.R0000644000176200001440000001431213430347451013230 0ustar liggesusersdwt <- function(x, wf="la8", n.levels=4, boundary="periodic") { switch(boundary, "reflection" = x <- c(x, rev(x)), "periodic" = invisible(), stop("Invalid boundary rule in dwt")) N <- length(x) J <- n.levels if(N/2^J != trunc(N/2^J)) stop("Sample size is not divisible by 2^J") if(2^J > N) stop("wavelet transform exceeds sample size in dwt") dict <- wave.filter(wf) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf storage.mode(h) <- "double" g <- dict$lpf storage.mode(g) <- "double" y <- vector("list", J+1) names(y) <- c(paste("d", 1:J, sep=""), paste("s", J, sep="")) for(j in 1:J) { W <- V <- numeric(N/2^j) out <- .C(C_dwt, as.double(x), as.integer(N/2^(j-1)), L, h, g, W=as.double(W), V=as.double(V))[6:7] y[[j]] <- out$W x <- out$V } y[[J+1]] <- x class(y) <- "dwt" attr(y, "wavelet") <- wf attr(y, "boundary") <- boundary return(y) } dwt.nondyadic <- function(x) { M <- length(x) N <- 2^(ceiling(log(M, 2))) xx <- c(x, rep(0, N - M)) y <- dwt(xx) J <- length(y) - 1 for(j in 1:J) y[[j]] <- y[[j]][1:trunc(M/2^j)] return(y) } idwt <- function(y) { ctmp <- class(y) if(is.null(ctmp) || all(ctmp != "dwt")) stop("argument `y' is not of class \"dwt\"") J <- length(y) - 1 dict <- wave.filter(attributes(y)$wavelet) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf storage.mode(h) <- "double" g <- dict$lpf storage.mode(g) <- "double" jj <- paste("s", J, sep="") X <- y[[jj]] for(j in J:1) { jj <- paste("d", j, sep="") N <- length(X) XX <- numeric(2 * length(y[[jj]])) X <- .C(C_idwt, as.double(y[[jj]]), as.double(X), as.integer(N), L, h, g, out=as.double(XX))$out } if(attr(y, "boundary") == "reflection") return(X[1:N]) else return(X) } modwt <- function(x, wf="la8", n.levels=4, boundary="periodic") { switch(boundary, "reflection" = x <- c(x, rev(x)), "periodic" = invisible(), stop("Invalid boundary rule in modwt")) N <- length(x) storage.mode(N) <- "integer" J <- n.levels if(2^J > N) stop("wavelet transform exceeds sample size in modwt") dict <- wave.filter(wf) L <- dict$length storage.mode(L) <- "integer" ht <- dict$hpf / sqrt(2) storage.mode(ht) <- "double" gt <- dict$lpf / sqrt(2) storage.mode(gt) <- "double" y <- vector("list", J+1) names(y) <- c(paste("d", 1:J, sep=""), paste("s", J, sep="")) W <- V <- numeric(N) storage.mode(W) <- "double" storage.mode(V) <- "double" for(j in 1:J) { out <- .C(C_modwt, as.double(x), N, as.integer(j), L, ht, gt, W=W, V=V)[7:8] y[[j]] <- out$W x <- out$V } y[[J+1]] <- x class(y) <- "modwt" attr(y, "wavelet") <- wf attr(y, "boundary") <- boundary return(y) } imodwt <- function(y) { ctmp <- class(y) if(is.null(ctmp) || all(ctmp != "modwt")) stop("argument `y' is not of class \"modwt\"") J <- length(y) - 1 dict <- wave.filter(attributes(y)$wavelet) L <- dict$length storage.mode(L) <- "integer" ht <- dict$hpf / sqrt(2) storage.mode(ht) <- "double" gt <- dict$lpf / sqrt(2) storage.mode(gt) <- "double" jj <- paste("s", J, sep="") X <- y[[jj]] N <- length(X) storage.mode(N) <- "integer" XX <- numeric(N) storage.mode(XX) <- "double" for(j in J:1) { jj <- paste("d", j, sep="") X <- .C(C_imodwt, as.double(y[[jj]]), as.double(X), N, as.integer(j), L, ht, gt, out=XX)$out } if(attr(y, "boundary") == "reflection") return(X[1:(N/2)]) else return(X) } brick.wall <- function(x, wf, method="modwt") { m <- wave.filter(wf)$length for(j in 1:(length(x)-1)) { if(method == "dwt") n <- ceiling((m - 2) * (1 - 1/2^j)) else n <- (2^j - 1) * (m - 1) n <- min(n, length(x[[j]])) x[[j]][1:n] <- NA } x[[j+1]][1:n] <- NA return(x) } phase.shift <- function(z, wf, inv=FALSE) { coe <- function(g) sum(0:(length(g)-1) * g^2) / sum(g^2) J <- length(z) - 1 g <- wave.filter(wf)$lpf h <- wave.filter(wf)$hpf if(!inv) { for(j in 1:J) { ph <- round(2^(j-1) * (coe(g) + coe(h)) - coe(g), 0) Nj <- length(z[[j]]) z[[j]] <- c(z[[j]][(ph+1):Nj], z[[j]][1:ph]) } ph <- round((2^J-1) * coe(g), 0) J <- J + 1 z[[J]] <- c(z[[J]][(ph+1):Nj], z[[J]][1:ph]) } else { for(j in 1:J) { ph <- round(2^(j-1) * (coe(g) + coe(h)) - coe(g), 0) Nj <- length(z[[j]]) z[[j]] <- c(z[[j]][(Nj-ph+1):Nj], z[[j]][1:(Nj-ph)]) } ph <- round((2^J-1) * coe(g), 0) J <- J + 1 z[[J]] <- c(z[[J]][(Nj-ph+1):Nj], z[[J]][1:(Nj-ph)]) } return(z) } mra <- function(x, wf="la8", J=4, method="modwt", boundary="periodic") { switch(boundary, "reflection" = x <- c(x, rev(x)), "periodic" = invisible(), stop("Invalid boundary rule in mra")) n <- length(x) if(method == "modwt") x.wt <- modwt(x, wf, J, "periodic") else x.wt <- dwt(x, wf, J, "periodic") x.mra <- vector("list", J+1) ## Smooth zero <- vector("list", J+1) names(zero) <- c(paste("d", 1:J, sep=""), paste("s", J, sep="")) class(zero) <- method attr(zero, "wavelet") <- wf attr(zero, "boundary") <- boundary zero[[J+1]] <- x.wt[[J+1]] if(method == "modwt") { for(k in 1:J) zero[[k]] <- numeric(n) x.mra[[J+1]] <- imodwt(zero) } else { for(k in 1:J) zero[[k]] <- numeric(n/2^k) x.mra[[J+1]] <- idwt(zero) } ## Details for(j in J:1) { zero <- vector("list", j+1) names(zero) <- c(paste("d", 1:j, sep=""), paste("s", j, sep="")) class(zero) <- method attr(zero, "wavelet") <- wf attr(zero, "boundary") <- boundary zero[[j]] <- x.wt[[j]] if(method == "modwt") { if(j != 1) { for(k in c(j+1,(j-1):1)) zero[[k]] <- numeric(n) } else { zero[[j+1]] <- numeric(n) } x.mra[[j]] <- imodwt(zero) } else { zero[[j+1]] <- numeric(n/2^j) if(j != 1) { for(k in (j-1):1) zero[[k]] <- numeric(n/2^k) } x.mra[[j]] <- idwt(zero) } } names(x.mra) <- c(paste("D", 1:J, sep=""), paste("S", J, sep="")) if(boundary == "reflection") { for(j in (J+1):1) x.mra[[j]] <- x.mra[[j]][1:(n/2)] return(x.mra) } else { return(x.mra) } } waveslim/R/misc.R0000644000176200001440000000044613430347451013370 0ustar liggesusersmy.acf <- function(x) { n <- length(x) x <- c(x, rep(0, n)) Re(fft(Mod(fft(x))^2, inverse = TRUE)/2/n^2)[1:n] } my.ccf <- function(a, b) { n <- length(a) a <- c(a, rep(0, n)) b <- c(b, rep(0, n)) x <- Re(fft(fft(a) * Conj(fft(b)), inverse=TRUE))/2/n^2 x[c((n+2):(2*n), 1:n)] } waveslim/R/hosking.R0000644000176200001440000000016413430347451014074 0ustar liggesusershosking.sim <- function(n, acvs) { .C(C_hosking, tseries=rnorm(n), as.integer(n), as.double(acvs[1:n]))$tseries } waveslim/R/stack.plot.R0000644000176200001440000000407513430347452014522 0ustar liggesusersstackPlot <- function (x, plot.type = c("multiple", "single"), panel = lines, log = "", col = par("col"), bg = NA, pch = par("pch"), cex = par("cex"), lty = par("lty"), lwd = par("lwd"), ann = par("ann"), xlab = "Time", main = NULL, oma = c(6, 0, 5, 0), layout = NULL, same.scale = 1:dim(x)[2], ...) { addmain <- function(main, cex.main = par("cex.main"), font.main = par("font.main"), col.main = par("col.main"), ...) { mtext(main, 3, 3, cex = cex.main, font = font.main, col = col.main, ...) } plot.type <- match.arg(plot.type) panel <- match.fun(panel) nser <- NCOL(x) if (plot.type == "single" || nser == 1) { m <- match.call() m[[1]] <- as.name("plot.ts") m$plot.type <- "single" return(eval(m, parent.frame())) } if (nser > 10) stop("Can't plot more than 10 series") if (is.null(main)) main <- deparse(substitute(x)) nm <- colnames(x) if (is.null(nm)) nm <- paste("Series", 1:nser) nc <- if (nser > 4) 2 else 1 oldpar <- par("mar", "oma", "mfcol") on.exit(par(oldpar)) par(mar = c(0, 5.1, 0, 2.1), oma = oma) nr <- ceiling(nser/nc) ## Begin added code if(!is.null(same.scale)) { unique.scales <- length(unique(same.scale)) ylim <- vector("list", unique.scales) for (i in 1:unique.scales) ylim[[i]] <- range(x[, same.scale==i]) } else for (i in 1:dim(x)[2]) ylim[[i]] <- range(x[,i]) if(is.null(layout)) par(mfcol = c(nr, nc)) else { par(mfcol = layout) nr <- layout[1] } ## End added code for (i in 1:nser) { plot(x[, i], axes = FALSE, xlab = "", ylab = "", log = log, col = col, bg = bg, pch = pch, ann = ann, type = "n", ylim=ylim[[same.scale[i]]], ...) panel(x[, i], col = col, bg = bg, pch = pch, ...) box() axis(2, xpd = NA) mtext(nm[i], 2, 3) if (i%%nr == 0 || i == nser) axis(1, xpd = NA) } if (ann) { mtext(xlab, 1, 3, ...) if (!is.null(main)) { par(mfcol = c(1, 1)) addmain(main, ...) } } invisible() } waveslim/R/cov.R0000644000176200001440000001573013430347451013226 0ustar liggesusers## Wavelet Variance wave.variance <- function(x, type="eta3", p=0.025) { ci.gaussian <- function(x, y, p) { find.first <- function(v) { na.length <- sum(is.na(v)) v[na.length + 1] } x.acf <- lapply(x, FUN = my.acf) Aj <- unlist(lapply(x.acf, FUN = function(v) sum(v*v, na.rm = TRUE))) - unlist(lapply(x.acf, FUN = find.first))^2 / 2 wv.var <- 2 * Aj / unlist(lapply(x, FUN = function(v) sum(!is.na(v)))) return(data.frame(wavevar = y, lower = y - qnorm(1-p) * sqrt(wv.var), upper = y + qnorm(1-p) * sqrt(wv.var))) } ci.eta1 <- function(x, y, p) { ## x4 <- lapply(x, FUN = function(v) sum(v^4, na.rm = TRUE)) ## eta1 <- x4.ss * unlist(lapply(x, FUN = function(v) sum(!is.na(v)))) return(0) } ci.eta2 <- function(x, y, p) { return(0) } ci.eta3 <- function(x, y, p) { x.length <- unlist(lapply(x, FUN=function(v)sum(!is.na(v)))) eta3 <- pmax(x.length / 2^(1:length(x)), 1) return(data.frame(wavevar = y, lower = eta3 * y / qchisq(1-p, eta3), upper = eta3 * y / qchisq(p, eta3))) } ci.nongaussian <- function(x, y, p) { K <- 5 J <- length(x) x.length <- unlist(lapply(x, FUN=function(v)sum(!is.na(v)))) x.ss <- unlist(lapply(x, FUN=function(v)v[!is.na(v)]^2)) mt.var <- numeric(J) for(j in 1:J) { x.dpss <- dpss.taper(x.length[j], K, 4) V <- apply(x.dpss, 2, sum) J <- apply(x.dpss * x.ss[[j]], 2, sum) mt.var[j] <- sum((J - y[j] * V)^2) / K / x.length[j] } return(data.frame(wavevar = y, lower = y - qnorm(1-p) * sqrt(mt.var), upper = y + qnorm(1-p) * sqrt(mt.var))) } x.ss <- unlist(lapply(x, FUN = function(v) sum(v*v, na.rm=TRUE))) x.length <- unlist(lapply(x, FUN = function(v) sum(!is.na(v)))) y <- x.ss / x.length switch(type, gaussian = ci.gaussian(x, y, p), eta1 = ci.eta1(x, y, p), eta2 = ci.eta2(x, y, p), eta3 = ci.eta3(x, y, p), nongaussian = ci.nongaussian(x, y, p), stop("Invalid selection of \"type\" for the confidence interval")) } ##plot.var <- function(x, y=NA, ylim=range(x, y, na.rm=TRUE)) ##{ ## n <- dim(x)[1] ## plot(2^(0:(n-1)), x[,1], axes=FALSE, type="n", log="xy", ylim=ylim) ## axis(1, at=2^(0:(n-1))) ## axis(2) ## polyci(x[,1], x[,-1], -1) ## if(any(!is.na(y))) { polyci(y[,1], y[,-1], 1, color=5) } ## abline(h=0, lty=2) ##} ## Wavelet Covariance wave.covariance <- function(x, y) { my.acf.na <- function(v) { v <- v[!is.na(v)] my.acf(v) } my.ccf.na <- function(u, v) { u <- u[!is.na(u)] v <- v[!is.na(v)] n <- length(u) u <- c(u, rep(0, n)) v <- c(v, rep(0, n)) n <- length(u) x <- Re(fft(fft(u) * Conj(fft(v)), inverse=TRUE)) / 2 / n^2 x[c((n %/% 2):n, 1:(n %/% 2 - 1))] } compute.sum.xy.ccvs <- function(x, y) { l <- length(x) xy <- numeric(l) for(i in 1:l) xy[i] <- sum(my.ccf.na(x[[i]], y[[i]])^2) xy } compute.xy.acvs <- function(x, y) { l <- length(x) xy <- vector("list", l) for(i in 1:l) { z <- x[[i]] * y[[i]] xy[[i]] <- c(rev(z), z[-1]) } xy } per <- function (z) { n <- length(z) (Mod(fft(z))^2/n)[1:(n%/%2 + 1)] } per2 <- function(x, y) { n <- length(x) fft.x <- fft(x) fft.y <- fft(y) ((Conj(fft.x) * fft.y)/n)[1:(n %/% 2 + 1)] } l <- length(x) xy <- vector("list", l) for(i in 1:l) xy[[i]] <- as.vector(x[[i]] * y[[i]]) z.ss <- unlist(lapply(xy, sum, na.rm=TRUE)) x.na <- lapply(x, is.na) for(i in 1:l) x.na[[i]] <- !x.na[[i]] z.length <- unlist(lapply(x.na, sum)) zz <- z.ss / z.length names(zz) <- names(x) x.acvs <- lapply(x, my.acf.na) y.acvs <- lapply(y, my.acf.na) sum.xy.acvs <- unlist(lapply(compute.xy.acvs(x.acvs, y.acvs), sum)) sum.squared.xy.ccvs <- compute.sum.xy.ccvs(x, y) var.gamma <- (sum.xy.acvs + sum.squared.xy.ccvs) / 2 / z.length out <- data.frame(wavecov = zz, lower = zz - qnorm(.975) * sqrt(var.gamma), upper = zz + qnorm(.975) * sqrt(var.gamma)) return(as.matrix(out)) } ##polyci <- function(x, xci, sp, color=2) ##{ ## n <- length(x) ## y <- 2^(0:(n-1)+sp*.05) ## delta <- y - 2^(0:(n-1)) ## for(i in 1:n){ ## polygon(c(y[i] + .6*delta[i], y[i] + .6*delta[i], y[i] - .6*delta[i], ## y[i] - .6*delta[i]), c(xci[i,], xci[i,2:1]), border=FALSE, ## col=color, lty=1) ## } ## points(y, x, pch="-") ##} ##plot.cov <- function(x, ylim=range(x,0)) ##{ ## n <- dim(x)[1] ## plot(2^(0:(n-1)), x[,1], axes=FALSE, type="n", log="x", ylim=ylim) ## axis(1, at=2^(0:(n-1))) ## axis(2) ## polyci(x[,1], x[,-1], 1) ## abline(h=0, lty=2) ##} ## Wavelet Correlation wave.correlation <- function(x, y, N, p = .975) { sum.of.squares <- function(x) { sum(x^2, na.rm=TRUE) / sum(!is.na(x)) } sum.of.not.squares <- function(x) { sum(x, na.rm=TRUE) / sum(!is.na(x)) } l <- length(x) xy <- vector("list", l); xy.abs <- vector("list", l) for(i in 1:l) { xy[[i]] <- as.vector(x[[i]] * y[[i]]) xy.abs[[i]] <- as.vector(abs(x[[i]] * y[[i]])) } xy.cov <- unlist(lapply(xy, sum.of.not.squares)) x.var <- unlist(lapply(x, sum.of.squares)) y.var <- unlist(lapply(y, sum.of.squares)) xy.cor <- xy.cov / sqrt(x.var * y.var) n <- trunc(N/2^(1:l)) out <- data.frame(wavecor=xy.cor, lower=tanh(atanh(xy.cor)-qnorm(p)/sqrt(n-3)), upper=tanh(atanh(xy.cor)+qnorm(p)/sqrt(n-3))) return(as.matrix(out)) } ##plot.cor <- function(x, ylim=c(-1,1), cex=NULL) ##{ ## n <- dim(x)[1] ## plot(2^(0:(n-1)), x[,1], axes=FALSE, type="n", log="x", ylim=ylim, cex=cex) ## axis(1, at=2^(0:(n-1)), cex=cex) ## axis(2, cex=cex) ## polyci(x[,1], x[,-1], 1) ## abline(h=0, lty=2) ##} ## Plotting functions for wavelet variance and covariance ## Wavelet cross-covariance spin.covariance <- function(x, y, lag.max = NA) { xx <- zz <- x[!is.na(x)] yy <- y[!is.na(y)] n.length <- length(xx) xx.length <- min(length(xx)-1, lag.max, na.rm=TRUE) lag1 <- numeric(xx.length + 1) lag2 <- numeric(xx.length + 1) for(i in 1:(xx.length+1)) { lag1[i] <- sum(xx * yy, na.rm=TRUE) / n.length lag2[i] <- sum(zz * yy, na.rm=TRUE) / n.length xx <- c(xx[2:n.length], NA) zz <- c(NA, zz[1:(n.length-1)]) } c(rev(lag2[-1]), lag1) } spin.correlation <- function(x, y, lag.max = NA) { xx <- zz <- x[!is.na(x)] yy <- y[!is.na(y)] n.length <- length(xx) xx.length <- min(length(xx)-1, lag.max, na.rm=TRUE) xx.var <- mean(xx^2) yy.var <- mean(yy^2) lag1 <- numeric(xx.length + 1) lag2 <- numeric(xx.length + 1) for(i in 1:(xx.length+1)) { lag1[i] <- sum(xx * yy, na.rm=TRUE) / sqrt(xx.var * yy.var) / n.length lag2[i] <- sum(zz * yy, na.rm=TRUE) / sqrt(xx.var * yy.var) / n.length xx <- c(xx[2:n.length], NA) zz <- c(NA, zz[1:(n.length-1)]) } c(rev(lag2[-1]), lag1) } ##edof <- function(x) { ## x <- x[!is.na(x)] ## n <- length(x) ## x.acf <- my.acf(x) ## n * x.acf[1]^2 / ## sum((1 - abs(seq(-n+1,n-1))/n) * c(rev(x.acf[-1]), x.acf)^2) ##} waveslim/R/dwpt_boot.R0000644000176200001440000000154613430347451014440 0ustar liggesusersdwpt.boot <- function(y, wf, J=log(length(y),2)-1, p=1e-04, frac=1) { N <- length(y) if(N/2^J != trunc(N/2^J)) stop("Sample size is not divisible by 2^J") ## Perform discrete wavelet packet transform (DWPT) on Y y.dwpt <- dwpt(y, wf, n.levels=J) n <- length(y) if(frac < 1) { for(i in 1:length(y.dwpt)) { vec <- y.dwpt[[i]] ni <- length(vec) j <- rep(1:J, 2^(1:J))[i] vec[trunc(frac * n/2^j):ni] <- NA y.dwpt[[i]] <- vec } } y.basis <- as.logical(ortho.basis(portmanteau.test(y.dwpt, p, type="other"))) ## Taken from my 2D bootstrapping methodology resample.dwpt <- y.dwpt for(i in 1:length(y.basis)) { m <- length(y.dwpt[[i]]) if(y.basis[i]) resample.dwpt[[i]] <- sample(y.dwpt[[i]], replace=TRUE) else resample.dwpt[[i]] <- rep(NA, m) } idwpt(resample.dwpt, y.basis) } waveslim/R/dualtree2D.R0000644000176200001440000001140013430347451014420 0ustar liggesusersdualtree2D <- function(x, J, Faf, af) { ## normalization x <- x/sqrt(2) w <- vector("list", J+1) ## Tree 1 w[[1]] <- vector("list", 2) temp <- afb2D(x, Faf[[1]]) # stage 1 x1 <- temp$lo w[[1]][[1]] <- temp$hi if (J > 1) { for (j in 2:J) { w[[j]] <- vector("list", 2) temp <- afb2D(x1, af[[1]]) # remaining stages x1 <- temp$lo w[[j]][[1]] <- temp$hi } } w[[J+1]] <- vector("list", 2) w[[J+1]][[1]] <- x1 # lowpass subband ## Tree 2 temp <- afb2D(x, Faf[[2]]) # stage 1 x2 <- temp$lo w[[1]][[2]] <- temp$hi if (J > 1) { for (j in 2:J) { temp <- afb2D(x2, af[[2]]) # remaining stages x2 <- temp$lo w[[j]][[2]] <- temp$hi } } w[[J+1]][[2]] <- x2 # lowpass subband ## sum and difference for (j in 1:J) { for (m in 1:3) { A <- w[[j]][[1]][[m]] B <- w[[j]][[2]][[m]] w[[j]][[1]][[m]] <- (A + B) / sqrt(2) w[[j]][[2]][[m]] <- (A - B) / sqrt(2) } } return(w) } afb2D <- function(x, af1, af2=NULL) { if (is.null(af2)) { af2 <- af1 } ## filter along columns temp <- afb2D.A(x, af1, 1) L <- temp$lo H <- temp$hi ## filter along rows hi <- vector("list", 3) temp <- afb2D.A(L, af2, 2) lo <- temp$lo hi[[1]] <- temp$hi temp <- afb2D.A(H, af2, 2) hi[[2]] <- temp$lo hi[[3]] <- temp$hi list(lo = lo, hi = hi) } afb2D.A <- function(x, af, d) { lpf <- af[,1] # lowpass filter hpf <- af[,2] # highpass filter if (d == 2) { x <- t(x) } ## x <- matrix(1:32, 32, 64) N <- nrow(x) L <- nrow(af) / 2 x <- cshift2D(x, -L) ## image(x, col=rainbow(16)) ## lo <- upfirdn(x, lpf, 1, 2) lo <- convolve2D(x, lpf, conj=FALSE, type="open") lo <- cshift2D(lo, -(2 * L - 1)) lo <- lo[seq(1, nrow(lo), by=2),] lo[1:L,] <- lo[1:L,] + lo[1:L + N/2,] lo <- lo[1:(N/2),] ## hi <- upfirdn(x, hpf, 1, 2) hi <- convolve2D(x, hpf, conj=FALSE, type="open") hi <- cshift2D(hi, -(2 * L - 1)) hi <- hi[seq(1, nrow(hi), by=2),] hi[1:L,] <- hi[1:L,] + hi[1:L + N/2,] hi <- hi[1:(N/2),] if (d == 2) { lo <- t(lo) hi <- t(hi) } list(lo = lo, hi = hi) } cshift2D <- function(x, m) { N <- nrow(x) n <- 0:(N-1) n <- (n-m) %% N y <- x[n+1,] return(y) } convolve2D <- function(x, y, conj=TRUE, type=c("circular", "open")) { ## Generalize convolve to handle vector arrays by calling mvfft() type <- match.arg(type) n <- nrow(x) ny <- length(y) Real <- is.numeric(x) && is.numeric(y) if (type == "circular") { if (ny != n) { stop("length mismatch in convolution") } } else { n1 <- ny - 1 x <- rbind(matrix(0, n1, ncol(x)), x) n <- length(y <- c(y, rep.int(0, n - 1))) } x <- mvfft(mvfft(x) * (if (conj) Conj(fft(y)) else fft(y)), inverse=TRUE) (if (Real) Re(x) else x) / n } idualtree2D <- function(w, J, Fsf, sf) { ## sum and difference for (k in 1:J) { for (m in 1:3) { A <- w[[k]][[1]][[m]] B <- w[[k]][[2]][[m]] w[[k]][[1]][[m]] <- (A+B)/sqrt(2) w[[k]][[2]][[m]] <- (A-B)/sqrt(2) } } ## Tree 1 y1 <- w[[J+1]][[1]] if (J > 1) { for (j in J:2) { y1 <- sfb2D(y1, w[[j]][[1]], sf[[1]]) } } y1 <- sfb2D(y1, w[[1]][[1]], Fsf[[1]]) ## Tree 2 y2 <- w[[J+1]][[2]] if (J > 1) { for (j in J:2) { y2 <- sfb2D(y2, w[[j]][[2]], sf[[2]]) } y2 <- sfb2D(y2, w[[1]][[2]], Fsf[[2]]) } ## normalization y <- (y1 + y2)/sqrt(2) return(y) } sfb2D <- function(lo, hi, sf1, sf2=NULL) { if (is.null(sf2)) { sf2 <- sf1 } ## filter along rows lo <- sfb2D.A(lo, hi[[1]], sf2, 2) hi <- sfb2D.A(hi[[2]], hi[[3]], sf2, 2) ## filter along columns y <- sfb2D.A(lo, hi, sf1, 1) return(y) } sfb2D.A <- function(lo, hi, sf, d) { lpf <- sf[,1] # lowpass filter hpf <- sf[,2] # highpass filter if (d == 2) { lo <- t(lo) hi <- t(hi) } N <- 2 * nrow(lo) M <- ncol(lo) L <- nrow(sf) ## y = upfirdn(lo, lpf, 2, 1) + upfirdn(hi, hpf, 2, 1); lo <- c(matrix(c(rep(0, length(lo)), c(lo)), nrow=2, byrow=TRUE)) lo <- matrix(lo, N, M) lo <- convolve2D(lo, lpf, conj=FALSE, type="open") lo <- cshift2D(lo, -L) hi <- c(matrix(c(rep(0, length(hi)), c(hi)), nrow=2, byrow=TRUE)) hi <- matrix(hi, N, M) hi <- convolve2D(hi, hpf, conj=FALSE, type="open") hi <- cshift2D(hi, -L) y <- lo + hi y[1:(L-2),] <- y[1:(L-2),] + y[N+1:(L-2),] y <- y[1:N,] y <- cshift2D(y, 1 - L/2) if (d == 2) { y <- t(y) } return(y) } pm <- function(a, b) { u <- (a + b) / sqrt(2) v <- (a - b) / sqrt(2) list(u=u, v=v) } waveslim/R/mra.2d.R0000644000176200001440000000372313430347451013521 0ustar liggesusersmra.2d <- function(x, wf="la8", J=4, method="modwt", boundary="periodic") { m <- dim(x)[1] n <- dim(x)[2] switch(boundary, "periodic" = invisible(), stop("Invalid boundary rule in mra")) if(method == "modwt") { x.wt <- modwt.2d(x, wf, J, "periodic") } else { x.wt <- dwt.2d(x, wf, J, "periodic") } x.mra <- vector("list", 3*J+1) ## Smooth zero <- vector("list", 3*J+1) names(zero) <- c(matrix(rbind(paste("LH", 1:J, sep=""), paste("HL", 1:J, sep=""), paste("HH", 1:J, sep="")), nrow=1), paste("LL", J, sep="")) attr(zero, "J") <- J attr(zero, "wavelet") <- wf attr(zero, "boundary") <- boundary zero[[3*J+1]] <- x.wt[[3*J+1]] if(method == "modwt") { for(k in 1:(3*J)) zero[[k]] <- matrix(0, m, n) x.mra[[3*J+1]] <- imodwt.2d(zero) } else { for(k in 1:J) zero[[3*(k-1)+1]] <- zero[[3*(k-1)+2]] <- zero[[3*k]] <- matrix(0, m/2^k, n/2^k) x.mra[[3*J+1]] <- idwt.2d(zero) } ## Details for(j in (3*J):1) { Jj <- ceiling(j/3) zero <- vector("list", 3*Jj+1) names(zero) <- c(matrix(rbind(paste("LH", 1:Jj, sep=""), paste("HL", 1:Jj, sep=""), paste("HH", 1:Jj, sep="")), nrow=1), paste("LL", Jj, sep="")) attr(zero, "J") <- Jj attr(zero, "wavelet") <- wf attr(zero, "boundary") <- boundary zero[[j]] <- x.wt[[j]] if(method == "modwt") { for(k in names(zero)[-charmatch(names(zero)[j], names(zero))]) zero[[k]] <- matrix(0, m, n) x.mra[[j]] <- imodwt.2d(zero) } else { for(k in 1:Jj) zero[[3*(k-1)+1]] <- zero[[3*(k-1)+2]] <- zero[[3*k]] <- matrix(0, m/2^k, n/2^k) zero[[3*Jj+1]] <- matrix(0, m/2^Jj, n/2^Jj) zero[[j]] <- x.wt[[j]] x.mra[[j]] <- idwt.2d(zero) } } names(x.mra) <- c(matrix(rbind(paste("LH", 1:J, sep=""), paste("HL", 1:J, sep=""), paste("HH", 1:J, sep="")), nrow=1), paste("LL", Jj, sep="")) return(x.mra) } waveslim/MD50000644000176200001440000001501713632657122012424 0ustar liggesusers542efa0004762bff65c5da1b07caffce *DESCRIPTION bb6b0bef936515398c182c6d291f0fe7 *LICENSE 966803a71c572c9ad84c2872e5785582 *NAMESPACE ee7726906084ed79b7bee4ec34b86bd9 *R/Anton.R 283911ee9f333cf65ddc7e61c334c0f6 *R/bishrink.R 3476acba18c36562a077cbaa4dff3f27 *R/cascade.R 5df8f93b0b637a5f4b706853b763b22b *R/cov.R 7be361e63e6a80f449c0d7f7fc0830da *R/cplxdual2D.R 49865a18924db44a80f308cb41dfa8ba *R/denoise.R b128e15192f8227f3eaf7c0b787c6e71 *R/dualtree.R a213f4da26ef920930faa05c65e32ae9 *R/dualtree2D.R 64baf49e50de70b427bc0f08d46e7362 *R/dwpt.R b7e6e422f8f59b164e5042a991e2aed9 *R/dwpt_boot.R f758f6b02d6777de4c930d123c32f87a *R/dwpt_sim.R 01d2dc2335492a8654ec5286f7a25493 *R/dwt.R 3d32a0c92a34638dca281fa7c1a73716 *R/fdp.R fca58cd2d566a895101b34f4f93ee4f9 *R/hilbert.R 78f9c697db88de56a14c87b38a9b9df5 *R/hosking.R 9b4a69dbed3124428e8970309515d7e8 *R/misc.R 75d93d0398a5a53d80168ed6244c7816 *R/mra.2d.R 6a32d87313b4a7d3590257fcddbe8ef1 *R/multiple.R 33523946e479acc4d422272402388f31 *R/periodogram.R 80f36c0602a1b0760b4b44d3ba01a83c *R/sdf.R ed07eb0513f9cf5147ae2df17d85ea43 *R/shift.2d.R e58448d5ddbee89c73910e99f412863d *R/soft.R dc70b4ae952d76661c2e1ce1f2d7e693 *R/spp.R 0c122387d7a3b13ec6c0802352c79d80 *R/stack.plot.R 13f601133b97886ce4b028e66a79d006 *R/tapers.R 19a4b0f618ed5772fcac189263db0275 *R/three_D.R 4c06fd4278ef2ba7a35555c8184ba427 *R/two_D.R b0deba4b0673841913e9f06ca5f66c6a *R/up.sample.R 0d103ae99d38155c04c51cc17b2e0c77 *R/wave.filter.R 4792056f444e73e604ff25bcbf1933e8 *R/zzz.R 6fcf55714c4648d79aa76445b9c91420 *README.md 2c54875881427e9e11ca442ceb224a8a *data/acvs.andel10.rda cf92c999586c0d47480d827064ee56da *data/acvs.andel11.rda cac98ed2927a008aa75f1690c880cfaa *data/acvs.andel8.rda 361c8f272577f0cb88e066894279aa19 *data/acvs.andel9.rda 17c0d777ef4e322393f01024171646c5 *data/ar1.rda 5417bed2534cec6a90b30719da7f3e6b *data/barbara.rda c0f344ad3561f3521b65ea3e4de75c66 *data/blocks.rda 5d8c76cb6ed07e8d22474910de9a502c *data/cpi.rda 42c4c8cfb985e54ccec5ee83679fa6c8 *data/dau.rda c6500a86324493afd07d88dedcca7761 *data/doppler.rda 49498cfb4cf627c477962aa90fc797c4 *data/exchange.rda b07432bafcec5fbec44cb66b06692d1d *data/heavisine.rda 9552c7b7bdcfdce5415e3a4b1a4999f0 *data/ibm.rda 18347dc823c55dffb072a2546131f0e5 *data/japan.rda 6434bf77341a56722aefc66fb0231838 *data/jumpsine.rda ff23e9fd80480ad2f97d1334a023690e *data/kobe.rda e52a6e6e9991fca3f2d314c8b679f8a4 *data/linchirp.rda 75bd9f10694c9df903c8ea5d8a374f98 *data/mexm.rda aa52062775ad4602c4dea1d77abdc86d *data/nile.rda a52e43fb8e4f76b59cfc10f00635bb48 *data/tourism.rda 9f7cf7c9f9d56a63566d4e7b5ed61fed *data/unemploy.rda e9ae4281dce09f262cae6364bf4288bb *data/xbox.rda 06db9250aaa15cbb59e53dfb3e6e7ce2 *man/Andel.Rd 4d8d51f6abaa11f5b97a8c6582b7d58d *man/Dualtree.Rd a43cbc5c0bbd3be5c24b419755de59fd *man/Farras.Rd 7f640a8023fda1ec24c6ece6f776b108 *man/Selesnick.Rd 4c5baf2dc84176614f37fa3976217dab *man/Thresholding.Rd 62ad6b5f960eee0cd8e507f0bbd6dbbe *man/ar1.Rd 0edf8327be32ca9e7ab3408caa50f62d *man/bandpass.Rd 08cea8c395895e5471e389bf0d67bafd *man/barbara.Rd a974f06f408ce793aa5972b2792891a0 *man/basis.Rd 87a2db6cd6d769367477fed1f2c7fdee *man/blocks.Rd b3f6b4b83bf5aac5bacb93c914c48846 *man/brick.wall.Rd f34ada00bbc8dda86e9cbe084f3a08f1 *man/convolve2D.Rd eb253d09e51304b00ae0b821b2eb3539 *man/cpi.Rd d61f276b4062884cf915db2e39c0eab6 *man/cplxdual.Rd 98ca23522b00db767673de745a43136e *man/dau.Rd 5b9787b9870297570c173c9356fee698 *man/denoise.dwt.2d.Rd 0850ff2c2b52969232c601b68ec4e7af *man/doppler.Rd 1ffc5555279edb4506834648a8d3d472 *man/dpss.taper.Rd 5e4342594a04092026d6bb0167fab850 *man/dualfilt1.Rd 30330e0ab71e17049d04429ab27cf7ff *man/dwpt.2d.Rd 7cb395c8766a8537141b41b3dafeb93d *man/dwpt.Rd 3d139ca6785bb713d283e552f66ce9a2 *man/dwpt.boot.Rd 200d8790e9924b3596725ffc0ce77f28 *man/dwpt.sim.Rd 3f09d19e2e174e80b37f04d958510cae *man/dwt.2d.Rd cd073ec75bb6a42de6c7fa3c7a42c479 *man/dwt.3d.Rd 367d57e21ce16931f4905e8d312ae6b9 *man/dwt.Rd 7e987fa8cf61d015aab4f971ce47e356 *man/exchange.Rd 2033bad974a2b0b112840f3161aa5497 *man/fb.Rd 4587d30c5ef186a3f873ad195c779596 *man/fdp.mle.Rd c6bed328bdd8c2205457174b59a3d48f *man/find.adaptive.basis.Rd bfcb2cb6ba702c86a76d2d98e19eae93 *man/heavisine.Rd d4621a5d068d2e3171f8d958acf6ac75 *man/hilbert.Rd defb74293a459183e8696fdc1748439e *man/hilbert.filter.Rd a951278a15f8659295a8b71eea64e16a *man/hosking.sim.Rd f170d66a14628263ae91610061d6630d *man/hwt.analysis.Rd 59f8439fa811c79cf47e4731cb3edbfb *man/ibm.Rd 192bc2b12540302c939c16c15a525897 *man/japan.Rd b8de31b2a5eb9d3b4b941b9252cf13df *man/jumpsine.Rd dfe2087f0aa57785c99114d9b81469a6 *man/kobe.Rd 96611acfea234828a0872e8359a09f23 *man/linchirp.Rd 2216631d6c77fb606bf54fd89e94dc21 *man/mexm.Rd 9df790ea67f8941c4b5b3667414bb93b *man/modwt.2d.Rd 51a0cd47ec31208de685a8f759d1dd23 *man/modwt.3d.Rd 92bc4809e9418be1b552e34a5e8e09b2 *man/modwt.Rd 79f054d612bf4cc3797f833a0b12307e *man/mra.2d.Rd 1e1a9f9ed599913fda54a3e6a2bc49ef *man/mra.3d.Rd 8c9e3efc0189015d7dfe57f923934758 *man/mra.Rd c147302075bd3e33f5845eb9a20c366a *man/mult.loc.Rd da7e62d31fc8ad46677414879f03a717 *man/my.acf.Rd f2acdb3941fbec392ec5b0623661df3e *man/nile.Rd bcebd48f9728e6912463aa371d97ec74 *man/ortho.basis.Rd e76d9143fe39834f7b2460d4d7bab5b6 *man/per.Rd ca97b578e94bd7d75b438eab8da82a5f *man/phase.shift.Rd 12923b6ac4c17da09bccec62c8653d8d *man/phase.shift.hilbert.Rd a84354355ac764690ae8566e08d655a2 *man/plot.dwt.2d.Rd 24b4172219f0f17c6f8e35079418feae *man/qmf.Rd ecb9769808cf5b8e2fe40b34c707acca *man/rotcumvar.Rd 286fd668bf5eefa07cb4d4424d05823c *man/sdf.Rd 23ad9c4517ec38b366ea30f4faaba82a *man/shift.2d.Rd b4fed24aaa4f8f937c9f2b588ece487e *man/sine.taper.Rd c0fc19629147fe066d760244dfc8b767 *man/spin.covariance.Rd ec0eb3ed4233e923017e6816f75034c1 *man/spp.mle.Rd a1793d6d002179b0d391734f99191855 *man/spp.var.Rd abb84d5d22ff3166f7e8afe5acca9bd4 *man/squared.gain.Rd 962a2ea1f27c8870eeef07991c797696 *man/stack.plot.Rd af9d703949e2dd958cfc29b5eb4c2999 *man/testing.hov.Rd e6d7a4933c5ff465079e932baa94f7fb *man/tourism.Rd 03aacef32ebbde9ba45a8ac58c43f24d *man/unemploy.Rd e5e9fe7f25d3bf5398ecdbdda7f6394c *man/up.sample.Rd 0a8be24388d4e6dd9b75900220dab320 *man/wave.filter.Rd 709eb0237cdb575b45c896586ab48951 *man/wave.variance.Rd 9c9877863960756e86d742969318873b *man/wavelet.filter.Rd 7df353e39c6a1dbd88af0c3541a4ca5d *man/wpt.test.Rd 61a1e785c7d70ca19bed449cd4c90892 *man/xbox.Rd 4486c42fc3ef32497070b963b34daca5 *src/bell-p-w.f 75647cbbd90f9f58c174cb3371289f83 *src/dwt.c 479a078c21ee6b5d1a624462afbef1d6 *src/dwt.h 3934bf3e81393ad972a51d193b262b5b *src/dwt2.c 2822bf88a86280390e5110cb584e1ccf *src/dwt3.c ef0296f98c4e377ee91ec48de1544acc *src/hosking.c 23b58f83915bd83fe339e70587ce584a *src/init.c