multitaper/0000755000176200001440000000000014456220702012442 5ustar liggesusersmultitaper/NAMESPACE0000644000176200001440000000134514456126666013702 0ustar liggesusers#exportPattern("^[^\\.]") export(centre, demod.dpss, dpss, dpssToEigenvalues,dropFreqs, dropFreqs.default, dropFreqs.mtm, dropFreqs.mtm.coh, dropFreqs.spec, mtm.coh, multitaperTrend, plot.mtm, plot.mtm.coh, sineTaper, spec.mtm ) useDynLib(multitaper, .registration = TRUE) S3method(plot, mtm) S3method(plot, mtm.coh) S3method(dropFreqs, default) S3method(dropFreqs, spec) S3method(dropFreqs, mtm) S3method(dropFreqs, mtm.coh) importFrom("grDevices", "xy.coords") importFrom("graphics", "abline", "axis", "box", "lines", "mtext", "par", "plot", "plot.new", "plot.window", "plot.xy") importFrom("methods", "hasArg") importFrom("stats", "as.ts", "deltat", "is.ts", "mvfft", "na.fail", "qf", "qnorm", "qt", "ts", "var") multitaper/data/0000755000176200001440000000000014456126666013371 5ustar liggesusersmultitaper/data/percivalAR4.rda0000644000176200001440000001730414456126666016202 0ustar liggesusers] 4oeWfߍ}\0ٷ첦EP!k{JQRRH&M?93=s\ϵ|=4/^+YXXXYXXX٘SvV vjGht映TwC6>e0.n*B G?,@P줝)c@Weݠ[Skf:{ T 9ҡ=%aOA@;e?Hhe@-:}> h-EPw'87/u⩥sJ`ĩ`j=~xUn%m/I)wu$|;d~AR0 nXS%Is=oۼ]Hyz=[#ڡIiweh%=񹓶 xV TwBmşkQcvu5kFI"&2n;2 EV.󁘀w7"Դ/x^cPKg lФ'ɢz ܍Ujw߻ LȔ뙳(h6j]~Zt(;jU@ڻ0#|, ք5Mєql! ]P oʜgƛPqq# +H>[‰mr(_Mjw~'hmbgrQ+Bf v4sP7,D`} [DS5F--ƾwNM{=@o-­Yϡ&5at Zó&W(ȳH73} cE4 .+Y Uv$e Ay7H=o{U6MՔ*5[ ''䀕/ f%yGPc}7,z8݊3m|uo.&jE-/"l;h=+-o쭽وYhT=.y^ ~~ ҕhPطg X(3}sfUR~^%qn?}:(s^eΡDIkyQU3u-bzDa M53-= 0uxBL2eEzr(Ž?A<̴lwAM`y9$NGAC2HS//& WD~|N}0.dt%\oAѭ3.(&hu:-qC(7/Z" Q!ia&oT4عV!U 1RSy|a|6(_C*'M.ߋG-zXbpܧ䤶=暌) ϩ ۺP6"nw@78Yڽz,:R. ֏je^j-( 1F5{+śߢiR CmC{Rs`Yx[irch$?}\2ybԬ -.}gTX>R 3)_fhC <:!;1eT-:xtr^CZrnTJ*f;9έAQq%v\U$]H%/ء:Kt"sH~|6lbZh'I|pw PO(ZǕ+x}?0F8u\GjoxқdF.4:n{G IG7DF,CCŚ(D, JaI)9O(2T{^Q 7^ Z7JYJ'=2G5]IѿfxA_ R6D0 Խ5h5hZ]1CK IcQ ϫ2JkNBWH3KdAcR/B`}}f02ɳklP _T][54y 9U! m5i߃6_Gu'̆?d9xn,E713d^l)Gk¢~o.CRGqc4ް 帷W􃝬ۼF V~Gr]|LNvC1稕q`ed4|8Kݮ:S'a4ά2zh9k`wy.:@>9{ڕ]]3x/;:_>(6#h:3kyt|kJH Y7~@=>+hv?gx3ZP0r./Y2m]qR2N(g|9Ox+㏳(\3~(Kci> _s!"X>oENB26mmG>jqW|򭭉|ڀ;TM:Rz=Uy:G^{ 72x map>l~f zF X޺z '(KfSDcCL0*E㍀Aa *݉@ipqYTm,< GouW>}ը#u$Rmn<r|(&GիZm:kgH0NLBE~9/rbF]3qSE]>T^+\v9|/8b`~ZuL]a.]mK(4~`mm;@A| /ᄅ!U\ g{T@PiUrڼ庴q ]Yy+=('Kn h-i]>bGή]GƁV.RjV[]!&,#T2fD4FnT$2ڟ,[~CA'9Mo4ÎsЪ9( ./mF]s} ^Um=n Y#=YyYֳǢ*N9Ɓ} z)7kR 7O_%(68 oA^kqz/HЄ=`9Zd7-ƣk߶ z@ slIo=c^F'XhIZ^RM4p;c)/hz_(sMg6>Mi~l&|>fk [~[PV|/SV{Asqkr'؛9xF Z@%m1prk+q*F0|ޡSjfA g8j@iŃ@1,]J%P}j;]4CvܨoYNt\6qJ0N3n.Rb8z}HG#5n--h^3?Vbm~OCbڻr4LV.Z+KE.n ^Kܻd6_S6h!C c/l'ar6=l +.ݜ]Ke-{| K a@h'AAhGx݃t%8ofTKa~-!mff~3mW:DH )#_Tz&`Jc+ 鉉%"#y^ALV((}au 3;y`]$-'KuP֌r(/ǩf)*(U!gP~H;u5x2S \ie *K߸cAkL`* >h]M5!Qg-%}Q$0uUjk{ M(ԋE?W|{,=f* fˏ>\Q- Գ/|P.񎗨٪H9_k:ƷlNm}Liz!Nz3=,j"քʧvHG Sn]F3U3 (q134]eRk58t$~9es^f#A690u WVqVPAz+ݩ<@5_?NGOk5PUͧuل'4(k-}tP @EBZ$SőxDEiJh{].G_y>imbOW6X6}1-Z05Գ!hyh#CY|o6ʣ})ǍČmte{@l ѭKaIgmH1C۝䎑j*B_g@fnTAz`)7:W mW^u$2&]ܚ"yXH*|5iGFĢgws]gn&a߯|kN!濂aðC6xVhw|@ OWǻAvb@`G@ e#W'e1&.r~"xy3iZd%&uqY'MVq`T${yjEXtъgОh\-") P/Y{n%A[&#ц<ѥ֢gM Z;PxюhXjD[\ GAIb0/|~4UmZ*x//nFs 1yUL$.}sAw(Л{c!oR YdNn0_QY JGQj#h\V1؈d143Ck:S?k ց XȎh꿸Rm=DwKѠowІy~/F ^]N'__e<3-pl'@bjPtjE{?yMes1iHea:Z$]){"'Z.ǂUn_w0->d^)glGԪE%Hfd\9X;Uj3s",~UnYږ<>jn djҞ(Rk(_MۏY1 ʻ~MrK{@!0hD0b78Fu}jBvhdPpNO6V\5Bz;o65r j@ӯ6A ͪ|+,2Qjf6_BBIS K4F+W#LE2}Œ*/nZ05x^^G n3CҲ~Zٿ~h&euR~Wd]BJCۚ{в|ZgAZp}089֨GLQ=یr6P1f DiOSΌ` lk$vIŀCИΙ(5GJ+U';z<5\@_ML< b_@ÿ5DD*w$} {k']y`=k N>z}gz_{^50{(tUz M l]86,Q/W[:Suxs-LΤ%m: Em@WOèޖswY&[ `{(Пf߮k5bQ]S Y&T "98~0b#&*{DZ)aߌڞނwHX|] K/ڨV5&P˲>k|ӡ,ܠLOd=sV)r%$Bi1O hw|g/Ze^dʴkf1( ژmK.az'Ho}V~+Jm$@5T)'W9sZ9[*'-4 5H:tPӑkBSIc5ƈqhwmʼnS2@J_Ξ;W"MM)䔠wElJt׼M'L,t[6N %:L\a?b]7{-tYR?XcɜJ=(muTx*u*&eLM!M߳H:7aj]}g<_CzAR9 έmB S-p}d^ dۨu'b6C~: Ps _E]z}<jZwt-Ikt,t<ÿYEZ3ۿ/v|cvђČ :a 6 SF4 ~_H4dm4$l>*Zk_"Ae8$͜-vW(,EݑjH|e5NvaLnUQgH/3@9]"K˒o@t),_S, ]T$\ɼ#XNF_]/j?րȈOq0SVMۯz}{\KN2&M4޿Orh<ԛ>k@t[ h'Glu(L@Ict͗pmUOj TW.ݻv0SoNAv1'I,}of multitaper/data/CETdaily.rda0000644000176200001440000044226714456126666015536 0ustar liggesusersy^Gu]Rdmõ.*˲%ْeцfSc3yfQLfe$&?Ea.%ޣ@[7 "}^7b)̽O~g_׏t9җ/=瑇C<~ů5_tst!?z{O(X(b5_(+(V+(VEQ^EQEQ(U((V/(V(X ~\EQ (*(V_((V_,(V(X ~REQOQE|(X)(V/EQ(Ѣ(bUJQE)(VEQcEQj(b5zQE|(X EQEQjDQE|(X ,(V((b58WEQ狢(Uᙢ(b5x(X +(V狢(U(X ^((V([EQŪRQE\EQ.(V EQŪp(X ^)(VKEQj(bUx(X .EQkEQjp(X^/(V7(jQE\+(VEQjfQEUEQ7(UfQE]EQ((bUx(X [EQMQELQE*EQjEQo_EQCQE*EQj;EQ{EQj~QE*EQjEQ/+(V_^EQ (X ~ע(b5݊(w/(Vߣ(X ~Ϣ(b5(vQE*EQjEQ[EQ_QE*EQj+(((V_UEQ `QE|(X (b5٢(bU()(V?(X (bUË(((V?(X (bUEQjGEQSEQ(Xآ(b5(X (b5㋢(UEQPEQbQE(b5(O.(V?(X Ԣ(bUӊ(O/(V?(X ̢(bU(.(V?(X ܢ(bUEQjEQ_EQAQE*EQjEQo((V;EQŪEQ_REQiQEeEQŪEQ_QEQeQEUEQŪWEQ_SEQmQEuEQŪEQPEQcQEMEQŪ7EQREQkQEmEQŪEQQEQgQE]EQŪ(b5EQjwEQSEQ oQE}EQjEQ?PEQ `QECEQjEQ?REQ hQEcEQjEQ?QEQ dQESEQjOEQ?SEQ lQEsEQjEQPEQ bQEKEQjp(X (bUW(_-(V(X (bU(X (b57(*(V(X (b5(X N(U-(V(X (b5(U?,(V(X (b5O(UEQjEQVEQEQo*(V(X (b5/(U*(V(X EQSEQ mQEwEQjEQPEQ EQXEQSQ=~x>K_/_q W@<k__~rv9].grv9].gٓ9].orv9].grv9].gɜ].ouv9].grv9].grd.ox].grv9].grv9{2gvy{]].grv9].grv9=vy..grv9].grv9]Ξvy]^orv9].grv9].grv9].grv9].grv9]vy..grv9].grv9]Ξvy]^orv9].grv9].gOvy].orv9].grv9].g'svy].orv9].grv9].gٓ9].orv9].grv9].gɜ].ouv9].grv9].grd.ox].grv9].grv9{2gvy{]].grv9].grv9=vy..grv9].grv9]Ξvy]^orv9].grv9].gOvy].orv9].grv9].g'svy].orv9].grv9].gٓ9].orv9].grv9].gɜ].ouv9].grv9].grd.ox].grv9].grv9{2gvy{]].grv9].grv9=vy..grv9].grv9]Ξvy]^orv9].grv9].gOvy].orv9].grv9].g'svy].orv9].grv9].gٓ9].orv9].grv9].gɜ].ouv9].grv9].grd.ox].grv9].grv9{2gvy{]].grv9].grv9].grv9].grv9].grv9n.ox].grv9].grv9{2gvy{]].grv9].grv9=vy..grv9].grv9]Ξvy]^orv9].grv9].gOvy].orv9].grv9].g'svy].orv9].grv9].gٓ9].orv9].grv9].gɜ].ouv9].grv9].grd.ox].grv9].grv9{2gvy{]].grv9].grv9=vy..grv9].grv9]Ξvy]^orv9].grv9].gOvy].orv9].grv9].g'svy].orv9].grv9].gٓ9].orv9].grv9].gɜ].ouv9].grv9].grd.ox].grv9].grv9{2gvy{]].grv9].grv9=vy..grv9].grv9]Ξvy]^orv9].grv9].gOvy].orv9].grv9].g'svy].orv9].grv9].gٓ9].orv9].grv9].gɜ].ouv9].grv9].grd.ox].grv9].grv9{2gvy{]].grv9].grv9=vy..grv9].grv9{ #{7xg {!~o>ēC<C<>sC? C|!^z_P}2[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{DʼŶ':ylM[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{DʼŶ':ylM[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dʼն;u|M[l{DʼŶ':ylM[l{Dȶ8z{Oo|hWWޏu?y*/-?r_ܕGJuϕ4?^?-ߝwy#\{RgU SuRλJNj_xyٿO+:sȉ\@rGG?~`Y'UKhʽ.("uz"Iu;Ay{UKJ8i߃ΣM_P}LWwI.+}y껬rEUuRο~.^WzUM) >ޕr\MsSב޺'uݭ;|y#yo)qWM_Qo*wU雴oY~r^G㖇znoIo׻]V\G_}S)pRN31ߍ8f]ϭe; C}Og2pQոJ)/\(O{*x< ?W'8 ; zUע8J?߉B[<|%y<<)guΪףȭzy;qv.zEa_'Nu?/)9v!χ?do.;=i{T.|>]sr؏￰t|(E.ϳOFsο8>οO+hx_RR~?[/O/)?7\2{S#x=(~ϿOy?Ǒ/ ;:O߿6xQO~ c{bqQ o3~1S?WCp?/yxo:s8^>!oM;)A1lޥ?{!eۿa?Ҿv3G=ʧ~KĞܵ[v=;ڹ'ȫoecs_SSNzG;*O;㪇{{u;<~N=滒sѮܷ,݋|;G_7'qJ?z^W++Q3i!3=ק]LlRN)+R;[:wiOx?r'6M}IxھUɛRRԏ\_V}v'sx޾y5̧"F̃a/ydy~Rv]q'5B~ui_<δ.׼G:~"=9ed<}_zW~}O^r?uۿM؜odcz>Y3_~;߉<1.{Ǝ^}ז=ߍ2~wq~Gy?Iȃ9n/AKO~<7'n>yD;gwixa>"qOG3zƎP?ȸg{~88Ësȫ|7_@~vU}T{޾J{v?PٴC~҃<{R~Vayt=vLc xOG?iоEu M̛=j4ϳoE>v󙞏Q~|y="87?o;q~rND~WX WO@)/'Di~udz{ 0K?=U5uMyQ7<_F:$WaUvvcO2svyzۿ:ypߥ*8:Vuv]v[/ghG=q:~g_~ޑ:-Ul{WR=oEuG;q=Poqg=wߊ|k~_~_''7 Oڥ^Dק7׏b>Rb wR]?;7.F{i?OVws</(_m:~ U}=Ox~z&+y=r3('z|/\g=]]'Nyg8_(t|?t حw~qyYv W(`:S3^S;HG{1wW*}~2.ѫK(;*F?yv7Ϗ T{^^S??c~ K Lq38yng 0/G.u}~?^oUy*y5.ww~8wq\o;W1yz*7V|'@vRc?g>QWs]"^g7*]Zy~[⾧v>9y{'qo䍬ryhϜǷߖg;{v=|r?]AC@^s#UYLQ}# O /rWF\wrB_Ϋ=DŽ^S{N ?Џ+bC'&9<m_r?-tW }`n?T~%Q#Rt_YI}oys瞟rztG8~1J|-8vt/=_^T3'/ӏ~jys9KoKwÌb{Pz]rԃ=[?e=%Ǫ<07J~{ߴROP9a*wNy{{= q f~:OێcrFq?=usvŨ/SmW2oj`G} ?oGo{_ӹ4׵}>>"R;xqy{?RyޛPlN\uS4.I~'yD?y3w͌g#Ƌo+K=G:\\;;=_o^ qK:Oz>Fc 3υNw9|țƼЗR?$v]O=JiS/NzGu7CמO/o1o-%G~!"yЛU9Kga\#w'zR}n G#k'u|$xV =(>2|K!>r3xjySrvԑsc}-xiGG=O{I:{'S8z_?]o;yS(#sK^q 8D?_.)uӉʟ>?^S`y_;cZn^wgr|SmzK9ccQ~3^!G^}|AN|(&dg*ǑJ>&qʡ7+'VG({YsLii*<_\wv?]UyN3q5|Rj~>8y2szybہǻsK?_qS;.~;RBvo㰝F^=<߮ס`:;^(m>۵ȩBnGRt(Co~S?*Gk8q\rza\^q\qO?We(GӮe>'_]*Wt=O*B gBds\iʩ}dK8tx|¾NL)vnx7BIy>bGS:9԰;;G}~c[Q ^}AN#(eqI_ )/9k,Wa~$?~b7Kb\w_8#1QyM.xy~+S8]k-?~~1?vyox.M9籱}Г(wѓ3#iW=_湒qy.w/ãۧUTi~ӟ;ޜWyN?޳{ѿ;]y=ts<:ߓGC9.2UCF!~Ǟ#.;ww9y^8 Sc=FyEyy_U?>-Gs{`~Ak?p|G\]}MQ9~?/ N`Ƹs^~~/*xw3w6<(!bG/4Y<}0NORrJ/~/>y.\y 8qǰ{oW+y65OFg3~.B{ql(Oק*Wi7:κg9Fh+R_@{t\r:^YGo?]jOUzG}7o`; -*g]3ݩ;Dt\JϟKR>cao~~,s?BN_R吟zXBn8 Cy@;{ǙRxxy'EЋ?~޷Ur|7|;OǩgM ]ÎGsLRNyԫ2ڳg<'r[PwWaُD>|7EDZ+c9Iz>'J3J~;Rm}o{)RϿJxJ1Q?܈3?$1i7M{~IЧuE~9~ f8w$ wK;~Ry$eԌ/ p}/?'U= p9dD:Oy[w><zAoos_#;?҇9so;cqi2~紏ڣ<X>>9#~&l6h'm~v?)ʧ}y, y}o.e7yפ_H^Gw_q[&wǽP2 9w C#qykyyyDZa|ƸdH z89t?ܷ(*hvpO[3_*H<.*6q w~Y{HC/gqїss<$=]s~_oURW|s$'r̗xoKqy>q3T=qNiD۞y-rU\O.ϟCz7ZvޯRx쥈_奄8y䳌7қ='u}-?x?quM<#kO.4gK7d=ѭ?~0ԛ_1~})}~|zR:LԗY] ?Ǎyө4*Qؔ_ y~9a|$22?r9m{Xw_g%uqq?yGx~(9v~<9qyUiN}^~^c^!MPy?bT彮=)gO B.o?v1Ϙ~ K=}f>_?^S!kj=!0_\#b㺟G_:ʥ7/T{:Ƚyn~VO?T0:?, G̻0) =0Oe?psb)NyKpٞ[ZyC=/?qy˼2s\/xNy9i:܎(e'z>8l2?ya8!W(NQ҇<31.cvw(_~[>Ϊ7 qM/gA}З~'_ƻx^2xÞEOَ{~#~i>}MJԮQWrvOaܠ8#ўZ(侩`^Gi~/PJOaO{O1?|ϩ ?/NjyrRs{1v"vyN`o{Ed\~ѮT>oD?i3~yB[?]oاvo43MK?8cpv A ׀'.Cɸ[n_r9n<{!/{~% {qއPӼߑԓby/ۻ<;?:AGC^/ܡi~*zkx\<.NƏ~{~d:lϑO#Ϗ=?40υo9IW}OmstxW}{J|_=aO:Ǜy)wd~r'z7~rC`)gS/9C\8nE8w{9Gyx>zU~{ <<ϒ`]S=O?^3g͓27wx$?|ǞE>ea\*v?xz챼o'W}O/yj|\>xN)Osquu1sOygǸQ; τz 9Ušw?|~`|}qۙ׎wb?RG<>Aөu:x~bG_z!σxNe/w>[b~~,::g[~'WGLg8ޕn 9Dst)`Yo~+zwrػ#u^ߧv=v2z<.~]':vmuwCg h'M}?8/^qa?O3|TUMqΧu~4OǠgx_-qgߑ'Gvy;Wywƿ{:ھxMZga:]#|>?qĝދ Ir^zgw]-{za+e#F*ϷQ+)J}ɮ?3,~\g<]Q{''쿡@̳s?g~yW~"~:{=?u/z۾?ޗwy+ul]h=?6q>`|>1sUʼץO_W=oM$秮yT~viGyR9w\>.~!<굿n"]{~J9o{I{~Dh7/ >_s_uo:s=(ތ2o#Q[:>]%SO;rQT3nL}:;tqVhW^ry}{-(Ɨ')}%c彎98ܷ6.UCi/$ UMQzOEGgTy:ߦҟecR94cc;r_^a7>p\ia_9^D\D0>>ogbw8yg7*󧙢ԃ RyK&E^G?11쏡4y5zq Oq 0Nt<ҟ 9_v{:O0)y3ѡx޼oOjvw&S?^zu)"Q:nR9r硕hu_>MHݎ8^77t{=RA 3|8zC~wپ@x\qozxG#?rO?t>'\Ov%ƣǑײ]R1t>k8q|=Nt=v^% gAgH_ᾐE\_W;"{}!#qK(C"G9<'y>wŸzȽ綎9O})x=Oq/=?~һv_qVMzpK2>\ΣfܗsqLzqHN9g<~߉}Л#/O^Ά#|uCORO?yї(#pt7H>q5vzu(~Egף ~MWW)Ϗv>:Ai2^q_?COn/v?Acm{;+ŏ]{OOύ|n=H_|' q>Q}]_cd|]IչލqJnxwXf4UG8_Dž}!yyJ޾񀽞G'痩2ԞCO#gOz;~zLշWFǽIs`MΘL^x㥾\J>[W~Gye>};I'َS>= :u.F{?y^^~ȯ<ï<_3KOKQT=Qkq=7c5/<@M?Tއxnr~/q8.Dy;DRH{~GU ǿ8b䱯{ƫзяwfɟ^gx_{u>gf|y?87+Q{GЁOEޠig]K><ט7Y/%~Ox!1C3ul8 #2>qY\gߤ߃r}y>|I=Kh~/?yu>43/:޼eo/缯w{)8ᔿy?'_|Ɓ8{w'ύG߬t<):Lm2 {MG>{^iЏی?uyb qۓ:uu;~ʿj]-zA^G^ڡ;z^r{Le_=!%uWBoB?^I}~?o\ ra4B.v(_ {>REJR^~YwvOa [ԣN屓υzo/˹_ʿگ"C݌qg:?~8>R澥{ wpc]:/7C=gw5#ƁM*u<\*GhFwA;ߥ?sTi<>8mEqt|JG}'_ک3v9ᾎ+OhS5!Ie;P{NtNٟ=9N\gŒ[}tNq)Wg^~<웨vЧ=$@zM??V񽹯ĵN=طK1y"וj|yܒ&o>yfڧ}<z}e\\WuKR9ig4+z$]uW|=_x8g·<'ӏ;C/<>ѾTP3/=TۅJ7/8fA3G},y+qpr9Ϟqkq!ٗo}\zvt~wwo ?eS~eh[z.Sr{&=g}y|(6zn8̽(s|y\~#w9N?t=ԳrgCq%'7xƿП2W'gO8N>•{ܸҴ=QP9xNI9+G?&C_A|;=\OTs?|>xoZ֕:w>R|oB)3 ߁?4 ztꡟó(O_:QߋEu.~`\oGves$]J=bU.#4ljaܓ缎{5臭}iU{igcgWKns}p̟q]{y}R<]p{+\~>>oxx~^y4sh߿U]9젫*qququqU#S\R 2t4{/^vW=^_uCzn:"r3x1ia8MO~Ki񫼿)u~7!ӫQҟqQu]})vu_hO)v?7skȧ4]bQ?_3}by?e[:Lgy]yWzj|1X'2os_8+yGX-w"D|:;Km71s7׋b_g{ԾU}e'q]x>|cH҃Mz>{$[y'˗wc~T.I}0iدK9zXEm)zw&x-®{~Gq>3n{{q}<ϪׯIq8P긟:[k/3zq>݋#.8vNǪ/yWxzq+M{oQ};y\>?weoaș>.w7^Y'q{#/6UP,ۡ^'H]}iBQϊw* oJ]7ߧIyUQ>Yn:>sq\}o or8CxgI џϔد:0O<؇gTȫr:~sW?ƛca]uہ#̸ S<>{C7?П"ߞWS݈{ !U)/ ySB_#W`R/-27^>G;EYOAya>`Sv~r?qȗyQ#߫:ű'Q3>qrDxn9n{=GΏsgqJ\/Z}%8`Qcc9:9X>'ʿy({;]o/q,^;^wsø-I?7>q]bVkz)F3^j83s~wguqtwgzE7+|ēp:|}qNdߙzz8_Ï@3μ)z9?{qYg|=D)t?r?y/q?q:N!'wEoar_s*P3~|1J{k%Gߊy|z32Ռ9{:3~1̏sT}TbCC~2%dHNoB.-{tq9}?Ƽsv9K|M/Ưq#^_K3_=R;CQzF~Gyh'~ze0>=Z@zo>O?Isq{cKpW7uj|R- uy~oFs_w3/yrx!x=q}9zO~#_'>#ٯS>Jr /W~#8U罱W_ף|[8:x~qϷٵKyR]wKپ;1Оu|;0uRx;#ߥ>7>Zʵ2bڥeA?;OxqB\mO:~F~`F~oN"t+ˌM \rQyJ؝^r?hɺ8ҁ~<3ߊ=u>9'یߗvwFiy.*=ߏo.]b|A{9gyyXڱgaqt.3˼b7g?t<8nlqzrߣU.וf|4c'8Nʓ^v1^ 9rnў%ԯow|]oȧݎݘ8=v/s؝D{_o\zHJ?8x2>_ާq?2W7{=9x~=q?)eq8C(i4߿2ڿNr9埌{sާyOoq*9g܍ʓ{8gr=:NR)8%I5_<rhC:9q\eKHƅT^z2N~8{ٰW߱xMi~_L?ێ_SkZi я`Ӑ'푫Qos~HhOi~wH.yz}iܧcb/ev|~r@}w9בox@@ק_׉Rq4WN8ޑ7\L\ ns>zszGKUŌ'u!R)UyGѸ%ϼyN3n/K^Os?_e8mO m}`_~r{G>{lb/fQ>`_qv>9p2N;|!SU}*-ҫwijw7C?a7='eGڿAu.jsէ+L . 4{<=nt~y{s_t{޿;Ye.%/_.<_ =}'Js7OJf{w0ՄO댔&wxYp _ExJҜ7[߅\/3^sG k/C =0eG<z>X( Grww=L:x!F\S9d_tkTjfƜo<^JuoE3IF?5^:uև~U2H~~>1_xt@G|h?'aH^q9rDo#׍~Rh'<>RGc{?;T=K&;>G|aoE3_ғ#s]d~{22"-q/"`S]1+s~-=sXe:q]u4u3o:WW_Y[E_Uiy}>{UrKNy/DG߿ed_߇}w#M^Ru q~>~N睕ﱇ2\ORɎ3|޺.KǯD>3 9y5ֶwu_rݙu]g0x+R~ww{]}~1]\vO=:uqC#g>dzn_Nt>h9r||xȅU*˸gZ+zToE~}~:r-w9οrR/;\F>зo@~ډY^?|ؿOׁS/ǣ?ή|ѥ^B;]Q׳뺌3nȧs ;.%|ߴ$;`d<|~s%c#m3;vu~X^;vܿ#;vޏ|oKCXG=h}$}7Ǖ?ۗ޹~1o`7߳qfi/K邎oC鷢OvboKCq8Ҏe>7?y]@SSwHS $?x>')~./Dx>7 | =4׷R~<ԅp߃IsH'_|轂c>JiotCo'}l'"/xDy[v~~g *O;Pfc/^wyyϣ8蹮zԗ5=3ًyFԟh3^w~8K~qoy3~SߑzjƱ*/[w%'g|(>N3ȋ}ӏ\<[q<:4I{L8i-.]J9O2J% ߤ幖G3yGo\my=:H$MFDzѣ_+?g\; /(v.skwe~{}wD_gCr(+e?wag鞞dԟ+_:|?\s\XcgTE}kUqq]q|yRa}žvNnxa{Ŕf|\?vMH_I>9ԯ~ھVuX/r`O?O%!G/pK\v^Ư wu<݋}qOS;cAg\|~y^?߷xWsLסQ?j'7'Sއx1Oy{o| R.U>wIyϗ(1zg ugbǧ yuqu0я/C﫣P/=f\ d~}G[r9 ?žJ;Jx_:Q'vxeS6d><q?3. r3N{WycԿs՛~!֋3|Is}u4q K;"<.r}[sy2^s&^=쇢pc\9^OK}9#?_|{=;y%>Y }K=YwzދoHWȍw^G/>SS|>(N8i:^ur^r]KGόsy<GvRys~|)_@~797sP"n2v vYx`;˳? |s}{]=$Uf Q߳#sDy?C1qd22x{}}?Q='{Oa>~Uq|ع#e3r`~f\nG|4y*9d>Dg3K?*><}_ ?Q(8!x(>ʓzF&o/. O^#?e=?NZ=x\qo{{R>|:SR*\={L?ԓ2vIݕyOwb:3s8Ew(]3(wU޿RpwYg_ozƫ>G{]>ߋxLӏ#r:)ד~2n'r)ƫyɌv:/Ϩ/I?:f"͸^o{M_q~yF{\qJxG.zٙvVˮôSTnII$FQ)OSksVRO84 (?"V\f̸͘1/>Ky<8'pGH:|?ƅs~Pq@?iweak7|ꓕvW;;ȟx_}=BշRvMzG޵Ӂ/Ń_ʅSo?G'zW~rM=š*^'yGv7yP}{h4zaկ-uN1oi_3z~o{Prj+_` ޙ~4ʟV) +7,]C|Cעʹ@/N~g \}v W-a#r_?Hkz.م=q.]aq(׼?fܡ/򉗮گʅ4?~1 ˩}|/wVx5..c+R =ȅ%娙'3}|tVv*^{+s';;+ϟ}#v1I{9Ta+GcޟO}}6Czߞ+ʕy,yX{>3"wf5H*W{k',|7Ծ-xZyX_/I=c?Mwk r1~rr>z?;O{;qBX)_z~hW^r']~g]%/|SOᯝ,('|4pe='=ޤ*uyܫXoOW}I ^s^/NrwX?is:FCިip_;I֮x[9}zt}ߑI6| ߜҵGM|ȳGOz_{ΓsMd.=y>9~~}QOmg0>;VxWZV+74}*էIogZzqWO/zO ,̻~;Н ˷(]ZzR`ǩsa~Z罤r)]?ť^9ɒ_zyKOWi]kI?sYQ?srrץϥG}T Nn1~OYx+zrK*p-_X^,+?9{BCGB/wLat6Mi^دofbYoi|j꿾83_ϗr\z^#ꗌ-d\zx~SUnFbCU9vWr߶}/EBsWqk?Wz哮~}~ukgﯵSP}0#|{GVyTvVW{z Na$kzyvvuμ)>|&z7ֿhcd1?*AbG;']Y&vG"ǽ=_{)}_T C- qVyWB㲯-?-i~7BoDuVg_^w ?]:h{s_~\^~#6P'\A~>c_o唟/ϵg}?Y?_|ڭ]CTW5X:vS{ O_K?Q~+>8UtN3ʫ_}9~D_ţr9O@:|x`[\+W?cy׮ⵣ~[nWhԾ4p˭pu->|g \}Wpoן^it2a姫gZ~fx#o\_§w];o]Om׆~Q_w[>r⁏C/|WE}ƅ]Yt|eߒfcge}8/CYਿI־~X_K|'R{wYrq[9o_]B}~w^Nsל;_:K>r'Ok'BӯC?Үr PD*ܕ_{CE;^н;Lyz^nǗ} {!ܷR^{-庩oM?/qKyIG0Ёڋ cF_?loݎ\qb]pٸhG$K ]N?7Wg_ĵr/SuC<|z}]~.\zDb޼|T^;#oGRnQ 7N3VxgԿ{.➃_ 2^; ǼwSepd~l@7xR򾳓~] ;W}(rsG$ ,?vM|O_ro鵫L|o{O2x+ߞz^'KڟCY4/Y/a.? HG+Jߓ~'-&+'']y\Лy'dAkY;%; _"W)]P>kjT}wŻrWNǯ,=&y4|k,Ӟ9x\?#9!xq!tڋoB}?]X9/qϓAW^ɼ[teū(Se!tL)'ݿvlϒ|k k%<tSarxW1΋Uϋ:q:O~?M3<|{X\E'p86IOYyƉs^;zί8+~.<w\܋=[?4`/V-ӮvH_>ڻWVxw|O^wq!u^r>}-}ҧ!J9N\_,zvgT#\CG+WD9#|E~i\}]gW>n=@so\qXZ/WG{k /koMw愌#AAR; kj?c2/_G>/v7q}^6^IjV}C9]Kj}̧ʭ׹tuS#-zUk5M}dyO;^A_}i饏k \_?̾T{ԋ?e켽:ի\t/hwZw/=yy|?̹ ]wGǦ﹦99όkh_y|Y:w ߟC?[P?0z 2oO{dnԯ= tu1/5NS2 ]:![:ڳ8س#$ >'KG퐿@$E ^jWU~Ik{!mw7Ry3|_U_{BOu>|q o B=O^@9^/BW# )zuCq|9wtBҙ>jI. ;N3h7~gM^r0in1?#ŽXлէSorcwom7_;-~5 zuq? _o s^/n],TIޫO9C֞D^iG|鞧8?CO->;oA?ԟ>Y}C&yߦ~Knũֿ|\S|M_׾F~Pɷw>o>w/{LV~q\D%xr›k|Y}{BUzaSnk_zkڽ!cd g|~} ._tu9|߄~2s3 ۫gVvvW^~m{N)< y_>[+_+/}ߜ_2Sa*YfD|kp\@*ovۿM0;~էťnz@rjGI{. ?eVΧpoM>sxGX>G#웜7C|r|wMK7,ι랓:Vo!og8k}P<==W|>iߋ?ҡw狼A7?+;xӽ ήu/q NΥQ6r3ȯCWя n=_o #o＞N?^hp}wo8߆\|OK/o)mB䩇O >~S0jP*gkE{%܏Nkrg}I_CVwЏg ܇ @}vs3_So:p(tҫW>ک\h4g~}߰򭖿2/G ܵ!_~q,CQ_; 'h\2iyq+Co{1NGU[h|އNIڭ僞>}~/-躬>dJS/eQ~ 5[zhy?/ߤ^ۦosBBg;WyK?ys:v+߳ ޡP NV8xD ֤ ¸&}6}#WjQ_bߪX>eyoceN=#gR9_gfC$:)S.G:{$ _3юfAOU8]>&*Or)qv}/nAQu80~Ia//t)<_|?^>[OU`U?QK_g/^+G\z |Ty/ԏ$c=3P}[/zK..v~|;Կ;Oʏ R$??=CY^څYY y}OHRRVYՏx7x>=/ ^A>BoUz't\q8G~X>6\sOG_?-+f \:9;a^} %!p>b02N#ƩH\'6Ƽ%z| {RR+0?3I2Rn vDs-q.1.1L_kOxO\I=%q cv @AoJVrڋ^S{ovrSyggK*x/~lw.!Woqxhbq}W^y_|/O{нBG2.ޟ*T}W:̷f?KO}}[̻+ރ+,O\}ckʗ8xzxHS>2fI.]͜~8kGrj/t_VeQO* CN(wO?\+?;tʷ~6/ݩ;f:vI`y{ztl娸wbpZga^N/D~ V ;;ڬn;?S_d=ݬcՁv'*W=6`'] *B{H 'oՇ-{%x_>~t_9ŕMW}gvc \YXy/Z~Bu9M:xYʧ,^9r |;7gYQ~8WJ:xeãW? 7d?J9[/fڟ.>|S5.<_ qK察!W>o8tb'=_{Q ,o̾ <`p<_33\?cϽiu‘w1 S{|wn^@o䏭_S?k_K?t }s?ƓO~ZʡW}=qcSvOW2a M0~?K:֣} 6|hBq[OX|V.uxGMוW'e#XB16}>ϹB?|U^v\'Ǩ}.G7*J_=P;*۬W2|i'뇎{OŏW^ ~LK/?[~ po6<(߭=}c7g{OS~IЋ\Gn;s#_OOtxy\9h3p_SS<1^7ࣾEB ~֫tm֍z#'; _lH>BTRGߝߖ察EY짫: |W!푟pW8gA|(7~^JJg.+]xvҥ_E,HtN_z#@~P/kgB}=A!O/?=~iޞ,B_U39^IkWne7"~U|87E} wVNRz|{^tB /[gߨ_RI| OE/5qs>_ԯ^#߃pW.m h>L89 tzR|>~7QyxxQNh'^d`>8W÷rkyY>*|g%~W^d!7b?;w;7O#wC}7y_e>r;Hb}d0o.K{qc`VuS.xq+p?xgJg0Wf0> O޴Wxꗎ}KX:וּϼ;[ws>Ƽ^'#|'[} ݼNȼ<=K4x?ᩏr}G]_(s998丕^D>\畃KAi~T_:l=te[{}|?1_>~|xK׭ܷ3xë^Ӿ7?Q=I[ϸ[/x^8oS /]tiR?? ~_ƾ,KP=!\O՗XV~)֏Kgy-_ӴAU{WY4\=\Ovgvǐj}\KC\>r_K<7gcqg^>Vk_r8t_ߜBtա=r3U]>*?j}cw=x^߫w#?A_{qb֮f^;e{@uM}!>EQmڭSdڽ<\(_׭^H<| >E}կ߽zGt9-]A᜕߻xqxQ/W9ZHgg\'ŕOY8x-W<[{yEک<K{ ^A}7P:n|+3Է^WS\a-<荮^WqZ\>(.yV?28嵃tr# ?3n[;6.ډzMӾ|֓:s=eRoy䏤^{e]Vo@)|oCT+Kqhdarrii:{ĥG.{֋S3jGlwROdՏW+G'> wdڡ[YK~oWf!X;\^ c?zDs~QN |ʍ\j_txlneq=C9Cک\ X%ӏ|ڧO8-kwrޗ.x~ hg[S}ڙ/ oVzW~qQ?_Wy;u|I?Y/ ^:kc2w.xii QNMp՞ ҩG˧\T4 g3$\)/]yʟ,~vGWn; kszzRx+ =`__=C>ڋ]v8GKw_txiÅ?~\-s}Y YX{Ϧߓrm|jv}f1D%O8 ;nt-rع?gcg ^/:̕/Zz7Kø]OyO&OvQ_)߳z`qw9 /ʣknaz-ߐBG[cްH_9;k[/W?>+m >_91/K0/872 t]U<|}8'w_;{j?tr#M_,.}GK~S|wWntst~)VkyϬ<ҭo\!=BS:{JGs_Uz}op=oh/V e#cg!W>;'!y7s_xɞ|c/Wi% s+Qe_B{x_z\kE+MyD?9SosoxmhN-r[}>.g^-./#?r[}whGg{ǔx#+Ǯ;!x^\{~y{+/S5򕿎9v4[9䲱wXX}9׾y}!oavt G`?;qQy*kzYoyIO[5~t|͕2*_u <'3no(sKS:vWYg{q?]>5xab-[ 9־i!={GG8Ћ;{D;p4lP~^tdK.rƫSxn^'t|zµ}{58?׈|2_(Gby/|q+_kOf\s?{>lT^u~г e,{'z'Wz~v {KWk3bks6@_~>'_}ess~'?O _`꧟|QvPxC ovE+W{SRzF}%?őS?y~JWy+;µg/?|ҋ߾rOX=@.<,v9hO]ЌKAW?N ڍQ<1~1=d'gV~WY/ a2OV[< +ϥ_Sn|Ϳv/ jgUy?Jy!+_\x3watC]}jΡ~幕{Z:4,Sҵ0zjt5+t*N[yF[rUR׃ǥ}B(kW{$r>ډ?۝N:hxq;!rk2>o?7Str4䝉 <>K=^+q-?Cҵ۬<_yW}wvY[_,_Hr/tpڭ_yi/P>ګks7.+6SW2W_\+AAW!ЏKG,]+}N{Kr*EyBY(}v=Vt-2.|fz̿~W~I2cPyEw10OkH=s!|=xXQ?ax~V|6Ye{<~PyJ?s@V~'t,CzԾv:gE{_V~_Z~>͹Lq>~aƱ/l,?{𳴿8OP*Qt/n_ ;SOKB.);vsi lތ1ߡˇ]߰ Coυg82Wzdj8w'_+?6vmhWNOljΥs}Oq]i7a}wsU ރ7)nk꿽<㷰-MҵӜ򯟝B!s-M#yO{zԻ^4M:VS)>m28ǵy#^vҵ|[*o<럝<\?]?̸ծץ+Y"x>~H YYP>//u~| xa\t9ؙ]}i_yI~9G[9ŕSy =8t+ mNW]r^򳖮|~G+@N~P~" 6>i)X=B=xf>.^;ԣ\{ԯBݦ=NwO^9uy{[\7p?3]oվ;%9Gk':XTRYq?"*YFO&pkϏqXC-Y>Յҧ;tv}eA.c˨ 3u_K? S}K@ND(GY7'+oMb-x+¾Q~;!^ܾG9~Nک|,ݍKRtգ;Χ}Cǁ4$뷲7Us Оt[,'_O64Yy~A}ʩByO~/q[ӧ|/ygڥ~xrٌ'~1]^U?5S!񬏌广UׯXJ>0^㳮or3B ~Og)G<߲ߏn8Mxীcn^Ѯ@yzNN/=\}EP*GSN W9XXy{מrÿh䪡\~Nw^@GgoaZmջocI_sϻzb`awy g]¸Cp>G9]q?b?x>zk<1o׿Op!+O7̇ >k{NwW~Ua\'9ʾI%샵;A_;}pOBϰ2oZzK_*~skG9@w"?ŕx~G?-w|ߦ>wsq-_tʔ[ڵ^]=?,N |c{/Pxf<QN~OsxR~~?~صW _y κ q2!t;v|W|qy|^寽6|yCnf8zv͗۝㷃vtl^n^nNxؽ^{|."{)/S >Agb_ r? TГdϛuNꃮ}ICKgo×c깬+^IꅾQIi\ Xߜ_^\? ՗Z~as?+_R;Qeˇ^'.o˧\)./N kY9zX|ӆ`SQ{Ń 埝W;u{X?OPՕS^ xPxq˴; OƩ~jo/AGa*׎XvJϯYB;ʥ3OX_Gmj_{WKOz+_.T#)Zc?Q/q|cǀ#'=Z{ 9W|?^:_)v< |?W}~_qn.{WsNι|=pNs O'r !ԟ;]9Ƶ~uUNfBu+rЗ=/CՄ^}Щ&tz?^kGrZ.˽ <9Ӧq㵯MC{}rT?Xn_1)`^JW. '>gyw*<7rryzd;]?z+_?yڃҐ{Dʯ!<z k_v}ۼ{^;$کX:|kt{=&\i`p.ťc'ӏW~}veOSN×)zמ_%:˨~B !pb>+7-y'$_YCyÅuҕȼ݉}u Vpu_ԟ}rhy>G7mOy뵧_M=_H~_GY]ũz˧=Cy!tB )w/?-Ɣ_}_'Qz:7/uCᔾ|WMv#Ϣ5<,[;~SKCW_ ]] ֡r+{W!jV}D7/޺JG:Wy嗎fouq`ޗn PQ/a~ʝ\0*>tY\pڍ,rK+?h8ה\| -ֻ@/ЃM?W~t!xY9MT{ȧŕ.xxXy.ƙ|`2_WA_?Xeg(7_K->=תG~/ >0`㴰v.;޾s0_'YoIy1|_>|ғVoPnet)oK4t%׉t֝y^>#^=샥Nzz7o= >Scj~?G_dKOZ9bVkr+;| |G;Y]C iO}B]~y{HhonQ^rqQBwJ-.ݲzϷzbTP~6_X;k+ :/JNx\;#}_mZ:1=tg Xy-^>_ڇ~(zvǗ^/ةCȷ]>oʃ!};s+)cq:Q/kK冑@Wڵ>l.n=٧?vJo |@sy{Vz~ X{껱.W˲P}IA{9[T^:3ߨg}gxop/ynO+WAKgx;ƺ'tBw[-[_$?rO\3G].n&]~?D>%,8*YқK?BHK}%[CPdw~iϙxP>9^ƃ~ ~̖OkqY>n{EϔL=f^*W¸0?:#dsr U=&[Εc |/8塳՗\z}8k[?rwv~7'UȞ.ˇ~W?tv~YBoIzG?RCI'z:(#7\x<:+?oO-fi?>1G4ޜckVoy~ۿaohz2db[33?n^oK܏/O#q cw/`#;AbԟShޥ#s/t4+zOkWc#F:xʾpRSp/+G9{X~7 3'+\gHo.`C>_\org` 8e,._ggph'qk/~!SܿX9vFDq]~=1w|~^iw3W^g\voCe=`ګ_;o:W΍Ϗyg:xd ˟Vt{l/v^EhI\;# _;m?Oޗsq>d|S_)#0_<$=KT/ _I_?{_\@7 ҧ[kɺ?#֟|N7x'|~>)|Snʾt~ƺ x-+Qg}wְS_y]MŅgqQ}+qUw0N|-_9ݥ/J|9\$]~=ν x} Ԏk~vZ/? Wzkzm/~_VY'_2+?@֯zv `yO}= ?kq:z;|*cϯv@י r!ug!|c3Ouy"gt.B=&;J'/<ؿꗇ}wSu[4^Vwە޾N^z؏/_`9jJy#qoksO>!dOY 3K_ëP>S9hSұip*?@8..q_Gww׽_:4ԮtoQ.ҁ_;#Io+w{ <.Gg]*ļO\)UՓd8g'/otӾk_#ҕCI77a3K) ٿϮ~j/8VU8Wz R?KyyW~'_㾠=_7q9? kby޽oҡkYy:On[)G^^~.1=wW@=+|.Q. V_yJ1ϕs8LJ}5r[O?X?gf>3.NhR/j,=3|uY_+$K'ȧ\ko.O7o?f>&k'Wyܵ9|?D #COh7?t[TOWY'7Bo=H|d?w_x?9g@+*rWc&}@9wїDNVekX:|nwNnGϋ'xoמrПď W9dlyv}X1?W~kץlX;xiy"~}/{+OvLz~e%zox o/>Ⱥ^5u`orQ+X aX(tqA9]֟R xJU>/κc؏ކAڹIڟXo}ծ}xʙ-wYWnq[^9i*oJP(GzkQ?K]OGz+,]K>|]X;íz pC'ca.~ra߇OBA?=/CzEqvRt{t z煯ܫ\/A/[;]yg ~/.tjvW^={FA:2%X7i3H:.D~ϻ~+~,d=kvwk}O;$\:Ю# ʿ.|'{a +"&IH>Y[P#kWr1S;ڛXy-tt죕>O{׷{Ӯ|[95 O ]W}=rNN {M.w9g/Q^鳵_?O)I>Xh ^Z:N&nH{ <>K;]G{Kʭ+'}Ub嫽_^)՟m̯9W^ =?W|<~} -]yrx}^vԠ7*_@]-?<ծzD+Cw<,|w#[\{ a`t-jp>⾂"vƿdۓn7ڎqr ߥ\okG8KBw~2ʫ2;G9bUNv?|<,vZ=ȼf/V֭ru=y?͸-|Z?NG@{9[Kf|.< wfΟ!~\zܔX>̗-枟i/z^9kmI_\B_0.QMB_:eaCI~WvSH/O+vX;Cex2(1. ӲP9Ccx~5g~B|꟝yX;I?7o3ڵx)W}Wa]%߼x/g !V'rNU?~d_?? կ{CA; kA9AwR_?tNsԏB 9+O 9]>[g#\MKȳ(4A[͋C>bDŽO~zؽC_nxBnDvߡWHWV2 \z 6XšrƸ/dOC9]g?Y3og {C=cްn7 TG|?d?{rO_r__w_vg&_fQSYxc<}퉤}oVu_$*z>k?˧krU!?t-},Cȿ^ydόh+/#{U;؛Y9ĥK ߯~sʍ1i/pO}}@9W}M ^_cmV~82OGw'g<2߁|K}T֭vViԴ~X̻NW߻'~j׸~y{.ZT]}0쟋_BOO~6a}'>^IϾxCV{ ^BoUvu+wsvKVN??KV 8.?s~7Gv#vVz9c<*ɟO/~|oq(?z_in|R8myx{Q;xڛ||y|gxW]yu)><>4._-_ z~_4Q|q>WVd[=#?o!tιwAPq 97C[>?-%B+.p0E\AkKJ, y?,:΋3WWew/ֿg='&գ|WOAMx^ެK jzSStګ_x;yym\;B7_屉W. ?3,W{#^>3ߖ< >po侠=w)Wu/_m{n^o/yN-z@y W^zN_98WwiC;x^>;/=>b/_{qʏ 70{O]9.,Sww] oΕ%_}=tr[~79W/BpP?~$C;/dޒ^?X#:R{kφ݉O)ZeF;믖:{[k_>xꗾ۴OkW:=ڕ/=oeU%䴴GC9{O/3Ir;=Wce^2o?/{?0v+w_u_XzYy?;sV^xqOVOت7q3˧~=\93Y9僁s+gQ^wi_G>W>B>/υP{Ե{?]#7iх^Q>ͼ%zC&W uüN ןΕԻ\J4/.4~ 0,o{ c ^B3cZ9 9V~9ҽee_b{5壟UtvqI} ~~s~ph}$˯|w/So7Ay 3.]P WΓ{7CK73~;tc] +GT?Qqxg\ןP̃'i+|h<SOy GyP8e#aY<|;3=-O9{WdySGʇ:]=-z}:_WzlVʳ܂n\lwM?]=G}딇Oߤ9s@OY;ʧ3Oz 1O̷B+}[?E^[v|nC7hz] 1r,=nk2:%Y}_̛Avvqg/71Wz ^|X׌[f}|dϜv~[gٔoMCPd~CVN_b -"F_y{ځTN,ôʛ^ū_XQkG|Gt}_F%>8~9Mp慨O >Է9_Cy9Vvߐy}GЩqe~.Ro$,Npo_r/]]۾/&8z꿋vٯݨIw~~kG2ٿyWKizyбkcZ/,13|tB=8VS6ްvpOP$+;ݔӾ}OwѫڗY;#Q>q>_l>/z|(ŕWvV/z#.\=WjBƝqV%u28GEuY*&\_{,}qn;$t%ILy)o_d]s?aM;oOlX\)KN_ڻ+I?B|ls|҅}gR=O/\ޟ%=X{.N;Ӿ[Q>VO?W9$x_?_z~$oO?\+=/u\Be2ۤ>+7MٿXR}:pvv}7"k/y_sw]ZK缅^Uo9ׯV/!x=[>8ʅ:+_;zW~yx_;z\>ܖ^{[}cYN~7|)O?}Pt]9婑#}C!v?H?xsu`(#g=2пSAqI+'v?p.?0gt_>8cW?Hx+V>?߂/~'z:}KHJ}yի]W;gF9Ϧ寜灟yw/O~W~!ȡ[G?V?<>~ >'Sr0˧>zX3|_?B:N(Wvz̓%LSʋ7o?QIbd:߬3u /x}ƕ磬V=뼣^Y꫽{֬^-z}sz},߃q)vWp_.Zt9r Q:D;%{N.伂ng-G;9ʗ-~+^9/9g\d-.9Y:i}Cgy!j~_rS^ZXyܫo*}\NjS9'W~_od'tӿ y5hwq3w~?o{ȵxE:{@93f|N0nsi&U1'|V??[؇SM_%r3;뗲J^:vV^;YO?[G9ߧ~$Bq-^>Z>9#-o8tEI@_驜<[KT9 i⧼~%H||S-"?SWρY>퇬_ЍSkz_Ɓg|'>yS?F]#Qü^`~9okS4xżWOG. uO+c~$x77r¹T{Y+{v^CG·_;ݲv W#]G!'PW?MzjW~ҫ >=k|%啻Y>Syx׮{ |{/o/]Ԕ+x+g~kg<q!=S#};LS2~ҋ3ԟzw]~h9W~^9}I9x$8̧ {o'Uҥ'_f ҧK?_xɮk~9jD{wq'S]yos?CsS~WN z<{ڥWy҉+WߴݖރO~Kk_杝wp_B.d3tAA9KeKƺY<>G;}7g/*O8V4D>R?t w;^v;N7pя8ߐy8P/ɯ|QXW;q>^ҙw%/k/r]iOD+'ɯ7໹-]93壗v?&ԮsOFd<Ӿz=ESWta\@Cvo$iWZ~$ngVmP{׼w'_8rՃnܷç2H_?߁} *y@:{OEOy\zz_.?؁Yy|㬞qu~֞g2gxT/畇Un?M|w5ȿvjW_{ }IgKfxTQA1-7?\Br~(P8ؿr{+WD}ϫ>jUYg^5kZ{+>yǐr֎9p1OjqzWଷOk7=z7rFg-|ZXPU/~~7{N9G[snOgD; ?nWA޸+ڑZ8^|hq"z>+|aokuY'qnj[X-\4 u:xp-|l"j{Qךk9Yz>>|oy×z]?BW{7_Oaב풞C8Н{jw G:S;轵rȳ9q'|W?| ||~5_}U=wģ\j|?gή~KЇ?Y77 ׮cCW=p߭T Kԅr[ײęX~0 fK/N#| Ku~G_?3Y}ڭU!j=)O8|,t~Ygԫ2 }_'.}YN޳#f|߮?ҿ=dГoz!zkq%ҋj^w^{1:/B~y˯=!߽rUЕ|nʋُٿ%,fqtOa>紏c +^aSKIۣ_Jz;ҡ |dO[+b>3Υӯ̥_ϳ>՛{~^\Sm#מZ\|YW:mz'2gqo/ûC%9r}p7/qwΥ7|Ze^Г]~A1z'\b^ہ z9 onnn_/g uktx߿lpq2 3?gGf|⼯<.>eμ7X_M7OX9Y|Y^Ϳ(9ÜckО~CYSٷ{ 14wQ)=rO%'w%ڡ~Cyŏ ]S(wYG+ijU?e-> ߜۍ>8Nh8ҙ|Y<t3>Ȼ#|GkyK}ǎOb~úB'w_:w[? ɓꃃGqU>}۾Uo}v3Ogq7|8n߸CCG+N?Ϻ؟}g=XwῲT;~J a?vRG[q>$|g{|xGtҞ.EN^BWkgvI7tqd|勑3's9d,|2s_?q_}':_Y7DB3s>9r}~!r>}D>z0'㻅s>c΂e8t?ʫO}{[;=V^riO7NŹ+_2FWwx'7zoh~7H2/qM N'hFN}AA#QyǏB>W̌u*>d{Ũ~=[= _{AB[ҩv[\?qѻǼ|j+y|ʾ\:R}'WҹNg=Yuu{];y-Y"lWN~ma?"~C9]fׯBMϭ!g2_׾|QQQ~ӷ8.kqL3o.Q}{?0G1t|}BK5֟v<}RPb]Y'>M/+ߊ83vss.J{ɹ>+.J/K~{/'OB5'po."^I|z/^~G=gWOX>Oh[< ˥?ʼ2[7*.O3.Y=xpA^,q[{}srȿ=71Sξ~n|w*EtZޤ-.>_!{ }/l>{i{xxGޕs|9KW~h}K |f_?|#T^re!rWZ<{OOک~L0ByYх-]wzo$SC7'.Nξr#߭IϽV,B7`]vݖ_}hN_;,gYo20q).C+W9xG K<.ŵw[x@?ʭV_G/ڸ[z Y;'y7-8vvKz~qw{փ_=_/Cǯ+7껎k^t-x/mN{s߿>I֯~^ןWv)sc-.*\AUdqH_vo]a\>/Gǽ@#?3t_>k~ sx[~ _ _y|x:B軐q܆W1t^9wE~F>_]~n?L?3M\_Y~zُd{)N~SKGr~H'.>Dz 9'g~! ~3||I{;CN.ϑT|SVF_鄳_B娜CuW]g!e?3͸Ⱥ?K=9ߵş$_ΜE9O9ViP9#e<ιyw{UxV^=Y`ތz.~iG/+{`an^7{Nx~WN=Շdo/ׄKWo}z/y}\?as^'|+ϻ8&]oX՛:.;_\W9g}^VχzBރ_#zs(}N׉sY\p}?}<8 yp]2#}vz֎j=8g,Wydw~@\mW 8ǿ]NG2vaL8#n ?<,^? G\+KUz//giл_va#z^GeܜQh7^'{֯h)_ni'xپb~ԇ^tʯ9GS>'`d|_ֻ[c^t("\k鹂.#>^>BQwq+_<%w!S՛V.`?փu`?,vA=2||g?yB/dc_ȼW]=x~gI_=䷌Gמۅ'|է}v̗t`< O[;F̿ድcеdݮaç8!i_ gGnŵ\'O;m#dzX_ƮW Կb_꧋gYXܡ{Py5秸n߅S>s)qY>Huy/?osϥMw:Nk2?sGw ?Z{ȫ^/8p8Nv '|zk"Oc1yڽ}_\ﶏ܍m\qlŸ:%rd|u/;z7RW>*=rO=8}ź짞5sGqpŕ[>]˷ ^=}J#+gdߨG==WzϢs~[B3-Cn2x)7#^˗Of}g/s?NgUc,_wz%|#T~Ky!c[8Ϥ Gg՟7z̸̛\>]ԗ^;W_w~O~_Z|zf=ٯڡRqAƽz~!g_Ӟi]o֏=ՏI;kySwtosߺ[~ʯs^{o~WgV)ևb ᾡ?3$tJz΃|ă|>H|M9[>;@䳓?s֤Í~>"G#7//xlQ,{yٞ//A>r8)wL2{f$DCOWN;?/j~_z3V~QzԳXz훨e%tqȫѯy!Ck2ݜz+r5Wo^_ctjʥ7oR^~? ?yC_q7֎~旎~z zO Orܬ^:O=> ^{bpJw%n ū%?:O_R\Vz|g~}^>qg~Kn :zƁS/`_ɕ:a^|.^1/*|*<'Ϋ#g¼YᄃAŋoS9 gv/|#W' ~\#_5zǎ^S ~xGN^,|?eezw^:~O=ҧxs ^g_~w9ݿw.f?rSNK_\CʷYއй? ߑ}w ,~+k UU|1W^?kȳ#w)yz^wWF~q}V_=+Ÿq!7Jʗt\~ԧ]>|7\o돒aBVVO{ l+G=y;!ׯtz}g=/ۄɇ^ q>ȇ>[_+QgpOqq>'gm+Ǔf,l|}W}[WO}`^ S ?Zz/GeP^x/q|S|?#a;18_G+x? ]O깲_W3ygg3U譊WGzq͔ϭz̛q;_;:?8ʩ'{2ߚcޔ>Z\ج@y1o7ÿ%).Z(\ΡKYs>9.^6voF҃ɽx_Q# Hy מŋQv߹|;~ WO?r C?Ky}x'G{joz+3ߑ+އz rG]o=+|s~>z|_O'>I|r.r'yg6Wнx9G_xrTn3]_G:|~.ܱx^]X >rq 'ZN5 'LJǚDU#}h#F.|ۃgeD~ rsٿzo.Cjq/|?ݍO~x͕n[@.~-w|Y5I/?.O99'sPga|̺r_V} <ҧ<'}~B?[vܛw~]?N 8+繡FYeTN[e//>8}g>sCO9S'?T^R M,.^=Zy8kW^~=Rޜ>=eG,/qVncwl{ 8/ |7vGe:B#\:o\ }_덮]w/r`5^kR>fz{?=~>t|y.ܰn3=g.~?c}K[\xq-C9 t#7t Ͻ ~~,qg^loկzԿdWY/W3.:ߑOU_騯G~6Oj $vOiw~ku댟8_r+_\~ cšX\=ի՗!\=q׮8$ώ٭A+/}+Zo~ʁil2pBrtƋSǬЗsb^ wr؅W0C;I!0Ʒvy%ύC~;+}`_wrډ89З`[{"or|~_y3N Qȉ -}q^Hw3 lC׏]}Ei+ڍ 7*_Hȱ^~>EwYwngq'B3oqvt/3_7O1+_T{+W;N9G)G틃@6d`2_e]px9'$s}߭QCn lw0A_콞QO8K /  x4+Krpƙz}{x1C{{C>x'sWcXWwm.| ϧg3/=7KYzԇ^z+G$]#_!^^g3on? a ԇ>+'W׈~/$rg5K/o/F}_QmߵS\rN㪷 _Vϖｹ4r5ZH\8kJ]ޣV{?گ^/_==YP]QБ{Zz@+{ӷzᗊ &fwvN ^y _|[NuYN.C8 %rw*jq)gQ=g>#(8)=®>ua<ȷ'_lW勬B Տ~~I[n}_S:> /tcrnk,:~Y@gW/ﾦ,Qն+~4^iez=yy?O|re>yʸ_?uۄy3:@OhwS,_\#N4o"_V~oqƩ=ʫx׮gzfCyw:.XqCy3'~mpӒsW?=c~Ѕy9w y廤sΖ*ιsM+'˽}3|1^ƓV#}Kx|,.(߯N;7o~W|ʥ;{O|n_K@68doI_yڛyP. ޼ヿ0_@B_]:}72.yO$?`^[27zK:itO'n\zY?!,d]pwOJ| 98gg‡VI\?iKg߱wkq®swJtx ׼ןN+/_\>~%HlaM?廖v9Wq\f7\Wr3/򳣾}!_{.] 'E9_yjA9kwgO} G3g|x_>z:yTVO|gVy+v=6>Wp=SBTyU[;d}H;㭞z\X40>>Gcե׮H8kz)ދ+>}/s/߉~sowo!rWkq,_Iv>2^Y3}}saIzTwxiz8/}6O~z?Ep!9̬?8k~7xq^p_ލzm(}3>n~1wiw)|K'_zB{ȹiO9CɶQ}y?0o\zjwx.pnd> }n׼g]^q>wPGGڌo{?%\xx~W˼ų[;!~VW\Kǟ~q?ẽg?-_vw{SBz+~?8Sw]r.ıd?Сv⳰_> 0tg=w =OБs~~7{#j=oZqb .V7}*}"C + qֱ~ V/tE_d~|+>+wG機=y>)z*W$$~3qjW;oRWMo|_kWEqaW +Ǹę\o7I}͇)'y8s?{sεƜgsMoO\yשMܧ9ɯjq^#ʫK'9q]q/^=/w˸2O|~菜k4.{l!q=ꭝȸNzk)B<<]~ '?%_yEGJGgç ._W,ʩuat|_}_kvKR~!WF>9 ?Y߲9w+* ?SܞooGŽ}Erok;O;GOrЋ0g&!^Zi q W~;|r'\1z'G\9㫍a7/!ԛ@{?0x|'\k$)Z9qі_T5l^|ˇ_d`V91]w5\7G'.^\jǷ95A%:c}sk~v}g"^?7qv+?Xz#[}/(w?4{r1׎|x5/8ワ>}7_r7zQ7$[+{t_tO7HX97=`8*.]R֎WnЯzէQ.vOXܾɯ[\ֳ|m~/Bԯދ6N暾z]9CGҋEǻ'W=^Q}9_(a^(\ߪqS?z!R|VK}Z仙;+Vxg_׎P}#C^W2NoC8'?"տ.ŸeqO/Ǜggg_p^n;mw-qse2'_.dЍ~v3.U>{Pa!w۟ }_ !?μwL,\W?"ez.rSr@f5ړs'-ArK7'~ j}-Z9߱՗]9[׏''}S,.N/3Hŕ/ eK//I{Ё?~|-<;B2׮~P6.<..^EM{'+B]yqGGʻOy/?FOxz-_^2bni^[}jy(gfK{?}z9+_Y"}V\ 7߯V}}8=R|qyn ,~c$J_a.y)^뇼x|w{g~̛uTqOqR~?PfGU_~/Nw/]e?-~ߵ%~1Nn?r?{+Cf?6яyzBwqW&~0~F>y!x+OX\WrAWO>uaʱ_;LOj|\.To>?|-^hq;n1f'q%^{G}=sH_r0+@?9p{..אZ~qO[;q;V^=A򹟖_g\~.^?'}HkQ>X=;٢_?=;)G~tqNS{S֓uak}/t6.%/ҏ][=C$}vd [=R|7=:#'7Ů 7].N ዥo?ظ˷t*J -ԮwKAw}srzWA?ngxx'~z"HC{G\>bݹw!Q+ｸsQSܷőyAWWԏZh=̃||#U[$#h^8Z2.!tbߩ~~ɽ>7^v 뷷5?B+?_ IqK2υ|ߔ?-/V GwG(N`zA~=y@£8F(6v߭_rʍ{Vn|_lޯeh!+oKwx̛_Q:VD=]곟N;`/v/fȁ?rG߀pR/fՎ~YCK kG]>N}qg~ta_~TO~aԟ=_9gc:h}xOs'(\]rI_/d#K}W?Ǹ/'qBW:h3 WLBSnqǰ񻭼6W_?7NӄkO=o/^|[S~֯%iOPv1?!]ʱWOEˇNS O?]HoPz\g{o{ ϻ|'.B3NM(9$w!or׮|.r}pOo|G_2*{^M׵}O?V[|s"qpi;Wrd#q:ҕ;) |!zɄ;V5݋3 5rN~v=5YX E~=||4@+s]:^qW1<h'x/aG>.3w pX̋y_ҷIx}o^=w?Qq#r~6e_VE:l~ _S֋42FǰBuqk|gY(>67t ^꽗 _zk'Ro$'GȿP~m+_H|W.P=ŕ_/orū*w}wX/ӿ'.qU/]= }_MWn =I_'Н8}jȸ'kOkGŋ- o|A''w[[O;(?~ξށsS}7)a(w`=9]|ԗ\r, +NNKj59/\CǕS/q0W_t`\Ϧ>9+g[1zKW.?1}q?pG^/D5~tWrS ;zZ:tܗ} <=[== ~>ZЗyT/.sOsY '|X__-w/Uy-r־~G?W$d?~s#^]HY.ݨ^Jk~S39k_\R*~O^XD9;r/K?Z: k|iʷnqGW_q_ׯ\qNZK~9_<5yjꞮ?+OnNzo(_^{YvkwY>m _Џ}:K#VN ?EqҙG|[9$|z݋~`Fa9Wrʫ׾ZkWqb<7t\?u|ȗ_w:oӮp;\1WRe+/g?F~*c}i'Fo]"?‡؟}? ?=ח{0^ =X=MϮx1+7𻬓r =WKo^_|tLK~[yߋ½t倔^X|ť=7%֟yInp!k&^ҋ;>|k}ʩ'>O9G|!Gdu'?%/.zkOwq3_E9iu&N2W<:WOr_գM3_koX:EhװrB|[=~8W+]XZ^Bt /xeՃQ8:)fwSGՑz1gr÷N}hsq./f⍯>vt:]X_rǽ<8Wݧq9wri_}^=<۹_W^r+o[|tݕX Q;CW>~pj/߽Pô?ʽUz~c.]yq _VY(Q{F-]B_zX{I 3hyփ^ad~KܼW;$_ԛezЎB?as(}}[}Xs='_M-6.qrO@sOnCrKkriVN~n|og~xy?O-\qYCjw|ȇگ/F^g7f6~ zxWn䏣|3~'8cW<)ߋ\GZ3|l^ǧ#OF.m_M[ѯ@>NAϥvO{ۥov+}?aSo?| -_ OԷNʑ_#f-t(Syxwϻ]s$^i9б#pﶽsͭ8M9?wac_>yIVwH&*[Xyi8g^OFgQoq,K|+_$O3~\G[dR};WoatB`?=8X}p@p{wBqF_q!ԟ/덳ؾ;B꽨OLvn k7zߡ CFX;YvYW9Y>jq}ʡsf|m\Q~v8SϰN׿ rD®ߘңWo`O|գ_~䗼x2ϼ x P|핿Q}q_ ;#nG9ջ> q׿ -]{O}mb7['Cv|CߜYQ>d=Gx53/=n^H_'^ǔC|a?+k~ {U=S?C?e/ (rpaq\g?+I{ʧ/O}'.,yEoƱP-oDÍ~S}w=?YqL^IqٮU7<_2r>LzŽƫx'.\[~2_N:f/?Bߏ{OS?Ee?]÷qĹ̾ekz(=3/BƕԧɹPʹ-`{2~񨟲PտMzr1ޓܕӿm>R|OJÕ#ߺ}BWz|OR|kqP6'zwröp!|/n ]xGWO>8to{Wxq'OO't{6NV^̻CG߭}mO]Dmmw|wlw[G{85W˺cP{֣vsPw?^ϹT}?[_?~'UO~>|vkrJܯj{\܅߹rK( /R2-gW.?zKQOdWr]Wrʹ2߄G_7q}zC;]\ ]yZN$-#RȎzȓrW_V~O~ɺ?[}zsv.5m}vzqz߷ԯY 9U8}e^~(&]ُ/G YK~\:/}}-|gv3f/)v^!+z)_Xyʏ,hgqʩ/|իY#ӱ}?8#|뗣~~uY\?NcWO> hsT!]o÷#_^\=!!7]`M3n֓.^?ݏ Wr/徐_fSN/?)~Te=g\'2dzxaԋ|\Be][~߫y>V_y}"0󰽄S}K1tb6_rro"Eeq/Nsk_tq)*W iO<-?'eq=*_=UvʉG{Ѓ֮kOO{nY(B2/~n3O"o>_^CTaq]9ob̗q ?;aW귯OsSy<ОzzA:a~{$s:6z]Cq֞8Q+|Ovz+K>Bګ-NH;Gn?\),w=G/wƯ|!r&dvQB//_ۥ/wysWK?/n| p=sy\pz߳_IZަ>oso=!bSG|q^wHso+Gf|GE}-,>s>[ v+K%i8qwWǜ#3u-O>B_O]?!O){}UELk{q?/6^^gq^t/1}r >wxȡv+T?/~a=Wv#eOxܘSk-k>z =j/VptN~Ӯߥnߠ{{Q|y}^9c\ޗ;~!̷~X?/_f~^1^uf=(65zٜ#_3_ӏe3Oͺ,߄0YZ^P/P;ԕ]PhUVN~eEŷS/)4t367~{I^SsKmi_:3/_w\q3v6_) :J`\w]+77},^WS\PjprĽy#ǒz/~o s?}ʽ:e=>ͼOv#W{k|cЕ]X7?oLV_ ^k6gYT_< G_?-uXű.'̯ʿW?ۄ߫#|-|#xwWc_sj~tlj߾7u&d}_!ĵ]} ;w'(O߮ܗx+}$wt sR#>rr黜{V)Ÿ'{. |W?Qڻ_P-.> 顷z(K}R?J;OBqv_<oM|7/>=>O ^u[\~ R_bWoq/q.kWw)W8iF_0K5|z;_r뵏<szWq!ß\>EWzH+W|@zЮ¾_;'9Ϫy[9{BBNP;)ʭ\ck /OzU^/@2nyoܣ8Y~驟7p)~2]8 ]~ z/tGCB3D~ /Ń?Iz"OE.[\%V;z2#kI X_)["6yd \юxۿ]^(㍯9?۬~WGGKR׮~F{c?-^=|sW?Q^sԿFq޸O_?rSפs}H2#Y_r~>z;0N89/+_b\>j;~vVkY< sx'NUY|Sa+Tqkz5+]y,_k_?S<7>✅ά|9m嗟o}F{x`=fH>z~$t.+SBs~~wAVCO3zB֣3j]W^C[{-y /z5|pMkfվr_ܭWoI\y/w$a1^:r{㪞zơ[_ѾGAk7~}7 t?ŬŋQ4/6NG@OK%^<|GG>NU??Z q9r֞:Վ${K''tz/ޠЯOBWXX??F;;^/W+ǽ|- #_x#'IDkwF|_oO1:ОFTz}7пg[_:-^Lo+T^;w߫AM\%Wμ8JVk!>Ű3a|'}[2o}přݳtUOg9_g-yh's;8+WB'iB G<.z_q?^ ߓg~Vvp._zo]}ÏOR~ߤ*`~s/vjc ?wѾlU<>}࣐/g|6/5۴?-rh#-drSW}BeB话uQ|Ⴥ|5.&qٯ>C ׌][qXMSڷ.ι?+Ⱦ.z ×;"riG>ʼs?GgOX=|~ۇ~e?9?aq<3z?H^Br9_\þg>x$qUfmWQ|BKs򓙰s7U-!/cWc'OhG+C=_kr:!zYӟ$+#KT~ ? \(73>V^{J9_<0NVk/Gڧ_#ry۽zup1Nt/svSGCԾqs0'\} ; +onտ>/|_x=z=.]|AP^KGzѕC?|{ؠ{f$D._]wo->'CeL=z!Iʋ3fK?x1m ~4~-#_Ξ;W;>z-Q5C{G{%y?PW s/\΍γr'}XOsn8O'IjG+)z/]|쥳8-OBCGKOia\kXwQ\0_^aˋ/\W:d_jPڇ*FŻ^pꭽ?~,|B?St.Q:,ej^[\Q Ѕ/780NQCy=󠟄85p~oٿ'g}' ٷ⌰]7Q|zs9y2/^e'/^~WюiJ|wwx+_ko38ʤ?B7LqWSQ!"weC[Y;/xjȻ^=կzd›kWL E;w /Oeʹ.! Ti_ϥT^O^[]C7W\1Bws٧w\'}4xKE{koܓ+_ʃ4/_%BeVrmq?R}b+|u+_tzyiYrgݧ+_{B ߠ>̏qBOjW MVG;qh?Q~?SPO{C} _<>_.qaݵ͹Xo念[\zbs>Z{kW[׿Jέ}6^j7Џuν]k|BϐK7Ses~{zɾ+o"o_F;_7Gz!oԟ Z_7YK?rXs˰ϙO~a׆ &z؏n;=ʟ/[9ӏ–sW ϱ׆V_7W<E7Yϛ+^|}I]OPBGuxRNSxzzq/sOytW=ҭ~ICy]p~֎tCNzgVOysOMOK.Oz~rW,ԯ׏N_Mkq-+ov_\]=3>?'L K¸ħ>|/"V>m wo.sԛY\|Δ^)G|~쓬k)_@|o/)]{굇'·؏s0~1ɹGW-+~4D 1 */˽#.*-`+_V+ ܃ŵ_Z;o_9z׾_/v!~gG=1nL9(wg~o7{)W9O3_Ճ^|Y%YE'r͸.x?8/rP^>m3)]yVϺʽ/ {W~NM,>뇽;5t=}{җ9ᝁr7X״{W"֟㌏y7Ï'6#M~ѿʫGyXsjq@;}}&ʸ2?Os3.%|r]>OOs~-.>~œ^; w׿v|]q׮/_ŋ\?^=q$<{BomK{zo]YV|^yw?}~z?%~9Ogr/Jʫ7PN1Wn,9-,ު[=K}/=ڃRF:i3Y~Ozg|Kt.}G77[/{A;wqzѕ}g>Y!rb踐fS>m }gzA-z+PوWYYC|zCW}ߓR~37b oE_G8״{=]07gzu>\P}GC}\?vr|B/?Տ *A+/B׎_=["g1,?勫~|,^1g|_Lyqվ X/㽠<k<;)g_9qWpY?hҾzawGo岯_kg﵋T3o|+Xǖo/$~GlAv9Ep|I K/XFvyې >_ʝ7f@/yH_}y<6oϿ;BځWw|xOmzux^i{/a·zٿ!o;"F~Fe=), ھ;!W1/'3tb}> ]W9ǽ}~zI'k/08+_Xr=![z_K]B!Wy3C,X8+3ߵ|Oky|~"{wq rO-N!r~wġ[;'WgUO̸ܸ_ʯUowz+w>wػ/ `_#>+BԎqG<(^-}~cO?=ȡ|_a (?8>:"Vzg݄~:7+98o)~ŽVe8Mtr/%܇D6ߙԧ<ϽS~UyBWNkT/)G yF>ϤdʭBww⑱)W=Y(`q/)8a'OOO;ӵ=ҋ?.xvđKVd="vʗϹW .GtrVw x>x:):s?ԮY9xCowþ '84k߃/hG9LOڷd|/>7mk9]VYCM|{Ï3o's{N/|)3)og{(QvM=S?X{95wsGÓ txG|?bT>-~g=v Z=N)~{rs?L\8웵G9c\?MK!'?p|MqgTyq]Pm"<*d]-F -}~7tXW;r~ЕYfVg}z:w%\vc%C{DMn];ĵ̸=gv+_`rpѰzsskyqp?p? OB-Q᥋/ȼo~ rjzj,oN" G{)ǑAo|~Q(|'7|&~=R}3^×?U/烔gя>/e}8g:G^uϻ лiw{~kFwrqVzz.^Wz_ӗ_v|\S}2~W8~VN"/@|ū^KKzc:.zu,<'~YӕO=w_'"U')L.vQduKk? W^\d[/]qҋ^~垵,~nkO}>7!|x6 *uqW[~Y>|u'yVvO}/GSr9)OLm3?r/ˍaDq?]Ǘ9,#Vn|4a}ă\wzWzT#/⏳ ֏k~g8Y?Od컥7T7+G;>Z1_]qWx'ߊ\pu ?L{ʿsNL9|Gy'˥9s_]cpse]%ک[Y8G(K;˗v87[ץwiv[]{5zzN]71ΥW_Y?6+˸~qBC !U?q=־/{Cq3q7R~w bf}'R|ƻ7E;|tpċGƣ|~%WQ-x2ERGJsbtU|=_{ DVVXVnz ~Kｼ~)?['/gਾ|zcꥲ/+׷ri[?a<⹐qOґ@Q{ WN|?ե~qXi [+g^C~sD>z|rnOkAx褎A'WO^$x+Sm*!z#wrwƯN}_֮ rQG]_BX; Z1nr'$̯q~e\o O>\ovNzvOg?dam77?t̆ vH<N]5ߩh/.vqB"䧯\hd-t|9cq-h.$?u#t跩D>)8GN}m<.HNa(/|h|$WP1how~2_yrSrʭ,{q@o)gKK>l?|_W0V.Xek< FR9g:ͼM=ԫyx2n|؇n.v/Si޲yU =Ԯ-u[?=XWWB>ۿ\|u%W{Գ~s+^QdaTz^>oVU-<ɃSV_k!|M•!"~&iqgLy'꫿g:prq[(tkW?#Cop|r8CP>f-]~6p/+x!bqVjog~-sc{ZQWA~!uEگI˥?^F&N#7ǺkPO/|]r'~ʙ ιida?ΩGiiP~ }g| :qkt CT>]K<,??9Q^? _qXt60姇W./?5^jp?| ޿!W,$q^oF݌^4)ϸnWI_̛E90+gRcnOډܸ7VvoovŋC^0/z}|u%Ge9#;_E:sorܵ+;#Y _zQ.0*ϽPW~s[ތӭap/_m^✫ڛޤGfԞtC"'C>I_Hʵ>+Oeʁ_W<._L7xܿ%[3NyC3KoSoA^z|a=>1>Wk_8kt钔Wha\4^4|~2/V_M>==征KOJ?~yO޿$}|yG8ӕ&_^s>C|q~n/io/ }דqsTN#rGS-\O{ϕ9_zl-Z^=P[)uK-ڍ‘߱no J ?wf?S{3_˵87 Kʳs~Osr>tU/*E"| t|* ^eߩ.|zz^yP;qeۄ+w ^\Ӵ˹,|̼~A~8>p:oH<@exZzro{gFGJ+:bY6{6QWo~Rk< qg7ݔgYG_RW,r7JZ\5 us3ns^|/áok{zQ&S|#7>?,r+~S/K-_; ^=ڷ]\BOV^펼)O}Sqqᾡ#x_\⥇_/xhgKTΣEjv(|adH?վbq}=~,%#(BeI>1?3dy.T1V;4k^;W?ʩW )E?Kg]qC+[>hGB K'ιεCsq_?';|-Gڛd~?M?ճOTzʧBcGYҿ՗[c\??rQ/RGB'|T)d~o+qpOʸ0-P<3#;~8xjwߒ?';pm2_Sƃ?9]V^oϩ7}* Q`o+,\;a-F:srko햭|C ?Q?ȜY|_~wQ}:;Nҫ>vk_o}w8#8r . *'q||{68x]hj7 CzGc;SyCE',?~[jBy}@B7OvObSDo9X3yEqn/{t.{ʻS}䣾[>_^S^Υťҥ+q}koN;jµ*߭=W`u_τڙ[}mNc.7\_~ҙ]Qc|joqZq=/OQxp22/2o|wƓ2|q|OQ{<_?G{;Kg.tz|崧=ƃyuI~yd=-;|_C)/N>[?%_7\{dxe_^6c!M;'vK]>\9־ʷ\AŹs6ѕ/o ~rM]/d3Ᶎ|9g^}OftIXfjr_w=鿝eP/\pm?j넾t=^Pn;9xʣ~|n}/rx/qqmgʇ/OCheAU\}מ c|?G~|\kG{ {Li>.ÍOc}J]U<|mʉգ>*=Ǽя(e_~BVڵ:[} \ߤ\#/K\}[ֻpOτS+|#w'BQ-V&Xs^hG.TzOx>O~H:e?Fey/=|;G̀}壽\??fqwY+p}O.I]g;x]{n[\!].+UUgXy䧞WK腞 7;G7R^xo3/A׾y'Կҙw.nuZЍc_x[.<]ʕO ?[/ R_Ns>VONO?鏎8te|Oz{ kgQ|Gc~ B}I@^wܵg2v7jv'Cv5,^;r彯q |vB>%}q|~G~:Rez ?x|Z}۲.~=ϔ+]ʾX;QU&sğt:@ S"}͐~1W;2=\sWA={4}a}W ~/qe,^ {t`╃.mIO\]pϭM"K?\3ʗQMƻ.^ڜ[~3վ^gW?gU싴׾ﶁSzvhqG}qҟ;! FX}K({Ax^'ԻvQ3zo[.ioqI?.kb׮(V.C~}8WI/|Ջd~͸)8.ʅ)GɅ_jJ|; xO`^'Ӯv_\=/~o'C>ӓ=Gfd?~R |];'{o^&ghr/8WOA7 ~/ϳϱ} ?țE^}vG~G)~,nWqd~Oz'񣿿HNt,:}u7us/<pu|h |'Vs+'Unއ,?Tnqi.c,0_u++O}Wm.7/g7r KN~Jv(M>'}d^q<~.& q#HACmqZO?K϶8|Xl?w!=oK=bW._E{ i9 ߭/3/tXz3Jg/C!tW; 3.v7Py.g_w,ywzzY$6sިt񁃐uG 3ԫ^:v{/CH{uاO'<`_T?ֿq]/aCAD.ՑO/_}zRD`,^ηE׏b?ڟA.8r7?w}=L~ #w|GNv}`go~g݃Wvo¥_|nn7=D;j_/r=BT+}^]~zɵq?v'_+ǰ kfv.{./?sw.hJ/zkzq]|g =;B|~߻ҕš\9&ҫ-О S3Nj * Wk,Jrq_󗌛E koQ{q2'EzʥlZ{Ǘp9o=|_-KueʛUM;g3߁#>B{KwM+P אsr7/8'>B,_χ;,w.j\TYuczפ[;:>_?zb!UƇ{P}komW#C[>1x<8ty pbw{ /t5a_zQx 6^ދZv70п;Xȷ^~]? <]X9r_?TCyh|\ܫOV>qv}-OrǾ ߅aߧ R=rαO'O<~<^#t|%Nȁw*I~Do_i_$KC_<]~v~Qc'G'G}'YG}W/}|yS2s OFbiw^ ?o_Տ} f<?'^>=F=P_ϼ:|??f=ϕ}/BְU=]AwC;$KWfq`/6~{G|I_r.-=6ç#]ySΕwR|_?|V|J_#[ G*P9QT>>-=ނ ]*=FS>i9G# :qOo~)W|~pt6'QpW>7 ~J/k xg}'0ǼOԞeoVo>_qr,O kG~WkuY;+>J} fM\>Џ=Pќw˔#}%+ꇃs\9 җOjCW|[X_fYҵc&ukPҡ i/_ k.~h'gqe[$|rhOdҽ?tU/Dy'\寝AB^*?DG{=fb`˾=}/a]1ߤxMz}c0/'V^|.P{'i唃ɸ>6|+ڋ .կϾiB4O 9Jiw`qh,R^7-],^C}#?tg~VߪrQ>v_{GW䳁_x݃b\vWiGd{4xF^Tb-UriOgPH]\ثq=8= _N=kA'?`~料d7J|_?XW%Pl Yo#Py|n5o_;~_Y'~x,ʷ.y-.}|XXл\Qȧc?Xz'Ls}tkAKN׮Ko]{ݕ˕?(' /v>kݎի~ M>%W+/eԏxvE3֞xZ~Ҥ3^v *?^•. p#_]{2kWTWK?K@;WJ,돕xN"vV>z`r_1s)OV;Ѓ(W;EK>qk_>흣ug=bӯ|06,w|Q}KK\HW{_-NG=a?;W>c?w ໿9]tU F;s:ڷ\O<|[=NrG,KW~a3_kGY}C\=kПMSb䖉/z^>]˪'|ő.5p7ҕ_] |vP/^;ꭑկCVOgx}qGXб+Okdp@ot߯%>pJwS/_=nQߔ ><Ǿ"So3e?N ?\{6s?V*^z ]47??ϧ~ }zzS)rYn}X?#<3_ʯ~+ǎ}+@{fBgj?zk[%ߙ~SMyʯfM'Yc~N5;.FHga}}+בvzP:'<>C?UD;qTvէ̛ڍ~kOyէ>M=%<~K ̹^{]_ʥVosNG\3ߵ{t++5p\h7y<YA kwGQ>7:dz|n?鴕S^gzg+^ojwҟիa~1?O/?~,'y-^}Ϳ釩GvKU?8uRe/~Ֆdi|KO%[}CkɟU=EeGz яſJzTnS/.$9+?n 9KssJw^K}#n!w_}tWs|υQ֯;K}fx߽y[ zz)>V (ߙr7q;k?7}yy >r#d^]}K9~i֭WwY95}qwޙ_/.OV8{n}rٷ˯ VzCv{.s.տBwsKgs'Q?vX7޹/O_w:Ǝƫ~bX\rtU;շF2t!/t5IG%'uB=|_{O]Z?a/_rw֞~GP9}P{'뇒}6~n^yPSrSz;8N_p/ߣ=L.9e=/O3OO KNN<'7W|-zr3RnqH꫕?Ku\)ŧss ۛ>&<=oeX~ʡWmkO9?;#}_׎|z*Z?SKv7o wu9'bҩp>/2p^9a^ >coSN}a黚e?r+]'O}oު~B_/|r< ˷Txo | xrѫv{?8qt<5I1W.zJ7/߹˷[> C/SzzuVn~/~%xx/Gstڟ|K'Y>(|rĥ)~*Agƭ8W?Wgw累ȼ?٣_}իݜntɬ+ýw岘>-J?Y'?^zSrk~ᝥמ^XH_%]98r Y'!z'Y=^dy3_yE?nT3wܭ~Q_6YgiSڱaeV~MjN8| |fnYÌKwqNe?'b3OsՐyQ{s_:j,[|է0yQ':pS=<|k~9k_+])yv۩XsbjyHg>Z\k~2} 2ۑyD;aB[=i2O_IW|k.pwe]aj8}߾~y\\}{Vg!h;٤_O d?nETpSM}?Z~{5~^- |B_C . ы^w9o_ԃݽѷ7u3¹7ðw ".}x >үfk__ʁ3zrNCe9Cx?׾[>߲^\_q|Kk{=O~Y/Y׾T}˲T+,ߕ(piWpa7+ozYcKo]yFIe9 ?W}%V~NeWR봷tү灣[_|;ȍ OB;|~F;m߬wGwO>17+'Ks_+\t'~zqY_=gy;Ur Y|aW[yi^QiNsyI=լC+~p~Wx%|/p1WZ>m|oDP('IyIK-|M,<_a9KQoi_x.=$q!x}.K} t~BҕX;?P]_?__G}Aς?K} _ އk5)穿ڗ2?S/s >W9hիcWlnqT_"}Bi_-O.`;IYW_*'I9ҥꓯT.|d|xo_~K| : :Vy<սs>ڷܣK_y|l7=z~"1'g#OcNtG_/.׃;';%/- ^~e?_쪜3=p]%'dW)r>\>>]rGkrG/+Ky;7vh0~RCTg?.|j@v+WsGy(>Wi׆|ʝʩ?_ڙ[>˭tK<:A)@G|~Gz#KOfGr,뢝ǩw;CM#r\*Ou鶻z+ϭ˗Goˏ!%Ϥ/3nzG\MB[<_g},s;Xo3]t߻WNo{xb>'B.NUhp@XQsYNgG$[?t?MO^>/bTNj_~']3n7.͡xǀ.Kpt|DW/* ~_~f~t҉.<~U퍱ޕXv o!ux9??VLև\g W8.C=KzR>|qMߦnzuga[z+\~ϗwKYjn?y_KHM\\E~o'z;+:/}Ogܖ|Iklq#Ԏ\ҥJe/.r~PqS_ŘKd>տ+R}jp`ރ<>0﬏+_G~C?ku='#-A2(/H7O\{ՎճУ'{Q+WOʝC'Xt|x/Gr??9CG!G x)X\=L!}i,[;7G kD_r+ ׮!\9W-? _\کO\yƾ /^{79kCT-,r|g㼇 CեS?tFTsG=ȉ"/D7z*.!|iz ^~#O"qn=Av7|wjQyft%6ʷC/O.T>xA_(輾ԏ察K4O{O{ebC_e]jOL_ϸNY_گ ʟ>k'ka5F;[\yO_:G |p9W-]9[;#!r@gĽW)Q:aѯꭽ~ӷ|䏙.T>eB[:gtquYHy|9C]:@b>IWzGeI_'!o"|5 W})<>ՏP~ĕȼQzw^f>[1\e|o+'Pk|jt0_wd?4 Ƌ`e qUOq\ܯPvO;W~g'dY=nE%_⥛oӮ\].`iwj::Oyiգ~!WN'ʯ^>[ю~XX$e>ڭO/׏P>|8ì]媁|f~?+_Srᴿ'̼rڙڍ&nWb˔W/16.#]HƁ8}'|gÅ!Y~`j=vwB tJ@Ggθ?WU:f98w>H?^Bqzĥ;>\zk㠽 >;?E>Z^6^n6S=ʾ[jq3o8דƎ!qs383<v_^WDba)}Wx}=k8!w.H~.F^鿧/wSoC{KJ#~}Zboŵ?u]+=@Se|wHگ} Ws}jUO+畃^kGk}_:s.9,,tx-y<@ :R;`Kߙt|K||ڏ rמ|RYAe?-kS=awO}6~Еaʟ:8~\#8ڍ$vaWrڅY΋ci|PxbSP?OY;ιr7.]wq$,XnKv3/iu{_堓 :ҵ?=F?x+="l_G=/;uh7q^+s'G_vsO4xzZK'ƷrWʭҁ#|3^f]Ԟ!xӏ(p,K~noagaWXyߙ?hWmjǚyT;á~ pa߳ا:$帇i$|?z_Qٷʗ}4㤝Յįt넿&VʩgX{Ͼy3Wq7υ]\yկӅڳ~|+߸~T*-@^૾+<>ڥ˧\{S%|*wt<'?_-qA(ۗxg8GWpgoLUO c|(>2f'N:f?|dOƟ~I?-}exW>rԿ~ >=;0tvJo3VvA\^8g?;-r^!!ɇr&_quvns8tWY+P:}}wB=M~?>=,Y_~|9/_ x>X|ŕ`|~~7WE:hphOcWDzsʋ7מr/tk嗯tEկv/έ>o&N?,^b%}WK/uZ=Jɼe\kpgϸRFꫜK=ً}+׬@=A?CK;.Y -iw=_y%-P/:|HX_^➋K'MjnrkJ_n朥%,@,^T\y^.7ڿʣjoq݅}W/u?0 գ]X-Z;;xHg3oB]/N+_E"'Q;0#1Ȭy|! =Z>#j Wno#T~7*gθ+_G';ٓg0/ʩW+#ܧW_A' ky` >/ '_;ǾļtKe{'.^'d 돽x*AW|G/_>;{ҵr _Э΀R9[x{_+(W5ԫ^.S9h'zoޝ~2 AGg?W?WeQ~H n>O>A}TzGKڗ+Qyk>PB?h+W?r[;׷!BgǢ^l:_~8{q|V~wG$_E`F9d'F~#/2I<#}{DK_9-ea\蟓Gel8hwu ?'X取~hW=YobfbWH;ϡS{)T+C?Kμar+g¾]х'9 'f_;]@ \Yw)}\W[v ;jr[zY(;-WO ҫg vSO}gƜtח_|+_?o|I5,^S/pлc^zy{m^ulwTW 7K8k_|>Cioaϴɧ΅7no~##2!|˫ߤ|_roٯ9bGXqNvoSq,zT'.ι_?|17.z^yU{ hXWO7w$r/-?+0|Y=+Ad:gO v;CGH{ϵ{/]<-"!}&yzH^꧑7dxўVu˔>t^AV~9+!7^;_~4W?9M9\QrpT.O}zv !w,_K'?tw*I^#CBBowte7V~\ ܵ/Y| Y3/_Ë8|kOi¯? Ưv}?Çkuu}nB|g1ogR>w YXiY?{?8g֯+eҵzHФ٧v9r '9/#ߍSnw|؏?ncy y6ϯbno.jB@_n"{dn:_qIS﹬ʻw@?'m>CV.r-^=._5*'K;E9e2??G\?+)jd7Y\x3#T?Cl/۩Gq=.j/Ny外=XgOoU}振k_HwZc+Pyk#૽b?\w=q'w)]x]P;+}'ѿ+w@?z?*H>O%v 8Px*mp^˓_KE%o}|S/ɮu^=;N1{ tbaw{{c׽{nv9꽹Zyc#/{-ːo=W.C)Y_Xk.fsOڽ^QyՅ'㞌܊zǼP>yq-]O'2Cꅃ߄]T/#|ڵ #z^=>''U[nq}r)츶]-.d+-} ʗn^y\.+uE\9Z^{;qNxZi7K? g;/B/+~}OTLxp'TB,]=ЗG\?GϽaZ }P6/<^9Os/VOWJkןyƼ!ktO'+wߦ湻z׵O8Cq~_zOO>S'D,iGFѥY{/X^Ѭ\B“gy/x}8).}"u/f* =Į_Ž𩝘{]nշa >}o>[HI$R/1ʼzzXGB|ޟf|Oe?~{?eW}TN?/O]~ڭu/CBS,ΗOP{ٿNWA һ ^'y[ztg[WI[X:p>BUUCATO|ĕxkعPdT~'2ځNn鄕k O>O)KKޕ;_K&~;MhVU|[>G[ SU;sYHϼKuȼ}vX13. .]>SqϜ}Q= #.^wgqΗ'/9qε%97UN}']>hD={;xپbJOzkÐkyz,><>w1z~7| +~r;KGZ6y_ȿ^v7?o ؽ }qޠ_G|hy+}zoVօY's/~O+~f< YwxTRxWN;{z'gp=wqsaLRCI|9^W_p//Mï&/ޕįݳ#=#]D+} ?]Iˋiov_c~w_au^ax_w#Ey ӏ[m'ʹoZ8:]>-]>k)9MK/_屵ȇLixگ^;pQzO~k?e?)vgTG _UK晇?yR{3RhY/9կT֯r웫W{Ssh*g[\LgƏy@8wmgG/DOBB|9B@)w|K3o}zK.8»Kد@QN컗pCOW#ppKW>_SE_0V_ /1xʽOz['µθ3XWS(DylpʼHQYz_y؃Ve}ku]Yܿʿ~z+zzg__{_ٙ^rs_o-ut&]WnXùLN~_΋+!)W}@Dqvz-U“m•K$XHw ,?ɺ>K,U}Wwʷvן@ICI>f_v2>>_}cWpՓYzlwu oOz\K.Pɋ+O8—nN?L'7w:O)w?^.zvKouS> X?^?|\ !ܑgV.)|e\1_4ky^_;91zgDy?Xz?y=saUzއSz!:~^ W^{NsN1Aw|3nsPNIwև|e8rx]WrW9ʻ-p+ݡ?=>I9n׮`Ok.ʧW/AC}o_>3X߸|eϋ_Nc^Qpe>I~ů.|r+_ڳ\6vsH?ɗERnuQ}J'3P{o򽼜gP~]tM.kaip#竇}kz9rkyq_ޑ._3_Ahaǁ?S}va孡.^|:Y {Ϊ@K޻.//|L)d\j>AV]Or*ؕ~sZcro_Я+_X=k>_?#v%kބW/]7WR'}to~*Ok,{<흄><IJo޿{;]k|-+tAe}~ ϕ{InYW_P9ߤN׮rʗ^|e.QvRvkov7~<t`Gʷ K=v\ x~ROއ~g>=C~+_:t2frׂ/ CoNKҟ嫼XwWABpOǝuuA;ԷP9C_K'G[ӕI=ZU>K?N0}_t},/KWq# yC~tMoCR/poq6S4MzV[׎GWwG_K!y2?P{s[{z_mBʳ,d?Toquo[]\YA~HKFuWCgs^1p{sN}}ĸGn3q.?+_ycTnrHg}nYC'T_:/.|ʟ_(?C=š˿[aY=ң iy~W>vcCʉSk@?2kW/=8WkO}2?bχ]r} gzx_. Q7Lqg~q>{ ϗ?*Y_?z*r/G_ ޛwnNl|k=i+w3ff#_[}++GhWov?j"N9es)ݧiY'G@Wn=c?{c+aUi5ok'vе[|-dF9샾e]j{#} IyUU|߽?M{O{V?>빙>ו?ɗ3o w^-z˓?INUёOK#~}埮5Tnb,\+OQ;P;?X;u)O9 +HBמrmWZgcPq{Bm_/syAnװ?].Tq[;1 |cWOo!ڑ=:ڃnt~+ǻ'=ŹY~/{|=c;>IO?wrj{ tO_ʟ AGf?'}eǮt2qUX:4zp}R:<$ЅH[C KYw9A:7jqeŞωn~7𿗰0 |ҝCLfnʷ\,#]}ȷv>gr嫥GR&j ^:'\=O'~Bkv_|x~C+< r髧sįn3pP/,DFyyXKϿMw~Orešw+ndx^8ҟQ{e2_ /hص'Izv:jT;u y +W;[|s/ԷPUŵtp87b9_'hq'ks+_sq^B7s.<|qĥ84+xY3.wW/t=.=Y{|WWVw+O>)ۅy˼{/pY/ _St% 8+gR^Vڰ_@o<ҟTy|fox8'n[юm^5^w^XYڕ+~ֿٟʭ0ov7Y9֑xXg?+EaJ=(G|+'yqosWiվשr}/~ ǻt~W S#+'Gy~rs }~W>nяW9;1 .'Uv}S?oԾG_r+v<7C/W.u-~A=f=ޭ7w >H# |?KW}ȋg\zʵ{r.>.9@:^vA<0 OBg~rBB^E.vjPy?Y/x>r}őI$?Anٛٴݛŵ¼[?zN+|Їe:/dƎFHg~/9tܬI{w/J#߅<-}<_y>ǵC*B3OoQڣ>̾ #$pȫďooO}w}G\..?yoof~wA+}SSr[?\]O=\zI]9wڡ[v]W?!.򩿹tP Oʩ~>/œK( _'p<|I +\q>qaނq&|vn|O)*>QNϕӞuMz2תV;GW9 ]Qzz6~0vOBGega ܵ_ٿϯ^}΄=+GOKsc|8 YԿ}9'~^~^ߟҮzõg>)^twYKo="A{p|s/f"쟾dR{q,r+?awʯYWqv?r'mQe@Gɟ?EPZ=^yџ~?9XW篃Ξڿ[Ofx߅=udql#Y9(HZuQrҥI)$V' -BXuSM7@`0ENdu>psdzz׺z]_,ɾ[y5X'g/UFY}QW_n|+_}s^:|5}{/Pvoz}>Y}G1;~x8f⽯ܻۋ7;ʳW ~>;;?gr[Ѿ.r)_X8՞vY}7q(^Nܛy}|KxyťxTe!q2 ~H=uyYgYS`ތy/]?Nؗ^?1 =gkc7@c>i_9j7ze>|KO֗uX{'N8e]owrz'=]uUVU.?_J9/vz*$waAf\y$z_| OC_-8t+1SmjS}eO3'_Ϛ]}q߰7ŧ|]<=+wnT:Zyz&z~걯N_KyE;̓qhDZp~aГ}ҋSr_x,`kwϕ{-ys(w_9zowpδ_X?;ųwJ0_{A K\_M/_lqhY {Qy﨟:o]q72=3_q_~xi#^ɸ/1xq*.nCSB|vW^?ԃ{S/W*7֏l?x]WYyןrWN9Q<^\BO)~}kPNeɾvr;ߥy\{r߭aa[}SڽC}AՇE._\8*#|k3÷7vdc'?@~Arc$(<Ƶqlg~~GC|t֯x!Y>xY?nC +ֿx߾|pQ3/ =^2OJSq+'>7y<;OWO?8E/8c+W_{ 1/c\c.~G+pO/4?CpO/<]Y:!o׎ܪx|gc݌_,-T޹r/V&G?}z>L܋+OZof^Eaϥ*_~?}}aq߁ _\;ϴW l^ߜpH|WOdQVgҵe?oG@9}wYIq+_X='Y;+$}gCC!m_rnXNN!d!ns;a3Ӯ^q뇮~w~̇r>},nHOc秸rrQI{SS?s#w-W)+O;6^w`?X?}į΅+8ͳOI?]7⛬80~ws?o/þca= z~YסUq@8+J,ԯ"q ιD~F{t4뫟ի=Pp%~G8ĵK{+U/K{YWv'|*i_7K<>ʸ[}W3B7ʯ잞!U|_Qꑯwy߻pTDkWnx'?WO.~qO۞}|:zTO]{PBztY(zNKȼY7a9WrmziKW_݉{{T}+{{[_9g_X\?9gkߍx&~2O˿zWneF>_ (ZŽ?Ɵ]q[|a_˯Ы{zģrӾ;6ځ~nHڅ/}N>=z<^⌋陬]yH8wuPd<85]-g] vv #YK/prTjoG+G{sZjWǗ8f~o}U~y7@; ߕ?=c׾{}¼=wwv~:־̛.oU_|4O]\|+̺.v/_}w+vG.ډ.rgx=@7Py)ڗEuF80cjh'[{!a'EVW=".tG/Uҟxws[zw gxŭ]t^9HϽ'zy.ڹ>oWFS\9x"K/ŽkV;+TvϨr | ȵykw ]a!qiH;^ \HWrjk\|qV^`YǃS맇~??WyC~ԍ zX?;M/]rпX{\=}'+s%v/va|񐿰ͮ|YB kw{~1[_K;Sz?=_C0럱ÓdKCťNg_zCYNP;Cq<KM=GY>OyqgT|^eG='ڣ3~ }]0Y3Oc||ߐO7~zB_\}erG_rkkU ,Vz7>ӈrWT=;*;z}v.^![jGI%`g^G\t^Ջ^伫o8'?Hg+9d#fŻ[wx/w~]C嶄ŕ)ГO@GeO޺$7(~Xgce՛ag={.?Ϲἳ_zBơiy?GpAs+/^xG~xyqȘSN<~~V}_Q?N:zȟn\ OPs..A|镯?+[y`VB?Y?eW~grI9 d+Q7x?nOv~zj#3]>G\U.P|]yǹ{)ęQ.θ֎x!c%t/'pt/ιʁB&+d4_c犼=U6gW#}{Cooa``x[Ϻ><~+EѯnBկ?ל%=#s#\v, rGrv_z.˯^-x/}>K}<,qU?2[9g|Ÿ#]]wô#368ջ.;| D~v<9#>rrA΁94z]W=7Ogw,Β '~'2_*,tEYq|*xWrŋP_g\ i0|=u7Ew\y/,6|!x!kc\ _\g^8X >{TW֟, ~:]d3l/|maw|ЯҼS^ ݊k^{e߿^;7ײrt=PC{≯ߧ rvơ}P?giߵ /\ikGB[~oXXFxK'/:Tv|x([z?ޞ.ګ|^q,ﱸ~=/c>Η/][/ȏ3Avk/?]eoyS8M+o?qa:997y>J=웞}ߕ&T{*9.q֣:y/qYϸ8%}z/%+'&\A޸Pow˵O=s_~գ@.[3 ^1{Sij?#-תO@GiX7 z(8SV93'v{с}||Y?f^WI*_vyCQγ kyaw@+_羣9/5q-rיo}\~~~>|nWY 2Nfn /ۼdzyGNy'_q[T.w8$ ʾ:OHBn!6<9zю`sWN53_*׏tغxBi!^=}{̏1*.whꗞ{ ~\w7&cz,?|D&Ad_:}\77i߉`;b'f|iHǿ:+귏wy3 1dž3cc%ridn͟;^=8巣G?Hʝ_ȍqN/;_8t}^*w_/yS?Ͻľ4c 3RpV8A+˽˽ĽK$.(G|W?1S9O#ts^\j# ~8+wICBS^q.pkx+{v|C/D3n_~U\忓u~`Or)]W='q+^׫'?W.k~q]!\?oDU=׎qt_T<^z~9u ɥ\L}rDz'WSWYŹ/|}@g@||q>˽|ā[:Y=qW2eoP|'"_zlw]*o[? UntNv`O/tj%cy._y/| ~/kuŏ̿z2kM:ڗ_Bǫ|3q&V~C.?I;O䗗v)wMS,qq0w>N=k͌{[UO/e2$|->+v/,:OrԞ_+ܛ7&NOGOP;g_ ).f~]',Z%kG='ҫ|ϡ{ыV>{ҵ3{zW^~+r*Wz(/]y+'~ {?Bx\~(=4NWOQ?ջ;9+e/=^/*?o?tzk>|r>?{1vj_-. #T\~p_}ܗK\T㽰{ŗ]\_/H`xrUg_,V9|#g^|Wocz/|}t//'9|_ïu]OKY>Z;cR~Qq3~m?=q"C[C^|__K }0qꭟ>?v W+ǻySß8H'}tևs);ks_guՋ(z)z;;f|'y)_=֩-}uZZƧ~誾ogLv3>Vv?ō`=9է;Hy4yqt׊X}}.8s>_͒z-?<..^B 9;g8KQ\~ '@녧 8[zwqB݋+?v_Y-'/{F/}CU~!+22}v_~~r}]ӡ˯\z8?O;пz&G|tNXz'vx_݆r;%ҕދQ.^SdkG{٥q~\KG%MίpOP?aSLwwzw䇖?amw"g/^9޵U?i~~~7xi=\}ʫҟ|CĩYyΓ:V\{1B北y/_h~e_%ŋa/\wSy]wG/yu'ʽX]{Be?eps\ߡv9_w.̣o|=<H_3F@nEB]N,^%7a_?w]`7B.j._R=1Ň{v _ZwBמrᵫ\~O_=SPq)N58~COp\~Sw%_;[ʥ/鋫k Yƽ/IƥʋӸ'pNv|ǰg0>iOs~<\8DeY_\fp~OSХZ\z튟L|Cνk}=4B;Q_<}gTyz̯vgP>qPcĊgB>a\ʉG+OpAǰ~kWzxG-Vo\?+x(8˺g߫#vqE,.[//C>^icκ?]֞_nb _=%n{u}__|qB>AϤ^ǁ\h8WWNG霮wYK?_U/'s+{Z'wrxrųw@sN_^K~aBkz5Knn!ѯ$t ?_}+>WN\׭rOV8gCw}; ן#-tk'oƿ ?\=׫_|BWpY'q/xټ[^?Y]{k)>_WB\X端/8O N{ŷ^zo +7_U<}oS{S=3rwQ>wzwK _B岋_//_ykY9g璿A?.]W8S^{'?jࣘ|Nq|/NoGwD 2/$\:7a/ޏ. /|?[2<[n,j_rr.*u,>~OSڏoA'gqbK\wY;WԮvrʏꉣ1'.g|Xƽɟ.Ny̏|Yg||/~~z>zó t$\gŅ+S|Ź?gxXܼmjx8t}}~fݸNq89ރ_zp_Ϩߙړ};\|eT|Cpe =?ԏ*k#ճXXݖ`}WWwՏ W3W/%Wz6;C[;qe_)z_b\>g<}z֧+N^<9+kW+ QmwZXG>-a^&}Oyc =8IϟuS}}}K|lk{]ʷ _;Y[H{ꇯ]k݄K/_ IoqwK]:`W/ߏzv '>݌x YxĻX9;>ZyhB׮|PXn*e<OSBʷWvuMpn-νx+ǹs+G9?KХ8N}s}R,"֯i=v+ 9~ C'ƣ>4tY +g&d]VxZ~G*&]L]7>cO{V}.eK/JڅڃUߥvknTO~;4lܬߛ۔__|yq?t$?'xq. ?}qO ݐ3 rK`sd~˟KJ%e:>;J9_{q~X{887zO~n(꫷PyBKY O!xs5TzcU?9s??^=?+ʽTYyQ_[,7KqbӨp ?=GΨ ? )v~7?Y/2ߟWvq?)UehrWOkHs^]>c{WvgiuVR2#qo=>̹g@GS)|zqK=f[{K;S^>q=kx=Vx-z+'.ұO;`qKZ{Gޮ/N啫bK];u]AGoԿ\9'^} ~W_ #|߂+zK/Kꩇxҿvvgށ~8' 97~f|<:󝿞ėθsgqAKb_u.V};?p(9 xάS3 rÅA+⻮^-]?kGŕ(zXnYhgq=<Wor[\^uP/̷~m ^9zoq;:~O57NkWw嫗+_Qz Ʊ_Q=ڭUB>p B½ _'(a>辩cqW;kyf as/<7߁RxŵVg?BNQaKo.]{3Gc7|;W_9όx%ȓ+(?ŭP~OݸWXV{qU>v G_?b| a] O֎% :~z9 +'>[=ЗBُ7ןөz.@S3n?B~6N3곯?W89ݬlv D=*v_{ 9 nogߤ~]^ '!X>x(V|GI#/*Ǹ8ڣr[ƳzNhg8 fᩙ+Ƚ\ y!oGI\|jYm+߃foObWT\FcKfa#Wf?4WĥWn: },xX:zu/NB?8K/.>nE~WG?`Cկ_jgr}0+]nە.Qb|'2._{GQcŸMROj_OwAGC-+Ϻ*ξo%9Sd]>)q8};_wWR_ܡH{_;nW.j_<׾rzօ->6GB7VZ[|F]v'k]{yX=e'~ڃެy|񮿏6nbn~NK?Xsζx=s;ix?#9WpS}׋+v^yeGdK[֞9V= K/~w_8# f3Ʊx?+w+P} <1W#QW+7E~8|ͫrvG>o Cן_S,^{}?|zhorM}z! <^ߣ\u~|錏uUOskXydgSJwfk`ه3\ߵO\Xg)W?BYU}7W`OH˟} yH돧;\b|Rv^()_Ʊ\^'ŸܞB(<Gn{qℙo/,|嫧$.|qq}>^?Hbv||z굯x̛~)Tn3-QΗv܋kgI?8+7`>2]ͽQU+k帇jd=J{-,nB/? \mS>'Z[S^}?%#X~8 g"/_-/zK?9{ w/\8~G~uGS{qW׮^1/wVGk̸3tϾ:ߝ |q /c>_d'Ⱦ|wЍ ?)W=8W{|F}_GQh[֞##tsz]Anb]R^߼8qݙGkL/_XyXs?_qQ.h g_S/~MʼnY}g.{G:?G8oګܦ&__/_{l!r?@z̫=X:oqn~|\}._9~)XP:?/_kwrGx-^ʧ+wtjඉ?)|*˧Nw_U/w =[\Os+f?_{G9<Ѯ7.I?'zpk nҙOW~ z)?:b\gMG~k\ȽXTzp.x_3^Y_a\`):N5gwbXgua@^I{g֩'Uxj'~oyBçXʫ?kHVNg6^k>V{ǕWa^/r,z Ou>vx)NaqظЋ~;tOO\r +O֯;ZpAځ/cY~q[g_>\,_/u}u*(#&]կz+Wqqǹ/G|W}A٥_S-=zc|u.c3>d?wfK3r9=+rd.ЉB5o?W=Ous:;d~ʵ7.# }Q﫥׮T\'sk[:WK)}__ux0ЏdT\ M{</? RB )}Sv?29_zAbx/w#]x]ʓqx +W$oPnwĺiv}JZ9?KSkrǐv?=S{ody0>wzwgпKO4-=*="nB2vϊds/,h^L/_99ǜ7ewӟ㡿x#~՞h'GIWa=P|ܛIAƙcxqPp-wyuZo;iiONzޥċ[wiƩEw]{vw_~ip_ʡhSY82/^ww~},$^ڹUAۤGy-isoK.ދWUW>򵌏y_2qC|3nø+`gׇ}O9qZ*q׾k6]=;C/aG䳟v]ՏGnYMV8Yܣ? %xNjH]=no%?q_S~ T?*O#h|Pp9] ha'ߜ}o#]:,9X1=CC6qTC;"ѿo8A?Ar {8Vs^ \rU͜38'q.d<^KzTw7+Վ%ꉏM; oOJBI%m\5tW_$~\r[7!?IeB`?oBM:P.ן?W>~UNv ]ċZs)YnwVsqᗫUzq<} d{X3ʙ&L VN>roTzDhT).g{bW^U˾!}WB>,ߡig7/r|WOåH^g!]Wz1ng.S &V>}[yY1ÿ,^+W+8WV*gYǵ^>|գ3ʧk's̃| ǽra0.ƹ֟|m;?|[y&—W8wV{|ѫ`s(~rt.p8`xMs?( (!y u޿V|:ޠO:|anϹZ$~_{qx,E߿kk/.ԯP{!+Pz+߃̓;ܯ⮮9_}r-n~ż~mS#CGú~\}+tCgq]x'Bi'Tc^;tZ:⾫7z~g/|~S٧'Cε||uqfпTg=ŧBuWbj_{}{Ǥd?-y紿z0@+Y;-_p].]k걞 tOҕ7~Gݴ>cڟR>#WObk8|G׃S~z/ZzwM˗>З]|;P9}z Gx01>_S|z3֮+~g̬\僾_̳8Wܾub+ܬ~sGQ\tXX|{a;3|rrǜʕ.|~Nr8'^lE^wzŝ9. kW+<yqVR\[_ߥK#^9=tb 0>:(/f\r++_:{ ?|vTCgQߥNy}&G/|^ ǩBsP+~c]9nP\N9S>Oh˷ ?$ߡ;v_o?ݕ+>'boP/B] |H/ᛵ:_+~.?B_;. =/񠇠Փ]z#_}Q^ixʓU?z~:*7 2s_f^?x ? cUO/#ߡsb s/t|R~Wa}ջ/tZXn汐?Kőyq?AOʸ>_ ɽt];5=+^B) Kx~gۧk/㭿8;'z_ N1?΄̗S|Oނvק|ˠWgr6iqng/ﰬx|o{,?:,4;֎xut6\O?CJC+'=՟iCֻI.EӕS B߻G1z}},HΟP/}|D1{W_lK+tTB|>gk=ϋ-{wsq襫[Hr]%/^}ʫ~>a\X{ahv;}}x˯]x|q*$vwm}z^֥+gT?v?FT^{ŕgO_;xxWyaO t {+/8[ c+.|:|~!sݖnAgӿţHگ|279,N[ow2ꥨμOcR9hA_~ I_ʑ_}W.tYyYW/3Sy>Ygoʟ٧+_{33.(Oul{B֗~^EzПu 9'r.]9@q'?rg}}~$}!x7t]~z~Q_m[\.;,ܹx||qWs,]VVOՃoT/~F3z;|WPÇ*>58ӾϗrD/~ _kgߡūwO|S~^3qh7]>T^z c*}[:!ʿ=2;GW*=gLqGV9 aG^My~Z:/k6 q_z-^|_=: qu!d?Y~գ>!? /_+L|7~e{/vhn\州S./Uh׶tzy˧mʱ^q>|So_\}?a_miWʱ?=ԞV˅ޟ8虿@v>^bjqkD'/xK- |!ekӅO31X{yѣ8қ?;7G1GS~Y_GA}O6OC:!BЙy0'QOdš^d΃マwgqB8̋}ɼ^oP?Y|~bJ:c>UΞ.?.ի ?}ӛ;{~߫WOgøю:-,,@oI?' |*zDŽ׫'[9I/s;[/a.j΋}Sz)mq׬[B?nu%·[=ז_]ٟ|2do}0(NbNR8.~~B7/`M[w/^#P~>羀^w[տBt_|^yqό{!ȝo'P{qoe}~7?KW }+!djV|mҩV^Kn/]ҡ9ܯүz3K]} γt'i~w֎ БRcRi?t~gm>g_go?_Υv죌sEsS^z˾t^&׿ ny/_Sګs/e\ʓ>n,??̗|C+J{)z!kqƋ|3<,{rK yWo`03?,{Yߧbwz,+Wj.F{]HqR+G=ƉHhꗲ~$ϋ̛q)?_c|ʓ+h]NbtjyO}y9.8X;Ds4=B> H|xk{"wNv(GIP(Z}mV^s^ ҟPK?o |_+Kޏ#w/wS1kG?+2i8]y٩awt`3z"wGB+_h|>{W|8ݿ7. t_z?kQXg<>{zI~Gu_}]ړ+O֍svGI;>^@\,گ^ [#{%aߕ׿ =XW ꯜ}#n Ui3=yr/*akz?w(?<૑_߀Cw|/A~雙OR*}rHп(N:{p93qK?_s0sS\o޵8*of{?|㸷vyW\%?È]}d~@i'w'yAWB=*?ϼ-jWz{q^1YNgyypX*?8*=R{/wkpof>ז8$c8E-7]c~tQAɯ>F0׾se ʺKOeo {{ W^qakײP}k|ά}71/^v ˦<κKoKYŵx.~MξO }_/qߥO֓u( wP?AʛB_::of_{x啋@WŽV|){~gPUkqq^|o?R qQ^>X_aZ7#OEnV܌ky=>[8L~ũzފ+xNzKGv߰Dykf7>S~fჍ9'#toaK;_27R xAg~/:VY/_>=Tg.?v FAbҙA =/n~;Tƹ!=@ ׳x/gۤs+iߝ8/SSý&>}0܋u/{/2?/=a^~^zn|uO7,;\; 3q]]O^/[]qrګ߹[G5d/`\.|r?wtq<2UϗWcgqߍK0 o}wA>a]Sz-N%y[$T o^ҋ?d}ϡ ڹWKqs߽r xi'|3~]st,p&Z}-<n|ʏ2G~ 熞 ν;^??w/;zpBxԯ#+R?8G'y~ʿYP}pnܠk*T޺O\XЋu|wCOy[;3=g|X{Vst,~cszqaS8 K-zj pޫ=3^nqi_s+͸VayZ$i8RxΩ_0ΕC3/?l_Gz]+;n7Uw勇z߯O⼽>Zr$~_j~'X|/_OOկ/{\z!+?f +wwe69\>zvn )M9* ,TT_x]z0 :N=Y8#+KůҮ/黐k˺?s8r~q.2Y x2N.X|.TTJkT[O6_#oƏl?|܀]? =xo#;DRPŕW|igJn}|?7jG^v})r_W?,oWm|K?x?Wc7W_X_z\|zg|S=,> S<ↈ_q߱xqʿ:oll:[#~6Hֹ%s|?G׎nǾ:v[?ccxX-;,1o/ƳktM>!ry{rESn|wĽZzű_*Bo..߹Ope) Uċ<߸=#ԯa>?Kg7d~է)n9cqV>rC]Ⱦ/NI۫8}?}~.w㜱^9SOX<62~mgB귇w셬 |S O{l`>w6+>漬=Kg@%=/O}oA? ջ;vgg:.'S<27D{û]7]z9.A/WO=!Wz˯^AzVN9Rxռ?P+qi+:Xo׮@s] 9'<]q1[hgI¸u~e?k?{?o?yoڿ?~4C/}wR{??_'~쬿GwΎ/5m8m16q,8888^ojioo4oi8q|q|{w7i8q|q`dÍSGǏ6O7k?8~qdӍg6k?8~qb\ˍWǯ6_k88~qvbR{817q<[;]=-[Ƿ56oo8>8q|Wx=7O4ll?8~q|qHcO4l?8~qLs/4_lk8~q|qJk7o6n_l_j8~qax1 jc8㭍FGǷ7hk8q|q|w}'6O6j?8>8~qht'O6j?8~ql/65_j8>8~qj 7o7/6/5m8m}gclsXǣqqqq8888h8q|[hc;w57n8q|DCǧǏ4mn?8~qDS4m?8~qBKǯ4_m8~q|qfqcnKx467w4ǻ{[Ƿ6okm8q|q|gݍ{5oh?8>8~qpTӍǏ7h?8~qt7_h8>8~qr|o4/4l888~q~ö5q̍cizxWxOxxq|Km㣍w45l8>8q|OM#G^x|4[<,jvwXn xŋa)SO?)SO?)SO?)SO?)SO?)SO?)SO?)SO?)SO?)SO?)SO?)SO?)SO?)SO?)SO?)SO?)?ϿxJ>?>7\:uvߕU>Dz7z_>^s>uTz?w)m+ެ7\T:_*חvC7Ѷ/Wz7+\ݬ7ZǯYoqi}S\?aMS׻-G9^{\'nTX|j\ޯ{U7ZTTU:gn[UN_÷_O]D Tڏ}^9]۫џ_Ӯ}S}T{aQzn[Q>T~տov_ʭl|ޗΫ^|*ם=s>}ɽ/zqtu~]Y kQq~jwq }}>u9?>Tnox_Gy=wm:γo>5.};V+mv7N_ϛ_zopwzM/տW-R?Oks#Y[j-^ч{V~u<Ǖ._{mum';7Z.}W}\5cVN7ZT=qWYT=o˭*cٶ_m7u}U~/n{?e?qίG|[އgv>n֏ʕov?w.H}˯=UN_z_Y| u>E/>~ΛyrQUΛkÏZ_W.W<W ߗۯM㒍3!7yokiѸm/;ﶨ|k?d׸z\vD,{'m[J<+^x ΫG.Wl7GDZyGﳎn>k~W_j=^\{N{Y.\ضڡ<)G=^ۑ[ک__G?>P5~ʎqG+WUSju+;._3ԟzjPaQW~,_Տڝ_@NrW~ê??AEymuJ:q\*myʣvkj?ڍ_'rڡ_zG~Ͷծ4nڧ=އ_;_j7ю~N;,ܪ?C{6>4_SS<=lۚ-_]?kR};[~A[TUWUߢU?m7B^{^ּM\;oj7z?O5o~O[_?{-j?t\?Ur;<_O_I~PYs/룇u(/j?k~i'͟4~|.ԯټl[_7߱5/˅3ost5~ݭvc.{^46yKջγ}n;;|i^{^E>Z_W|-X\]\?^|5/?r?vajGjQ~Ӎ'u^r+^yV^տͫ~^•֏/kUj)jWX?/S{_WuݶuV_wK4ߨorCחOÚzX,/syqJ%}V_)/^zR^?qT=?~Nwڍ)^W5϶׼^^HCWWuz:Oϴ>}h>\VfuWͭK?>4S~~^~HSW_jO}_sո?~A!/i~Kb=qm_8z4?T^տKUN{_jTnK:mk::[o+ݧ%~^,Sڱ\*3_:yXO=SV?T}/H~8qDڍ?S?7}i\~cY?h<+ ";ՋNOOGN>.{^׏ucѯjX?|~pK>_?rA]P~oQeT??4?I|Z\{׫Ի^޿~}:߮^k}.J~?ͶcY[뺛SR^掣Runw~·\~j?}+E>ޟS=_Wj_o>oSW87|UǬ_SQU:_.:϶A! ?uP+uo?}j|'z\zo-.Gǩ~]?>SqL~꯮ϻzy?*ڥkߟQ9=vٙ睗~@:䜪>u/G_?RsΡqVZSEulɢ{Tz߹˿o[t{NwTr煵j_J_i[W"m[{ߛ}Zn5sx{N<ʱGTu]F˻k۵pa]ٞ|^]yP;שndkծriqmNY~r;z]߰|Y>oX~kާ]zy[oNUuԾ}9y?Y?^~^~W?Ks+~߽Om?K5Ѹc>E}:ߧ{翿pmkMJ^YZ8??ΧOuڥ|Y>onu~5.Wտޝޟ#]z?:'zz/#꺸/}HTT?:.uI//:կm[Cǯ듪{^q8~UsRS?gozJR՛ݟ3>1FC+șϯC:kϾݻjSQvڑky]}snvSۏ=___RÝGkz?rk7lZ|WSk'ջ=_m;|]Gw~_>_WV{^5G{M.z>ջN۶k迿ydP;xɗ}'Oޟi#5oWQ\>{;->$V.qߧy[S|~~MGrv׹yPq9~~^G}X5CCK^kI}YsK'{:*_C׎KSO5^MSc%yYnmjgw~ܟfoUcQO8控u^|uo}sU1Uj7Xޟiv_Vypp|>WֺjUK*;^?\r]Om+{`z7jOV=}?{^sW|Rg+|@_^:^|kvϯL=&gW=v]sL^_Sv~TuKns8<_~m꾢~~j?V/:ߚ7/E~~\r] ??^ܯʗڵPRel| \Upzߩ~*w~zgS'YîS*][z:O~Z>Z]T·̯g|4>~|+]]Wi}]WT9ɓڽ~omkjuNu~}woxv{+]ӼMt|:|ˡ+?JSw>}߯m~|U/TE=gIsx???[׷qN&X~YzUzmՎwvy+_v=IۮWM?ӣQ.XCw\jO/ٶGTN˧q3Ekۯ9.O]u\_8h~D x;^}*R;ߡ~`ж[j[_ev͢ޯm扚Ϗ,> l?YZWW\?cIοڍ8jȑ9~o_;jOΗ~@kw[C]~v_sj?8{]^1߿g^}\=j|W?f_ +g?To3rʯ>;s緮Oj|j~q/Uڿ=^.{_u:]^PտzwkQ&=.'U{ZΛeP{]=ǶU~Jө+տa寿hW˯kM?ο=^~{OyET~WnQ{V;Ŷ}}_>oyu߃'qQu~>Uߣ˷Eﻩ}>c_տț\~ZaȳźouʝgzCVzA .j?PyGRYT~~?E糸zEjaۯ}({\j{}X?Tj?\._/]>Nm?z.?'u^9}߅Q?f>y~ukO*nxЕ^jpNerN@W~{^|d5.w gɢ2_;uϺޣzMe Wf]Yr˹X<;t4{?ӿy'߯'|0JFOv> DI^4RxFڭt B:4_M:t~t&돓OkIHI`s>sQNyC:_,8' o;Aͤ(McHo%?ǓFH"EH2鷓N?AH: =F3I&~'%|_@z"_Lz7/!{I9wGiϐ +I&=AgI?Gn??O_K=~בz҇Io$MH3o!6N;H%wC{IcAI&#O~ˤK$~?>EGI'}OI?E &3Y?GIs/!}/ҿJWH_'}oMҳg]"ۤ%ҿKH>ˤ_%<#L ?!_#}sA_AI %@H=I$oGҷIAH3EB_I%"K?H#/&~E;w;w;H;w$w;w ;w;wQ;w;w$w;w{H;w;w;wO;w;w#;w;w;w;w;w;w;w;w;w;w;w;w;w;w/_  /_L{={={={={={={={={={={={={={={={={={={={={={={={={={={={={={={={~."#DGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGG_8_!???~|qR߀<8????????????O/??????????????????^XOOOOOO<^o#Gyr#G?#G?#G?#G?#G?#G?#G?#G?#G?#G?#G?#G?#G?#G?#G?#G?#G?#G?#G?#G?#G?#G?#G?#G?#G?#G?#G?#G?#G?#G?#G?|~f 'O?N'O? 'O? 'O? 'O? 'O? 'O? 'O? 'O? 'O? 'O? 'O? 'O? 'O?wE 'O? 'O? 'O? 'O? 'O? 'O? 'O? 'O? 'O? 'O? 'O? 'O? 'O? 'O? 'O? 'O? 'O? /n?3g?3g?3g?3g?3g?3g?3g?3g?3g?3g?3g?3g?3g?3g?3g?3g?3g?3g?3g?3g?3g?3g?3g?3g?3g?3g?3g?3g?3g?3g?3g?3g/_һ /_ /_ /_ /_ /_ /_ /_ /_ /_ /_ /_ /_ /_ /_ /_ /_ /_ /_ /_ /_ /_ /_ /_ /_ /_ /_ /_ /_ /_ /_ /_ /_^WyV_+W_E+W_+W_+W_+W_+W_+W_+W_+W_+W_+W_+W_+W_+W_+W_+W_+W_+W_+W_+W_+W_+W_+W_+W_+W_+W_+W_+W_+W_+W_+W_+ח/Ʒ 7o 7^ 7o 7o 7o 7o 7o 7o 7o 7o 7o 7o 7o 7o 7o 7o 7o 7o 7o 7o 7o 7o 7o 7o 7o 7o 7o 7o 7o 7o 7o 7o|;w;w;w;w;w;w;w;w;w;w;w;w;w;w;w;w;w;w;w;w;w;w;w;w;w;w;w;w;w;w;w;w勯??28???????????????oE/׃{x;u龤7multitaper/data/willamette.rda0000644000176200001440000000533014456126666016231 0ustar liggesusers=ynlܛ 4N=xȆPyu]Czpa7g}eNν9!>U 16 f71 EtfCtF3‹ﭴ8oꤞT s Zoypa=ϴSgOJao,tJ$ tdMў}Єt@KwM !tΞQvu?2ʘFVZXb|r# pop\ګN `p7W eNϝ5&t\X&.MH~s:ϿljrmZ8[,\ Xc:DoU A8P pm; bg~!x=!Kh:b)x{Y y?Y ϬItr1 P~t 4T:n0ж=4pe'mw"ewc85aR7^$1疚G͆D4[I_K2L{v}+V2\BO"{xN# ԭO} L2CJ@>=Ӛ rC1O4-}* _vP*QjW< C5w;ukzsv#‰uFTq؜M;_@t>zSR;AfBE WhU mW 6 -pG{^ ?ALY<! Bq /5̲oI7*߆G4끳ςv bmi-O&-6ڽJ\3m<~/aG$|.7s}=8;6|KjӘTнt%BQ#@Gq+?'=@[h]sU\ԥ\\ͱQYu kW@Y~ΉVX<O tglde{st+2ś=8ߕ :8FĀd/W  X %m?טLx^-fT&Se^w}u[o .\9p=%ƃ[U u3KgmSZp HKT'/{m)w+Yτ3yr j<}7f. Ce]ŕq0yO!GZ cBz1wV UX E# `"I28Oٟ.HJQN%"@Ժ-Q2㸋ZXjGGf5 cz? ~XOW?@Gya{Bп=v|f W?Ł~D}vy7?eΌh__ngY#Rb@;^נ-lׄ>ysW rH50;=˼6Z%^bul>Jə%c>;x3.d?X Yv|rN)V>tzTW{?Oٷ˦-sk6gK޼|Uu;e<-sQ"^r ς,/j+B-ǫB[MSVO* \f 6GEZYa1jH^NzIP:4#DzgBR}qF3y}@7! nk:00C:]hĸGgy)tG9P3j5h_k }u,'[FLgxO~qF- Vw{݉qBC s>x2DCB7P)g$- LYffgn m8ƷG{>rtt 닔#@LkP:m' 9oT~+ЁR̬_֐t],Fl}۶L_>kȹ.8'X!?޼YψtY PS+Z'c6[Sa ;rRvA7zeԱve|uo:7{p31ޤ:௎)1fPf~ՓԗmP,OuL_Nu1", u'?~Y1@DP^62_\Wy2?`) ߩbR5$~`2㷪?~oJ=38b߰X<8-K,/Oؾ3|q̶A0)4f .]>?qm_'Mvb>neK!f4@8GZ@A~rm'2@d?ed1\͹ n /#σ9J~)XHkw(>MgY<rOSևn^ aUٹv0l*K{&Í~8ic?PIȱxX jkq+q}q-(ZP*S;h[jXQDQDT(PZi~iҦ1M{I|n|6l>6&Z3?Μ}߽>997%,Jܬ9/d{oޤq U@y5q;ouM:Ske}?^Dŵ]&yqSCKtV:-/3Oʧcȷ~s9|h]膏'I?$))G~GU?T"=bɮF_8ޏľδaQPHt9<>&y_uA(,؇u+Ƒ0꒟!{xQ`nQwC N?׻'"I}jIJZ.R> ~ڧ=II1zGp%wsTa}_D݋/&>+K#BQY`)er.ucQtH.{y7uNS={+T ǡk[)+~=:Sk4rvzMIjkk] '2w&$=E?Ah=f܍|?6dׯc#`\'õ:NQ(ľߐ>1ck-,[_ YGj>\ ag#ȷ&.KA\~P+nnۡ4}98:?8jR=S6('=sC~ P@l/j>ߏ CzʟQ>{;y_z~_?}):>qi @77'sgzNKj;}Đw} 4?ѧCFv:@Ro .(JHOQ) .o?|:>QQ~IiT?ct>Ng1A 7| !Љ5ԏ~?x<þ:}!; ?qi8L#OGqy@>S{qQx`~ZqĹ*=S!'Q^(&OZ 8Y tb e4t!qI #>c#7z,|$m_/CwRD4LiSkз)C;ԏ._n&k\z݆Kgxm&7sW=w__u{v]pKoo>.7}'multitaper/data/mlco2.rda0000644000176200001440000000420314456126666015074 0ustar liggesusers{Wc{݄֯HJ%dCaS YL]X*Mm9-iG ݶDZZM*H3%dx7ys>=9MX,9KN LMI A οgLV,rFplfGi),e̱2Rޱ2Ko)򮥼g) ,}KRZ"KYl)K,e,喲RVZʇ򑥬 KՖR,cKYk),KYo)ՖR6Z&Kl)[,e|j),e찔KRvD3[j8R/@3C`@ }>aO'}pfseG*&8nM|wKń̟wkٞ˚8fM&{Ϋ_cDqY `NwC>ygfq;_{Mwk~}~ *L.2LxIMo DK_ֳF|ղ֑G~^#ⴁ6?\Zpn,|y k&kK.NVxN!C_a5qӄo2^lg N< ~Vk%x? \]߇? o z &i}G᧰ˇr݂|'/~}2x<\gqz˾xXǑy'voWKOsX򍃯W}?}o!H}f\/c]Ewo>83[ sw>a?mei"iSd!BVo9ϼeğF/͂W|&9o9?] SSx9(}U12J_o-࿀)vOKc7]<(W݂Q_$kx *R'|} 'l??U}!@ db"ȷN1/: 8a gJ>^}y{ ʸ_s1bܣ[۬3rl>e:Eg}FpsX 87톿›^&Gӗ*ɯɗC]ĿX8#O~Ÿf;z3]5zt E62]g/>7 q.>t9wtpuø.D=9M3o+\w?u,q'җ~C{>=烑?|s]PY.z$/Mz>WI39⍹Kux /_N}_iͼx>gΔ wH] p𞡏 >A߰R9Op9H#V;}cay\ gKL2x#ѧE࿊݄Wӟ3oI"N=s~+ =}37 _בs~enn0]/>χL;w ~gIwgr-OV7zјBeyEԋ?Rn5d{9RƇyyFqO2oP4te?>s`30 'multitaper/man/0000755000176200001440000000000014456126666013233 5ustar liggesusersmultitaper/man/HadCRUTnh.Rd0000644000176200001440000000304214456126666015241 0ustar liggesusers% The multitaper R package % Multitaper and spectral analysis package for R % Copyright (C) 2011 Karim Rahim % % Written by Karim Rahim and Wesley Burr. % % This file is part of the multitaper package for R. % % The multitaper package is free software: you can redistribute it and % or modify it under the terms of the GNU General Public License as % published by the Free Software Foundation, either version 2 of the % License, or any later version. % % The multitaper package is distributed in the hope that it will be % useful, but WITHOUT ANY WARRANTY; without even the implied warranty % of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with multitaper. If not, see . % % If you wish to report bugs please contact the author. % karim.rahim@gmail.com \name{HadCRUTnh} \alias{HadCRUTnh} \title{HadCRUT Land Temperature Anomaly (Northern Hemisphere) Series} \description{ Hadley Climate Research Unit Temperature anomaly (Northern Hemisphere) time series. Consists of monthly observations, truncated to start at March 1958 and extend to September 2009, to match mlco2 dataset. This dataset was retrieved from the Hadley CRU on Oct 1, 2011. } \usage{HadCRUTnh} \format{ A data frame indicating the year, month and temperature anomaly for the Northern Hemisphere, between 1958 and 2009.} \keyword{datasets} multitaper/man/plot.mtm.Rd0000644000176200001440000000550414456126666015300 0ustar liggesusers% The multitaper R package % Multitaper and spectral analysis package for R % Copyright (C) 2011 Karim Rahim % % Written by Karim Rahim and Wesley Burr. % % This file is part of the multitaper package for R. % % The multitaper package is free software: you can redistribute it and % or modify it under the terms of the GNU General Public License as % published by the Free Software Foundation, either version 2 of the % License, or any later version. % % The multitaper package is distributed in the hope that it will be % useful, but WITHOUT ANY WARRANTY; without even the implied warranty % of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with multitaper. If not, see . % % If you wish to report bugs please contact the author. % karim.rahim@gmail.com \name{plot.mtm} \alias{plot.mtm} \title{Compute and plot the multitaper spectrum estimate} \description{ Plots the multitaper spectral estimate and the multitaper F-test. } \usage{ \method{plot}{mtm}(x, jackknife = FALSE, Ftest = FALSE, ftbase = 1.01, siglines = NULL, ...) } \arguments{ \item{x}{An object of the class mtm generated by spec.mtm.} \item{jackknife}{Boolean variable indicating if jackknife confidence intervals should be plotted, only applies if Ftest=FALSE.} \item{Ftest}{Boolean variable indicating if the multitaper harmonic F-test should be plotted instead of the spectrum.} \item{ftbase}{Lowest value to be plotted when the F-test is plotted. When Ftest = TRUE, max(ftestvalue, ftbase) is plotted.} \item{siglines}{Vector of significance values (as probabilities, 0.0 to 1.0) to plot as horizontal significance lines on the F-test plot. } \item{...}{Arguments to be passed to methods, such as graphical parameters (see 'par').} } \details{ The value log can be set to \dQuote{yes} (default), \dQuote{no}, or \dQuote{dB} as in the function plot.spec.} \seealso{ \code{\link{spec.mtm}} and \code{\link{plot.spec}} } \references{ Thomson, D.J (1982) Spectrum estimation and harmonic analysis. \emph{Proceedings of the IEEE} Volume \bold{70}, number 9, pp. 1055--1096. Percival, D.B. and Walden, A.T. (1993) \emph{Spectral analysis for physical applications} Cambridge University Press. } \examples{ data(willamette) resSpec <- spec.mtm(willamette, nw=4.0, k=8, Ftest=TRUE, plot=FALSE, deltat=1.0, dtUnits="month") plot(resSpec) plot(resSpec, Ftest=TRUE) plot(resSpec, Ftest=TRUE, siglines=c(0.90, 0.99)) # with jackknife estimate resSpec2 <- spec.mtm(willamette, nw=4.0, k=8, Ftest=TRUE, jackknife=TRUE, plot=FALSE, deltat=1.0, dtUnits="month") plot(resSpec2,jackknife=TRUE) } \keyword{multitaper} multitaper/man/multitaperTrend.Rd0000644000176200001440000000407714456126666016715 0ustar liggesusers% The multitaper R package % Multitaper and spectral analysis package for R % Copyright (C) 2011 Karim Rahim % % Written by Karim Rahim and Wesley Burr. % % This file is part of the multitaper package for R. % % The multitaper package is free software: you can redistribute it and % or modify it under the terms of the GNU General Public License as % published by the Free Software Foundation, either version 2 of the % License, or any later version. % % The multitaper package is distributed in the hope that it will be % useful, but WITHOUT ANY WARRANTY; without even the implied warranty % of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with multitaper. If not, see . % % If you wish to report bugs please contact the author. % karim.rahim@gmail.com \name{multitaperTrend} \alias{multitaperTrend} \title{Estimate Linear Trend using Multitaper Techniques} \description{ Estimate linear trend using inverse spectrum estimation, with the spectrum being computed via multitaper. This technique has improved spectral properties when compared to the least-squares approach. Returned values from this function include the intercept, slope, and centered time array. } \usage{ multitaperTrend(xd, B, deltat, t.in) } \arguments{ \item{xd}{Contiguous time series to be detrended.} \item{B}{Bandwidth to use in estimating trend in physical units; corresponds to NW via equation NW=BT, where N and W are the usual Slepian definitions, and T is the total time elapsed, i.e. T = N*deltat.} \item{deltat}{Time step for series xd, also used in computing T.} \item{t.in}{Time array, used in accurately estimating the slope.} } \examples{ x <- 1:101 y <- 1.0 + 0.5*(x) + rnorm(n=101,mean=0,sd=2) vars <- multitaperTrend(xd=y, B=0.05, deltat=1.0, t.in=x) plot(x,y,type="l") lines(x,vars[[1]]+vars[[2]]*vars[[3]],type="l",col="red") } \keyword{math} multitaper/man/percivalAR4.Rd0000644000176200001440000000422014456126666015634 0ustar liggesusers% The multitaper R package % Multitaper and spectral analysis package for R % Copyright (C) 2013 Karim Rahim % % Written by Karim Rahim and Wesley Burr. % % This file is part of the multitaper package for R. % % The multitaper package is free software: you can redistribute it and % or modify it under the terms of the GNU General Public License as % published by the Free Software Foundation, either version 2 of the % License, or any later version. % % The multitaper package is distributed in the hope that it will be % useful, but WITHOUT ANY WARRANTY; without even the implied warranty % of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with multitaper. If not, see . % % If you wish to report bugs please contact the author. % karim.rahim@gmail.com \name{percivalAR4} \alias{percivalAR4} \title{Auto Regressive Series generated by Don Percival at Applied Physics Laboratory} \description{This is a simulated AR(4) time series (page 45 of Percival and Walden 1993). The source of this series is: Applied Physics Laboratory (Don Percival). The value for delta T is 1, and the sample size is 1024. Another realization of this series based on the same autoregressive coefficients can be generated in R using the code in the example section of the documentation. } \usage{percivalAR4} \format{A time series object containing 1024 simulated values.} \source{ Presented on page 45 of Percival, D.B. and Walden, A.T. (1993). See: \url{http://faculty.washington.edu/dbp/DATA/ar4.dat} } \references{ Percival, D.B. and Walden, A.T. (1993) \emph{Spectral analysis for physical applications.} Cambridge University Press. } \examples{ ## get the Percival realization of the series saved as data. data(percivalAR4) ## generate another realization of this series using the same AR(4) ## coefficients. ar4Coef <- c(2.7607, -3.8106, 2.6535, -0.9238) ar4.ts <- arima.sim(list(order = c(4, 0, 0), ar=ar4Coef), n=1024) } \keyword{datasets} multitaper/man/dpss.Rd0000644000176200001440000000622714456126666014502 0ustar liggesusers% The multitaper R package % Multitaper and spectral analysis package for R % Copyright (C) 2013 Karim Rahim % % Written by Karim Rahim and Wesley Burr. % % This file is part of the multitaper package for R. % % The multitaper package is free software: you can redistribute it and % or modify it under the terms of the GNU General Public License as % published by the Free Software Foundation, either version 2 of the % License, or any later version. % % The multitaper package is distributed in the hope that it will be % useful, but WITHOUT ANY WARRANTY; without even the implied warranty % of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with multitaper. If not, see . % % If you wish to report bugs please contact the author. % karim.rahim@gmail.com % Jeffery Hall, Queen's University, Kingston Ontario % Canada, K7L 3N6 \name{dpss} \alias{dpss} \title{Compute Discrete Prolate Spheroidal Sequences} \description{ Compute Discrete Prolate Spheroidal (Slepian) Sequences for use as tapers or other applications. This function uses the tridiagonal method and exploits symmetry. Note the odd order tapers are normalized so that the slope at the centre is positive in accordance with Slepian (1978) and Thomson (1982). This differs from Percival and Walden (1993). This code follows section (8.3) of Percival and Walden (1993) using LAPACK function calls Anderson (1999). } \usage{ dpss(n,k,nw, returnEigenvalues=TRUE) } \arguments{ \item{n}{A positive integer, typically the non-zero-padded length of the time series.} \item{k}{A positive integer, the number of tapers, often 2*nw for spectrum estimation purposes.} \item{nw}{A positive double-precision number, the time-bandwidth parameter.} \item{returnEigenvalues}{If true the appropriate eigenvalues are calculated and returned using the function dpssToEigenvalues. If FALSE, the eigenvalues returned are from the LAPACK function DSTEBZ using the tridiagonal. See section 8.3 of Percival and Walden (1993), or equation (13) in Slepian (1978).} } \value{ \item{v}{A n by k matrix of Slepian Sequences. Each column represents the Slepian sequence of order k-1.} \item{eigen}{A length k vector of eigenvalues corresponding to equation (13) in Slepian (1978), or the eigenvalues of the input tridiagonal matrix returned from the internal call to the LAPACK function DSTEBZ.} } \references{ Anderson, E. (1999). \emph{LAPACK Users' guide (Vol. 9).} Siam. Percival, D.B. and Walden, A.T. (1993) \emph{Spectral analysis for physical applications.} Cambridge University Press. Slepian, D. (1978) Prolate spheroidal wave functions, Fourier analysis, and uncertainty. V--The discrete case. \emph{Bell System Technical Journal} Volume \bold{57}, pp. 1371--1430 Thomson, D.J (1982) Spectrum estimation and harmonic analysis. \emph{Proceedings of the IEEE} Volume \bold{70}, number 9, pp. 1055--1096. } \examples{ dpss(10,4,4.0) dpss(100,8,5.0) } \keyword{math} multitaper/man/demod.dpss.Rd0000644000176200001440000000545514456126666015573 0ustar liggesusers% The multitaper R package % Multitaper and spectral analysis package for R % Copyright (C) 2011 Karim Rahim % % Written by Karim Rahim and Wesley Burr. % % This file is part of the multitaper package for R. % % The multitaper package is free software: you can redistribute it and % or modify it under the terms of the GNU General Public License as % published by the Free Software Foundation, either version 2 of the % License, or any later version. % % The multitaper package is distributed in the hope that it will be % useful, but WITHOUT ANY WARRANTY; without even the implied warranty % of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with multitaper. If not, see . % % If you wish to report bugs please contact the author. % karim.rahim@gmail.com \name{demod.dpss} \alias{demod.dpss} \title{Computes complex demodulates using multiple taper techniques} \description{ Computes complex demodulate of a given series around a given central frequency using multiple taper techniques. Returns amplitude, phase, and complex demodulate. } \usage{ demod.dpss(x,centreFreq,nw,blockLen,stepSize=1,wrapphase=TRUE,...) } \arguments{ \item{x}{Time series, required to be contiguous.} \item{centreFreq}{Frequency around which to demodulate.} \item{nw}{Parameter controlling time-bandwidth.} \item{blockLen}{Length of sub-block to use; demodulate is computed on each block in turn.} \item{stepSize}{This is a proposed option that sets the index step size between blocks. Currently this must be set to 1 and changes in step size have not been implemented.} \item{wrapphase}{If true, routine wraps phases around +/-360 degree boundaries.} \item{...}{Additional arguments. Currently only includes depreciated arguments} } \references{ Thomson, D.J. (1995). The Seasons, Global Temperature, and Precession. \emph{Science}, Volume 268, pp. 59--68. Bloomfield P. (2000). Fourier Analysis of Time Series. 2nd edition. Wiley New York, pp. 97--130. } \examples{ data(CETmonthly) nJulOff <- 1175 xd <- ts(CETmonthly[,"temp"],deltat=1/12) demodYr <- demod.dpss(xd,centreFreq=1,nw=3,blockLen=120,stepSize=1) phase <- demodYr$phase offsJul <- 3*360/365 phaseAdj <- phase phaseAdj[1:nJulOff] <- phase[1:nJulOff] + offsJul yr <- (time(xd)+1658)[1:length(phase)] plot(yr, phaseAdj, type="l", lwd=2, ylab="Phase of the Year in Degrees", xlab="Gegorian calender date") lines((1:nJulOff)/12+1659, phase[1:nJulOff], col="red") fit <- lm( phaseAdj ~ yr) abline(fit, lty=2, col="blue") cat(paste("Precession Estimate: ",fit$coef[2]*60*60,digits=6," (arcseconds/yr)\n",sep="")) } \keyword{math} multitaper/man/CETdaily.Rd0000644000176200001440000000323014456126666015156 0ustar liggesusers% The multitaper R package % Multitaper and spectral analysis package for R % Copyright (C) 2011 Karim Rahim % % Written by Karim Rahim and Wesley Burr. % % This file is part of the multitaper package for R. % % The multitaper package is free software: you can redistribute it and % or modify it under the terms of the GNU General Public License as % published by the Free Software Foundation, either version 2 of the % License, or any later version. % % The multitaper package is distributed in the hope that it will be % useful, but WITHOUT ANY WARRANTY; without even the implied warranty % of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with multitaper. If not, see . % % If you wish to report bugs please contact the author. % karim.rahim@gmail.com \name{CETdaily} \alias{CETdaily} \title{Central England Temperature daily time series} \description{ Central England Temperature daily time series from the Hadley Centre United Kingdom Meteorological Office, http://www.metoffice.gov.uk/hadobs/hadcet/. The data set represents daily CET values recorded to the tenth of a degree Celsius, and contains temperatures for the years 1772 through September 30, 2011. This dataset was retrieved from the Met office at Hadley on Oct 1, 2011. } \usage{CETdaily} \format{ A data frame indicating the year, month, day, and temperature observed in Central England. This data-set contains 87566 observations.} \keyword{datasets} multitaper/man/willamette.Rd0000644000176200001440000000363014456126666015673 0ustar liggesusers% The multitaper R package % Multitaper and spectral analysis package for R % Copyright (C) 2011 Karim Rahim % % Written by Karim Rahim and Wesley Burr. % % This file is part of the multitaper package for R. % % The multitaper package is free software: you can redistribute it and % or modify it under the terms of the GNU General Public License as % published by the Free Software Foundation, either version 2 of the % License, or any later version. % % The multitaper package is distributed in the hope that it will be % useful, but WITHOUT ANY WARRANTY; without even the implied warranty % of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with multitaper. If not, see . % % If you wish to report bugs please contact the author. % karim.rahim@gmail.com % Dataset Rd file added in response to bug from Kirk Hornik Aug 12, % 2010. \name{willamette} \alias{willamette} \title{Willamette River time series} \description{ Willamette River time series. Each point represents the log of the average daily flow over a one month period from October, 1950, to August 1983. The sampling time is 1/12 year and the Nyquist frequency is 6 cycles per year. The data is from the companion code to \dQuote{Spectral Analysis for the Physical Applications} (1993) and was originally compiled by the US Geological Survey. } \usage{willamette} \format{A vector containing 395 observations} \references{ Percival, D.B. and Walden, A.T. (1993) \emph{Spectral analysis for physical applications.} Cambridge University Press. } \examples{ data(willamette) # time series object, January = year.0, December = year.917 will.ts <- ts(data=willamette, start=(1950+9/12), freq=12) } \keyword{datasets} multitaper/man/mtm.coh.Rd0000644000176200001440000000554514456126666015100 0ustar liggesusers% The multitaper R package % Multitaper and spectral analysis package for R % Copyright (C) 2011 Karim Rahim % % Written by Karim Rahim and Wesley Burr. % % This file is part of the multitaper package for R. % % The multitaper package is free software: you can redistribute it and % or modify it under the terms of the GNU General Public License as % published by the Free Software Foundation, either version 2 of the % License, or any later version. % % The multitaper package is distributed in the hope that it will be % useful, but WITHOUT ANY WARRANTY; without even the implied warranty % of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with multitaper. If not, see . % % If you wish to report bugs please contact the author. % karim.rahim@gmail.com \name{mtm.coh} \alias{mtm.coh} \title{Compute and plot the multitaper magnitude-squared coherence.} \description{ Computes and plots the adaptive multitaper spectrum estimate. } \usage{ mtm.coh(mtm1, mtm2, fr=NULL, tau=0, phcorr = TRUE, plot=TRUE, ...) } \arguments{ \item{mtm1}{An object created with spec.mtm(... ,returnInternals=TRUE).} \item{mtm2}{An object created with spec.mtm(... ,returnInternals=TRUE). Note mtm1 and mtm2 must be created with the same frequency resolution. They both must have the same values for nFFT and returnZeroFreq.} \item{fr}{The frequency values for the mtm object. This can be null by default (which results in computation for the full frequency range) or it can be a subset of frequency values.} \item{tau}{Phase-correction factor, if known.} \item{phcorr}{Correct phase (unwrap). By default, set to TRUE; set to FALSE if you would prefer the phase to be untouched. } \item{plot}{Boolean value indicating if a plot should be drawn.} \item{...}{Additional parameters, such as xaxs="i" which are passed through to the plotting function.} } \references{ Thomson, DJ (1991) Jackknifed error estimates for spectra, coherences, and transfer functions, \emph{Advances in Spectrum Estimation} 58--113. Thomson, D.J (1982) Spectrum estimation and harmonic analysis. \emph{Proceedings of the IEEE} Volume \bold{70}, number 9, pp. 1055--1096. Percival, D.B. and Walden, A.T. (1993) \emph{Spectral analysis for physical applications} Cambridge University Press. } \examples{ data(HadCRUTnh) data(mlco2) spec1 <- spec.mtm(HadCRUTnh, nw=5.0, k=8, plot=FALSE, returnInternals=TRUE, dtUnits="month", deltat=1.0) spec2 <- spec.mtm(mlco2, nw=5.0, k=8, plot=FALSE, returnInternals=TRUE, dtUnits="month", deltat=1.0) resCoh <- mtm.coh(spec1, spec2, plot=FALSE) plot(resCoh) plot(resCoh, cdfQuantilesTicks=1-10^(-(6:12))) } \keyword{multitaper} multitaper/man/mlco2.Rd0000644000176200001440000000305414456126666014540 0ustar liggesusers% The multitaper R package % Multitaper and spectral analysis package for R % Copyright (C) 2011 Karim Rahim % % Written by Karim Rahim and Wesley Burr. % % This file is part of the multitaper package for R. % % The multitaper package is free software: you can redistribute it and % or modify it under the terms of the GNU General Public License as % published by the Free Software Foundation, either version 2 of the % License, or any later version. % % The multitaper package is distributed in the hope that it will be % useful, but WITHOUT ANY WARRANTY; without even the implied warranty % of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with multitaper. If not, see . % % If you wish to report bugs please contact the author. % karim.rahim@gmail.com \name{mlco2} \alias{mlco2} \title{Mauna Loa Observatory CO2 Monthly Averages} \description{ Observations of monthly CO2 atmospheric concentration averages from the Mauna Loa Observatory, Mauna Loa, Hawaii, USA. Obtained from the ESRL Global Monitoring Division of the National Oceanic and Atmospheric Administration at http://www.esrl.noaa.gov/gmd/dv/data/index.php?parameter_name=Carbon\%2BDioxide. Dataset downloaded Oct 1, 2011. } \usage{mlco2} \format{ A data frame indicating the year, month and atmospheric concentration of CO2 in PPM.} \keyword{datasets} multitaper/man/centre.Rd0000644000176200001440000000456714456126666015016 0ustar liggesusers% The multitaper R package % Multitaper and spectral analysis package for R % Copyright (C) 2011 Karim Rahim % % Written by Karim Rahim and Wesley Burr. % % This file is part of the multitaper package for R. % % The multitaper package is free software: you can redistribute it and % or modify it under the terms of the GNU General Public License as % published by the Free Software Foundation, either version 2 of the % License, or any later version. % % The multitaper package is distributed in the hope that it will be % useful, but WITHOUT ANY WARRANTY; without even the implied warranty % of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with multitaper. If not, see . % % If you wish to report bugs please contact the author. % karim.rahim@gmail.com \name{centre} \alias{centre} \title{Centres (converts to zero-mean) the time series.} \description{ Centres the data using an expansion on the Slepian sequences if the bandwidth parameter (nw) and number of tapers (k) is specified, otherwise subtracts the mean or robust trimmed mean. } \usage{ centre(x, nw = NULL, k = NULL, deltaT = NULL, trim = 0) } \arguments{ \item{x}{The data as a vector or as a time series.} \item{nw}{The Slepian bandwidth parameter, typically between 2.0 and 6.0.} \item{k}{The number of Slepian tapers used, often 2*nw.} \item{deltaT}{Parameter required if the data is a vector and not a time series, and only for the Slepian case.} \item{trim}{[only used if nw and k are not specified] The fraction (0 to 0.5) of observations to be trimmed from each end of `x' before the mean is computed. Values of trim outside that range are taken as the nearest endpoint.} } \references{ Thomson, D.J (1982) Spectrum estimation and harmonic analysis. \emph{Proceedings of the IEEE} Volume \bold{70}, number 9, pp. 1055--1096. Slepian, D. (1978) Prolate spheroidal wave functions, Fourier analysis, and uncertainty. V--The discrete case. \emph{Bell System Technical Journal} Volume \bold{57}, pp. 1371--1430. } \examples{ data(willamette) cent.Slepian <- centre(willamette, nw=4, k=8, deltaT=1) cent.Trim <- centre(willamette, trim=0.2) } \keyword{math} multitaper/man/sineTaper.Rd0000644000176200001440000000306114456126666015454 0ustar liggesusers% The multitaper R package % Multitaper and spectral analysis package for R % Copyright (C) 2011 Karim Rahim % % Written by Karim Rahim and Wesley Burr. % % This file is part of the multitaper package for R. % % The multitaper package is free software: you can redistribute it and % or modify it under the terms of the GNU General Public License as % published by the Free Software Foundation, either version 2 of the % License, or any later version. % % The multitaper package is distributed in the hope that it will be % useful, but WITHOUT ANY WARRANTY; without even the implied warranty % of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with multitaper. If not, see . % % If you wish to report bugs please contact the author. % wesley.burr@gmail.com \name{sineTaper} \alias{sineTaper} \title{Computes sine tapers} \description{ Computes sine tapers for use in transfer function estimation and plotting. Not called from within spec.mtm. } \usage{ sineTaper(n, k) } \arguments{ \item{n}{The data as a vector or as a time series.} \item{k}{The Slepian bandwidth parameter, typically between 2.0 and 6.0.} } \references{ Riedel, K.S. and Sidorenko, A. (1995) Minimum bias multiple taper spectral estimation. \emph{IEEE Transactions on Signal Processing}, Volume \bold{43}, Number \bold{1}, pp. 188--195. } \keyword{math} multitaper/man/spec.mtm.Rd0000644000176200001440000001503214456126666015251 0ustar liggesusers% The multitaper R package % Multitaper and spectral analysis package for R % Copyright (C) 2011 Karim Rahim % % Written by Karim Rahim and Wesley Burr. % % This file is part of the multitaper package for R. % % The multitaper package is free software: you can redistribute it and % or modify it under the terms of the GNU General Public License as % published by the Free Software Foundation, either version 2 of the % License, or any later version. % % The multitaper package is distributed in the hope that it will be % useful, but WITHOUT ANY WARRANTY; without even the implied warranty % of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with multitaper. If not, see . % % If you wish to report bugs please contact the author. % karim.rahim@gmail.com \name{spec.mtm} \alias{spec.mtm} \title{Compute and plot multitaper spectrum estimates} \description{ Computes and plots adaptive or nonadaptive multitaper spectrum estimates from contiguous time series objects. } \usage{ spec.mtm(timeSeries, nw=4.0, k=7, nFFT="default", taper=c("dpss"), centre=c("Slepian"), dpssIN=NULL, returnZeroFreq=TRUE, Ftest=FALSE, jackknife=FALSE, jkCIProb=.95, adaptiveWeighting=TRUE, maxAdaptiveIterations=100, plot=TRUE, na.action=na.fail, returnInternals=FALSE, sineAdaptive=FALSE, sineSmoothFact=0.2, dtUnits=c("default"), deltat=NULL, ...) } \arguments{ \item{timeSeries}{A time series of equally spaced data, this can be created by the ts() function where deltat is specified.} \item{nw}{nw a positive double precision number, the time-bandwidth parameter.} \item{k}{k a positive integer, the number of tapers, often 2*nw.} \item{nFFT}{This function pads the data before computing the fft. nFFT indicates the total length of the data after padding.} \item{taper}{Choose between dpss-based multitaper (the default,'dpss') or sine taper method. In the case of the sine taper, parameter nw is useless, and both Ftest and jackknife are forced to FALSE. The sine taper also has two specific parameters below.} \item{centre}{The time series is centred using one of three methods: expansion onto discrete prolate spheroidal sequences ('Slepian'), arithmetic mean ('arithMean'), trimmed mean ('trimMean'), or not at all ('none'). } \item{dpssIN}{Allows the user to enter a dpss object which has already been created. This can save computation time when Slepians with the same bandwidth parameter and same number of tapers are used repeatedly.} \item{returnZeroFreq}{Boolean variable indicating if the zeroth frequency (DC component) should be returned for all applicable arrays.} \item{Ftest}{Boolean variable indicating if the Ftest result should be computed and returned.} \item{jackknife}{Boolean variable indicating if jackknifed confidence intervals should be computed and returned.} \item{jkCIProb}{Decimal value indicating the jackknife probability for calculating jackknife confidence intervals. The default returns a 95\% confidence interval.} \item{adaptiveWeighting}{Boolean flag for enabling/disabling adaptively weighted spectrum estimates. Defaults to \code{TRUE}. The \code{FALSE} case gives complex Fourier transforms equivalent to direct estimates with Slepian sequences as tapers.} \item{maxAdaptiveIterations}{Maximum number of iterations in the adaptive multitaper calculation. Generally convergence is quick, and should require less than 100 iterations.} \item{plot}{Boolean variable indicating if the spectrum should be plotted.} \item{na.action}{Action to take if NAs exist in the data, the default is to fail.} \item{returnInternals}{Return the weighted eigencoefficients, complex mean values, and so on. These are necessary for extensions to the multitaper, including magnitude-squared coherence (function mtm.coh in this package). Note: The internal ($mtm) variables eigenCoefs and eigenCoefWt correspond to the multitaper eigencoefficients. The eigencoefficients correspond to equation (3.4) and weights, eigenCoefWt, correspond to sqrt(|d_k(f)|^2) from equation (5.4) in Thomson's 1982 paper. This is because the square root values contained in eigenCoefWt are commonly used in additional calculations (example: eigenCoefWt * eigenCoefs). The values returned in mtm$cmv correspond to the the estimate of the coefficients hat(mu)(f) in equation (13.5) in Thomson (1982), or to the estimate of hat(C)_1 at frequency 1 in equation (499) form Percival and Walden (1993)} \item{sineAdaptive}{In the case of using the sine taper method, choose between non-adaptive and adaptive taper choice.} \item{sineSmoothFact}{The sine taper option has an inherent smoothing parameter that can be set between 0.01 and 0.5. Lower values indicate smaller amounts of smoothing.} \item{dtUnits}{Allows indication of the units of delta-t for accurate frequency axis labels.} \item{deltat}{Time step for observations. If not in seconds, dtUnits should be set to indicate the proper units for plot labels.} \item{...}{Additional parameters, such as xaxs="i" which are passed to the plotting function. Not all parameters are supported.} } \details{ The value log can be set to \dQuote{yes} (default), \dQuote{no}, or \dQuote{dB} as in the function plot.spec.} \seealso{ \code{\link{plot.mtm}} and \code{\link{plot.spec}} } \references{ Thomson, D.J (1982) Spectrum estimation and harmonic analysis. \emph{Proceedings of the IEEE} Volume \bold{70}, Number 9, pp. 1055--1096. Percival, D.B. and Walden, A.T. (1993) \emph{Spectral analysis for physical applications} Cambridge University Press. Riedel, K.S. and Sidorenko, A. (1995) Minimum bias multiple taper spectral estimation. \emph{IEEE Transactions on Signal Processing} Volume \bold{43}, Number 1, pp. 188--195. } \examples{ ## default behaviour, dpss tapers; deltat and dtUnits set to ensure axis accuracy data(willamette) spec.mtm(willamette, nw=4.0, k=8, deltat=1/12, dtUnits="year") spec.mtm(willamette, nw=4.0, k=8, nFFT=2048, deltat=1/12, dtUnits="year") ## if you have a ts object, you can skip the deltat and dtUnits parameters will.ts <- ts(data=willamette, start=1950.75, freq=12) spec.mtm(will.ts, nw=4.0, k=8) ## using Sine Tapers spec.mtm(will.ts, k=10, taper="sine", sineAdaptive=FALSE) spec.mtm(will.ts, k=10, taper="sine", sineAdaptive=TRUE, maxAdaptiveIterations=100, sineSmoothFact=0.05) } \keyword{multitaper} multitaper/man/dpssToEigenvalues.Rd0000644000176200001440000000336614456126666017176 0ustar liggesusers% The multitaper R package % Multitaper and spectral analysis package for R % Copyright (C) 2011 Karim Rahim % % Written by Karim Rahim and Wesley Burr. % % This file is part of the multitaper package for R. % % The multitaper package is free software: you can redistribute it and % or modify it under the terms of the GNU General Public License as % published by the Free Software Foundation, either version 2 of the % License, or any later version. % % The multitaper package is distributed in the hope that it will be % useful, but WITHOUT ANY WARRANTY; without even the implied warranty % of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with multitaper. If not, see . % % If you wish to report bugs please contact the author. % karim.rahim@gmail.com \name{dpssToEigenvalues} \alias{dpssToEigenvalues} \title{Compute eigenvalues for the Discrete Prolate Spheroidal Sequences (dpss)} \description{ Compute eigenvalues for the Discrete Prolate Spheroidal Sequences. The method used here is described in Chapter 8 of Percival and Walden (1993). } \usage{ dpssToEigenvalues(v, nw) } \arguments{ \item{v}{A matrix of dpss's, with each column representing a sequence of a different order, 1 to k.} \item{nw}{A positive double-precision number, the time-bandwidth parameter.} } \references{ Percival, D.B. and Walden, A.T. (1993) \emph{Spectral analysis for physical applications.} Cambridge University Press. } \examples{ dpss1 <- dpss(10,4,4.0, returnEigenvalues=FALSE)$v dpssToEigenvalues(dpss1,4.0) } \keyword{math} multitaper/man/dropFreqs.Rd0000644000176200001440000000454214456126666015474 0ustar liggesusers% The multitaper R package % Multitaper and spectral analysis package for R % Copyright (C) 2011 Karim Rahim % % Written by Karim Rahim and Wesley Burr. % % This file is part of the multitaper package for R. % % The multitaper package is free software: you can redistribute it and % or modify it under the terms of the GNU General Public License as % published by the Free Software Foundation, either version 2 of the % License, or any later version. % % The multitaper package is distributed in the hope that it will be % useful, but WITHOUT ANY WARRANTY; without even the implied warranty % of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with multitaper. If not, see . % % If you wish to report bugs please contact the author. % karim.rahim@gmail.com \name{dropFreqs} \alias{dropFreqs} \alias{dropFreqs.default} \alias{dropFreqs.spec} \alias{dropFreqs.mtm} \alias{dropFreqs.mtm.coh} \title{Truncate mtm or mtm.coh Objects in Frequency} \description{ A utility function to truncate the frequencies in a spectral estimate. This utility is used before calling plot(), to increase the visual frequency resolution of a plot by truncating frequencies outside a particular band of interest. This function is not a filter, but rather a utility to allow R to 'zoom' a spectrum plot to a certain frequency band. } \usage{ dropFreqs(spec, minFreq, maxFreq) } \arguments{ \item{spec}{A spectrum object 'obj', of class spec, mtm, or mtm.coh.} \item{minFreq}{The lower bound for the frequency band to be retained, in the same units as the obj$freq array.} \item{maxFreq}{The upper bound for the frequency band to be retained, also in the same units as the obj$freq array.} } \examples{ data(willamette) mtm1 <- spec.mtm(willamette, nw=4.0, k=8, plot=FALSE, deltat=1.0, dtUnits="month") mtm2 <- dropFreqs(mtm1, 0.1, 0.4) plot(mtm2) # another option plot(dropFreqs(mtm1, 0.1, 0.4)) # using sine tapers mtm.sine <- spec.mtm(willamette, k=10, plot=FALSE, deltat=1.0, dtUnits="month", taper="sine", sineAdaptive=FALSE, sineSmoothFact=0.05) plot(dropFreqs(mtm.sine, 0.1, 0.4)) } \keyword{multitaper} multitaper/man/plot.mtm.coh.Rd0000644000176200001440000000620314456126666016045 0ustar liggesusers% The multitaper R package % Multitaper and spectral analysis package for R % Copyright (C) 2013 Karim Rahim % % Written by Karim Rahim and Wesley Burr. % % This file is part of the multitaper package for R. % % The multitaper package is free software: you can redistribute it and % or modify it under the terms of the GNU General Public License as % published by the Free Software Foundation, either version 2 of the % License, or any later version. % % The multitaper package is distributed in the hope that it will be % useful, but WITHOUT ANY WARRANTY; without even the implied warranty % of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with multitaper. If not, see . % % If you wish to report bugs please contact the author. % karim.rahim@gmail.com \name{plot.mtm.coh} \alias{plot.mtm.coh} \title{Compute and plot the multitaper magnitude-squared coherence.} \description{ Plots the magnitude-squared coherence for a mtm.coh object computed from two equal-parameter mtm objects. } \usage{ \method{plot}{mtm.coh}(x,percentGreater=NULL,nehlim=10,nehc=4, cdfQuantilesTicks=NULL, drawPercentLines=TRUE, percentG=c(.1,.2,.5,.8,.9), ...) } \arguments{ \item{x}{An object of the class mtm.coh generated by spec.mtm.coh.} \item{percentGreater}{Prints the percent of the coherence function greater than the given values in the lower left hand corner. The values are expected in a vector representing the percentages. For example c(.5, .7) will print the percent of the msc that is greater than 50\% and 70\%.} \item{nehlim}{A smoothing parameter used in smoothing the variance in the final plot. nehlim is the number of points to smooth by on each side.} \item{nehc}{A smoothing parameter used in smoothing the MSC in the final plot. nehc is the number of points to smooth by on each side.} \item{cdfQuantilesTicks}{Percent lines to place the tick marks on the right axis (CDF). See the example in mtm.coh for use.} \item{drawPercentLines}{Boolean variable indicating if significance lines are to be drawn.} \item{percentG}{A vector of values for which to print dashed lines indicating the percent greater than a particular value. If drawpPercentLines is FALSE then this will not be used.} \item{...}{Parameters passed to plotting function. Currently only tested with xaxs="i".} } \details{ Returns an object containing the user-specified significance levels (\code{percentG}), along with their normal transforms. This allows the user to examine the \code{mtm.coh} object and clip the \code{NTmsc} variable to different significances. } \references{ Thomson, D.J (1982) Spectrum estimation and harmonic analysis. \emph{Proceedings of the IEEE} Volume \bold{70}, number 9, pp. 1055--1096. Percival, D.B. and Walden, A.T. (1993) \emph{Spectral analysis for physical applications} Cambridge University Press. } \examples{ # examples here } \keyword{multitaper} multitaper/man/CETmonthly.Rd0000644000176200001440000000355614456126666015561 0ustar liggesusers% The multitaper R package % Multitaper and spectral analysis package for R % Copyright (C) 2011 Karim Rahim % % Written by Karim Rahim and Wesley Burr. % % This file is part of the multitaper package for R. % % The multitaper package is free software: you can redistribute it and % or modify it under the terms of the GNU General Public License as % published by the Free Software Foundation, either version 2 of the % License, or any later version. % % The multitaper package is distributed in the hope that it will be % useful, but WITHOUT ANY WARRANTY; without even the implied warranty % of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with multitaper. If not, see . % % If you wish to report bugs please contact the author. % karim.rahim@gmail.com \name{CETmonthly} \alias{CETmonthly} \title{Central England Temperature monthly time series} \description{ Central England Temperature monthly time series from the Hadley Centre United Kingdom Meteorological Office, http://www.metoffice.gov.uk/hadobs/hadcet/. The data set represents monthly CET temperature values recorded to the nearest tenth of a degree Celsius, and containing records for January 1659 through December 2011. This dataset was retrieved from the Met office at Hadley on Mar 10, 2012. } \usage{CETmonthly} \format{ A data frame indicating the year, month and temperature observed in Central England. This data-set contains 4237 observations. } \references{ Parker DE, Horton EB (2005). Uncertainties in central England temperature 1878-2003 and some improvements to the maximum and minimum series. \emph{Int. J. Climatol}. 25: 1173--1188. } \keyword{datasets} multitaper/DESCRIPTION0000644000176200001440000000207014456220702014147 0ustar liggesusersPackage: multitaper Version: 1.0-17 Title: Spectral Analysis Tools using the Multitaper Method Author: Karim Rahim , Wesley S. Burr Maintainer: Karim Rahim Depends: R (>= 3.0), methods Suggests: psd, fftwtools, slp Description: Implements multitaper spectral analysis using discrete prolate spheroidal sequences (Slepians) and sine tapers. It includes an adaptive weighted multitaper spectral estimate, a coherence estimate, Thomson's Harmonic F-test, and complex demodulation. The Slepians sequences are generated efficiently using a tridiagonal matrix solution, and jackknifed confidence intervals are available for most estimates. This package is an implementation of the method described in D.J. Thomson (1982) "Spectrum estimation and harmonic analysis" . License: GPL (>= 2) ByteCompile: true LazyData: true URL: https://github.com/krahim/multitaper/ NeedsCompilation: yes Packaged: 2023-07-20 11:37:23 UTC; karim Repository: CRAN Date/Publication: 2023-07-20 12:00:02 UTC multitaper/configure.ac0000644000176200001440000000134414456126666014750 0ustar liggesusers# -*- Autoconf -*- # Process this file with autoconf to produce a configure script. AC_PREREQ(2.61) AC_INIT(FULL-PACKAGE-NAME, VERSION, BUG-REPORT-ADDRESS) AC_CONFIG_SRCDIR([src/dpss1.c]) #AC_CONFIG_HEADER([config.h]) # Checks for programs. : ${R_HOME=`R RHOME`} if test -z "${R_HOME}"; then echo "could not determine R_HOME" exit 1 fi CC=`"${R_HOME}/bin/R" CMD config CC` AC_PROG_CC # Checks for libraries. # Checks for header files. AC_HEADER_STDC AC_CHECK_HEADERS([stdlib.h math.h complex.h]) # Checks for typedefs, structures, and compiler characteristics. # Checks for library functions. AC_FUNC_MALLOC ##AC_CHECK_FUNCS([pow]) AC_CONFIG_FILES([src/Makevars]) AC_OUTPUT multitaper/src/0000755000176200001440000000000014456215667013247 5ustar liggesusersmultitaper/src/djt.f0000644000176200001440000002734614456142503014177 0ustar liggesusersC$$$ The multitaper R package C$$$ Multitaper and spectral analysis package for R C$$$ Copyright (C) 2011 Karim J. Rahim David J. Thomson C$$$ C$$$ This file is part of the multitaper package for R. C$$$ C$$$ The multitaper package is free software: you can redistribute it and C$$$ or modify C$$$ it under the terms of the GNU General Public License as published by C$$$ the Free Software Foundation, either version 2 of the License, or C$$$ any later version. C$$$ C$$$ The multitaper package is distributed in the hope that it will be C$$$ useful, but WITHOUT ANY WARRANTY; without even the implied warranty C$$$ of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the C$$$ GNU General Public License for more details. C$$$ C$$$ You should have received a copy of the GNU General Public License C$$$ along with multitaper. If not, see . C$$$ C$$$ If you wish to report bugs please contact the author. C$$$ karim.rahim@gmail.com C$$$ cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc cc This files contains modified djt multitaper files originally cc from libraries written at Bell Labs by David Thomson. c************************************************************************** c mw2wta multitaper using weights subroutine mw2wta(sa,wt,nfreq,nord,s,ev,evp 1 ,dofs,dofav,var,dt,tol, maxadit 1 , mxiter, aviter) implicit none integer nfreq, nord, maxadit, mxiter,n, niter, k double precision sa(nfreq,nord),wt(nfreq,nord),dofs(nfreq) 1 ,s(nfreq),ev(nord),evp(nord),var,dt,tol, aviter, avewt 1 ,wtmin, dofmin, sewn, sbar, dk2, sum, cwt, dofav, wmin 1 ,dk2l c Generate Weights mxiter = 0 aviter = 0.d0 avewt = 0.d0 wtmin = 1.d0 dofmin = dble(2*nord) cwt = 0.d0 wmin = 0.d0 c Equivalent white noise level for bias calculation sewn = var*dt do 265 n=1,nfreq c start at estimate based on two best eigenvalues sbar = ( sa(n,1) + sa(n,2) )/2.d0 dk2 = 1.d0 c iterate do 262 niter=1, maxadit sum = 0.d0 cwt = 0.d0 wmin = 1.d0 dk2l = dk2 do 250 k = 1,nord dk2 = 1 ( ev(k)*sbar/( ev(k)*sbar + evp(k)*sewn ) )**2 wt(n,k) = dk2 sum = sum + sa(n,k)*dk2 wmin = dmin1(wmin,dk2) cwt = cwt + dk2 250 continue sbar = sum/cwt if(dabs((dk2-dk2l)/(dk2+dk2l)).le.tol) exit 262 continue mxiter = max0(mxiter,niter) aviter = aviter + niter avewt = avewt + cwt wtmin = dmin1(wtmin,wmin) dofs(n) = 2.d0*cwt dofmin = dmin1(dofmin,dofs(n)) s(n) = sbar aviter = aviter/dble(nfreq) 265 continue dofav = 2.d0*avewt/dble(nfreq) end subroutine c*****end mw2wta cc********************************************************************** c multiwindow jacknifed. c Multi-Window Weighting, Jackknifed subroutine mw2jkw(sa,wt,nfreq,nord,s,ev,evp 1 ,dofs,dofav,var,dt,tol, sjk,varjk,bcjk,wjk,cwjk,vwj 1 ,maxadit, mxiter) implicit none integer nfreq, nord, mxiter, n1, n2,j, n, niter, ks, maxadit 1 ,k double precision sa(nfreq,nord),wt(nfreq,nord),dofs(nfreq) 1 , s(nfreq) 1 ,ev(nord),evp(nord),sjk(nord+2),varjk(nfreq),bcjk(nfreq) 2 ,wjk(nord,nord+2),cwjk(nord+2),vwj(nord) 1 ,total, avewt, wtmin, dofmin, bcor 1 ,fnord, vnrm, sewn,var,dt, dofav, varcwt, sbar,sum 1 ,wmin, slast, tol c Generate Weights mxiter = 0 total = 0.d0 avewt = 0.d0 wtmin = 1.d0 niter = 0 sbar = 0.d0 wmin =0.d0 dofmin = dble(2*nord) bcor = dble(nord-1) fnord = nord vnrm = dble(nord-1)/fnord n1 = nord + 1 n2 = nord + 2 c Equivalent white noise level for bias calculation sewn = var*dt c do 365 n=1,nfreq c iterate do 433 ks = 1, nord+1 c start at estimate based on two best eigenvalues sbar = ( sa(n,1) + sa(n,2) )/2. do 362 niter=1, maxadit sum = 0. cwjk(ks) = 0.d0 wmin = 1.d0 slast = sbar do 350 k = 1,nord if(k.eq.ks) go to 350 wjk(k,ks) = ( ev(k)*sbar/ 1 ( ev(k)*sbar + evp(k)*sewn ) )**2 sum = sum + sa(n,k)*wjk(k,ks) wmin = dmin1(wmin,wjk(k,ks)) cwjk(ks) = cwjk(ks) + wjk(k,ks) 350 continue sbar = sum/cwjk(ks) sjk(ks) = dlog(sbar) if(dabs((sbar-slast)/(sbar+slast)).le.tol) exit 362 continue 433 continue c Jackknife mean, variance of Log S sjk(n2) = 0.d0 cwjk(n2) = 0.d0 do 490 k = 1, nord wjk(k,n2) = 0.d0 490 continue do 500 k = 1, nord cwjk(n2) = cwjk(n2) + cwjk(k) sjk(n2) = sjk(n2) + sjk(k) do 510 j = 1, nord wjk(j,n2) = wjk(j,n2) + wjk(j,k) 510 continue 500 continue sjk(n2) = sjk(n2)/fnord cwjk(n2) = cwjk(n2)/fnord do 610 j = 1, nord vwj(j) = 0.d0 wjk(j,n2) = wjk(j,n2)/fnord wt(n,j) = wjk(j,n2) 610 continue c Jackknife Bias Estimate (Log S ) bcjk(n) = bcor*(sjk(n2) - sjk(n1)) c Variance Estimate varjk(n) = 0.d0 varcwt = 0.d0 do 550 k = 1, nord varjk(n) = varjk(n) + (sjk(k)-sjk(n2))**2 varcwt = varcwt + (cwjk(k)-cwjk(n2))**2 do 560 j = 1, nord vwj(j) = vwj(j) + (wjk(j,k)-wjk(j,n2))**2 560 continue 550 continue varjk(n) = varjk(n)*vnrm mxiter = max0(mxiter,niter) total = total + niter avewt = avewt + cwjk(n1) wtmin = dmin1(wtmin,wmin) dofs(n) = 2.d0*cwjk(n1) dofmin = dmin1(dofmin,dofs(n)) s(n) = sbar 365 continue dofav = 2.d0*avewt/float(nfreq) end subroutine c ****** end mw2jkw c Multi-Window Average Estimation subroutine mweave(x,dw,swz,ndata,nord,ssqswz,cntr,dt 1 ,spz, varc) implicit none integer ndata, nord, n, k, nnx double precision x(ndata),dw(ndata,nord),swz(nord) 1 ,sm(nord),sum,spz, zero8, dt 1 ,ssqswz, cntr, varc data zero8/0.d+00/ c no need for a max of 9 nnx = nord call setdp(nnx,zero8,sm) do 100 k = 1, nnx do 110 n = 1, ndata sm(k) = sm(k) + dw(n,k)*x(n) 110 continue 100 continue sum = zero8 spz = zero8 do 300 k = 1, nnx, 2 sum = sum + swz(k)*sm(k) 300 continue sum = sum/ssqswz do 500 k = 1, nnx spz = spz + (sm(k) - sum*swz(k))**2 500 continue spz = spz/dble(nnx) varc = spz/(dt*dble(ndata)) cntr = sum end subroutine c ******** end mweave c Set Real*8 array subroutine setdp(npts,val,x) implicit none integer npts, n double precision val, x(npts) do 100 n = 1, npts x(n) = val 100 continue end subroutine c ******* end setdp c ************************** helper functions used in coherence calculation c djt/ts/ adstoa.f Add Scalar to Array subroutine adstoa(x,y,ndata,xinc) implicit none integer n, ndata double precision x(ndata), y(ndata), xinc c djt/ts/tsu1 -2- add scalar to array do 3400 n = 1,ndata y(n) = x(n)+xinc 3400 continue end subroutine c ********** end adstoa c djt/ts/sphsed.f Basic Phase Unwrapping Routine, Degrees subroutine sphsed(ph,nfreq) implicit none integer nfreq, n double precision ph(nfreq), q, pinc,d, t q=0.d0 pinc=0.d0 do 2100 n=1,nfreq t=ph(n) d=q-t q=t if(dabs(d).gt.180.d0) pinc=pinc+dsign(360.d0,d) ph(n)=t+pinc 2100 continue end subroutine c ****** end sphsed c********************************************************************* cc calculated coherence estimates subroutine jkcoh1(cft1, cft2, nord, blklof, blkhif 1 ,fr, tau, phcorr, NTmsc, NTvar 1 ,msc, ph, phvar, s1, s2, jkmsc, TRmsc, bias 1 ,cx) implicit none integer n1, n2, ks, nav, phcorr, blklof, blkhif 1 ,k, kc, n, nord, nfreqs double precision fr(blklof:blkhif), tau 1 ,ph(blklof:blkhif), NTmsc(blklof:blkhif),s1(nord+2) 1 ,s2(nord+2) 1 ,jkmsc(nord+2),TRmsc(nord+2),bias(blklof:blkhif) 4 ,phvar(blklof:blkhif),NTvar(blklof:blkhif), cdabs2, phsed 3 ,trnrm, fnavm, varc, RtoD, RtoD2, msc(blklof:blkhif) 1 ,C2toF, xx, FtoMSC, fnav, xsm2, ff, zpref, d1mach 1 , dphse complex(8) cft1(blklof:blkhif, nord) 1 ,cft2(blklof:blkhif, nord) 1 ,cx(nord+2), zz logical phzref c cdabs2(zz) = real(zz)**2 + aimag(zz)**2 phsed(zz) = RtoD*datan2(aimag(zz),real(zz)) c Transforms from MSC to f, inverse C2toF(xx) = trnrm*dlog((1.+dsqrt(xx))/(1.-dsqrt(xx)))/2. FtoMSC(ff) = dtanh(ff/trnrm)**2 c zpref = 0.d0 nfreqs = blkhif + 1 - blklof nav = nord n1 = nav + 1 n2 = nav + 2 trnrm = dsqrt(dble(2*nav-2)) fnavm = dble(nav-1) fnav = dble(nav) varc = fnavm/fnav RtoD = 45.d0/datan(1.d0) RtoD2 = RtoD**2 do 6000 n = blklof, blkhif do 1400 ks = 1, nav+1 kc = 0 cx(ks) = (0.d0,0.d0) s1(ks) = 0.d0 s2(ks) = 0.d0 do 1300 k = 1, nav c do 300 nb = ns1,ns1+nsav-1 kc = kc + 1 if(kc.eq.ks) cycle cx(ks) = cx(ks) + cft1(n,k)*conjg(cft2(n,k)) s1(ks) = s1(ks) + cdabs2(cft1(n,k)) s2(ks) = s2(ks) + cdabs2(cft2(n,k)) 1300 continue xsm2 = cdabs2(cx(ks)) c Keep phase in (cos,sin) form cx(ks) = cx(ks)/dsqrt(xsm2) c MSC jkmsc(ks) = xsm2/(s1(ks)*s2(ks)) c Transform MSC TRmsc(ks) = C2toF( jkmsc(ks) ) 1400 continue c Bias TRmsc(n2) = 0.d0 cx(n2) = (0.d0,0.d0) do 1500 k = 1, nav cx(n2) = cx(n2) + cx(k) TRmsc(n2) = TRmsc(n2) + TRmsc(k) 1500 continue c Phase and Phase Variance cx(n2) = cx(n2)/fnav if(cdabs2(cx(n2)).le.10.*d1mach(1)) then if(n.gt.blklof) then ph(n) = ph(n-1) else ph(n) = 0.d0 endif else ph(n) = phsed(cx(n2)) + 360.d0*fr(n)*tau endif phvar(n) = dble(2*(nav-1))*(1.-cdabs2(cx(n2)))*RtoD2 c Jackknife average of transformed delete-one estimates TRmsc(n2) = TRmsc(n2)/fnav NTmsc(n) = TRmsc(n1) bias(n) = fnavm*( TRmsc(n2) - TRmsc(n1) ) c J.K. Unbiased Normal Transform to msc msc(n) = FtoMSC( NTmsc(n) ) c Variance NTvar(n) = 0.d0 do 1600 k = 1, nav NTvar(n) = NTvar(n) + ( TRmsc(k) - TRmsc(n2) ) **2 1600 continue NTvar(n) = NTvar(n)*varc 6000 continue c cx1(0) = 360.d0 c Keep zero-frequency reference phzref = (blklof.le.0).and.(blkhif.ge.0) if(phcorr .eq. 1) then if(phzref) zpref = ph(0) call sphsed(ph,nfreqs) if(phzref) then dphse = ph(0) - zpref call adstoa(ph,ph,nfreqs,-dphse) endif endif end subroutine c **** end jkcoh multitaper/src/dpss.f900000644000176200001440000001623714456126666014551 0ustar liggesusers! slp: Slepian Regression Smoothers ! ! Based on LISP code accompanying Percival and Walden 1993, the work of David Thomson and David Slepian. ! Code: Karim Rahim 2010 ! Modifications: Wesley Burr, small modifications, 2013 ! Maintainer: Karim Rahim 2017 ! ! This file is part of the slp package for R. ! ! If you wish to report bugs please contact the maintainer: ! ! ! dpss.f90 calculates Discrete Prolate Spheroidal Sequences using ! LAPACK routines 'dstebz' and 'dstein', using the tridiagonal method. ! ! Note the subroutine expects the memory for the matrix 'v' and the vector ! 'ev' to be allocated by the calling program. This is done by the ! '.dpss' subroutine in /R. ! ! name change to avoid namespace issue (2017) subroutine fdpss (n, k, nw, v, ev) ! Calculate dpss using the tridiagonal formulation given in ! Percival and Walden (1993), Chapter 8.3, using LAPACK functions ! in place of EISPACK. ! ! Also reduces the problem using the trick of reducing the symmetric ! tridiagonal matrix to two half sized matrices: one for the even ! eigenfunctions, and one for the odd. This trick was mentioned in a ! Bell Labs technical memo by Slepian in 1977. ! implicit none integer :: n, k, oddK, evenK, nOdd, nEven, i, j, & oddK_2, evenK_2M1, iTest double precision :: nw, w, ctpw, pi, twopi, sr2, & dlamch, abstol, sqrtsumsq parameter(pi=3.141592653589793d0,twopi=2.0d0*pi) double precision, pointer :: d(:), e(:), work(:), & blockDbleMem(:), evLocal(:)!, vlocal(:,:) double precision :: ev(k), v(n,k) integer, pointer :: blockIntMem(:) logical :: is_evenN character :: cmach ! ! interface block added to conform with f90 standard. ! In response to bug reported by Brian Ripley, July 25, 2010 ! - krahim ! interface subroutine tridiagMatrixEigen(n, k, d, e, v, ldv, ev, & abstol, blockIntMem, work) implicit none character :: range, order, cmach integer :: nsplit, m, info integer :: k, ldv, n, il integer, target :: blockIntMem(5*n+k) integer, pointer :: iblock(:), isplit(:), iwork(:), ifail(:) double precision :: vl, vu, abstol double precision :: d(n), e(n-1), v(ldv,k), ev(n), work(5*n) end subroutine tridiagMatrixEigen end interface w = nw/dble(n) ctpw = dcos(twopi*w) oddK = k/2 evenK = k - oddK sr2 = dsqrt(2.0d0) nOdd = n/2 nEven = n - nOdd ! Allocate memory and use pointers to reduce malloc calls ! The values '5' and '8' provide the required memory space for the two ! LAPACK calls. See the documentation for 'dstebz' and 'dstein'. ! Memory used in this procedure is allocated in the following two ! calls and then appropriate blocks of memory are accessed using ! pointers. Note: memory space for the matrix used by the calling ! program must be allocated in the calling program allocate(blockIntMem(5*nEven+k)) allocate(blockDbleMem(8*nEven-1)) d => blockDbleMem(1:nEven) e => blockDbleMem((nEven+1):(2*nEven-1)) work => blockDbleMem((2*nEven):(7*nEven-1)) evLocal => blockDbleMem((7*nEven):(8*nEven-1)) i = 0 d = (/ (((n-1-2*i) / 2.0d0)**2 * ctpw, i=0, nEven-1) /) ! ! convert n and i to double before the multiplication, in response to ! reported bug that occurs for large N ! - wburr, 2012 ! e = (/ ((dble(i) * dble(n - i)) / 2.0d0, i = 1, nEven-1) /) is_evenN = (modulo(n, 2) .eq. 0) ! ensure integer values are converted to double before mult to avoid overflow if(is_evenN) then d(nEven) = ((n+1-2*nEven)/2.0d0)**2 * ctpw + dble(nEven) * dble(nOdd)/2.0d0 else e(nEven -1) = e(nEven -1) * sr2 end if cmach = 'S' abstol = 2.0d0*dlamch(cmach) ! set ldv (ldz) to 2*n to force 'dstein' to skip odd column which ! will be used for odd eigenvectors ! The matrix v is considered to be of a different shape in the ! call to 'tridiagMatrixEigen2' ! call tridiagMatrixEigen(nEven, evenK, d, e, v, 2*n, evlocal, & abstol, blockIntMem, work) if(.not. is_evenN) then do i = 1, k, 2 v(nEven, i) = v(nEven, i) * sr2 end do end if do i = 1, k, 2 v((nEven+1):n ,i) = v(nOdd:1:-1, i) end do ! reorder eigenvalues and eigenfunction columns for even evenK_2M1 = evenK * 2 - 1 j = 1 ev((/ (i, i=evenK_2M1, 1, -2) /)) = evLocal((/ (j, j=1, evenK, 1) /)) v(:, (/ (i, i=1, evenK_2M1, 2) /)) = & v(:,(/ (j, j=evenK_2M1, 1, -2) /)) if(k > 1) then ! odd eigenfunctions (if any) ! similar procedure to the even functions ! if n is odd, nOdd < nEven ! ensure integer values are converted to double before mult to avoid overflow d(1:nOdd) = (/ (((n-1-2*i) / 2.0d0)**2 * ctpw, i=0, nOdd-1) /) ! convert n and i to double before the multiplication, in response to bug when n is large e(1:(nOdd-1)) = (/ ((dble(i) * dble(n - i)) / 2.0d0, i = 1, nOdd-1) /) if(is_evenN) then ! convert n and i to double before the multiplication, in response to bug when n is large d(nOdd) = ((n+1-2*nEven)/2.0d0)**2 * ctpw - dble(nEven) * dble(nOdd)/2.0d0 end if call tridiagMatrixEigen(nOdd, oddK, d, e, v(1,2), 2*n, evlocal, & abstol, blockIntMem, work) if(.not. is_evenN) then do i= 2, k, 2 v(nEven,i) = 0.0d0 end do end if do i = 2, k, 2 v((nEven+1):n ,i) = - v(nOdd:1:-1, i) end do ! reorder eigenvalues and eigenfunction columns for odd oddK_2 = oddK * 2 ev((/ (i, i=oddK_2, 2, -2) /)) = evLocal((/ (j, j=1, oddK, 1) /)) v(:, (/ (i, i=2, oddK_2, 2) /)) = & v(:,(/ (j, j=oddK_2, 2, -2) /)) end if ! normalize iTest = 0 if (mod(n,2) .eq. 0) then iTest = n/2 +1 else iTest = n/2 +2 end if do j = 1 , k sqrtsumsq = dsqrt(sum( v(:,j)**2 )) ! set polarity to agree with Slepian (1978) ! differs from Percival and Walden's formulation ! dpss slope up at centre, this agrees with Thomson (1982) if(v(iTest,j) < 0.0d0) then sqrtsumsq = -1.0d0 * sqrtsumsq end if v(:,j) = v(:,j) / sqrtsumsq end do nullify(d,e,work,evLocal) deallocate(blockDbleMem) deallocate(blockIntMem) end subroutine fdpss subroutine tridiagMatrixEigen(n, k, d, e, v, ldv, ev, & abstol, blockIntMem, work) !assumes memory is allocated by the calling subroutine. implicit none character :: range, order, cmach integer :: nsplit, m, info integer :: k, ldv, n, il integer, target :: blockIntMem(5*n+k) integer, pointer :: iblock(:), isplit(:), iwork(:), ifail(:) double precision :: vl, vu, abstol double precision :: d(n), e(n-1), v(ldv,k), ev(n), work(5*n) range = 'I' order = 'E' cmach = 'S' il = n - k + 1 m = k iblock => blockIntMem(1:n) isplit => blockIntMem((n+1):(2*n)) iwork => blockIntMem((2*n+1):(5*n)) ifail => blockIntMem((5*n+1):(5*n+k)) call dstebz(range, order, n, vl, vu, il, n, & abstol, d, e, m, nsplit, ev, iblock, isplit, & work, iwork, info) call dstein(n, d, e, m, ev, iblock, isplit, v, ldv, & work, iwork, ifail, info) nullify(iblock, isplit, iwork, ifail) end subroutine tridiagMatrixEigen multitaper/src/Makevars0000644000176200001440000000201414456126666014740 0ustar liggesusers## The multitaper R package ## Multitaper and spectral analysis package for R ## Copyright (C) 2010 Karim Rahim ## ## This file is part of the multitaper package for R. ## ## The multitaper package is free software: you can redistribute it and ## or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## any later version. ## ## The multitaper package is distributed in the hope that it will be ## useful, but WITHOUT ANY WARRANTY; without even the implied warranty ## of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## GNU General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with your install of R. If not, see . ## ## If you wish to report bugs please contact the author. ## karim.rahim@gmail.com PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) multitaper/src/Makevars.win0000644000176200001440000000175714456126666015551 0ustar liggesusers## The multitaper R package ## Multitaper and spectral analysis package for R ## Copyright (C) 2010 Karim Rahim ## This file is part of the multitaper package for R. ## The multitaper package is free software: you can redistribute it and ## or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 2 of the License, or ## any later version. ## The multitaper package is distributed in the hope that it will be ## useful, but WITHOUT ANY WARRANTY; without even the implied warranty ## of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## GNU General Public License for more details. ## You should have received a copy of the GNU General Public License ## along with Foobar. If not, see . ## If you wish to report bugs please contact the author. ## karim.rahim@gmail.com PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) multitaper/src/sine.f0000644000176200001440000001452514456215656014361 0ustar liggesusersC$$$ The multitaper R package C$$$ Multitaper and spectral analysis package for R C$$$ Copyright (C) 2011 Wesley S. Burr, Karim J. Rahim, David J. Thomson C$$$ C$$$ This file is part of the multitaper package for R. C$$$ C$$$ The multitaper package is free software: you can redistribute it and C$$$ or modify C$$$ it under the terms of the GNU General Public License as published by C$$$ the Free Software Foundation, either version 2 of the License, or C$$$ any later version. C$$$ C$$$ The multitaper package is distributed in the hope that it will be C$$$ useful, but WITHOUT ANY WARRANTY; without even the implied warranty C$$$ of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the C$$$ GNU General Public License for more details. C$$$ C$$$ You should have received a copy of the GNU General Public License C$$$ along with multitaper. If not, see . C$$$ C$$$ If you wish to report bugs please contact the author. C$$$ wesley.burr@gmail.com cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc cc This files contains modified spectral estimation code adapted from cc Robert Parker's psd.f c********************************************************************* cc cc quickSineF cc cc Simple non-adaptive (possibly weighted) sine taper multitaper cc computation program. Explicitly for calling from within cc the adaptive loop of spec.mtm.sine. The R-specific version cc of this (quickSine) runs quickly on its own; it is the adaptive cc loops that need speeding up. cc cc Adapted from Robert Parker's 'psd.f'. cc c********************************************************************* subroutine quickSineF(nFreqs,nFFT,k,cft,useAdapt,kadapt,spec) implicit none integer nFreqs,nFFT,k, ks, i, j, i2, j1, j2 logical useAdapt complex(8) cft(nFFT), zz real(8) spec(1:nFreqs), ck, wt, kadapt(1:nFreqs) do 5 j=1,nFreqs spec = 0.0d+00 5 continue do 6 i=1,nFreqs i2 = 2*(i-1) if(useAdapt) then ks = int(kadapt(i)) else ks = k endif ck = 1/(real(ks)**2) do 7 j=1,ks j1 = mod(i2+nFFT-j,nFFT) j2 = mod(i2+j,nFFT) zz = cft(j1+1) - cft(j2+1) wt = 1.0d+00 - ck*(j-1)**2 spec(i) = spec(i) + (dble(zz)**2 + aimag(zz)**2)*wt 7 continue spec(i) = spec(i)*(6.0d+00 *dble(ks))/(4*(dble(ks)**2) + * (3*dble(ks)) -1) 6 continue return end subroutine c********************************************************************* cc cc curbF cc cc Rewrites input vector so all points lie below a piecewise cc linear function v(k) + abs(j-k); clips strong peaks, keeps cc slopes below 1 in magnitude. Based on Robert Parker's 'psd.f'. cc c********************************************************************* subroutine curbF(n, v) implicit none integer n, j, k real(8) v(n), vloc do 1500 j=2, n-1 if (v(j).lt.v(j+1) .and. v(j).lt.v(j-1)) then vloc=v(j) do 1200 k=1, n v(k)=min(v(k), vloc+abs(j-k)) 1200 continue endif 1500 continue return end ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc cc cc northF cc cc Performs quadratically-weighted LS fit to some function 's' by cc a degree-two polynomial in an orthogonal basis; returns cc d1 and d2, estimates of 1st and 2nd derivatives at center of record cc cc Taken directly from Robert Parker's 'psd.f'. cc ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc subroutine northF(n, i1, i2, s, ds, dds) implicit none integer i1, i2, n, el, L, kk, i, u0sq real(8) gamma, s(n), ds, dds, amid, u1sq, u2sq, dot0, dot1, dot2 * , ssq L = i2 - i1 + 1 el=L gamma = (el**2 - 1.0)/12.0 u0sq = el u1sq = el*(el**2 - 1.0)/12.0 u2sq = (el*(el**2 - 1.0)*(el**2- 4.0))/180.0 amid= 0.5*(el + 1.0) dot0=0.0 dot1=0.0 dot2=0.0 ssq=0.0 do 1100 kk=1, L i=kk + i1 - 1 c Negative or excessive index uses even function assumption if (i.le. 0) i=2 - i if (i.gt. n) i=2*n - i dot0 = dot0 + s(i) dot1 = dot1 + (kk - amid) * s(i) dot2 = dot2 + ((kk - amid)**2 - gamma)*s(i) 1100 continue ds = dot1/u1sq dds = 2.0*dot2/u2sq return end ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc cc cc adapt cc cc Performs adaptive spectral estimation via sine taper approach. cc From pilot estimate of spectrum, computes estimates of S'' to be used cc in Eq. (13) of Riedel & Sidorenko (1995). cc cc Adapted somewhat from Robert Parker's 'psd.f'. cc ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc subroutine adapt(ntimes, k, nFreqs, sx, nFFT, cft, df,kopt,fact) implicit none integer k, ntimes, nFreqs, ispan, iter, nFFT, j real(8) sx(nFreqs), kopt(nFreqs), y(nFreqs), dy, ddy, R, ak, phi * , sigR, opt(nFreqs), fact, df, c1, c2 complex(8) cft(nFFT) data c1/1.2000/, c2/3.437/ do 5 j=1,nFreqs kopt(j) = k 5 continue c Adaptive iteration for MSE spectrum do 1600 iter=1, ntimes c do 1100 j=1, nFreqs y(j)= log(sx(j)) 1100 continue c Estimate K, number of tapers at each freq for MSE spectrum c R = S"/S -- use R = Y" + (Y')**2 , Y=ln S. do 1200 j=1, nFreqs c ispan = int(kopt(j)*1.4) call northF(nFreqs, j-ispan, j+ispan, y, dy, ddy) R = (ddy + dy**2)/df**2 ak=kopt(j)/dble(2*ispan) phi=720.0*ak**5*(1.0 - 1.286*ak + $ ak**3 - 0.0909*ak**5) sigR= sqrt(phi/dble(kopt(j))**5) / df**2 opt(j)=c2/(df**4 *( R**2 + 1.4*sigR**2) /fact**2)** 0.2 1200 continue call curbF(nFreqs, opt) do 1550 j=1, nFreqs kopt(j)=max(dble(3.0), opt(j)) 1550 continue c Recompute spectrum with optimal variable taper numbers call quickSineF(nFreqs,nFFT,1,cft,.true.,kopt,sx) 1600 continue return end multitaper/src/multitaper_init.c0000644000176200001440000000361114456126666016625 0ustar liggesusers#include #include // for NULL #include /* FIXME: Check these declarations against the C/Fortran source code. */ /* .Fortran calls */ extern void F77_NAME(adapt)(void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void F77_NAME(curbf)(void *, void *); extern void F77_NAME(fdpss)(void *, void *, void *, void *, void *); extern void F77_NAME(jkcoh1)(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void F77_NAME(mw2jkw)(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void F77_NAME(mw2wta)(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void F77_NAME(mweave)(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void F77_NAME(northf)(void *, void *, void *, void *, void *, void *); extern void F77_NAME(quicksinef)(void *, void *, void *, void *, void *, void *, void *); static const R_FortranMethodDef FortranEntries[] = { {"adapt", (DL_FUNC) &F77_NAME(adapt), 9}, {"curbf", (DL_FUNC) &F77_NAME(curbf), 2}, {"fdpss", (DL_FUNC) &F77_NAME(fdpss), 5}, {"jkcoh1", (DL_FUNC) &F77_NAME(jkcoh1), 19}, {"mw2jkw", (DL_FUNC) &F77_NAME(mw2jkw), 20}, {"mw2wta", (DL_FUNC) &F77_NAME(mw2wta), 15}, {"mweave", (DL_FUNC) &F77_NAME(mweave), 10}, {"northf", (DL_FUNC) &F77_NAME(northf), 6}, {"quicksinef", (DL_FUNC) &F77_NAME(quicksinef), 7}, {NULL, NULL, 0} }; void R_init_multitaper(DllInfo *dll) { R_registerRoutines(dll, NULL, NULL, FortranEntries, NULL); R_useDynamicSymbols(dll, FALSE); } multitaper/R/0000755000176200001440000000000014456126666012661 5ustar liggesusersmultitaper/R/demod.R0000644000176200001440000000616114456126666014100 0ustar liggesusers## The multitaper R package ## Multitaper and spectral analysis package for R ## Copyright (C) 2011 Karim Rahim ## ## Written by Karim Rahim. ## ## This file is part of the multitaper package for R. ## http://cran.r-project.org/web/packages/multitaper/index.html ## ## The multitaper package is free software: you can redistribute it and ## or modify it under the terms of the GNU General Public License as ## published by the Free Software Foundation, either version 2 of the ## License, or any later version. ## ## The multitaper package is distributed in the hope that it will be ## useful, but WITHOUT ANY WARRANTY; without even the implied warranty ## of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## GNU General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with multitaper. If not, see . ## ## If you wish to report bugs please contact the author: ## ## Karim Rahim ## karim.rahim@gmail.com ################################################################ ## ## .sphsed ## ## Phase wrapping routine; takes phases and tracks violation ## of +/-360 degree boundary, and wraps aliases. For use ## by demod.dpss(). ## ################################################################ .sphsed <- function(ph,nfreq=length(ph)) { q <- 0.0 pinc <- 0.0 for(n in 1:nfreq) { t1 <- ph[n] d <- q - t1 q <- t1 if(abs(d) > 180.0) { pinc <- pinc + sign(d)*360.0 } ph[n] <- t1+pinc } return(ph) } ################################################################ ## ## demod.dpss ## ## Complex demodulation routine. Takes a series x, and ## demodulates the series around center frequency centreFreq, ## using parameters NW, blockLen, and stepSize. ## ################################################################ demod.dpss <- function(x, centreFreq, nw, blockLen, stepSize=1, wrapphase=TRUE, ...) { stopifnot(stepSize == 1) ## not implemented nwTmp <- match.call(expand.dots = )$NW if(!is.null(nwTmp)) { warning("NW has been depreciated. Please use nw instead.") nw <- nwTmp } ndata <- length(x) deltaT <- deltat(x) dw <- dpss(blockLen, 1, nw)$v U0 <- sum(dw) ampScale <- 2.0/U0 omegaDeltaT <- 2*pi*centreFreq*deltaT jSeq <- (1:blockLen) -1 complexVal <- exp(-1i*omegaDeltaT*jSeq) complexVal <- complexVal*dw*ampScale nResultVals <- ndata - blockLen +1 complexDemod <- complex(nResultVals) for(i in 1:nResultVals) { iSeq <- i:(i+blockLen-1) complexDemod[i] <- crossprod(x[iSeq], complexVal) } phase <- Arg(complexDemod)*180/pi if(wrapphase) { phase <- .sphsed(phase) } phase <- phase - 360*deltaT*centreFreq * (1:nResultVals) list(amplitude=Mod(complexDemod), phase=phase, complexDemod=complexDemod) } multitaper/R/utility.R0000644000176200001440000000417214456126666014513 0ustar liggesusers## The multitaper R package ## Multitaper and spectral analysis package for R ## Copyright (C) 2011 Karim Rahim ## ## Written by Karim Rahim and Wesley Burr. ## ## This file is part of the multitaper package for R. ## http://cran.r-project.org/web/packages/multitaper/index.html ## ## The multitaper package is free software: you can redistribute it and ## or modify it under the terms of the GNU General Public License as ## published by the Free Software Foundation, either version 2 of the ## License, or any later version. ## ## The multitaper package is distributed in the hope that it will be ## useful, but WITHOUT ANY WARRANTY; without even the implied warranty ## of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## GNU General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with multitaper. If not, see . ## ## If you wish to report bugs please contact the author: ## ## Karim Rahim ## karim.rahim@gmail.com ############################################################## ## ## multitaperTrend ## ## Utility routine that computes multitaper-based linear ## trend line. Has improved spectral properties over ## traditional least-squares. Returns intercept and slope. ## ############################################################## multitaperTrend = function(xd, B, deltat, t.in) { N <- length(t.in) w <- B*deltat if(length(xd)!=N) { stop("Time array and data array not the same length!")} if((B <= 0) || (B > 0.5)) { stop("B outside acceptable limits: 0 < B < 0.5.")} ttbar <- t.in - (t.in[N]+t.in[1])/2 k <- floor(2*N*w -1) vt <- (dpss(N,k=k,nw=N*w))$v vk <- colSums(vt) ## solve for a subsel <- seq(1,k,by=2) vk <- colSums(vt)[subsel] xk <- colSums(xd*vt[,subsel]) a <- sum(xk*vk) / sum(vk*vk) ## solve for b subsel <- seq(2,k,by=2) tvk <- colSums(ttbar*vt[,subsel]) xk <- colSums(xd*vt[,subsel]) b <- sum(tvk*xk)/sum(tvk*tvk) return(list(a,b,ttbar)) } multitaper/R/multitaperHelper.R0000644000176200001440000001334514456126666016340 0ustar liggesusers## The multitaper R package ## Multitaper and spectral analysis package for R ## Copyright (C) 2011 Karim Rahim ## ## Written by Karim Rahim and Wesley Burr. ## ## This file is part of the multitaper package for R. ## http://cran.r-project.org/web/packages/multitaper/index.html ## ## The multitaper package is free software: you can redistribute it and ## or modify it under the terms of the GNU General Public License as ## published by the Free Software Foundation, either version 2 of the ## License, or any later version. ## ## The multitaper package is distributed in the hope that it will be ## useful, but WITHOUT ANY WARRANTY; without even the implied warranty ## of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## GNU General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with multitaper. If not, see . ## ## If you wish to report bugs please contact the author: ## ## Karim Rahim ## karim.rahim@gmail.com .mweave <- function (x,dw,swz,ndata,nord,ssqswz,dt_) { out <- .Fortran("mweave", as.double(x), as.double(dw), as.double(swz), as.integer(ndata), as.integer(nord), as.double(ssqswz), cntr=double(1), as.double(dt_), spz=double(1), varc=double(1), PACKAGE='multitaper') return(list(cntr=out$cntr, spz=out$spz, varc=out$varc)) } .HF4mp1 <- function(cft, swz, nord, ssqswz) { ## ###################################### ## The notation and function names were chosen ## to map to original fortran (f77) code. ## Note to obtain: swz <- apply(dw, 2, sum) ## swz is the zeroth frequency Fourier transform of the ## Slepian sequences. It is H_k(0) from P ercival and Walden (1993) ## pages 497--399. ## (just to define dw) dw <- dpssIN$v*sqrt(deltaT) ## Vectorized from original F77 code ## Equation (13.5) of: ## Thomson, D.J. Spectrum Estimation and Harmonic Analysis, ## Proceedings of the IEEE, 1982. cmv <- (cft %*% swz) /ssqswz ssqave <- (Mod(cmv)^2)*ssqswz swz <- as.matrix(swz) ssqres <- apply( Mod(cft - (cmv %*% t(swz)))^2, 1, sum) F_<- (nord-1)*ssqave/ssqres return(list(Ftest=F_,cmv=cmv)) } .mw2wta <- function(sa, nfreq, nord, var, dt_, ev, evp=(1-ev), tol=.03, maxadaptiveiteration=100) { ## this is equation (5.3) and (5.4) form ## Thomson, D.J. Spectrum Estimation and Harmonic Analysis, ## Proceedings of the IEEE, 1982. ## note that the weights are squared, they are |d_k(f)^2 from equation ## (5.4) out <- .Fortran("mw2wta", as.double(sa), wt=matrix(as.double(0), nfreq, nord), as.integer(nfreq), as.integer(nord), s=double(nfreq), as.double(ev), as.double(evp), dofs=double(nfreq), dofav=double(1), as.double(var), as.double(dt_), as.double(tol), as.integer(maxadaptiveiteration), mxiter=integer(1), aviter=double(1), PACKAGE='multitaper') return(list(s=out$s, wt=out$wt, dofs=out$dofs, dofav=out$dofav, mxiter=out$mxiter, aviter=out$aviter)) } .mw2jkw <- function(sa, nfreq, nord, var, dt_, ev, evp=(1-ev), tol=.03, maxadaptiveiteration=100) { nordP2 <- nord+2 out <- .Fortran("mw2jkw", as.double(sa), wt=matrix(as.double(0), nfreq, nord), as.integer(nfreq), as.integer(nord), s=double(nfreq), as.double(ev), as.double(evp), dofs=double(nfreq), dofav=double(1), as.double(var), as.double(dt_), as.double(tol), sjk=double(nordP2), varjk=double(nfreq), bcjk=double(nfreq), matrix(as.double(0), nord, nordP2), double(nordP2), double(nord), as.integer(maxadaptiveiteration), mxiter=integer(1), PACKAGE='multitaper') return(list(s=out$s, wt=out$wt, dofs=out$dofs, dofav=out$dofav, mxiter=out$mxiter, varjk=out$varjk, bcjk=out$bcjk, sjk=out$sjk)) } .qsF <- function(nFreqs,nFFT,k,cft,useAdapt,kadapt) { out <- .Fortran("quickSineF", as.integer(nFreqs), as.integer(nFFT), as.integer(k), cft=cft, as.logical(useAdapt), kadapt=matrix(data=as.double(kadapt),nrow=nFreqs,ncol=1), spec=matrix(data=double(nFreqs),nrow=nFreqs,ncol=1), PACKAGE='multitaper') return(list(spec=out$spec)) } .cF <- function(n,v) { out <- .Fortran("curbF",as.integer(n),as.double(v),PACKAGE='multitaper') opt <- out[[2]] return(list(opt=opt)) } .nF <- function(n,i1,i2,s) { out <- .Fortran("northF",as.integer(n),as.integer(i1), as.integer(i2),sx=matrix(data=as.double(s),nrow=n,ncol=1), ds=double(1), dds=double(1), PACKAGE='multitaper') return(list(ds=out$ds, dds=out$dds)) } .adaptSine <- function(ntimes, k, nFreqs, sx, nFFT, cft, df, fact) { out <- .Fortran("adapt",as.integer(ntimes),as.integer(k), as.integer(nFreqs),sx=matrix(data=as.double(sx),nrow=nFreqs,ncol=1), as.integer(nFFT), cft=cft, as.double(df), kopt=double(nFreqs),fact=as.double(fact),PACKAGE='multitaper') return(list(spec=out$sx,kadapt=out$kopt)) } multitaper/R/plots.R0000644000176200001440000002000314456126666014140 0ustar liggesusers## The multitaper R package ## Multitaper and spectral analysis package for R ## Copyright (C) 2013 Karim Rahim ## ## Written by Karim Rahim and Wesley Burr. ## ## This file is part of the multitaper package for R. ## http://cran.r-project.org/web/packages/multitaper/index.html ## ## The multitaper package is free software: you can redistribute it and ## or modify it under the terms of the GNU General Public License as ## published by the Free Software Foundation, either version 2 of the ## License, or any later version. ## ## The multitaper package is distributed in the hope that it will be ## useful, but WITHOUT ANY WARRANTY; without even the implied warranty ## of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## GNU General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with multitaper. If not, see . ## ## If you wish to report bugs please contact the author: ## ## Karim Rahim ## karim.rahim@gmail.com ################################################################## ## ## plot.mtm ## ## Takes a mtm object, and plots either the associated spectrum ## (obj$spec) or the harmonic F-test statistic (obj$Ftest). ## ################################################################## plot.mtm <- function(x, jackknife=FALSE, Ftest=FALSE, ftbase=1.01, siglines=NULL, ...) { ## Set frequency axis and label dtUnits <- x$mtm$dtUnits deltaT <- x$mtm$deltaT ## if the user has not set 'xlab' ... set it for them: if(!hasArg("xlab")) { if(!(x$mtm$dtUnits == "default")) { xlab <- paste("Frequency in cycles/",dtUnits,sep="") } else { xlab <- paste("Frequency") } } if(Ftest) { if(!hasArg("xlab")) { .plotFtest(x,xlab=xlab,siglines=siglines,ftbase=ftbase, ...) } else { .plotFtest(x, siglines=siglines, ftbase=ftbase, ...) } } else { ## plot spectrum only ## modified to remove calls to plot.spec ## for R version 3.1.0 ## class(x) <- "spec" if(x$mtm$taper=="sine") { if(!hasArg("xlab")) { plot( x, xlab=xlab, sub=" ", ...) } else { plot( x, sub=" ", ...) } } else { ## case of taper=="dpss" nw <- x$mtm$nw k <- x$mtm$k sub <- paste("(NW = ", nw, " K = ", k,")", sep="") log <- match.call(expand.dots = )$log if(jackknife) { dBPlot <- FALSE if(!is.null(log) && log== "dB" ) { dBPlot <- TRUE } if(jackknife && !is.null(x$mtm$jk)) { if(dBPlot) { upperCI <- 10*log10(x$mtm$jk$upperCI) lowerCI <- 10*log10(x$mtm$jk$lowerCI) minVal <- 10*log10(x$mtm$jk$minVal) maxVal <- 10*log10(x$mtm$jk$maxVal) } else { upperCI <- x$mtm$jk$upperCI lowerCI <- x$mtm$jk$lowerCI minVal <- x$mtm$jk$minVal maxVal <- x$mtm$jk$maxVal } yRange <- c(minVal, maxVal) if(!hasArg("xlab")) { .lplotSpec( x, xlab=xlab, sub=sub, ylim=yRange, ...) } else { .lplotSpec( x, sub=sub, ylim=yRange, ...) } lines(x$freq, upperCI, lty=2, col=2) lines(x$freq, lowerCI, lty=2, col=3) } } else { if(!hasArg("xlab")) { .lplotSpec( x, xlab=xlab, sub=sub, ...) } else { .lplotSpec( x, sub=sub, ...) } } } ## end of dpss case } ## spectrum plot end } ## end of function ################################################################## ## ## plot.mtm.coh ## ## Takes a mtm.coh object, and plots the Magnitude-Squared ## Coherence, with multiple y-axes. ## ################################################################## plot.mtm.coh <- function(x, percentGreater=NULL, nehlim=10, nehc=4, cdfQuantilesTicks=NULL, drawPercentLines=TRUE, percentG=c(.1,.2,.5,.8,.9), ...) { if( is.null(x$NTmsc) || is.null(x$NTvar) || is.null(x$msc) || is.null(x$freq) || is.null(x$nfreqs) || is.null(x$k)) { stop("Requires mtm.coh object. Run mtm.coh on two mtm objects with returnInternals=TRUE.") } TRmsc <- x$NTmsc NTvar <- x$NTvar freqs <- x$freq nfreqs <- x$nfreqs k <- x$k ##nehlim and nehc are for smoothing ## currently we plot the smoothed transformed coherence ## and lower CI after smoothing the variance plotTRmsc <- .lftr3p(TRmsc, NTvar, nfreqs, nehlim,nehc, "even", "ext") trnrm_ <- .trnrm(k) par(oma=c(2,4,0,2)) plot.new() ## note the ... was mainly implemented for xaxs="i" ## Undefined behaviour with other options plot.window(range(freqs), range(plotTRmsc[,2]), ...) xy <- xy.coords(freqs,plotTRmsc[,2]) ## plot smoothed msc plot.xy(xy, type="l", lwd=1, ...) ## plot one sd dev lower jackknife variance lines(freqs, plotTRmsc[,1], lty=3, lwd=1) box() axis(1) ## allow for user-settable xlabel, or unit display if(!hasArg("xlab")) { if(!(x$mtm$dtUnits == "default")) { xlab <- paste("Frequency in cycles/",x$mtm$dtUnits,sep="") } else { xlab <- paste("Frequency") } } mtext(xlab, side=1, line=3) ## basic left axis axis(2) mtext("Arctanh Transform of MSC", side=2, line=2, cex=par()$cex) ## outer MSC axis on the left msc <- .FtoMSC(plotTRmsc[,2], trnrm_) mscTicks <- pretty(msc) ## transform ticks for at ##C2toF is coherence to inverse transform TRmscTicks <- .C2toF(mscTicks, trnrm_) axis(2, at=TRmscTicks, labels=mscTicks, outer=TRUE) mtext("Magnitude Squared Coherence", side=2, line=6) ##mscToCDF values may have issues for highly coherent values ## values over .9 will cause issues if(is.null(cdfQuantilesTicks)) { cdfQuantiles <- .mscToCDFquantiles(msc, k) cdfQuantilesTicks <- pretty(cdfQuantiles) } ## put right axis Qlvl <- .cdfToMSqCoh(cdfQuantilesTicks, k) TRQlvl <- .C2toF(Qlvl, trnrm_) cumulativeDistVals <- .C2toF(msc, trnrm_) axis(4, at=TRQlvl, labels=cdfQuantilesTicks) mtext("CDF for Independent Data", side=4, line=2) if(drawPercentLines == TRUE) { percentGprob <- percentG percentG <- .C2toF(.cdfToMSqCoh(percentG, k), trnrm_) lenPercentG <- length(percentG) for(i in 1:lenPercentG) { lines(freqs, array(percentG[i], nfreqs), lty=2) } } if(!is.null(percentGreater)) { mtext(paste("CDF for C= 10.0% 20.0% 50.0% 80.0% 90.0%"), side=1, line=4, adj=-1, cex=.8) mtext(paste("% of data > Q ", 100*round( percentGreater[1], digits=3), "% ", 100*round( percentGreater[2], digits=3), "% ", 100*round( percentGreater[3], digits=3), "% ", 100*round( percentGreater[4], digits=3), "% ", 100*round( percentGreater[5], digits=3), "%", sep=""), side=1, line=5, adj=-1, cex=0.8) } return(list(sigProb = percentGprob, sigNT = percentG)) } multitaper/R/plotsHelper.R0000644000176200001440000002036714456126666015315 0ustar liggesusers## The multitaper R package ## Multitaper and spectral analysis package for R ## Copyright (C) 2013 Karim Rahim ## ## Written by Karim Rahim. ## ## This file is part of the multitaper package for R. ## http://cran.r-project.org/web/packages/multitaper/index.html ## ## The multitaper package is free software: you can redistribute it and ## or modify it under the terms of the GNU General Public License as ## published by the Free Software Foundation, either version 2 of the ## License, or any later version. ## ## The multitaper package is distributed in the hope that it will be ## useful, but WITHOUT ANY WARRANTY; without even the implied warranty ## of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## GNU General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with multitaper. If not, see . ## ## ## If you wish to report bugs please contact the author: ## ## Karim Rahim ## karim.rahim@gmail.com ## siglines degrees of freedom correction Oct 4, 2012 karim ################################################################## ## ## .plotFtest ## ## Takes a mtm object, and plots the harmonic F-test statistic ## (obj$Ftest). ## ################################################################## .plotFtest <- function(x, ftbase=1.01, siglines=NULL, xlab="Frequency", ...) { if(is.null(x$mtm$Ftest) || !("Ftest" %in% class(x))) { stop(paste("Ftest not computed for given mtm object!")) } ## correct notes and warnings with devel R version to upload to cran. ##arglist <- list(...) ##log <- arglist$log ##match.call(expand.dots = )$log ##ylab <- arglist$ylab ##match.call(expand.dots = )$ylab log <- match.call(expand.dots = )$log ylab <- match.call(expand.dots = )$ylab if(is.null(ylab)) ylab <- "Harmonic F-test Statistic" ylog = "n" if(is.null(log) || log == "yes") { ylog = "y" } ftestVals = x$mtm$Ftest ftestVals[ftestVals < ftbase] <- ftbase ftmax <- max(ftestVals) .lplotDefault(x$freq, ftestVals, log=ylog, ylab=ylab, xlab=xlab, ylim=c(ftbase,ftmax), type="l", ...) ## add siglines if defined if(!is.null(siglines)) { for(j in 1:length(siglines)) { if(is.numeric(siglines[j]) && 0.80 <= siglines[j] && 1.000000 >= siglines[j]) { ## degree of freedom correction P&W page 499 changed to 2, 2*k-2 date Sept 30 2012 sig0 <- qf(siglines[j],2,2*x$mtm$k-2) abline(h=sig0, col="red", lty=2, lwd=1) mtext(paste(siglines[j]*100,"%",sep=""), side=4, line=0, at=ceiling(sig0), col="red") } } ## end for } ## end logical } ## this is a hack method to strip depreciated hidden parameters. ## This suggestion is from Gavin Simpson's blog and he traces it ## to a suggestion from Brian Ripley ## see: http://ucfagls.wordpress.com/2011/07/23/ ## local hidden plotting routine to strip depreciated parameter ## dT from arguments lost .lplotSpec <- function(x, ..., dT) { ## should call plot.spec prior to 3.1 dev. plot(x, ...) } ## this is currently used in F--test plots. ## modified Feb 2015 to compile for cran .lplotDefault <- function(x, y, ..., dT) { ## should call plot default plot(x, y, ...) } ## utilities functions added for plot.mtm.coh ## fortran versions exist and could be cleaned up and implemented... ## nhi is nfreqs ## c ## c x Input Data ## c xv Variance estimate of X ## c xp Plotting Array, Returned ## c xp(.,1) mean - 1 standard deviation ## c xp(.,2) smoothed x ## c xp(.,3) mean + 1 standard deviation ## c nehl Number each half for smoothing limits ## -- for smoothing variance ## c nehc Number Each Half for Center ## -- for smoothing data ## c slo Low end symmetry - "even","odd", "extend" ## c shi High end symmetry .lftr3p <- function(x, xv, nhi, nehl, nehc, slo, shi) { ip <- 2 xp <- matrix(NA, nhi, 3) xp[,3] <- .llftr7(xv, nhi, "hi", "even", "extend", nehl, ip) xp[,2] <- .llftr7(x, nhi, "-", slo, shi, nehc, ip) xp[,1] <- xp[,2] - sqrt(xp[,3]) xp[,3] <- xp[,2] + sqrt(xp[,3]) return(xp) } ##modified djt jk ##Programmers note. currently uses jkcoh7 which containes segment averaging ##Segment averaging can be looked into and implemented ##Segment averaging can likely be vectorized or should it be ##implemented in C? ## Dave sets ip=2 in the file ts/lftr3p.f .llftr7 <- function(x,nhi,lohi,slo,shi,neh,ip) { nlo <- 1 y <- array(NA, nhi) z <- array(NA, nhi+2*neh) zNlo <- nlo + neh zNhi <- nhi + neh zHi <- zNhi + neh ## Generate Weights fw <- as.double(neh + 1) wt <- ((1-((-neh:neh)/fw))*(1+((-neh:neh)/fw)))**ip cwt <- sum(wt) wt <- wt/cwt ## Move data to working (z) array, extend ends,default innerSeq <- zNlo:zNhi z[innerSeq] <- x lowerSeq <- 1:neh z[lowerSeq] <- x[1] upperSeq <- (zNhi+1):zHi z[upperSeq] <- x[nhi] ## Low End if(tolower(slo) == "even") { z[rev(lowerSeq)] <- z[(zNlo+1):(zNlo+neh)] } if(tolower(slo) == "odd") { ## not tested... z[rev(lowerSeq)] <- 2.0*z[zNlo] - z[(zNlo+1):(zNlo+neh)] } ## High End ## Programmer's note: The numbers map to numbers on do loops ## in Thomson's fortran code. if(tolower(shi) == "even") { for( j in 1:neh) { ## 850 z[zNhi+j] <- z[zNhi-j] } ## 850 } if(tolower(shi) == "odd") { for( j in 1:neh) { ## 860 z[zNhi + j] = 2.*z[zNhi] - z[zNhi-j] } ## 860 } ## High Limit, supress local Minima if(tolower(lohi) == "hi") { for( n in (nlo+1):(nhi-1) ) { ## 1400 if( (x[n] < x[n-1]) && (x[n] < x[n+1]) ) { zNoff <- n +neh z[zNoff] <- (x[n-1]+x[n+1])/2.0 } } ## 1400 } ## Low Limit, supress local Maxima if(tolower(lohi) == "lo") { for( n in (nlo+1):(nhi-1) ) { if( (x[n] > x[n-1] ) && (x[n] > x[n+1]) ) { zNoff <- n +neh z[n] = (x[n-1]+x[n+1])/2.0 } } ## 1500 } zOffSetSeq <- 1:(2*neh+1) for (n in nlo:nhi) { ## 2000 y[n] <- sum(wt*z[zOffSetSeq]) zOffSetSeq <- zOffSetSeq +1 } ## 2000 return(y) ##checks out on first test } ### functions to convert the coherence to the transformed coherence ## normalizing constant 2k-2 .trnrm <- function(k) sqrt(2*k-2) ## These formulae are based on: ## "Jackknifed error estimates for spectra, coherences, ## and transfer functions" ## by Thomson, DJ and Chave, AD ## Advances in Spectrum Estimation ## ## coherence to quantiles of the CDF .C2toF <- function(xx, trnrm_) { return( trnrm_*log((1.0+sqrt(xx))/(1.0-sqrt(xx)))/2.0 ) } ##quantiles to MSC .FtoMSC <- function(ff, trnrm_) tanh(ff/trnrm_)**2 ## odinlibs nplot function.... ## c ## c Cumulative probability points in 1-2-5 sequence ## c ndata Number data points; output approximately from 1/ndata ## c to 1 - 1/ndata ## c nmax Maximum number of Outputs = Dimension of out,cout,Qnorm ## c nmax approx > 6* log10(ndata) ## c ## c out Cumulative distribution ## c cout Character*8 version of CDF ## c Qnorm Quantiles of Standard Normal at CDF ## c nout Number of output points ## c ## using jkcoh defaults... .paxpt7 <- function(ndata=2000, nmax=40) { ndec <- round(log10(max(11,ndata))); nout = 6*ndec -1; if(nout > nmax) { return(); } n <- 0; out <- array(NA, nout) for(m in seq(-ndec, -1, 1)) { for(k in c(1,2,5)) { n <- n +1; v <- as.double(k*10**m); out[n] <- v; out[nout +1 -n] <- as.double(1.0 - v); } } return(list(out=out, Qnorm=qnorm(out),nout=nout)); } .cdfToMSqCoh <- function(cdf, k) { fnavm <- as.double(k-1); return(1.0 - (1.0 - cdf)**(1.0/fnavm)); } ## used in coherence plot--added May, 2013. .mscToCDFquantiles <- function(msc, k) { 1 - (1-msc)^(k-1) } ## end utilities added mainly for plot.mtm.coh multitaper/R/multitaper.R0000644000176200001440000005427014456126666015202 0ustar liggesusers## The multitaper R package ## Multitaper and spectral analysis package for R ## Copyright (C) 2011 Karim Rahim ## ## Written by Karim Rahim and Wesley S. Burr. ## ## This file is part of the multitaper package for R. ## http://cran.r-project.org/web/packages/multitaper/index.html ## ## The multitaper package is free software: you can redistribute it and ## or modify it under the terms of the GNU General Public License as ## published by the Free Software Foundation, either version 2 of the ## License, or any later version. ## ## The multitaper package is distributed in the hope that it will be ## useful, but WITHOUT ANY WARRANTY; without even the implied warranty ## of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## GNU General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with multitaper. If not, see . ## ## If you wish to report bugs please contact the author: ## ## Karim Rahim ## karim.rahim@gmail.com ## ############################################################## ## ## spec.mtm ## ## Wrapper routine for .spec.mtm.dpss and .spec.mtm.sine. ## ############################################################## spec.mtm <- function(timeSeries, nw=4.0, k=7, nFFT="default", taper=c("dpss"), centre=c("Slepian"), dpssIN=NULL, returnZeroFreq=TRUE, Ftest=FALSE, jackknife=FALSE, jkCIProb=.95, adaptiveWeighting=TRUE, maxAdaptiveIterations=100, plot=TRUE, na.action=na.fail, returnInternals=FALSE, sineAdaptive=FALSE, sineSmoothFact=0.2, dtUnits=c("default"), deltat=NULL, ...) { series <- deparse(substitute(timeSeries)) taper <- match.arg(taper,c("dpss","sine")) centre <- match.arg(centre,c("Slepian","arithMean","trimMean","none")) dtUnits <- match.arg(dtUnits,c("second","hour","day","month","year","default")) ## deal with depreciated parameter dT is changed to deltat ## we strip dT before plotting in plotsHelper.R ## to prevent it getting passed to plot deltaT <- NULL if(!missing(deltat)) { deltaT <- deltat } dT <- match.call(expand.dots = )$dT if(missing(deltat) && !is.null(dT)) { warning("dT has been depreciated. Use either deltat or input a time series object.") deltaT <- dT } if( (taper=="sine") && is.complex(timeSeries)) { stop("Sine tapering not implemented for complex time series.") } if( (taper=="sine") && jackknife) { warning("Cannot jackknife over sine tapers.") jackknife <- FALSE } if( (taper=="sine") && Ftest) { warning("Cannot compute Ftest over sine tapers.") Ftest <- FALSE } if( (taper=="sine") && !returnZeroFreq) { returnZeroFreq = TRUE warning("returnZeroFreq must be TRUE for sine taper option.") } if( (taper=="sine") && sineSmoothFact > 0.5) { warning("Smoothing Factor > 0.5 is very high!") } ## Addtional warnings to make clear that multitaper without adaptive weighting is currently only implemented in this package for real data without jackknife CI. if( adaptiveWeighting==FALSE) { if( jackknife==TRUE) { adaptiveWeighting <- TRUE warning("Jackknife estimates are only implemented with adaptive weighting, and adaptive weighting has been turned on.") } else if ( is.complex(timeSeries) ) { adaptiveWeighting <- TRUE warning("Multitaper estimates for complex time series are only implemented with adaptive weighting, and adaptive weighting has been turned on.") } } dtTmp <- NULL ## warning for deltaT missing: makes all frequency plots incorrect if(!is.ts(timeSeries) && is.null(deltaT)) { warning("Time series is not a ts object and deltat is not set. Frequency array and axes may be incorrect.") } if(!is.ts(timeSeries)) { if(!is.complex(timeSeries)) { timeSeries <- as.double(as.ts(timeSeries)) } } else { ## Order matters here, because as.double breaks the ts() class dtTmp <- deltat(timeSeries) if(!is.complex(timeSeries)) { timeSeries <- as.double(timeSeries) } } ## in responese to delta T bug July 2, 2013 ## modified to remove dT if(is.null(deltaT)) { if(!is.null(dtTmp)) { deltaT <- dtTmp } else{ deltaT <- 1.0 } } n <- length(timeSeries) if(taper=="dpss") { stopifnot(nw >= 0.5, k >= 1, n > 8) ## replace stop if not with warning. ## the following was also in stopif not: ## nw <= 500, k <= 1.5+2*nw) if( nw > 500) { warning("nw > 500") } if( k > 1.5 * 2*nw ) { warning("k > 1.5+2*nw") } if (nw/n > 0.5) { warning("half-bandwidth parameter (w) is greater than 1/2") } if(k==1) { Ftest=FALSE jackknife=FALSE } } else { stopifnot(k <= n, k >= 1, n > 8) } na.action(timeSeries) if(!is.complex(timeSeries)) { sigma2 <- var(timeSeries) * (n-1)/n } else { sigma2 <- var(Re(timeSeries)) * (n-1)/n + var(Im(timeSeries)) * (n-1)/n } if(nFFT == "default") { nFFT <- 2* 2^ceiling(log2(n)) } else { stopifnot(is.numeric(nFFT)) } stopifnot(nFFT >= n) ## convert time-series to zero-mean by one of three methods, if set; default is Slepian if(centre=="Slepian") { if(taper=="dpss") { timeSeries <- centre(timeSeries, nw=nw, k=k, deltaT=deltaT) } else { # edge case: sine taper, set initial k, but too high for default nw=4.0 timeSeries <- centre(timeSeries, nw=5.0, k=8, deltaT=deltaT) } } else if(centre=="arithMean") { timeSeries <- centre(timeSeries, trim=0) } else if(centre=="trimMean") { timeSeries <- centre(timeSeries, trim=0.10) } if(taper=="dpss") { mtm.obj <- .spec.mtm.dpss(timeSeries=timeSeries, nw=nw, k=k, nFFT=nFFT, dpssIN=dpssIN, returnZeroFreq=returnZeroFreq, Ftest=Ftest, jackknife=jackknife, jkCIProb=jkCIProb, adaptiveWeighting = adaptiveWeighting, maxAdaptiveIterations=maxAdaptiveIterations, returnInternals=returnInternals, n=n, deltaT=deltaT, sigma2=sigma2, series=series, dtUnits=dtUnits, ...) } else if(taper=="sine") { mtm.obj <- .spec.mtm.sine(timeSeries=timeSeries, k=k, sineAdaptive=sineAdaptive, nFFT=nFFT, dpssIN=dpssIN, returnZeroFreq=returnZeroFreq, returnInternals=FALSE, n=n, deltaT=deltaT, sigma2=sigma2, series=series,maxAdaptiveIterations=maxAdaptiveIterations, smoothFact=sineSmoothFact, dtUnits=dtUnits, ...) } if(plot) { plot.mtm(mtm.obj, jackknife=jackknife, ...) return(invisible(mtm.obj)) } else { return(mtm.obj) } } ############################################################## ## ## .spec.mtm.dpss ## ## Computes multitaper spectrum using Slepian tapers ## References: ## Percival and Walden "Spectral Analysis ## for Physical Applications" 1993 and associated LISP code ## ## Thomson, D.J. Spectrum Estimation and Harmonic Analysis, ## Proceedings of the IEEE, 1982 and associated Fortran code ## ############################################################## .spec.mtm.dpss <- function(timeSeries, nw, k, nFFT, dpssIN, returnZeroFreq, Ftest, jackknife, jkCIProb, adaptiveWeighting, maxAdaptiveIterations, returnInternals, n, deltaT, sigma2, series, dtUnits, ...) { # Complex check case if(is.complex(timeSeries)) { if(!returnZeroFreq) { returnZeroFreq <- 1 warning("Cannot set returnZeroFreq to 0 for complex time series.") } } dw <- NULL ev <- NULL receivedDW <- TRUE if(!.is.dpss(dpssIN)) { receivedDW <- FALSE dpssIN <- dpss(n, k, nw=nw, returnEigenvalues=TRUE) dw <- dpssIN$v*sqrt(deltaT) ev <- dpssIN$eigen } else { dw <- .dpssV(dpssIN) ev <- .dpssEigen(dpssIN) if(all(is.null(ev))) { ev <- dpssToEigenvalues(dw, nw) } dw <- dw*sqrt(deltaT) } nFreqs <- nFFT %/% 2 + as.numeric(returnZeroFreq) offSet <- if(returnZeroFreq) 0 else 1 # Note that the frequency axis is set by default to unit-less # scaling as 0 through 0.5 cycles/period. The user parameter # dtUnits modifies this scaling in the plot.mtm function. scaleFreq <- 1 / as.double(nFFT * deltaT) swz <- NULL ## Percival and Walden H0 ssqswz <- NULL swz <- apply(dw, 2, sum) if(k >= 2) { swz[seq(2,k,2)] <- 0 } ssqswz <- as.numeric(t(swz)%*%swz) taperedData <- dw * timeSeries nPadLen <- nFFT - n if(!is.complex(timeSeries)) { paddedTaperedData <- rbind(taperedData, matrix(0, nPadLen, k)) } else { paddedTaperedData <- rbind(taperedData, matrix(complex(0,0), nPadLen, k)) } cft <- mvfft(paddedTaperedData) if(!is.complex(timeSeries)) { cft <- cft[(1+offSet):(nFreqs+offSet),] } else { cft <- rbind(cft[(nFreqs+offSet+1):nFFT,],cft[(1+offSet):(nFreqs+offSet),]) } sa <- abs(cft)^2 if(!is.complex(timeSeries)) { resultFreqs <- ((0+offSet):(nFreqs+offSet-1))*scaleFreq } else { resultFreqs <- (-(nFreqs-1):(nFreqs-2))*scaleFreq } adaptive <- NULL jk <- NULL PWdofs <- NULL if(!jackknife) { if(!is.complex(timeSeries)) { adaptive <- .mw2wta(sa, nFreqs, k, sigma2, deltaT, ev) } else { adaptive <- .mw2wta(sa, nFFT, k, sigma2, deltaT, ev) } } else { stopifnot(jkCIProb < 1, jkCIProb > .5) if(!is.complex(timeSeries) & adaptiveWeighting) { adaptive <- .mw2jkw(sa, nFreqs, k, sigma2, deltaT, ev) } else { adaptive <- .mw2jkw(sa, nFFT, k, sigma2, deltaT, ev) } scl <- exp(qt(jkCIProb,adaptive$dofs)* sqrt(adaptive$varjk)) upperCI <- adaptive$s*scl lowerCI <- adaptive$s/scl minVal = min(lowerCI) maxVal = max(upperCI) jk <- list(varjk=adaptive$varjk, bcjk=adaptive$bcjk, sjk=adaptive$sjk, upperCI=upperCI, lowerCI=lowerCI, maxVal=maxVal, minVal=minVal) } ## Short term solution to address bug noted by Lenin Castillo noting that adaptive weights are not properly turned off (Karim 2017). resSpec <- NULL dofVal <- NULL if(!adaptiveWeighting) { resSpec <- apply(sa, 1, mean) dofVal <- 2*k } else { resSpec <- adaptive$s dofVal <- adaptive$dofs } ftestRes <- NULL if(Ftest) { if(is.null(swz)) { swz <- apply(dw, 2, sum) } ftestRes <- .HF4mp1(cft, swz, k, ssqswz) } eigenCoef1 <- NULL wtCoef1 <- NULL if(returnInternals) { eigenCoef1 <- cft if(adaptiveWeighting) { wtCoef1 <- sqrt(adaptive$wt) } } auxiliary <- list(dpss=dpssIN, eigenCoefs=eigenCoef1, eigenCoefWt=wtCoef1, nfreqs=nFreqs, nFFT=nFFT, jk=jk, Ftest=ftestRes$Ftest, cmv=ftestRes$cmv, dofs=dofVal, nw=nw, k=k, deltaT=deltaT, dtUnits=dtUnits, taper="dpss") ## Thomson, D.J. Spectrum Estimation and Harmonic Analysis, ## Proceedings of the IEEE, 1982. ## note that the weights are squared, they are |d_k(f)^2 from equation ## (5.4) ## These weights correspond to Thomoson's 1982 Fortran code. ## dof fix for one taper, only value. if(k==1) { auxiliary$dofs <- 2 } spec.out <- list(origin.n=n, method="Multitaper Spectral Estimate", pad= nFFT - n, spec=resSpec, freq=resultFreqs, series=series, adaptive=adaptiveWeighting, mtm=auxiliary) class(spec.out) <- c("mtm", "spec") if(Ftest) { class(spec.out) <- c("mtm", "Ftest", "spec") } return(spec.out) } ######################################################################### ## ## spec.mtm.sine ## ## Computes multitaper spectrum estimate using sine tapers, as in ## ## Riedel, Kurt S. and Sidorenko, Alexander, Minimum Bias Multiple ## Taper Spectral Estimation. IEEE Transactions on Signal Processing, ## Vol. 43, No. 1, January 1995. ## ## Algorithm implementation based on previous work by: ## German Prieto, Universidad de los Andes ## via \texttt{mtsepc}, a F90 package that can be found at ## http://wwwprof.uniandes.edu.co/~gprieto/software/mwlib.html ## ## and ## ## Robert L. Parker, Scripps Institution of Oceanography ## via \texttt{psd.f}, a F77 program that can be found at ## http://igppweb.ucsd.edu/~parker/Software/Source/psd.f ## ######################################################################### .spec.mtm.sine <- function(timeSeries, nFFT, k, sineAdaptive, dpssIN, returnZeroFreq=TRUE, n, deltaT, dtUnits, sigma2, series=series, maxAdaptiveIterations, smoothFact, ...) { dw <- NULL receivedDW <- TRUE if(!.is.dpss(dpssIN)) { receivedDW <- FALSE dpssIN <- sineTaper(n, k) dw <- dpssIN$v } else { dw <- .dpssV(dpss) } # returnZeroFreq forced to TRUE, offset = 0 # NOTE: sine tapers produce nFFT/4 unique results; need to scale nFFT and nFreqs accordingly nFFT <- nFFT*2 nFreqs <- nFFT %/% 4 + as.numeric(returnZeroFreq) offSet <- if(returnZeroFreq) 0 else 1 scaleFreq <- 1 / as.double(nFFT/2 * deltaT) resultFreqs <- ((0+offSet):(nFreqs+offSet-1))*scaleFreq nPadLen <- nFFT - n df <- 1/as.double(nFFT*deltaT) # compute a single FFT; since we are using sine tapers, this is all we need ones <- matrix(1,n,1) paddedData<- rbind(timeSeries*ones, matrix(0, nPadLen, 1)) cft <- mvfft(paddedData) # constant number of tapers, or adaptive? spec <- as.double(matrix(0,1,nFreqs)) if(!sineAdaptive) { # constant k tapers spec <- (.qsF(nFreqs=nFreqs,nFFT=nFFT,k=k,cft=cft,useAdapt=FALSE,kadapt=c(1)))$spec dofs <- NULL } else { # adaptively weighted tapers initTaper <- ceiling(3.0 + sqrt(smoothFact*n)/5.0); # pilot estimate of S spec0 <- (.qsF(nFreqs=nFreqs,nFFT=nFFT,k=k,cft=cft,useAdapt=FALSE,kadapt=c(1)))$spec out <- .adaptSine (ntimes=maxAdaptiveIterations, k=initTaper, nFreqs=nFreqs, sx=spec0, nFFT=nFFT, cft=cft, df=df, fact=smoothFact) spec <- out$spec; dofs <- out$kadapt; } # end of adaptive logic # normalize spectrum const <- var(timeSeries)/sum(spec)/df specFinal <- const*spec ## set up return object if(sineAdaptive) { method = "Sine-Taper Multitaper Spectrum (adaptive)" } else { method = paste("Sine-Taper Multitaper Spectrum (k=",k,")",sep="") } auxiliary <- list(dpss=dpssIN, eigenCoefs=NULL, eigenCoefWt=NULL, nfreqs=nFreqs, nFFT=nFFT, jk=NULL, Ftest=NULL, cmv=NULL, dofs=dofs, nw=NULL, k=k, deltaT=deltaT, dtUnits=dtUnits, taper="sine") spec.out <- list(origin.n=n, method=method, pad= nFFT - n, spec=specFinal, spec = NULL, freq=resultFreqs, series=series, mtm=auxiliary) class(spec.out) <- c("mtm", "spec") return(spec.out) } ######################################################################### ## ## centre ## ## Takes a time series and converts to zero-mean using one of three ## methods: Slepian projection, arithmetic mean, or trimmed mean. ## ######################################################################### centre <- function(x, nw=NULL, k=NULL, deltaT=NULL, trim=0) { na.fail(x) res <- NULL if(is.null(nw) && is.null(k) ) { res <- x - mean(x, trim=trim) } else { if(trim != 0) { warning(paste("Ignoring trim =", trim)) } stopifnot(nw >= 0.5, k >= 1, nw <= 500, k <= 1.5+2*nw) if (nw/length(x) > 0.5) { stop("half-bandwidth parameter (w) is greater than 1/2") } if(is.null(deltaT)) { if(is.ts(x)) { deltaT <- deltat(ts) } else { warning("deltaT not specified; using deltaT=1.") deltaT <- 1.0 } } n <- length(x) dpssRes <- dpss(n, k=k, nw=nw, returnEigenvalues=TRUE) dw <- dpssRes$v*sqrt(deltaT) ev <- dpssRes$eigen swz <- apply(dw, 2, sum) ## zero swz where theoretically zero; odd tapers if(k >=2) { swz[seq(2,k,2)] <- 0.0 } ssqswz <- sum(swz^2) if(!is.complex(x)) { res <- .mweave(x, dw, swz, n, k, ssqswz, deltaT) res <- x - res$cntr } else { res.r <- .mweave(Re(x), dw, swz, n, k, ssqswz, deltaT) res.i <- .mweave(Im(x), dw, swz, n, k, ssqswz, deltaT) res <- x - complex(real=res.r$cntr, imaginary=res.i$cntr) } } return(res) } ######################################################################### ## ## jackknife coherence and helper smoother and plotting functions ## ## Example: ## jkRes <- jkcoh1(r1$auxiliary$cft, r2$auxiliary$cft, ## 4,2048,4,4096,395) ## pGreater <- percentjkMSCGreaterThan(jkRes$msc, 4) ## plotJkcoh1(r1$freqs, jkRes$TRmsc, jkRes$NTvar, 4, pGreater) ## ######################################################################### mtm.coh <- function(mtm1, mtm2, fr=NULL, tau=0, phcorr = TRUE, plot=TRUE,...) { ## note Dave saves the cft ## in ./odinlibs-1.1/src/mw/mw2pakt as weighted ## 1000 blkcft(n,k,curblk,curset) = ## cft(n*ndecfr,k)*sqrt(wt(n*ndecfr,k)) ## we require auxiliary data if(is.null(mtm1$mtm$eigenCoefs) || is.null(mtm2$mtm$eigenCoefs)) { stop("Both mtm objects must have been computed with returnInternals=TRUE.") } if(mtm1$mtm$k != mtm1$mtm$k) { stop("Both mtm objects must have the same value for k.") } ##k <- mtm1$auxiliary$ if(mtm1$mtm$nfreqs != mtm1$mtm$nfreqs) { stop("Both mtm objects must have the same value for nFFT.") } nord <- mtm1$mtm$k nfreqs <- mtm1$mtm$nfreqs cft1 <- mtm1$mtm$eigenCoefs cft2 <- mtm2$mtm$eigenCoefs fr <- if(is.null(fr)) array(as.double(0), nfreqs) else fr blklof <- if(nfreqs %%2 ==0) 1 else 0 blkhif <- nfreqs -1 + blklof nordP2 <- nord +2 out <- .Fortran("jkcoh1", cft1=as.complex(cft1), cft2=as.complex(cft2), nord=as.integer(nord), blklof=as.integer(blklof), blkhif=as.integer(blkhif), fr=as.double(fr), tau=as.double(tau), phcorr=as.integer(phcorr), NTmsc=double(nfreqs), NTvar=double(nfreqs), msc=double(nfreqs), ph=double(nfreqs), phvar=double(nfreqs), s1=double(nordP2), s2=double(nordP2), jkmsc=double(nordP2), TRmsc=double(nordP2), bias=double(nfreqs), cx=complex(nordP2), PACKAGE="multitaper") auxiliary <- list(nfreqs=mtm1$mtm$nFreqs, nFFT=mtm1$mtm$nFFT, nw=mtm1$mtm$nw, k=mtm1$mtm$k, deltaT=mtm1$mtm$deltaT, dtUnits=mtm1$mtm$dtUnits, taper=mtm1$mtm$taper ) coh.out <- list(NTmsc=out$NTmsc, NTvar=out$NTvar, msc=out$msc, nfreqs=mtm1$mtm$nfreqs, freq=mtm1$freq, k=nord, ph=out$ph, phvar=out$phvar, mtm=auxiliary) class(coh.out) <- "mtm.coh" if(plot) { plot.mtm.coh(coh.out, ...) return(invisible(coh.out)) } else { return(coh.out) } } multitaper/R/dpss.R0000644000176200001440000000733114456126666013761 0ustar liggesusers## The multitaper R package ## Multitaper and spectral analysis package for R ## Copyright (C) 2013 Karim Rahim ## ## Written by Karim Rahim based on Percival and Walden (1993) updated to use ## use LAPACK, makes use of technique found in David Thomson's F77 code for ## reducing the tridiagonal matrix in half. ## ## Small changes made by Wesley Burr. ## ## This file is part of the multitaper package for R. ## http://cran.r-project.org/web/packages/multitaper/index.html ## ## The multitaper package is free software: you can redistribute it and ## or modify it under the terms of the GNU General Public License as ## published by the Free Software Foundation, either version 2 of the ## License, or any later version. ## ## The multitaper package is distributed in the hope that it will be ## useful, but WITHOUT ANY WARRANTY; without even the implied warranty ## of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## GNU General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with multitaper. If not, see . ## ## If you wish to report bugs please contact the author: ## ## Karim Rahim ## karim.rahim@gmail.com ########################################################## ## ## dpss ## ## Generates k orthogonal discrete prolate spheroidal ## sequences (dpss) using the tridiagonal method. See ## Slepian (1978) page 1379 and Percival and Walden ## chapter 8.4 ## ########################################################## dpss <- function(n, k, nw, returnEigenvalues=TRUE) { stopifnot(n >= 1, nw/n >0, nw/n < 0.5, k >= 1) ## if k is passed in as floating point, the cast to ## as.integer() in the Fortran call does not quite work properly if(!is.integer(k)) { k<-as.integer(floor(k)); } ##eigen is of length for use by lapack functoins. ## this will use lapack functions in place of the ## eispack functions referenced in Percival and Waldern out <- .Fortran("fdpss", as.integer(n), as.integer(k), as.double(nw), v=double(n*k), eigen=double(k), PACKAGE='multitaper') out$v <- matrix(data=out$v, nrow=n, ncol=k, byrow=FALSE) if(returnEigenvalues) { out$eigen <- dpssToEigenvalues(out$v, nw) } else { ## eigen values returned from the tridiagonal formulation ## Slepian eqn #13 (1978) out$eigen <- out$eigen } res <- list(v=out$v, eigen=out$eigen) class(res) <- "dpss" return(res) } ########################################################## ## ## dpssToEigenvalues ## ## Given a set of dpss tapers, find the eigenvalues corresponding ## to the generated dpss's ## ## See Percival and Walden (1993) exercise 8.4, and ## associated LISP code. ## ########################################################## dpssToEigenvalues <- function(v, nw) { v <- as.matrix(v) n <- length(v[,1]) k <- length(v[1,]) w <- nw/n npot <- 2**(ceiling(log2(2*n))) ## pad scratch <- rbind(v, matrix(data=0, nrow=npot-n, ncol=k)) ## n * acvs scratch <- Re(mvfft(abs(mvfft(scratch))**2))/npot j <- 1:(n-1) vectorOfRatios <- c(2*w, sin(2*pi*w*j)/(pi*j)) ## Note: both vector of ratios and scratch ## roughy decrease in amplitude with increasing index, ## so sum things up in reverse order eigenvalues <- NULL if(k>1) { eigenvalues <- apply(scratch[n:2,] * vectorOfRatios[n:2], 2, sum) } else { eigenvalues <- sum(scratch[n:2,] * vectorOfRatios[n:2]) } return(2*eigenvalues + vectorOfRatios[1]*scratch[1,1:k]) } multitaper/R/dropFreqs.R0000644000176200001440000000776714456126666014772 0ustar liggesusers## The multitaper R package ## Multitaper and spectral analysis package for R ## Copyright (C) 2011 Karim Rahim ## ## Written by Karim Rahim. ## ## This file is part of the multitaper package for R. ## http://cran.r-project.org/web/packages/multitaper/index.html ## ## The multitaper package is free software: you can redistribute it and ## or modify it under the terms of the GNU General Public License as ## published by the Free Software Foundation, either version 2 of the ## License, or any later version. ## ## The multitaper package is distributed in the hope that it will be ## useful, but WITHOUT ANY WARRANTY; without even the implied warranty ## of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## GNU General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with multitaper. If not, see . ## ## If you wish to report bugs please contact the author: ## ## Karim Rahim ## karim.rahim@gmail.com ################################################################ ## ## dropFreqs.* ## ## Plotting utility functions that allow the user to subselect ## a frequency range of interest, and 'drop' the extraneous ## frequencies. Note that these functions are intended to be ## used only at the end of analysis, as once they have been ## applied to an object, the result is not suitable for ## passing into any further computational routines (such as ## mtm.coh). ## ################################################################ # Handler dropFreqs <- function(spec, minFreq, maxFreq) UseMethod("dropFreqs") # Fall-through case dropFreqs.default <- function(spec, minFreq, maxFreq) { print("This function is only valid for objects of spec, mtm, or mtm.coh classes") spec } # Spectrum object dropFreqs.spec <- function(spec, minFreq, maxFreq) { idx <- (findInterval(spec$freq, c(minFreq,maxFreq)) == 1) if(sum(idx) <= 1) { stop("minFreq and maxFreq must allow for a range of frequencies to be returned") } spec.out <- spec spec.out$freq <- spec$freq[idx] spec.out$spec <- spec$spec[idx] spec.out } # mtm object dropFreqs.mtm <- function(spec, minFreq, maxFreq) { idx <- (findInterval(spec$freq, c(minFreq,maxFreq)) == 1) if(sum(idx) <= 1) { stop("minFreq and maxFreq must allow for a range of frequencies to be returned") } spec.out <- spec spec.out$freq <- spec$freq[idx] spec.out$spec <- spec$spec[idx] ##adjust mtm parameters if(!is.null(spec.out$mtm)) { ## null unnecessary values ## enforces fact that currently function is mainly a ## plotting utility spec.out$mtm$dpss <- NULL spec.out$mtm$eigenCoefs <- NULL spec.out$mtm$eigenCoefsWt <- NULL ## keep values used in plotting spec.out$mtm$Ftest <- spec.out$mtm$Ftest[idx] spec.out$mtm$dofs <- spec.out$mtm$dofs[idx] if(!is.null(spec.out$mtm$jk)) { spec.out$mtm$jk$varjk <- NULL spec.out$mtm$jk$upperCI <- spec.out$mtm$jk$upperCI[idx] spec.out$mtm$jk$maxVal <- max(spec.out$mtm$jk$upperCI) spec.out$mtm$jk$bcjk <- NULL spec.out$mtm$jk$lowerCI <- spec.out$mtm$jk$lowerCI[idx] spec.out$mtm$jk$sjk <- NULL spec.out$mtm$jk$minVal <- min(spec.out$mtm$jk$lowerCI) } } spec.out } # mtm.coh object dropFreqs.mtm.coh <- function(spec, minFreq, maxFreq) { idx <- (findInterval(spec$freq, c(minFreq,maxFreq)) == 1) if(sum(idx) <= 1) { stop("minFreq and maxFreq must allow for a range of frequencies to be returned") } spec.out <- spec spec.out$NTmsc <- spec.out$NTmsc[idx] spec.out$msc <- spec.out$msc[idx] spec.out$NTvar <- spec.out$NTvar[idx] spec.out$freq <- spec.out$freq[idx] spec.out$ph <- spec.out$ph[idx] spec.out$phvar <- spec.out$phvar[idx] spec.out$nfreqs <- sum(idx) spec.out } multitaper/R/sineTaper.R0000644000176200001440000000404114456126666014735 0ustar liggesusers## The multitaper R package ## Multitaper and spectral analysis package for R ## Copyright (C) 2011 Karim Rahim ## ## Written by Wesley Burr. ## ## This file is part of the multitaper package for R. ## http://cran.r-project.org/web/packages/multitaper/index.html ## ## The multitaper package is free software: you can redistribute it and ## or modify it under the terms of the GNU General Public License as ## published by the Free Software Foundation, either version 2 of the ## License, or any later version. ## ## The multitaper package is distributed in the hope that it will be ## useful, but WITHOUT ANY WARRANTY; without even the implied warranty ## of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## GNU General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with multitaper. If not, see . ## ## If you wish to report bugs please contact the author: ## ## Wesley Burr ## wesley.burr@gmail.com #################################################################### ## ## sineTaper ## ## Generates k sine tapers of length n. These are not actually ## used in the \pkg{multitaper} implementation of the sine-tapered ## multiple taper spectrum estimate, but are provided for ## plotting and transfer function purposes. ## ## ref: Kurt S. Riedel and Alexander Sidorenko ## #################################################################### sineTaper <- function(n, k) { stopifnot(n >= 8, k >= 1) coef1 <- as.double(sqrt(2/(n+1))) coef2 <- as.double((pi/(n+1))*seq(1,n,1)) kmat <- matrix(data=as.double(rep(seq(1,n),each=k)),nrow=n,ncol=k) taper <- coef1*sin(coef2*kmat) out <- NULL out$v <- as.matrix(taper) # include k in object since these tapers are not always computed # in context of a mtm object. res <- list(v=out$v, eigen=NULL, k=k) class(res) <- "dpss" return(res) } multitaper/R/dpssHelpers.R0000644000176200001440000000234014456126666015277 0ustar liggesusers## The multitaper R package ## Multitaper and spectral analysis package for R ## Copyright (C) 2011 Karim Rahim ## ## Written by Karim Rahim. ## ## This file is part of the multitaper package for R. ## http://cran.r-project.org/web/packages/multitaper/index.html ## ## The multitaper package is free software: you can redistribute it and ## or modify it under the terms of the GNU General Public License as ## published by the Free Software Foundation, either version 2 of the ## License, or any later version. ## ## The multitaper package is distributed in the hope that it will be ## useful, but WITHOUT ANY WARRANTY; without even the implied warranty ## of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## GNU General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with multitaper. If not, see . ## ## If you wish to report bugs please contact the author: ## ## Karim Rahim ## karim.rahim@gmail.com .dpssV <- function(obj) obj$v .dpssEigen <- function(obj) obj$eigen .is.dpss <- function(obj) { return( sum ( "dpss"==class(obj) ) >= 1 ) } multitaper/MD50000644000176200001440000000413514456220702012755 0ustar liggesusers09c9d69bbe17fdddce63021a60328580 *DESCRIPTION 70631adf61b98492ee8977e7d3f324df *NAMESPACE 158922fb8585ef36eea9f9110348b01a *R/demod.R 4e5cfc149316ec71343447fc411f79d9 *R/dpss.R 1dd775e5821b980099b20cbaa57f5308 *R/dpssHelpers.R bf38c857b5cfaf2f50c878e5a3174583 *R/dropFreqs.R c17594d84b25cd58555c072f7224223e *R/multitaper.R 032caf4929b973edc5b6a6530f44c79a *R/multitaperHelper.R abd53e31c7a1941cbdc92a23f1d3cb46 *R/plots.R 4a0baf7db146f4da832031afda785578 *R/plotsHelper.R 4695a5177397c685dc9b0ff1b155caac *R/sineTaper.R 19607f017d1c697dbdd1a51d5ce85363 *R/utility.R 0ce867df06dafbc04fc5b7c02ca7d5fb *configure.ac c195be9ad469ff1301ebec5c994609d0 *data/CETdaily.rda a778ebe3f5e5494c57710f0897df283d *data/CETmonthly.rda e66a82df7e015af55fc9b62bba559fb3 *data/HadCRUTnh.rda 4e8ee469b70c407411723d8ff43a0ae9 *data/mlco2.rda 3c1cc41d60370a7a43925f50cd1cd49a *data/percivalAR4.rda da3c639de98b93d20a8b9aa9b266d77c *data/willamette.rda e5699a615042b93842e8ec1725b4944c *inst/CITATION 6d0e781380cb71b1d9d8b0ca67d26208 *man/CETdaily.Rd fa173e3264653a2392ed3bb6c78844fa *man/CETmonthly.Rd 01317a99b2003dde5a060608fc4c67b4 *man/HadCRUTnh.Rd 0d8ebb46ee58676aaeed5abebbdfdc92 *man/centre.Rd 17739f0477813693bb73ac45360e15b5 *man/demod.dpss.Rd b92e5255907be60963ea76e2223d0504 *man/dpss.Rd f36f419512253debd725ba41ffb091b5 *man/dpssToEigenvalues.Rd 1c0c22f4c328a51e8624cdd8c4094649 *man/dropFreqs.Rd 76c2ad2a390831e4edffa1269476b5c3 *man/mlco2.Rd 2460db6a7a72850ff31938d63ade6734 *man/mtm.coh.Rd 9cececef332318d4042ed962ea0ce6e5 *man/multitaperTrend.Rd 48e56d4715834cc0985d63d01f2527d1 *man/percivalAR4.Rd 2eff21bd6fcddbbc28c5815838ca32ed *man/plot.mtm.Rd 1948c0ecd9dd72670adbdb6fefcfffd7 *man/plot.mtm.coh.Rd 22c1c068adff4656669ad89d6a982d7c *man/sineTaper.Rd 346ab6aee7513c72be8485aca3391e17 *man/spec.mtm.Rd 73ac2f8237b7b992f6e656241a18b3ec *man/willamette.Rd 51a291f69722dbe9b45b325366729a13 *src/Makevars 970c9aac20d1062533bf7a36ff504bbb *src/Makevars.win 217b2b1158ea546bf8c2f25e110ada85 *src/djt.f 22819b547d53e2461c144f83439486ae *src/dpss.f90 a30077d87916114eb1950ecf1aa8bd1e *src/multitaper_init.c 9ffb669e7bcbcc6275b799e49190d8f1 *src/sine.f multitaper/inst/0000755000176200001440000000000014456126666013435 5ustar liggesusersmultitaper/inst/CITATION0000644000176200001440000000160614456126666014575 0ustar liggesusers##year <- sub("-.*", "", meta$Date) note <- sprintf("R package version %s", meta$Version) bibentry(bibtype = "phdthesis", title = "Applications of Multitaper Spectral Analysis to Nonstationary Data", chapter= "Appendix A: Multitaper R Package", author = "Karim J Rahim and Wesley S Burr and David J Thomson", year = 2014, note = note, pages= "149--183", school = "Queen's University", url = "https://CRAN.R-project.org/package=multitaper", mheader = "To cite 'multitaper' in publications please use:", textVersion = paste('K J Rahim, W S Burr and D J Thomson,', 'Appendix A: Multitaper R Package in \"Applications of Multitaper Spectral', 'Analysis to Nonstationary Data,\" PhD diss., Queen\'s University, 2014,', 'pp. 149-183, http://hdl.handle.net/1974/12584', sep=' '))