waveslim/0000755000176200001440000000000014627612203012104 5ustar liggesuserswaveslim/MD50000644000176200001440000001520614627612203012420 0ustar liggesusersfe1f2dbef02c368754cce5d5961d712f *DESCRIPTION bb6b0bef936515398c182c6d291f0fe7 *LICENSE 9f7ae50c1cbcfd4f6756d8aee79b34e7 *NAMESPACE ee7726906084ed79b7bee4ec34b86bd9 *R/Anton.R 283911ee9f333cf65ddc7e61c334c0f6 *R/bishrink.R 5c85b155f7fe6363c4f78245a63a6770 *R/cascade.R 0f10b0ff5f21e8bdc0c546f49c2f57e3 *R/cov.R 02294dca4467f1867628f602e815ecf3 *R/cplxdual2D.R fbf2a220d8804ed9f772e54cc373104c *R/data.R 450604836496b90e6fac54277ce985f8 *R/denoise.R 325d93fa23d28c48190b71bf68e99f42 *R/dualtree.R e93a9d17ffd0e8a60c9e633e230f4663 *R/dualtree2D.R 6c30f744062cb341512751fed12396d3 *R/dwpt.R 1fa15d6fd37017233dcc5ff6f7490da4 *R/dwpt_boot.R 58eebeb224dafed6d846fc1ac10b6c90 *R/dwpt_sim.R acfa14df92c5f29c453101121b2fa5c9 *R/dwt.R c35d0c26835239546a3c83fe9d15da44 *R/fdp.R 1463f5dcb5b24c2c780e018a99d169c5 *R/hilbert.R 4ff94a4439e47fd92ffcef2142860e8d *R/hosking.R fde260e1122b72c7c151ec93087a26f4 *R/misc.R c4d2ac87dbef7b4e05a68606724175bd *R/mra.2d.R 81071f9703d6a276e5a5611ec3755534 *R/multiple.R 177127af84ba749929e1b7865fbf4cdc *R/periodogram.R 216b7028342061985975ce32c6d75ec7 *R/sdf.R 649c76590bf2a96aa87a3a69d0b6cba7 *R/shift.2d.R e58448d5ddbee89c73910e99f412863d *R/soft.R 66b3fefe1660c9fc019cb1ef73edb62b *R/spp.R bcf8ea160a1211345b3b6edf3c1e26a6 *R/stack.plot.R 7491b430cd3a66b2cf4d1cd55c8242b4 *R/tapers.R 8521226caf16388a981903e6ab6085e6 *R/three_D.R e92c7485647749bdaa10a87f989b4a56 *R/two_D.R b61d68fb1b990c8d852c62167d315e7a *R/up.sample.R 4593ef73d1aaf8221938b56b268f2bce *R/var_2D.R 5c971f3b128c1a10ed4040a3aa6be558 *R/wave.filter.R 94c27f7350b53d8d094105a8611e3215 *R/zzz.R b9d0fd96a7b483c23e6d0871ff31ec1c *README.md 2c54875881427e9e11ca442ceb224a8a *data/acvs.andel10.rda cf92c999586c0d47480d827064ee56da *data/acvs.andel11.rda cac98ed2927a008aa75f1690c880cfaa *data/acvs.andel8.rda 361c8f272577f0cb88e066894279aa19 *data/acvs.andel9.rda 17c0d777ef4e322393f01024171646c5 *data/ar1.rda 5417bed2534cec6a90b30719da7f3e6b *data/barbara.rda c0f344ad3561f3521b65ea3e4de75c66 *data/blocks.rda 5d8c76cb6ed07e8d22474910de9a502c *data/cpi.rda 42c4c8cfb985e54ccec5ee83679fa6c8 *data/dau.rda c6500a86324493afd07d88dedcca7761 *data/doppler.rda 49498cfb4cf627c477962aa90fc797c4 *data/exchange.rda b07432bafcec5fbec44cb66b06692d1d *data/heavisine.rda 9552c7b7bdcfdce5415e3a4b1a4999f0 *data/ibm.rda 18347dc823c55dffb072a2546131f0e5 *data/japan.rda 6434bf77341a56722aefc66fb0231838 *data/jumpsine.rda ff23e9fd80480ad2f97d1334a023690e *data/kobe.rda e52a6e6e9991fca3f2d314c8b679f8a4 *data/linchirp.rda 75bd9f10694c9df903c8ea5d8a374f98 *data/mexm.rda aa52062775ad4602c4dea1d77abdc86d *data/nile.rda a52e43fb8e4f76b59cfc10f00635bb48 *data/tourism.rda 9f7cf7c9f9d56a63566d4e7b5ed61fed *data/unemploy.rda e9ae4281dce09f262cae6364bf4288bb *data/xbox.rda c90a9c65d5af636699d891c6a3a4cccc *man/FSfarras.Rd 372d19d619639df1a9f7a291dfabf261 *man/acvs.andel8.Rd 64ce9d6ca9f6ce4a8ce2ed89a88aa988 *man/afb.Rd 92f3b0d88312846d0011eb6b7c189110 *man/ar1.Rd afe040b22ecbc83374bdf05e43c56589 *man/bandpass.var.spp.Rd 8c2b22b17fb8789516dd731fa361368a *man/barbara.Rd f980f30821dc49642515c5406f1ca3bc *man/basis.Rd fecb98eb98a5824cdf9358aa5a7a969a *man/blocks.Rd ee49357ccc912bdcf847ec775cf8ee70 *man/brick.wall.Rd d4716489ab253c683fb887ee20be2878 *man/convolve2D.Rd 50647c7566f7a9b5786d1d242e92bac4 *man/cpi.Rd 66e7a55d16f41ed1982aa3c21f053de5 *man/cplxdual2D.Rd acec0da58a490e507783da87aac50369 *man/cshift.Rd 53e99e60b0cc3bd000e65d388d98b116 *man/css.test.Rd bbf5a0b12e7bf62fc2ec1c102c79c30a *man/dau.Rd 87f0891028dd72671fe12855274f9fc4 *man/denoise.dwt.2d.Rd 8b4ed5089254138f7c7b34e8b2e3d797 *man/doppler.Rd 2ad11253de07de296abd2ac8383a7a46 *man/dpss.taper.Rd dd7c887e20f24b297dd99003a53d1f1b *man/dualfilt1.Rd de228052753c2979c114937003705d52 *man/dualtree.Rd be637ed39ff4ec888d6bc58e1c31b207 *man/dwpt.2d.Rd ceae199543ea283055417705592a1579 *man/dwpt.Rd 7ede7ba8134d1c9bce87869c186e389e *man/dwpt.boot.Rd 0f23313867de257d22835a7830aa7c1a *man/dwpt.sim.Rd 645b594595f73de991870e959dbd5f1b *man/dwt.2d.Rd c00f28601a52bb5bee792fc34217b763 *man/dwt.3d.Rd 5e18ed5f7ae5558a789fecfdcc856a0a *man/dwt.Rd a01b1df25a26c18082404ff852be4ced *man/dwt.hilbert.Rd b35e02af25989e14dd88b828f37245af *man/exchange.Rd 2342fbc06deeb29d4d4124e0d7c4cda1 *man/fdp.mle.Rd cfff22bce13d3fa7d4455ed9919327bd *man/fdp.sdf.Rd 94bd3e528b1da2e3c4734f13628ba285 *man/find.adaptive.basis.Rd 2fbe7375fbe281d6ee2b06f235697bd3 *man/heavisine.Rd 42fd3ece0b8e08742bbc75993200143d *man/hilbert.filter.Rd bf99610c16bc373ea91db432d6f1713f *man/hosking.sim.Rd 8007f5c396fd59c550a5f1bbff5488b6 *man/ibm.Rd b0c651578c3ab60eadbbfd943c8c61b4 *man/japan.Rd 0e28f9e2269670f3983127800f6fe807 *man/jumpsine.Rd 50bef29259c236239996b73c9ebc1430 *man/kobe.Rd 5b98ae7587554b51baa2e63322389ea3 *man/linchirp.Rd df8e6cc769a944ed9ed2dc2c802dac48 *man/manual.thresh.Rd fb5d58dfc4a914dbed97a51a475504ab *man/mexm.Rd edb34ed9c87dbe5922afbd1aac40c214 *man/modhwt.coh.Rd 0c79f4b0b8165f3860ef95495a4483a4 *man/modwt.2d.Rd d6619b496997a2bc4c3b464fb9a3db2a *man/modwt.3d.Rd 3359fbaca0bf6913468a96235da56589 *man/modwt.Rd a168ce012a9957dfa7fa9ef64d3a084d *man/mra.2d.Rd 0a777b017b47ea96242d9bb1ded03bc7 *man/mra.3d.Rd ff8e2b93530737479187c1510b5ae5b7 *man/mra.Rd a53427468896e144dc5fdccfd40ae8bc *man/mult.loc.Rd d3d4148d0f82de6c063a0b27c9e085b0 *man/my.acf.Rd 4107fe3faf16148486425d972b20ccd1 *man/nile.Rd 2b225174faa0a81ccf7b446e44048ca2 *man/ortho.basis.Rd 7c0cccf8ddc4b308aa236cfdf7cb581d *man/per.Rd e80aa85a88a11f2145d592f49b3a14b3 *man/phase.shift.Rd 4ed4bae4228679bbcfdd24de6c961c53 *man/phase.shift.hilbert.Rd 9308d2453ce97117a0c5589e27de2dad *man/plot.dwt.2d.Rd 85aa7317c1ec08fb433e6356ebd17ac8 *man/qmf.Rd 1324ced7f1db85c447f6d389a5ad7064 *man/rotcumvar.Rd 1cc5e1c1f5f91ec2759a53fa7eb95498 *man/shift.2d.Rd 805b5790779a977d493c61aebddb0afc *man/sine.taper.Rd 12bd723be076131e96b1bfeaa9e849c1 *man/spin.covariance.Rd adf8c0f2560e03267700acc7accfad90 *man/spp.mle.Rd 2bea9311ab45a9d329c01e695d6abd76 *man/spp.var.Rd 421711052b2e3acb6fbf0166ce6b7bfe *man/squared.gain.Rd fe3938a80908182e5a11b03491b66331 *man/stackPlot.Rd 58a3d8f2df8f51d2d842ad4429a1ca90 *man/testing.hov.Rd 25d4ca9c9bc266a3caaf247f35eaca33 *man/tourism.Rd 48b0410d7c610af5b05e71cb36ef6bc3 *man/unemploy.Rd 450d14b5a73c992f6ea187582689d03d *man/up.sample.Rd a91bbdd032fbe0a7d7fe1fa10da320b0 *man/wave.filter.Rd 8e9779e3fe599a459aa33bdf9292c232 *man/wave.variance.2d.Rd ed105bf6f76e8204ac14fd11821297a7 *man/wave.variance.Rd e474488f7c496d53f39a9708e74e34e3 *man/wavelet.filter.Rd ec2b2c9468733ead7f8da6fd56457b8e *man/xbox.Rd 75647cbbd90f9f58c174cb3371289f83 *src/dwt.c 479a078c21ee6b5d1a624462afbef1d6 *src/dwt.h 3934bf3e81393ad972a51d193b262b5b *src/dwt2.c 2822bf88a86280390e5110cb584e1ccf *src/dwt3.c ef0296f98c4e377ee91ec48de1544acc *src/hosking.c ec9ccc64eb83c57c0000fdb5b952422e *src/init.c waveslim/R/0000755000176200001440000000000014627073455012317 5ustar liggesuserswaveslim/R/two_D.R0000644000176200001440000005730314627073455013526 0ustar liggesusers#' Two-Dimensional Discrete Wavelet Transform #' #' Performs a separable two-dimensional discrete wavelet transform (DWT) on a #' matrix of dyadic dimensions. #' #' See references. #' #' @usage dwt.2d(x, wf, J = 4, boundary = "periodic") #' @usage idwt.2d(y) #' @aliases dwt.2d idwt.2d #' @param x input matrix (image) #' @param wf name of the wavelet filter to use in the decomposition #' @param J depth of the decomposition, must be a number less than or equal to #' log(minM,N,2) #' @param boundary only \code{"periodic"} is currently implemented #' @param y an object of class \code{dwt.2d} #' @return List structure containing the \eqn{3J+1} sub-matrices from the #' decomposition. #' @author B. Whitcher #' @seealso \code{\link{modwt.2d}}. #' @references Mallat, S. (1998) \emph{A Wavelet Tour of Signal Processing}, #' Academic Press. #' #' Vetterli, M. and J. Kovacevic (1995) \emph{Wavelets and Subband Coding}, #' Prentice Hall. #' @keywords ts #' @examples #' #' ## Xbox image #' data(xbox) #' xbox.dwt <- dwt.2d(xbox, "haar", 3) #' par(mfrow=c(1,1), pty="s") #' plot.dwt.2d(xbox.dwt) #' par(mfrow=c(2,2), pty="s") #' image(1:dim(xbox)[1], 1:dim(xbox)[2], xbox, xlab="", ylab="", #' main="Original Image") #' image(1:dim(xbox)[1], 1:dim(xbox)[2], idwt.2d(xbox.dwt), xlab="", ylab="", #' main="Wavelet Reconstruction") #' image(1:dim(xbox)[1], 1:dim(xbox)[2], xbox - idwt.2d(xbox.dwt), #' xlab="", ylab="", main="Difference") #' #' ## Daubechies image #' data(dau) #' par(mfrow=c(1,1), pty="s") #' image(dau, col=rainbow(128)) #' sum(dau^2) #' dau.dwt <- dwt.2d(dau, "d4", 3) #' plot.dwt.2d(dau.dwt) #' sum(plot.dwt.2d(dau.dwt, plot=FALSE)^2) #' #' @export dwt.2d dwt.2d <- function(x, wf, J=4, boundary="periodic") { m <- dim(x)[1] storage.mode(m) <- "integer" n <- dim(x)[2] storage.mode(n) <- "integer" dict <- wave.filter(wf) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf storage.mode(h) <- "double" g <- dict$lpf storage.mode(g) <- "double" z <- matrix(0, m/2, n/2) storage.mode(z) <- "double" x.wt <- vector("list", 3*J+1) x.names <- NULL for(j in 1:J) { out <- .C(C_two_D_dwt, "Image"=as.double(x), "Rows"=m, "Cols"=n, "filter.length"=L, "hpf"=h, "lpf"=g, "LL"=z, "LH"=z, "HL"=z, "HH"=z)[7:10] if(j < J) { index <- (3*j-2):(3*j) x.wt[index] <- out[-1] x.names <- c(x.names, sapply(names(out)[-1], paste, j, sep="")) x <- out[[1]] m <- dim(x)[1] storage.mode(m) <- "integer" n <- dim(x)[2] storage.mode(n) <- "integer" z <- matrix(0, m/2, n/2) storage.mode(z) <- "double" } else { index <- (3*j):(3*(j+1)) - 2 x.wt[index] <- out[c(2:4,1)] x.names <- c(x.names, sapply(names(out)[c(2:4,1)], paste, j, sep="")) } } names(x.wt) <- x.names attr(x.wt, "J") <- J attr(x.wt, "wavelet") <- wf attr(x.wt, "boundary") <- boundary attr(x.wt, "class") <- "dwt.2d" x.wt } idwt.2d <- function(y) { J <- attributes(y)$J dict <- wave.filter(attributes(y)$wavelet) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf storage.mode(h) <- "double" g <- dict$lpf storage.mode(g) <- "double" LL <- paste("LL", J, sep="") y.in <- y[[LL]] for(j in J:1) { LH <- paste("LH", j, sep="") HL <- paste("HL", j, sep="") HH <- paste("HH", j, sep="") m <- dim(y.in)[1] storage.mode(m) <- "integer" n <- dim(y.in)[2] storage.mode(n) <- "integer" x <- matrix(0, 2*m, 2*n) storage.mode(x) <- "double" out <- .C(C_two_D_idwt, as.double(y.in), as.double(y[[LH]]), as.double(y[[HL]]), as.double(y[[HH]]), m, n, L, h, g, "Y"=x) y.in <- out$Y } zapsmall(y.in) } #' Two-Dimensional Maximal Overlap Discrete Wavelet Transform #' #' Performs a separable two-dimensional maximal overlap discrete wavelet #' transform (MODWT) on a matrix of arbitrary dimensions. #' #' See references. #' #' @usage modwt.2d(x, wf, J = 4, boundary = "periodic") #' @usage imodwt.2d(y) #' @aliases modwt.2d imodwt.2d #' @param x input matrix #' @param wf name of the wavelet filter to use in the decomposition #' @param J depth of the decomposition #' @param boundary only \code{"periodic"} is currently implemented #' @param y an object of class \code{dwt.2d} #' @return List structure containing the \eqn{3J+1} sub-matrices from the #' decomposition. #' @author B. Whitcher #' @seealso \code{\link{dwt.2d}}, \code{\link{shift.2d}}. #' @references Liang, J. and T. W. Parks (1994) A two-dimensional translation #' invariant wavelet representation and its applications, \emph{Proceedings #' ICIP-94}, Vol. 1, 66-70. #' #' Liang, J. and T. W. Parks (1994) Image coding using translation invariant #' wavelet transforms with symmetric extensions, \emph{IEEE Transactions on #' Image Processing}, \bold{7}, No. 5, 762-769. #' @keywords ts #' @examples #' #' ## Xbox image #' data(xbox) #' xbox.modwt <- modwt.2d(xbox, "haar", 2) #' ## Level 1 decomposition #' par(mfrow=c(2,2), pty="s") #' image(xbox.modwt$LH1, col=rainbow(128), axes=FALSE, main="LH1") #' image(xbox.modwt$HH1, col=rainbow(128), axes=FALSE, main="HH1") #' frame() #' image(xbox.modwt$HL1, col=rainbow(128), axes=FALSE, main="HL1") #' ## Level 2 decomposition #' par(mfrow=c(2,2), pty="s") #' image(xbox.modwt$LH2, col=rainbow(128), axes=FALSE, main="LH2") #' image(xbox.modwt$HH2, col=rainbow(128), axes=FALSE, main="HH2") #' image(xbox.modwt$LL2, col=rainbow(128), axes=FALSE, main="LL2") #' image(xbox.modwt$HL2, col=rainbow(128), axes=FALSE, main="HL2") #' sum((xbox - imodwt.2d(xbox.modwt))^2) #' #' data(dau) #' par(mfrow=c(1,1), pty="s") #' image(dau, col=rainbow(128), axes=FALSE, main="Ingrid Daubechies") #' sum(dau^2) #' dau.modwt <- modwt.2d(dau, "d4", 2) #' ## Level 1 decomposition #' par(mfrow=c(2,2), pty="s") #' image(dau.modwt$LH1, col=rainbow(128), axes=FALSE, main="LH1") #' image(dau.modwt$HH1, col=rainbow(128), axes=FALSE, main="HH1") #' frame() #' image(dau.modwt$HL1, col=rainbow(128), axes=FALSE, main="HL1") #' ## Level 2 decomposition #' par(mfrow=c(2,2), pty="s") #' image(dau.modwt$LH2, col=rainbow(128), axes=FALSE, main="LH2") #' image(dau.modwt$HH2, col=rainbow(128), axes=FALSE, main="HH2") #' image(dau.modwt$LL2, col=rainbow(128), axes=FALSE, main="LL2") #' image(dau.modwt$HL2, col=rainbow(128), axes=FALSE, main="HL2") #' sum((dau - imodwt.2d(dau.modwt))^2) #' #' @export modwt.2d modwt.2d <- function(x, wf, J=4, boundary="periodic") { m <- dim(x)[1] storage.mode(m) <- "integer" n <- dim(x)[2] storage.mode(n) <- "integer" dict <- wave.filter(wf) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf / sqrt(2) storage.mode(h) <- "double" g <- dict$lpf / sqrt(2) storage.mode(g) <- "double" z <- matrix(0, m, n) storage.mode(z) <- "double" x.wt <- vector("list", 3*J+1) x.names <- NULL for(j in 1:J) { out <- .C("two_D_modwt", "Image"=as.double(x), "Rows"=m, "Cols"=n, "Level"=j, "filter.length"=L, "hpf"=h, "lpf"=g, "LL"=z, "LH"=z, "HL"=z, "HH"=z, PACKAGE="waveslim")[8:11] if(j < J) { index <- (3*j-2):(3*j) x.wt[index] <- out[-1] x.names <- c(x.names, sapply(names(out)[-1], paste, j, sep="")) x <- out$LL } else { index <- (3*j):(3*(j+1)) - 2 x.wt[index] <- out[c(2:4,1)] x.names <- c(x.names, sapply(names(out)[c(2:4,1)], paste, j, sep="")) } } names(x.wt) <- x.names attr(x.wt, "J") <- J attr(x.wt, "wavelet") <- wf attr(x.wt, "boundary") <- boundary x.wt } imodwt.2d <- function(y) { J <- attributes(y)$J dict <- wave.filter(attributes(y)$wavelet) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf / sqrt(2) storage.mode(h) <- "double" g <- dict$lpf / sqrt(2) storage.mode(g) <- "double" LL <- paste("LL", J, sep="") y.in <- y[[LL]] for(j in J:1) { LH <- paste("LH", j, sep="") HL <- paste("HL", j, sep="") HH <- paste("HH", j, sep="") m <- dim(y.in)[1] storage.mode(m) <- "integer" n <- dim(y.in)[2] storage.mode(n) <- "integer" x <- matrix(0, m, n) storage.mode(x) <- "double" out <- .C(C_two_D_imodwt, as.double(y.in), as.double(y[[LH]]), as.double(y[[HL]]), as.double(y[[HH]]), m, n, j, L, h, g, "Y"=x) y.in <- out$Y } zapsmall(y.in) } #' Plot Two-dimensional Discrete Wavelet Transform #' #' Organizes the wavelet coefficients from a 2D DWT into a single matrix and #' plots it. The coarser resolutions are nested within the lower-lefthand #' corner of the image. #' #' The wavelet coefficients from the DWT object (a list) are reorganized into a #' single matrix of the same dimension as the original image and the result is #' plotted. #' #' @param x input matrix (image) #' @param cex.axis \code{par} plotting parameter that controls the size of the #' axis text #' @param plot if \code{plot = FALSE} then the matrix of wavelet coefficients #' is returned, the default is \code{plot = TRUE} #' @param ... additional graphical parameters if necessary #' @return Image plot. #' @author B. Whitcher #' @seealso \code{\link{dwt.2d}}. #' @keywords ts #' @export plot.dwt.2d plot.dwt.2d <- function(x, cex.axis=1, plot=TRUE, ...) { J <- attributes(x)$J X <- x[[paste("LL", J, sep="")]] for(j in J:1) { x.names <- sapply(c("LH","HL","HH"), paste, j, sep="") X <- rbind(cbind(X, x[[x.names[2]]]), cbind(x[[x.names[1]]], x[[x.names[3]]])) } M <- dim(X)[1]; N <- dim(X)[2] if(plot) { image(1:M, 1:N, X, col=rainbow(128), axes=FALSE, xlab="", ylab="", ...) x.label <- NULL lines(c(0,N,N,0,0) + 0.5, c(0,0,M,M,0) + 0.5) for(j in J:1) { lines(c(M/2^j,M/2^j) + 0.5, 2*c(0,N/2^j) + 0.5) lines(2*c(0,M/2^j) + 0.5, c(N/2^j,N/2^j) + 0.5) } at <- c((3*N+2)/2^(1:J+1),(N+2)/2^(J+1)) labs <- c(paste("H",1:J,sep=""), paste("L",J,sep="")) axis(side=1, at=at, labels=labs, tick=FALSE, cex.axis=cex.axis) axis(side=2, at=at, labels=labs, tick=FALSE, cex.axis=cex.axis) } else return(X) invisible() } #' Denoise an Image via the 2D Discrete Wavelet Transform #' #' Perform simple de-noising of an image using the two-dimensional discrete #' wavelet transform. #' #' See \code{\link{Thresholding}}. #' #' @aliases denoise.dwt.2d denoise.modwt.2d #' @param x input matrix (image) #' @param wf name of the wavelet filter to use in the decomposition #' @param J depth of the decomposition, must be a number less than or equal to #' log(minM,N,2) #' @param method character string describing the threshold applied, only #' \code{"universal"} and \code{"long-memory"} are currently implemented #' @param H self-similarity or Hurst parameter to indicate spectral scaling, #' white noise is 0.5 #' @param noise.dir number of directions to estimate background noise standard #' deviation, the default is 3 which produces a unique estimate of the #' background noise for each spatial direction #' @param rule either a \code{"hard"} or \code{"soft"} thresholding rule may be #' used #' @return Image of the same dimension as the original but with high-freqency #' fluctuations removed. #' @author B. Whitcher #' @seealso \code{\link{Thresholding}} #' @references See \code{\link{Thresholding}} for references concerning #' de-noising in one dimension. #' @keywords ts #' @examples #' #' ## Xbox image #' data(xbox) #' n <- nrow(xbox) #' xbox.noise <- xbox + matrix(rnorm(n*n, sd=.15), n, n) #' par(mfrow=c(2,2), cex=.8, pty="s") #' image(xbox.noise, col=rainbow(128), main="Original Image") #' image(denoise.dwt.2d(xbox.noise, wf="haar"), col=rainbow(128), #' zlim=range(xbox.noise), main="Denoised image") #' image(xbox.noise - denoise.dwt.2d(xbox.noise, wf="haar"), col=rainbow(128), #' zlim=range(xbox.noise), main="Residual image") #' #' ## Daubechies image #' data(dau) #' n <- nrow(dau) #' dau.noise <- dau + matrix(rnorm(n*n, sd=10), n, n) #' par(mfrow=c(2,2), cex=.8, pty="s") #' image(dau.noise, col=rainbow(128), main="Original Image") #' dau.denoise <- denoise.modwt.2d(dau.noise, wf="d4", rule="soft") #' image(dau.denoise, col=rainbow(128), zlim=range(dau.noise), #' main="Denoised image") #' image(dau.noise - dau.denoise, col=rainbow(128), main="Residual image") #' denoise.dwt.2d <- function(x, wf = "la8", J = 4, method = "universal", H = 0.5, noise.dir = 3, rule = "hard") { soft <- function(x, delta) sign(x) * pmax(abs(x) - delta, 0) hard <- function(x, delta) ifelse(abs(x) > delta, x, 0) n <- length(x) x.dwt <- dwt.2d(x, wf, J) if(noise.dir == 3) sigma.mad <- list(HH = mad(x.dwt$HH1), HL = mad(x.dwt$HL1), LH = mad(x.dwt$LH1)) else { noise <- x.dwt$jj sigma.mad <- list(HH = mad(noise), HL = mad(noise), LH = mad(noise)) } thresh <- list(HH = rep(sqrt(2 * sigma.mad$HH^2 * log(n)), J), HL = rep(sqrt(2 * sigma.mad$HL^2 * log(n)), J), LH = rep(sqrt(2 * sigma.mad$LH^2 * log(n)), J)) if(method == "long-memory") thresh <- lapply(thresh, function(x,J,H) 2^(0:(J-1)*(H-1/2))*x, J=J, H=H) for(j in 1:J) { jj <- paste("HL", j, sep = "") if(rule == "hard") x.dwt[[jj]] <- hard(x.dwt[[jj]], thresh$HL[j]) else x.dwt[[jj]] <- soft(x.dwt[[jj]], thresh$HL[j]) jj <- paste("LH", j, sep = "") if(rule == "hard") x.dwt[[jj]] <- hard(x.dwt[[jj]], thresh$LH[j]) else x.dwt[[jj]] <- soft(x.dwt[[jj]], thresh$LH[j]) jj <- paste("HH", j, sep = "") if(rule == "hard") x.dwt[[jj]] <- hard(x.dwt[[jj]], thresh$HH[j]) else x.dwt[[jj]] <- soft(x.dwt[[jj]], thresh$HH[j]) } idwt.2d(x.dwt) } denoise.modwt.2d <- function(x, wf = "la8", J = 4, method = "universal", H = 0.5, rule = "hard") { soft <- function(x, delta) sign(x) * pmax(abs(x) - delta, 0) hard <- function(x, delta) ifelse(abs(x) > delta, x, 0) n <- length(x) x.modwt <- modwt.2d(x, wf, J) sigma.mad <- list(HH = sqrt(2) * mad(x.modwt$HH1), HL = sqrt(2) * mad(x.modwt$HL1), LH = sqrt(2) * mad(x.modwt$LH1)) thresh <- list(HH = rep(sqrt(2 * sigma.mad$HH^2 * log(n))/2^(1:J), J), HL = rep(sqrt(2 * sigma.mad$HL^2 * log(n))/2^(1:J), J), LH = rep(sqrt(2 * sigma.mad$LH^2 * log(n))/2^(1:J), J)) if(method == "long-memory") thresh <- lapply(thresh, function(x,J,H) 2^(0:(J-1)*(H-1/2))*x, J=J, H=H) for(j in 1:J) { jj <- paste("HL", j, sep = "") if(rule == "hard") x.modwt[[jj]] <- hard(x.modwt[[jj]], thresh$HL[j]) else x.modwt[[jj]] <- soft(x.modwt[[jj]], thresh$HL[j]) jj <- paste("LH", j, sep = "") if(rule == "hard") x.modwt[[jj]] <- hard(x.modwt[[jj]], thresh$LH[j]) else x.modwt[[jj]] <- soft(x.modwt[[jj]], thresh$LH[j]) jj <- paste("HH", j, sep = "") if(rule == "hard") x.modwt[[jj]] <- hard(x.modwt[[jj]], thresh$HH[j]) else x.modwt[[jj]] <- soft(x.modwt[[jj]], thresh$HH[j]) } imodwt.2d(x.modwt) } #' (Inverse) Discrete Wavelet Packet Transforms in Two Dimensions #' #' All possible filtering combinations (low- and high-pass) are performed to #' decompose a matrix or image. The resulting coefficients are associated with #' a quad-tree structure corresponding to a partitioning of the two-dimensional #' frequency plane. #' #' The code implements the two-dimensional DWPT using the pyramid algorithm of #' Mallat (1989). #' #' @usage dwpt.2d(x, wf = "la8", J = 4, boundary = "periodic") #' @usage idwpt.2d(y, y.basis) #' @aliases dwpt.2d idwpt.2d #' @param x a matrix or image containing the data be to decomposed. This #' ojbect must be dyadic (power of 2) in length in each dimension. #' @param wf Name of the wavelet filter to use in the decomposition. By #' default this is set to \code{"la8"}, the Daubechies orthonormal compactly #' supported wavelet of length \eqn{L=8} (Daubechies, 1992), least asymmetric #' family. #' @param J Specifies the depth of the decomposition. This must be a number #' less than or equal to \eqn{\log(\mbox{length}(x),2)}. #' @param boundary Character string specifying the boundary condition. If #' \code{boundary=="periodic"} the default, then the vector you decompose is #' assumed to be periodic on its defined interval,\cr if #' \code{boundary=="reflection"}, the vector beyond its boundaries is assumed #' to be a symmetric reflection of itself. #' @param y \code{dwpt.2d} object (list-based structure of matrices) #' @param y.basis Boolean vector, the same length as \eqn{y}, where \code{TRUE} #' means the basis tensor should be used in the reconstruction. #' @return Basically, a list with the following components #' \item{w?.?-w?.?}{Wavelet coefficient matrices (images). The first index is #' associated with the scale of the decomposition while the second is #' associated with the frequency partition within that level. The left and #' right strings, separated by the dash `-', correspond to the first \eqn{(x)} #' and second \eqn{(y)} dimensions.} \item{wavelet}{Name of the wavelet filter #' used.} \item{boundary}{How the boundaries were handled.} #' @author B. Whitcher #' @seealso \code{\link{dwt.2d}}, \code{\link{modwt.2d}}, #' \code{\link{wave.filter}}. #' @references Mallat, S. G. (1989) A theory for multiresolution signal #' decomposition: the wavelet representation, \emph{IEEE Transactions on #' Pattern Analysis and Machine Intelligence}, \bold{11}, No. 7, 674-693. #' #' Wickerhauser, M. V. (1994) \emph{Adapted Wavelet Analysis from Theory to #' Software}, A K Peters. #' @keywords ts #' @export dwpt.2d dwpt.2d <- function(x, wf="la8", J=4, boundary="periodic") { ## x <- xbox ## Define image dimensions (assign mode for C) and perform simple ## diagnostics. m <- dim(x)[1] storage.mode(m) <- "integer" n <- dim(x)[2] storage.mode(n) <- "integer" if(log(m, 2) != trunc(log(m, 2)) | log(n, 2) != trunc(log(n, 2))) stop("One dimension is not a power of 2") if(2^J > m | 2^J > n) stop("Wavelet transform exceeds sample size in one dimension of DWPT") ## Extract wavelet and scaling filter coefficients, along with filter ## length, from the filter name provided. dict <- wave.filter(wf) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf storage.mode(h) <- "double" g <- dict$lpf storage.mode(g) <- "double" ## Create names for wavelet packet nodes (quad-tree structure). N <- sum(4^(1:J)) level <- rep(1:J, 4^(1:J)) x.wpt <- vector("list", N) c1 <- rep(1:J, 2^(1:J)) c2 <- unlist(apply(as.matrix(2^(1:J) - 1), 1, seq, from=0)) cry <- paste("w", c1, ".", c2, sep="") x.wpt.names <- NULL for(j in 1:J) { xx <- matrix(cry[c1 == j], 2^j, 2^j) yy <- matrix(cry[c1 == j], 2^j, 2^j, byrow=TRUE) x.wpt.names <- c(x.wpt.names, as.matrix(paste(xx, "-", yy, sep=""))) } names(x.wpt) <- x.wpt.names rm(j,xx,yy,c1,c2,cry) ## Define initial zero matrix to store wavelet sub-images. z <- matrix(0, m/2, n/2) storage.mode(z) <- "double" ## Implement the 2D DWPT in a nested loop structure. for(j in 1:J) { ## cat("j =", j, fill=TRUE) for(k in 0:(4^j/4-1)) { if(j > 1) { ## if j > 1, grab wavelet coefficient image and also its name. index <- min((1:N)[level == j-1]) + k parent <- x.wpt.names[index] ## cat("parent =", parent, fill=TRUE) x <- x.wpt[[parent]] tmp <- unlist(strsplit(parent, "\\-")) } else tmp <- c("w0.0", "w0.0") ## Deconstruct name into nodes for the x and y dimensions. node <- unlist(strsplit(tmp, "\\.")) node <- as.integer(node[-c(1,3)]) ## Preliminary assignments in order to keep wavelet coefficient ## sub-images in sequency order. if(node[1] %% 2 == 0) { Xlow <- paste("w", j, ".", 2 * node[1], sep="") Xhigh <- paste("w", j, ".", 2 * node[1] + 1, sep="") } else { Xlow <- paste("w", j, ".", 2 * node[1] + 1, sep="") Xhigh <- paste("w", j, ".", 2 * node[1], sep="") } if(node[2] %% 2 == 0) { Ylow <- paste("w", j, ".", 2 * node[2], sep="") Yhigh <- paste("w", j, ".", 2 * node[2] + 1, sep="") } else { Ylow <- paste("w", j, ".", 2 * node[2] + 1, sep="") Yhigh <- paste("w", j, ".", 2 * node[2], sep="") } ## Create names for the new wavelet coefficient images. LL <- paste(Xlow, "-", Ylow, sep="") LH <- paste(Xlow, "-", Yhigh, sep="") HL <- paste(Xhigh, "-", Ylow, sep="") HH <- paste(Xhigh, "-", Yhigh, sep="") ## cat(matrix(c(LH,LL,HH,HL), 2, 2), fill=TRUE) ## Perform the DWPT out <- .C(C_two_D_dwt, "Image"=as.double(x), "Rows"=m, "Cols"=n, "filter.length"=L, "hpf"=h, "lpf"=g, "LL"=z, "LH"=z, "HL"=z, "HH"=z)[7:10] ## Pass wavelet coefficient images into the DWPT object. x.wpt[[LL]] <- out[["LL"]] x.wpt[[LH]] <- out[["LH"]] x.wpt[[HL]] <- out[["HL"]] x.wpt[[HH]] <- out[["HH"]] } ## Redefine zero matrix to its new (decimated) size. m <- dim(out[["LL"]])[1] storage.mode(m) <- "integer" n <- dim(out[["LL"]])[2] storage.mode(n) <- "integer" z <- matrix(0, m/2, n/2) storage.mode(z) <- "double" } attr(x.wpt, "J") <- J attr(x.wpt, "wavelet") <- wf attr(x.wpt, "boundary") <- boundary return(x.wpt) } idwpt.2d <- function(y, y.basis) { ## Error checking if(length(y) != length(y.basis)) stop("DWPT object and basis selection must be the same length") ## Number of wavelet scales J <- attributes(y)$J ## Define wavelet/scaling filter coefficients and length dict <- wave.filter(attributes(y)$wavelet) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf storage.mode(h) <- "double" g <- dict$lpf storage.mode(g) <- "double" ## Nested for loops names(y.basis) <- names(y) for(j in J:1) { for(nx in seq(0, 2^j - 1, by = 2)) { for(ny in seq(0, 2^j - 1, by = 2)) { ## Name the four wavelet coefficients sub-images LL <- paste("w", j, ".", nx, "-", "w", j, ".", ny, sep="") LH <- paste("w", j, ".", nx, "-", "w", j, ".", ny+1, sep="") HL <- paste("w", j, ".", nx+1, "-", "w", j, ".", ny, sep="") HH <- paste("w", j, ".", nx+1, "-", "w", j, ".", ny+1, sep="") if(any(y.basis[LL], y.basis[LH], y.basis[HL], y.basis[HH])) { m <- nrow(y[[LL]]) storage.mode(m) <- "integer" n <- ncol(y[[LL]]) storage.mode(n) <- "integer" XX <- matrix(0, 2*m, 2*n) storage.mode(XX) <- "double" ## parent indices to construct string pnx <- floor(nx / 2) pny <- floor(ny / 2) if((pnx %% 2 != 0) & (pny %% 2 != 0)) ## Upper right-hand corner out <- .C(C_two_D_idwt, as.double(y[[HH]]), as.double(y[[HL]]), as.double(y[[LH]]), as.double(y[[LL]]), m, n, L, h, g, "Y"=XX)$Y else { ## Upper left-hand corner if((pnx %% 2 == 0) & (pny %% 2 != 0)) out <- .C(C_two_D_idwt, as.double(y[[LH]]), as.double(y[[LL]]), as.double(y[[HH]]), as.double(y[[HL]]), m, n, L, h, g, "Y"=XX)$Y else { ## Lower right-hand corner if((pnx %% 2 != 0) & (pny %% 2 == 0)) out <- .C(C_two_D_idwt, as.double(y[[HL]]), as.double(y[[HH]]), as.double(y[[LL]]), as.double(y[[LH]]), m, n, L, h, g, "Y"=XX)$Y else { ## Lower left-hand corner if((pnx %% 2 == 0) & (pny %% 2 == 0)) out <- .C(C_two_D_idwt, as.double(y[[LL]]), as.double(y[[LH]]), as.double(y[[HL]]), as.double(y[[HH]]), m, n, L, h, g, "Y"=XX)$Y else stop("Ouch!") } } } if(j > 1) { pname <- paste("w", j-1, ".", pnx, "-", "w", j-1, ".", pny, sep="") y[[pname]] <- out y.basis[pname] <- 1 } } } } } return(out) } waveslim/R/soft.R0000644000176200001440000000012114627073455013407 0ustar liggesuserssoft <- function(x, T) { y <- max(abs(x) - T, 0) return(y/(y+T) * x) } waveslim/R/hosking.R0000644000176200001440000000310414627073455014102 0ustar liggesusers#' Generate Stationary Gaussian Process Using Hosking's Method #' #' Uses exact time-domain method from Hosking (1984) to generate a simulated #' time series from a specified autocovariance sequence. #' #' #' @param n Length of series. #' @param acvs Autocovariance sequence of series with which to generate, must #' be of length at least \code{n}. #' @return Length \code{n} time series from true autocovariance sequence #' \code{acvs}. #' @author B. Whitcher #' @references Hosking, J. R. M. (1984) Modeling persistence in hydrological #' time series using fractional differencing, \emph{Water Resources Research}, #' \bold{20}, No. 12, 1898-1908. #' #' Percival, D. B. (1992) Simulating Gaussian random processes with specified #' spectra, \emph{Computing Science and Statistics}, \bold{22}, 534-538. #' @keywords ts #' @examples #' #' dB <- function(x) 10 * log10(x) #' per <- function (z) { #' n <- length(z) #' (Mod(fft(z))^2/(2 * pi * n))[1:(n%/%2 + 1)] #' } #' spp.sdf <- function(freq, delta, omega) #' abs(2 * (cos(2*pi*freq) - cos(2*pi*omega)))^(-2*delta) #' data(acvs.andel8) #' n <- 1024 #' \dontrun{ #' z <- hosking.sim(n, acvs.andel8[,2]) #' per.z <- 2 * pi * per(z) #' par(mfrow=c(2,1), las=1) #' plot.ts(z, ylab="", main="Realization of a Seasonal Long-Memory Process") #' plot(0:(n/2)/n, dB(per.z), type="l", xlab="Frequency", ylab="dB", #' main="Periodogram") #' lines(0:(n/2)/n, dB(spp.sdf(0:(n/2)/n, .4, 1/12)), col=2) #' } #' #' @export hosking.sim hosking.sim <- function(n, acvs) { .C(C_hosking, tseries=rnorm(n), as.integer(n), as.double(acvs[1:n]))$tseries } waveslim/R/fdp.R0000644000176200001440000000774714627073455013232 0ustar liggesusers#' Wavelet-based Maximum Likelihood Estimation for a Fractional Difference #' Process #' #' Parameter estimation for a fractional difference (long-memory, self-similar) #' process is performed via maximum likelihood on the wavelet coefficients. #' #' The variance-covariance matrix of the original time series is approximated #' by its wavelet-based equivalent. A Whittle-type likelihood is then #' constructed where the sums of squared wavelet coefficients are compared to #' bandpass filtered version of the true spectrum. Minimization occurs only #' for the fractional difference parameter \eqn{d}, while variance is estimated #' afterwards. #' #' @param y Dyadic length time series. #' @param wf Name of the wavelet filter to use in the decomposition. See #' \code{\link{wave.filter}} for those wavelet filters available. #' @param J Depth of the discrete wavelet transform. #' @return List containing the maximum likelihood estimates (MLEs) of \eqn{d} #' and \eqn{\sigma^2}, along with the value of the likelihood for those #' estimates. #' @author B. Whitcher #' @references M. J. Jensen (2000) An alternative maximum likelihood estimator #' of long-memory processes using compactly supported wavelets, \emph{Journal #' of Economic Dynamics and Control}, \bold{24}, No. 3, 361-387. #' #' McCoy, E. J., and A. T. Walden (1996) Wavelet analysis and synthesis of #' stationary long-memory processes, \emph{Journal for Computational and #' Graphical Statistics}, \bold{5}, No. 1, 26-56. #' #' Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time #' Series Analysis}, Cambridge University Press. #' @keywords ts #' @examples #' #' ## Figure 5.5 in Gencay, Selcuk and Whitcher (2001) #' fdp.sdf <- function(freq, d, sigma2=1) #' sigma2 / ((2*sin(pi * freq))^2)^d #' dB <- function(x) 10 * log10(x) #' per <- function(z) { #' n <- length(z) #' (Mod(fft(z))**2/(2*pi*n))[1:(n %/% 2 + 1)] #' } #' data(ibm) #' ibm.returns <- diff(log(ibm)) #' ibm.volatility <- abs(ibm.returns) #' ibm.vol.mle <- fdp.mle(ibm.volatility, "d4", 4) #' freq <- 0:184/368 #' ibm.vol.per <- 2 * pi * per(ibm.volatility) #' ibm.vol.resid <- ibm.vol.per/ fdp.sdf(freq, ibm.vol.mle$parameters[1]) #' par(mfrow=c(1,1), las=0, pty="m") #' plot(freq, dB(ibm.vol.per), type="l", xlab="Frequency", ylab="Spectrum") #' lines(freq, dB(fdp.sdf(freq, ibm.vol.mle$parameters[1], #' ibm.vol.mle$parameters[2]/2)), col=2) #' #' @export fdp.mle fdp.mle <- function(y, wf, J=log(length(y),2)) { fdpML <- function(d, y) { y.dwt <- y[[1]] n <- y[[2]] J <- y[[3]] ## Establish the limits of integration for the band-pass variances a <- c(1/2^c(1:J+1), 0) b <- 1/2^c(0:J+1) ## Define some useful parameters for computing the likelihood length.j <- n / c(2^(1:J), 2^J) scale.j <- c(2^(1:J+1), 2^(J+1)) ## Initialize various parameters for computing the approximate ML bp.var <- numeric(J+1) ## Compute the band-pass variances according to d omega.diag <- NULL for(j in 1:(J+1)) { bp.var[j] <- integrate(fdp.sdf, a[j], b[j], d=d)$value omega.diag <- c(omega.diag, scale.j[j] * rep(bp.var[j], length.j[j])) } ## Compute approximate maximum likelihood n * log(sum(y.dwt^2 / omega.diag) / n) + sum(length.j * log(scale.j * bp.var)) } n <- length(y) y.dwt <- as.vector(unlist(dwt(y, wf, n.levels=J))) ## Compute MLE of d (limited to stationary region) result <- optimize(fdpML, interval=c(-0.5,0.5), maximum=FALSE, y=list(y.dwt, n, J)) ## Compute MLE of sigma_epsilon^2 a <- c(1/2^c(1:J+1), 0) b <- 1/2^c(0:J+1) length.j <- n / c(2^(1:J), 2^J) scale.j <- c(2^(1:J+1), 2^(J+1)) bp.var <- numeric(J+1) omega.diag <- NULL for(j in 1:(J+1)) { bp.var[j] <- integrate(fdp.sdf, a[j], b[j], d=result$minimum)$value omega.diag <- c(omega.diag, scale.j[j] * rep(bp.var[j], length.j[j])) } sigma2 <- sum(y.dwt^2 / omega.diag) / n list(parameters=c(result$minimum, sigma2), objective=result$objective) } waveslim/R/sdf.R0000644000176200001440000001321714627073455013222 0ustar liggesusers#' Spectral Density Functions for Long-Memory Processes #' #' Draws the spectral density functions (SDFs) for standard long-memory #' processes including fractional difference (FD), seasonal persistent (SP), #' and seasonal fractional difference (SFD) processes. #' #' #' @usage fdp.sdf(freq, d, sigma2 = 1) #' @usage spp.sdf(freq, d, fG, sigma2 = 1) #' @usage spp2.sdf(freq, d1, f1, d2, f2, sigma2 = 1) #' @usage sfd.sdf(freq, s, d, sigma2 = 1) #' @aliases fdp.sdf spp.sdf spp2.sdf sfd.sdf #' @param freq vector of frequencies, normally from 0 to 0.5 #' @param d,d1,d2 fractional difference parameter #' @param fG,f1,f2 Gegenbauer frequency #' @param s seasonal parameter #' @param sigma2 innovations variance #' @return The power spectrum from an FD, SP or SFD process. #' @author B. Whitcher #' @seealso \code{\link{fdp.mle}}, \code{\link{spp.mle}}. #' @keywords ts #' @examples #' #' dB <- function(x) 10 * log10(x) #' #' fdp.main <- expression(paste("FD", group("(",d==0.4,")"))) #' sfd.main <- expression(paste("SFD", group("(",list(s==12, d==0.4),")"))) #' spp.main <- expression(paste("SPP", #' group("(",list(delta==0.4, f[G]==1/12),")"))) #' #' freq <- 0:512/1024 #' #' par(mfrow=c(2,2), mar=c(5-1,4,4-1,2), col.main="darkred") #' plot(freq, dB(fdp.sdf(freq, .4)), type="l", xlab="frequency", #' ylab="spectrum (dB)", main=fdp.main) #' plot(freq, dB(spp.sdf(freq, .4, 1/12)), type="l", xlab="frequency", #' ylab="spectrum (dB)", font.main=1, main=spp.main) #' plot(freq, dB(sfd.sdf(freq, 12, .4)), type="l", xlab="frequency", #' ylab="spectrum (dB)", main=sfd.main) fdp.sdf <- function(freq, d, sigma2 = 1) sigma2 / ((2 * sin(pi * freq)) ^ 2) ^ d bandpass.fdp <- function(a, b, d) 2 * integrate(fdp.sdf, lower = a, upper = b, d = d)$value spp.sdf <- function(freq, d, fG, sigma2 = 1) sigma2 * abs(2 * (cos(2 * pi * freq) - cos(2 * pi * fG))) ^ (-2 * d) spp2.sdf <- function(freq, d1, f1, d2, f2, sigma2 = 1) { sigma2 * abs(2 * (cos(2 * pi * freq) - cos(2 * pi * f1))) ^ (-2 * d1) * abs(2 * (cos(2 * pi * freq) - cos(2 * pi * f2))) ^ (-2 * d2) } sfd.sdf <- function(freq, s, d, sigma2=1) sigma2 / (2 * (1 - cos(s * 2 * pi * freq))) ^ d bandpass.spp <- function(a, b, d, fG) { if (fG > a && fG < b) { result1 <- integrate(spp.sdf, lower=a, upper=fG, d=d, fG=fG)$value result2 <- integrate(spp.sdf, lower=fG, upper=b, d=d, fG=fG)$value } else { result1 <- integrate(spp.sdf, lower=a, upper=b, d=d, fG=fG)$value result2 <- 0 } return(2*(result1 + result2)) } bandpass.spp2 <- function(a, b, d1, f1, d2, f2) { a1 <- a b1 <- b if(a1 < f1 && b1 > f2) { a2 <- f1 b2 <- f2 result1 <- integrate(spp2.sdf, a1, a2, d1=d1, f1=f1, d2=d2, f2=f2)$value result2 <- integrate(spp2.sdf, a1, b2, d1=d1, f1=f1, d2=d2, f2=f2)$value result3 <- integrate(spp2.sdf, b2, b1, d1=d1, f1=f1, d2=d2, f2=f2)$value } else { if (a1 < f1 && b1 < f2) { a2 <- f1 result1 <- integrate(spp2.sdf, a1, a2, d1=d1, f1=f1, d2=d2, f2=f2)$value result2 <- integrate(spp2.sdf, a2, b1, d1=d1, f1=f1, d2=d2, f2=f2)$value result3 <- 0 } else { if (a1 < f1 && b1 > f1 && b1 < f2) { a2 <- f1 result1 <- integrate(spp2.sdf, a1, a2, d1=d1, f1=f1, d2=d2, f2=f2)$value result2 <- integrate(spp2.sdf, a2, b1, d1=d1, f1=f1, d2=d2, f2=f2)$value result3 <- 0 } else { if (a1 > f1 && a1 < f2 && b1 > f2) { a2 <- f2 result1 <- integrate(spp2.sdf, a1, a2, d1=d1, f1=f1, d2=d2, f2=f2)$value result2 <- integrate(spp2.sdf, a2, b1, d1=d1, f1=f1, d2=d2, f2=f2)$value result3 <- 0 } else { result1 <- integrate(spp2.sdf, a1, b1, d1=d1, f1=f1, d2=d2, f2=f2)$value result2 <- 0 result3 <- 0 } } } } return(2 * (result1 + result2 + result3)) } #' Variance of a Seasonal Persistent Process #' #' Computes the variance of a seasonal persistent (SP) process using a #' hypergeometric series expansion. #' #' See Lapsa (1997). The subroutine to compute a hypergeometric series was #' taken from \emph{Numerical Recipes in C}. #' #' @usage spp.var(d, fG, sigma2 = 1) #' @usage Hypergeometric(a, b, c, z) #' @aliases spp.var Hypergeometric #' @param d Fractional difference parameter. #' @param fG Gegenbauer frequency. #' @param sigma2 Innovations variance. #' @param a,b,c,z Parameters for the hypergeometric series. #' @return The variance of an SP process. #' @author B. Whitcher #' @references Lapsa, P.M. (1997) Determination of Gegenbauer-type random #' process models. \emph{Signal Processing} \bold{63}, 73-90. #' #' Press, W.H., S.A. Teukolsky, W.T. Vetterling and B.P. Flannery (1992) #' \emph{Numerical Recipes in C}, 2nd edition, Cambridge University Press. #' @keywords ts #' @export spp.var spp.var <- function(d, fG, sigma2 = 1) { ## Hypergeometric series representation of the variance taken from ## Lapsa (1997) omega <- 2 * pi * fG A <- sigma2 / 2 / sqrt(pi) * gamma(1 - 2 * d) / gamma(3 / 2 - 2 * d) * sin(omega) ^(1 - 4 * d) P1 <- Hypergeometric(1 - 2 * d, 1 - 2 * d, 3 / 2 - 2 * d, sin(omega / 2) ^ 2) P2 <- Hypergeometric(1 - 2 * d, 1 - 2 * d, 3 / 2 - 2 * d, cos(omega / 2) ^ 2) return(A * (P1 + P2)) } Hypergeometric <- function(a, b, c, z) { ## Recursive implementation taken from Numerical Recipes in C (6.12) ## Press, Teukolsky, Vetterling and Flannery (1992) fac <- 1 temp <- fac aa <- a bb <- b cc <- c for (n in 1:1000) { fac <- fac * (aa * bb) / cc fac <- fac * z / n series <- temp + fac if (series == temp) return(series) temp <- series aa <- aa + 1 bb <- bb + 1 cc <- cc + 1 } stop("convergence failure in Hypergeometric") } waveslim/R/var_2D.R0000644000176200001440000000534714627073455013570 0ustar liggesusersbrick.wall.2d <- function (x, method = "modwt") { wf <- attributes(x)$wavelet m <- wave.filter(wf)$length for (i in names(x)) { j <- as.numeric(substr(i, 3, 3)) if (method == "dwt") { n <- ceiling((m - 2) * (1 - 1/2^j)) } else { n <- (2^j - 1) * (m - 1) } n <- min(n, nrow(x[[i]])) x[[i]][1:n, ] <- NA x[[i]][, 1:n] <- NA } return(x) } #' Wavelet Analysis of Images #' #' Produces an estimate of the multiscale variance with approximate #' confidence intervals using the 2D MODWT. #' #' The wavelet variance is basically the average of the squared wavelet #' coefficients across each scale and direction of an image. As shown #' in Mondal and Percival (2012), the wavelet variance is a #' scale-by-scale decomposition of the variance for a stationary spatial #' process, and certain non-stationary spatial processes. #' #' @param x image #' @param p (one minus the) two-sided p-value for the confidence interval #' @return Data frame with 3J+1 rows. #' @author B. Whitcher #' @references Mondal, D. and D. B. Percival (2012). Wavelet variance #' analysis for random fields on a regular lattice. \emph{IEEE #' Transactions on Image Processing} \bold{21}, 537–549. #' wave.variance.2d <- function(x, p = 0.025) { # The unbiased estimator ignores those coefficients affected by the boundary x_bw <- brick.wall.2d(x) x_ss <- unlist(lapply(x_bw, FUN = function(v) sum(v * v, na.rm = TRUE))) x_length <- unlist(lapply(x_bw, FUN = function(v) sum(! is.na(v)))) wave_var <- x_ss / x_length edof <- rep(NA, length(x)) names(edof) <- names(x) wf_length <- wave.filter(attributes(x)$wavelet)$length # from Section 3.3 Confidence intervals in Geilhufe et al. (2013) for (i in names(x)) { j <- as.integer(substr(i, 3, 3)) Lj <- (2^j - 1) * (wf_length - 1) + 1 Nj <- nrow(x[[i]]) - Lj + 1 Mj <- ncol(x[[i]]) - Lj + 1 pad_with_zeros <- matrix(0, nrow = 2^(trunc(log2(Nj)) + 2), ncol = 2^(trunc(log2(Mj)) + 2)) pad_with_zeros[1:Nj, 1:Mj] <- x[[i]][Lj:nrow(x[[i]]), Lj:ncol(x[[i]])] sW <- fft(fft(pad_with_zeros) * Conj(fft(pad_with_zeros)), inverse = TRUE) / prod(dim(pad_with_zeros)) / Nj / Mj sigma_W <- sum(sW^2) if (Nj * Mj > 128) { edof[i] <- 2 * Nj * Mj * wave_var[i]^2 / Re(sigma_W) } else { edof[i] <- max((Nj * Mj) / (2^j * 2^j), 1) } } data.frame( value = wave_var, level = as.integer(substr(names(x), 3, 3)), direction = factor( toupper(substr(names(x), 1, 2)), levels = c("LH", "HL", "HH", "LL"), labels = c("Horizontal", "Vertical", "Diagonal", "Approximation") ), ci_lower = unlist(edof) * wave_var / qchisq(1 - p, unlist(edof)), ci_upper = unlist(edof) * wave_var / qchisq(p, unlist(edof)) ) } waveslim/R/up.sample.R0000644000176200001440000000072414627073455014351 0ustar liggesusers#' Upsampling of a vector #' #' Upsamples a given vector. #' #' #' @param x vector of observations #' @param f frequency of upsampling; e.g, 2, 4, etc. #' @param y value to upsample with; e.g., NA, 0, etc. #' @return A vector twice its length. #' @author B. Whitcher #' @references Any basic signal processing text. #' @keywords ts #' @export up.sample up.sample <- function(x, f, y=NA) { n <- length(x) as.vector(rbind(x, matrix(rep(y, (f-1)*n), nrow=f-1))) } waveslim/R/spp.R0000644000176200001440000002036614627073455013253 0ustar liggesusers#' Wavelet-based Maximum Likelihood Estimation for Seasonal Persistent #' Processes #' #' Parameter estimation for a seasonal persistent (seasonal long-memory) #' process is performed via maximum likelihood on the wavelet coefficients. #' #' The variance-covariance matrix of the original time series is approximated #' by its wavelet-based equivalent. A Whittle-type likelihood is then #' constructed where the sums of squared wavelet coefficients are compared to #' bandpass filtered version of the true spectral density function. #' Minimization occurs for the fractional difference parameter \eqn{d} and the #' Gegenbauer frequency \eqn{f_G}, while the innovations variance is #' subsequently estimated. #' #' @usage spp.mle(y, wf, J = log(length(y), 2) - 1, p = 0.01, frac = 1) #' @usage spp2.mle(y, wf, J = log(length(y), 2) - 1, p = 0.01, dyadic = TRUE, frac = 1) #' @aliases spp.mle spp2.mle #' @param y Not necessarily dyadic length time series. #' @param wf Name of the wavelet filter to use in the decomposition. See #' \code{\link{wave.filter}} for those wavelet filters available. #' @param J Depth of the discrete wavelet packet transform. #' @param p Level of significance for the white noise testing procedure. #' @param dyadic Logical parameter indicating whether or not the original time #' series is dyadic in length. #' @param frac Fraction of the time series that should be used in constructing #' the likelihood function. #' @return List containing the maximum likelihood estimates (MLEs) of #' \eqn{\delta}, \eqn{f_G} and \eqn{\sigma^2}, along with the value of the #' likelihood for those estimates. #' @author B. Whitcher #' @seealso \code{\link{fdp.mle}} #' @references Whitcher, B. (2004) Wavelet-based estimation for seasonal #' long-memory processes, \emph{Technometrics}, \bold{46}, No. 2, 225-238. #' @keywords ts #' @export spp.mle spp.mle <- function(y, wf, J=log(length(y),2)-1, p=0.01, frac=1) { sppLL <- function(x, y) { delta <- x[1] fG <- x[2] ## cat("Parameters are: d =", delta, ", and f =", fG, fill=TRUE) y.dwpt <- y[[1]] y.basis <- y[[2]] n <- y[[3]] J <- y[[4]] ## Establish the limits of integration for the band-pass variances a <- unlist(apply(matrix(2^(1:J)-1), 1, seq, from=0, by=1)) / 2^(rep(1:J, 2^(1:J))) / 2 b <- unlist(apply(matrix(2^(1:J)), 1, seq, from=1, by=1)) / 2^(rep(1:J, 2^(1:J))) / 2 ## Define some useful parameters for the wavelet packet tree # n <- length(y) length.jn <- n / rep(2^(1:J), 2^(1:J)) scale.jn <- rep(2^(1:J+1), 2^(1:J)) ## Initialize various parameters for the reduced LL Basis <- (1:length(y.basis))[y.basis] bp.var <- numeric(length(Basis)) delta.n <- 100 ## Compute the band-pass variances according to \delta and f_G omega.diag <- NULL for(i in 1:sum(y.basis)) { jn <- Basis[i] bp.var[i] <- bandpass.spp(a[jn], b[jn], delta, fG) omega.diag <- c(omega.diag, scale.jn[jn] * rep(bp.var[i], length.jn[jn])) } ## Compute reduced log-likelihood rLL <- n * log(1/n * sum(y.dwpt^2 / omega.diag, na.rm=TRUE)) + sum(length.jn[y.basis] * log(scale.jn[y.basis] * bp.var)) rLL } n <- length(y) x0 <- numeric(2) ## Perform discrete wavelet packet transform (DWPT) on Y y.dwpt <- dwpt(y, wf, n.levels=J) n <- length(y) if(frac < 1) { for(i in 1:length(y.dwpt)) { vec <- y.dwpt[[i]] ni <- length(vec) j <- rep(1:J, 2^(1:J))[i] vec[trunc(frac * n/2^j):ni] <- NA y.dwpt[[i]] <- vec } } y.basis <- as.logical(ortho.basis(portmanteau.test(y.dwpt, p))) y.dwpt <- as.matrix(unlist(y.dwpt[y.basis])) ## Compute initial estimate of the Gegenbauer frequency y.per <- per(y - mean(y)) x0[2] <- (0:(n/2)/n)[max(y.per) == y.per] ## Compute initial estimate of the fractional difference parameter muJ <- (unlist(apply(matrix(2^(1:J)-1), 1, seq, from=0, by=1)) / 2^(rep(1:J, 2^(1:J))) + unlist(apply(matrix(2^(1:J)), 1, seq, from=1, by=1)) / 2^(rep(1:J, 2^(1:J)))) / 4 y.modwpt <- modwpt(y, wf=wf, n.levels=J) y.varJ <- rep(2^(1:J), 2^(1:J)) * unlist(lapply(y.modwpt, FUN=function(x)sum(x*x,na.rm=TRUE)/length(x[!is.na(x)]))) x0[1] <- min(-0.5 * lsfit(log(abs(muJ[y.basis] - x0[2])), log(y.varJ[y.basis]))$coef[2], 0.49) cat(paste("Initial parameters are: delta =", round(x0[1],4), "freqG =", round(x0[2],4), "\n")) result <- optim(par=x0, fn=sppLL, method="L-BFGS-B", lower=c(0.001,0.001), upper=c(0.499,0.499), control=list(trace=0, fnscale=2), y=list(y.dwpt, y.basis, n, J)) return(result) } spp2.mle <- function(y, wf, J=log(length(y),2)-1, p=0.01, dyadic=TRUE, frac=1) { spp2LL <- function(x, y) { d1 <- x[1] f1 <- x[2] d2 <- x[3] f2 <- x[4] ## cat("Parameters are: d1 =", round(d1,6), ", and f1 =", round(f1,6), ## ", d2 =", round(d2,6), ", and f2 =", round(f2,6), fill=TRUE) y.dwpt <- y[[1]] y.basis <- y[[2]] n <- y[[3]] J <- y[[4]] ## Establish the limits of integration for the band-pass variances a <- unlist(apply(matrix(2^(1:J)-1), 1, seq, from=0, by=1)) / 2^(rep(1:J, 2^(1:J))) / 2 b <- unlist(apply(matrix(2^(1:J)), 1, seq, from=1, by=1)) / 2^(rep(1:J, 2^(1:J))) / 2 ## Define some useful parameters for the wavelet packet tree length.jn <- n / rep(2^(1:J), 2^(1:J)) scale.jn <- rep(2^(1:J+1), 2^(1:J)) ## Initialize various parameters for the reduced LL Basis <- (1:length(y.basis))[y.basis] bp.var <- numeric(length(Basis)) delta.n <- 100 ## Compute the band-pass variances according to \delta and f_G omega.diag <- NULL for(i in 1:sum(y.basis)) { jn <- Basis[i] bp.var[i] <- bandpass.spp2(a[jn], b[jn], d1, f1, d2, f2) omega.diag <- c(omega.diag, scale.jn[jn] * rep(bp.var[i], length.jn[jn])) } ## Compute reduced log-likelihood n * log(1/n * sum(y.dwpt^2 / omega.diag, na.rm=TRUE)) + sum(length.jn[y.basis] * log(scale.jn[y.basis] * bp.var), na.rm=TRUE) } n <- length(y) x0 <- numeric(4) ## Perform discrete wavelet packet transform (DWPT) on Y y.dwpt <- dwpt(y, wf, n.levels=J) if(!dyadic) { for(i in 1:length(y.dwpt)) { vec <- y.dwpt[[i]] ni <- length(vec) j <- rep(1:J, 2^(1:J))[i] vec[trunc(frac * n/2^j):ni] <- NA y.dwpt[[i]] <- vec } } y.basis <- as.logical(ortho.basis(portmanteau.test(y.dwpt, p, type="other"))) y.dwpt <- as.vector(unlist(y.dwpt[y.basis])) ## Compute initial estimate of the Gegenbauer frequencies if(dyadic) y.per <- per(y - mean(y)) else y.per <- per(y[1:(frac*n)] - mean(y[1:(frac*n)])) freq.y <- (0:(frac*n %/% 2))/(frac*n) x0[2] <- freq.y[max(y.per) == y.per] x0[4] <- freq.y[max(y.per[freq.y > x0[2] + freq.y[10] | freq.y < x0[2] - freq.y[10]]) == y.per] if(x0[2] > x0[4]) { xx <- x0[2] x0[2] <- x0[4] x0[4] <- xx rm(xx) } ## Compute initial estimate of the fractional difference parameters muJ <- (unlist(apply(matrix(2^(1:J)-1), 1, seq, from=0, by=1)) / 2^(rep(1:J, 2^(1:J))) + unlist(apply(matrix(2^(1:J)), 1, seq, from=1, by=1)) / 2^(rep(1:J, 2^(1:J)))) / 4 y.modwpt <- modwpt(y, wf=wf, n.levels=J) y.varJ <- rep(2^(1:J), 2^(1:J)) * unlist(lapply(y.modwpt, FUN = function(x) sum(x*x,na.rm=TRUE)/length(x[!is.na(x)]))) x0.mid <- (x0[2] + x0[4]) / 2 muJ <- muJ[y.basis] y.varJ <- y.varJ[y.basis] x0[1] <- min(-0.5 * lsfit(log(abs(muJ[muJ < x0.mid] - x0[2])), log(y.varJ[muJ < x0.mid]))$coef[2], 0.49) x0[3] <- min(-0.5 * lsfit(log(abs(muJ[muJ > x0.mid] - x0[4])), log(y.varJ[muJ > x0.mid]))$coef[2], 0.49) cat(paste("Initial parameters: d1 = ", round(x0[1],4), ", f1 = ", round(x0[2],4), ", d2 = ", round(x0[3],4), ", f2 = ", round(x0[4],4), sep=""), fill=TRUE) result <- optim(par=x0, fn=spp2LL, method="L-BFGS-B", lower=rep(0.001,4), upper=rep(0.499,4), control=list(trace=1, fnscale=2), y=list(y.dwpt, y.basis, n, J)) return(result) } waveslim/R/dualtree.R0000644000176200001440000003000414627073455014244 0ustar liggesusers#' Kingsbury's Q-filters for the Dual-Tree Complex DWT #' #' Kingsbury's Q-filters for the dual-tree complex DWT. #' #' These cofficients are rounded to 8 decimal places. #' #' @aliases dualfilt1 AntonB #' @return \item{af}{List (i=1,2) - analysis filters for tree i} \item{sf}{List #' (i=1,2) - synthesis filters for tree i} Note: \code{af[[2]]} is the reverse #' of \code{af[[1]]}. #' @author Matlab: S. Cai, K. Li and I. Selesnick; R port: B. Whitcher #' @seealso \code{\link{dualtree}} #' @references Kingsbury, N.G. (2000). A dual-tree complex wavelet transform #' with improved orthogonality and symmetry properties, \emph{Proceedings of #' the IEEE Int. Conf. on Image Proc.} (ICIP). #' @keywords ts #' @export dualfilt1 dualfilt1 <- function() { af1 <- c(0.03516384000000, 0, 0, 0, -0.08832942000000, -0.11430184000000, 0.23389032000000, 0, 0.76027237000000, 0.58751830000000, 0.58751830000000, -0.76027237000000, 0, 0.23389032000000, -0.11430184000000, 0.08832942000000, 0, 0, 0, -0.03516384000000) af1 <- matrix(af1, ncol=2, byrow=TRUE) af2 <- c(0, -0.03516384000000, 0, 0, -0.11430184000000, 0.08832942000000, 0, 0.23389032000000, 0.58751830000000, -0.76027237000000, 0.76027237000000, 0.58751830000000, 0.23389032000000, 0, -0.08832942000000, -0.11430184000000, 0, 0, 0.03516384000000, 0) af2 <- matrix(af2, ncol=2, byrow=TRUE) sf1 <- af1[nrow(af1):1, ] sf2 <- af2[nrow(af2):1, ] list(af = list(af1, af2), sf = list(sf1, sf2)) } #' Farras nearly symmetric filters #' #' Farras nearly symmetric filters for orthogonal 2-channel perfect #' reconstruction filter bank and Farras filters organized for the dual-tree #' complex DWT. #' #' #' @aliases farras FSfarras #' @return \item{af}{List (i=1,2) - analysis filters for tree i} \item{sf}{List #' (i=1,2) - synthesis filters for tree i} #' @author Matlab: S. Cai, K. Li and I. Selesnick; R port: B. Whitcher #' @seealso \code{\link{afb}}, \code{\link{dualtree}}, \code{\link{dualfilt1}}. #' @references A. F. Abdelnour and I. W. Selesnick. \dQuote{Nearly symmetric #' orthogonal wavelet bases}, Proc. IEEE Int. Conf. Acoust., Speech, Signal #' Processing (ICASSP), May 2001. #' @keywords ts FSfarras <- function() { af1 <- c(0, 0, -0.08838834764832, -0.01122679215254, 0.08838834764832, 0.01122679215254, 0.69587998903400, 0.08838834764832, 0.69587998903400, 0.08838834764832, 0.08838834764832, -0.69587998903400, -0.08838834764832, 0.69587998903400, 0.01122679215254, -0.08838834764832, 0.01122679215254, -0.08838834764832, 0, 0) af1 <- matrix(af1, ncol=2, byrow=TRUE) sf1 <- af1[nrow(af1):1, ] af2 <- c(0.01122679215254, 0, 0.01122679215254, 0, -0.08838834764832, -0.08838834764832, 0.08838834764832, -0.08838834764832, 0.69587998903400, 0.69587998903400, 0.69587998903400, -0.69587998903400, 0.08838834764832, 0.08838834764832, -0.08838834764832, 0.08838834764832, 0, 0.01122679215254, 0, -0.01122679215254) af2 <- matrix(af2, ncol=2, byrow=TRUE) sf2 <- af2[nrow(af2):1, ] list(af = list(af1, af2), sf = list(sf1, sf2)) } farras <- function() { af <- c(0, -0.01122679215254, 0, 0.01122679215254, -0.08838834764832, 0.08838834764832, 0.08838834764832, 0.08838834764832, 0.69587998903400, -0.69587998903400, 0.69587998903400, 0.69587998903400, 0.08838834764832, -0.08838834764832, -0.08838834764832, -0.08838834764832, 0.01122679215254, 0, 0.01122679215254, 0) af <- matrix(af, nrow=10, byrow=TRUE) sf <- af[nrow(af):1, ] list(af = af, sf = sf) } #' Miscellaneous Functions for Dual-Tree Wavelet Software #' #' Miscellaneous functions for dual-tree wavelet software. #' #' #' @usage cshift(x, m) #' @usage cshift2D(x, m) #' @usage pm(a, b) #' @aliases cshift cshift2D pm #' @param x N-point vector #' @param m amount of shift #' @param a,b input parameters #' @return \item{y}{vector \code{x} will be shifed by \code{m} samples to the #' left or matrix \code{x} will be shifed by \code{m} samples down.} #' \item{u}{(a + b) / sqrt(2)} \item{v}{(a - b) / sqrt(2)} #' @author Matlab: S. Cai, K. Li and I. Selesnick; R port: B. Whitcher #' @keywords ts cshift <- function(x, m) { N <- length(x) n <- 0:(N-1) n <- (n-m) %% N y <- x[n+1] y } #' Filter Banks for Dual-Tree Wavelet Transforms #' #' Analysis and synthesis filter banks used in dual-tree wavelet algorithms. #' #' The functions \code{afb2D.A} and \code{sfb2D.A} implement the convolutions, #' either for analysis or synthesis, in one dimension only. Thus, they are the #' workhorses of \code{afb2D} and \code{sfb2D}. The output for the analysis #' filter bank along one dimension (\code{afb2D.A}) is a list with two elements #' \describe{ \item{lo}{low-pass subband} \item{hi}{high-pass subband} } where #' the dimension of analysis will be half its original length. The output for #' the synthesis filter bank along one dimension (\code{sfb2D.A}) will be the #' output array, where the dimension of synthesis will be twice its original #' length. #' #' @usage afb(x, af) #' @usage afb2D(x, af1, af2 = NULL) #' @usage afb2D.A(x, af, d) #' @usage sfb(lo, hi, sf) #' @usage sfb2D(lo, hi, sf1, sf2 = NULL) #' @usage sfb2D.A(lo, hi, sf, d) #' @aliases afb afb2D afb2D.A sfb sfb2D sfb2D.A #' @param x vector or matrix of observations #' @param af analysis filters. First element of the list is the low-pass #' filter, second element is the high-pass filter. #' @param af1,af2 analysis filters for the first and second dimension of a 2D #' array. #' @param sf synthesis filters. First element of the list is the low-pass #' filter, second element is the high-pass filter. #' @param sf1,sf2 synthesis filters for the first and second dimension of a 2D #' array. #' @param d dimension of filtering (d = 1 or 2) #' @param lo low-frequecy coefficients #' @param hi high-frequency coefficients #' @return In one dimension the output for the analysis filter bank #' (\code{afb}) is a list with two elements \item{lo}{Low frequecy output} #' \item{hi}{High frequency output} and the output for the synthesis filter #' bank (\code{sfb}) is the output signal. #' #' In two dimensions the output for the analysis filter bank (\code{afb2D}) is #' a list with four elements \item{lo}{low-pass subband} \item{hi[[1]]}{'lohi' #' subband} \item{hi[[2]]}{'hilo' subband} \item{hi[[3]]}{'hihi' subband} and #' the output for the synthesis filter bank (\code{sfb2D}) is the output array. #' @author Matlab: S. Cai, K. Li and I. Selesnick; R port: B. Whitcher #' @keywords ts #' @examples #' #' ## EXAMPLE: afb, sfb #' af = farras()$af #' sf = farras()$sf #' x = rnorm(64) #' x.afb = afb(x, af) #' lo = x.afb$lo #' hi = x.afb$hi #' y = sfb(lo, hi, sf) #' err = x - y #' max(abs(err)) #' #' ## EXAMPLE: afb2D, sfb2D #' x = matrix(rnorm(32*64), 32, 64) #' af = farras()$af #' sf = farras()$sf #' x.afb2D = afb2D(x, af, af) #' lo = x.afb2D$lo #' hi = x.afb2D$hi #' y = sfb2D(lo, hi, sf, sf) #' err = x - y #' max(abs(err)) #' #' ## Example: afb2D.A, sfb2D.A #' x = matrix(rnorm(32*64), 32, 64) #' af = farras()$af #' sf = farras()$sf #' x.afb2D.A = afb2D.A(x, af, 1) #' lo = x.afb2D.A$lo #' hi = x.afb2D.A$hi #' y = sfb2D.A(lo, hi, sf, 1) #' err = x - y #' max(abs(err)) afb <- function(x, af) { N <- length(x) L <- nrow(af)/2 x <- cshift(x,-L) ## lowpass filter lo <- convolve(x, af[,1], conj=FALSE, type="open") lo <- cshift(lo,-(2*L-1)) lo <- lo[seq(1, length(lo), by=2)] lo[1:L] <- lo[N/2+(1:L)] + lo[1:L] lo <- lo[1:(N/2)] ## highpass filter hi <- convolve(x, af[,2], conj=FALSE, type="open") hi <- cshift(hi,-(2*L-1)) hi <- hi[seq(1, length(hi), by=2)] hi[1:L] <- hi[N/2+(1:L)] + hi[1:L] hi <- hi[1:(N/2)] list(lo = lo, hi = hi) } #' Dual-tree Complex Discrete Wavelet Transform #' #' One- and two-dimensional dual-tree complex discrete wavelet transforms #' developed by Kingsbury and Selesnick \emph{et al.} #' #' In one dimension \eqn{N} is divisible by \eqn{2^J} and #' \eqn{N\ge2^{J-1}\cdot\mbox{length}(\mbox{\code{af}})}. #' #' In two dimensions, these two conditions must hold for both \eqn{M} and #' \eqn{N}. #' #' @usage dualtree(x, J, Faf, af) #' @usage idualtree(w, J, Fsf, sf) #' @usage dualtree2D(x, J, Faf, af) #' @usage idualtree2D(w, J, Fsf, sf) #' @aliases dualtree idualtree dualtree2D idualtree2D #' @param x N-point vector or MxN matrix. #' @param w DWT coefficients. #' @param J number of stages. #' @param Faf analysis filters for the first stage. #' @param af analysis filters for the remaining stages. #' @param Fsf synthesis filters for the last stage. #' @param sf synthesis filters for the preceeding stages. #' @return For the analysis of \code{x}, the output is \item{w}{DWT #' coefficients. Each wavelet scale is a list containing the real and #' imaginary parts. The final scale (J+1) contains the low-pass filter #' coefficients.} For the synthesis of \code{w}, the output is \item{y}{output #' signal} #' @author Matlab: S. Cai, K. Li and I. Selesnick; R port: B. Whitcher #' @seealso \code{\link{FSfarras}}, \code{\link{farras}}, #' \code{\link{convolve}}, \code{\link{cshift}}, \code{\link{afb}}, #' \code{\link{sfb}}. #' @keywords ts #' @examples #' #' ## EXAMPLE: dualtree #' x = rnorm(512) #' J = 4 #' Faf = FSfarras()$af #' Fsf = FSfarras()$sf #' af = dualfilt1()$af #' sf = dualfilt1()$sf #' w = dualtree(x, J, Faf, af) #' y = idualtree(w, J, Fsf, sf) #' err = x - y #' max(abs(err)) #' #' ## Example: dualtree2D #' x = matrix(rnorm(64*64), 64, 64) #' J = 3 #' Faf = FSfarras()$af #' Fsf = FSfarras()$sf #' af = dualfilt1()$af #' sf = dualfilt1()$sf #' w = dualtree2D(x, J, Faf, af) #' y = idualtree2D(w, J, Fsf, sf) #' err = x - y #' max(abs(err)) #' #' ## Display 2D wavelets of dualtree2D.m #' #' J <- 4 #' L <- 3 * 2^(J+1) #' N <- L / 2^J #' Faf <- FSfarras()$af #' Fsf <- FSfarras()$sf #' af <- dualfilt1()$af #' sf <- dualfilt1()$sf #' x <- matrix(0, 2*L, 3*L) #' w <- dualtree2D(x, J, Faf, af) #' w[[J]][[1]][[1]][N/2, N/2+0*N] <- 1 #' w[[J]][[1]][[2]][N/2, N/2+1*N] <- 1 #' w[[J]][[1]][[3]][N/2, N/2+2*N] <- 1 #' w[[J]][[2]][[1]][N/2+N, N/2+0*N] <- 1 #' w[[J]][[2]][[2]][N/2+N, N/2+1*N] <- 1 #' w[[J]][[2]][[3]][N/2+N, N/2+2*N] <- 1 #' y <- idualtree2D(w, J, Fsf, sf) #' image(t(y), col=grey(0:64/64), axes=FALSE) #' dualtree <- function(x, J, Faf, af) { ## normalization x <- x/sqrt(2) w <- vector("list", J+1) ## Tree 1 w[[1]] <- vector("list", 2) temp <- afb(x, Faf[[1]]) x1 <- temp$lo w[[1]][[1]] <- temp$hi if(J > 1) { for(j in 2:J) { w[[j]] <- vector("list", 2) temp <- afb(x1, af[[1]]) x1 <- temp$lo w[[j]][[1]] <- temp$hi } } w[[J+1]] <- vector("list", 2) w[[J+1]][[1]] <- x1 ## Tree 2 temp <- afb(x, Faf[[2]]) x2 <- temp$lo w[[1]][[2]] <- temp$hi if(J > 1) { for(j in 2:J) { temp <- afb(x2, af[[2]]) x2 <- temp$lo w[[j]][[2]] <- temp$hi } } w[[J+1]][[2]] <- x2 w } sfb <- function(lo, hi, sf) { N <- 2*length(lo) L <- nrow(sf) ## lo <- upfirdn(lo, sf[,1], 2, 1) lo <- c(matrix(c(rep(0, N/2), lo), nrow=2, byrow=TRUE)) lo <- convolve(lo, sf[,1], conj=FALSE, type="open") lo <- cshift(lo, -L) ## hi <- upfirdn(hi, sf[,2], 2, 1) hi <- c(matrix(c(rep(0, N/2), hi), nrow=2, byrow=TRUE)) hi <- convolve(hi, sf[,2], conj=FALSE, type="open") hi <- cshift(hi, -L) y <- lo + hi y[1:(L-2)] <- y[1:(L-2)] + y[N+1:(L-2)] y <- y[1:N] ## y = cshift(y, 1-L/2); y <- cshift(y, 1-L/2) y } idualtree <- function(w, J, Fsf, sf) { ## Tree 1 y1 <- w[[J+1]][[1]] if(J > 1) { for(j in J:2) { y1 <- sfb(y1, w[[j]][[1]], sf[[1]]) } } y1 <- sfb(y1, w[[1]][[1]], Fsf[[1]]) ## Tree 2 y2 <- w[[J+1]][[2]] if(J > 1) { for(j in J:2) { y2 <- sfb(y2, w[[j]][[2]], sf[[2]]) } } y2 <- sfb(y2, w[[1]][[2]], Fsf[[2]]) ## normalization y <- (y1 + y2)/sqrt(2) y } waveslim/R/misc.R0000644000176200001440000000224214627073455013375 0ustar liggesusers#' Autocovariance Functions via the Discrete Fourier Transform #' #' Computes the autocovariance function (ACF) for a time series or the #' cross-covariance function (CCF) between two time series. #' #' The series is zero padded to twice its length before the discrete Fourier #' transform is applied. Only the values corresponding to nonnegative lags are #' provided (for the ACF). #' #' @usage my.acf(x) #' @usage my.ccf(a, b) #' @aliases my.acf my.ccf #' @param x,a,b time series #' @return The autocovariance function for all nonnegative lags or the #' cross-covariance function for all lags. #' @author B. Whitcher #' @keywords ts #' @examples #' #' data(ibm) #' ibm.returns <- diff(log(ibm)) #' plot(1:length(ibm.returns) - 1, my.acf(ibm.returns), type="h", #' xlab="lag", ylab="ACVS", main="Autocovariance Sequence for IBM Returns") #' #' @export my.acf my.acf <- function(x) { n <- length(x) x <- c(x, rep(0, n)) Re(fft(Mod(fft(x)) ^ 2, inverse = TRUE) / 2 / n ^ 2)[1:n] } my.ccf <- function(a, b) { n <- length(a) a <- c(a, rep(0, n)) b <- c(b, rep(0, n)) x <- Re(fft(fft(a) * Conj(fft(b)), inverse = TRUE)) / 2 / n ^ 2 x[c((n + 2):(2 * n), 1:n)] } waveslim/R/dwt.R0000644000176200001440000005033714627073455013250 0ustar liggesusers#' Discrete Wavelet Transform (DWT) #' #' This function performs a level \eqn{J} decomposition of the input vector or #' time series using the pyramid algorithm (Mallat 1989). #' #' The code implements the one-dimensional DWT using the pyramid algorithm #' (Mallat, 1989). The actual transform is performed in C using pseudocode #' from Percival and Walden (2001). That means convolutions, not inner #' products, are used to apply the wavelet filters. #' #' For a non-dyadic length vector or time series, \code{dwt.nondyadic} pads #' with zeros, performs the orthonormal DWT on this dyadic length series and #' then truncates the wavelet coefficient vectors appropriately. #' #' @usage dwt(x, wf = "la8", n.levels = 4, boundary = "periodic") #' @usage dwt.nondyadic(x) #' @usage idwt(y) #' @aliases dwt dwt.nondyadic idwt #' @param x a vector or time series containing the data be to decomposed. This #' must be a dyadic length vector (power of 2). #' @param wf Name of the wavelet filter to use in the decomposition. By #' default this is set to \code{"la8"}, the Daubechies orthonormal compactly #' supported wavelet of length L=8 (Daubechies, 1992), least asymmetric family. #' @param n.levels Specifies the depth of the decomposition. This must be a #' number less than or equal to log(length(x),2). #' @param boundary Character string specifying the boundary condition. If #' \code{boundary=="periodic"} the default, then the vector you decompose is #' assumed to be periodic on its defined interval,\cr if #' \code{boundary=="reflection"}, the vector beyond its boundaries is assumed #' to be a symmetric reflection of itself. #' @param y An object of S3 class \code{dwt}. #' @return Basically, a list with the following components #' \item{d?}{Wavelet coefficient vectors.} #' \item{s?}{Scaling coefficient vector.} #' \item{wavelet}{Name of the wavelet filter used.} #' \item{boundary}{How the boundaries were handled.} #' @author B. Whitcher #' @seealso \code{\link{modwt}}, \code{\link{mra}}. #' @references Daubechies, I. (1992) \emph{Ten Lectures on Wavelets}, CBMS-NSF #' Regional Conference Series in Applied Mathematics, SIAM: Philadelphia. #' #' Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to #' Wavelets and Other Filtering Methods in Finance and Economics}, Academic #' Press. #' #' Mallat, S. G. (1989) A theory for multiresolution signal decomposition: the #' wavelet representation, \emph{IEEE Transactions on Pattern Analysis and #' Machine Intelligence}, \bold{11}(7), 674--693. #' #' Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time #' Series Analysis}, Cambridge University Press. #' @keywords ts #' @examples #' #' ## Figures 4.17 and 4.18 in Gencay, Selcuk and Whitcher (2001). #' data(ibm) #' ibm.returns <- diff(log(ibm)) #' ## Haar #' ibmr.haar <- dwt(ibm.returns, "haar") #' names(ibmr.haar) <- c("w1", "w2", "w3", "w4", "v4") #' ## plot partial Haar DWT for IBM data #' par(mfcol=c(6,1), pty="m", mar=c(5-2,4,4-2,2)) #' plot.ts(ibm.returns, axes=FALSE, ylab="", main="(a)") #' for(i in 1:4) #' plot.ts(up.sample(ibmr.haar[[i]], 2^i), type="h", axes=FALSE, #' ylab=names(ibmr.haar)[i]) #' plot.ts(up.sample(ibmr.haar$v4, 2^4), type="h", axes=FALSE, #' ylab=names(ibmr.haar)[5]) #' axis(side=1, at=seq(0,368,by=23), #' labels=c(0,"",46,"",92,"",138,"",184,"",230,"",276,"",322,"",368)) #' ## LA(8) #' ibmr.la8 <- dwt(ibm.returns, "la8") #' names(ibmr.la8) <- c("w1", "w2", "w3", "w4", "v4") #' ## must shift LA(8) coefficients #' ibmr.la8$w1 <- c(ibmr.la8$w1[-c(1:2)], ibmr.la8$w1[1:2]) #' ibmr.la8$w2 <- c(ibmr.la8$w2[-c(1:2)], ibmr.la8$w2[1:2]) #' for(i in names(ibmr.la8)[3:4]) #' ibmr.la8[[i]] <- c(ibmr.la8[[i]][-c(1:3)], ibmr.la8[[i]][1:3]) #' ibmr.la8$v4 <- c(ibmr.la8$v4[-c(1:2)], ibmr.la8$v4[1:2]) #' ## plot partial LA(8) DWT for IBM data #' par(mfcol=c(6,1), pty="m", mar=c(5-2,4,4-2,2)) #' plot.ts(ibm.returns, axes=FALSE, ylab="", main="(b)") #' for(i in 1:4) #' plot.ts(up.sample(ibmr.la8[[i]], 2^i), type="h", axes=FALSE, #' ylab=names(ibmr.la8)[i]) #' plot.ts(up.sample(ibmr.la8$v4, 2^4), type="h", axes=FALSE, #' ylab=names(ibmr.la8)[5]) #' axis(side=1, at=seq(0,368,by=23), #' labels=c(0,"",46,"",92,"",138,"",184,"",230,"",276,"",322,"",368)) #' #' @export dwt dwt <- function(x, wf="la8", n.levels=4, boundary="periodic") { switch(boundary, "reflection" = x <- c(x, rev(x)), "periodic" = invisible(), stop("Invalid boundary rule in dwt")) N <- length(x) J <- n.levels if(N/2^J != trunc(N/2^J)) stop("Sample size is not divisible by 2^J") if(2^J > N) stop("wavelet transform exceeds sample size in dwt") dict <- wave.filter(wf) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf storage.mode(h) <- "double" g <- dict$lpf storage.mode(g) <- "double" y <- vector("list", J+1) names(y) <- c(paste("d", 1:J, sep=""), paste("s", J, sep="")) for(j in 1:J) { W <- V <- numeric(N/2^j) out <- .C(C_dwt, as.double(x), as.integer(N/2^(j-1)), L, h, g, W=as.double(W), V=as.double(V))[6:7] y[[j]] <- out$W x <- out$V } y[[J+1]] <- x class(y) <- "dwt" attr(y, "wavelet") <- wf attr(y, "boundary") <- boundary return(y) } dwt.nondyadic <- function(x) { M <- length(x) N <- 2^(ceiling(log(M, 2))) xx <- c(x, rep(0, N - M)) y <- dwt(xx) J <- length(y) - 1 for(j in 1:J) y[[j]] <- y[[j]][1:trunc(M/2^j)] return(y) } idwt <- function(y) { ctmp <- class(y) if(is.null(ctmp) || all(ctmp != "dwt")) stop("argument `y' is not of class \"dwt\"") J <- length(y) - 1 dict <- wave.filter(attributes(y)$wavelet) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf storage.mode(h) <- "double" g <- dict$lpf storage.mode(g) <- "double" jj <- paste("s", J, sep="") X <- y[[jj]] for(j in J:1) { jj <- paste("d", j, sep="") N <- length(X) XX <- numeric(2 * length(y[[jj]])) X <- .C(C_idwt, as.double(y[[jj]]), as.double(X), as.integer(N), L, h, g, out=as.double(XX))$out } if(attr(y, "boundary") == "reflection") return(X[1:N]) else return(X) } #' (Inverse) Maximal Overlap Discrete Wavelet Transform #' #' This function performs a level \eqn{J} decomposition of the input vector #' using the non-decimated discrete wavelet transform. The inverse transform #' performs the reconstruction of a vector or time series from its maximal #' overlap discrete wavelet transform. #' #' The code implements the one-dimensional non-decimated DWT using the pyramid #' algorithm. The actual transform is performed in C using pseudocode from #' Percival and Walden (2001). That means convolutions, not inner products, #' are used to apply the wavelet filters. #' #' The MODWT goes by several names in the statistical and engineering #' literature, such as, the ``stationary DWT'', ``translation-invariant DWT'', #' and ``time-invariant DWT''. #' #' The inverse MODWT implements the one-dimensional inverse transform using the #' pyramid algorithm (Mallat, 1989). #' #' @usage modwt(x, wf = "la8", n.levels = 4, boundary = "periodic") #' @usage imodwt(y) #' @aliases modwt imodwt #' @param x a vector or time series containing the data be to decomposed. #' There is \bold{no} restriction on its length. #' @param y Object of class \code{"modwt"}. #' @param wf Name of the wavelet filter to use in the decomposition. By #' default this is set to \code{"la8"}, the Daubechies orthonormal compactly #' supported wavelet of length L=8 (Daubechies, 1992), least asymmetric family. #' @param n.levels Specifies the depth of the decomposition. This must be a #' number less than or equal to log(length(x),2). #' @param boundary Character string specifying the boundary condition. If #' \code{boundary=="periodic"} the defaulTRUE, then the vector you decompose is #' assumed to be periodic on its defined interval,\cr if #' \code{boundary=="reflection"}, the vector beyond its boundaries is assumed #' to be a symmetric reflection of itself. #' @param y an object of class \code{"modwt"} #' @return Basically, a list with the following components #' \item{d?}{Wavelet coefficient vectors.} #' \item{s?}{Scaling coefficient vector.} #' \item{wavelet}{Name of the wavelet filter used.} #' \item{boundary}{How the boundaries were handled.} #' @author B. Whitcher #' @seealso \code{\link{dwt}}, \code{\link{idwt}}, \code{\link{mra}}. #' @references Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An #' Introduction to Wavelets and Other Filtering Methods in Finance and #' Economics}, Academic Press. #' #' Percival, D. B. and P. Guttorp (1994) Long-memory processes, the Allan #' variance and wavelets, In \emph{Wavelets and Geophysics}, pages 325-344, #' Academic Press. #' #' Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time #' Series Analysis}, Cambridge University Press. #' @keywords ts #' @examples #' #' ## Figure 4.23 in Gencay, Selcuk and Whitcher (2001) #' data(ibm) #' ibm.returns <- diff(log(ibm)) #' # Haar #' ibmr.haar <- modwt(ibm.returns, "haar") #' names(ibmr.haar) <- c("w1", "w2", "w3", "w4", "v4") #' # LA(8) #' ibmr.la8 <- modwt(ibm.returns, "la8") #' names(ibmr.la8) <- c("w1", "w2", "w3", "w4", "v4") #' # shift the MODWT vectors #' ibmr.la8 <- phase.shift(ibmr.la8, "la8") #' ## plot partial MODWT for IBM data #' par(mfcol=c(6,1), pty="m", mar=c(5-2,4,4-2,2)) #' plot.ts(ibm.returns, axes=FALSE, ylab="", main="(a)") #' for(i in 1:5) #' plot.ts(ibmr.haar[[i]], axes=FALSE, ylab=names(ibmr.haar)[i]) #' axis(side=1, at=seq(0,368,by=23), #' labels=c(0,"",46,"",92,"",138,"",184,"",230,"",276,"",322,"",368)) #' par(mfcol=c(6,1), pty="m", mar=c(5-2,4,4-2,2)) #' plot.ts(ibm.returns, axes=FALSE, ylab="", main="(b)") #' for(i in 1:5) #' plot.ts(ibmr.la8[[i]], axes=FALSE, ylab=names(ibmr.la8)[i]) #' axis(side=1, at=seq(0,368,by=23), #' labels=c(0,"",46,"",92,"",138,"",184,"",230,"",276,"",322,"",368)) #' #' @export modwt modwt <- function(x, wf="la8", n.levels=4, boundary="periodic") { switch(boundary, "reflection" = x <- c(x, rev(x)), "periodic" = invisible(), stop("Invalid boundary rule in modwt")) N <- length(x) storage.mode(N) <- "integer" J <- n.levels if(2^J > N) stop("wavelet transform exceeds sample size in modwt") dict <- wave.filter(wf) L <- dict$length storage.mode(L) <- "integer" ht <- dict$hpf / sqrt(2) storage.mode(ht) <- "double" gt <- dict$lpf / sqrt(2) storage.mode(gt) <- "double" y <- vector("list", J+1) names(y) <- c(paste("d", 1:J, sep=""), paste("s", J, sep="")) W <- V <- numeric(N) storage.mode(W) <- "double" storage.mode(V) <- "double" for(j in 1:J) { out <- .C(C_modwt, as.double(x), N, as.integer(j), L, ht, gt, W=W, V=V)[7:8] y[[j]] <- out$W x <- out$V } y[[J+1]] <- x class(y) <- "modwt" attr(y, "wavelet") <- wf attr(y, "boundary") <- boundary return(y) } imodwt <- function(y) { ctmp <- class(y) if(is.null(ctmp) || all(ctmp != "modwt")) stop("argument `y' is not of class \"modwt\"") J <- length(y) - 1 dict <- wave.filter(attributes(y)$wavelet) L <- dict$length storage.mode(L) <- "integer" ht <- dict$hpf / sqrt(2) storage.mode(ht) <- "double" gt <- dict$lpf / sqrt(2) storage.mode(gt) <- "double" jj <- paste("s", J, sep="") X <- y[[jj]] N <- length(X) storage.mode(N) <- "integer" XX <- numeric(N) storage.mode(XX) <- "double" for(j in J:1) { jj <- paste("d", j, sep="") X <- .C(C_imodwt, as.double(y[[jj]]), as.double(X), N, as.integer(j), L, ht, gt, out=XX)$out } if(attr(y, "boundary") == "reflection") return(X[1:(N/2)]) else return(X) } #' Replace Boundary Wavelet Coefficients with Missing Values #' #' Sets the first \eqn{n} wavelet coefficients to \code{NA}. #' #' The fact that observed time series are finite causes boundary issues. One #' way to get around this is to simply remove any wavelet coefficient computed #' involving the boundary. This is done here by replacing boundary wavelet #' coefficients with \code{NA}. #' #' @usage brick.wall(x, wf, method = "modwt") #' @usage dwpt.brick.wall(x, wf, n.levels, method = "modwpt") #' @usage brick.wall.2d(x, method = "modwt") #' @aliases brick.wall dwpt.brick.wall brick.wall.2d #' @param x DWT/MODWT/DWPT/MODWPT object #' @param wf Character string; name of wavelet filter #' @param n.levels Specifies the depth of the decomposition. This must be a #' number less than or equal to log(length(x),2). #' @param method Either \code{\link{dwt}} or \code{\link{modwt}} for #' \code{brick.wall}, or either \code{\link{dwpt}} or \code{\link{modwpt}} for #' \code{dwpt.brick.wall} #' @return Same object as \code{x} only with some missing values. #' @author B. Whitcher #' @references Lindsay, R. W., D. B. Percival and D. A. Rothrock (1996). The #' discrete wavelet transform and the scale anlaysis of the surface properties #' of sea ice, \emph{IEEE Transactions on Geoscience and Remote Sensing}, #' \bold{34}, No. 3, 771-787. #' #' Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time #' Series Analysis}, Cambridge University Press. #' @keywords ts #' @export brick.wall brick.wall <- function(x, wf, method = "modwt") { m <- wave.filter(wf)$length for (j in 1:(length(x) - 1)) { if (method == "dwt") { n <- ceiling((m - 2) * (1 - 1 / 2 ^ j)) } else { n <- (2^j - 1) * (m - 1) } n <- min(n, length(x[[j]])) x[[j]][1:n] <- NA } x[[j + 1]][1:n] <- NA return(x) } #' Phase Shift Wavelet Coefficients #' #' Wavelet coefficients are circularly shifted by the amount of phase shift #' induced by the wavelet transform. #' #' The center-of-energy argument of Hess-Nielsen and Wickerhauser (1996) is #' used to provide a flexible way to circularly shift wavelet coefficients #' regardless of the wavelet filter used. The results are not identical to #' those used by Percival and Walden (2000), but are more flexible. #' #' \code{phase.shift.packet} is not yet implemented fully. #' #' @usage phase.shift(z, wf, inv = FALSE) #' @usage phase.shift.packet(z, wf, inv = FALSE) #' @aliases phase.shift phase.shift.packet #' @param z DWT object #' @param wf character string; wavelet filter used in DWT #' @param inv Boolean variable; if \code{inv=TRUE} then the inverse phase shift #' is applied #' @return DWT (DWPT) object with coefficients circularly shifted. #' @author B. Whitcher #' @references Hess-Nielsen, N. and M. V. Wickerhauser (1996) Wavelets and #' time-frequency analysis, \emph{Proceedings of the IEEE}, \bold{84}, No. 4, #' 523-540. #' #' Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time #' Series Analysis}, Cambridge University Press. #' @keywords ts #' @export phase.shift phase.shift <- function(z, wf, inv = FALSE) { coe <- function(g) sum(0:(length(g)-1) * g^2) / sum(g^2) J <- length(z) - 1 g <- wave.filter(wf)$lpf h <- wave.filter(wf)$hpf if(!inv) { for(j in 1:J) { ph <- round(2^(j-1) * (coe(g) + coe(h)) - coe(g), 0) Nj <- length(z[[j]]) z[[j]] <- c(z[[j]][(ph + 1):Nj], z[[j]][1:ph]) } ph <- round((2^J-1) * coe(g), 0) J <- J + 1 z[[J]] <- c(z[[J]][(ph + 1):Nj], z[[J]][1:ph]) } else { for(j in 1:J) { ph <- round(2^(j-1) * (coe(g) + coe(h)) - coe(g), 0) Nj <- length(z[[j]]) z[[j]] <- c(z[[j]][(Nj - ph + 1):Nj], z[[j]][1:(Nj - ph)]) } ph <- round((2^J-1) * coe(g), 0) J <- J + 1 z[[J]] <- c(z[[J]][(Nj - ph + 1):Nj], z[[J]][1:(Nj - ph)]) } return(z) } #' Multiresolution Analysis of Time Series #' #' This function performs a level \eqn{J} additive decomposition of the input #' vector or time series using the pyramid algorithm (Mallat 1989). #' #' This code implements a one-dimensional multiresolution analysis introduced #' by Mallat (1989). Either the DWT or MODWT may be used to compute the #' multiresolution analysis, which is an additive decomposition of the original #' time series. #' #' @param x A vector or time series containing the data be to decomposed. This #' must be a dyadic length vector (power of 2) for \code{method="dwt"}. #' @param wf Name of the wavelet filter to use in the decomposition. By #' default this is set to \code{"la8"}, the Daubechies orthonormal compactly #' supported wavelet of length L=8 least asymmetric family. #' @param J Specifies the depth of the decomposition. This must be a number #' less than or equal to log(length(x), 2). #' @param method Either \code{"dwt"} or \code{"modwt"}. #' @param boundary Character string specifying the boundary condition. If #' \code{boundary=="periodic"} the default, then the vector you decompose is #' assumed to be periodic on its defined interval,\cr if #' \code{boundary=="reflection"}, the vector beyond its boundaries is assumed #' to be a symmetric reflection of itself. #' @return Basically, a list with the following components \item{D?}{Wavelet #' detail vectors.} \item{S?}{Wavelet smooth vector.} \item{wavelet}{Name of #' the wavelet filter used.} \item{boundary}{How the boundaries were handled.} #' @author B. Whitcher #' @seealso \code{\link{dwt}}, \code{\link{modwt}}. #' @references Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An #' Introduction to Wavelets and Other Filtering Methods in Finance and #' Economics}, Academic Press. #' #' Mallat, S. G. (1989) A theory for multiresolution signal decomposition: the #' wavelet representation, \emph{IEEE Transactions on Pattern Analysis and #' Machine Intelligence}, \bold{11}, No. 7, 674-693. #' #' Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time #' Series Analysis}, Cambridge University Press. #' @keywords ts #' @examples #' #' ## Easy check to see if it works... #' x <- rnorm(32) #' x.mra <- mra(x) #' sum(x - apply(matrix(unlist(x.mra), nrow=32), 1, sum))^2 #' #' ## Figure 4.19 in Gencay, Selcuk and Whitcher (2001) #' data(ibm) #' ibm.returns <- diff(log(ibm)) #' ibm.volatility <- abs(ibm.returns) #' ## Haar #' ibmv.haar <- mra(ibm.volatility, "haar", 4, "dwt") #' names(ibmv.haar) <- c("d1", "d2", "d3", "d4", "s4") #' ## LA(8) #' ibmv.la8 <- mra(ibm.volatility, "la8", 4, "dwt") #' names(ibmv.la8) <- c("d1", "d2", "d3", "d4", "s4") #' ## plot multiresolution analysis of IBM data #' par(mfcol=c(6,1), pty="m", mar=c(5-2,4,4-2,2)) #' plot.ts(ibm.volatility, axes=FALSE, ylab="", main="(a)") #' for(i in 1:5) #' plot.ts(ibmv.haar[[i]], axes=FALSE, ylab=names(ibmv.haar)[i]) #' axis(side=1, at=seq(0,368,by=23), #' labels=c(0,"",46,"",92,"",138,"",184,"",230,"",276,"",322,"",368)) #' par(mfcol=c(6,1), pty="m", mar=c(5-2,4,4-2,2)) #' plot.ts(ibm.volatility, axes=FALSE, ylab="", main="(b)") #' for(i in 1:5) #' plot.ts(ibmv.la8[[i]], axes=FALSE, ylab=names(ibmv.la8)[i]) #' axis(side=1, at=seq(0,368,by=23), #' labels=c(0,"",46,"",92,"",138,"",184,"",230,"",276,"",322,"",368)) #' #' @export mra mra <- function(x, wf = "la8", J = 4, method = "modwt", boundary = "periodic") { switch(boundary, "reflection" = x <- c(x, rev(x)), "periodic" = invisible(), stop("Invalid boundary rule in mra")) n <- length(x) if(method == "modwt") x.wt <- modwt(x, wf, J, "periodic") else x.wt <- dwt(x, wf, J, "periodic") x.mra <- vector("list", J+1) ## Smooth zero <- vector("list", J+1) names(zero) <- c(paste("d", 1:J, sep = ""), paste("s", J, sep = "")) class(zero) <- method attr(zero, "wavelet") <- wf attr(zero, "boundary") <- boundary zero[[J+1]] <- x.wt[[J+1]] if(method == "modwt") { for(k in 1:J) zero[[k]] <- numeric(n) x.mra[[J+1]] <- imodwt(zero) } else { for(k in 1:J) zero[[k]] <- numeric(n/2^k) x.mra[[J+1]] <- idwt(zero) } ## Details for(j in J:1) { zero <- vector("list", j+1) names(zero) <- c(paste("d", 1:j, sep = ""), paste("s", j, sep = "")) class(zero) <- method attr(zero, "wavelet") <- wf attr(zero, "boundary") <- boundary zero[[j]] <- x.wt[[j]] if(method == "modwt") { if(j != 1) { for(k in c(j+1,(j-1):1)) zero[[k]] <- numeric(n) } else { zero[[j+1]] <- numeric(n) } x.mra[[j]] <- imodwt(zero) } else { zero[[j+1]] <- numeric(n/2^j) if(j != 1) { for(k in (j-1):1) zero[[k]] <- numeric(n/2^k) } x.mra[[j]] <- idwt(zero) } } names(x.mra) <- c(paste("D", 1:J, sep = ""), paste("S", J, sep = "")) if(boundary == "reflection") { for(j in (J+1):1) x.mra[[j]] <- x.mra[[j]][1:(n/2)] return(x.mra) } else { return(x.mra) } } waveslim/R/cascade.R0000644000176200001440000001342114627073455014026 0ustar liggesusers#' Higher-Order Wavelet Filters #' #' Create a wavelet filter at arbitrary scale. #' #' Uses \code{cascade} subroutine to compute higher-order wavelet coefficient #' vector from a given filtering sequence. #' #' @param wf.name Character string of wavelet filter. #' @param filter.seq Character string of filter sequence. \code{H} means #' high-pass filtering and \code{L} means low-pass filtering. Sequence is read #' from right to left. #' @param n Length of zero-padded filter. Frequency resolution will be #' \code{n}/2+1. #' @return Vector of wavelet coefficients. #' @author B. Whitcher #' @seealso \code{\link{squared.gain}}, \code{\link{wave.filter}}. #' @references Bruce, A. and H.-Y. Gao (1996). \emph{Applied Wavelet Analysis #' with S-PLUS}, Springer: New York. #' #' Doroslovacki, M. L. (1998) On the least asymmetric wavelets, \emph{IEEE #' Transactions on Signal Processing}, \bold{46}, No. 4, 1125-1130. #' #' Daubechies, I. (1992) \emph{Ten Lectures on Wavelets}, CBMS-NSF Regional #' Conference Series in Applied Mathematics, SIAM: Philadelphia. #' #' Morris and Peravali (1999) Minimum-bandwidth discrete-time wavelets, #' \emph{Signal Processing}, \bold{76}, No. 2, 181-193. #' #' Nielsen, M. (2001) On the Construction and Frequency Localization of Finite #' Orthogonal Quadrature Filters, \emph{Journal of Approximation Theory}, #' \bold{108}, No. 1, 36-52. #' @keywords ts #' @examples #' #' ## Figure 4.14 in Gencay, Selcuk and Whitcher (2001) #' par(mfrow=c(3,1), mar=c(5-2,4,4-1,2)) #' f.seq <- "HLLLLL" #' plot(c(rep(0,33), wavelet.filter("mb4", f.seq), rep(0,33)), type="l", #' xlab="", ylab="", main="D(4) in black, MB(4) in red") #' lines(c(rep(0,33), wavelet.filter("d4", f.seq), rep(0,33)), col=2) #' plot(c(rep(0,35), -wavelet.filter("mb8", f.seq), rep(0,35)), type="l", #' xlab="", ylab="", main="D(8) in black, -MB(8) in red") #' lines(c(rep(0,35), wavelet.filter("d8", f.seq), rep(0,35)), col=2) #' plot(c(rep(0,39), wavelet.filter("mb16", f.seq), rep(0,39)), type="l", #' xlab="", ylab="", main="D(16) in black, MB(16) in red") #' lines(c(rep(0,39), wavelet.filter("d16", f.seq), rep(0,39)), col=2) #' #' @export wavelet.filter wavelet.filter <- function(wf.name, filter.seq = "L", n = 512) { cascade <- function(f, x, j) { L <- length(f) N <- length(x) M <- (L - 1) * 2^j M1 <- M - L + 2 M2 <- 2 * M - L + 2 if(N > M1) stop("x is too long\n") else x <- c(x, rep(0, M1 - N)) xj <- c(rep(0, M), x, rep(0, M)) yj <- rep(0, M2) for(i in 1:L) yj <- yj + f[L - i + 1] * xj[1:M2 + (i - 1) * 2^j] yj } if(is.character(wf.name)) wf <- wave.filter(wf.name) else wf <- wf.name J <- nchar(filter.seq) key <- rev(substring(filter.seq, 1:J, 1:J)) f <- 1 fl <- wf$lpf fh <- wf$hpf for(k in 1:J) { if(key[k] == "H") f <- cascade(fh, f, k - 1) else if(key[k] == "L") f <- cascade(fl, f, k - 1) else stop("Invalid filter.seq\n") } f } #' Squared Gain Function of a Filter #' #' Produces the modulus squared of the Fourier transform for a given filtering #' sequence. #' #' Uses \code{cascade} subroutine to compute the squared gain function from a #' given filtering sequence. #' #' @param wf.name Character string of wavelet filter. #' @param filter.seq Character string of filter sequence. \code{H} means #' high-pass filtering and \code{L} means low-pass filtering. Sequence is read #' from right to left. #' @param n Length of zero-padded filter. Frequency resolution will be #' \code{n}/2+1. #' @return Squared gain function. #' @author B. Whitcher #' @seealso \code{\link{wave.filter}}, \code{\link{wavelet.filter}}. #' @keywords ts #' @examples #' #' par(mfrow=c(2,2)) #' f.seq <- "H" #' plot(0:256/512, squared.gain("d4", f.seq), type="l", ylim=c(0,2), #' xlab="frequency", ylab="L = 4", main="Level 1") #' lines(0:256/512, squared.gain("fk4", f.seq), col=2) #' lines(0:256/512, squared.gain("mb4", f.seq), col=3) #' abline(v=c(1,2)/4, lty=2) #' legend(-.02, 2, c("Daubechies", "Fejer-Korovkin", "Minimum-Bandwidth"), #' lty=1, col=1:3, bty="n", cex=1) #' f.seq <- "HL" #' plot(0:256/512, squared.gain("d4", f.seq), type="l", ylim=c(0,4), #' xlab="frequency", ylab="", main="Level 2") #' lines(0:256/512, squared.gain("fk4", f.seq), col=2) #' lines(0:256/512, squared.gain("mb4", f.seq), col=3) #' abline(v=c(1,2)/8, lty=2) #' f.seq <- "H" #' plot(0:256/512, squared.gain("d8", f.seq), type="l", ylim=c(0,2), #' xlab="frequency", ylab="L = 8", main="") #' lines(0:256/512, squared.gain("fk8", f.seq), col=2) #' lines(0:256/512, squared.gain("mb8", f.seq), col=3) #' abline(v=c(1,2)/4, lty=2) #' f.seq <- "HL" #' plot(0:256/512, squared.gain("d8", f.seq), type="l", ylim=c(0,4), #' xlab="frequency", ylab="", main="") #' lines(0:256/512, squared.gain("fk8", f.seq), col=2) #' lines(0:256/512, squared.gain("mb8", f.seq), col=3) #' abline(v=c(1,2)/8, lty=2) #' #' @export squared.gain squared.gain <- function(wf.name, filter.seq = "L", n = 512) { cascade <- function(f, x, j) { L <- length(f) N <- length(x) M <- (L - 1) * 2^j M1 <- M - L + 2 M2 <- 2 * M - L + 2 if(N > M1) stop("x is too long\n") else x <- c(x, rep(0, M1 - N)) xj <- c(rep(0, M), x, rep(0, M)) yj <- rep(0, M2) for(i in 1:L) yj <- yj + f[L - i + 1] * xj[1:M2 + (i - 1) * 2^j] yj } if(is.character(wf.name)) wf <- wave.filter(wf.name) else wf <- wf.name J <- nchar(filter.seq) key <- rev(substring(filter.seq, 1:J, 1:J)) f <- 1 fl <- wf$lpf fh <- wf$hpf for(k in 1:J) { if(key[k] == "H") f <- cascade(fh, f, k - 1) else if(key[k] == "L") f <- cascade(fl, f, k - 1) else stop("Invalid filter.seq\n") } Mod(fft(c(f, rep(0, n - length(f))))[1:(n/2 + 1)])^2 } waveslim/R/zzz.R0000644000176200001440000000046614627073455013305 0ustar liggesusers## .First.lib <- function(lib, pkg) library.dynam("waveslim", pkg, lib) .onAttach <- function(lib, pkg) { txt <- paste( "\n", pkg, ": Wavelet Method for 1/2/3D Signals (version = ", utils::packageDescription(pkg, lib)[["Version"]], ")\n", sep = "" ) packageStartupMessage(txt) } waveslim/R/denoise.R0000644000176200001440000002615014627073455014074 0ustar liggesusers#' Wavelet Shrinkage via Thresholding #' #' Perform wavelet shrinkage using data-analytic, hybrid SURE, manual, SURE, or #' universal thresholding. #' #' An extensive amount of literature has been written on wavelet shrinkage. #' The functions here represent the most basic approaches to the problem of #' nonparametric function estimation. See the references for further #' information. #' #' @usage da.thresh(wc, alpha = .05, max.level = 4, verbose = FALSE, return.thresh = FALSE) #' @usage hybrid.thresh(wc, max.level = 4, verbose = FALSE, seed = 0) #' @usage manual.thresh(wc, max.level = 4, value, hard = TRUE) #' @usage sure.thresh(wc, max.level = 4, hard = TRUE) #' @usage universal.thresh(wc, max.level = 4, hard = TRUE) #' @usage universal.thresh.modwt(wc, max.level = 4, hard = TRUE) #' @aliases Thresholding da.thresh hybrid.thresh manual.thresh sure.thresh #' universal.thresh universal.thresh.modwt bishrink soft #' @param wc wavelet coefficients #' @param alpha level of the hypothesis tests #' @param max.level maximum level of coefficients to be affected by threshold #' @param verbose if \code{verbose=TRUE} then information is printed to the #' screen #' @param value threshold value (only utilized in \code{manual.thresh}) #' @param hard Boolean value, if \code{hard=F} then soft thresholding is used #' @param seed sets random seed (only utilized in \code{hybrid.thresh}) #' @param return.thresh if \code{return.thresh=TRUE} then the vector of #' threshold values is returned, otherwise the surviving wavelet coefficients #' are returned #' @return The default output is a list structure, the same length as was #' input, containing only those wavelet coefficients surviving the threshold. #' @author B. Whitcher (some code taken from R. Todd Ogden) #' @references Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An #' Introduction to Wavelets and Other Filtering Methods in Finance and #' Economics}, Academic Press. #' #' Ogden, R. T. (1996) \emph{Essential Wavelets for Statistical Applications #' and Data Analysis}, Birkhauser. #' #' Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time #' Series Analysis}, Cambridge University Press. #' #' Vidakovic, B. (1999) \emph{Statistical Modeling by Wavelets}, John Wiley and #' Sons. #' @keywords ts manual.thresh <- function(wc, max.level=4, value, hard=TRUE) { wc.fine <- wc[["d1"]] factor <- median(abs(wc.fine)) / .6745 wc.shrink <- wc if(hard) { # Hard thresholding for(i in names(wc)[1:max.level]) { wci <- wc[[i]] unithresh <- factor * value wc.shrink[[i]] <- wci * (abs(wci) > unithresh) } } else { # Soft thresholding for(i in names(wc)[1:max.level]) { wci <- wc[[i]] unithresh <- factor * value wc.shrink[[i]] <- sign(wci) * (abs(wci) - unithresh) * (abs(wci) > unithresh) } } wc.shrink } universal.thresh <- function(wc, max.level=4, hard=TRUE) { n <- length(idwt(wc)) wc.fine <- wc[["d1"]] factor <- median(abs(wc.fine)) / .6745 wc.shrink <- wc if(hard) { # Hard thresholding for(i in names(wc)[1:max.level]) { wci <- wc[[i]] unithresh <- factor * sqrt(2 * log(n)) wc.shrink[[i]] <- wci * (abs(wci) > unithresh) } } else { # Soft thresholding for(i in names(wc)[1:max.level]) { wci <- wc[[i]] unithresh <- factor * sqrt(2 * log(n)) wc.shrink[[i]] <- sign(wci) * (abs(wci) - unithresh) * (abs(wci) > unithresh) } } wc.shrink } universal.thresh.modwt <- function(wc, max.level=4, hard=TRUE) { n <- length(wc[[1]]) wc.fine <- wc[["d1"]] factor <- sqrt(2) * median(abs(wc.fine)) / .6745 wc.shrink <- wc j <- 1 if(hard) { ## Hard thresholding for(i in names(wc)[1:max.level]) { wci <- wc[[i]] unithresh <- factor * sqrt(2 * log(n)) / 2^(j/2) wc.shrink[[i]] <- wci * (abs(wci) > unithresh) j <- j+1 } } else { ## Soft thresholding for(i in names(wc)[1:max.level]) { wci <- wc[[i]] unithresh <- factor * sqrt(2 * log(n)) / 2^(j/2) wc.shrink[[i]] <- sign(wci) * (abs(wci) - unithresh) * (abs(wci) > unithresh) j <- j+1 } } wc.shrink } sure.thresh <- function(wc, max.level=4, hard=TRUE) { wc.shrink <- wc sure <- function(t, x) { ax <- sort(abs(x)) num <- match(FALSE, ax <= t, nomatch = length(ax) + 1) - 1 length(ax) - 2 * num + sum(pmin(ax, t)^2) } for(i in names(wc)[1:max.level]) { wci <- wc[[i]] ni <- length(wci) factor <- median(abs(wci)) / .6745 xi <- wci / factor sxi <- sort(abs(xi))^2 s <- cumsum(sxi) + ((ni - 1):0) * sxi risk <- (ni - (2 * (1:ni)) + s) / ni surethresh <- sqrt(sxi[order(risk)[1]]) if(hard) { ## Hard thresholding wc.shrink[[i]] <- wci * (abs(xi) > surethresh) } else { ## Soft thresholding wc.shrink[[i]] <- sign(wci) * (abs(wci) - factor*surethresh) * (abs(xi) > surethresh) } } return(wc.shrink) } hybrid.thresh <- function(wc, max.level = 4, verbose = FALSE, seed = 0) { shrinkit <- function(coeffs, thresh) sign(coeffs) * pmax(abs(coeffs) - thresh, 0) sure <- function(t, x) { ax <- sort(abs(x)) num <- match(FALSE, ax <= t, nomatch = length(ax) + 1) - 1 length(ax) - 2 * num + sum(pmin(ax, t)^2) } wc.shrink <- wc n <- length(unlist(wc)) nlev <- log(n + 1, 2) - 1 i <- 1 iloc <- 1 while(i <= max.level) { ## Extract current level coefficients from all wavelet coefficients raw <- wc[[names(wc)[i]]] d <- length(raw) ## Test: if the variance is small enough, just use threshold sqrt(2logd) if((sum(raw^2) - d)/d <= sqrt(i^3/2^i)) { if(verbose) cat(paste("At level ", i, " the threshhold is sqrt(2log(d)): ", sqrt(2 * log(d)), "\n", sep = "")) wc.shrink[[names(wc)[i]]] <- shrinkit(wc[[names(wc)[i]]], sqrt(2*log(d))) } else { ## Generate random subset if(length(seed) != 1) .Random.seed <- seed Iset <- sort(sample(d, d/2)) rawI <- raw[Iset] / (median(abs(raw[Iset])) / .6745) rawIp <- raw[ - Iset] / (median(abs(raw[ - Iset])) / .6745) ggI <- sort(abs(rawI)) ggIp <- sort(abs(rawIp)) ## Calculate SURE for all possible thresholds surevecI <- sapply(c(ggI[ggI < sqrt(2 * log(d))], 0, sqrt(2 * log(d))), sure, ggI) surevecIp <- sapply(c(ggIp[ggI < sqrt(2 * log(d))], 0, sqrt(2 * log(d))), sure, ggIp) ## Threshold that minimizes risk llI <- length(surevecI) llIp <- length(surevecIp) ## The minimum occurs either at sqrt(2logd), if(min(surevecI) == surevecI[llI]) threshI <- sqrt(2 * log(d)) else if(min(surevecI) == surevecI[llI - 1]) threshI <- 0 else threshI <- ggI[match(min(surevecI), surevecI)] ## or at 0, if(min(surevecIp) == surevecIp[llIp]) threshIp <- sqrt(2 * log(d)) else if(min(surevecIp) == surevecI[llIp - 1]) threshIp <- 0 else threshIp <- ggIp[match(min(surevecIp), surevecIp)] ## or at 0, if(verbose) { cat(paste("At level ", i, ", threshold1 is ", threshI, "\n", sep = "")) cat(paste("At level ", i, ", threshold2 is ", threshIp, "\n", sep = "")) } ## Perform shrinking newI <- shrinkit(rawI, threshIp) newIp <- shrinkit(rawIp, threshI) new <- rep(0, d) new[Iset] <- newI new[ - Iset] <- newIp wc.shrink[[names(wc)[i]]] <- new } ## Otherwise, go through all this stuff iloc <- iloc + 2^i i <- i + 1 } wc.shrink } da.thresh <- function(wc, alpha=.05, max.level=4, verbose=FALSE, return.thresh=FALSE) { onebyone2 <- function(dat, alpha) { kolsmi.chi2 <- function(dat) { n <- length(dat) return(max(abs(cumsum(dat)-(1:n)*sum(dat)/n))/sqrt(2*n)) } crit <- c(seq(0.28,1.49,by=.01), seq(1.50,2.48,by=.02)) alph <- c(.999999,.999996,.999991,.999979,.999954,.999909,.999829, .999697,.999489,.999174,.998715,.998071,.997192,.996028, .994524,.992623,.990270,.987410,.983995,.979978,.975318, .969983,.963945,.957186,.949694,.941466,.932503,.922817, .912423,.901344,.889605,.877240,.864282,.850771,.836775, .822247,.807323,.792013,.776363,.760418,.744220,.727811, .711235,.694529,.677735,.660887,.644019,.627167,.610360, .593628,.576998,.560495,.544143,.527959,.511970,.496192, .480634,.465318,.450256,.435454,.420930,.406684,.392730, .379072,.365714,.352662,.339918,.327484,.315364,.303556, .292060,.280874,.270000,.259434,.249174,.239220,.229566, .220206,.211140,.202364,.193872,.185658,.177718,.170050, .162644,.155498,.148606,.141962,.135558,.129388,.123452, .117742,.112250,.106970,.101896,.097028,.092352,.087868, .083568,.079444,.075495,.071712,.068092,.064630,.061318, .058152,.055128,.052244,.049488,.046858,.044350,.041960, .039682,.037514,.035448,.033484,.031618,.029842,.028154, .026552,.025030,.023588,.022218,.019690,.017422,.015390, .013574,.011952,.010508,.009223,.008083,.007072,.006177, .005388,.004691,.004078,.003540,.003068,.002654,.002293, .001977,.001703,.001464,.001256,.001076,.000921,.000787, .000671,.000572,.000484,.000412,.000350,.000295,.000250, .000210,.000178,.000148,.000126,.000104,.000088,.000074, .000060,.000051,.000042,.000035,.000030,.000024,.000020, .000016,.000013,.000011,.000009) if(alpha < min(alph) || alpha > max(alph)) stop("alpha =",alpha,"is out of range") ind <- match(TRUE, alpha > alph) critval <- crit[ind-1]+(alph[ind-1]-alpha)*(crit[ind]-crit[ind-1]) / (alph[ind-1]-alph[ind]) i <- length(dat) cc <- kolsmi.chi2(dat) while(cc[length(cc)] > critval && i > 1) { i <- i-1 cc <- c(cc,kolsmi.chi2(dat[sort(order(dat)[1:i])])) } return(cc) } getthrda2 <- function(dat, alpha) { a <- onebyone2(dat, alpha) if(length(a) == length(dat)) if(1 - pchisq(min(dat),1) < alpha) ggg <- 0 else ggg <- sqrt(min(dat)) else ggg <- sqrt(max(dat[sort(order(dat)[1:(length(dat)-length(a)+1)])])) return(ggg) } shrinkit <- function(coeffs, thresh) sign(coeffs) * pmax(abs(coeffs) - thresh, 0) if(alpha <= .000009 || alpha >= .999999) stop("alpha out of range") ans <- wc n <- length(unlist(wc)) nlev <- log(n+1, 2)-1 i <- 1 iloc <- 1 while(i <= max.level) { gg <- wc[[names(wc)[i]]] thresh <- getthrda2(gg^2,alpha) if(verbose) cat(paste("At level ",i,", the threshold is ",thresh, "\n",sep="")) if(return.thresh) if(i == nlev) rt <- thresh else rt <- c(thresh, rt) else ans[[names(wc)[i]]] <- shrinkit(wc[[names(wc)[i]]], thresh) iloc <- iloc + 2^i i <- i+1 } if(return.thresh) return(rt) else return(ans) } waveslim/R/Anton.R0000644000176200001440000000505514627073455013526 0ustar liggesusersAntonB <- function() { a0 <- c(0, 0.02674875741081, -0.01686411844287, -0.07822326652899, 0.26686411844288, 0.60294901823636, 0.26686411844287, -0.07822326652899, -0.01686411844287, 0.02674875741081, 0, 0) a1 <- c(0, 0, 0, 0.04563588155712, -0.02877176311425, -0.29563588155712, 0.55754352622850, -0.29563588155713, -0.02877176311425, 0.04563588155712, 0, 0) s0 <- c(0, 0, 0, -0.04563588155712, -0.02877176311425, 0.29563588155712, 0.55754352622850, 0.29563588155713, -0.02877176311425, -0.04563588155712, 0, 0) s1 <- c(0, 0.02674875741081, 0.01686411844287, -0.07822326652899, -0.26686411844288, 0.60294901823636, -0.26686411844287, -0.07822326652899, 0.01686411844287, 0.02674875741081, 0, 0) s0 <- 2 * s0 s1 <- 2 * s1 aa0 <- c(0, 0, 0.02674875741081, -0.01686411844287, -0.07822326652899, 0.26686411844288, 0.60294901823636, 0.26686411844287, -0.07822326652899, -0.01686411844287, 0.02674875741081, 0) aa1 <- c(0, 0, 0, 0, 0.04563588155712, -0.02877176311425, -0.29563588155712, 0.55754352622850, -0.29563588155713, -0.02877176311425, 0.04563588155712, 0) ss0 <- c(0, 0, -0.04563588155712, -0.02877176311425, 0.29563588155712, 0.55754352622850, 0.29563588155713, -0.02877176311425, -0.04563588155712, 0, 0, 0) ss1 <- c(0.02674875741081, 0.01686411844287, -0.07822326652899, -0.26686411844288, 0.60294901823636, -0.26686411844287, -0.07822326652899, 0.01686411844287, 0.02674875741081, 0, 0, 0) ss0 <- 2 * ss0 ss1 <- 2 * ss1 list(af = list(cbind(a0, a1), cbind(aa0, aa1)), sf = list(cbind(s0, s1), cbind(ss0, ss1))) } waveslim/R/cov.R0000644000176200001440000003235414627102620013223 0ustar liggesusers#' Wavelet Analysis of Univariate/Bivariate Time Series #' #' Produces an estimate of the multiscale variance, covariance or correlation #' along with approximate confidence intervals. #' #' The time-independent wavelet variance is basically the average of the #' squared wavelet coefficients across each scale. As shown in Percival #' (1995), the wavelet variance is a scale-by-scale decomposition of the #' variance for a stationary process, and certain non-stationary processes. #' #' @usage wave.variance(x, type = "eta3", p = 0.025) #' @usage wave.covariance(x, y) #' @usage wave.correlation(x, y, N, p = 0.975) #' @aliases wave.variance wave.covariance wave.correlation #' @param x first time series #' @param y second time series #' @param type character string describing confidence interval calculation; #' valid methods are \code{gaussian}, \code{eta1}, \code{eta2}, \code{eta3}, #' \code{nongaussian} #' @param p (one minus the) two-sided p-value for the confidence interval #' @param N length of time series #' @return Matrix with as many rows as levels in the wavelet transform object. #' The first column provides the point estimate for the wavelet variance, #' covariance, or correlation followed by the lower and upper bounds from the #' confidence interval. #' @author B. Whitcher #' @references Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An #' Introduction to Wavelets and Other Filtering Methods in Finance and #' Economics}, Academic Press. #' #' Percival, D. B. (1995) \emph{Biometrika}, \bold{82}, No. 3, 619-631. #' #' Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time #' Series Analysis}, Cambridge University Press. #' #' Whitcher, B., P. Guttorp and D. B. Percival (2000) Wavelet Analysis of #' Covariance with Application to Atmospheric Time Series, \emph{Journal of #' Geophysical Research}, \bold{105}, No. D11, 14,941-14,962. #' @keywords ts #' @examples #' #' ## Figure 7.3 from Gencay, Selcuk and Whitcher (2001) #' data(ar1) #' ar1.modwt <- modwt(ar1, "haar", 6) #' ar1.modwt.bw <- brick.wall(ar1.modwt, "haar") #' ar1.modwt.var2 <- wave.variance(ar1.modwt.bw, type="gaussian") #' ar1.modwt.var <- wave.variance(ar1.modwt.bw, type="nongaussian") #' par(mfrow=c(1,1), las=1, mar=c(5,4,4,2)+.1) #' matplot(2^(0:5), ar1.modwt.var2[-7,], type="b", log="xy", #' xaxt="n", ylim=c(.025, 6), pch="*LU", lty=1, col=c(1,4,4), #' xlab="Wavelet Scale", ylab="") #' matlines(2^(0:5), as.matrix(ar1.modwt.var)[-7,2:3], type="b", #' pch="LU", lty=1, col=3) #' axis(side=1, at=2^(0:5)) #' legend(1, 6, c("Wavelet variance", "Gaussian CI", "Non-Gaussian CI"), #' lty=1, col=c(1,4,3), bty="n") #' #' ## Figure 7.8 from Gencay, Selcuk and Whitcher (2001) #' data(exchange) #' returns <- diff(log(as.matrix(exchange))) #' returns <- ts(returns, start=1970, freq=12) #' wf <- "d4" #' J <- 6 #' demusd.modwt <- modwt(returns[,"DEM.USD"], wf, J) #' demusd.modwt.bw <- brick.wall(demusd.modwt, wf) #' jpyusd.modwt <- modwt(returns[,"JPY.USD"], wf, J) #' jpyusd.modwt.bw <- brick.wall(jpyusd.modwt, wf) #' returns.modwt.cov <- wave.covariance(demusd.modwt.bw, jpyusd.modwt.bw) #' par(mfrow=c(1,1), las=0, mar=c(5,4,4,2)+.1) #' matplot(2^(0:(J-1)), returns.modwt.cov[-(J+1),], type="b", log="x", #' pch="*LU", xaxt="n", lty=1, col=c(1,4,4), xlab="Wavelet Scale", #' ylab="Wavelet Covariance") #' axis(side=1, at=2^(0:7)) #' abline(h=0) #' #' returns.modwt.cor <- wave.correlation(demusd.modwt.bw, jpyusd.modwt.bw, #' N = dim(returns)[1]) #' par(mfrow=c(1,1), las=0, mar=c(5,4,4,2)+.1) #' matplot(2^(0:(J-1)), returns.modwt.cor[-(J+1),], type="b", log="x", #' pch="*LU", xaxt="n", lty=1, col=c(1,4,4), xlab="Wavelet Scale", #' ylab="Wavelet Correlation") #' axis(side=1, at=2^(0:7)) #' abline(h=0) #' #' @export wave.variance wave.variance <- function(x, type = "eta3", p = 0.025) { ci.gaussian <- function(x, y, p) { find.first <- function(v) { na.length <- sum(is.na(v)) v[na.length + 1] } x.acf <- lapply(x, FUN = my.acf) Aj <- unlist(lapply(x.acf, FUN = function(v) sum(v * v, na.rm = TRUE))) - unlist(lapply(x.acf, FUN = find.first))^2 / 2 wv.var <- 2 * Aj / unlist(lapply(x, FUN = function(v) sum(!is.na(v)))) return(data.frame(wavevar = y, lower = y - qnorm(1-p) * sqrt(wv.var), upper = y + qnorm(1 - p) * sqrt(wv.var))) } ci.eta1 <- function(x, y, p) { ## x4 <- lapply(x, FUN = function(v) sum(v^4, na.rm = TRUE)) ## eta1 <- x4.ss * unlist(lapply(x, FUN = function(v) sum(!is.na(v)))) return(0) } ci.eta2 <- function(x, y, p) { return(0) } ci.eta3 <- function(x, y, p) { x.length <- unlist(lapply(x, FUN=function(v)sum(!is.na(v)))) eta3 <- pmax(x.length / 2^(1:length(x)), 1) return(data.frame(wavevar = y, lower = eta3 * y / qchisq(1-p, eta3), upper = eta3 * y / qchisq(p, eta3))) } ci.nongaussian <- function(x, y, p) { K <- 5 J <- length(x) x.length <- unlist(lapply(x, FUN=function(v)sum(!is.na(v)))) x.ss <- unlist(lapply(x, FUN=function(v)v[!is.na(v)]^2)) mt.var <- numeric(J) for(j in 1:J) { # Return the matrix of Slepian Sequences only (ignore the eigenvalues) x.dpss <- dpss(x.length[j], K, 4)$v V <- apply(x.dpss, 2, sum) J <- apply(x.dpss * x.ss[[j]], 2, sum) mt.var[j] <- sum((J - y[j] * V)^2) / K / x.length[j] } return(data.frame(wavevar = y, lower = y - qnorm(1-p) * sqrt(mt.var), upper = y + qnorm(1-p) * sqrt(mt.var))) } x.ss <- unlist(lapply(x, FUN = function(v) sum(v*v, na.rm=TRUE))) x.length <- unlist(lapply(x, FUN = function(v) sum(!is.na(v)))) y <- x.ss / x.length switch(type, gaussian = ci.gaussian(x, y, p), eta1 = ci.eta1(x, y, p), eta2 = ci.eta2(x, y, p), eta3 = ci.eta3(x, y, p), nongaussian = ci.nongaussian(x, y, p), stop("Invalid selection of \"type\" for the confidence interval")) } ##plot.var <- function(x, y=NA, ylim=range(x, y, na.rm=TRUE)) ##{ ## n <- dim(x)[1] ## plot(2^(0:(n-1)), x[,1], axes=FALSE, type="n", log="xy", ylim=ylim) ## axis(1, at=2^(0:(n-1))) ## axis(2) ## polyci(x[,1], x[,-1], -1) ## if(any(!is.na(y))) { polyci(y[,1], y[,-1], 1, color=5) } ## abline(h=0, lty=2) ##} wave.covariance <- function(x, y) { my.acf.na <- function(v) { v <- v[!is.na(v)] my.acf(v) } my.ccf.na <- function(u, v) { u <- u[!is.na(u)] v <- v[!is.na(v)] n <- length(u) u <- c(u, rep(0, n)) v <- c(v, rep(0, n)) n <- length(u) x <- Re(fft(fft(u) * Conj(fft(v)), inverse=TRUE)) / 2 / n^2 x[c((n %/% 2):n, 1:(n %/% 2 - 1))] } compute.sum.xy.ccvs <- function(x, y) { l <- length(x) xy <- numeric(l) for(i in 1:l) xy[i] <- sum(my.ccf.na(x[[i]], y[[i]])^2) xy } compute.xy.acvs <- function(x, y) { l <- length(x) xy <- vector("list", l) for(i in 1:l) { z <- x[[i]] * y[[i]] xy[[i]] <- c(rev(z), z[-1]) } xy } per <- function (z) { n <- length(z) (Mod(fft(z))^2/n)[1:(n%/%2 + 1)] } per2 <- function(x, y) { n <- length(x) fft.x <- fft(x) fft.y <- fft(y) ((Conj(fft.x) * fft.y)/n)[1:(n %/% 2 + 1)] } l <- length(x) xy <- vector("list", l) for(i in 1:l) xy[[i]] <- as.vector(x[[i]] * y[[i]]) z.ss <- unlist(lapply(xy, sum, na.rm=TRUE)) x.na <- lapply(x, is.na) for(i in 1:l) x.na[[i]] <- !x.na[[i]] z.length <- unlist(lapply(x.na, sum)) zz <- z.ss / z.length names(zz) <- names(x) x.acvs <- lapply(x, my.acf.na) y.acvs <- lapply(y, my.acf.na) sum.xy.acvs <- unlist(lapply(compute.xy.acvs(x.acvs, y.acvs), sum)) sum.squared.xy.ccvs <- compute.sum.xy.ccvs(x, y) var.gamma <- (sum.xy.acvs + sum.squared.xy.ccvs) / 2 / z.length out <- data.frame(wavecov = zz, lower = zz - qnorm(.975) * sqrt(var.gamma), upper = zz + qnorm(.975) * sqrt(var.gamma)) return(as.matrix(out)) } ##polyci <- function(x, xci, sp, color=2) ##{ ## n <- length(x) ## y <- 2^(0:(n-1)+sp*.05) ## delta <- y - 2^(0:(n-1)) ## for(i in 1:n){ ## polygon(c(y[i] + .6*delta[i], y[i] + .6*delta[i], y[i] - .6*delta[i], ## y[i] - .6*delta[i]), c(xci[i,], xci[i,2:1]), border=FALSE, ## col=color, lty=1) ## } ## points(y, x, pch="-") ##} ##plot.cov <- function(x, ylim=range(x,0)) ##{ ## n <- dim(x)[1] ## plot(2^(0:(n-1)), x[,1], axes=FALSE, type="n", log="x", ylim=ylim) ## axis(1, at=2^(0:(n-1))) ## axis(2) ## polyci(x[,1], x[,-1], 1) ## abline(h=0, lty=2) ##} wave.correlation <- function(x, y, N, p = .975) { sum.of.squares <- function(x) { sum(x^2, na.rm=TRUE) / sum(!is.na(x)) } sum.of.not.squares <- function(x) { sum(x, na.rm=TRUE) / sum(!is.na(x)) } l <- length(x) xy <- vector("list", l); xy.abs <- vector("list", l) for(i in 1:l) { xy[[i]] <- as.vector(x[[i]] * y[[i]]) xy.abs[[i]] <- as.vector(abs(x[[i]] * y[[i]])) } xy.cov <- unlist(lapply(xy, sum.of.not.squares)) x.var <- unlist(lapply(x, sum.of.squares)) y.var <- unlist(lapply(y, sum.of.squares)) xy.cor <- xy.cov / sqrt(x.var * y.var) n <- trunc(N/2^(1:l)) out <- data.frame(wavecor=xy.cor, lower=tanh(atanh(xy.cor)-qnorm(p)/sqrt(n-3)), upper=tanh(atanh(xy.cor)+qnorm(p)/sqrt(n-3))) return(as.matrix(out)) } ##plot.cor <- function(x, ylim=c(-1,1), cex=NULL) ##{ ## n <- dim(x)[1] ## plot(2^(0:(n-1)), x[,1], axes=FALSE, type="n", log="x", ylim=ylim, cex=cex) ## axis(1, at=2^(0:(n-1)), cex=cex) ## axis(2, cex=cex) ## polyci(x[,1], x[,-1], 1) ## abline(h=0, lty=2) ##} #' Compute Wavelet Cross-Covariance Between Two Time Series #' #' Computes wavelet cross-covariance or cross-correlation between two time #' series. #' #' See references. #' #' @usage spin.covariance(x, y, lag.max = NA) #' @usage spin.correlation(x, y, lag.max = NA) #' @aliases spin.covariance spin.correlation #' @param x first time series #' @param y second time series, same length as \code{x} #' @param lag.max maximum lag to compute cross-covariance (correlation) #' @return List structure holding the wavelet cross-covariances (correlations) #' according to scale. #' @author B. Whitcher #' @seealso \code{\link{wave.covariance}}, \code{\link{wave.correlation}}. #' @references Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An #' Introduction to Wavelets and Other Filtering Methods in Finance and #' Economics}, Academic Press. #' #' Whitcher, B., P. Guttorp and D. B. Percival (2000) Wavelet analysis of #' covariance with application to atmospheric time series, \emph{Journal of #' Geophysical Research}, \bold{105}, No. D11, 14,941-14,962. #' @keywords ts #' @examples #' #' ## Figure 7.9 from Gencay, Selcuk and Whitcher (2001) #' data(exchange) #' returns <- diff(log(exchange)) #' returns <- ts(returns, start=1970, freq=12) #' wf <- "d4" #' demusd.modwt <- modwt(returns[,"DEM.USD"], wf, 8) #' demusd.modwt.bw <- brick.wall(demusd.modwt, wf) #' jpyusd.modwt <- modwt(returns[,"JPY.USD"], wf, 8) #' jpyusd.modwt.bw <- brick.wall(jpyusd.modwt, wf) #' n <- dim(returns)[1] #' J <- 6 #' lmax <- 36 #' returns.cross.cor <- NULL #' for(i in 1:J) { #' blah <- spin.correlation(demusd.modwt.bw[[i]], jpyusd.modwt.bw[[i]], lmax) #' returns.cross.cor <- cbind(returns.cross.cor, blah) #' } #' returns.cross.cor <- ts(as.matrix(returns.cross.cor), start=-36, freq=1) #' dimnames(returns.cross.cor) <- list(NULL, paste("Level", 1:J)) #' lags <- length(-lmax:lmax) #' lower.ci <- tanh(atanh(returns.cross.cor) - qnorm(0.975) / #' sqrt(matrix(trunc(n/2^(1:J)), nrow=lags, ncol=J, byrow=TRUE) #' - 3)) #' upper.ci <- tanh(atanh(returns.cross.cor) + qnorm(0.975) / #' sqrt(matrix(trunc(n/2^(1:J)), nrow=lags, ncol=J, byrow=TRUE) #' - 3)) #' par(mfrow=c(3,2), las=1, pty="m", mar=c(5,4,4,2)+.1) #' for(i in J:1) { #' plot(returns.cross.cor[,i], ylim=c(-1,1), xaxt="n", xlab="Lag (months)", #' ylab="", main=dimnames(returns.cross.cor)[[2]][i]) #' axis(side=1, at=seq(-36, 36, by=12)) #' lines(lower.ci[,i], lty=1, col=2) #' lines(upper.ci[,i], lty=1, col=2) #' abline(h=0,v=0) #' } #' #' @export spin.covariance spin.covariance <- function(x, y, lag.max = NA) { xx <- zz <- x[!is.na(x)] yy <- y[!is.na(y)] n.length <- length(xx) xx.length <- min(length(xx)-1, lag.max, na.rm=TRUE) lag1 <- numeric(xx.length + 1) lag2 <- numeric(xx.length + 1) for(i in 1:(xx.length+1)) { lag1[i] <- sum(xx * yy, na.rm=TRUE) / n.length lag2[i] <- sum(zz * yy, na.rm=TRUE) / n.length xx <- c(xx[2:n.length], NA) zz <- c(NA, zz[1:(n.length-1)]) } c(rev(lag2[-1]), lag1) } spin.correlation <- function(x, y, lag.max = NA) { xx <- zz <- x[!is.na(x)] yy <- y[!is.na(y)] n.length <- length(xx) xx.length <- min(length(xx)-1, lag.max, na.rm=TRUE) xx.var <- mean(xx^2) yy.var <- mean(yy^2) lag1 <- numeric(xx.length + 1) lag2 <- numeric(xx.length + 1) for(i in 1:(xx.length+1)) { lag1[i] <- sum(xx * yy, na.rm=TRUE) / sqrt(xx.var * yy.var) / n.length lag2[i] <- sum(zz * yy, na.rm=TRUE) / sqrt(xx.var * yy.var) / n.length xx <- c(xx[2:n.length], NA) zz <- c(NA, zz[1:(n.length-1)]) } c(rev(lag2[-1]), lag1) } ##edof <- function(x) { ## x <- x[!is.na(x)] ## n <- length(x) ## x.acf <- my.acf(x) ## n * x.acf[1]^2 / ## sum((1 - abs(seq(-n+1,n-1))/n) * c(rev(x.acf[-1]), x.acf)^2) ##} waveslim/R/tapers.R0000644000176200001440000000266614627405714013747 0ustar liggesusers#' Calculating Thomson's Spectral Multitapers by Inverse Iteration #' #' This is now a wrapper to the function multitaper::dpss(). #' #' @param n length of data taper(s) #' @param k number of data tapers; 1, 2, 3, ... (do not use 0!) #' @param nw product of length and half-bandwidth parameter (w) #' @return \item{v}{matrix of data tapers (cols = tapers)} #' \item{eigen}{eigenvalue associated with each data taper, discarded} #' @author B. Whitcher #' @seealso \code{\link{sine.taper}}. #' @references Percival, D. B. and A. T. Walden (1993) \emph{Spectral Estimation for #' Physical Applications: Multitaper and Conventional Univariate Techniques}, #' Cambridge University Press. #' @keywords ts #' @export dpss.taper dpss.taper <- function(n, k, nw = 4) { out <- multitaper::dpss(n, k, nw) return(out$v) } #' Computing Sinusoidal Data Tapers #' #' Computes sinusoidal data tapers directly from equations. #' #' See reference. #' #' @param n length of data taper(s) #' @param k number of data tapers #' @return A vector or matrix of data tapers (cols = tapers). #' @author B. Whitcher #' @references Riedel, K. S. and A. Sidorenko (1995) Minimum bias multiple #' taper spectral estimation, \emph{IEEE Transactions on Signal Processing}, #' \bold{43}, 188-195. #' @keywords ts #' @export sine.taper sine.taper <- function(n, k) { tapers <- NULL for(i in 1:k) tapers <- cbind(tapers, sqrt(2/(n+1)) * sin((pi*i*1:n)/(n+1))) return(tapers) } waveslim/R/dualtree2D.R0000644000176200001440000001320614627073455014437 0ustar liggesusersdualtree2D <- function(x, J, Faf, af) { ## normalization x <- x/sqrt(2) w <- vector("list", J+1) ## Tree 1 w[[1]] <- vector("list", 2) temp <- afb2D(x, Faf[[1]]) # stage 1 x1 <- temp$lo w[[1]][[1]] <- temp$hi if (J > 1) { for (j in 2:J) { w[[j]] <- vector("list", 2) temp <- afb2D(x1, af[[1]]) # remaining stages x1 <- temp$lo w[[j]][[1]] <- temp$hi } } w[[J+1]] <- vector("list", 2) w[[J+1]][[1]] <- x1 # lowpass subband ## Tree 2 temp <- afb2D(x, Faf[[2]]) # stage 1 x2 <- temp$lo w[[1]][[2]] <- temp$hi if (J > 1) { for (j in 2:J) { temp <- afb2D(x2, af[[2]]) # remaining stages x2 <- temp$lo w[[j]][[2]] <- temp$hi } } w[[J+1]][[2]] <- x2 # lowpass subband ## sum and difference for (j in 1:J) { for (m in 1:3) { A <- w[[j]][[1]][[m]] B <- w[[j]][[2]][[m]] w[[j]][[1]][[m]] <- (A + B) / sqrt(2) w[[j]][[2]][[m]] <- (A - B) / sqrt(2) } } return(w) } afb2D <- function(x, af1, af2=NULL) { if (is.null(af2)) { af2 <- af1 } ## filter along columns temp <- afb2D.A(x, af1, 1) L <- temp$lo H <- temp$hi ## filter along rows hi <- vector("list", 3) temp <- afb2D.A(L, af2, 2) lo <- temp$lo hi[[1]] <- temp$hi temp <- afb2D.A(H, af2, 2) hi[[2]] <- temp$lo hi[[3]] <- temp$hi list(lo = lo, hi = hi) } afb2D.A <- function(x, af, d) { lpf <- af[,1] # lowpass filter hpf <- af[,2] # highpass filter if (d == 2) { x <- t(x) } ## x <- matrix(1:32, 32, 64) N <- nrow(x) L <- nrow(af) / 2 x <- cshift2D(x, -L) ## image(x, col=rainbow(16)) ## lo <- upfirdn(x, lpf, 1, 2) lo <- convolve2D(x, lpf, conj=FALSE, type="open") lo <- cshift2D(lo, -(2 * L - 1)) lo <- lo[seq(1, nrow(lo), by=2),] lo[1:L,] <- lo[1:L,] + lo[1:L + N/2,] lo <- lo[1:(N/2),] ## hi <- upfirdn(x, hpf, 1, 2) hi <- convolve2D(x, hpf, conj=FALSE, type="open") hi <- cshift2D(hi, -(2 * L - 1)) hi <- hi[seq(1, nrow(hi), by=2),] hi[1:L,] <- hi[1:L,] + hi[1:L + N/2,] hi <- hi[1:(N/2),] if (d == 2) { lo <- t(lo) hi <- t(hi) } list(lo = lo, hi = hi) } cshift2D <- function(x, m) { N <- nrow(x) n <- 0:(N-1) n <- (n-m) %% N y <- x[n+1,] return(y) } #' Fast Column-wise Convolution of a Matrix #' #' Use the Fast Fourier Transform to perform convolutions between a sequence #' and each column of a matrix. #' #' This is a corrupted version of \code{convolve} made by replacing \code{fft} #' with \code{mvfft} in a few places. It would be nice to submit this to the R #' Developers for inclusion. #' #' @param x MxN matrix. #' @param y numeric sequence of length N. #' @param conj logical; if \code{TRUE}, take the complex \emph{conjugate} #' before back-transforming (default, and used for usual convolution). #' @param type character; one of \code{circular}, \code{open} (beginning of #' word is ok). For \code{circular}, the two sequences are treated as #' \emph{circular}, i.e., periodic. #' #' For \code{open} and \code{filter}, the sequences are padded with zeros (from #' left and right) first; \code{filter} returns the middle sub-vector of #' \code{open}, namely, the result of running a weighted mean of \code{x} with #' weights \code{y}. #' @author B. Whitcher #' @seealso \code{\link{convolve}} #' @keywords ts #' @export convolve2D convolve2D <- function(x, y, conj=TRUE, type=c("circular", "open")) { ## Generalize convolve to handle vector arrays by calling mvfft() type <- match.arg(type) n <- nrow(x) ny <- length(y) Real <- is.numeric(x) && is.numeric(y) if (type == "circular") { if (ny != n) { stop("length mismatch in convolution") } } else { n1 <- ny - 1 x <- rbind(matrix(0, n1, ncol(x)), x) n <- length(y <- c(y, rep.int(0, n - 1))) } x <- mvfft(mvfft(x) * (if (conj) Conj(fft(y)) else fft(y)), inverse=TRUE) (if (Real) Re(x) else x) / n } idualtree2D <- function(w, J, Fsf, sf) { ## sum and difference for (k in 1:J) { for (m in 1:3) { A <- w[[k]][[1]][[m]] B <- w[[k]][[2]][[m]] w[[k]][[1]][[m]] <- (A+B)/sqrt(2) w[[k]][[2]][[m]] <- (A-B)/sqrt(2) } } ## Tree 1 y1 <- w[[J+1]][[1]] if (J > 1) { for (j in J:2) { y1 <- sfb2D(y1, w[[j]][[1]], sf[[1]]) } } y1 <- sfb2D(y1, w[[1]][[1]], Fsf[[1]]) ## Tree 2 y2 <- w[[J+1]][[2]] if (J > 1) { for (j in J:2) { y2 <- sfb2D(y2, w[[j]][[2]], sf[[2]]) } y2 <- sfb2D(y2, w[[1]][[2]], Fsf[[2]]) } ## normalization y <- (y1 + y2)/sqrt(2) return(y) } sfb2D <- function(lo, hi, sf1, sf2=NULL) { if (is.null(sf2)) { sf2 <- sf1 } ## filter along rows lo <- sfb2D.A(lo, hi[[1]], sf2, 2) hi <- sfb2D.A(hi[[2]], hi[[3]], sf2, 2) ## filter along columns y <- sfb2D.A(lo, hi, sf1, 1) return(y) } sfb2D.A <- function(lo, hi, sf, d) { lpf <- sf[,1] # lowpass filter hpf <- sf[,2] # highpass filter if (d == 2) { lo <- t(lo) hi <- t(hi) } N <- 2 * nrow(lo) M <- ncol(lo) L <- nrow(sf) ## y = upfirdn(lo, lpf, 2, 1) + upfirdn(hi, hpf, 2, 1); lo <- c(matrix(c(rep(0, length(lo)), c(lo)), nrow=2, byrow=TRUE)) lo <- matrix(lo, N, M) lo <- convolve2D(lo, lpf, conj=FALSE, type="open") lo <- cshift2D(lo, -L) hi <- c(matrix(c(rep(0, length(hi)), c(hi)), nrow=2, byrow=TRUE)) hi <- matrix(hi, N, M) hi <- convolve2D(hi, hpf, conj=FALSE, type="open") hi <- cshift2D(hi, -L) y <- lo + hi y[1:(L-2),] <- y[1:(L-2),] + y[N+1:(L-2),] y <- y[1:N,] y <- cshift2D(y, 1 - L/2) if (d == 2) { y <- t(y) } return(y) } pm <- function(a, b) { u <- (a + b) / sqrt(2) v <- (a - b) / sqrt(2) list(u=u, v=v) } waveslim/R/three_D.R0000644000176200001440000002666514627073455014033 0ustar liggesusers########################################################################### ########################################################################### ########################################################################### #' Three Dimensional Separable Discrete Wavelet Transform #' #' Three-dimensional separable discrete wavelet transform (DWT). #' #' #' @usage dwt.3d(x, wf, J = 4, boundary = "periodic") #' @usage idwt.3d(y) #' @aliases dwt.3d idwt.3d #' @param x input array #' @param wf name of the wavelet filter to use in the decomposition #' @param J depth of the decomposition, must be a number less than or equal to #' log(minZ,Y,Z,2) #' @param boundary only \code{"periodic"} is currently implemented #' @param y an object of class \code{dwt.3d} #' @author B. Whitcher #' @keywords ts #' @export dwt.3d dwt.3d <- function(x, wf, J=4, boundary="periodic") { nx <- dim(x)[1] storage.mode(nx) <- "integer" ny <- dim(x)[2] storage.mode(ny) <- "integer" nz <- dim(x)[3] storage.mode(nz) <- "integer" dict <- wave.filter(wf) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf storage.mode(h) <- "double" g <- dict$lpf storage.mode(g) <- "double" z <- array(0, dim=c(nx,ny,nz)/2) storage.mode(z) <- "double" x.wt <- vector("list", 7*J+1) x.names <- NULL for(j in 1:J) { out <- .C(C_three_D_dwt, "cube"=as.double(x), "NX"=nx, "NY"=ny, "NZ"=nz, "filter.length"=L, "hpf"=h, "lpf"=g, "LLL"=z, "HLL"=z, "LHL"=z, "LLH"=z, "HHL"=z, "HLH"=z, "LHH"=z, "HHH"=z)[8:15] if(j < J) { index <- (7*(j-1)+1):(7*j) x.wt[index] <- out[-1] x.names <- c(x.names, sapply(names(out)[-1], paste, j, sep="")) x <- out[[1]] nx <- dim(x)[1] storage.mode(nx) <- "integer" ny <- dim(x)[2] storage.mode(ny) <- "integer" nz <- dim(x)[3] storage.mode(nz) <- "integer" z <- array(0, dim=c(nx,ny,nz)/2) storage.mode(z) <- "double" } else { index <- (7*(j-1)+1):(7*j+1) x.wt[index] <- out[c(2:8,1)] x.names <- c(x.names, sapply(names(out)[c(2:8,1)], paste, j, sep="")) } } names(x.wt) <- x.names class(x.wt) <- "dwt.3d" attr(x.wt, "J") <- J attr(x.wt, "wavelet") <- wf attr(x.wt, "boundary") <- boundary return(x.wt) } ########################################################################### ########################################################################### ########################################################################### idwt.3d <- function(y) { J <- attributes(y)$J LLL <- paste("LLL", J, sep="") wf <- attributes(y)$wavelet dict <- wave.filter(wf) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf storage.mode(h) <- "double" g <- dict$lpf storage.mode(g) <- "double" y.in <- y$LLL for(j in J:1) { HLL <- paste("HLL", j, sep="") LHL <- paste("LHL", j, sep="") LLH <- paste("LLH", j, sep="") HHL <- paste("HHL", j, sep="") HLH <- paste("HLH", j, sep="") LHH <- paste("LHH", j, sep="") HHH <- paste("HHH", j, sep="") nx <- dim(y.in)[1] storage.mode(nx) <- "integer" ny <- dim(y.in)[2] storage.mode(ny) <- "integer" nz <- dim(y.in)[3] storage.mode(nz) <- "integer" z <- array(0, dim=2*c(nx, ny, nz)) storage.mode(z) <- "double" out <- .C(C_three_D_idwt, as.double(y.in), as.double(y[[HLL]]), as.double(y[[LHL]]), as.double(y[[LLH]]), as.double(y[[HHL]]), as.double(y[[HLH]]), as.double(y[[LHH]]), as.double(y[[HHH]]), nx, ny, nz, L, h, g, "Y"=z) y.in <- out$Y } zapsmall(y.in) } #' Three Dimensional Separable Maximal Ovelrap Discrete Wavelet Transform #' #' Three-dimensional separable maximal overlap discrete wavelet transform #' (MODWT). #' #' #' @usage modwt.3d(x, wf, J = 4, boundary = "periodic") #' @usage imodwt.3d(y) #' @aliases modwt.3d imodwt.3d #' @param x input array #' @param wf name of the wavelet filter to use in the decomposition #' @param J depth of the decomposition #' @param boundary only \code{"periodic"} is currently implemented #' @param y an object of class \code{modwt.3d} #' @author B. Whitcher #' @keywords ts #' @export modwt.3d #' @export imodwt.3d modwt.3d <- function(x, wf, J=4, boundary="periodic") { nx <- dim(x)[1] storage.mode(nx) <- "integer" ny <- dim(x)[2] storage.mode(ny) <- "integer" nz <- dim(x)[3] storage.mode(nz) <- "integer" dict <- wave.filter(wf) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf / sqrt(2) storage.mode(h) <- "double" g <- dict$lpf / sqrt(2) storage.mode(g) <- "double" z <- array(0, dim=c(nx,ny,nz)) storage.mode(z) <- "double" x.wt <- vector("list", 7*J+1) x.names <- NULL for(j in 1:J) { out <- .C(C_three_D_modwt, "cube"=as.double(x), "NX"=nx, "NY"=ny, "NZ"=nz, "J"=j, "filter.length"=L, "hpf"=h, "lpf"=g, "LLL"=z, "HLL"=z, "LHL"=z, "LLH"=z, "HHL"=z, "HLH"=z, "LHH"=z, "HHH"=z)[9:16] if(j < J) { index <- (7*(j-1)+1):(7*j) x.wt[index] <- out[-1] x.names <- c(x.names, sapply(names(out)[-1], paste, j, sep="")) x <- out[[1]] nx <- dim(x)[1] storage.mode(nx) <- "integer" ny <- dim(x)[2] storage.mode(ny) <- "integer" nz <- dim(x)[3] storage.mode(nz) <- "integer" z <- array(0, dim=c(nx,ny,nz)) storage.mode(z) <- "double" } else { index <- (7*(j-1)+1):(7*j+1) x.wt[index] <- out[c(2:8,1)] x.names <- c(x.names, sapply(names(out)[c(2:8,1)], paste, j, sep="")) } } names(x.wt) <- x.names class(x.wt) <- "modwt.3d" attr(x.wt, "J") <- J attr(x.wt, "wavelet") <- wf attr(x.wt, "boundary") <- boundary return(x.wt) } ########################################################################### ########################################################################### ########################################################################### imodwt.3d <- function(y) { J <- attributes(y)$J LLL <- paste("LLL", J, sep="") wf <- attributes(y)$wavelet dict <- wave.filter(wf) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf / sqrt(2) storage.mode(h) <- "double" g <- dict$lpf / sqrt(2) storage.mode(g) <- "double" y.in <- y$LLL for(j in J:1) { HLL <- paste("HLL", j, sep="") LHL <- paste("LHL", j, sep="") LLH <- paste("LLH", j, sep="") HHL <- paste("HHL", j, sep="") HLH <- paste("HLH", j, sep="") LHH <- paste("LHH", j, sep="") HHH <- paste("HHH", j, sep="") nx <- dim(y.in)[1] storage.mode(nx) <- "integer" ny <- dim(y.in)[2] storage.mode(ny) <- "integer" nz <- dim(y.in)[3] storage.mode(nz) <- "integer" z <- array(0, dim=c(nx, ny, nz)) storage.mode(z) <- "double" out <- .C(C_three_D_imodwt, as.double(y.in), as.double(y[[HLL]]), as.double(y[[LHL]]), as.double(y[[LLH]]), as.double(y[[HHL]]), as.double(y[[HLH]]), as.double(y[[LHH]]), as.double(y[[HHH]]), nx, ny, nz, j, L, h, g, "Y"=z) y.in <- out$Y } zapsmall(y.in) } ########################################################################### ########################################################################### ########################################################################### #' Three Dimensional Multiresolution Analysis #' #' This function performs a level \eqn{J} additive decomposition of the input #' array using the pyramid algorithm (Mallat 1989). #' #' This code implements a three-dimensional multiresolution analysis by #' performing the one-dimensional pyramid algorithm (Mallat 1989) on each #' dimension of the input array. Either the DWT or MODWT may be used to #' compute the multiresolution analysis, which is an additive decomposition of #' the original array. #' #' @param x A three-dimensional array containing the data be to decomposed. #' This must be have dyadic length in all three dimensions (but not necessarily #' the same) for \code{method="dwt"}. #' @param wf Name of the wavelet filter to use in the decomposition. By #' default this is set to \code{"la8"}, the Daubechies orthonormal compactly #' supported wavelet of length \eqn{L=8} least asymmetric family. #' @param J Specifies the depth of the decomposition. This must be a number #' less than or equal to \eqn{\log(\mbox{length}(x),2)}{log(length(x),2)}. #' @param method Either \code{"dwt"} or \code{"modwt"}. #' @param boundary Character string specifying the boundary condition. If #' \code{boundary=="periodic"} the default and only method implemented, then #' the matrix you decompose is assumed to be periodic on its defined interval. #' @return List structure containing the filter triplets associated with the #' multiresolution analysis. #' @author B. Whitcher #' @seealso \code{\link{dwt.3d}}, \code{\link{modwt.3d}} #' @references Mallat, S. G. (1989) A theory for multiresolution signal #' decomposition: the wavelet representation, \emph{IEEE Transactions on #' Pattern Analysis and Machine Intelligence}, \bold{11}, No. 7, 674-693. #' #' Mallat, S. G. (1998) \emph{A Wavelet Tour of Signal Processing}, Academic #' Press. #' @keywords ts #' @export mra.3d mra.3d <- function(x, wf="la8", J=4, method="modwt", boundary="periodic") { nx <- dim(x)[1] ny <- dim(x)[2] nz <- dim(x)[3] if(method == "modwt") { x.wt <- modwt.3d(x, wf, J, "periodic") } else { x.wt <- dwt.3d(x, wf, J, "periodic") } x.mra <- vector("list", 7*J+1) names(x.mra) <- c(matrix(rbind(paste("HLL", 1:J, sep=""), paste("LHL", 1:J, sep=""), paste("LLH", 1:J, sep=""), paste("HHL", 1:J, sep=""), paste("HLH", 1:J, sep=""), paste("LHH", 1:J, sep=""), paste("HHH", 1:J, sep="")), nrow=1), paste("LLL", J, sep="")) ## Smooth zero <- vector("list", 7*J+1) names(zero) <- names(x.mra) attr(zero, "J") <- J attr(zero, "wavelet") <- wf attr(zero, "boundary") <- boundary zero[[7*J+1]] <- x.wt[[7*J+1]] if(method == "modwt") { class(x.wt) <- "modwt.3d" for(k in 1:(7*J)) zero[[k]] <- array(0, dim=c(nx,ny,nz)) x.mra[[7*J+1]] <- imodwt.3d(zero) } else { class(x.wt) <- "dwt.3d" for(k in 1:J) zero[[7*(k-1)+1]] <- zero[[7*(k-1)+2]] <- zero[[7*(k-1)+3]] <- zero[[7*(k-1)+4]] <- zero[[7*(k-1)+5]] <- zero[[7*(k-1)+6]] <- zero[[7*k]] <- array(0, dim=c(nx,ny,nz)/2^k) x.mra[[7*J+1]] <- idwt.3d(zero) } ## Details for(j in (7*J):1) { Jj <- ceiling(j/7) zero <- vector("list", 7*Jj+1) names(zero) <- c(matrix(rbind(paste("HLL", 1:Jj, sep=""), paste("LHL", 1:Jj, sep=""), paste("LLH", 1:Jj, sep=""), paste("HHL", 1:Jj, sep=""), paste("HLH", 1:Jj, sep=""), paste("LHH", 1:Jj, sep=""), paste("HHH", 1:Jj, sep="")), nrow=1), paste("LLL", Jj, sep="")) attr(zero, "J") <- Jj attr(zero, "wavelet") <- wf attr(zero, "boundary") <- boundary zero[[j]] <- x.wt[[j]] if(method == "modwt") { for(k in names(zero)[-charmatch(names(zero)[j], names(zero))]) zero[[k]] <- array(0, dim=c(nx,ny,nz)) x.mra[[j]] <- imodwt.3d(zero) } else { for(k in 1:Jj) zero[[7*(k-1)+1]] <- zero[[7*(k-1)+2]] <- zero[[7*(k-1)+3]] <- zero[[7*(k-1)+4]] <- zero[[7*(k-1)+5]] <- zero[[7*(k-1)+6]] <- zero[[7*k]] <- array(0, dim=c(nx,ny,nz)/2^k) zero[[7*Jj+1]] <- array(0, dim=c(nx,ny,nz)/2^Jj) zero[[j]] <- x.wt[[j]] x.mra[[j]] <- idwt.3d(zero) } } return(x.mra) } waveslim/R/bishrink.R0000644000176200001440000000064214627073455014255 0ustar liggesusersbishrink <- function(y1, y2, T) { ## Bivariate Shrinkage Function ## Usage : ## [w1] = bishrink(y1,y2,T) ## INPUT : ## y1 - a noisy coefficient value ## y2 - the corresponding parent value ## T - threshold value ## OUTPUT : ## w1 - the denoised coefficient R <- sqrt(abs(y1)^2 + abs(y2)^2) R <- R - T R <- R * as.numeric(R > 0) return(y1 * R/(R+T)) } waveslim/R/multiple.R0000644000176200001440000001735614627073455014311 0ustar liggesusers#' Rotated Cumulative Variance #' #' Provides the normalized cumulative sums of squares from a sequence of #' coefficients with the diagonal line removed. #' #' The rotated cumulative variance, when plotted, provides a qualitative way to #' study the time dependence of the variance of a series. If the variance is #' stationary over time, then only small deviations from zero should be #' present. If on the other hand the variance is non-stationary, then large #' departures may exist. Formal hypothesis testing may be performed based on #' boundary crossings of Brownian bridge processes. #' #' @param x vector of coefficients to be cumulatively summed (missing values #' excluded) #' @return Vector of coefficients that are the sumulative sum of squared input #' coefficients. #' @author B. Whitcher #' @references Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An #' Introduction to Wavelets and Other Filtering Methods in Finance and #' Economics}, Academic Press. #' #' Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time #' Series Analysis}, Cambridge University Press. #' @keywords ts #' @export rotcumvar rotcumvar <- function(x) { x <- x[!is.na(x)] n <- length(x) plus <- 1:n/(n-1) - cumsum(x^2)/sum(x^2) minus <- cumsum(x^2)/sum(x^2) - 0:(n-1)/(n-1) pmax(abs(plus), abs(minus)) } #' Testing for Homogeneity of Variance #' #' A recursive algorithm for detecting and locating multiple variance change #' points in a sequence of random variables with long-range dependence. #' #' For details see Section 9.6 of Percival and Walden (2000) or Section 7.3 in #' Gencay, Selcuk and Whitcher (2001). #' #' @param x Sequence of observations from a (long memory) time series. #' @param wf Name of the wavelet filter to use in the decomposition. #' @param J Specifies the depth of the decomposition. This must be a number #' less than or equal to \eqn{\log(\mbox{length}(x),2)}{log(length(x),2)}. #' @param min.coef Minimum number of wavelet coefficients for testing purposes. #' Empirical results suggest that 128 is a reasonable number in order to apply #' asymptotic critical values. #' @param debug Boolean variable: if set to \code{TRUE}, actions taken by the #' algorithm are printed to the screen. #' @return Matrix whose columns include (1) the level of the wavelet transform #' where the variance change occurs, (2) the value of the test statistic, (3) #' the DWT coefficient where the change point is located, (4) the MODWT #' coefficient where the change point is located. Note, there is currently no #' checking that the MODWT is contained within the associated support of the #' DWT coefficient. This could lead to incorrect estimates of the location of #' the variance change. #' @author B. Whitcher #' @seealso \code{\link{dwt}}, \code{\link{modwt}}, \code{\link{rotcumvar}}, #' \code{\link{mult.loc}}. #' @references Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An #' Introduction to Wavelets and Other Filtering Methods in Finance and #' Economics}, Academic Press. #' #' Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time #' Series Analysis}, Cambridge University Press. #' @keywords ts #' @export testing.hov testing.hov <- function(x, wf, J, min.coef=128, debug=FALSE) { n <- length(x) change.points <- NULL x.dwt <- dwt(x, wf, J) x.dwt.bw <- brick.wall(x.dwt, wf, method="dwt") x.modwt <- modwt(x, wf, J) x.modwt.bw <- brick.wall(x.modwt, wf) for(j in 1:J) { cat("##### Level ", j, " #####", fill=TRUE) Nj <- n/2^j dwt.list <- list(dwt = (x.dwt.bw[[j]])[!is.na(x.dwt.bw[[j]])], left = min((1:Nj)[!is.na(x.dwt.bw[[j]])]) + 1, right = sum(!is.na(x.dwt.bw[[j]]))) modwt.list <- list(modwt = (x.modwt.bw[[j]])[!is.na(x.modwt.bw[[j]])], left = min((1:n)[!is.na(x.modwt.bw[[j]])]) + 1, right = sum(!is.na(x.modwt.bw[[j]]))) if(debug) cat("Starting recursion; using", dwt.list$left, "to", dwt.list$right - 1, "... ") change.points <- rbind(change.points, mult.loc(dwt.list, modwt.list, wf, j, min.coef, debug)) } dimnames(change.points) <- list(NULL, c("level", "crit.value", "loc.dwt", "loc.modwt")) return(change.points) } #' Wavelet-based Testing and Locating for Variance Change Points #' #' This is the major subroutine for \code{\link{testing.hov}}, providing the #' workhorse algorithm to recursively test and locate multiple variance changes #' in so-called long memory processes. #' #' For details see Section 9.6 of Percival and Walden (2000) or Section 7.3 in #' Gencay, Selcuk and Whitcher (2001). #' #' @param dwt.list List of wavelet vector coefficients from the \code{dwt}. #' @param modwt.list List of wavelet vector coefficients from the \code{modwt}. #' @param wf Name of the wavelet filter to use in the decomposition. #' @param level Specifies the depth of the decomposition. #' @param min.coef Minimum number of wavelet coefficients for testing purposes. #' @param debug Boolean variable: if set to \code{TRUE}, actions taken by the #' algorithm are printed to the screen. #' @return Matrix. #' @author B. Whitcher #' @seealso \code{\link{rotcumvar}}, \code{\link{testing.hov}}. #' @references Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An #' Introduction to Wavelets and Other Filtering Methods in Finance and #' Economics}, Academic Press. #' #' Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time #' Series Analysis}, Cambridge University Press. #' @keywords ts #' @export mult.loc mult.loc <- function(dwt.list, modwt.list, wf, level, min.coef, debug) { Nj <- length(dwt.list$dwt) N <- length(modwt.list$modwt) crit <- 1.358 change.points <- NULL if(Nj > min.coef) { ## test statistic using the DWT P <- cumsum(dwt.list$dwt^2) / sum(dwt.list$dwt^2) test.stat <- pmax((1:Nj) / (Nj-1) - P, P - (1:Nj - 1) / (Nj-1)) loc.dwt <- (1:Nj)[max(test.stat) == test.stat] test.stat <- max(test.stat) ## location using the MODWT P <- cumsum(modwt.list$modwt^2) / sum(modwt.list$modwt^2) loc.stat <- pmax((1:N) / (N-1) - P, P - (1:N - 1) / (N-1)) loc.modwt <- (1:N)[max(loc.stat) == loc.stat] if(test.stat > sqrt(2) * crit / sqrt(Nj)) { if(debug) cat("Accepted!", fill=TRUE) ## Left if(debug) cat("Going left; using", dwt.list$left, "to", loc.dwt + dwt.list$left - 1, "... ") temp.dwt.list <- list(dwt = dwt.list$dwt[1:(loc.dwt-1)], left = dwt.list$left, right = loc.dwt + dwt.list$left - 1) temp.modwt.list <- list(modwt = modwt.list$modwt[1:(loc.modwt-1)], left = modwt.list$left, right = loc.modwt + modwt.list$left - 1) change.points <- rbind(c(level, test.stat, loc.dwt + dwt.list$left, loc.modwt + modwt.list$left), Recall(temp.dwt.list, temp.modwt.list, wf, level, min.coef, debug)) ## Right if(debug) cat("Going right; using", loc.dwt + dwt.list$left + 1, "to", dwt.list$right, "... ") temp.dwt.list <- list(dwt = dwt.list$dwt[(loc.dwt+1):Nj], left = loc.dwt + dwt.list$left + 1, right = dwt.list$right) temp.modwt.list <- list(modwt = modwt.list$modwt[(loc.modwt+1):N], left = loc.modwt + modwt.list$left + 1, right = modwt.list$right) change.points <- rbind(change.points, Recall(temp.dwt.list, temp.modwt.list, wf, level, min.coef, debug)) } else if(debug) cat("Rejected!", fill=TRUE) } else if(debug) cat("Sample size does not exceed ", min.coef, "!", sep="", fill=TRUE) return(change.points) } waveslim/R/hilbert.R0000644000176200001440000005473514627073455014111 0ustar liggesusers#' Discrete Hilbert Wavelet Transforms #' #' The discrete Hilbert wavelet transforms (DHWTs) for seasonal and #' time-varying time series analysis. Transforms include the usual orthogonal #' (decimated), maximal-overlap (non-decimated) and maximal-overlap packet #' transforms. #' #' @usage dwt.hilbert(x, wf, n.levels = 4, boundary = "periodic", ...) #' @usage dwt.hilbert.nondyadic(x, ...) #' @usage idwt.hilbert(y) #' @usage modwt.hilbert(x, wf, n.levels = 4, boundary = "periodic", ...) #' @usage imodwt.hilbert(y) #' @usage modwpt.hilbert(x, wf, n.levels = 4, boundary = "periodic") #' @aliases dwt.hilbert dwt.hilbert.nondyadic idwt.hilbert modwt.hilbert #' imodwt.hilbert modwpt.hilbert #' @param x Real-valued time series or vector of observations. #' @param wf Hilbert wavelet pair #' @param n.levels Number of levels (depth) of the wavelet transform. #' @param boundary Boundary treatment, currently only \code{periodic} and #' \code{reflection}. #' @param \ldots Additional parametes to be passed on. #' @param y An object of S3 class \code{dwt.hilbert}. #' @return Hilbert wavelet transform object (list). #' @author B. Whitcher #' @seealso \code{\link{hilbert.filter}} #' @references Selesnick, I. (200X). \emph{IEEE Signal Processing Magazine} #' #' Selesnick, I. (200X). \emph{IEEE Transactions in Signal Processing} #' #' Whither, B. and P.F. Craigmile (2004). Multivariate Spectral Analysis Using #' Hilbert Wavelet Pairs, \emph{International Journal of Wavelets, #' Multiresolution and Information Processing}, \bold{2}(4), 567--587. #' @keywords ts dwt.hilbert <- function(x, wf, n.levels=4, boundary="periodic", ...) { switch(boundary, "reflection" = x <- c(x, rev(x)), "periodic" = invisible(), stop("Invalid boundary rule in dwt.hilbert")) N <- length(x) J <- n.levels if(N/2^J != trunc(N/2^J)) stop("Sample size is not divisible by 2^J") if(2^J > N) stop("Wavelet transform exceeds sample size in dwt") dict <- hilbert.filter(wf) L <- dict$length; storage.mode(L) <- "integer" h0 <- dict$lpf[[1]]; storage.mode(h0) <- "double" g0 <- dict$lpf[[2]]; storage.mode(g0) <- "double" h1 <- dict$hpf[[1]]; storage.mode(h1) <- "double" g1 <- dict$hpf[[2]]; storage.mode(g1) <- "double" y <- vector("list", J+1) names(y) <- c(paste("d", 1:J, sep=""), paste("s", J, sep="")) x.h <- x.g <- x for(j in 1:J) { W <- V <- numeric(N/2^j) out.h <- .C(C_dwt, as.double(x.h), as.integer(N/2^(j-1)), L, h1, h0, W = W, V = V)[6:7] out.g <- .C(C_dwt, as.double(x.g), as.integer(N/2^(j-1)), L, g1, g0, W = W, V = V)[6:7] y[[j]] <- complex(real = out.h$W, imaginary = out.g$W) x.h <- out.h$V x.g <- out.g$V } y[[J+1]] <- complex(real = x.h, imaginary = x.g) attr(y, "wavelet") <- wf attr(y, "levels") <- n.levels attr(y, "boundary") <- boundary return(y) } ######################################################################## dwt.hilbert.nondyadic <- function(x, ...) { M <- length(x) N <- 2^(ceiling(log(M, 2))) xx <- c(x, rep(0, N - M)) y <- dwt.hilbert(xx, ...) J <- length(y) - 1 for(j in 1:J) { y[[j]] <- y[[j]][1:trunc(M/2^j)] } return(y) } ######################################################################## idwt.hilbert <- function(y) { switch(attributes(y)$boundary, "reflection" = y <- c(y, rev(y)), "periodic" = invisible(), stop("Invalid boundary rule in dwt.dbp")) J <- attributes(y)$levels dict <- hilbert.filter(attributes(y)$wavelet) L <- dict$length; storage.mode(L) <- "integer" h <- dict$hpf; storage.mode(h) <- "double" g <- dict$lpf; storage.mode(g) <- "double" jj <- paste("s", J, sep="") X <- y[[jj]] for(j in J:1) { jj <- paste("d", j, sep="") XX <- numeric(2 * length(y[[jj]])) X <- .C(C_idwt, y[[jj]], as.double(X), as.integer(length(X)), L, h, g, XX=XX)$XX } return(X) } ######################################################################## modwt.hilbert <- function(x, wf, n.levels=4, boundary="periodic", ...) { switch(boundary, "reflection" = x <- c(x, rev(x)), "periodic" = invisible(), stop("Invalid boundary rule in modwt")) N <- length(x) storage.mode(N) <- "integer" J <- n.levels if(2^J > N) stop("wavelet transform exceeds sample size in modwt") dict <- hilbert.filter(wf) L <- dict$length; storage.mode(L) <- "integer" h0 <- dict$lpf[[1]] / sqrt(2); storage.mode(h0) <- "double" g0 <- dict$lpf[[2]] / sqrt(2); storage.mode(g0) <- "double" h1 <- dict$hpf[[1]] / sqrt(2); storage.mode(h1) <- "double" g1 <- dict$hpf[[2]] / sqrt(2); storage.mode(g1) <- "double" y <- vector("list", J+1) names(y) <- c(paste("d", 1:J, sep=""), paste("s", J, sep="")) W <- V <- numeric(N) x.h <- x.g <- x for(j in 1:J) { out.h <- .C(C_modwt, as.double(x.h), N, as.integer(j), L, h1, h0, W = W, V = V)[7:8] out.g <- .C(C_modwt, as.double(x.g), N, as.integer(j), L, g1, g0, W = W, V = V)[7:8] y[[j]] <- complex(real = out.h$W, imaginary = out.g$W) x.h <- out.h$V x.g <- out.g$V } y[[J+1]] <- complex(real = x.h, imaginary = x.g) attr(y, "wavelet") <- wf attr(y, "boundary") <- boundary attr(y, "levels") <- n.levels return(y) } ######################################################################## imodwt.hilbert <- function(y) { if(attributes(y)$boundary != "periodic") stop("Invalid boundary rule in imodwt") J <- length(y) - 1 dict <- hilbert.filter(attributes(y)$wavelet) L <- dict$length ht <- dict$hpf / sqrt(2) gt <- dict$lpf / sqrt(2) jj <- paste("s", J, sep="") X <- y[[jj]]; N <- length(X) XX <- numeric(N) for(j in J:1) { jj <- paste("d", j, sep="") X <- .C(C_imodwt, y[[jj]], X, as.integer(N), as.integer(j), as.integer(L), ht, gt, XX)[[8]] } return(X) } ######################################################################## #' Select a Hilbert Wavelet Pair #' #' Converts name of Hilbert wavelet pair to filter coefficients. #' #' Simple \code{switch} statement selects the appropriate HWP. There are two #' parameters that define a Hilbert wavelet pair using the notation of #' Selesnick (2001,2002), \eqn{K} and \eqn{L}. Currently, the only implemented #' combinations \eqn{(K,L)} are (3,3), (3,5), (4,2) and (4,4). #' #' @param name Character string of Hilbert wavelet pair, see acceptable names #' below (e.g., \code{"k3l3"}). #' @return List containing the following items: \item{L}{length of the wavelet #' filter} \item{h0,g0}{low-pass filter coefficients} \item{h1,g1}{high-pass #' filter coefficients} #' @author B. Whitcher #' @seealso \code{\link{wave.filter}} #' @references Selesnick, I.W. (2001). Hilbert transform pairs of wavelet #' bases. \emph{IEEE Signal Processing Letters} \bold{8}(6), 170--173. #' #' Selesnick, I.W. (2002). The design of approximate Hilbert transform pairs #' of wavelet bases. \emph{IEEE Transactions on Signal Processing} #' \bold{50}(5), 1144--1152. #' @keywords ts #' @examples #' #' hilbert.filter("k3l3") #' hilbert.filter("k3l5") #' hilbert.filter("k4l2") #' hilbert.filter("k4l4") #' #' @export hilbert.filter hilbert.filter <- function(name) { select.K3L3 <- function() { L <- 12 h0 <- c(1.1594353e-04, -2.2229002e-03, -2.2046914e-03, 4.3427642e-02, -3.3189896e-02, -1.5642755e-01, 2.8678636e-01, 7.9972652e-01, 4.9827824e-01, 2.4829160e-02, -4.2679177e-02, -2.2260892e-03) h1 <- qmf(h0) g0 <- c(1.6563361e-05, -5.2543406e-05, -6.1909121e-03, 1.9701141e-02, 3.2369691e-02, -1.2705043e-01, -1.5506397e-02, 6.1333712e-01, 7.4585008e-01, 2.1675412e-01, -4.9432248e-02, -1.5582624e-02) g1 <- qmf(g0) return(list(length = L, hpf = list(h1, g1), lpf = list(h0, g0))) } select.K3L5 <- function() { L <- 12 h0 <- c(5.4258791e-06, -2.1310518e-04, -2.6140914e-03, 1.0212881e-02, 3.5747880e-02, -4.5576766e-02, 3.9810341e-03, 5.3402475e-01, 7.8757164e-01, 2.6537457e-01, -1.3008915e-01, -5.9573795e-02, 1.2733976e-02, 2.8641011e-03, -2.2992683e-04, -5.8541759e-06) h1 <- qmf(h0) g0 <- c(4.9326174e-07, 3.5727140e-07, -1.1664703e-03, -8.4003116e-04, 2.8601474e-02, 9.2509748e-03, -7.4562251e-02, 2.2929480e-01, 7.6509138e-01, 5.8328559e-01, -4.6218010e-03, -1.2336841e-01, -6.2826896e-03, 9.5478911e-03, 4.6642226e-05, -6.4395935e-05) g1 <- qmf(g0) return(list(length = L, hpf = list(h1, g1), lpf = list(h0, g0))) } select.K4L2 <- function() { L <- 12 h0 <- c(-1.7853301e-03, 1.3358873e-02, 3.6090743e-02, -3.4722190e-02, 4.1525062e-02, 5.6035837e-01, 7.7458617e-01, 2.2752075e-01, -1.6040927e-01, -6.1694251e-02, 1.7099408e-02, 2.2852293e-03) h1 <- qmf(h0) g0 <- c(-3.5706603e-04, -1.8475351e-04, 3.2591486e-02, 1.3449902e-02, -5.8466725e-02, 2.7464308e-01, 7.7956622e-01, 5.4097379e-01, -4.0315008e-02, -1.3320138e-01, -5.9121296e-03, 1.1426146e-02) g1 <- qmf(g0) return(list(length = L, hpf = list(h1, g1), lpf = list(h0, g0))) } select.K4L4 <- function() { L <- 16 h0 <- c(2.5734665593981519e-05, -6.6909066441298817e-04, -5.5482443985275260e-03, 1.3203474646343588e-02, 3.8605327384848696e-02, -5.0687259299773510e-02, 8.1364447220208733e-03, 5.3021727476690994e-01, 7.8330912249663232e-01, 2.7909546754271131e-01, -1.3372674246928601e-01, -6.9759509629953295e-02, 1.6979390952358446e-02, 5.7323570134311854e-03, -6.7425216644469892e-04, -2.5933188060087743e-05) h1 <- qmf(h0) g0 <- c(2.8594072882201687e-06, 1.9074538622058143e-06, -2.9903835439216066e-03, -1.9808995184875909e-03, 3.3554663884350758e-02, 7.7023844121478988e-03, -7.7084571412435535e-02, 2.3298110528093252e-01, 7.5749376288995063e-01, 5.8834703992067783e-01, 5.1708789323078770e-03, -1.3520099946241465e-01, -9.1961246067629732e-03, 1.5489641793018745e-02, 1.5569563641876791e-04, -2.3339869254078969e-04) g1 <- qmf(g0) return(list(length = L, hpf = list(h1, g1), lpf = list(h0, g0))) } select.K5L7 <- function() { L <- 24 h0 <- c(-2.5841959496364648e-10, 6.0231243121018760e-10, 2.1451486802217960e-06, -4.9989222844980982e-06, -2.2613489535132104e-04, 5.1967501391358343e-04, 3.4011963595840899e-03, -7.1996997688061597e-03, -1.7721433874932836e-02, 3.5491112173858148e-02, 3.0580617312936355e-02, -1.3452365188777773e-01, 2.1741748603083836e-03, 5.8046856094922639e-01, 7.4964083145768690e-01, 2.6775497264154541e-01, -7.9593287728224230e-02, -4.3942149960221458e-02, 1.9574969406037097e-02, 8.8554643330725387e-03, -7.2770446614145033e-04, -3.1310992841759443e-04, 1.4045333283124608e-06, 6.0260907100656169e-07) h1 <- qmf(h0) g0 <- c(-3.8762939244546978e-09, 2.9846463282743695e-07, 5.6276030758515370e-06, -7.7697066311187957e-05, -2.1442686434841905e-04, 2.1948612668324223e-03, 9.5408758453423542e-04, -1.7149735951945008e-02, 1.5212479104581677e-03, 5.6600564413983846e-02, -4.8900162376504831e-02, -1.3993440493611778e-01, 2.7793346796113222e-01, 7.6735603850281364e-01, 5.4681951651005178e-01, 3.6275855872448776e-02, -8.8224410289407154e-02, 3.2821708368951431e-05, 1.7994969189524142e-02, 1.8662128501760204e-03, -7.8622878632753014e-04, -5.8077443328549205e-05, 3.0932895975646042e-06, 4.0173938067104100e-08) g1 <- qmf(g0) return(list(length = L, hpf = list(h1, g1), lpf = list(h0, g0))) } select.K6L6 <- function() { L <- 24 h0 <- c(1.4491207137947255e-09 -3.4673992369566253e-09, -6.7544152844875963e-06, 1.6157040144070828e-05, 4.0416340595645441e-04, -9.4536696039781878e-04, -4.2924086033924620e-03, 9.0688042722858742e-03, 1.8690864167884680e-02, -3.7883945370993717e-02, -2.7337592282061701e-02, 1.3185812419468312e-01, -2.1034481553730465e-02, -5.9035515013747486e-01, -7.4361804647499452e-01, -2.5752016951708306e-01, 9.2725410672739983e-02, 4.9100676534870831e-02, -2.4411085480175867e-02, -1.1190458223944993e-02, 1.7793885751382626e-03, 7.4715940333597059e-04, -6.2392430013359510e-06, -2.6075498267775052e-06) h1 <- qmf(h0) g0 <- c(1.8838569279331431e-08, -1.1000360697229965e-06, -1.4600820117782769e-05, 1.6936567299204319e-04, 2.6967189953984829e-04, -3.1633669438102655e-03, -7.2081460313487946e-04, 1.9638595542490079e-02, -3.0968325940269846e-03, -5.6722348677476261e-02, 5.2260784738219289e-02, 1.2763836788794369e-01, -2.9566169882112192e-01, -7.6771793937333599e-01, -5.3818432160802543e-01, -2.4023872575927138e-02, 9.9019132161496132e-02, -1.2059411664071501e-03, -2.2693488886969308e-02, -1.8724943382560243e-03, 1.7270823778712107e-03, 1.5415480681200776e-04, -1.1712464100067407e-05, -2.0058075590596196e-07) g1 <- qmf(g0) return(list(length = L, hpf = list(-h1, -g1), lpf = list(-h0, -g0))) } switch(name, "k3l3" = select.K3L3(), "k3l5" = select.K3L5(), "k4l2" = select.K4L2(), "k4l4" = select.K4L4(), "k5l7" = select.K5L7(), "k6l6" = select.K6L6(), stop("Invalid selection for hilbert.filter")) } ######################################################################## #' Phase Shift for Hilbert Wavelet Coefficients #' #' Wavelet coefficients are circularly shifted by the amount of phase shift #' induced by the discrete Hilbert wavelet transform. #' #' The "center-of-energy" argument of Hess-Nielsen and Wickerhauser (1996) is #' used to provide a flexible way to circularly shift wavelet coefficients #' regardless of the wavelet filter used. #' #' @aliases phase.shift.hilbert phase.shift.hilbert.packet #' @param x Discete Hilbert wavelet transform (DHWT) object. #' @param wf character string; Hilbert wavelet pair used in DHWT #' @return DHWT (DHWPT) object with coefficients circularly shifted. #' @author B. Whitcher #' @seealso \code{\link{phase.shift}} #' @references Hess-Nielsen, N. and M. V. Wickerhauser (1996) Wavelets and #' time-frequency analysis, \emph{Proceedings of the IEEE}, \bold{84}, No. 4, #' 523-540. #' @keywords ts #' @export phase.shift.hilbert phase.shift.hilbert <- function(x, wf) { coe <- function(g) sum(0:(length(g)-1) * g^2) / sum(g^2) J <- length(x) - 1 h0 <- hilbert.filter(wf)$lpf[[1]] h1 <- hilbert.filter(wf)$hpf[[1]] for(j in 1:J) { ph <- round(2^(j-1) * (coe(h0) + coe(h1)) - coe(h0), 0) Nj <- length(x[[j]]) x[[j]] <- c(x[[j]][(ph+1):Nj], x[[j]][1:ph]) } ph <- round((2^J-1) * coe(h0), 0) J <- J + 1 x[[J]] <- c(x[[J]][(ph+1):Nj], x[[J]][1:ph]) return(x) } ######################################################################## modwpt.hilbert <- function(x, wf, n.levels=4, boundary="periodic") { N <- length(x) storage.mode(N) <- "integer" J <- n.levels if(2^J > N) stop("wavelet transform exceeds sample size in modwpt") dict <- hilbert.filter(wf) L <- dict$length; storage.mode(L) <- "integer" h0 <- dict$lpf[[1]] / sqrt(2); storage.mode(h0) <- "double" g0 <- dict$lpf[[2]] / sqrt(2); storage.mode(g0) <- "double" h1 <- dict$hpf[[1]] / sqrt(2); storage.mode(h1) <- "double" g1 <- dict$hpf[[2]] / sqrt(2); storage.mode(g1) <- "double" y <- vector("list", sum(2^(1:J))) yn <- length(y) crystals1 <- rep(1:J, 2^(1:J)) crystals2 <- unlist(apply(as.matrix(2^(1:J) - 1), 1, seq, from=0)) names(y) <- paste("w", crystals1, ".", crystals2, sep="") W <- V <- numeric(N) storage.mode(W) <- storage.mode(V) <- "double" for(j in 1:J) { ## cat(paste("j =", j, fill=T)) index <- 0 jj <- min((1:yn)[crystals1 == j]) for(n in 0:(2^j / 2 - 1)) { index <- index + 1 if(j > 1) x <- y[[(1:yn)[crystals1 == j-1][index]]] else x <- complex(real=x, imaginary=x) if(n %% 2 == 0) { zr <- .C(C_modwt, as.double(Re(x)), N, as.integer(j), L, h1, h0, W = W, V = V)[7:8] zc <- .C(C_modwt, as.double(Im(x)), N, as.integer(j), L, g1, g0, W = W, V = V)[7:8] y[[jj + 2*n + 1]] <- complex(real=zr$W, imaginary=zc$W) y[[jj + 2*n]] <- complex(real=zr$V, imaginary=zc$V) } else { zr <- .C(C_modwt, as.double(Re(x)), N, as.integer(j), L, h1, h0, W = W, V = V)[7:8] zc <- .C(C_modwt, as.double(Im(x)), N, as.integer(j), L, g1, g0, W = W, V = V)[7:8] y[[jj + 2*n]] <- complex(real=zr$W, imaginary=zc$W) y[[jj + 2*n + 1 ]] <- complex(real=zr$V, imaginary=zc$V) } } } attr(y, "wavelet") <- wf return(y) } ######################################################################## phase.shift.hilbert.packet <- function(x, wf) { coe <- function(g) sum(0:(length(g)-1) * g^2) / sum(g^2) dict <- hilbert.filter(wf) h0 <- dict$lpf[[1]]; h1 <- dict$hpf[[1]] g0 <- dict$lpf[[2]]; g1 <- dict$hpf[[2]] xn <- length(x) N <- length(x[[1]]) J <- trunc(log(xn,2)) jbit <- vector("list", xn) jbit[[1]] <- FALSE; jbit[[2]] <- TRUE crystals1 <- rep(1:J, 2^(1:J)) for(j in 1:J) { jj <- min((1:xn)[crystals1 == j]) for(n in 0:(2^j - 1)) { if(j > 1) { jp <- min((1:xn)[crystals1 == j-1]) if(n %% 4 == 0 | n %% 4 == 3) jbit[[jj + n]] <- c(jbit[[jp + floor(n/2)]], FALSE) else jbit[[jj + n]] <- c(jbit[[jp + floor(n/2)]], TRUE) } Sjn0 <- sum((1 - jbit[[jj + n]]) * 2^(0:(j-1))) Sjn1 <- sum(jbit[[jj + n]] * 2^(0:(j-1))) ph <- round(Sjn0 * coe(h0) + Sjn1 * coe(h1), 0) x[[jj + n]] <- c(x[[jj + n]][(ph+1):N], x[[jj + n]][1:ph]) } } return(x) } #' Time-varying and Seasonal Analysis Using Hilbert Wavelet Pairs #' #' Performs time-varying or seasonal coherence and phase anlaysis between two #' time seris using the maximal-overlap discrete Hilbert wavelet transform #' (MODHWT). #' #' The idea of seasonally-varying spectral analysis (SVSA, Madden 1986) is #' generalized using the MODWT and Hilbert wavelet pairs. For the seasonal #' case, \eqn{S} seasons are used to produce a consistent estimate of the #' coherence and phase. For the non-seasonal case, a simple rectangular #' (moving-average) filter is applied to the MODHWT coefficients in order to #' produce consistent estimates. #' #' @usage modhwt.coh(x, y, f.length = 0) #' @usage modhwt.phase(x, y, f.length = 0) #' @usage modhwt.coh.seasonal(x, y, S = 10, season = 365) #' @usage modhwt.phase.seasonal(x, y, season = 365) #' @aliases modhwt.coh modhwt.phase modhwt.coh.seasonal modhwt.phase.seasonal #' @param x MODHWT object. #' @param y MODHWT object. #' @param f.length Length of the rectangular filter. #' @param S Number of "seasons". #' @param season Length of the "season". #' @return Time-varying or seasonal coherence and phase between two time #' series. The coherence estimates are between zero and one, while the phase #' estimates are between \eqn{-\pi}{-pi} and \eqn{\pi}{pi}. #' @author B. Whitcher #' @seealso \code{\link{hilbert.filter}} #' @references Madden, R.A. (1986). Seasonal variation of the 40--50 day #' oscillation in the tropics. \emph{Journal of the Atmospheric Sciences} #' \bold{43}(24), 3138--3158. #' #' Whither, B. and P.F. Craigmile (2004). Multivariate Spectral Analysis Using #' Hilbert Wavelet Pairs, \emph{International Journal of Wavelets, #' Multiresolution and Information Processing}, \bold{2}(4), 567--587. #' @keywords ts modhwt.coh <- function(x, y, f.length = 0) { filt <- rep(1, f.length + 1) filt <- filt / length(filt) J <- length(x) - 1 coh <- vector("list", J) for(j in 1:J) { co.spec <- filter(Re(x[[j]] * Conj(y[[j]])), filt) quad.spec <- filter(-Im(x[[j]] * Conj(y[[j]])), filt) x.spec <- filter(Mod(x[[j]])^2, filt) y.spec <- filter(Mod(y[[j]])^2, filt) coh[[j]] <- (co.spec^2 + quad.spec^2) / x.spec / y.spec } coh } ######################################################################## modhwt.phase <- function(x, y, f.length = 0) { filt <- rep(1, f.length + 1) filt <- filt / length(filt) J <- length(x) - 1 phase <- vector("list", J) for(j in 1:J) { co.spec <- filter(Re(x[[j]] * Conj(y[[j]])), filt) quad.spec <- filter(-Im(x[[j]] * Conj(y[[j]])), filt) phase[[j]] <- Arg(co.spec - 1i * quad.spec) } phase } ######################################################################## modhwt.coh.seasonal <- function(x, y, S=10, season=365) { J <- length(x) - 1 coh <- shat <- vector("list", J) for(j in 1:J) { xj <- x[[j]] yj <- y[[j]] ## Cospectrum co <- matrix(Re(xj * Conj(yj)), ncol=season, byrow=TRUE) co.spec <- c(apply(co, 2, mean, na.rm=TRUE)) gamma.c <- my.acf(as.vector(co)) omega.c <- sum(gamma.c[c(1, rep(seq(season+1, S*season, by=season), each=2))]) ## Quadrature spectrum quad <- matrix(-Im(xj * Conj(yj)), ncol=season, byrow=TRUE) quad.spec <- c(apply(quad, 2, mean, na.rm=TRUE)) gamma.q <- my.acf(as.vector(quad)) omega.q <- sum(gamma.q[c(1, rep(seq(season+1, S*season, by=season), each=2))]) gamma.cq <- my.ccf(as.vector(co), as.vector(quad)) omega.cq <- sum(gamma.cq[S*season + seq(-S*season+1, S*season, by=season)]) ## Autospectrum(X) autoX <- matrix(Mod(xj)^2, ncol=season, byrow=TRUE) x.spec <- c(apply(autoX, 2, mean, na.rm=TRUE)) ## Autospectrum(Y) autoY <- matrix(Mod(yj)^2, ncol=season, byrow=TRUE) y.spec <- c(apply(autoY, 2, mean, na.rm=TRUE)) shat[[j]] <- 4 * (co.spec*omega.c + quad.spec * omega.q + 2*co.spec*quad.spec*omega.cq) / x.spec^2 / y.spec^2 coh[[j]] <- (co.spec^2 + quad.spec^2) / x.spec / y.spec } list(coh = coh, var = shat) } ######################################################################## modhwt.phase.seasonal <- function(x, y, season=365) { J <- length(x) - 1 phase <- vector("list", J) for(j in 1:J) { co.spec <- Re(x[[j]] * Conj(y[[j]])) co.spec <- c(apply(matrix(co.spec, ncol=season, byrow=TRUE), 2, mean, na.rm=TRUE)) quad.spec <- -Im(x[[j]] * Conj(y[[j]])) quad.spec <- c(apply(matrix(quad.spec, ncol=season, byrow=TRUE), 2, mean, na.rm=TRUE)) phase[[j]] <- Arg(co.spec - 1i * quad.spec) } phase } waveslim/R/dwpt_sim.R0000644000176200001440000001563614627073455014303 0ustar liggesusers#' Simulate Seasonal Persistent Processes Using the DWPT #' #' A seasonal persistent process may be characterized by a spectral density #' function with an asymptote occuring at a particular frequency in #' \eqn{[0,\frac{1}{2})}{[0,1/2)}. It's time domain representation was first #' noted in passing by Hosking (1981). Although an exact time-domain approach #' to simulation is possible, this function utilizes the discrete wavelet #' packet transform (DWPT). #' #' Two subroutines are used, the first selects an adaptive orthonormal basis #' for the true spectral density function (SDF) while the second computes the #' bandpass variances associated with the chosen orthonormal basis and SDF. #' Finally, when \eqn{M>N}{\code{M} > \code{N}} a uniform random variable is #' generated in order to select a random piece of the simulated time series. #' For more details see Whitcher (2001). #' #' @param N Length of time series to be generated. #' @param wf Character string for the wavelet filter. #' @param delta Long-memory parameter for the seasonal persistent process. #' @param fG Gegenbauer frequency. #' @param M Actual length of simulated time series. #' @param adaptive Logical; if \code{TRUE} the orthonormal basis used in the #' DWPT is adapted to the ideal spectrum, otherwise the orthonormal basis is #' performed to a maximum depth. #' @param epsilon Threshold for adaptive basis selection. #' @return Time series of length \code{N}. #' @author B. Whitcher #' @seealso \code{\link{hosking.sim}} for an exact time-domain method and #' \code{\link{wave.filter}} for a list of available wavelet filters. #' @references Hosking, J. R. M. (1981) Fractional Differencing, #' \emph{Biometrika}, \bold{68}, No. 1, 165-176. #' #' Whitcher, B. (2001) Simulating Gaussian Stationary Time Series with #' Unbounded Spectra, \emph{Journal of Computational and Graphical Statistics}, #' \bold{10}, No. 1, 112-134. #' @keywords ts #' @examples #' #' ## Generate monthly time series with annual oscillation #' ## library(ts) is required in order to access acf() #' x <- dwpt.sim(256, "mb16", .4, 1/12, M=4, epsilon=.001) #' par(mfrow=c(2,1)) #' plot(x, type="l", xlab="Time") #' acf(x, lag.max=128, ylim=c(-.6,1)) #' data(acvs.andel8) #' lines(acvs.andel8$lag[1:128], acvs.andel8$acf[1:128], col=2) #' #' @export dwpt.sim dwpt.sim <- function(N, wf, delta, fG, M=2, adaptive=TRUE, epsilon=0.05) { M <- M*N J <- log(M, 2) jn <- rep(1:J, 2^(1:J)) jl <- length(jn) if( adaptive ) { Basis <- find.adaptive.basis(wf, J, fG, epsilon) } else { Basis <- numeric(jl) a <- min((1:jl)[jn == J]) b <- max((1:jl)[jn == J]) Basis[a:b] <- 1 } Index <- (1:jl)[as.logical(Basis)] Length <- 2^jn variance <- bandpass.var.spp(delta, fG, J, Basis, Length) z <- vector("list", jl) class(z) <- "dwpt" attr(z, "wavelet") <- wf for(i in Index) z[[i]] <- rnorm(M/Length[i], sd=sqrt(Length[i]*variance[i])) x <- idwpt(z, Basis) xi <- trunc(runif(1, 1, M-N)) return(x[xi:(xi+N-1)]) } #' Determine an Orthonormal Basis for the Discrete Wavelet Packet Transform #' #' Subroutine for use in simulating seasonal persistent processes using the #' discrete wavelet packet transform. #' #' The squared gain functions for a Daubechies (extremal phase or least #' asymmetric) wavelet family are used in a filter cascade to compute the value #' of the squared gain function for the wavelet packet filter at the #' Gengenbauer frequency. This is done for all nodes of the wavelet packet #' table. #' #' The idea behind this subroutine is to approximate the relationship between #' the discrete wavelet transform and long-memory processes, where the squared #' gain function is zero at frequency zero for all levels of the DWT. #' #' @param wf Character string; name of the wavelet filter. #' @param J Depth of the discrete wavelet packet transform. #' @param fG Gegenbauer frequency. #' @param eps Threshold for the squared gain function. #' @return Boolean vector describing the orthonormal basis for the DWPT. #' @author B. Whitcher #' @seealso Used in \code{\link{dwpt.sim}}. #' @keywords ts #' @export find.adaptive.basis find.adaptive.basis <- function(wf, J, fG, eps) { H <- function(f, L) { H <- 0 for(l in 0:(L/2-1)) H <- H + choose(L/2+l-1,l) * cos(pi*f)^(2*l) H <- 2 * sin(pi*f)^L * H return(H) } G <- function(f, L) { G <- 0 for(l in 0:(L/2-1)) G <- G + choose(L/2+l-1,l) * sin(pi*f)^(2*l) G <- 2 * cos(pi*f)^L * G return(G) } L <- wave.filter(wf)$length jn <- rep(1:J, 2^(1:J)) jl <- length(jn) U <- numeric(jl) U[1] <- G(fG, L) U[2] <- H(fG, L) for(j in 2:J) { jj <- min((1:jl)[jn == j]) jp <- (1:jl)[jn == j-1] for(n in 0:(2^j/2-1)) { if (n%%2 == 0) { U[jj + 2 * n + 1] <- U[jp[n+1]] * H(2^(j-1)*fG, L) U[jj + 2 * n] <- U[jp[n+1]] * G(2^(j-1)*fG, L) } else { U[jj + 2 * n] <- U[jp[n+1]] * H(2^(j-1)*fG, L) U[jj + 2 * n + 1] <- U[jp[n+1]] * G(2^(j-1)*fG, L) } } } return(ortho.basis(U < eps)) } #' Bandpass Variance for Long-Memory Processes #' #' Computes the band-pass variance for fractional difference (FD) or seasonal #' persistent (SP) processes using numeric integration of their spectral #' density function. #' #' See references. #' #' @usage bandpass.fdp(a, b, d) #' @usage bandpass.spp(a, b, d, fG) #' @usage bandpass.spp2(a, b, d1, f1, d2, f2) #' @usage bandpass.var.spp(delta, fG, J, Basis, Length) #' @aliases bandpass.fdp bandpass.spp bandpass.spp2 bandpass.var.spp #' @param a Left-hand boundary for the definite integral. #' @param b Right-hand boundary for the definite integral. #' @param d,delta,d1,d2 Fractional difference parameter. #' @param fG,f1,f2 Gegenbauer frequency. #' @param J Depth of the wavelet transform. #' @param Basis Logical vector representing the adaptive basis. #' @param Length Number of elements in Basis. #' @return Band-pass variance for the FD or SP process between \eqn{a} and #' \eqn{b}. #' @author B. Whitcher #' @references McCoy, E. J., and A. T. Walden (1996) Wavelet analysis and #' synthesis of stationary long-memory processes, \emph{Journal for #' Computational and Graphical Statistics}, \bold{5}, No. 1, 26-56. #' #' Whitcher, B. (2001) Simulating Gaussian stationary processes with unbounded #' spectra, \emph{Journal for Computational and Graphical Statistics}, #' \bold{10}, No. 1, 112-134. #' @keywords ts bandpass.var.spp <- function(delta, fG, J, Basis, Length) { a <- unlist(sapply(2^(1:J)-1, seq, from=0, by=1)) / (2*Length) b <- unlist(sapply(2^(1:J), seq, from=1, by=1)) / (2*Length) bp.var <- rep(0, length(Basis)) for(jn in (1:length(Basis))[as.logical(Basis)]) { if(fG < a[jn] | fG > b[jn]) bp.var[jn] <- 2*integrate(spp.sdf, a[jn], b[jn], d=delta, fG=fG)$value else { result1 <- 2*integrate(spp.sdf, a[jn], fG, d=delta, fG=fG)$value result2 <- 2*integrate(spp.sdf, fG, b[jn], d=delta, fG=fG)$value bp.var[jn] <- result1 + result2 } } return(bp.var) } waveslim/R/dwpt_boot.R0000644000176200001440000000531014627073455014442 0ustar liggesusers#' Bootstrap Time Series Using the DWPT #' #' An adaptive orthonormal basis is selected in order to perform the naive #' bootstrap within nodes of the wavelet packet tree. A bootstrap realization #' of the time series is produce by applying the inverse DWPT. #' #' A subroutines is used to select an adaptive orthonormal basis for the #' piecewise-constant approximation to the underlying spectral density function #' (SDF). Once selected, sampling with replacement is performed within each #' wavelet packet coefficient vector and the new collection of wavelet packet #' coefficients are reconstructed into a bootstrap realization of the original #' time series. #' #' @param y Not necessarily dyadic length time series. #' @param wf Name of the wavelet filter to use in the decomposition. See #' \code{\link{wave.filter}} for those wavelet filters available. #' @param J Depth of the discrete wavelet packet transform. #' @param p Level of significance for the white noise testing procedure. #' @param frac Fraction of the time series that should be used in constructing #' the likelihood function. #' @return Time series of length $N$, where $N$ is the length of \code{y}. #' @author B. Whitcher #' @seealso \code{\link{dwpt.sim}}, \code{\link{spp.mle}} #' @references Percival, D.B., S. Sardy, A. Davision (2000) Wavestrapping Time #' Series: Adaptive Wavelet-Based Bootstrapping, in B.J. Fitzgerald, R.L. #' Smith, A.T. Walden, P.C. Young (Eds.) \emph{Nonlinear and Nonstationary #' Signal Processing}, pp. 442-471. #' #' Whitcher, B. (2001) Simulating Gaussian Stationary Time Series with #' Unbounded Spectra, \emph{Journal of Computational and Graphical Statistics}, #' \bold{10}, No. 1, 112-134. #' #' Whitcher, B. (2004) Wavelet-Based Estimation for Seasonal Long-Memory #' Processes, \emph{Technometrics}, \bold{46}, No. 2, 225-238. #' @keywords ts #' @export dwpt.boot dwpt.boot <- function(y, wf, J=log(length(y),2)-1, p=1e-04, frac=1) { N <- length(y) if(N/2^J != trunc(N/2^J)) stop("Sample size is not divisible by 2^J") ## Perform discrete wavelet packet transform (DWPT) on Y y.dwpt <- dwpt(y, wf, n.levels=J) n <- length(y) if(frac < 1) { for(i in 1:length(y.dwpt)) { vec <- y.dwpt[[i]] ni <- length(vec) j <- rep(1:J, 2^(1:J))[i] vec[trunc(frac * n/2^j):ni] <- NA y.dwpt[[i]] <- vec } } y.basis <- as.logical(ortho.basis(portmanteau.test(y.dwpt, p, type="other"))) ## Taken from my 2D bootstrapping methodology resample.dwpt <- y.dwpt for(i in 1:length(y.basis)) { m <- length(y.dwpt[[i]]) if(y.basis[i]) resample.dwpt[[i]] <- sample(y.dwpt[[i]], replace=TRUE) else resample.dwpt[[i]] <- rep(NA, m) } idwpt(resample.dwpt, y.basis) } waveslim/R/wave.filter.R0000644000176200001440000002302214627073455014667 0ustar liggesusers#' Select a Wavelet Filter #' #' Converts name of wavelet filter to filter coefficients. #' #' Simple \code{switch} statement selects the appropriate filter. #' #' @param name Character string of wavelet filter. #' @return List containing the following items: \item{L}{Length of the wavelet #' filter.} \item{hpf}{High-pass filter coefficients.} \item{lpf}{Low-pass #' filter coefficients.} #' @author B. Whitcher #' @seealso \code{\link{wavelet.filter}}, \code{\link{squared.gain}}. #' @references Daubechies, I. (1992) \emph{Ten Lectures on Wavelets}, CBMS-NSF #' Regional Conference Series in Applied Mathematics, SIAM: Philadelphia. #' #' Doroslovacki (1998) On the least asymmetric wavelets, \emph{IEEE #' Transactions for Signal Processing}, \bold{46}, No. 4, 1125-1130. #' #' Morris and Peravali (1999) Minimum-bandwidth discrete-time wavelets, #' \emph{Signal Processing}, \bold{76}, No. 2, 181-193. #' #' Nielsen, M. (2000) On the Construction and Frequency Localization of #' Orthogonal Quadrature Filters, \emph{Journal of Approximation Theory}, #' \bold{108}, No. 1, 36-52. #' @keywords ts #' @export wave.filter wave.filter <- function(name) { select.haar <- function() { L <- 2 g <- c(0.7071067811865475, 0.7071067811865475) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.d4 <- function() { L <- 4 g <- c(0.4829629131445341, 0.8365163037378077, 0.2241438680420134, -0.1294095225512603) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.mb4 <- function() { L <- 4 g <- c(4.801755e-01, 8.372545e-01, 2.269312e-01, -1.301477e-01) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.bs3.1 <- function() { L <- 4 g <- c(0.1767767, 0.5303301, 0.5303301, 0.1767767) h <- qmf(g) gd <- c(0.3535534, 1.06066, -1.06066, -0.3535534) hd <- qmf(g) return(list(length = L, hpf = h, lpf = g, dhpf = hd, dlpf = gd)) } select.w4 <- function() { L <- 4 g <- c(-1, 3, 3, -1) / 8 h <- c(-1, 3, -3, 1) / 8 return(list(length = L, hpf = h, lpf = g)) } select.fk4 <- function() { L <- 4 g <- c(.6539275555697651, .7532724928394872, .5317922877905981e-1, -.4616571481521770e-1) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.d6 <- function() { L <- 6 g <- c(0.3326705529500827, 0.8068915093110928, 0.4598775021184915, -0.1350110200102546, -0.0854412738820267, 0.0352262918857096) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.fk6 <- function() { L <- 6 g <- c(.4279150324223103, .8129196431369074, .3563695110701871, -.1464386812725773, -.7717775740697006e-1, .4062581442323794e-1) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.d8 <- function() { L <- 8 g <- c(0.2303778133074431, 0.7148465705484058, 0.6308807679358788, -0.0279837694166834, -0.1870348117179132, 0.0308413818353661, 0.0328830116666778, -0.0105974017850021) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.fk8 <- function() { L <- 8 g <- c(.3492381118637999, .7826836203840648, .4752651350794712, -.9968332845057319e-1, -.1599780974340301, .4310666810651625e-1, .4258163167758178e-1, -.1900017885373592e-1) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.la8 <- function() { L <- 8 g <- c(-0.07576571478935668, -0.02963552764596039, 0.49761866763256290, 0.80373875180538600, 0.29785779560560505, -0.09921954357695636, -0.01260396726226383, 0.03222310060407815) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.mb8 <- function() { L <- 8 g <- rev(c(-1.673619e-01, 1.847751e-02, 5.725771e-01, 7.351331e-01, 2.947855e-01, -1.108673e-01, 7.106015e-03, 6.436345e-02)) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.bl14 <- function() { L <- 14 g <- c( 0.0120154192834842, 0.0172133762994439, -0.0649080035533744, -0.0641312898189170, 0.3602184608985549, 0.7819215932965554, 0.4836109156937821, -0.0568044768822707, -0.1010109208664125, 0.0447423494687405, 0.0204642075778225, -0.0181266051311065, -0.0032832978473081, 0.0022918339541009) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.fk14 <- function() { L <- 14 g <- c(.2603717692913964, .6868914772395985, .6115546539595115, .5142165414211914e-1, -.2456139281621916, -.4857533908585527e-1, .1242825609215128, .2222673962246313e-1, -.6399737303914167e-1, -.5074372549972850e-2, .2977971159037902e-1, -.3297479152708717e-2, -.9270613374448239e-2, .3514100970435962e-2) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.d16 <- function() { L <- 16 g <- c(0.0544158422431049, 0.3128715909143031, 0.6756307362972904, 0.5853546836541907, -0.0158291052563816, -0.2840155429615702, 0.0004724845739124, 0.1287474266204837, -0.0173693010018083, -0.0440882539307952, 0.0139810279173995, 0.0087460940474061, -0.0048703529934518, -0.0003917403733770, 0.0006754494064506, -0.0001174767841248) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.la16 <- function() { L <- 16 g <- c(-0.0033824159513594, -0.0005421323316355, 0.0316950878103452, 0.0076074873252848, -0.1432942383510542, -0.0612733590679088, 0.4813596512592012, 0.7771857516997478, 0.3644418948359564, -0.0519458381078751, -0.0272190299168137, 0.0491371796734768, 0.0038087520140601, -0.0149522583367926, -0.0003029205145516, 0.0018899503329007) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.mb16 <- function() { L <- 16 g <- rev(c(-1.302770e-02, 2.173677e-02, 1.136116e-01, -5.776570e-02, -2.278359e-01, 1.188725e-01, 6.349228e-01, 6.701646e-01, 2.345342e-01, -5.656657e-02, -1.987986e-02, 5.474628e-02, -2.483876e-02, -4.984698e-02, 9.620427e-03, 5.765899e-03)) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.la20 <- function() { L <- 20 g <- c(0.0007701598091030, 0.0000956326707837, -0.0086412992759401, -0.0014653825833465, 0.0459272392237649, 0.0116098939129724, -0.1594942788575307, -0.0708805358108615, 0.4716906668426588, 0.7695100370143388, 0.3838267612253823, -0.0355367403054689, -0.0319900568281631, 0.0499949720791560, 0.0057649120455518, -0.0203549398039460, -0.0008043589345370, 0.0045931735836703, 0.0000570360843390, -0.0004593294205481) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.bl20 <- function() { L <- 20 g <- c(0.0008625782242896, 0.0007154205305517, -0.0070567640909701, 0.0005956827305406, 0.0496861265075979, 0.0262403647054251, -0.1215521061578162, -0.0150192395413644, 0.5137098728334054, 0.7669548365010849, 0.3402160135110789, -0.0878787107378667, -0.0670899071680668, 0.0338423550064691, -0.0008687519578684, -0.0230054612862905, -0.0011404297773324, 0.0050716491945793, 0.0003401492622332, -0.0004101159165852) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.fk22 <- function() { L <- 22 g <- c(.1938961077599566, .5894521909294277, .6700849629420265, .2156298491347700, -.2280288557715772, -.1644657152688429, .1115491437220700, .1101552649340661, -.6608451679377920e-1, -.7184168192312605e-1, .4354236762555708e-1, .4477521218440976e-1, -.2974288074927414e-1, -.2597087308902119e-1, .2028448606667798e-1, .1296424941108978e-1, -.1288599056244363e-1, -.4838432636440189e-2, .7173803165271690e-2, .3612855622194901e-3, -.2676991638581043e-2, .8805773686384639e-3) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } select.mb24 <- function() { L <- 24 g <- rev(c(-2.132706e-05, 4.745736e-04, 7.456041e-04, -4.879053e-03, -1.482995e-03, 4.199576e-02, -2.658282e-03, -6.559513e-03, 1.019512e-01, 1.689456e-01, 1.243531e-01, 1.949147e-01, 4.581101e-01, 6.176385e-01, 2.556731e-01, -3.091111e-01, -3.622424e-01, -4.575448e-03, 1.479342e-01, 1.027154e-02, -1.644859e-02, -2.062335e-03, 1.193006e-03, 5.361301e-05)) h <- qmf(g) return(list(length = L, hpf = h, lpf = g)) } switch(name, "haar" = select.haar(), "d4" = select.d4(), "mb4" = select.mb4(), "w4" = select.w4(), "bs3.1" = select.bs3.1(), "fk4" = select.fk4(), "d6" = select.d6(), "fk6" = select.fk6(), "d8" = select.d8(), "fk8" = select.fk8(), "la8" = select.la8(), "mb8" = select.mb8(), "bl14" = select.bl14(), "fk14" = select.fk14(), "d16" = select.d16(), "la16" = select.la16(), "mb16" = select.mb16(), "la20" = select.la20(), "bl20" = select.bl20(), "fk22" = select.fk22(), "mb24" = select.mb24(), stop("Invalid selection for wave.filter")) } #' Quadrature Mirror Filter #' #' Computes the quadrature mirror filter from a given filter. #' #' None. #' #' @param g Filter coefficients. #' @param low2high Logical, default is \code{TRUE} which means a low-pass #' filter is input and a high-pass filter is output. Setting \code{low2high=F} #' performs the inverse. #' @return Quadrature mirror filter. #' @author B. Whitcher #' @seealso \code{\link{wave.filter}}. #' @references Any basic signal processing text. #' @keywords ts #' @examples #' #' ## Haar wavelet filter #' g <- wave.filter("haar")$lpf #' qmf(g) #' #' @export qmf qmf <- function(g, low2high = TRUE) { L <- length(g) if(low2high) h <- (-1)^(0:(L - 1)) * rev(g) else h <- (-1)^(1:L) * rev(g) return(h) } waveslim/R/data.R0000644000176200001440000002261114627073455013355 0ustar liggesusers#' Autocovariance and Autocorrelation Sequences for a Seasonal Persistent #' Process #' #' The autocovariance and autocorrelation sequences from the time series model #' in Figures 8, 9, 10, and 11 of Andel (1986). They were obtained through #' numeric integration of the spectral density function. #' #' @usage data(acvs.andel8) #' @usage data(acvs.andel9) #' @usage data(acvs.andel10) #' @usage data(acvs.andel11) #' @name acvs.andel8 #' @docType data #' @aliases acvs.andel9 acvs.andel10 acvs.andel11 #' @format A data frame with 4096 rows and three columns: lag, autocovariance #' sequence, autocorrelation sequence. #' @references Andel, J. (1986) Long memory time series models, #' \emph{Kypernetika}, \bold{22}, No. 2, 105-123. #' @keywords datasets NULL #' Simulated AR(1) Series #' #' Simulated AR(1) series used in Gencay, Selcuk and Whitcher (2001). #' #' @usage data(ar1) #' @name ar1 #' @docType data #' @format A vector containing 200 observations. #' @references Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An #' Introduction to Wavelets and Other Filtering Methods in Finance and #' Economics}, Academic Press. #' @keywords datasets NULL #' Barbara Test Image #' #' The Barbara image comes from Allen Gersho's lab at the University of #' California, Santa Barbara. #' #' @usage data(barbara) #' @name barbara #' @docType data #' @format A 256 \eqn{\times}{x} 256 matrix. #' @source Internet. #' @keywords datasets NULL #' A Piecewise-Constant Function #' #' \deqn{blocks(x) = \sum_{j=1}^{11}(1 + {\rm sign}(x-p_j)) h_j / 2}{% #' blocks(x) = sum[j=1,11] (1 + sign(x - p_j)) h_j/2} #' #' @usage data(blocks) #' @name blocks #' @docType data #' @format A vector containing 512 observations. #' @references Bruce, A., and H.-Y. Gao (1996) \emph{Applied Wavelet Analysis #' with S-PLUS}, Springer: New York. #' @source S+WAVELETS. #' @keywords datasets NULL #' U.S. Consumer Price Index #' #' Monthly U.S. consumer price index from 1948:1 to 1999:12. #' #' @usage data(cpi) #' @name cpi #' @docType data #' @format A vector containing 624 observations. #' @references Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An #' Introduction to Wavelets and Other Filtering Methods in Finance and #' Economics}, Academic Press. #' @source Unknown. #' @keywords datasets NULL #' Digital Photograph of Ingrid Daubechies #' #' A digital photograph of Ingrid Daubechies taken at the 1993 AMS winter #' meetings in San Antonio, Texas. The photograph was taken by David Donoho #' with a Canon XapShot video still frame camera. #' #' @usage data(dau) #' @name dau #' @docType data #' @format A 256 \eqn{\times}{x} 256 matrix. #' @references Bruce, A., and H.-Y. Gao (1996) \emph{Applied Wavelet Analysis #' with S-PLUS}, Springer: New York. #' @source S+WAVELETS. #' @keywords datasets NULL #' Sinusoid with Changing Amplitude and Frequency #' #' \deqn{doppler(x) = \sqrt{x(1 - x)} }{% doppler(x) = sqrt{x(1-x)} #' sin[(2.1*pi)/(x+0.05)]}\deqn{ \sin\left(\frac{2.1\pi}{x+0.05}\right)}{% #' doppler(x) = sqrt{x(1-x)} sin[(2.1*pi)/(x+0.05)]} #' #' @usage data(doppler) #' @name doppler #' @docType data #' @format A vector containing 512 observations. #' @references Bruce, A., and H.-Y. Gao (1996) \emph{Applied Wavelet Analysis #' with S-PLUS}, Springer: New York. #' @source S+WAVELETS. #' @keywords datasets NULL #' Exchange Rates Between the Deutsche Mark, Japanese Yen and U.S. Dollar #' #' Monthly foreign exchange rates for the Deutsche Mark - U.S. Dollar (DEM-USD) #' and Japanese Yen - U.S. Dollar (JPY-USD) starting in 1970. #' #' @usage data(exchange) #' @name exchange #' @docType data #' @format A bivariate time series containing 348 observations. #' @references Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An #' Introduction to Wavelets and Other Filtering Methods in Finance and #' Economics}, Academic Press. #' @source Unknown. #' @keywords datasets NULL #' Sine with Jumps at 0.3 and 0.72 #' #' \deqn{heavisine(x) = 4\sin(4{\pi}x) - \mathrm{sign}(x-0.3) - }{% #' heavisine(x) = 4*sin(4*pi*x) - sign(x-0.3) - sign(0.72-x)}\deqn{ #' \mathrm{sign}(0.72-x)}{% heavisine(x) = 4*sin(4*pi*x) - sign(x-0.3) - #' sign(0.72-x)} #' #' @usage data(heavisine) #' @name heavisine #' @docType data #' @format A vector containing 512 observations. #' @references Bruce, A., and H.-Y. Gao (1996) \emph{Applied Wavelet Analysis #' with S-PLUS}, Springer: New York. #' @source S+WAVELETS. #' @keywords datasets NULL #' Daily IBM Stock Prices #' #' Daily IBM stock prices spanning May~17, 1961 to November~2, 1962. #' #' @usage data(ibm) #' @name ibm #' @docType data #' @format A vector containing 369 observations. #' @source Box, G. E.P. and Jenkins, G. M. (1976) \emph{Time Series Analysis: #' Forecasting and Control}, Holden Day, San Francisco, 2nd edition. #' @keywords datasets NULL #' Japanese Gross National Product #' #' Quarterly Japanese gross national product from 1955:1 to 1996:4. #' #' @usage data(japan) #' @name japan #' @docType data #' @format A vector containing 169 observations. #' @references Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An #' Introduction to Wavelets and Other Filtering Methods in Finance and #' Economics}, Academic Press. #' #' Hecq, A. (1998) Does seasonal adjustment induce common cycles?, #' \emph{Empirical Economics}, \bold{59}, 289-297. #' @source Unknown. #' @keywords datasets NULL #' Sine with Jumps at 0.625 and 0.875 #' #' \deqn{jumpsine(x) = 10\left( \sin(4{\pi}x) + #' I_{[0.625 < x \leq 0.875]}\right)}{% #' jumpsine(x) = 10*(sin(4*pi*x) + I_[0.625 < x <= 0.875])} #' #' @usage data(jumpsine) #' @name jumpsine #' @docType data #' @format A vector containing 512 observations. #' @references Bruce, A., and H.-Y. Gao (1996) \emph{Applied Wavelet Analysis #' with S-PLUS}, Springer: New York. #' @source S+WAVELETS. #' @keywords datasets NULL #' 1995 Kobe Earthquake Data #' #' Seismograph (vertical acceleration, nm/sq.sec) of the Kobe earthquake, #' recorded at Tasmania University, HobarTRUE, Australia on 16 January 1995 #' beginning at 20:56:51 (GMTRUE) and continuing for 51 minutes at 1 second #' intervals. #' #' @usage data(kobe) #' @name kobe #' @docType data #' @format A vector containing 3048 observations. #' @source Data management centre, Washington University. #' @keywords datasets NULL #' Linear Chirp #' #' \deqn{linchirp(x) = \sin(0.125 \pi n x^2)}{% #' linchirp(x) = sin(0.125*pi*n*x^2)} #' #' @usage data(linchirp) #' @name linchirp #' @docType data #' @format A vector containing 512 observations. #' @references Bruce, A., and H.-Y. Gao (1996) \emph{Applied Wavelet Analysis #' with S-PLUS}, Springer: New York. #' @source S+WAVELETS. #' @keywords datasets NULL #' Mexican Money Supply #' #' Percentage changes in monthly Mexican money supply. #' #' @usage data(mexm) #' @name mexm #' @docType data #' @format A vector containing 516 observations. #' @references Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An #' Introduction to Wavelets and Other Filtering Methods in Finance and #' Economics}, Academic Press. #' @source Unknown. #' @keywords datasets NULL #' Nile River Minima #' #' Yearly minimal water levels of the Nile river for the years 622 to 1281, #' measured at the Roda gauge near Cairo (Tousson, 1925, p. 366-385). The data #' are listed in chronological sequence by row. #' #' The original Nile river data supplied by Beran only contained only 500 #' observations (622 to 1121). However, the book claimed to have 660 #' observations (622 to 1281). The remaining observations from the book were #' added, by hand, but the series still only contained 653 observations (622 to #' 1264). #' #' Note, now the data consists of 663 observations (spanning the years #' 622-1284) as in original source (Toussoun, 1925). #' #' @usage data(nile) #' @name nile #' @docType data #' @format A length 663 vector. #' @references Beran, J. (1994) \emph{Statistics for Long-Memory Processes}, #' Chapman Hall: Englewood, NJ. #' @source Toussoun, O. (1925) M\'emoire sur l'Histoire du Nil, Volume 18 in #' \emph{M\'emoires a l'Institut d'Egypte}, pp. 366-404. #' @keywords datasets NULL #' U.S. Tourism #' #' Quarterly U.S. tourism figures from 1960:1 to 1999:4. #' #' @usage data(tourism) #' @name tourism #' @docType data #' @format A vector containing 160 observations. #' @references Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An #' Introduction to Wavelets and Other Filtering Methods in Finance and #' Economics}, Academic Press. #' @source Unknown. #' @keywords datasets NULL #' U.S. Unemployment #' #' Monthly U.S. unemployment figures from 1948:1 to 1999:12. #' #' @usage data(unemploy) #' @name unemploy #' @docType data #' @format A vector containing 624 observations. #' @references Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An #' Introduction to Wavelets and Other Filtering Methods in Finance and #' Economics}, Academic Press. #' @source Unknown. #' @keywords datasets NULL #' Image with Box and X #' #' \deqn{xbox(i,j) = I_{[i=n/4,\;3n/4,\;j;~ n/4 \leq j \leq 3n/4]} + }{% #' xbox(i,j) = I_[i = n/4, 3n/4, j; n/4 \leq j \leq 3n/4] + I_[n/4 \leq i \leq #' 3n/4; j = n/4, 3n/4, i]}\deqn{ I_{[n/4 \leq i \leq 3n/4;~ #' j=n/4,\;3n/4,\;i]}}{% xbox(i,j) = I_[i = n/4, 3n/4, j; n/4 \leq j \leq 3n/4] #' + I_[n/4 \leq i \leq 3n/4; j = n/4, 3n/4, i]} #' #' @usage data(xbox) #' @name xbox #' @docType data #' @format A 128 \eqn{\times}{x} 128 matrix. #' @references Bruce, A., and H.-Y. Gao (1996) \emph{Applied Wavelet Analysis #' with S-PLUS}, Springer: New York. #' @source S+WAVELETS. #' @keywords datasets NULL waveslim/R/dwpt.R0000644000176200001440000003610514627073455013425 0ustar liggesusers#' (Inverse) Discrete Wavelet Packet Transforms #' #' All possible filtering combinations (low- and high-pass) are performed to #' decompose a vector or time series. The resulting coefficients are #' associated with a binary tree structure corresponding to a partitioning of #' the frequency axis. #' #' The code implements the one-dimensional DWPT using the pyramid algorithm #' (Mallat, 1989). #' #' @usage dwpt(x, wf = "la8", n.levels = 4, boundary = "periodic") #' @usage idwpt(y, y.basis) #' @aliases dwpt idwpt modwpt #' @param x a vector or time series containing the data be to decomposed. This #' must be a dyadic length vector (power of 2). #' @param wf Name of the wavelet filter to use in the decomposition. By #' default this is set to \code{"la8"}, the Daubechies orthonormal compactly #' supported wavelet of length L=8 (Daubechies, 1992), least asymmetric family. #' @param n.levels Specifies the depth of the decomposition.This must be a #' number less than or equal to #' \eqn{\log(\mbox{length}(x),2)}{log2[length(x)]}. #' @param boundary Character string specifying the boundary condition. If #' \code{boundary=="periodic"} the default, then the vector you decompose is #' assumed to be periodic on its defined interval,\cr if #' \code{boundary=="reflection"}, the vector beyond its boundaries is assumed #' to be a symmetric reflection of itself. #' @param y Object of S3 class \code{dwpt}. #' @param y.basis Vector of character strings that describe leaves on the DWPT #' basis tree. #' @return Basically, a list with the following components #' \item{w?.?}{Wavelet coefficient vectors. The first index is associated with #' the scale of the decomposition while the second is associated with the #' frequency partition within that level.} #' \item{wavelet}{Name of the wavelet filter used.} #' \item{boundary}{How the boundaries were handled.} #' @author B. Whitcher #' @seealso \code{\link{dwt}}, \code{\link{modwpt}}, \code{\link{wave.filter}}. #' @references Mallat, S. G. (1989) A theory for multiresolution signal #' decomposition: the wavelet representation, \emph{IEEE Transactions on #' Pattern Analysis and Machine Intelligence}, \bold{11}(7), 674--693. #' #' Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time #' Series Analysis}, Cambridge University Press. #' #' Wickerhauser, M. V. (1994) \emph{Adapted Wavelet Analysis from Theory to #' Software}, A K Peters. #' @keywords ts #' @examples #' #' data(mexm) #' J <- 4 #' mexm.mra <- mra(log(mexm), "mb8", J, "modwt", "reflection") #' mexm.nomean <- ts( #' apply(matrix(unlist(mexm.mra), ncol=J+1, byrow=FALSE)[,-(J+1)], 1, sum), #' start=1957, freq=12) #' mexm.dwpt <- dwpt(mexm.nomean[-c(1:4)], "mb8", 7, "reflection") #' #' @export dwpt dwpt <- function(x, wf="la8", n.levels=4, boundary="periodic") { N <- length(x) J <- n.levels if(N/2^J != trunc(N/2^J)) stop("Sample size is not a power of 2") if(2^J > N) stop("wavelet transform exceeds sample size in dwt") dict <- wave.filter(wf) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf storage.mode(h) <- "double" g <- dict$lpf storage.mode(g) <- "double" y <- vector("list", sum(2^(1:J))) crystals1 <- rep(1:J, 2^(1:J)) crystals2 <- unlist(apply(as.matrix(2^(1:J) - 1), 1, seq, from=0)) names(y) <- paste("w", crystals1, ".", crystals2, sep="") for(j in 1:J) { jj <- min((1:length(crystals1))[crystals1 == j]) for(n in 0:(2^j/2-1)) { if(j > 1) x <- y[[(1:length(crystals1))[crystals1 == j-1][n+1]]] W <- V <- numeric(N/2^j) if(n %% 2 == 0) { z <- .C(C_dwt, as.double(x), as.integer(N/2^(j-1)), L, h, g, W=as.double(W), V=as.double(V)) y[[jj + 2*n + 1]] <- z$W y[[jj + 2*n]] <- z$V } else { z <- .C(C_dwt, as.double(x), as.integer(N/2^(j-1)), L, h, g, W=as.double(W), V=as.double(V)) y[[jj + 2*n]] <- z$W y[[jj + 2*n + 1 ]] <- z$V } } } attr(y, "wavelet") <- wf return(y) } idwpt <- function(y, y.basis) { J <- trunc(log(length(y), 2)) dict <- wave.filter(attributes(y)$wavelet) L <- dict$length storage.mode(L) <- "integer" h <- dict$hpf storage.mode(h) <- "double" g <- dict$lpf storage.mode(g) <- "double" for(j in J:1) { a <- min((1:length(rep(1:J, 2^(1:J))))[rep(1:J, 2^(1:J)) == j]) b <- max((1:length(rep(1:J, 2^(1:J))))[rep(1:J, 2^(1:J)) == j]) n <- a while(n <= b) { if(y.basis[n]) { m <- length(y[[n]]) XX <- numeric(2 * m) if(floor((n-a)/2) %% 2 == 0) X <- .C(C_idwt, as.double(y[[n+1]]), as.double(y[[n]]), as.integer(m), L, h, g, out=as.double(XX))$out else X <- .C(C_idwt, as.double(y[[n]]), as.double(y[[n+1]]), as.integer(m), L, h, g, out=as.double(XX))$out if(j != 1) { y[[a-(b-a+1)/2 + (n-a)/2]] <- X y.basis[[a-(b-a+1)/2 + (n-a)/2]] <- 1 } n <- n + 2 } else { n <- n + 1 } } } return(X) } ##plot.dwpt <- function(x, n.levels, pgrid=TRUE) ##{ ## J <- n.levels ## scales <- rep(1:J, 2^(1:J)) ## y <- matrix(NA, 2*length(x[[1]]), J) ## for(j in 1:J) { ## a <- min((1:length(scales))[scales == j]) ## b <- max((1:length(scales))[scales == j]) ## y[, j] <- unlist(x[a:b]) ## x.length <- length(y[, j]) ## } ## plot(ts(y), ylim=c(-.45,.45)) ## if(pgrid) { ## lines(x.length * c(0,1), c(0,0), lty=2) ## for(j in 1:J) { ## lines(x.length * c(0,1), c(-j,-j), lty=2) ## for(n in 0:2^j) lines(x.length * c(n/2^j, n/2^j), c(-j,-(j-1)), lty=2) ## } ## } ## title(ylab="Level") ##} #' Produce Boolean Vector from Wavelet Basis Names #' #' Produce a vector of zeros and ones from a vector of basis names. #' #' None. #' #' @param x Output from the discrete wavelet package transfrom (DWPT). #' @param basis.names Vector of character strings that describe leaves on the #' DWPT basis tree. See the examples below for appropriate syntax. #' @return Vector of zeros and ones. #' @seealso \code{\link{dwpt}}. #' @keywords ts #' @examples #' #' data(acvs.andel8) #' \dontrun{ #' x <- hosking.sim(1024, acvs.andel8[,2]) #' x.dwpt <- dwpt(x, "la8", 7) #' ## Select orthonormal basis from wavelet packet tree #' x.basis <- basis(x.dwpt, c("w1.1","w2.1","w3.0","w4.3","w5.4","w6.10", #' "w7.22","w7.23")) #' for(i in 1:length(x.dwpt)) #' x.dwpt[[i]] <- x.basis[i] * x.dwpt[[i]] #' ## Resonstruct original series using selected orthonormal basis #' y <- idwpt(x.dwpt, x.basis) #' par(mfrow=c(2,1), mar=c(5-1,4,4-1,2)) #' plot.ts(x, xlab="", ylab="", main="Original Series") #' plot.ts(y, xlab="", ylab="", main="Reconstructed Series") #' } #' #' @export basis basis <- function(x, basis.names) { m <- length(x) n <- length(basis.names) y <- numeric(m) for(i in 1:n) { y <- y + as.integer(names(x) == basis.names[i]) } return(y) } #' Derive Orthonormal Basis from Wavelet Packet Tree #' #' An orthonormal basis for the discrete wavelet transform may be characterized #' via a disjoint partitioning of the frequency axis that covers #' \eqn{[0,\frac{1}{2})}{[0,1/2)}. This subroutine produces an orthonormal #' basis from a full wavelet packet tree. #' #' A wavelet packet tree is a binary tree of Boolean variables. Parent nodes #' are removed if any of their children exist. #' #' @param xtree is a vector whose entries are associated with a wavelet packet #' tree. #' @return Boolean vector describing the orthonormal basis for the DWPT. #' @author B. Whitcher #' @keywords ts #' @examples #' #' data(japan) #' J <- 4 #' wf <- "mb8" #' japan.mra <- mra(log(japan), wf, J, boundary="reflection") #' japan.nomean <- #' ts(apply(matrix(unlist(japan.mra[-(J+1)]), ncol=J, byrow=FALSE), 1, sum), #' start=1955, freq=4) #' japan.nomean2 <- ts(japan.nomean[42:169], start=1965.25, freq=4) #' plot(japan.nomean2, type="l") #' japan.dwpt <- dwpt(japan.nomean2, wf, 6) #' japan.basis <- #' ortho.basis(portmanteau.test(japan.dwpt, p=0.01, type="other")) #' # Not implemented yet #' # par(mfrow=c(1,1)) #' # plot.basis(japan.basis) #' #' @export ortho.basis ortho.basis <- function(xtree) { J <- trunc(log(length(xtree), 2)) X <- vector("list", J) X[[1]] <- xtree[rep(1:J, 2^(1:J)) == 1] for(i in 2:J) { for(j in i:J) { if(i == 2) X[[j]] <- xtree[rep(1:J, 2^(1:J)) == j] X[[j]] <- X[[j]] + 2 * c(apply(matrix(xtree[rep(1:J, 2^(1:J)) == i-1]), 1, rep, 2^(j-i+1))) } } X[[J]][X[[J]] == 0] <- 1 ifelse(unlist(X) == 1, 1, 0) } ##plot.basis <- function(xtree) ##{ ## J <- trunc(log(length(xtree), base=2)) ## j <- rep(1:J, 2^(1:J)) ## n <- unlist(apply(matrix(2^(1:J)-1), 1, seq, from=0)) ## basis <- ifelse(xtree, paste("w", j, ".", n, sep=""), NA) ## pgrid.plot(basis[basis != "NA"]) ## invisible() ##} phase.shift.packet <- function(z, wf, inv=FALSE) { ## Center of energy coe <- function(g) sum(0:(length(g)-1) * g^2) / sum(g^2) J <- length(z) - 1 g <- wave.filter(wf)$lpf h <- wave.filter(wf)$hpf if(!inv) { for(j in 1:J) { ph <- round(2^(j-1) * (coe(g) + coe(h)) - coe(g), 0) Nj <- length(z[[j]]) z[[j]] <- c(z[[j]][(ph+1):Nj], z[[j]][1:ph]) } ph <- round((2^J-1) * coe(g), 0) J <- J + 1 z[[J]] <- c(z[[J]][(ph+1):Nj], z[[J]][1:ph]) } else { for(j in 1:J) { ph <- round(2^(j-1) * (coe(g) + coe(h)) - coe(g), 0) Nj <- length(z[[j]]) z[[j]] <- c(z[[j]][(Nj-ph+1):Nj], z[[j]][1:(Nj-ph)]) } ph <- round((2^J-1) * coe(g), 0) J <- J + 1 z[[J]] <- c(z[[j]][(Nj-ph+1):Nj], z[[j]][1:(Nj-ph)]) } return(z) } modwpt <- function(x, wf="la8", n.levels=4, boundary="periodic") { N <- length(x); storage.mode(N) <- "integer" J <- n.levels if(2^J > N) stop("wavelet transform exceeds sample size in modwt") dict <- wave.filter(wf) L <- dict$length storage.mode(L) <- "integer" ht <- dict$hpf/sqrt(2) storage.mode(ht) <- "double" gt <- dict$lpf/sqrt(2) storage.mode(gt) <- "double" y <- vector("list", sum(2^(1:J))) yn <- length(y) crystals1 <- rep(1:J, 2^(1:J)) crystals2 <- unlist(apply(as.matrix(2^(1:J) - 1), 1, seq, from=0)) names(y) <- paste("w", crystals1, ".", crystals2, sep="") W <- V <- numeric(N) storage.mode(W) <- storage.mode(V) <- "double" for(j in 1:J) { index <- 0 jj <- min((1:yn)[crystals1 == j]) for(n in 0:(2^j / 2 - 1)) { index <- index + 1 if(j > 1) x <- y[[(1:yn)[crystals1 == j-1][index]]] if(n %% 2 == 0) { z <- .C(C_modwt, as.double(x), N, as.integer(j), L, ht, gt, W = W, V = V)[7:8] y[[jj + 2*n + 1]] <- z$W y[[jj + 2*n]] <- z$V } else { z <- .C(C_modwt, as.double(x), N, as.integer(j), L, ht, gt, W = W, V = V)[7:8] y[[jj + 2*n]] <- z$W y[[jj + 2*n + 1 ]] <- z$V } } } attr(y, "wavelet") <- wf return(y) } dwpt.brick.wall <- function(x, wf, n.levels, method="modwpt") { N <- length(x[[1]]) m <- wave.filter(wf)$length J <- n.levels crystals1 <- rep(1:J, 2^(1:J)) crystals2 <- unlist(apply(as.matrix(2^(1:J) - 1), 1, seq, from=0)) if(method=="dwpt") { ## for DWPT for(j in 1:J) { jj <- min((1:length(crystals1))[crystals1 == j]) L <- switch(j, (m-2)/2, ((m-2)/2 + floor(m/4)), ((m-2)/2 + floor((m/2 + floor(m/4))/2))) if(is.null(L)) L <- (m-2) for(n in 0:(2^j-1)) x[[jj+n]][1:L] <- NA } } else { ## for MODWPT for(j in 1:J) { jj <- min((1:length(crystals1))[crystals1 == j]) L <- min((2^j - 1) * (m - 1), N) for(n in 0:(2^j-1)) x[[jj+n]][1:L] <- NA } } return(x) } #' Testing the Wavelet Packet Tree for White Noise #' #' A wavelet packet tree, from the discrete wavelet packet transform (DWPT), is #' tested node-by-node for white noise. This is the first step in selecting an #' orthonormal basis for the DWPT. #' #' Top-down recursive testing of the wavelet packet tree is #' #' @usage cpgram.test(y, p = 0.05, taper = 0.1) #' @usage css.test(y) #' @usage entropy.test(y) #' @usage portmanteau.test(y, p = 0.05, type = "Box-Pierce") #' @aliases cpgram.test css.test entropy.test portmanteau.test #' @param y wavelet packet tree (from the DWPT) #' @param p significance level #' @param taper weight of cosine bell taper (\code{cpgram.test} only) #' @param type \code{"Box-Pierce"} and \code{other} recognized #' (\code{portmanteau.test} only) #' @return Boolean vector of the same length as the number of nodes in the #' wavelet packet tree. #' @author B. Whitcher #' @seealso \code{\link{ortho.basis}}. #' @references Brockwell and Davis (1991) \emph{Time Series: Theory and #' Methods}, (2nd. edition), Springer-Verlag. #' #' Brown, Durbin and Evans (1975) Techniques for testing the constancy of #' regression relationships over time, \emph{Journal of the Royal Statistical #' Society B}, \bold{37}, 149-163. #' #' Percival, D. B., and A. T. Walden (1993) \emph{Spectral Analysis for #' Physical Applications: Multitaper and Conventional Univariate Techniques}, #' Cambridge University Press. #' @keywords ts #' @examples #' #' data(mexm) #' J <- 6 #' wf <- "la8" #' mexm.dwpt <- dwpt(mexm[-c(1:4)], wf, J) #' ## Not implemented yet #' ## plot.dwpt(x.dwpt, J) #' mexm.dwpt.bw <- dwpt.brick.wall(mexm.dwpt, wf, 6, method="dwpt") #' mexm.tree <- ortho.basis(portmanteau.test(mexm.dwpt.bw, p=0.025)) #' ## Not implemented yet #' ## plot.basis(mexm.tree) #' css.test <- function(y) { K <- length(y) test <- numeric(K) for(k in 1:K) { x <- y[[k]] x <- x[!is.na(x)] n <- length(x) plus <- 1:n/(n - 1) - cumsum(x^2)/sum(x^2) minus <- cumsum(x^2)/sum(x^2) - 0:(n - 1)/(n - 1) D <- max(abs(plus), abs(minus)) if(D < 1.224/(sqrt(n) + 0.12 + 0.11/sqrt(n))) test[k] <- 1 } return(test) } entropy.test <- function(y) { K <- length(y) test <- numeric(K) for(k in 1:K) { x <- y[[k]] test[k] <- sum(x^2 * log(x^2), na.rm=TRUE) } return(test) } cpgram.test <- function(y, p=0.05, taper=0.1) { K <- length(y) test <- numeric(K) for(k in 1:K) { x <- y[[k]] x <- x[!is.na(x)] x <- spec.taper(scale(x, center=TRUE, scale=FALSE), p=taper) y <- Mod(fft(x))^2/length(x) y[1] <- 0 n <- length(x) x <- (0:(n/2))/n if(length(x) %% 2 == 0) { n <- length(x) - 1 y <- y[1:n] x <- x[1:n] } else y <- y[1:length(x)] mp <- length(x) - 1 if(p == 0.05) crit <- 1.358/(sqrt(mp) + 0.12 + 0.11/sqrt(mp)) else { if(p == 0.01) crit <- 1.628/(sqrt(mp) + 0.12 + 0.11/sqrt(mp)) else stop("critical value is not known") } D <- abs(cumsum(y)/sum(y) - 0:mp/mp) if(max(D) < crit) test[k] <- 1 } return(test) } portmanteau.test <- function(y, p = 0.05, type = "Box-Pierce") { K <- length(y) test <- numeric(K) for(k in 1:K) { x <- y[[k]] x <- x[!is.na(x)] n <- length(x) h <- trunc(n/2) x.acf <- my.acf(x)[1:(h+1)] x.acf <- x.acf / x.acf[1]; if(type == "Box-Pierce") test[k] <- ifelse(n * sum((x.acf[-1])^2) > qchisq(1-p, h), 0, 1) else test[k] <- ifelse(n*(n+2) * sum((x.acf[-1])^2 / (n - h:1)) > qchisq(1-p, h), 0, 1) } return(test) } waveslim/R/cplxdual2D.R0000644000176200001440000001026114627073455014444 0ustar liggesusers#' Dual-tree Complex 2D Discrete Wavelet Transform #' #' Dual-tree complex 2D discrete wavelet transform (DWT). #' #' #' @usage cplxdual2D(x, J, Faf, af) #' @usage icplxdual2D(w, J, Fsf, sf) #' @aliases cplxdual2D icplxdual2D #' @param x 2D array. #' @param w wavelet coefficients. #' @param J number of stages. #' @param Faf first stage analysis filters for tree i. #' @param af analysis filters for the remaining stages on tree i. #' @param Fsf last stage synthesis filters for tree i. #' @param sf synthesis filters for the preceeding stages. #' @return For the analysis of \code{x}, the output is \item{w}{wavelet #' coefficients indexed by \code{[[j]][[i]][[d1]][[d2]]}, where #' \eqn{j=1,\ldots,J} (scale), \eqn{i=1} (real part) or \eqn{i=2} (imag part), #' \eqn{d1=1,2} and \eqn{d2=1,2,3} (orientations).} For the synthesis of #' \code{w}, the output is \item{y}{output signal.} #' @author Matlab: S. Cai, K. Li and I. Selesnick; R port: B. Whitcher #' @seealso \code{\link{FSfarras}}, \code{\link{farras}}, \code{\link{afb2D}}, #' \code{\link{sfb2D}}. #' @keywords ts #' @examples #' #' \dontrun{ #' ## EXAMPLE: cplxdual2D #' x = matrix(rnorm(32*32), 32, 32) #' J = 5 #' Faf = FSfarras()$af #' Fsf = FSfarras()$sf #' af = dualfilt1()$af #' sf = dualfilt1()$sf #' w = cplxdual2D(x, J, Faf, af) #' y = icplxdual2D(w, J, Fsf, sf) #' err = x - y #' max(abs(err)) #' } #' cplxdual2D <- function(x, J, Faf, af) { ## Dual-Tree Complex 2D Discrete Wavelet Transform ## ## USAGE: ## w = cplxdual2D(x, J, Faf, af) ## INPUT: ## x - 2-D array ## J - number of stages ## Faf{i}: first stage filters for tree i ## af{i}: filters for remaining stages on tree i ## OUTPUT: ## w{j}{i}{d1}{d2} - wavelet coefficients ## j = 1..J (scale) ## i = 1 (real part); i = 2 (imag part) ## d1 = 1,2; d2 = 1,2,3 (orientations) ## w{J+1}{m}{n} - lowpass coefficients ## d1 = 1,2; d2 = 1,2 ## EXAMPLE: ## x = rand(256); ## J = 5; ## [Faf, Fsf] = FSfarras; ## [af, sf] = dualfilt1; ## w = cplxdual2D(x, J, Faf, af); ## y = icplxdual2D(w, J, Fsf, sf); ## err = x - y; ## max(max(abs(err))) ## ## WAVELET SOFTWARE AT POLYTECHNIC UNIVERSITY, BROOKLYN, NY ## http://eeweb.poly.edu/iselesni/WaveletSoftware/ ## normalization x <- x/2 w <- vector("list", J+1) for (m in 1:2) { w[[1]][[m]] <- vector("list", 2) for (n in 1:2) { w[[1]][[m]][[n]] <- vector("list", 2) temp <- afb2D(x, Faf[[m]], Faf[[n]]) lo <- temp$lo w[[1]][[m]][[n]] <- temp$hi if (J > 1) { for (j in 2:J) { temp <- afb2D(lo, af[[m]], af[[n]]) lo <- temp$lo w[[j]][[m]][[n]] <- temp$hi } w[[J+1]][[m]][[n]] <- lo } } } for (j in 1:J) { for (m in 1:3) { w[[j]][[1]][[1]][[m]] <- pm(w[[j]][[1]][[1]][[m]]) w[[j]][[2]][[2]][[m]] <- pm(w[[j]][[2]][[2]][[m]]) w[[j]][[1]][[2]][[m]] <- pm(w[[j]][[1]][[2]][[m]]) w[[j]][[2]][[1]][[m]] <- pm(w[[j]][[2]][[1]][[m]]) } } return(w) } icplxdual2D <- function(w, J, Fsf, sf) { ## Inverse Dual-Tree Complex 2D Discrete Wavelet Transform ## ## USAGE: ## y = icplxdual2D(w, J, Fsf, sf) ## INPUT: ## w - wavelet coefficients ## J - number of stages ## Fsf - synthesis filters for final stage ## sf - synthesis filters for preceeding stages ## OUTPUT: ## y - output array ## See cplxdual2D ## ## WAVELET SOFTWARE AT POLYTECHNIC UNIVERSITY, BROOKLYN, NY ## http://eeweb.poly.edu/iselesni/WaveletSoftware/ for (j in 1:J) { for (m in 1:3) { w[[j]][[1]][[1]][[m]] <- pm(w[[j]][[1]][[1]][[m]]) w[[j]][[2]][[2]][[m]] <- pm(w[[j]][[2]][[2]][[m]]) w[[j]][[1]][[2]][[m]] <- pm(w[[j]][[1]][[2]][[m]]) w[[j]][[2]][[1]][[m]] <- pm(w[[j]][[2]][[1]][[m]]) } } y <- matrix(0, 2*nrow(w[[1]][[1]][[1]][[1]]), 2*ncol(w[[1]][[1]][[1]][[1]])) for (m in 1:2) { for (n in 1:2) { lo <- w[[J+1]][[m]][[n]] if (J > 1) { for (j in J:2) { lo <- sfb2D(lo, w[[j]][[m]][[n]], sf[[m]], sf[[n]]) } lo <- sfb2D(lo, w[[1]][[m]][[n]], Fsf[[m]], Fsf[[n]]) y <- y + lo } } } ## normalization return(y/2) } waveslim/R/shift.2d.R0000644000176200001440000000623014627073455014064 0ustar liggesusers#' Circularly Shift Matrices from a 2D MODWT #' #' Compute phase shifts for wavelet sub-matrices based on the ``center of #' energy'' argument of Hess-Nielsen and Wickerhauser (1996). #' #' The "center of energy" technique of Wickerhauser and Hess-Nielsen (1996) is #' employed to find circular shifts for the wavelet sub-matrices such that the #' coefficients are aligned with the original series. This corresponds to #' applying a (near) linear-phase filtering operation. #' #' @param z Two-dimensional MODWT object #' @param inverse Boolean value on whether to perform the forward or inverse #' operation. #' @return Two-dimensional MODWT object with circularly shifted coefficients. #' @author B. Whitcher #' @seealso \code{\link{phase.shift}}, \code{\link{modwt.2d}}. #' @references Hess-Nielsen, N. and M. V. Wickerhauser (1996) Wavelets and #' time-frequency analysis, \emph{Proceedings of the IEEE}, \bold{84}, No. 4, #' 523-540. #' #' Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time #' Series Analysis}, Cambridge University Press. #' @keywords ts #' @examples #' #' n <- 512 #' G1 <- G2 <- dnorm(seq(-n/4, n/4, length=n)) #' G <- 100 * zapsmall(outer(G1, G2)) #' G <- modwt.2d(G, wf="la8", J=6) #' k <- 50 #' xr <- yr <- trunc(n/2) + (-k:k) #' par(mfrow=c(3,3), mar=c(1,1,2,1), pty="s") #' for (j in names(G)[1:9]) { #' image(G[[j]][xr,yr], col=rainbow(64), axes=FALSE, main=j) #' } #' Gs <- shift.2d(G) #' for (j in names(G)[1:9]) { #' image(Gs[[j]][xr,yr], col=rainbow(64), axes=FALSE, main=j) #' } #' #' @export shift.2d shift.2d <- function(z, inverse=FALSE) { ## "Center of Energy" coe <- function(g) { sum(0:(length(g)-1) * g^2) / sum(g^2) } wf <- attributes(z)$wavelet h <- wave.filter(wf)$hpf g <- wave.filter(wf)$lpf J <- (length(z) - 1) / 3 m <- nrow(z[[1]]) n <- ncol(z[[1]]) nu.H <- round(2^(1:J-1) * (coe(g) + coe(h)) - coe(g), 0) nu.Hm <- ifelse(nu.H/m < 1, nu.H, nu.H - trunc(nu.H/m) * m) nu.Hn <- ifelse(nu.H/n < 1, nu.H, nu.H - trunc(nu.H/n) * n) nu.G <- round((2^(1:J) - 1) * coe(g), 0) nu.Gm <- ifelse(nu.G/m < 1, nu.G, nu.G - trunc(nu.G/m) * m) nu.Gn <- ifelse(nu.G/n < 1, nu.G, nu.G - trunc(nu.G/n) * n) if (!inverse) { ## Apply the phase shifts for (j in 0:(J-1)) { Hm.order <- c((nu.H[j+1]+1):m, 1:nu.H[j+1]) Hn.order <- c((nu.H[j+1]+1):n, 1:nu.H[j+1]) Gm.order <- c((nu.G[j+1]+1):m, 1:nu.G[j+1]) Gn.order <- c((nu.G[j+1]+1):n, 1:nu.G[j+1]) z[[3*j+1]] <- z[[3*j+1]][Gm.order, Hn.order] z[[3*j+2]] <- z[[3*j+2]][Hm.order, Gn.order] z[[3*j+3]] <- z[[3*j+3]][Hm.order, Hn.order] } z[[3*J+1]] <- z[[3*J+1]][Gm.order, Gn.order] } else { ## Apply the phase shifts "reversed" for (j in 0:(J-1)) { Hm.order <- c((m-nu.H[j+1]+1):m, 1:(m-nu.H[j+1])) Hn.order <- c((n-nu.H[j+1]+1):n, 1:(n-nu.H[j+1])) Gm.order <- c((m-nu.G[j+1]+1):m, 1:(m-nu.G[j+1])) Gn.order <- c((n-nu.G[j+1]+1):n, 1:(n-nu.G[j+1])) z[[3*j+1]] <- z[[3*j+1]][Gm.order, Hn.order] z[[3*j+2]] <- z[[3*j+2]][Hm.order, Gn.order] z[[3*j+3]] <- z[[3*j+3]][Hm.order, Hn.order] } z[[3*J+1]] <- z[[3*J+1]][Gm.order, Gn.order] } return(z) } waveslim/R/mra.2d.R0000644000176200001440000001127214627073455013530 0ustar liggesusers#' Multiresolution Analysis of an Image #' #' This function performs a level \eqn{J} additive decomposition of the input #' matrix or image using the pyramid algorithm (Mallat 1989). #' #' This code implements a two-dimensional multiresolution analysis by #' performing the one-dimensional pyramid algorithm (Mallat 1989) on the rows #' and columns of the input matrix. Either the DWT or MODWT may be used to #' compute the multiresolution analysis, which is an additive decomposition of #' the original matrix (image). #' #' @param x A matrix or image containing the data be to decomposed. This must #' be have dyadic length in both dimensions (but not necessarily the same) for #' \code{method="dwt"}. #' @param wf Name of the wavelet filter to use in the decomposition. By #' default this is set to \code{"la8"}, the Daubechies orthonormal compactly #' supported wavelet of length L=8 least asymmetric family. #' @param J Specifies the depth of the decomposition. This must be a number #' less than or equal to log(length(x),2). #' @param method Either \code{"dwt"} or \code{"modwt"}. #' @param boundary Character string specifying the boundary condition. If #' \code{boundary=="periodic"} the default, then the matrix you decompose is #' assumed to be periodic on its defined interval,\cr if #' \code{boundary=="reflection"}, the matrix beyond its boundaries is assumed #' to be a symmetric reflection of itself. #' @return Basically, a list with the following components \item{LH?}{Wavelet #' detail image in the horizontal direction.} \item{HL?}{Wavelet detail image #' in the vertical direction.} \item{HH?}{Wavelet detail image in the diagonal #' direction.} \item{LLJ}{Wavelet smooth image at the coarsest resolution.} #' \item{J}{Depth of the wavelet transform.} \item{wavelet}{Name of the wavelet #' filter used.} \item{boundary}{How the boundaries were handled.} #' @author B. Whitcher #' @seealso \code{\link{dwt.2d}}, \code{\link{modwt.2d}} #' @references Mallat, S. G. (1989) A theory for multiresolution signal #' decomposition: the wavelet representation, \emph{IEEE Transactions on #' Pattern Analysis and Machine Intelligence}, \bold{11}, No. 7, 674-693. #' #' Mallat, S. G. (1998) \emph{A Wavelet Tour of Signal Processing}, Academic #' Press. #' @keywords ts #' @examples #' #' ## Easy check to see if it works... #' ## -------------------------------- #' #' x <- matrix(rnorm(32*32), 32, 32) #' # MODWT #' x.mra <- mra.2d(x, method="modwt") #' x.mra.sum <- x.mra[[1]] #' for(j in 2:length(x.mra)) #' x.mra.sum <- x.mra.sum + x.mra[[j]] #' sum((x - x.mra.sum)^2) #' #' # DWT #' x.mra <- mra.2d(x, method="dwt") #' x.mra.sum <- x.mra[[1]] #' for(j in 2:length(x.mra)) #' x.mra.sum <- x.mra.sum + x.mra[[j]] #' sum((x - x.mra.sum)^2) #' #' @export mra.2d mra.2d <- function(x, wf="la8", J=4, method="modwt", boundary="periodic") { m <- dim(x)[1] n <- dim(x)[2] switch(boundary, "periodic" = invisible(), stop("Invalid boundary rule in mra")) if(method == "modwt") { x.wt <- modwt.2d(x, wf, J, "periodic") } else { x.wt <- dwt.2d(x, wf, J, "periodic") } x.mra <- vector("list", 3*J+1) ## Smooth zero <- vector("list", 3*J+1) names(zero) <- c(matrix(rbind(paste("LH", 1:J, sep=""), paste("HL", 1:J, sep=""), paste("HH", 1:J, sep="")), nrow=1), paste("LL", J, sep="")) attr(zero, "J") <- J attr(zero, "wavelet") <- wf attr(zero, "boundary") <- boundary zero[[3*J+1]] <- x.wt[[3*J+1]] if(method == "modwt") { for(k in 1:(3*J)) zero[[k]] <- matrix(0, m, n) x.mra[[3*J+1]] <- imodwt.2d(zero) } else { for(k in 1:J) zero[[3*(k-1)+1]] <- zero[[3*(k-1)+2]] <- zero[[3*k]] <- matrix(0, m/2^k, n/2^k) x.mra[[3*J+1]] <- idwt.2d(zero) } ## Details for(j in (3*J):1) { Jj <- ceiling(j/3) zero <- vector("list", 3*Jj+1) names(zero) <- c(matrix(rbind(paste("LH", 1:Jj, sep=""), paste("HL", 1:Jj, sep=""), paste("HH", 1:Jj, sep="")), nrow=1), paste("LL", Jj, sep="")) attr(zero, "J") <- Jj attr(zero, "wavelet") <- wf attr(zero, "boundary") <- boundary zero[[j]] <- x.wt[[j]] if(method == "modwt") { for(k in names(zero)[-charmatch(names(zero)[j], names(zero))]) zero[[k]] <- matrix(0, m, n) x.mra[[j]] <- imodwt.2d(zero) } else { for(k in 1:Jj) zero[[3*(k-1)+1]] <- zero[[3*(k-1)+2]] <- zero[[3*k]] <- matrix(0, m/2^k, n/2^k) zero[[3*Jj+1]] <- matrix(0, m/2^Jj, n/2^Jj) zero[[j]] <- x.wt[[j]] x.mra[[j]] <- idwt.2d(zero) } } names(x.mra) <- c(matrix(rbind(paste("LH", 1:J, sep=""), paste("HL", 1:J, sep=""), paste("HH", 1:J, sep="")), nrow=1), paste("LL", Jj, sep="")) return(x.mra) } waveslim/R/periodogram.R0000644000176200001440000000046214627073455014754 0ustar liggesusers#' Periodogram #' #' Computation of the periodogram via the Fast Fourier Transform (FFT). #' #' #' @param z time series #' @author Author: Jan Beran; modified: Martin Maechler, Date: Sep 1995. #' @keywords ts per <- function(z) { n <- length(z) (Mod(fft(z)) ** 2 / (2 * pi * n)) [1:(n %/% 2 + 1)] } waveslim/R/stack.plot.R0000644000176200001440000000532714627073455014533 0ustar liggesusers#' Stack Plot #' #' Stack plot of an object. This function attempts to mimic a function called #' \code{stack.plot} in S+WAVELETS. #' #' Produces a set of plots, one for each element (column) of \code{x}. #' #' @param x \code{ts} object #' @param layout Doublet defining the dimension of the panel. If not #' specified, the dimensions are chosen automatically. #' @param same.scale Vector the same length as the number of series to be #' plotted. If not specified, all panels will have unique axes. #' @param plot.type,panel,log,col,bg,pch,cex,lty,lwd,ann,xlab,main,oma,... See #' \code{plot.ts}. #' @author B. Whitcher #' @keywords hplot #' @export stackPlot stackPlot <- function (x, plot.type = c("multiple", "single"), panel = lines, log = "", col = par("col"), bg = NA, pch = par("pch"), cex = par("cex"), lty = par("lty"), lwd = par("lwd"), ann = par("ann"), xlab = "Time", main = NULL, oma = c(6, 0, 5, 0), layout = NULL, same.scale = 1:dim(x)[2], ...) { addmain <- function(main, cex.main = par("cex.main"), font.main = par("font.main"), col.main = par("col.main"), ...) { mtext(main, 3, 3, cex = cex.main, font = font.main, col = col.main, ...) } plot.type <- match.arg(plot.type) panel <- match.fun(panel) nser <- NCOL(x) if (plot.type == "single" || nser == 1) { m <- match.call() m[[1]] <- as.name("plot.ts") m$plot.type <- "single" return(eval(m, parent.frame())) } if (nser > 10) stop("Can't plot more than 10 series") if (is.null(main)) main <- deparse(substitute(x)) nm <- colnames(x) if (is.null(nm)) nm <- paste("Series", 1:nser) nc <- if (nser > 4) 2 else 1 oldpar <- par("mar", "oma", "mfcol") on.exit(par(oldpar)) par(mar = c(0, 5.1, 0, 2.1), oma = oma) nr <- ceiling(nser/nc) ## Begin added code if(!is.null(same.scale)) { unique.scales <- length(unique(same.scale)) ylim <- vector("list", unique.scales) for (i in 1:unique.scales) ylim[[i]] <- range(x[, same.scale==i]) } else for (i in 1:dim(x)[2]) ylim[[i]] <- range(x[,i]) if(is.null(layout)) par(mfcol = c(nr, nc)) else { par(mfcol = layout) nr <- layout[1] } ## End added code for (i in 1:nser) { plot(x[, i], axes = FALSE, xlab = "", ylab = "", log = log, col = col, bg = bg, pch = pch, ann = ann, type = "n", ylim=ylim[[same.scale[i]]], ...) panel(x[, i], col = col, bg = bg, pch = pch, ...) box() axis(2, xpd = NA) mtext(nm[i], 2, 3) if (i%%nr == 0 || i == nser) axis(1, xpd = NA) } if (ann) { mtext(xlab, 1, 3, ...) if (!is.null(main)) { par(mfcol = c(1, 1)) addmain(main, ...) } } invisible() } waveslim/data/0000755000176200001440000000000014627406037013023 5ustar liggesuserswaveslim/data/barbara.rda0000644000176200001440000016144014627073455015117 0ustar liggesusersBZh91AY&SYt| ) @DHH")@A>}  P}еfNݹf6Zr˻uY,ĪUi33$[ DU6ŬÑ!lbb֣ ksh[ 6&nX'0ۃsYݷaո7N`` . aa9g wEsupN7 ɃU ;pva6fmuAs̻v6;u0nWqaۍX;qn-5we ;w..cnqn\s]ssγۮv;wvw;k\fM6ͻ6bnnl휻qT"(HD$"@A(@!*@"@PP@((@!E!TFa2@ 0 L @@TOH4@ESL4h@&Bh*~4ih4bFj6 $JUT# щiG40Кd`0L&ѠѓLFɡFLMOI144=OSOLHzbL)xj6L&52m4j{S4$򞉵)&k6+tQTb65EMڍ61F6*ebX`lY4Z6ARm&i5¾%UOg* Z*LbĔlmcchFcjlUElj*J6) ƿ&bՕIjUjP}lͶ6L$4`IbRdQlQm#V-c))I"#)$ѢmQk%&RPb IK_uh:^K OHy$xZIwJ*l–QEVڅ m m bBD| $iɢFF4Rb 2),ƚbf0d ɤɄb %TmVBUѓ*2FbX(Sd(qd (siDAٔ/|$9(|>.Vo[Z[\ٛF5D$J2jk]-yNkλO;v9;yu⼊"XwrJ!s(A).E%GG .H\Pvկ Ci#XEѣdb$)Bj )BYI&FP hІY*66fִjmUl,Q16 T3`ڶ36MT_՟D\I.aQ:_6EUVmF4IE!b3dI21`֣k%6A9$/8z|8em8e 3QjDZ6*̴4m\! c)M4dP+ILLmʹ*Dhƈɵl;bK¹ڈq'vTC {$\J%QtVLDQ־4I hъ4mIbEQE2& MbLL3$iAĀ&Y$HIDmLhє5" cFbZ6Be#E@!S4hE&(ѨD5JjѨ%%$YMD1c( E"$Q4Xz4UB%"Wkl6mͨ؂ԻiQ;;J&9;u;wmKdۖbfwWMvYw;3w\kIӠd8ܻuw`wKsn&b"5wvq4h\+rۺkkcj7*lk1ʮdlIEs.ZEE˕m7 q"Cd RC]*Ukb#"ko_GUCԪiܕT⃹"C؊Oa`q쑊4e64H4Qd#)4$fEFaLlPXJ!M6#R& K P hL@Ś@h&ńIHJŴ)j"4[lb%HF$4HR4 66,b5Db+!LJ`FdhX$$i H[Z6*jkmW+ʑ|"%!DOor o^"6*;MX`)OF~ؿ 'sqR2)=i"fti#L!8" 97r9ݠ]EE R4r_T)%Qt4f#fG$ % n/.۽0쥵$ J|Wf35S$U/" ,+#+H^D)DS!yNYWS9!:g ds19MdZ{nX:Ėw0 W$p:"i>p6u%Þs}K kG7}JVR.Uh@FNHTQ yЅ !S o ́<[ )C 9 [&**J6pJNIyJUl3FrRjb!(Qg:I12z~$ LQ0-hf$aT'eg0:^jP@YO!AQr2ZP.>-+3K#@~D;i2QIf NgnEOKY{m&( İ"#5Y 둑*ȄZu`J.TQS0U " K u-s&xT AJɨgv+Cd$P/ QH5JDǍadDyI̟ ac ZPM—:T~IGvҿ9p6:K=ʭ@"qD\\;e6th LrL=+I-ԂꓛWp$V'mxe3Bٞ+R䀨˯5>jw҆BG% C$Qtzޓ$=J\Iƭ88zRnB8pU2U+QGiIܒo"#-9IAZpbU',>l8e)tZ.AAh0=ҠPLyӞW3*ťo,K9lieFS|JHt>uJ0#ak޾7QF/dLH;> 3iU:^fH GdUu [ "q1!|9Cs-E92c\ JʼnPDYTIrR@Q,5U\V9DA8/-x,[!fnl8w+S6>/k7w?lw@o?,]\ؖW:Kإga))i=l3-}Wf0u*pʳq2S ҙpΦ@u BY3B2aJ#8C-]n-RER^WmBђTJa+HuY!S`z;XBYSQ;yzNۤΙey*{P|2Y$HʽlKF/nZ_Ma3tTO}6;^uۉؤ$!f撋unHkj! b;~reZЫڕؐ~klIߨ )m鹱JH_wjzhM!,*gj+6 &#IkQFD rj%"<(" Gdi6[n-J"3DAdii8Ъ&LS/9|ٜ(RH,_q5_]#Uõă=kQ p7.τׄ[3QvN5BkjAZ~ԛ Uh7,3@:Yg|;P'`6Fyl5ԁ:o>+r!@Vb&[ZBPóX-#f2脰xcEqܨn֛.~(Tk{`୯<8:]O2fC*E9zܞ~ ҚcLS+|0]98ZZ;wĵhfW[AcdoQF!!dӏ^ '(]G:T|iN{_5^IYջpjeem<ne3G@{qjJ0]E"Qxg{+j\69`d'gsyO-y|Hqsm*S2X f5緿B\tU_Fyɮ[p/)t~]=$rtyoz'"0"&[L{O10M9DrE[㩕W}hһmσH-3]T^^XnAxK#\vfKiCFZ;,$6zyt@"Y3;G 4;2s 1ַqm ;\D+ĈZ`r!M&, CnTL$ %{{gz^DgA v; ԁ+ # Zl4e)ta4d.L4v7Uc<ΎbmO9>{SNƔu`RO~֓G1އlu.@m!nA$֜YDdMyh0 |-KZ 4_}Ve;Yo|i#}$+wLgcG1.82l C9b6ݯ {N٨%hѵ~U 1{a9Xv(*_i.m8~LygY@ʂ*YZfֲd>玵qVmꦙ[m+߃'O=rC+՜QDV|%x ; ~\ZM$5N,iOJCHmI5)^p7:XB`Yh<8ܼhYXB\\)MvUM0N' r3Sŀ(_'aJԓ\2WXBxTl"8 CdU}P d]O&ιZjkZ# et'!_ot,:QȤ\ Ȕ(i%h+>`˕z's9Z8?k~12"_J߮˞a!K0ە#67\SUVB˱:9@ڶC;ԯƥ0 ]V3 P4vKrU1x[:2*^G4ͫu1q-kS)h y]~'3Ϸ9\'kqr!Qx$%ZtlR&#ܛ=pY%RQ!!/p[ ,8Ǵp^9<ӫDjј7 {#h-Fs 9=tRfPБ_YLԝ"O݄kP%8m|5 -lj]rrZwCƻC3ɓ5ݝ{4=sk@sF'ɪ|LxHtb;n$7:38SJe2,/Su)@Cӿ:J6 Xׄt Q#5Wцl2V1 0VQZ֭ZhޘbK}N1yқ0IJ( ENitb2#rݞ,goEa+,SGY=>%ébcۙX߾ ΰsLPfyy8h h܆x+b" P=N$UnUwus_FZ߳Xi4o{]HYOYrRw+ &?f3Ѱlsxy9S ~^Zf}!* TiБt^{mX&,I=K8WY'om{XEm{1lnG> 5wd9vۂi`ٕ:80lgTή-BBVuaBDEDYJPI4G O=y@nT}φ"5Mb=X`IЅP(%9w ڜܖ}o[)ç~UB KvSM;[V{6[HlCaɷ9QtC؀:3 mEj*B |rB~ LژK+JC3lRn>7NJ_r{ؑLqTw |fq.0m @: {1VBTn=]iL=_:LFNrG7{vΦբᎾ,6·nNusR-5f\&G<]$p'W ive*yv PܳM[h+`6}%. 94AF";&֋c3v:\Tmڹb̺TEDGPWnug?i\Y,m.Y@ j鋺!]h n >TdN㇞!Jbpj[0Jy.pԆ 2,I*s=,ӭaŷ A.dBCQɗS9:F\Ac}-KTPsX^/xDְ2VSc)2;zFf=G^R2x捠a[ Cs- !աS(dޒ +m"Ƅ\Rՙ{ʎKE~ÐvC]ˎ.>fa %>B'>kVDgRcTvg+]&VA%LoE]=r[[W[R iۀk-}N@fBTzIޣ crY} |_0kmu Ukžt"R|xɺ JB&r?Ep@TH"KU93jTdΞB )$mI+3РL3~ t5RdҰ#WLȁԇb~`obKDwd{&j<)RC/4Ս/,t/9zۼ\+@0aٺc g rGX89,e/Ί.j<,c8Z "7:pCN!,ًTR{EYɫ'o1s0J;z1;:Pȍ QDU0 <\ĉhzeTDxyc2WPBjW0V"U:Ƨ`RiIjfRfNmUoat՘g-qȹ7r.{ӛ(Q5͙߬bsa/^l;[w؞P-f^4a+EYBPnL=/TC<JU'Y^Y|v{5Y{S*&4D q~$T@=]c}}8#$Puڎ1b#Ŧ")iڦ_OPN}=݆ xN\l'yPcT% &Co\ɋ%l2~K4YrǕ*_KStҜacd}M'8#b* +ceJ' DyL XDf^(tP婗{QAtDyxܓX syvxrY9h\jz>w SUL .79Ipzh \Hth>{|_}:cKS ƍ$>Qktֺzu?#Tp]x9/I;*0bc~cz؆T()~b3uW1̧24UCC]k*pWf5isluvb* ~|kՍjxIPqW\LԂyVeC'$ V4w$6ms./:1fn^jF1KHĆD<lCE qǜ=UNGؼu^웻hG˝nHIuQ(ҹM"sk *_&Ot5xNdɃ;tH|!Z\i/- >kagdžLcsD,mq.Zp]@GѾ{-ʁ(Go9*&w0,%bf PO{d-sjfyQH i:Jwy3? =Ysif>kT V'*(yag4K4!E0s-gEZJJX)T&e )`17izM :;1JL^"B9(z}.!eq -j AOױXM"D)3!K*7Uټ3چQZd845,#qKTRrBs2y+VԖ~_~~/~ #Wm[!Wb:]F6':m-]d6.$}lp.Պi3&7ڗH8.q@Jam;WYݲ  ;;EwςV܆V+XK *\}*m~Ũ)O΅>`-fai#YPY%( Q/9ӻ]5PW;.ӋoƋRJYs}ۺiG\9~O5Uzu(DNKlmV=y02O`7h)J%JGNQ!s;UDŽ"[k5 (W@Z@%/PXK>lfii\TjF| h!ūǗvkTѮSJ KNS9zڤ͒^0R+^thB\v.~B.j1WÑub:A\$]j3` @x$.]I3KqCܫP&do`M)0R_}"5ʡiB,Ɣr.ۦ6Am'Z-=ϧctbAx.D ,CoDWc TT ;; eYO>iE!鍷| _ 'Cu4Щ;N,7&sgÍ|Vz*C6~ھ3< osV{gwgwJO.zF<u].A V@@^2w À=2$ erH˵ؕ1X~RwX ӎW+51<تKWq-g/; 2NAi4H+ $C 8g\ u0xL;p,w}<34FVv*m{JqΝYX4>-wpM19? bz$?Ozf}H aWゥȆ+6$ 18f [0,nT8"zoA7ZZg( ќyU`$XƳ7=u8]"meI (j2Ac`b :"f y`{L[5FB. /5uD gZ@fFlCMѡ<\_39 ;=+X#T *nf.LQ-R4ԢKjT FP{sW4a7+e PWi3 3DUz©fDjZax>Ka;_-||ڨyP|k.l7Z,Ss./0ipÐo8-PȚ 'B¯Fhh廸?[7·.yC2sA۲(fدNuB 00Azܭ~R1w6(ȾQ9/ҹرmsKeyuQX+{̍?%iե++Qk}xQ\c.|\´c NFob^䎵6/ ;`^W<lNڸr^kVŔ#؈7C"k##zmXw¨ü}#Kf Wxu˗z8Bo^F)W> cրuȮMD>dM\WWP-Z;R,GfFN+&)!} -sݸzkb3l'WN6"b%u3R\'[Zj#(ifa3|PµI-0ISp[|;L' (U~aza;QA]ݰ$xs=Z^u^yNR̴ tg>{;D͐Ykk&3КtY@+9~!{Hp:TDyٍ._5vs0bzô';QGu:Ѫ҆0'o 30!8w!p Ǯ r[f&3tr mc&е-HQ-q]$҄=E4>sjRQRXg֔*Ie OAg] {c\ĐSuV51N-H1d"v !4$=M6y3ӐLFJD隺ʹ w%\}ytlb mX,^˩xO" ~^ӓZc=yxiD` *\/dUX*~y"-98lP$p)Qu ,CdR(Yq8X'lgP /1|ʾ?>?kFR+U\ ~qF᧊!xwr o!Jo1^)hrerYuX\_~=oVtQ-7/h% (Nߢ FR i P sdr0@GG7v{ &NcSVR,<(2@vSȏOMX$VBB$fAߥetb{5lS8x=5,uBL%Si:S vK:vL1rkl$(:k6EylaKѺer_)v?MvPe.}u-RNVӔ| zKu\$qH~Ķ*T]Յi}e/RէЍߎk0fB 1٢+:Olن < mW1G3e8$ S}0Xv#{uA  =ܛWV-Px _(\Qu 5I0I6Fl'=/S$w!2{9` ][չs0dazrVME(Jzͷ?v{y!p(bh)GcbM:rlE;Es@XL~!|T n[4+4~Xb{\ƞ xsr<T#LmyL@}쿩=sVoGؙn,nt'[HR n|^ޚ7CK8{^ߓ@ۿfxu4+M(> ||lx4ǒVӪHT߇7@ ku(N|"fmOkİ &G8N=}r߬ݾxz3'v2ԙUQgZ/b: |δy"~l&-\{";Y}_Dݥ9)!-9\P5%5ɱMqH˒Yz7h![,q>PqSwl_̘qX4ͽn/bѓ5C`]V}1&e鿏u$;Sݼpn{􊢤pOE˕nB]Em=/wgL)*Ky ̒B{W 06j$.@xb/+ Y+5-"ry##ɚK0b|{>ls~yqAs ,Ӧe(![%F$= "vۻ[nz}x+5Yq_[ayI-I^vqj|xMLN)%A_*mʞ5(CHnG1vׇ~ vKX+߆Ŵfvؔ{z2Pί=>p@ߥPY6u&eK (ZsF\29&n$J摲j[""ȭ(MTCnZvJxOXdAfŮ hMd#,[YQQ;1XnmTfs#Ӆ ~KuAB 7!Gҡtoڨ`w/S܊ an8T!$B\zJu߸F]M~ ~WT޴_[.oX%ՉtQ ,P⫧8uGmc޴&Y2E&S(Z d*F/qץʵ*qgz޽|)nd>ct'7;+ٻwRC z`=\m;NؒsICV">k#">UΛJj̠ O\QMI"5#\(0 kQ,0|z6DY()C'fr'Hs\2(->iI}ʖaa~Z먪)Yr>,腹::cp fHh%{Y'ƾ)C[Xm9E1ou}6e+&+  % *F W@+)GMKk3 (ϘlkF6٥whD\OvlOi]y?=VX{T쩣q$y=SN$2Wd.&Mqm dڵ:.x9N@,0O\!jsP{xLK觭?h.4hFU;0eM2Rc?H@D p ljD/\[Fk~6}1=nKA+DP8C}ש7pZjz4Q17U;A%~+2vGvFa^q;f,G!nS+W1gZV.N\TfDX_з79|n`΅J>I{Ԑ4}" X0&,y#X*ke4y,x(\]!MUZL|+^QPUTjBu aB'VKJȝ-jRmOUˀ{jNPG=`cA%xԆm|%axj)..5h qTl|AY.m\k0`d" u\X !;a5t,ďj`NH%T*`ߑQeD4kxa91Spm4 Iͳݑ@5$)+mw8%kp,`3&cJ..D O \TN`UW/pbw.i;Tq$B~6ݢ;qB4WMdrHs(UjVЯ W߷o~ǞOKxJ3{2WťO4Zg!A~=%oXT\I+WuwL5j–{)O7)+Z lj: TcwexTΞ7s2T̟eβ-`ptV mBԈ%ۙ*HQ;ᖸJ~K92 fM3XÑ<޿ӫX,TA[aQO=Rflk?֋=Q/j QA!vroS$6БTX߫UjĹllG0..褢7KX´g06,R*nlL+f;ˏ"^%w#LdN^<\3WO IWkZW7=3R2mQ UqZ)CBN+2 EON;bxs7ZLoyJ+ 3I/vmOձ315>*dHp {xL@_f@r~_u^XT+zjsMZx@Ly与:Ll[gك \ lEHζI nhKɽHKLњ_8>#dC:nyL̼0*wCD}35lS!ƃ70ބW`}5M,Ơ+>ma1IdkoʼnE:da IOwnDJ856@lJ՛\\賜*W)9/|xzǟvwS9>M5>d3Zlvv#=I][Ϸƚ$hlZ_ڼ*k=?(_S"PM6 } %ƅqE H7kli' ^wpOsNu/әc hS@Q%JUd%Mpvfp򬏻) 0T-Ib@|(0mTW <]չ,S` Zd*h& 22GdMHJ2*\ %%.Y04]VU{a%hbj-K^ tfI8#w KMk ߾Б-Y ]BO;݁ QN~fcl?2z_jO Bؘ16>s2 "]sܲNwiZWʽB#tRT\_lM{QcV_4k :4jl;j^ts}DMOe-\ ofvѼk?|\BfssRw- 1gK  7,JTG_bRabt^Mgݺ'C~(6Q\ԇ?9ZvaQ:q$U7@2 9z Be&|S{HGXʁsO&o[$,\iO=]ʚkb;V\qRziEoIlD([C=Kմ.{cqWneV0qr7+EjҥX3vH >Wo_K/Ưeb\jٙAZB'K}RX׺QyxPދoO؄&g[e[x@wP3܁^F>w ZEqo+M<[dPo)i00]2D)팾Vܥ~iqfnE8*{?#Z, p0kBۣa!bɐ#ʯĴ %c9ֳTa=X3.ݾlJXIp[QPDT\69tWnH vk`$+/Nχщ g KI$z9}1(UxBsUSQ6'D@aB/^E^ə{M<ҽRѦpI'S)Dދo~nq쓺;m6`@;}>l.BgU*EAdkܾ}PTgv5 lyθPy~9@˚cn= 2Abuƿs֍pg2YkZPڭi%f !lB6'Ef*dTmhzZ@tvԱy9ACȟ`wrZ 8k+$@B`_JWn(' O i.sY{tҳLFp|mBrթ0zY-fgjoWwurjV5xa#LHWr&w fL2+}aRPLiQP5 x:`]y -\H&yH ! zUd~RXbjLmCfԷ6k Kf/%syPqKzc<+L7 V!M^clN}JEkz#E> ~ HWCAA-m+m%xwT$e|f MnB 0e %ˊm*??πqqbi9.()or+ !2fJB򌍍7 -w0Q*[C^U\9ꚍKx`,A3 jF앯l(v)!b _;{LBD=g<GޝF'x>Jż3FSuws|n1A"&Cja {?ۓlf̓pk,16zoRBN'7gzWf |_~>2W.Gjel_fBgŖb$އܼ'֪_σ6j_ fn"[5d{nY,5J_!fAh8@ 8 XЪ.PjObȏ~MΙy}K!XwN8B _4EF#( & @"q9*c C;I^ oEG?0aI%00lڗ4:[!/@e}[BAqNot+!H7BdܥUqzNdK>^GjNć}W͂wm|m;y}[ v=K^dF?31O젋lyƸsv4O^_dWedПz@8L>aM9{ dѹTG;$A.ڻx YJ.[spMR=H- N+
}- 'ES>kH>/s7qznBaIH@PGQqx 2d@ΰ"Tvjk`T)OR{.Όv0@[ āք Kdn4#Wu8l/6Cd0dDN׳c{0D.z}|-@H5u-r/{ D4TtN?LQū'aMDGcb2L S9)c~?njqy#nx@Aߺ2N|w$A }>0zB_l_Nft'ހ&WbHd&tEU&[qS%WFl[QG:m;YVw',ZW3C e\&0{cn ZV@VQ2N+Iq3dN=؃ ɦ9iBсy׃6:~,n5#*!oIs#\خ% [ےhDAc ܱTLc34ц{Mq]O IY'aĀo\OF,c(fNUXݪyL8^)w~_ 70r8Lu^e"7+sU$)`5{ؠͲ%4}as}27O;Ʀ [adkeU+I#=" ʝdiÀwkzr /F)ǒsDEB&VGΥNPh6#I? .-r*_["O Y %z6mSr$ƲY?ߎ8naz~bط(bmAi4 6 r 0ȸ )ȵ>طq_喖5]u C៣D8>wWUJ: &ŗr\R(nuOM+$qVև3yEK-5h UY$%XGx,Y>GS滏 v8ǔ^&Z82NJ2 Lм򹦷XTo\'Hv2bx4va{nj3AKMW9#JH~-kH.$}Kf7Iu쭡8VDML$4i`5t^ګ9eYˏ +w&Jx{zBBJDm2LvF3a@խHX_0>_="΁fBPɜ|b]P\-dJHBVğBǜK,#H2y}\L l%h;řw-=#緐_9^po dk7\eˡ|.:aqM!PN ʧ\"qb:o#"+B1UoPir͍WY|(._er&/[JjTYGwrR&wFTL;kPlZ֥fěs?CsjrBs.J|%ϕx:#7 IFl`|Uxk B2MGz+JawT\Y!OlwXBzP&GKFuiG̑m@srd$@گr3qW.Z28'(kTMmVW$ XO( j SQ3Ql 8)Ov` YH 01R! ף4qc)-n"kfSiסZ%ɋzD%LU nx{?h[gbL>(UE5)nƯ$SѩrzʞQYetUQ=*y*`Bwox#ܗ랈INǀkRԁONMܲ!9TZ@k$:7ayg-a)E%# K wQ!XKiԿTVi[Ͳd0H'k{:'GCW,k2&; w>VWICebu8U[30o^e6 MqI*ɍtCET){]SUL`M3y /3-I BqnSA.+"ތţ;_WkMiYԪL{'#;M5\fC3o飽 Ox=5OC̮7Jۏl7gi:7雖Z?1x-[TwZB^N'NILUg_Hus10k^YFzdMt.YH{͒zKf®1;Sf~(7r/ SZ."g/k0؝t❃NWP[]X6q q:DOά@r aJ/'yTIR!-حqg@Lh4Խ,[Q ߋ@1:ӻk>woD2Ҏ h"m<ǍMV;ޚU1jd%UfWP"r*4d*@8k' +9/ 2X: EbjI:(=(V1Koݯ"~;;X;|~2W1mMwّ+BuHB@.?"DPyg@Uw4j:<$b֕R%_݃Y 04F?rːWukݗ ӴTG2t+Ԓ9 3|7oۅF6Ƭ6i {(e, q䵶/_=ª!]?VFwMwpq] TD$-}~Jcq'+^|kX%rN_؄q~oSƶll}̎lE"o;?u6r`[b=BTQ` dռY,ѠP반_pl}+]ǚDaa M,T/8uYqCK 1ZOߡsn LqY@uhYRԢ='7ƩGY*2tX 2SRF*zLC^6͎JafR9'Y/99zz4ֽ\Z r#>TGe5yL#AEpC NFY$)=V{϶͓t.ﬣ3: JK6 Rm-[tڹT:~ާfJ>MN5{{p2~zK3 }+UV-g 0dS[/93V߈߅eJq &AS} t"9g 1[w+DYZ-t1Af?l`dh [dz[V1iV-/y{а|=,[E+B]B9uui98HHqуAb^Rd̀'$Xy'+Ԋ$:6zHo),z֞~-Fzm>JJb-*V`*J˳j{IO r\(ـF?;E.=WpQ@0"ꩱ扴3fH<[sR;A4tkRǠ):2A0Lm=t]kZN0#sD{cW!${ KC~e~4gPT"8ҲHn =6`i2} ]zfuVͥiKﯭ5k~`0y7-*lC5i8 xLv:̍L=t 4pW5Y\fC%[!N^x yImps67d'mrF3R\Q3#*.nZJ8Ad$-l$ٴW3fmS鼦-8lHϬVhan{umë'ψ]uv:eQ嬶F}Cu2+ѮKBe xg5[5xTuFK!&(R7_ N;&!+٧]#gRНq*K_v{3sz!l>B2sg_eX{aP>ҵwpwV?jzu4S3zIE8 ' g:,fdMy5 SP"2U{R|Fܧ)C~jG,0 ()`yԁԩSJ .X‘~kɒ&>x*CBeN\7AYS]4sFr)Vȥ-+ @GѬR1uۡE(8gJLbd^/G,=u;q௳EQVޭJb 3Yj6"|8)H԰Ό"nM:\4 tD s7\3y6xEAO5;5yz<)=$X}GT#5yW[-~[+ċ*Au޼PpmL]>q 250FdO_ î偸85eEDAjަ嵑M|Կ;2v޴G["rL?Rhh((FZ t!Hu"aeعo|X]YqZOUZ jb۴ ,i2VZFCԴ'KՏ7]vㇶ_oo%d~KkEӱ2Pt{]b)W4iztj n4v,.^K{̤juj,ߒqRL6|0ĈO\+׊;^D;OJ>a٥I3Cp.|LL(2_4ګ66'+9ٖ!ҕI?-E{xh7{-%q\jЧGζY!uL_3 ƍayȫU/-b1ts()"~Rw[lg:n]t؂[\Wau{7i$Hލ ?k4DC-^˒s24 6[iofG~" @ ,گ2ӥtѴ.brk6+ełs:_Z1 e9ժD ]lţ Ee%U#z] Kj(Q!4ůc 0&eʾGEmǂA_J%2\(8GIU֕HcHUfCPPi;'q8dٹGjʖ Ʋ!n#xg,.iz *{ H)m^=wx/_+(yA`AwݰƆBeH멧udlzuV XIc/Yx <^F;G) ԥ\52~n*OM!)׹ GW*[4;u>fk@Ǐ Y1Naʆ>&4O*m= &ֵ[ί\)%Y޵?e ハTYQ> jRغo1j o&`Χ65CJL[q#((yU_Yg[c"p]j% aRhF7%`(G FZit޵ߔRH{CyҖQW xr3 S kҹmy.Ora_η۲U7uV1t>Qo)s/*R6)ҷ3/s6;ʠ{ߌO#D󃐤Ǯ>k?|9K}D?636'.{{ݜ=Iib^>dfiBl/XNȁ/Fv=l2zl4g[: uh|#l; 1"+ W6W)7c}|zK]EP| :TwO1(f {)XsxS"oC.PgޑRIsc4v;14Un_MLSHAFw1Q3eFH x=^&/vڃo3q0#&qUuR)G}ڧRwli-_(DTl9eل}ҍP6Ҷ39dtަ^`lRcf1.+) M] b.`{@V6~r1R2C%zzL({i~|}Ԛ{|,?}>ј2L*ՇP,>,EOp'Gbvn$:6_PW~IL:#m8nS +)NR,(\kyԟjպʀH]i8z+B1/WУxGQRl֬j~{MX:ԩ%чd+l,ÏG+6 Vz+KNeIAy6%Ӫ fmԪv\J;]ѲRUBϊ׊fHo Nȳ%LnQcqB}{>ZThE,Xj#Xc)ˣh5s3?8Oyj5_6}鶍b>W+h"H܈4'3'1;_);0,"; u0۵g oE*- x]z) =s=/eᮅZ0Mz]~V(|vU7 `0׺n8g=pT  i ]J6ѰusBՖz@4ny^czz,@eE߇ #oڛi{޳ QϭSx &iT<dZa{A5]EhHUD8ƌV9LPB)y Bb[#s0mo#rx,f+QNL_Vo[ <3${nn@`l ֆg,B%9XpJT(xsB~J>w Ha];PgMtN*bOO)a=S01lWvU1C8M~k]ݦ="Sg+(p`(l[0\tsW0T#EF}5i~$wX=wzH}ŋ$^y:j8 :u*Sy_I(-i5 pp;A80U]}(W]w*T+-\[ tr&瀫?טt҄iẠ|!.t>;JbH0u@f,R#2~('0Dz(( ge-a fҮ9|3+οJ|l :+1ԁ\a]9FY1UuxS^BO*{: Uz.l '.$DltzS;4]Rs~(RG_ 8_u-@0M g𪛣lZyPff߀ЎuP|}^1p:uy~ѝBuMS^4zep8Cm94 j=O9k,#D2T*^3.+rO_^Sq`+&-=/=Xo`UϏv5g[(/Sy\~*/a-YQs$83}!O>lLyV@q @d1NdÓ?~y3ýr%z D2w%:ߛom`FD1 FGBHً)i&0gpNqӂ 7IID#- m[>'byDRm8_zkGi9;> dfX~9ֲ*DWƛUsv+e|{3=vtSe "!ӳQT xEf1Fnd47dxo{]{<θĖ9Y0is<4w2+0.W "8QdI#C+hȠD#7C ZY@յ_lqrXRC4y?-!f~,2g)b 9ܥrt?h|滈"rQNhnj";X럀/zM]^2| d;G2O`qF;-n@ # ʥsOf2oKPh!5 :gl!E:Ϸ <=j z`P̔j&;7sCyúO(z&VM[]iL#Hx_ JûP3xuCRpKlRHsHoy|S~ǀa"J_C.=Y3зIOCs0d@dlQ4ZxںX4~ `iu*@ GSߺF O԰_b_*kO]mQ {j& 9;qurQ^Z.]&U#rä܂AO.а1ɋZ9+[jiuMt3v;aݸdž;SʩH*MO ѷߢ8eܺ|,1YoFȴHoIƎPsq:/G=c^ Gﭬ sȤ2G )pѨ!],FZJL#[jh&S=>e-zGi6, ,2.f|@dT\S1~ZFY=-53-:?zX͸[<. =j^{ՙZu{?c=ß'߽N 7td3}}@\YH2bȶ>J(XUE6Yk6go􎯛 RXk/PؑR;ZfՂ< HPKIz)#w*)\ 2lB!s'tSmg3hf㳓) mpp*ﴆKkF$!@f|A#< _#z҉'ZkҸ̷SC)YaҪIE{R"?Bhr'}|N!ߞܷT 3 e[,{V")aL7oޞvKT?x )nFG`~zl8iVQ`CCR%/ }2dk)[}A"Lb])mW#~Ђ|tP MTLC7nibs06 %Mxq~Ѵ>5zu˘ϔh2naJc؉]MC4J\)czv)'~_ʊ"a`L"^rR>bȏoM9_rƽCO w*Y;ʛ kvdBYb &Ġv.ExțPڽ;8ƚ5(J]+aN e9B FJaO%J5%zPn i>o6Z\q K\ӣ%ndK|LqP3ܲ5dV'pNs5*9~2=m[64f]&j1eDB bdUBkD3nj. 5,ЏB\#5SЎť/O Z\FHx9QhK&Z=q{W2f&]V.Hq8mh0D J.{ ЦW1 ?0.4jMkF6$ b^ 3quQ.V:e)׸{&]|#516/Q\c2SFgf~Gn/u aޗ*bXo;n3"00*y~bC9&dFI}ԭ-^g} sd[L̓wC t<ڛք}T롴ArJ~r]:9ڛ g-&NGl )Zyv|n9 ϺIq ay# {V&Rͱ'nEߑ2JƝC s‚Qk^}ml9ﵼە9tп~5 `PVJ2!U͎Q;VMX}Q2;X8fޘB,3h^1/-*Ew"kAo 3*Ƀy4 ,7s0Ds,5^; :{ (wU$8`Ѷ zR`CL VVon=EJ4%eE%$q贱'Aj=;KHfZ8*gNS^pIl|,1m ;jkZyW?d( q|ۆ`38l*"(ud-йl\-Aޫ QDfu+7FfqZRt.k|7|yX kHuk:T;IeZՃ6 |ȦUˢ5 Dv1n<8JAv=k觤f72f com&UU&lՋxJLQ-DĘ^=<#<%<̊ +}<6f\LJ"?Tao[t }Mt\u!Ũ{7X0dl3\`[NF]ŋaX$/ozϾN{؇^%z)k3GQGA9L|⶷> ޝU*G|1c6nPBt#RVT,pc@1bD>b&H1p5w ]6kّ3T]v(6nX~1T^*p~\8׻؜zػ8eFT#WFش|žb.=KB5xbfvG#XNf^QB4Rv1|"HB|"rhJ>SYOag].m"eFAfr>K+m& U@~,1s %Yc[Ax{wCjF mqtr$bQr9sr 43p+`g|JPќ^j`tm,qr.\^ FҚ&}rS̱#7gKVDA#$nyJK C\=2k4j!w%Tv`<HB§l^?Y3TM5\H=ff,0%[8Xy>M3?!0 Іz WF\G/֑IlquFK{gB~|Ş j2\HtI~xAH49in:bjeHM]t "(|مDPg+CaLU_C9΢% ɺ=8ERBrAU%䐀X鰈상zJRy%rS2xT p2sEeXPHD[~PeyHAp.&mi_Rjgي]c#Irf?#LnbD")ANSTDNo[eb[7 }3ufJjp&j2;Ml= 6S&j?8>ςܖ *KQS=RaS ]* nJĘ|gA0h_P)Tӱ`f$==NރB;v K%!6ez [(doy[*ys&7G7" \ `u~]B6*]Xa22Wj,"d5S?REMMn tĮd7Y#7@(DIݳH%IHsA7e1$$0 IuPy J3r% ऄy`uڡQ5'cr8*I;nT^Qt='}W(x`@pd^r=ʿ? >k۵.]j{Ol(Tb\z~`wEZЅaBĢʃ}M|3N: pZXXfH#ܻwy|}qRWZEErQ\mhL_W 01'sQD̲?F;A4 P gП'Q[HH\+G9PqvZgkMmC%+V])zOpbʀ]07+@HYu1TB,`=fE91˝(4Lbf-i?{W+~呫G?ooW*HY|C~Gojvh}D2cL:aŅC8^>~#3E`E&TY hoe3#<_ܼ!4C"vWXkܔq\TBnT.*#Idbt0 Dp! ~Ɩ#Z20MXEqfcfb#|jgD) U:wˇN~V|8 F1@Hg@YeCS3u ǿ22 {fy⼁9b6P >r̀! K2_C,Gu"漴F?[⢝3uZFDO"$ߍeq86"tćU<ʒa[dσ$%sE O4:ub1p [Ļ|;ǝ ϗXt<[qwHs'Ƨ1UTHFd1nJ# [Ͼw#HAǯ.oBlB8d!GR_XYښWw]ߕ mn?mx˧_6N=1oײEZ w"}#i῕D<mڣdM$j^8cI䛭g<[ <_? 8vWd R<KU:cQDi`@dk]hD1Q K"N17O^! т Yqwaj ry0KXvbu#e3EN+Ѭ.2HAEal`=m2LxTi3ךKJƶv>fQr2uih+@Yl޵H|єluy%| Oyk#j7b f^Ƃi4.y<Bj !X,'V ȟBuՙR-#kMx#ly£TxT^,#+hl3*4LkCRPc5)XvJ mFQD, \NGyMkbZ57i?~aB-ğ/g="2='!F10~[v6uzy(?n6ɵ/];+EG†0=dɗ b̯2Go&f\ֶZi|/\Kb m+m0N=_o*WCWB)G! -/T |ƒw:ZZ$zU8'7kk]$\lL$Bpfguql|DWb]V_Ղ*]\{4#I fUJu!Z/?גl~vҮ*̡[`-iJz5a~sE}+{$%QqC,VMu U*a,B!82 D+;#rAESՁf)N 2z+vW~cg&쯊{ cjGJqIw/M:9Bϧ߷AV *m[.5+q? ZV,-b1kJ__ 4}( >\PW3x|a#$c-=c;w?v2έ*M\a'|q\|#EөomT61HKE2KO/HIVjgIcLb Fza)ִ&_3_&}qαJ0ՠ)h[)YÇ.wpZүB&41.]jiW2&iEe#ȊI9ǵ;e>bղ<~h*xVu `G~ʐ]݅owRWpy#49hy#۴ƈpWysԬ>eNYw QY>j$ b @l@'[~zoc}w{rX[,w0-D,+b|v- >51Q^)$m޹30 (,Ncȫ5ccsD*]e94`.?9{Bˋ[ t _7Y[4!*h,b+ӼhQ;`᫏H]7u E+,%'O5V19b/2_)k-p7CmIWJNv<(?sgaq+oLxP86 e Uwg |ozza`K4'c{K֮ Ρ"flA*nٸ|) t.m¦+5eA3yˑl27p=]]r 8|R+^0h`9wxL'&~YI]yoJG|umXkg q+t@w)ҺпƲ3#cIM.G$(ME&,4lҤ/.wkvonX+Y6ni^nY==-hLҳmnlA`9[PK$nc8i0F"6>-mfPpNJ۟;J]r(L.3L3.ƿ&}tjVkU:j[ {vArevHPeZ%Q}tk~'LAr$hX N˙`!  ـJ޼Gkb;ݴ؛&,G%;|Y-xc[oڹ^j5w!%=7:5-, P36 $1i!CzRM}h%* ʓx.C:!/@uϓJU]"ܓgQY4Lu C}Q0ƶ@4lFb^JGHV2prUHgև0 /~4X8φ.| ݺ$nb_q*fayVaӮjSC@,S^?J0u`=.4cA!E6ዘ eJߒrKS mW15l" nO /i 2oǞr)-F г nuZuI(ot-U`^2yUO>3ӥcX .I:J XdBq|U1ArhK y8QHт4hI.qL&|ՐйCU3e Qٴ=bٽh=;w?ƳЖl{n6)aRP<SËSsw{ղ\ɏH5)s+*E U(đ}z!c5)o\A{\|ֳSq}jlK;Is:ɄF!Zax0 }Mh[#=fjPw1lgںN㏁o2u = t|\@& [o@*~l?VP7k?T8 !T:N)"^],"nԲON#_fvѿTΑ}(tZk  };dkíЊbE^}SJrZ>V5͛ο)LboIצCY$n:/Y2昡SeoƺASj6D:d\/Ԣ%Xۺ cd{W`g <^EH."){8qwWʫ-{}yV/y.\,]:.ꚳa.3'-4vQ#<-!z,1R<[klixe[Iam~L[RtJF'!jWgD+yMB,., I`x<ګ3|nUR03<9bk׹rŀ&T̗\۝8bcEt Hb |hc!BHD%%z-45秭0$&G)-sUIE/}/e&+땼 eC=WEs rnElD15!+˦b2z'ֵt@DIDO ōfʣ0ҘH{-S`<4374h_#+(*QTK3IN3"PZo?߶Ux:Y`& '`]AM`Yp?Djޡغ1t^Yj^M_{2ؗŅ 0R1}&=rd YijKJ?LQQCZjou;) Êm?VfzA+ǟZGڙËNndkXnhٰ602g`u"3~ ޥvAH&O_|֣M@MDbSnV?Ԧ.{lkSڻp"}8v; `G/vIW]h0BХr@Gu+2压-k/N˩n4g 4EL"+dC)B6X CŬNʤN_w5︳ɀM&>!z;׸'$ ޱŁ ܺ)߆KVu ҅rn^ Ylq]ucm]J]l7Fŭ* DiwKT NH3"I4k=UT $: BJ%}{KB=j8 gL榏n"վ*tZ={{@8:(G'V k?8xNd%`UDr(E*KF=ZBJ+,,uG1Sc啕ܙ]ȕE' >ףrjM4֕&Lܳ%4ô=u&se?L MMUh'ň+I[*Ӑ TЬ cg 1rUyhU-2hd7|]^Zкk73#,zEyـ3%5ϺM<݊G=~ωWll!*ӍhjN`yȍ=r*<9hf8Bk)d&FRi5\j@N R msap.53S&-\:И44ko6έ+ӻ̀Yl#ˏJ(iGqn|/E,b^6*Qh^}(h5[6e)UQT ;J^Gjwr:{qܥT#V"XV:yd[ŦP'~\[(ATxg1!-{1=#?$SśђNVvW& ;I$1,@7!aiplbE҄5{ș1JNc灷-tŭ޺߀alȝ;X`h{+ߺǎʝX/&Qb3`OO+zҺ;&:Er:S]hH۴D> i "ш@rܚI5P! UUepbR!>2WzMҟ&usbZMC 9zI)$7!C~oճHvS47P9핝FAAUwl2%Ő,s13] g.QsShr"A$`nR$$&R1+XVs=.b9H:6?0,"r`VGjPV!8x'-EKg3Y=4tV^iާ!XL_Z*V #ڄڀ(AWƠ'k(.$j.5]ڛ(s8of]^a$ #܊.&,'R4@A ^0aURa@ !i-9P{gj;dR Z8UfRyqf++7x9v ѳ#3U5pm冿Rii&[ÔMZφ2io3L](.YTlrV%i 9$a_l0{aIDa }%B͉Ʉ?z!mhq*oJ9$ygD'#@]=NmOf{|n}zvw zRrMdnl jԫ8ZÂpwNv4vDLj@ve23čDG&IS²x5EۦQS<mad1H*{lp(&zxNl*44kEϫx?E>MNӆWH19g$jz֌jM l $v̴~RKl֨9RVrstL-H:ض,qA2f ͒d)s.^3 ھxޒ~1KO2 aCF iNgGYOKj7nv&f+N' 6x\@a1HUtA,S^\`*w$*T/7 ;h8Xu K:w&LFJʶ\ӫ*U]^^yP9kHorq~qNw~%5zY`8svͯ{Sx/UOiΎbyx+;zO)l/gr?.Fy DOyi աE lrFUX ^;gfluwu߹B'FLJjF:˫,@\@phTEDVgKDBG8e71*8`g&|f3䏁giU4ze)5gPloyCplNKvflҘ~՗6ܖZ."и͒b8 nm[ L+i/- rm H!sSA-a&WAw*sCö5?D/b"-b}v۲sBmYLw{2ѪPi}~w-ȧ>#S "Aja@<kTN||y:#:&v~֒D}W>Zɂ0Iӳ*a8]<1}`4r[Q$F/K[Wfmo/}B۩* <}j٥J^;܂UnIۦ:[JA9m翄X望_:@ v9/P@kV гtDQ]%įh`*-26̀Ss ÚU뢕׳{ VԹ 4elaao%?3m_ fy^[}wup*e46B#jso Emfp!U ΢UeQUD>!-|牝tS-B(1tX(yͪb;Oc(͔ IEs[I;N!Eev{'WV:̖bYG bC3Y ºL*k:HphWroLmwCtS#xu.nJϔZsԚ7LT9\\?w fWźY/3ZL@!TZ6ThQTmX`ﶪ i!@ԛ&Պ5(IC[o~̟}mk54Z,mF6*5$T6PQHͤذb4e4DdRfZ&!,CcXVi cd2U-RT F(@^QITE㤋Djt6[)ٶmlhdI AIlXTIE6C  Hb`ŊMDPFƢ5ŬV6ѵTU@VlTj,cTPi,1ֶ^T|yEGRJb'hm 51V5XlVF6- JQcCBɅ$ DAFLZi-hŨlX lwzPKߩSCje$H B`# #&d̍0PID4h4)TBdm1&2!(abHLę!@33@ I i% D$16-ųB5Im"I[&R a(4DFJ"`dɒ0APaP,XF14E2ă2&) LB"`A-[[kb-AhFZVѶ4FƊ160R1LY4)DRRAEl&-XMQlhXSjzVzJ#$X12RcQ"X#F"XRX-ihE TQԚƣPVBUѱQ[%jhMBj=P=@(+ PKԪ,|jڳњmSbRmTڨh54cQh5L$F)&FFRm5m66"V (ԂjbƭV*֐bJQDY2J4Z"jJJE- e!ΠRTNS$ 6CiJ ,(¤13"1[hu[UkSEWEW%$ECG]ڤ%b16ͳfߠ^Bqw$y*qWpqOQ_ݑAA=*zj(l)HY,I&J*C0TڤXMTkd6,$QTJ4*LZP$$0Bi3&(H` &cZMT-Y6AQAS2S,PFБBV5&+٦[65+^!ԋݢE+)'G_)},3;*7*-J5&j L-몹ZZ*ZNR[l@JI꒒WwfC%ƒ+ɢU\ۛr.˦Qwh-{E}yʔD"WbBOĂ4$i .>BK!SUȊ!zʏ6mb*jIcKţchMV5Eb4bbD֤HmV͚|TurwJ>B ,.r*2DUЅ^HINaH%#h#uAWГ/[I/ TUR_EORH`ZڠUeAޅKlj-A"!lbbmmml[#B& DŢ[%Q-ZέDJ+6ڵzmj%%6J b؍b4j6%[FFXjE!I 6[Pjcm,cD1R!Q$OEGC sQ>RU66J6uAi5LQsUh"Y6@ntnnU۶ܣ\ -W"KARL!h5&TV6*MQj6T5h%ƍ`!!KF5ѨkFՈ"4jދj+j"j-ƶ,lZ hţlQcY 2MEd*"Z1AddāBDET!%! )2F-i4EXmZ-*61"HRf٢"0C6k1n=UxR伅$梓P(v é_><:cj+T ܚuwb9MsurwnkpWW;Qr95IrrwkAsh6\݄TX%dFƢbbLQcAmmchd֋","$+jW[jJ(YdjI*31(0bbEB"Y0aA a(Q)bi42  2d)"LfA(Chشk6ōض-h6آ@mci6ō b(-E"lUlڶʛG=r-fb 6"lkF,Z+TjQmFH!c Qd)5-Vl ҙmU-4-1F&cLUVű5DԓRNQ]!ȪE` Tb{G ͦ"&6)m$"HLtwD40wc9΍&smtۻj-nv]uλQ;Mr5r˺qi(t;u]\`w@;wqݻ)\ݮ\I\,adpb6!TLڶuձk\MEa8fTW{]U#"^Y)9^-j-[Qj65F,AIAF EdK&"e)bѓTڍcXFF, ш1^m%xnwC$:ЃAI搩TAu}Ѳ7NNrs-ؤj64%*HH."92d@Q4DICYJݨjVJ-XmVkڤw:.WKuss,[']9s9\һ++.t7ݚM)q-ڹmr5mz)@wZI$:(C҃H@Cl֢JQjEXb((`Q4LfڣdAnB!y!Q=$:p͵ FضқD͊ E$TPEƄѲd$FHM(MI5A֍Z llFb-F(6MUE>tA;lm`X=dh4I%.HM$ŌQh7:FѤQLڹ]+cm[BZ*ۛ-&T! 6棋]ݻ;WL)tI88n lKӥEe!U+Ԕ9Ae,콜 *_A @TU?_XIAdD&Z*-Z m/M(x!TƮx: pq$'F5%E5D25kU&ִm+Z*EEj1dQj)"6jmSj̬I;!zH~j%|ڎn"R} /)"ѵ&Vlmb% fmKmL6;NMB]͛6M$WERQ)8%O_B^=~q]'.%q)9(UP r9$tHD7UKQ̡UX552QDEQh|ۜ8E )j.Xkt-ͷ6ԛnk,ZC@QsVޙZu)U%rb^DHA!D01D*1I&YXePDK1@dL,b RH&,Z+")mDX1dX!FL1I) F1YrhJQG5m٢,[hڍEr56EchشP(,,hE Z2Uڋ Qz:u*q'M%;i)ʩISآjYAUʤΕWjU_ rQWH\j}\NW*KRYW8 .jO^GmZsslm Ms#www9p'pa r;\s).n\$wa˥d˝&Q%AͅݫmC i50 dBR+L$e)!lC 0i)Mvsh3QAhň"JfF$.BfB bR)s"wmh7W2W9+(G $Oa~+bRkkQFc Qc5hm[Xɴk$Z5fbb4lBi4iѴXjd*63Q"#L`mWNr/H=(WaJ2JO,*/ڔ% $UJ'ɤKE /*ԋR.&R[Vō( bPȱEh-F(-jmmd@2h 6iQSƤ]HT*$TȩRKECHyWI$zI:CW1hFd A`%[&+bmF&ڊjM`CZ4ʋ3C # H ,h 3$k&Ơ3mF6kTZ6ح&H4h))bI&M& HFjɪMQQIDEoGk|%OuTmE[j1h#IEJa)dTIZLbŶ-Q[Q65ţk~8)„ݤwaveslim/data/ibm.rda0000644000176200001440000000116214627073455014266 0ustar liggesusersBZh91AY&SY}q@@@@P@@P@xfo@@@@@@@@@@@@@@A@pMO%=' &iMTmM&@OS0`0)*=z6@4 R5?n*^}WgE_ZjŴ.vy)IbɜPs|lyf@]86\3VL#qLZ#8MC89wtfusxQܦP~VJߞ0lEB++b+pJDK\t[e@ bZsжUjE'Hu}¿ߖ-uۏerؾ ~~ضgۿfu;e<;+>;r)nWݮ]u==<{@V׾ex`,}qH!C:AӐ_C~ }7aM~54_iߚź54&-ђsK?eZx[eZm>m9M m6Ƕk:|t)>ۃUg>ӡ#;rc9vۡ=WOu3\{ۓ_ޞݗWOO_N}>w#w$#+?x8{?x433XlrED B{>0C| 0h^C0gXRg_m?PO\_83wDޑE4SGDBs#3#{4t$gZ&'W?B<>$](լob_{Н={Bg"rO=;Rv??JJwJw>nF{Oj>Aj>_r.ޥ=;5}rc'O|u䇫xy?Oȧwaveslim/data/doppler.rda0000644000176200001440000000772014627073455015172 0ustar liggesusers]X 4׿JU!**$JTHe n( Bf)åm&pu狫dHA[Y}9{so>VƶbbA ($@\@XD",Y@QgoO_APU6a߁}88 }FO0K|j#kΏ@hXΡrtSRTN2k>`2PsUs+O"I{L4oATT!Z)>`@]Fh.SIMN4vK (]:l:+ ?> o5hOPPXT Y#.6=/cof#WRGwҍvnt%4,i+~߰" )=X}&(`lZs @٠]D8*ϻnZ} t~RI!1xs kRRuC=bN)GS]u:S;kjtx_ƕ?+9A ;rΪ ѩ.^E{˚%O@\&#hݜ92Jտu.~6o O~B1m/_"MR#2H5n4 ޟڽṕ;1RPZB* y"@kU_1_ZtHtVwd#0ldz>0._+"|ir6?t$"x#ͤfK"adf;rȪ[fe6y)*Lۥ+;ѫVv;/bUhp ,Y5txqP tFCC@y [+ tw%9-YaCrI TYĥҟI=Ƕ;;{ͼb@[1y%'K{7#=0ބuZgCH$[u4ʟB嘔 m2.ػ!k@th +9>yܑ͓ٚc_l=e9vNEa$dݯٹz 2ڟVDnlsﴍk$F=x7V/$KUn"BsT \rPG#KzIj6XҕSw {A@ ӋGN@ GP<'1 R̔Ot(?p =cZ[סV kǞ̘ Iq_'tώ6N{lyRij-'yuFL,I[!+M>w|6ce߷)DmHu2M~JL{3rӲ [[>JuE1]W'm{݄t[vaܺ!^oo a?L}C߉D1MFZ-ulY1$Ed|-POt*clZٜŖ$dB\cP aέ$"9_\xev\1EMȀ?k(~)|DYZj"Z5bY^ H!̈~>[K 뼧Aj@.8oTRle( d[CCˀgB.@Y}OnQ]:}!CZՉlPeZ,Q%f. rX |obm_Oyܧ9y /O5̜>ut{t'Kos`绩LI5Ң SfIWRikslGBi`TXYFz6з+<CNO VaII6V.@7ZzdGKtmQmm;x\{}N\ p$3 _l$Udzrҡ-/.A*">® }I6݅ѹlv\>:i }|.*uzRȯ<mmKϜ)[|z[k#7iYD~O8sM.ECNP19$u_GsS:/[$@`o4o].YvkȎ N[s9a:Fމ-<6{ wR?OڥĐ}nX `2- <F2u]C5COo¦5ѕ y뼞X65Vs]*MVe8{+ޫ~z%;YaKJVu.@@->UÇxc}רEKG yGd_S/a7B!P YUL ^Yڎ)܀}do bV@dʝP5tKM1gP/J< k7 gvg&4v>Y/|Y!hUޖr_ C>3v#PƉc%@]nj'4mꔰW@X?LA-- Rs(?0w4zAk̇k#z0-0؍S=`3J+`rsĀ^cƪG5&׌j*`TU 8kLK=E~dp_lXi JpXyp83^NWFW_UƁkIS+խL,zB u)p[^f ?|z`a|yM¼L$p/ 2z8x&YGϱUGױ5]; =_K e6TNɡgSu+2 龜gT<%,iשB6҆h;  q yoA_J4s?waveslim/data/jumpsine.rda0000644000176200001440000000376314627073455015362 0ustar liggesusers혉WW5Ьt"vE#P0"h) 2D$ P`> !afPI@A"-L_H8[{Uo\#QP+HJ99"GU/&>|)= ؖ4]؞5;0;ˮU|tɃZJؙiC}Oy6 =8ԣP?VşwPG,Pozp2hoWuU&F&`IUWa+E;e<^3Э:z+ aqKGE[ЧxU}/nDatIO1?uV0b6pL v>Q; < KNm+ft 0}Z[fYgf7 |f/yߡ*s-Q#//U//Tt3Au`C>2 sGYxtjs2A0[WY!7P ͓v ,㥗AX[QxdI*m5)჏A>k=t[U ,{baײx<q?^Z?#1%b޲qt>8/# O!'"7O ~/~S1}-bz'~b?ZZ??yyy/y? t>΋:OBK ?<<<'/<7?>>>'/>7s<p}z>֏~̃y+>Mzg cBydç֚\X/y&ӏF;=`tf,05Bz(`SW Lj`"vxǻUgy[a`,Ͻc ?-~3J W'6Ż@mOeŵfѻ6& Q< .Mp賊f7C[ !%m{pp9tN5_}༿g%j{wK8`l.6;_It$]u/jw 5tZܦu`?`='o=9zZwq{dXyf|Lz'f`塱.c$+| e{^>н+8+GnyWպ"G<,Ic X~xf@iX8])u*@W T11>^F]ns\\]\ϖ9/pyF“yd }PKvy/8yбL\gz:J `Tz^ْ$I }UbqA577|,W]z^+袶9);s5Mzħd}oh[s:-=AϹ M)W UV#k6sR٧Ojf$W%]}3slsٮq}SvҖytr:m1j>T:$Fc 87[>}cf^oc.^ذ}A>#yД>eG!~E/ 9E)8jO|) }gN+<waveslim/data/mexm.rda0000644000176200001440000000354114627073455014470 0ustar liggesusers]T/<"bptK\eGtJgjisSK?9q[ijNˎSYMvv |Ω/yyToQZtQwDD;#sD:+HYW'(v6 Seۃ F[Wlo|gO<<<7^̣ϓIc;G=GswuMܼN=&^o8|ռW<}U'ݾWӜ}ϧww>S9>ݟ?p^&}J=/έU#ЛGKՓnuO&kys>M3OɛEK*}ݥOAG8ߥ]);N_纈[~炉`y7/JB-"E:K+_ *Z(M[̭*@O sUccZթ_W֞^L|_zOf}g[V2yg޹3 3gyֳAyN ݿn7 VޚNqVk寽~pc:^pAEfp*Ᏽ>ܨMFxTi+U 82Y}Zo] nm5oap@pgغE)T=˄һGzn}T >n&xX9 |c6tPbwbsf/ﶁ' 8'Z;:.Nw ?^~({xz(gf) 䝝KG%b3qէ/+nq'≻0\yvh/'a=>Hܧؗc_m~%Gs/m ^ ]'XLWӳ~LG >{/owݎ¸V Yr-t@Oo2z{qCKEPڤ˅>'}}^K;f-?c׵"BOD+:#\1rw~ E4{?a 1;l?=^Ŏb?֠X^ǠD>N?c# ԏ) Iݓa7¦Drꄅіx &6\9ܑ6RC_@K[Mrĝ$֝&l9676%ά/ȌHZW5wvXXui}uJB/y %~3ɱh&% +r{<1&g\t!>V dW)jףZ-3+cɦiȞŮl.o7\*Q,~C5hJ!R)pg*,mu*^_!@?d%HFHE;#ۈf.s,.[6 hd:7j62sE^nx"rz}FxN{d6H mJz5fdFl, ^ X>Og@,0dTKSjNm@UT欇CpRDX+'K3g @٠4au׮@uњ1UOє 1إn^b֥7%1;5^}r e^H v|v8"fj}$PF}i]Yjy‹~>'vqdfݸ_Gą^ŝ^hVF^}1^}@:w+=ޫrbDrHvV J GqIi+9"^ K|%<ś[Wj{55. @# H:^(K]S1J[rmI"فfvIziIyM<)XaN馊e);:(C;M ^6UUKa3&L'5i|*|6ٝq":/tc[)0AUSKݒFrҗ^tGu&$30}a3s&H.|b;vz{ߪ*yEχteeN}uQti4fC1?p5McM3&++V<%E{sD%n׻UEa8]; צ`%LjgCm҆*vs)EM]=9aWPQKߏ9@#Ple+ym TTh >z\B1 Z^[2Ù-GQyd~W=#> Kde~dS h{.HAU yfMǬ5Fn.ͮn291L|%_SRRjT5l9݆]$B uEqpGz8'{&qZvy8+]' w ;mNɹu.gFB劢}l6$yۉ%߰RR_7O><-]Y8h|7WAwҙcWm iKaS_Là@IѫWB(N,b[&}ia)Vw~[ F/eҚp3Т5*~a`n ~< oə,.nCKmcqs+]4c 8:gľ=:YXF5+l@V ¯:PX-{2+HfxE,dZoW;bF>Rj7 '(_;9=?{Q1bt Ct;j)#xG`FgeYӜlϩJEխzpG&y S2*.]vx6Í[y[\_ AjdR+gW5rvүY:\K596X#'&ݟjCzWvZU0Mkx<2T QvɮFT=k߷)Bۧ(kh;c-^.>nAav&m-j/$3s[jA/@~f%nFZ:pJ="RNlvZB&G"xZfShٽ,o8Hº<-IF]e.V>Z;}qĪf47bAHF">(?Bc$FLQ>ޮkFBT&J,T|^"+Eڇ+2}nu>_2DIuv=C$uf 5iwO x[$s4,Onмoꢋf<1!Ǝ' }k۬'7ʟwC|ڹB6um\. lSGV|+ X|qN1hAT8 bB>* 8<-q:?2O\O6PqZXAqOP&Şoy!ƌ[43_ ,Xx!_")aޫEU,w@2TvFQϰJE*jeNP1Nuݘb<  ,Ȃ, P#f#iI > z'FRsT.߶grm3*/nw*r?'D KߠP0e}Jtzh䛣)1pQC/֏aa-r5=+!/ 8-i^]Z63OήJXIxfC/hYl_MYܪN>f.V?Q*.ZB,1E31>>8\cl7̱,C ҘGh[5i\˕;T =̽,%tAG($VRaӅlzL6GoۢQ0BP&6o\>;+y^]ވ4$f>~/1nRy+_SAT,k^rk(%+ۓD 9T%IC/Z ?pH3oꞃ(beSщ%-摖 VU2  *(.YpېE^Ȁ|g?^$bdzc HmB``;E/YANݟ&.s_hQ$(~˺/Fwwǝ 8b9 1 xkcM;vè*҆O<\|s'ܗG{Dz9$"^3x7P\Y X67w 9QYf‚pC ؞'&}`qRN{~? =54<)};)s4~ v:{u: {t6D cbS)1&le RΡeDC KB48y8Ӧ3/ՋN$K !f#?;Do?- $((]ˁ[WjA,Msc)ҳA?^*KfF8L/"&Pf-YW\+DK̈#"l#+B%ثV2;nnAlғ`4 TmoH\`/ r|(4w*TC銰Hu;b^s>Q"hmVMHHHm&XlM]Rng[]Gl7L~t9"C(_]b215m߱gJE@ ސ8/f}IИbNE' N-m; Y|y~AyB[ wYT!Iisz_SR 㳹343^l9sֳW_%9w:+SN/ň(Ltb1Ⱦh'XAщhN@-${'c;ҦͅRL} нf(Q͂ٝ̋7h2cUq0-h!*rg}qFAH0_aVv7g]oON<>&:R;zT':0m/n˜cy!_?p0VKb]dxåab[)9,j 2_w؜dQaK"$RP+"Y @%.G)z1J!G~:zBCgw|D^4,ANCPX;~vҼ{1A(R}! o6os3Bs*}m8ő8*yѳWhBkv2#U7-3ޅJv΄j1J㤢sBchIgjY$&'vznֿl/e6$Fh.n"T?M}Gqm8 nzGfBr~{j9dGm}#fg^*py'گ(8A3V.8mE`Y9C瑴/KF kyMG?r ŗθA0c;fi.ȏāv1<.,|Gq5'ho׮N?]J%mWhba:Ɛ9d3a).DQ4<&bSS"H=c z>lR !+R*`ݧkbHGpڪdK ^D檣I-9*K@m·fl2|㯣1y!6U _%ON@"EI\ՑliI,8ک&cCON;} =`'|q=; :3mu~S)9<`,΄P]z X%[kiL]2DjhUy`1m9r!к'Qh SmӪ*q8gsXjf^?/΀aomma]haB0V.k[B+,rBOfdzx ©eGRL$X1g"[8 1# )IAsxɒI}fT噬4lĄ2rkL3#2<>elX9kbQJm >:Z.SW'0A -LԅKFwTݮ;H!{0?ѽ)I] v1idw,4rȤ) p%S.pyDҍZv8-9 ƧՓ7( CkN[Dj֌"#*֙ymWPӀrdVE({@)T* r\X-g%6.A,7%_wu/Qkt:r*w7dFy셹 ix@IZ[Di#;$żKJ !D C(SK/[͵%⼣OO'~UVq|9$_33lʫ7DXI}9{qڕ/l#Fvd)GZqXP_6[n}$7 lٟY|jBt2IE.Pŋy7HD)gp\҇ HNr芠=xz%)0(ƯJ9Sjƽz;ґg`Cfvc&] ݅($# .Tכ3$FSnV!p)P p8dƗG+>$^H oʹ$Yd]vB< R;Xog>4+ƷU.g+og Cxpz, >dYHr ԱjU XjL EJWLY?4Ռq{;";6%z"DKp0hM_,af7v%Z&EL}czxvޖӵOۚ}u^V ]KycDk-@k+"ICLFH_49m~Jv_UB{;&M҂sly4&u3#Foƚ) z_Yu&?/|-06(wsc,4SYF$xR)$@mke.R+m<}G_{!*%3>s5DMx'条P~,2\ 嗈Y"_ě- pk/ʍ7OdX*F,+@W@:Bl6#m! PC4IILkɜf4aK{}[!lW~23!t =Nnav'1=q5K~g4)5]82Bg"G% %{̵NOQlFɬPfn( ig''zrX⫞akڧ^ 20α$(ة˹ -3v0GIZ6#zVc^pb%20.33wRtx8)B2%rS(ticکR> R<vaO= AifG5MG&4&L$)ohOEd 2{JBwH녑$nϕad=-.da61_3uˇ*#ih(X|A.L\rVG ]CV9r5 ٙg~4SrXd-$l*;uj'6Y> 0熹5J6(" _Ƒ:)0lM ;UEUPJzmFiLbN '(Uۯu2vԜI^g]D[&cV#sa@A\K)(@"gŮ *o2'ЎP.*9b]h-,d `EXPuη҂ncn/ o)t*{ԃsؑ8&|]bQeNt'8:mē39,1TRkp˅׶+CU9ҿnD߽:Ns]~+S)K7 O vTsO~DH W Y7N@,e7Uq ZPB-O62ZC$'סR8.Hu^}dy]'hTX/>f$C 18Q!qlW5 k"Cbqdqؤ"IMN@r4+9(JC,t.nK\1h7PCv2n*nQI|&œR({I%|wck rk !4uʗ:xTڡ;e"7+߱e˧]ce*U{d1>#1` azjZ9Hb:J'DMUamCm#=z8sUGnSd+.:O7Dp< \c9*MO%%3+QlF'cW4A6ݝcmBNQ04FU8׬ Us)N pkëjc'؀_>څ=̜O-9<3u9.bWDڨ~T)bw5(}ᅵ d !3ZUϳ GlH TkbwdtoJȚ\bt+VavEgN_J=tQ2OKv7iX^a)(S8!-p_S* ڄf_Pg6afES\uxuZ@=pCCJ+Dz7Ӣ]#@;^X}DZ5kti@\7I~h q+yoӇw|uas|p(<{? YsXm¿ڴ ~7N}mʁ r/UoΥG1O(Xr)ٴW X\Pwnaޔ еBx~zllhvcE0*!HW䕣 ]`jkDCW DTaV~ۑc\]pNgl$` UQYv4Y[J| 2w\yHe-3LLθO1;#+տV2<{Mh "HE$1@Z)X¾;TlD AOAٜR+ juv(j!~nR~('"5)+fbG%P5+H Qg9t&o7͵G GOi}uzFFZ.ɓLT:dP]ZT4mwgL޳?,z6 xs|g}wvH]SA%"{sIK]rUrUqT1f^5QFqLf+#UUC LnĪy.IAEg(9FpO<@;}Vi?"}2Zğãr$K&_mC*;j$uI2zaj7O)L6a+C %.u>~r64[uE-GYk6s {!,,ꅠͪYA(v7O'I(`1lTSN~u-˒9K>"J}iGyڈ{9 \ c`S,,^RhSOk!ض#jyV!Ф*U3wM 2V5j9ݪ( ƊySg)X( $ 9WjJໝv6綦;5#[O@ nU1;<_='/$OI- ϻK!wae,[͐x*i^ǧq<1AX"P8) ~QY=_\p1^7oC@(jm}WTUtAwr YntϬeƐ^aF^32qb#')F2.Zj6N eW2ĢCbnGN M3)̣p,6q%Vo.e$h9z~LS _V'/{`cS|t`O \=_,a-Ek. *B =k+Qh~־o &#Hb{N+s*2gqb`Xf%*w;ק/% Ny"Gq{z*sڍor& @Vg=0y[4jЕ$`Vr`8K|ݔnރ{޶WIEiT>f?p_ez:,S'T]F{"#ѶaϹyJg>SNOA `XYA-DRrS;c"BT(dW+G }~tkoKvsӾ?C/UlX6onU*ntmg $(Vu@pN# *y P2ԑU X{cU{ ülou:cnDlVu]rg:Br9:\Z);/L,p@Q$e : &-4vau @Z`/>hYI*b:ee}pZc[?pgN,E1U~>IJdv XP$ > L#sGSrie{r>gEbOՋs;O:KVO3ǞnJ2-|X>x r'Ё 4SW8e1S-gYr0p| 98gֶUᧈ'B;П]c+*-e'Y}ӨA*Xώ'Rbİ@-Ry">8/T[ 0L@3rW9w\{y'xcQt bN5Akʙ{9c8y_бW2̋gxUS53#s4 nؘhT2b|Rkd<̻,݌nvbgJtN=HzJPw?ɑ%ȕJ|>6v[x˳2<=@B-ݒ@.{: >E46TrWWA@hXibΪ huK'SŜK!>i- V4̬ gY.EZ0jqBCoZ5(@'9g #]SS ⸮&q\MYtQ.4`\tM}eoTT)i]ʭ?V1jeX~U6)/|8HN\#u)r`!Nw蠪@mxi|KWЕmvcW8vGLBy.^S`gPs: pn]p(l h 3jeB9յ-cwi6Űtr%}ʍEN l< KcwAKwhߜҍ Q ͥ$R,%X7{zсX<ؼ7a wfLd9:VZ:SolܹzC9uIPl -i1&rMk$uq΄8S) ҒFcGd Yb C "gI١S!RJ){NYN!l=eT*yCW)]jo9;A#k0U],*p@lN&K'nFljujԳo$ggqRa>8(U7%RSR$gX{@ GXi!Oi k^.T JmIe#@O P&owmxj leK/Yd住zڞe-HLbca#+.`r3?C"!zXk}Ny z_snj|o=+]FX۫j>{|KqMqcs }=ft|kg6wW%_Jg=خXhwa]FlBɬ/h p:,5a-99gEߚpŻXSYHo6HvE,[.p(7qx@u_x ]ޗD#ُrU5Ou9}˱<(#ĩBݾ_:G_ ھ'+B#)A)wH|SE|]"̕1mXyl+Ǧm$\lq0={uֿ+wªW&[g*}v}Z!l1'H|b< >Aۢ>Ltϩ(͝ߌbXtZ9 iߺv"V9dbgx\(QRt:F+u۪!dXMY ,\2e;FLec|RJw}6P\{($cG .0ˆ3vn7~PzF`b NߑfFwΈ=gSw;?Vh3a@ ⿶m'pM.ҥ1BKmq6> JX_6oeIore #R=DFA{RAܲjBG%eap#FʉclȒd`UO`'}%jd2C.Azak>:l>EMhC%EQ]˼'_yT)uZ}z`JESZgH>Dq(0\i9L,M"XnN-76`vu^\Q?*0N^'b"ھis':Q1Is鄷;`~C($k CL">S5~S'C@M$_O0؊6{ѡ8}7c/o4-%W.TÉ4׭j^yC,?`GPb4uID [J P|+\ҚIXET={DU8nwc_AxoLuv]qz hVMWЪYk/~powL3L\!CLݘ__#_.Fmn2FdqN[;r}m_Yc ]HSjl4&l42Sl7"@#FИM`m/T 7ŕCᨪV~$x3nߣ(:V8âteϩI-[3>o/E H9`q–M1'L{m(>/]~XOU ~ 8. q3ՑSOҰoIk<Ra_X`^J)BөhDV{wMf1\bL1u 9sO&X߱V&K=YIҍ7.)PM wB*5xfV³B5 . Tw$[(?6q>Q4*9mgaY򨽮%)zRD=B^G*H;"tmKD,p7[p #܅󣉃BlUU: rrKb/AThQKH+iyn#;b$NNM%-]'g&P" bǙ+b]":|QF'5G"g1̨nPo, ӽcUr Mz@Q{XI 暝L(E;… : yCit'[[XG݈8?F {&JYRV%5X'QцdV, 8i1(pK]B4!jXυ <Ҝ=ۺΟ"@~oLfDv`ifʭtQh-;}'D*ݧLn_+)7o)1TFm{UĭL` 신7E7w`c ƋpnvQ5 pt[K4u3 vhP+˱G",4kD;\ۭڤ>?U^$6P] 8}F<">c~?YnMًo@J(`a5cbcE4 )@d di C+ܕfvx/P ¿vV¿|3TГZ3+JJAP` Ld>FS#Xs@EC-4ꂈ*|\[3/u;Q\S+Y?@kU8IJ-&i2kgXhIJ3TWB,٬ʁ ]c$R%l>~O$[/.ZݴA bJENo}9GIJTe]]îvEY.h|*eg&&nw6 5y{OLd=>6L2c,T a )!J ULNf5 43Wu!/Cloý859xҤ/Wf~rk"9׸;uO~iš+H~ԱXIQf kIVH!mG'_뜹vH7,8w1/Qb (@23l3+&YTmMwQ?,[i !ʷ;;t3*\,jN3 JYtm7: ق4&QqUp)L' bob91BCK#OcvsOTk _~Bvj͖nYyļC'bƱa}Y_}nzu.\WT#9O_H-k[Q.8r?"8mK 3KN\N?ׁoÃvE {m$ #>'*<b ڛ/V"66inqH9-(`@,|7ݾ|V3;88Qx(Tt}5}NC*.)@IoSXįb[%U$x6ܨ5'_}ʈ *8Q(⏴(+mݏ1- o(Ws}-8S5KxB IHR&RZ?:' 8iE8 i f}jS[Dp6`MN.zm'Xxzd1.Ԑ&czX7-_u&gk0ݷx}:rU {qD%G}a5{)#۰Ff5z[~Vy-Pao8IN%^)ģَMG?ڈKz%-g`L;NGB(ꄣDKO0v*r2fVЩKE$gY !!mshˑpGM|/pG'ܢY` EsL6G.> <˄9'C@R`b íK:|uTrt8%~:k2 CHC96M9XW?Sz9fm +vN 얭#,8}R7BV9y)yѭ/'/gHq@c-k '"H[0!Ȇ8vHW8@xQ G]odx'` ̟pPݫtO) m5i zޤOPx &y 9džVSd2Bb${@#.6"N5Lu+aIC 1C_?E"h'hJ51yVɨbነG,\~%3V#CAR$YםUr )LC]qِ"=M9Z؝?ã񸺕RW]Ǧ d܍%n<݃## *ijQrO忇{Fhj9K3VCڥ<"h"55xpx6njj^xhYApvC*>)ZM| ŖPAu|,]X ER`M֐\\+.}ɲjl2=ͳdG QL`yFw߿"FfL|7u0eB0~4hGJTOB'~u4nFڿ *o8{G~P6#=Qm4SX X#L%Cʟ׻^&#'9^~TQtqV-i$frk{ LOg<t_œ*R7 jJ S af= FiO [ _Ѧ fP(-Dug\ʚ& =cJXU>#i\< ׌?펔AK%~֊zCM]̮ƿ[$6P@$Qp˻xpI ZI'=̶BFe<"@鳜S0iXwlǯ<Έ04?窋/}q53>7 7zxo>._e֤mK{,{w:Rt<.R7QNj Yy'8G~pIc>"g'Ξ|fٙ .#gl@_ B˛ݓz(7,7 |̂w̽bTN~P_wt.f6.R:mqPaل w!)̫"?Huպ?W=7ZT +JA#{[xݦ{PuٔmN~wS/tush[s9[Z'qI:m1Βdw C[Y+VMg4Mz/jLn:!`%/'2Kebw\q#{ -/o2Ya@܏'90J RotR>|if`<*䳘"wzSKBS,[r{wN +F*3V:zRi[ya\+p&]@uD< %] fBlL[jLtH)f1PXB /ukW !GK; 6Ґ'^Kk&8vݩ׆٤4(?-Ѝ}"$pR(CHAFT:QZ&ޝPM#jU5"dgØ'Pyl"7n] <#"@p|'?g f*LbK*M5qkޑ0.TV{t)'<[z mP&bXޕ$H5_͡K OfhhdhRlMʱVȂWe 喴+w}Ll#;2ʃ.zMfw6T@] V=uӤO)MeqcK}|Dw~nQK/~p 8L 0!dI|*ͺzi}=qQm2@YjWp\z,ɨ_z"+eɀa=kH-/@x [w3[`  AMtDZӬ(hHu ,;Nf pnΘ6{Y2٧>1_ta2}Оf2IĂK7;)³]?D릩-[O v0[|z~Έ4m1f!."*?tVVpp^y< j߃޽Omi=^nxs%3&z)HKٹ|T<Y8nFGaQdu?iQxMC:ó?r fMJ2b*9>BBr x`sغ2\S.[:a'DZiV[y74r/N#*ݦKsq-éh&>4.g- <KAUD+@qGMD/{,w0Bd~2EM'8'͘Ր`10'`^Ҷ ۑ 0o?ʂ+`^OdhCךxK9cNZ5纭vGu}4Te%gD)[ ;e@oczl&yzXhh骓\#\ Q23iV 6>Z"jX! [iSQQpMluB2Gg#>&*(M䯏E¼X|kF_#w!gq5CC?0Dqۉ0c^HpNg& %#T3An'8!'ݳm֭C*~k88 g (iugŊV\G2@|FYչz?:Z>R]kƞsYBǕDDMc;HVD6|+VtH{km-#{S)le}8e- Z{ sROoO[P?=;ȚϽ02իB$f&Q=2P\@nd.!@@lj+xPW'(GtLv}[F+&jv':U`z]*ze"`5G^Fxa16LKb ,5!2 cFG.eyGx\Mݢ焐%ԫ_sS4W:r#򲿌BjHRu~#7U+5eW3 k#gxqXDx G _fHMBTEQ#tWouL | \aQ*}ϢMXt1Ldߐdf%*vQ-g8D뼐yFЍS=҆ɭƽ ]n6m_kmyÖfi)$L^f߂48qXD f7\Ȉ{R%_R!o>9B7O**yJ#гCmdly XE2m*$}Br=ׂ̇PǜώlW]ы Phz9? Љ}F>A$.Rf"f-p8،"-B|"}2JHRё9:Q1\\OK䂎t~t{GF#tcA]YVu/;,FLY5')~p,փ ,V{еOo6ż΅,.ǚ,njEF q0T;֦_;7+̂ t<ˀIyg4H8Hh2h҇0Dȃ \`vKS(tT%.BYfW%ts/sP{6 C&PEIP0||fTZ ; 7F$Md9w=Kۖkrj4h5"dc$Cwĥ-"ʆL;aՎXh61x9y» 5.OOI5*^ցc>uU"ŋ):՛:)?=DK{~mfKf$iϏm xG,W7JΜ LQ alcvjJ׳ɒArgR-.ө?w\gk2QpGPM4)\Md{?ےrhf4u/!Jޑn BJnKƿa kG^ҲΝ'Q4Ɨ~ϻs *#6,vm(dBF%)<ɩP~ȴ\RKEӯOs!1aDVI+e8  Ȍb`[F8{HIXnpZ( N"Fǩm;’(Ef8)2O8&uN,)!Ai b:PaJbftf-ܶIdl)!@On8^]Z20eeqw9Q8y<L>\kTɞ2tE>|g,z[$B,VXhc7 ȻHpkHp 3"9\u(\Ac80kށ.E:lrJʅ05b#Fʐ>*m5ޚSdOFZg9ƕߖO<@!g) ?NXP?VmkVt*L͑4/SZnR8Z $XRC_nr w,UP|F*+\7r@wh%Nr| <=8)*΃OT*ǡLHѿT+"[qYh!CйhQusvKaWDc]$o'HRmW5bD25I+MϿݮgBQplBQޘcH_t} jbK x mål @bLLi!n,(ڞyMR%xȾ]8t%22 2@ܚݛKJl}x%FH컌-&rlԵ{cH33xa*q!bTcVdY2-N'*Z,d2g8:Ɨs_!އ($P1T=hz\ ?uJЩ~PA j6A pl4ױ-bh}NetTE3"*|ܮ;L'nA62oj)(H\l;L:NnA@6&0B$/Ba_fHt>U,̙/ a[Ty?0%F<9h-HX71i Jda9x/9`z}pE?/`6+:y7Z Rk$V~Cȯx]2aԄ#NKHK*LԬ7;* YƂ>c;F/I׉8~ʭ+Z'rbEAqq) l΁8ܝJ:&NESp5jIj :vy3LV4L [RAj1˾GYEsI3%B>@P=犚(Vס|,58ڠׇ|/{B G0Nuk q RKϿA 9$-]:TSgXll7SĘKޝ;MZs%c-j$,*,$!!Ђ@ [ $^'G(;̶hu+XhŅ:wjV* ujIX˱Q1q~o >;WUI+ֳ{s*f./&qE}6 ~3Y?FZ9hHF=$]E#LyrBTvAG^ă|6z}!y)^0 >ĥONM~\e;Nt$,0k'iWx5ZoSX5ԊƖ~3_Z0`iP1޺hD2xTuq׻"0$T2@.5@_7 &Ndɑŀxӽ:5Mry'/Y"ԙ+M*y;qП -| IEt[}i)2txҌGN?%c%"[܇_$ۗAnFyD(= wvz*-OPN{Y} u+!fNRFspx6L#ZhcbTшW0xnS1\Nѓ=Nq<l@1W7kT]YcQ ѹ dHYlj\K#v=ҫwmKi|I)2d5dx\a#J@m)TcOl;b)oVELvhXXIvGI.h:rBqLPM˾yrrUܬWQfK,0)%F*l³=2YK X*_*2/ /Ƈt=Quq#z4IfN{u$yaz`1s"ڑ_%Efҳn&E.ɗHXyuESLEKbL Nd֤[1a;-l9eED,s?!*\NGijPk^dg:1u<? FRCmSyCp*%2OFz ]uWKQ+-Z#)X`k{!Zί>W'DŽœfKrl|*TvQ)LMGh@nFQc=ܑ5.R0ZvBnjdlNmqpg`M$PuoX=q=ǧ:[pl{#=K#?YFEz*6 m OjP!ϰ~yΧlNtGŒނk>p:6ѩ:Oi&XPfI#G{㈽?Hև늑y*i +Jᄔ4# ~'OV2}W!p07*IO^[u8W YAXҐ1Zi#x~-I[ъ4b,(jk*HS]<.}*G]CK%'[P2̞{k['G5);蛞IL[br$gTEL3fpD+d`ÚcCB?Ϳ}"*5$f☔i4~q3)yV7,sg֍3hBU{xd[[ך?MNw5D:V&ب!ݒc-D< ny#SE8DžACf`è-'[F%f[5ж1 Q≻ QMJtJ%5['wDR:y#LN<@߸\lr1&dɎ>y$:%dQzJ,+q a($v q*ݯ[޹8\&*rG":Cp,E Xp06^3Pg?h C磰F029H+;$;•mU^e,c[-9GЅm`?RiDn1=,7$%YJcR)P&t,Rn-cf 踜nY:vQkai|gF $+X -I{*=;Q…p »JO#HŤyf6@W>K:M803[gM f`2m)J(%#ЄWt"nNSbNF~e B`#bx/$r|E\^S2 ~ rQz!)KܳY9]n_{5#Y..C?:_Q#)OvafIGc4B:lDгpd 84{&Dm3BdY3=9mFC!MAQDz㺽5s?* D" ʛ#QeCjdxy QmҲÆ;<8{t:(YL'­ ϡ=$𿝀U׻rgXl5 r겟R[; UfJWi_M;FK1GAvg5qª!ق }Е"K!{<G#=ӴT2elJQZⵉDTMJ'cxDB0:B[6N/wKq Aq8Ah;[떛j oL0|RMD2%-q~‚5W;+j0v4 7] !t6NE)ײ{G=xv>߳ap,܉ <Ñv:Cc~׬eB9t-Fa)[NMV_ٙ|yz\&}>C1# gGvߪFr x5NjX@G)2, ]y' C53u.MFYj+{(]Z>:u tE\-|.'+0㭭V,jz!bMr/%{\.>d|ӖB&,,r*=4u챫/Va4тPp[Twh9ҝLr'bM+e i>0߹oEgxuqƚ=\/@tgT6,@2H=V̐$ C>*^16DJy]S,?jP1IuH\9Ǘ{@:^s w[3zk$:g*qC;:0P;9-vC'949\Hr|VxZhVx͆fֽEsmdZܖчʭX=5`YQFZA1i;mBI.O1 أP~5fk ܹ/&ݯK OOmQ: ЗyxE,`\B߳~=?zAHe=[" i&1wtTEjU:Ծ@FD(D> gy'_nL K/Q'NUb"#k8~}[J(2kZSA WHx~[m|j)&舘26e"ȏowOm?Iޝ2 o[tN=w43WvWqO;Zt -[7 6slE >t5+osJn)9[9}G`<˗cc0Jw8lMS`毆#L]~GO 52JmT'Qم\cӶr],!2i OR@R%7D>6="K x$Q'8̟c1]nm}&i>֛PcZ $gniܷwG}kZ/n3կN2޴}o@ ZdmUVV_فS܊FnHsl@q;Âtr]^DYr'0|Rnʵ$vsDTɌZ|;9R7sLfK E5Y14ǿY?<_Y '~h\|˻794֎ZP[b'ZNZ2nrɎܮ6лi rͥdg 6hC'1Fl/shPĶ*BXH;m#1u)$C.[sR-9YG^GELb_G()s1O2}[r7DUg uoo3o#m(]n,c $w!Pt:7A[2wP!>Ҧ񞛐BXMvۄFGIdSxl&-__8̷?1{5P^9lˀEp(Q]N"/( b+*BVat&(\K2HU} sOb.%#:RtuHnTJbBZ5THƸ; hLfamMG a @gVi3'nz6ϟ]U-%|K8~Xhu(7/!Rb}::&<p^;4IboRU)]AVsRvXv$\x |yłӦY FQ}Y;ثc‚K@|k-?π1s%$fV}~6 1ȼ ,|{1Ń<88sa+)P7,h:9ie[L8ϻ86IQr Kk0=z|,PUpS`2rO+t•LYMHy,g̻s5~"l"l͋KlPpA y(CX z| T$+_̓P^FM,.JܨL531mR.Z.x:v 9`'`%S*ېm$=q&4.iI@ dJ(o- hW?QNjxPy[ztƍ$PuqE.1FL=hB()7x۶$I1/Y+ qʛ,!C|Ǔo8{7&3Cc##,9Y8)ཟG# M6Ke;c .RZk&k0 OMĈ-:&BB=.wƠF[,lM:. i*KVLL=_^GWi Z/v ` yVTs$";ݮ$-{?̀N <-=EAhMZނ=,A)U;زZF7t< 9A*(jAzUeO(7hL`@I$_3p juO5z< KdPv;p1y/]j7-p@@"qxY8VA'a<*ܧPX[Zn~ib59{'.C=Yb]؞=/>Ҟ.E (\jy oLDk iwqZ&8Q|BB2 j~Mk[Ҡn1 lX Лm y: UX{i\џ/%8 R(GQ(_-+SB!Ê膳? 3U}v$N$ȹ75n1h-|@>Uapsoot-d |A L)rޖŽBPVŠUNZ:>_[n.)0xfj[n)пVpw@ٷ;?Y]G\Kģ;M% {K]-z& XV532Pɉ.n{L0m:{@s{NŽ™\FPU39D lXu SGhꊣ3)؊Lv]խg2*p%-)^K|>T\2f:S:L<7`JOT6d戟Sfƶ#} 9u&yYd%GO _ΘL˵^-"}{<{G߹&L]t]¶*,-5QBLl=M ͍,̮HVsSf9cuS -Y%=TFtß/i\>go)L븛cQi;^(W<*nDu>s@I<9n a%nKEzP旙zcZz* K. mefZ:d5 RIPKQNq,߿)bJ9'|tudP!()I=V=ApX\A⤍@SguWΏ!^s 5g":)V҆,B[bv5M7 HP&+EȜ^e$';q5"ޣHqC,n̎R`&cEW(gC䄊G\%ftA1WΈ@2͗PL0U\ڊG0m U )FڶϪ~ ZͰs_B[$)891d ynI|jTfR0oT{O?tc~ypɑW4A9W>mvA^㰎m2:M`\eXBr/2UQ~6o?զ?f7Ph{-n 1fA[(%gẔbL'3Ķdd}(x +CkRp+X#թD)<`8V;*L3d*ܨ1GeU,3S' :M(8)&u%Vp4*x*A/R!%3' $Q|ʄiƢ$?:Y<z׋vvGl-iPBfOTh#0?MWiL?sNv5ܴ)+P^}Xozlc=!CעK{TQ6?qRQ#위cC=]\:,OCt!A!F xd׈7o +5_d.iTRnmTgI 6 l!ѹѲg~y7^SWza;CPr86O~Tg= oh0s_c6 Tk²F2 {3몤_JSB&[5,,\L',בsPL4 lm7r"~"b\I>^r! F|rޭ\7K>GEj_KKtB`y.pu.|TɞS$5=kPM?YwpAGUEqݛˉ&6VsrBTyay#щDEmag,'kywXk;C[T !H=fNN=H #Inxbds'/Ozķ*7ݩK֊Dyܣ)TglV_q<05HT6vt]ꊘ;asԜSR~ӑX9:[RNY`"4LmANS2~ w{IV[Qc{H^;_H9 eCA"FT mjFޓǖԆ<'f~P%X{P0Kд{>`biZgbvePrT4;UGagKoEU!n=cX'?0޷+f~0?T@e{4b#l|N5pBL`t1x`%5?D zHFG+T%Cߞɞ3<1BOiUҋ&'aߝ&kr ~TldJN?1.;aHK=Rq_KꙜs( `ekZ(k 7"2=xVLqĊ 2@1F-ُ !C9>y|h=^\dsz гwr\7 k%eBj~}?~~kybf8TtCņAZ,S@;="FUAhCt>QaI:- 70e Av w_c(9J'5M7!Ex`:KigW.U+!Dg[H$ܮ['~]hؽ!\V=쒪f{>/jLu$_ގ=]p?O&^m+2Z-'yo}ܣ4蓢a.fFw#c^;NŰ]&kjH-/xJx&(uPRlQ\K(]] #{~B",}'rxIƏҶzS{l9hj@!L ]f7SULw[12pMWЦ?|XN?2p\B/bS #͌W];KWwl3vg޽}qA,@U+r@;b-.+EW;{|s.1GMoyMD@ ;n6 EB,=ŇĒ\YeA͵2pݺ^}y6oC& awڶlw.#kJx$I, 8j^ZVY,.y,K22cX[XsS-erEڎV9b}~Bv^91Uĉq۵8&.3>^5\ۅ } 7J]"C{0z<R'22{\QFY]O pkYG1Zع+y?x2Q"a-(%zV:hzb] eRDi| 3'^o]HyHǼ%j }lZ]AQ9{nL(dv_*ɳX(UA?Ϭx^ HZɜRU×aV{+Nٸ;I4Su0oCٴL>,g@m.؅%>5v J ~9 DF]W )[_|.ǝG_d:AeoX5 (sv^zNT*.C5Ec]wby8IX}>Kq$ )%E e%C Lʺ󙳹ɕO[bPPf? O-_;Sd;dXL= *֟givB |f+6CPO Vb0O +'uu!͆b:Kjԟnn7bϽtq7#h_b[qyz,cV$&o yf/5xKPY7,7O`Yf=/ЁB|n}|O+]{x8CV[fM8R.r+PVVzP$}RCԧ_o KwDs%`+FEZNd M=lIjn@qF3ڞH?%#ڼU( ˘j[#Z4r[id:n@.!5TD+y(`ny 5ZL8\cptWw׶ŃIrJ?wKޚx4BJznCc>^r/q8G(43-Q|˰dҙ OR!]1;d UB<z+"HbJ\W2^D/!OV0,>xs,1$`F#y:|+5-pVl8 /SsQE'P"dqAYK?%4B Y*5tZkye@) #ĺUE$:TJyPle&ö5 -%‚21$!IVJt6M..TX3BhA|F)̂ǎ9O6Ńϔ2>ob<}J[ &4nhFoXۜT>5VhApY s%5?iQJwsc.SNŭ)ZCek+aӵ:1[IQ٫ SYi}Eڊ??TI.)3ѫ#$],`c-`||5[ƂڧJq~P?>!":3XuSrKyGvfV ͙ao9y GLxK{o mo*lޞW0-O?lS(fJrҕɦZDܨ5Av~\ B˫ `۳ӂev TbxA;w&wp o$$S2ʦyF1` y/6?&s&1ͺC@N% 誡ٓI~p 1P"_a{@\D B~˂l ^Os_.jV_w#8Q2,#bÄbQ"[2St3^7YrFM VUZK.6O(0+5d'n翙ʂ ,zP۫k~V=w 7n^ DLp'I1OHj}_7XG)"Rރ hy+i_SӵQLGܛ!W%ġtʑSyÞ5Z6 :<#!J@rgKotlĿO_~JPBI>-kE05H=y=JX2 ]l()*N-TG_734 !!}=IP_e`J?k++'PcT5 BHWY^gv{[;/)] 5Ȭ­/S} S牢SrfII~Q=RyШvT+WJl@4d8ޑiK6ͮ'ju KC_OcLשC3^ZY ur<>g> 4twH ʃcJt)фv3l)ЀsBJyQցF& [='Fd[>c*RJws_ -ulc:2%(b9IgZE#X/E*K[cz̤D/'w# f" jネrVw;ʑ*SLt.;D!qX@ԮLJ- BE]Bcu C]Bka6$1.?$duyG{ۈq>l9Mgǣ/e+V: &񱛁xQu n+jN~$&󾂏zJY@mkzMv2[p᫋Ijosx5!(Ě[箶';&TEYZgKa(UD! c4k;CF]S=cyQ%P.3ȹ=wk>J)< >dHՙ6#m{o!|h Oavm%M{ MSGQ,#UoIvޡq =},-`"V(Vh}!2Y(nY3]gI!2s`upkwKڥ Vlw}H'8:$Wh/HGH4G!`ӗ.҃cf lgY(ux粖B&|Gv fF5('2dfԅ7T,A= 53ƖO]V1%v;7d<I9F^%mrA{َw5>\󸮨>t;dGA 굢q#4 ބn.g)C:@7ԥ4R@m.#W3z+ ?>Vv.+-S{Z!Q(1wӫPa( jlsLv"\JtrHtkpZDF33 ed!L> zMHt&hky#ĄRS w[4@9%X) fq#YJg&n괙]Y<<:t\;(DeĎHVI|׬ajw)b1 \kt}@RЫݺ#Pǫ(G!Г騕#my9\?s&y +LH#z=ǗF5~(HX*$LdFwM]PEA2o,69d= VVyzo=û&{fw'}o2=amUx]] b!Gvs=DӇ5Ž}rY>bʂE1 /} ܸWL;roʴ%H?m )aus+$LsŮ/,3NH%uV~WB>Łe׼($&:C%k5()_uM<4۵+!{Zjab  ~WSk@= 5cPJ޺3H|Z6{4;nS]yeUB{uEmf L0 RݠpϺJ/A!P'F~""IPQ+Jvuޫ'o-AR'@)6]צ$[`3"!4>"ZMЦԳO\GL-9yv\ieZ40us{Znb%CL'Y??Ր%.,0p_SHXfW&2ᠡe4ïX35ZV \B~pZ^T@.]cJR[]+1z5ߚ"ߓcI\UegV\]%1RW: |DwO2S66E[u&@yhy/3a]~uMsYOn )#å+8w ɵ1&W֣ջlBI8lRүC*5p@r" a"Qa I;TSh&{m:`Ue *;g/?m_(0 YZwaveslim/data/acvs.andel9.rda0000644000176200001440000012774014627073455015641 0ustar liggesusers7zXZi"6!X@쯣])TW"nRʟx8Og0܅>_U3{@!jkUT0ʁ\v~szHyk7#,@ιGc뼌_Pܸ@sȭ_}5vvdWU?ӭ#?*ln[KA]!xl0 iլyh@f-X/zуH0qR M|HSgWk{ҕ3[CˡW2qKt'uҍ.s(#58V@`&l^6LŁ(kmYt;"Ý)&OO cZrR"^q|!JQ*nY|*)~yAZ 2$zY}/4֦_AgՏͳH-CsJW j<9gO @<6xN1ŶH>VL.>4Ѽa!f;4K,=(+ ֪G[)#eRп^ >n%br쮾 JLR:e7XpmqzC4Iܕ`vղkyC[,;C=KE.~23Tzձv5S.sǽ3e ^03r,A<}d^%:+3hh*߁[D,i ]Hh $Мllקpefrޱ^!WJ!}dМ".,r319 L_\xքg+Ӊr,s M8 ~k`_fSaKMX9UL:N c^x7FV=Cths2X'6*aZKs4QˌX+6'ްү Pp 񖨠yJLQdΩ5 `w޶V9Mžb>i@}F?vyM,/ oe RBoGC!NLoS""5O w.`W9XB|7 ం-~d h1H:ޫ4Ҿtsoo8OY? U.RmwU >F5.⽪b񉽿?҅CZgj͗WȤy' %9UnH)R0 ~4&k]))h@ކ¦||Ldb!\5-/Veͩ-ȒjL#OdzIQrQZxpch+HaX63m'e=Q{0e#w |*xb8ŞLl'/8-/*CPRVr>ؙlaX _|Y%C QGc~Ƕ4IA 6]B7!$I'dCdC8 VhjҊ?>9B%)D\fԗ0CnQc$*6Hy/4gOn i^ a$7#?$#wlҮsg|NhxWv/kI}Lvy}Ԁa&HT7Bq0սཙdwO- v;./&m4W&+Ja}_6EOzHjRIjo|wW:ظ7:/a8c"LdbK)[YbЏ%½XZ%އ?̣hUԧ"©}6ɤS=rM7Dw ᵜ9@Zp O16=exsݟK%FɱȐÈ&,UckZN ԍ쎫Fyꦩ[C?'-SW΂;Y>kDQŒJL:5ie/_d-i3Iڿ!WJv_ HFWXX<8s` $j!kAhǠGw?ǭco)1i9O R*BH‹[xqȰ+WNoUӐ&*uJ(f&0${&3F%l^t6hS@4ƚnJ`WNzu%o|{/ĆuWdx'7p'G.3:5:ǗOӣ)R~ G0 e )񺯋Tū?$`h-!W`B`5 fYN 2lN҄oyHJSuG `ү4` }RWjroq3P'@MXR55 iE "⬓5~fykAI5DK-5Ի_+.sq!178//[Ќ&">d]L1vqn(*ykEծDa]Da\ 9^Y꒪)i'ڦXɚj4b˕+09ק֘Lgdlwq׃#cw]aLgyzj^[UYr4´X r`}UVzs{`IBZ9T +aL^y2""4A͒f0Ru H\o~dqepjP8yn6űS3`:{mޛOR:{ús|sĚ::;,IMT yTL@ݡOqל]WM8VWS毢`x3iހE&: oap"4k7A~ohu:_RfB@UO+)jp Hy'ǛouuGQS~)`sx|z@׎Tz]jAǥ4xt׏ʷ"eD\ޏEd`%yP\pꊈ+' /s[3Z<3` 'w3y{ `z.kO;CYfA(*sԮ`aGI >NXՃEq۪G9-uM}p&|cƗ$]ÀލoM!?IG2vgc_[MOn3>zq_g|dVDƌlHA*xvLn, 3,!"{RRYו(ŜHcfDfH͌a;O ݼ9֣yQ;/tz'R-W_>6I`*VxN504|POY2ƙs8j,BvUFΆj}V /(=`wM&*н/~ j/>0[g>K^ѶKGز3=1RZtkBYp< UI~q ~OP^Hd#|Ҕ0E1::-~c츤 G/ } H_zW+yx:tѩ.a[>fI/UZnJNI {Irt#Vy'C/6;sf&2_+"`4tPwhY^xoWIN≜|:wC6ԷZKGǩ*8WW= QМ-Z/猜:TDɢUMr G/dZIJtzhx^we=K%wD=s :J0t!J7ƚNtVa~lK.T-:,zX:mFҴ.W\"$L@`v&F~r$/q v]ǻlnLzCʔv5bͰPS?3U( T[Բ 9#c,eiͭį>$0Oǂ^|+![8+}1TNESl5O|mSd K5wURKVBThټ7$,E stYb`ěҝl.X ǁ̡t,m 57/LZ= lWu3` j4z>rh7 LV5-tD aʺ?8e=V‚h{iKTeb?2FXa':7Jkcl g2I?&Oq YUrj0# LR@]Xެ4_Awfd>77("6>m`Y>;r~]nf^ȓ'K~~C]%+KGf5qtk>*X7ńPhy$5I6*ZwEq/zZєτi8YOFGWF'W/=Hn&ZP#A+h(;+ٕd0{Zkca{fsG.sv_dJABxq\&ʔt %ӢԜ3T.( $svȰYo $q:3{i~x=Yfdn-G{2h jdx(zKFĂ#4g$nr>5Je'!nى] GAq<ޮhN/qf/(4anGft^o{ҺӤ;谦P0![b^ʲs:́*pO6^wՁ( bSmqg '}êV oqUD*EƅΝ8cԸ鑯˷uX0}tfp 2JuE"iYv[an`ʅ!gH,f|?B?ې).̳8i4ۋxO'aqC` |?}uCL[tʐ; j@@LNG}ƨI:X9OVדF}3_K]|3r ѻ5%O1{w buY'`{*eBS!@U|tğRZr<1? Qm;uHȗC9o[v(hޅkrՕDu(/TSaŷ=;X_(YuHJ%TڵzU-XAZ ]#֯G+jG2KZ+F]q*?M%&}t&\O3Q^1x(*g`GC zŀ#"$}ݾ ŝ+SaLNG;-8KғBJL5!<"Ez*ZV`yIԪx@bnlZܤii%++|s݀ Ql%]h!n ڏJh$_`Wh8Jݲf`Ŭ}_迼wVپ{W̿*Hv -`^e܈˕4j '5dֽ csS0XHOx43=:2b5~p4B``IUoQ}2_ @t,($BD''e߄a4+4h F`+JQqlĈv |џ-a\RV4> TG\1moZeY̏hp]PʩB>ǫ91גK~LĈ!Ípj\o˳⒚YmHmbWIe z4a*`FoR-pj9/k 62! _bznwm<@}zym.1CXZH#Ee9c*ErB*s-1. Tu}o"ۛonݿ?3ibe|*>Kc͜/EFlH)%ΣT>gXU#9I<>&1F▬{wfaEx;Q3ތPK#M2/+g>E:NZp2вh"> a š\2FvDŽ((y쇅6g ▱ AWx~Z4*:ecvNF ҸmM p6HcL+1RsVo9, ޟ/IٵdEC峡VPti Ftp !e!@Eu5Kߣ Y Rv%=x`W+We|J'ux,Qao|)r;ѴEwa&51bk=4KH|-@n$F؉=Qah@aa9$|_٩W#"rة^qn1 ~ck|d*Q/tH2Ynڔڵ{W{ehv8SV(`54Cnɱ׶ڗEmek}ZѣztC^E)6l;CE"'kΩlYX!]g o@ǡpo< .шbfb\#3Wn䔶o=$I~{Θk|,N{ǟʶzuApPErh*Q!ր6!54*KL|ۻ]=zе-,5X!ƖR V}> &K9_i5uVb:HٲؚKn>Lskw@5&@rO<1VNt+7ݨϮ 3xI-]XVW/`{E i~˯Dc;F>ۻ»yy`+'R()bO!EX†OSACv̧42EP„T _4`PG8ҚG ( (/͌ }5:+i`a;k=I GƎs&V9CnWE 9A5mlJؘJ?CCSF_gKW?+/Wka~VADV-u]+kCrę],e;X_YcrҞ_(oZ3cBGmr/]lһISq?eBلIΓ<Z*<ܿI8{XZNdF'a|ӮQ*~0xZ_-/gE\5M[C M^+J6^?,'dv?t%Bt S(XNY:13qOŦIQ^,)ɨ|A$`u| |b6m=4!/6M4&gaLI*Y\H1*`k\w8? &(`Qp{Z1U@x+uBͫv+IUF8;]5e>$3] o>un@4\ a~T,ˁC*}~ NmbǰZ \1V?WiABT/k"t#j@ahj`>BG԰?|᱑_I{ 5TRy 4(OUc5nD?-᪞ -W`*b=(S-@mdVMwBWhGr ~ Z3͘1/7kC ;uCw*^r Gm]EI 3Yh랔 b=s{{!T\l)LJrՄ-#5ˢ% zS#V,òf6"q;| V٩X!Z+|mO#I|d(N'/2Jjۢ`$u>t|y{%NiyV @ Ia'Q^ 6PsyջߎE:A)2NTbx5CI6V[w %g|jK^ӢAl8Vu]?kmnkpa[**ihNld+-޽.[R€H4i0_V9?۔ ~|\G[6^.UQadV{@p6_׳]p =~,EeSzwkymG{V/z+?%-m䮾h.ɆZ˲C@HR \%LZ1-t} RHĦ7j/kͅTSF'z/-95uy}b9ӕ?XGů[7 g'>~NxIpl\fs lA05dz%MWq(]WT1ls3o>0Ժ_ב{ ^Cġx|h2HVz"$ sX0V.xJIdq0ߜUܰOgTYrq\=inHKpxN=Cϒ^xCW5C. E =yy2xO{rc Etw_iIV@,&#j .I(9DUUcEk8qD>IJd9XߊnC@j "ԀYҳwm~ lQV>4f?|JѮv>aQXԲ7AazF<"1'攺xjKL$1i ޷hvH3.3:|a esyOx7!vP *6-F2AIo Y|?޾~y^yغ K͊埒3 Tsv5}! 0 ]NZOx +Lf4g}"BOp{#ycS!(yYA($" `XS?,ςvx~ze/R4ZV LghUmc6\[ 1ŏMVyE*j~-q^mM`c m7Zh&-^xli~׊>'^&IK~X J>0 CDg -wP ZAI{xn&}4`prMMo$EN_eTfpQc@%Ўo?Pp3wjdl_esf$ m7 7ȟӗ_%Kd׌0J~SNH3:Gtl\rIiͱn6tI^ k 1/I#/{)m ΕXH a4:W^0_jo1$؃]o56z][;`N5pn@0nٷv[b8A q-?(CC4*M- .*kk(bZdC}Nm.nZFg*WoMdίt n/zs3*'^{b?M9bQ(KG'E tB16LWJԩpUͤ*nA;OQpK1(spÚ6ZՃ2[IA:b 4v bu R*j 5=o5PZPtN;ru Zj'ЛBE$]]&lڬkhy+ dE}o ^Vőwy~~VݍްƒL3_v5S?C9_nSne(㇔CB]yViVfҁ%&QfBB-QAͅoHz]-U;_7'hUXt ֦-[I Axzaf W5(rM6LP`msB1mu|W%nqY/1M@%g,ͪ8I,"` y[04448O9G68YT:f!;R=mN Q4CDknmżH'Tu7}D^4!P𘞼#B1P_A`qm}R 5H=g| !b$c 䮝n`u KZؘ>I[ǁEָ*btO1a#!d%(TI4|LruIF c\=wt !Ү @ TMW;m[')l{P!/ זf=8ѫ8 MGbYğ>Sw-; ^f@SD1-cꔵu}YZb ! o!\ ~8VBzUq)}czۼÑC=v>h3g)qzuPiĹ: Z_U6x@$0 OHoKYc9*O8bƂ#rwh QzIB*0\~j/-P7|3-@Z_tܑyJppO23 >D> 0qI (XE'Ëu3N`ܤaf,/xNYխ-%l4BV(;he=P+7f5gdUL^?Q}5[b` J a[A|I;D3V̂ƺWSv[q1n=oAZki: aN*Qc\ZP_ 1eQ4]9!ҽ='A 37H|76}ڤXrbu(rWzH Uҷ! iw[uł0[bqݤOJ*5^4>qmyY'dڂT& #j}ܺE48nL}jP3??[㻡@bs?PC|W%=bŘe*6o ?%)l|CheQf KM kc`A!W*Ĝ^~Y^OoFG%ݩ((hb:<_-#XegvYenzODgT 2hTV͒Lg B2˳y-rUWcU)5eovm1}zKr !lh*Sr_eES[*o8EFdS_/Dc/6nSz5gܢZ`yOLdILqLfa9%ڼSϒ)o<#PX $}r ;.odot&aALc$0q_8p`,p PsTEF+'G[=h7.Z X d<">WW#3?sgh.h˭D}'}T=ϓ|~/#hɬQ 8:@^FD7tփoAQ/JT+DzR`ēż$y&Zwa&;(=R_D`k>jF bJ"hl/ {V5o(LVˁ{=80ҿ ;R v+~|ĻHC"nb#sXH)AzErq}v" [u>Eiw/p4IS"4vW4X^ܪ/q]־oykd儊+Ib4AYY|Glt^|qܳ'6]ǒfI3^Ld!|[H`V%?*@K}Цp)An9PeIOr䊊^HOutTq4 |} N yr" - ͵>/ ; N]:$8ͤ"_!Ari ABu8pQ7sV(O ֎$gj>o3ZAU+d]lz4\tj>J -q G- >{t z_Iz=֍{zH!4l~r9Ɲ3d_:}Wqp) )B+-fzCWBA8!8x >ұ[HtFK/ʚڮ@>1/qbHE@cB-\.d̏L|Hȏg 9=D=9UZADghHZBSxKQp !h`:6u1n| 8fo Nj|AxkiuM?v;n3O-5^W'i҃(yC&U=gw:oTE{dIf2bx jBF:J;[g$E`9'|݉F8@ :ay?n)UCJtюsO Fo4'hDuۘs(+ENF:C0&T0u5fѣ2q4 ԩF$.?bG8뱍iʎ2amޕJ0b ;}U|+PF|(;b|'.(VT͏Rna,f-̚`j-Q5ѐ ɧrG;kƞd.Hae<.;V(Ar##?vY`69 w9 3 t:s1ie_N?Xfy2A˦0*Tʖ I/7C a[,[=ݟ쇄r& :.r"1ry/YKrΠR0M\8rUc_7 {SŖ,@;Kn? =b攛5/xʺB:?lǼ; 4+5p'Vt>FQ(:,3ovc|1h :^Ux@wR꾆5$B{@iy, >I0bԥZ 8;XFez#jpCS^}^g.5FƩR wKgW q)Ӣ~(Hԛ*߃A\?5B™EuvWlL(k mo$?tퟵxvgBIĐ%Kju-:JfOܗ%`&ͣ)Yj8Ef}Ttlvh;&A7".uZ29 k%DxE;/&EAO qcDTqh+TH{"}/ GyTĂ-gx?1 Z"0sI`wsM)B$yyAIV<5v( ZC88l GJQS6@V; ѹ9 C]y^ptL}Β;d;-Ӥ>c`|UD\-,Khrى"R#LX"dSv+0}pt SvoV H:5 h\4nhw@--7f ԇ5=}d.__:W򱂻5Y:m h =p!R)Xrz;m;rXAq6fӧͺT{jOP4QQʠ{5n&1V _#,׹ڹ<&&@e/(f/'^*gŘ](u"``r9+{E JANgXZrz,̷IKQ|tbĎNN9LGhe;׵DiE*V>TD5 &ڷ WFečH+?Mr{6p)u\Զ}>#>AlfPwzMM\.;6!D ,q.՟:;k6Xڵ8(>,V&5o;Q>_D_Zgޒ!ͽ'@R=ox,uߑ< LCmphB-݉d{(!PA=l%Jד5(6C}Bq^ CC# fl^bYg5wf1*_/a)tìJ4ͅ{3<'e:6K9S dp0w= ^>'lmkNH\ŸxT>v#^0(/(etkKW3 Ƽ~aG%14ڙjH a ]< V 0.g}(bqfQyU9X  [p~\- 3Gυ}U+DuRn(Oŕl 8@9G,-*rNƢI2-z#?#! ].yPǞaSUk]lEIET"Xx- ])TܸYYU" !L_;/t~~{.,IS%[Jl8Й: sb@C`ŃϛⲻG_UZߔGm/.p^73L<~TX7VjїoP{4*~9;fN0Nf+z U!P*Ád8n䲢 hYU[U{\BQA0 Q QԪF4z;k60Vvq洐Z&72+{Su8~: K08a+LTy IXe wŨ9O`Gm".::p>ǵ˕U[30T')eN;QC({iY$h\rB61jn6OݪM)cK{mZ)bCT;~3a*C\Ĺ!90ivh$Iy;`Ȯ)}5M yҌVhڃ*~Kv5VMQ+\g>Loތۋ9&}>"*6ϟ.İ,;jyA¼k^?5u B#ӳPȕ#C&tvr'Gj%Zf@@6^p*+FЗ.|79\|{BtTyLoFj V~Ejڴ5d$e8 ~"~+Dz ZV޸]=˾ؾ`IJhiJҎa;ZwaQfͲm;X`ސ#^i D2QId> Y@U3QTX۵dOQq d-z," a8] G+Mv|)&lw<`\y*&jd0Ď@B-4(DYD2fzyD@|_&b[QbĊp&ڕi#{E+Qsyϵ*9Ǔ'`+1L!}"U7As0޶ЪLoCA#_flz 0Wl oP7[ Y(3(a-[Zڬ+-dt_=]=f"#Vw؊'ғHmJw6ue.a)li"Ñy$cۓkZI!C39;Bz![5ECZ DY zN|z4|N3zIpoVu])//JcEƞ[׎Rz ?6BܒUnI#[N` _29 IEP/nѫɹ+} fF4;g(Kԑ ieǥtQA]ʼvNO)xkEuy}+75~Ö:w9=#)"BYRԭ(T[o DDhƲDֽ*hm$"/w(_)Ҍ''Ӳe֭ɺ^ U FyjlaTǮ 1d/ .g awϥ]| Ҍ%Q_i2b2iHMxNoza¨u"I!cSVS;T@ mז7QSC$#c:r޲iIPfbPjZl9Yh|;qlqg|W{gVܩ` Sj!,u5BcIdH{w:#w1acyR2=A ΢eN'ALp^Έ:5Af礆ͻݭ FA['%Ў _Z$H}=Q%v6" ?}@\"Fğ5 ;$Z fNu$OI.`C_bQ/;_ثs%ʑolavjnQ):^8QG0~{ȽpaG;sgʳiX'=9*o=2} j}^E@?\Bq {`d&q+5Zߟ SZӺ|S?*^J)O3 TtV&Mi&H!]`!g~Mǥhr֥S0/䦼:+(EQ؎ԡϳU(Zz*NN]ZǡFեE1 SWm:I |NzݿUc}o6.U>Px ))y=l'N ,}23\(9>.@6]T_$)WjJnۥpB 6oVR'-F3ޑĜ J# %ٗ]9P m‡O+X3EL4vFf75#$t+ZRx/OW<-uμqΕWcN4'K:xpMZ+cOsߜh(zdcn[@k~W!,Cy7ɤۗM N.B2;KNMlz~XF'1itf5[UW7lI1b81& 0]5iOBR\Jb5g?;8-W8=DcFs;4 0kqSYѥD`xPw8MWVG}khiO=6n:>`DU|`W듀F/aӒ%cu/o E7Csm㗵ߪa`? O*]\1qiZhz欙Sh].g&+=_U2B$A]"NHbιRc,@ ?+'h^/v4)mnՔ1JZu1_vLNl`jTxE?&J*pTT)VjUJ߷s)9a*NNe{b9-#gd ls/6s0~]oG ϲS'~I29 @`hDޏ.pE_~:n %7!M$:4HN9OLCG؛Z3 Ahk; J2SE+Rw- VHuϸ5s`/dN2fY <7iD/:L;#h'h`NT;K +ARE@K0Iu'(超&JIFK d-z!*LukYݐA09㳳 &mg.Iέy!t{&xŪ (E>0 rsJ #{O!ǫSTC%tyRUM uo4:ٜ$^M%E U8V14o-š)(X?(U9S,CW˥3f%Qg]QZ`ҿHA/L XY6]6jǾ;y ܧ\2tm~FjMΎfkr6P}!XɾOyTlH:(.4H=O2Lzx[o&kboԎg@yݱ-mms2+7bN^D.XYw|ߗ8 pO}ap޳@!~7@KHnC'%rxfq}'ȇE~̣0vo,`YefތL #PЃ"@6c<$ C^dgfXfE83Ё?rx%cQʦ9i/0P-q}p"R '6 '9 ƫ %45' 6|?p[v:Qʵp(|nB8ZWE)싅ؾo|zj6Bhy/.?Ƀ` T'`t=otbid'q/%`]y]խoq&V_'>jSJ&ׅ;';Og3H!FT>)|ՐTLTIk:CBlV9E+6'WX3B<L7]_ zQè<_";iz_[H2!$t !Wy.4\^KU;ScXg^e-+r(t~!_de9QU66mj"nYY*`*E }jT\HRmxZϭV7ֽUXwûsK]ŴcKwKpWi*>qw{e -yfEfHixrJGU܎ȒRm懩D$' R 4S-V5ːei&?8fFXE(Tmp~8ٵ0^}%$Q(DOJ;>ߏWĉeS9/E1Jieȡ7ͮ+8o>$0YyYVH B  `oTdE7(&a3ÄW?o02n":a-J:2 )8FV:Et%C:niOqHZ'0GFXo]GcEeR swI;ӳsi΢v(bFS`wX}ԶSR7v QVLA4,agz5DPpK)E{OE3?0ZUEn,X[fɤP( V=FcX]JloH}*թؓ$< -;:CruIժn~~| 0Lt /?H/10)sKFG81R }bc,{`{}jo?5%Ld(g?[ogeFmmhrKu` |'ɒ$֒1YnkPjE(򏻡Ӛ`ݾ/.{Ml4RE_0REielmʢ5RG ( 7">gS̴L|e\]1Yu,(x/Ww 9*5 sג($$\mݭԦW܄{2ASagĿ#lrd?>zTūw@V6QK/Buћxa w{E呮hܑd㪘 Z Pĥ8La *} ,N</0 !h8`nɊL&rՖL<>#Hh|laY#WTΈ;rߙ TRKeޗ@S*7aQ/ޢre$ :} ?c{r^kl)%Wxǵ6:RԚ!\iWW{B !K,,Sˍ[ꎦjtjŁ0t( +T$[}v7(*X;QthƳߔsA!)eV@,=MQbY^p^שR u#V{β,?'u(7CfE6+A.0e:;~ÆFO-Z)wuc+`hC,'0}ڌnF7Y!uC6ᢚZ!ߑ[64P}r_aA&:DI D GZP1=]4=0O<gf]{;xIS%H(o;d4z# X^@4ޮ%u6!`BytJ9 ^1 sG㽑ɭG1qen"WMco\|CE1&`\ۀˍn!293؍DYW`+oČI55( ])ڔ2FW9uhq=zK-Y>D<|W%"_ f 8u7t3fN-}dO~n (>ihB,CdpEPC ,ɞat^@nj|3'AA%zꊖSE4Z^ KS6+Ի< h Q9@X8H|%)y wB)߭dheYӝnyeC”Ŧ=ю0'*d^xlb NŨJIX;萚j?`x,2Zʄ>(- KiߟXh[||>"|E汙>/$uMs-v[ߛpYa ,m<*+ƚo2Նc74-\+8Op |F5DeBqZ65eb I2i#-hJI*& 8=uqY HJh b+ye ;cXˀeh}|,l Ճ! /قB yTd"8)3375϶v %7.{RYw@*Tց>[԰Gm8f`xy]eA-^2Wŝ/x~Ne3]YϽ&.ߒF vڽ"3˻yA}߷ܣ/z%z_WEh~l;5~=ƣ| YWN߲lh YC1G,eFX&dIx ĥiKU_^3Z5@6ګ;y :obJp4/yRM,.Y, P bF'3{䫽 qNρ3 "u\ʶ Uyϯ _+W3w[S |Ey'7Ķ0c\njCnXMM\H=Ck)մ؁vOq]Alz ܹE\:gljzN7c)rgYTH{3oR1ZF*^h/[)FDJBّ;J؅zᖵ3!9Vz؁)0[T&4b+D5˳e"139=+)F2|Y(U焎 (mR5_|Xdg=yѮm7z9ҙn&4k KTZ-bXFΉKgB/xTd>-lN*ZuԒ2Nyލ!+%T>3VS*W:͞z?)u~ҞyJRR$4e κQovK{HZיnk"P! i1#0T/W.,AZ%E"6ʢm {Չ3æsZކW08@i.@3b(urqh=v73״A\q\FUn8 2wt\Fuz|L!ƞ'/E(*kʼnyc}ߨu8c]p) 65j0-8"d?fM9C8(II>U!9 aUܫص|}!nv,iCf_G+qХ&1Sb(zkK:ZlfxOX-M?J%fIq^?^❥Xs/r8~OWO0K ro*ܒ1Ьc+d67Sv]'T\ }|sl;k ]rhgOh.UD낮ٶkV䟗nj8D T`bɲo`;y7(6TZ4Ĥ x mb}DOy|T3n{Qpm ] L0-:Q%p9`7Byf_;\p}+o2'=Jn@%[~NP+)>J5.C\Ԗh==mZ.z]yi<" e!p}NdQX[uOP2! {aMonhq\pKX_dTS4.{rIA=ж?!*S~ig?T4pu]#B8KlF!SKA f=銸ﲺwUJɡ+aX6{@pڈpå$~sT~Ck\,+왢ZuGhZ5ȾLδF ;Ɔ402у ɺbZșttS_^4K4T<@ G*sbw1$ y ,Ф ZXvݐЉ?O-_W@0XT )_2 {"DvC&?_dZ4QL=羑*ٞb.p[=mwxOgtf#P.Ԇ=駱{gA(U^Xo-6fo>q4-[Jԣr1BҵmǺ΍uTǧ:1LLIQ+8a׳"n<M I7"3Fr!.!**37H \í> 5tUQ"Q +i脬 (Xs%fq W)U.8I0(+]1l*v֥Qo#Fa\ZuJ a9}Ȳg}i1v1ۿqy)߆gifN< 'Nk³slbr̰(.db }@@}o@Ca &asM*ZX@PP u\"iVgE3O.`=yģ4f1FY#RҨǦh*^jNY09ڗe ,q-tA)2hfe-L9Xx9n_.ʂqu@2&_Gn; N *P?` SxPbelЗ4]@}mP6:6CtEP>6 5@؂3sc@*'w~)o|f>.݄[Cۦ;fP[ tkgB4.mg9K @'BQyq+ C<݊-ye|CNViH.1G&ۇ*((K?,A{F06jeh>Z4d}5Y)<} bUT[1^1} =/ďY;=3STjJ) Rmbj9N|5@c߉%&n=+!~44MG,7Wb,(t#2%|GO/ gV} 6ÞqB@9AADf" vO>Rݵ_nU Ax\>~gLw|:x-!.Y+ByMj\l b&AqOѼVܙ挅UpxJޖ=*~' ?\ &wquZL+G9&;k" X!ⳬqIXk$z:˧Ax`ʂ7Sy BH9~R+pQE5Һ^<D0^QH1̫@[yG!Vk>/(rplleC~w&?lQkG#yHCc`뤪2Ηs  z*p+Wܻ#S5Ke[[v֘\i <3Vw:׃zDl R-TŢ1prq8*Hի=@`jl6ǵNGRnJ Iկ.iAoQ9bD0&$&WVdj/*մPL{u]/YK0wAe?U4?%LB.4 ǴD^QUTw3LN}vn0{C)?{c'{mvkr.N|J։yv:ݰ5aTI3o18]gmΣ~ՖvY;!*M"s`%*rg9 <ћHoW5baxUqjf3ך c)^9NS^25z># mNj&HTn\m ;2__SzF:e.S?߭iHOC=?AH0#ӭ R[Anp+ L#57Oo#@,(I KEujiڴ.,M+`B\ņ˩HkMkum&ԧ]k i'XQS:dF>԰YFV3$R*I?d [l*nInrpnEg͉08V9Up(@Z!08Z8Cq߶;SJ!3q⨝FYf.Q Z+XT~Z?2!{Ч>|+Fp9:6p|fCW2ltɈխ~Omf[dP]⍺#$OC@~ɯ8T+GiRdmm,Z-^m5ZUwt*zܘ90/]dXrhH>ϼ%1a~ݯ Hc +QA)+|qz0*;8_㯆 J4H*O #A΃Ha @9y~)p!,2tQ50rGdu"DE$#?IZe}UPA[0+-ˆal2f2+x l:8|O* F==!xRu7Q.>|I83 טz=\YEbelB V;YfI{p73Vqrk|ܛZtJυxcEBWuCZ>uF:\T)[ 0O94$d::uʎ&Ֆ5%auf1Xvbe!rz1D6alܮ%dCe^ ^gq1o=ut({ouZ@X`G\ZS''Ȑ8j]&Z.zh#ݑ(7_*!0[K->e M,vxUtXoq*> ~<~S2|je `ŝ|=;حs!9U`ݤ~.1/4RWN7wIGWA<Ъiys?; AdmjԈr+kK÷ôzkv&0YHNJgCփv=p9XEa.ʻc|R` f"TmȻBL YfBG"NpF*p~Jis7֦ OL#NnSrDy 7(՟prwZ ! wd ˶1pQ!4ERi2'fN j,,By(J7LͰ\bЧ_¾x9U4$ 1+$-2zw/!9E"Ȧ l۵jp#s[j2%q*}ܦȋ(4tA/d5}Sjitl3=)ws7#\_,& u˽=9JGUt@mD6I&q d{գo$^ͻ"n7myIX^s48C.מ(&z2_2kN؁3C{恞Z# 3 .$j4&: .Z}=˥zw= 9%C :z WtvmosyPeTOCRZ #eٲIq#3z\,}eFan#d D=nl JbvO31;&Xb {I =Z5;DY_51"s!`q9=)tƗ0\n%85'(@LO"^*Vټ4}hI2χsBN_ 7ÎdGP" ݜ Y*jo 7ZSpϬV/d'vD.wz]t% |<}aז)iN!wYNI:mz glŭUb'':-ܪ~k+SD '''Ѕ:9uT 38/V3_0,rkn>8n=;)}+uB~|WM]@ pcٵgn_Ww79#l$;3Zs^_֭wёBo>nzDh0TZ<i,Kfēa?'۬bR1fK%B)A|~=$yb6U{2GS!e:"chKZ~ɛ(w}l>d]1Jy2w!uSZ|&nq U;XuQG.Tm[4n)Oe0Y0> s{z:4-Kb GhJ^yWf\/ƀ0l˯揦؝dI8/dee͈$1|B9E_PMYPZ910^ n:Y{۹~0.T51{`̱U$R9mktޓ6h,h,]}5Ʃ%,S{Fl-Ajv ue-7'w8Nab.PnNP*lڽCV9I׀E9;n@|mE" dAwc/Di: B58x'oYlhD5X+@ش2ld7dt!l+n= r"zBѤZ\ fdˉF~SgtD '1;l`7eatrFf0u΂|bWΆ Y9GMK(z)p04j|ַ |ů5'_'_nx \ @Ekʓ`0Z;*42dyV=1=˓Qطca?~  \'yW {tq4`*Ű{F&MIlbtSQ!!qI"_%;\Hܮ- O01['Su< B|:YA!P*{\RY\ҁx?zK( r+KY^se'Vgd/)2egQջ$\>S O}( 9 NRܯy3uٔ"b4JTc&D2gba灁g)*La< " -lã#Ag%z.jЄg&[N-3A@T( 4*o~d3N.+߶@ߊ>5RFIF q؄d*{2_z1+ 82'µ'l( eR|'Us?iCq_ ]V`8ƊDQbG}/}4)L^5qzwV0s,](rϻn [O9\fAo}Š@ Wxط#jNvEp۶d"/uI۽Q`1=hi $ò)v,p'j>(zZ> DHG\G;0%Bh'zvG7Ǯ{%,-ڏX3eR(ɿ*{mcP .< &bV4mf=YwJ/#NT0F2dE*W* 1(DZ&W"SB*fYDl>u HՅ_fgf~ x#ɱIۗTo)?_Y̩Ug=KDKRnP(ʥ9=p,|L^Sl6͈;R/|NTgH}BEw讶~ce\8ESpLB4dS ~dkGy]ִx T),C7]zXuAOk%XD8~.ŋ[mw#w_FK*y_cKU& VKors[%Fv%b)K}IX2!ԵU">8&J#"iՔQù4D{b2zL%Z,BoK+QsyGH~p"y%a/ʬgT)ד6&,L[ox/uz43ތJSCmmZFǂuX?x.#sCy`љ$?DbL0M}PC +7ٛE'^txR?nFOAG 9R-jw͂/z0.3!C_8Uzqhh=%MW>F ˧6ʞZj5hGT61PO(hW;TLB 0ɾJ_xѭ[ĮMc:hտFVbb+GU—%$B.u=(N~]6i]ѩS̶MlSt; Tc:sʾskU-Y ['\HJ^C,֦ 08;VqV'yTu~a6YD:\ s37*mQI'¦^A4i),o;vu~ {Əl(2^Ȓ}B8),s0jeELBn{c&)e+v 0>NM7'׿mtqSiGq~)U s£ o}RZL1=bDt L~ű VhvUR-(ᕱ$ |F@%a5*- V+9UqONs8)obPq=J!$HS7Ngtw%-6>'0TU"hY,dtj,y"?2C2 }SUc:fwΕ~lo3&3UpfJqwE_4r8֧v'%~lmFF ")n>T7: :< s/jA U^xŠ8@C?Z"68%;(/=l1XP-3P)3n etYacJB^#h%} ֟Y3tj(~p,F )H÷|9N2n,^ =?LA%xlr˹N Gä K_f|_aO_VZn1.cBS~XVL /c֠&j]?xWByA^6j'U6P CM C:f,&V:o-/JZh{v:!|u)RP#ݟXÅۡ4IjǍuƃʇ^:bh"oFJJ228\|"=0:O+`km Rl@w} QfrAgiW8Au/J'I3,0$&΅qù!.\RaEU^13 (Q0'lVR4l__#_$ FIc : V>ɫuNDD+![ꞽ%^& JK-duʖ<*zjҔG0@e&|tlZl8 N/%~_J.+wsKwvPdؤ/T!WxȓLXMC }N[2{ ݯ˰p9( yήz= >J0frcPuT ==M{,4+Pl;kWbCeWn}Pajt%"Ĥ;CJ/='CfߎFPrY ͎:1S޲\N8M@2gGꗍ^\VBC, sc} os^yq𹞫tYʏ+\0Ƒ ZqMo Iz:ˉL)D qS`%jԏwjT׼O ܶibڄdHzuV-{e,|cxk9[bAҔg-huC;yTuq'R>q-a:j"#ntsTBK;6ށ-uHuCv(#쓆\Ȑ$L3I((#uɐ5 L߁7uqu,xt "Ŋ%ꦦ +//W:;O~zJD>Y 6t-5!-{:"5Xg $QYK\$| 6$ ׭Ǯ4hsiTzu8 5zJT+ލu=-fx+H>'a;b+-YsZ@5e[>?%z9Vj2 i!+::8:e }vQiRiF*b/sО$'bNߵ%IF\nYFìJV6Yeqķ ^XϪ!&.al9{f3yqIN7is\ eP黄GtfmbF4\րujUQ喇OT7c_P'P Q>8nF|h_ І*" fW]%{r=f˺939SM<4MRĭ$.mґdAxt:XK}U7Ŗ`{o%8#y7egٚyEcxCV_DYzXL;:.:jIZUߎ QqDȚWzyev+ܨw( f]iI3mWuFbxGpn d,0;8re)4j5 6N˒D=6c᫬+/RBT{o Hld_rh_RDD^>Zք{u5ﵱoϴhqy:Fd)pvl 9NnHݧ#qPv،xct  wJqO=aۭ *$4P8aʹ eZ{p0 YZwaveslim/data/tourism.rda0000644000176200001440000000113014627073455015214 0ustar liggesusersmKSqBADxcFyTt..D+]<%d2Yiv4+b Nqks !uDxMљo<]8]v8,W! & I6? %l"t~ޡ]B7CC&2/΀`.*ֺuGPið5ιJ븾NS+ox6q]}b6 wrNةZ6s{l?w6򼭟g缃 U|wm\Ͼv8?s} y5k[ x=<ԡaE8sC.3^OvQ,>z/0_0peb ca) _O)+E{1NatÅ>w #ߑ p΅`s<0wc}A~%pLFb}9?`=0m#/~P_S!]a}JUeϝ@_'>!+s e]SM2߁ h}tڅJM3?ط$%=y_Ĕwaveslim/data/heavisine.rda0000644000176200001440000000432414627073455015475 0ustar liggesusersXiPTWnhffn@" + )ш3)-B%(a :=Q n,"lsLϡz9?,sU,Sd2]\OW+d:2=8$xШЈ`Ln~ KCҳYVYսrYԷ.Yɬim*' Qޜ^g_YeZLb,~4밨Z7 vtNdo>\u;lihH_zll[f}m[Uʜ}vl,;7 9挑}eQ ʹMe&SU9u= [׍˕=uY\˸ޢN˂0t#i 2tэ@U9j77 pɺ9l]pisM 7*oĒnc`n\T?QWL>{+>M ɟRMj`z_—ſpӃ 4qmS<۞MjnK稸CvBCO'7JH͏sܼ_UGLJELC\9 We6\>pɀQ \yš\y?҅+_޺ߟ+m q`qOi,=<:^~~G #<%|oŸ ~/$~o@ ~HO/$J%=IB!?o?#J%?c^~x#> _`?د!x O  ? `Ck`ƃe2*ghFX^>}2Za6X-wYVE`01 ?Ӣm@` fr{"|@m]-)=f9/ۭ߬͸囚V_N睠|)^ hT'u6FiM}1hUloObցO3@>+HQllGЦGw_ڂuUk--<ZCdxUi0.H<-um׊|S8hxղC<1U5N+^T9GLi^\sʘS@dh.ľx~lx8~nvh*L\V<ݏ<(dq^.VWv+==8~+N1{m){TrfO˃K/cOW:unu1xլkڄ2Wmi%ff6֓+h= >sL5p&{uѩ~9{r2P}V[nɭـ׼Ҷh6p~ -`ޮDG!s󏱡ߥ8kα G5lxqng9^^ )/u>`w xwitpjovNyNi=GytTGRGRCx~'KxC|'K|Cz"}HG'U/MzG?zc>k 0; `>̋0OK ?(`>̫0[ 0`>ˀ0Ok 8`>0{zڏ|zG< /ďE !?%B!=Ho?#*L& D"ȏO+L7EmeN|Eӗo [5ru7djwaveslim/data/ar1.rda0000644000176200001440000000267414627073455014213 0ustar liggesusers- 8Ti̸3fHhmlXieu"e B(.JWRm>tY6VbSKQTI!Rb'F~߱yy9yg_pqa>#03|$+FDVArwpmu/i<]37Af%^yGqT#NCUK@`7omxͭ% ݿZ{[6B`.Id׆aMfs;c7#Uuwl[W,ճkݐ:v0: j雹Y#^Js@^|f4놮 ;u^#B!M`ȋgkw@e f> [i`~<(i׎3A7fY[;8Z 1~/d]b],/nZpczZ˘<|'$[W헉slp#mJB7tb[c;7̻L>W]q4򺵀`ޯVI9 '![S3 }- u}aaͻ;~۝v}_CKӀaGܲz((Ɣą@0,Z &Kl|]׀x6g9ւ>U'"߁NsT0'$])`yNB_ Xz.xTǬ!rtŒ`[LetR ySCƜYe[c)GM$+&2`W`J%ù`%Y-3`5o_*A]@z:Ai"L?0:X=tZ'l.t9%5Rq܂*sxdu q6HYi Y  @l sE` q2'Zg ~;=ݘ##D1{!wZwG/Iw2#7iumYlO.q ۬XzpWI Nb{ţz&Ʒ;9p#Hsq7S~k)u˰FQeg0_^-PÃ8#G\IHYJ@=l3'&p#zɿBa {qs56Rf'j- RFUkhVdV-|oBWR<2hk"; ,,eېc5H]#{ɴH>3(9Y}lrW&/`6q$ɿu!ie?=aNZdZv+ F^V4-G/?Q^gI$q N]8 H֟w,2rh"#}ZMAgG:%HcDΛHȪ8|Re"U})r YbϑVuf[Ց4Tz;HXdq!TAl$ӓ\zQ$?Ӥf6arwaveslim/data/exchange.rda0000644000176200001440000000626014627073455015305 0ustar liggesusersXwtn , "R"(½" !ND@ދH4i(J7[ށsrޙ;`)iI&ͤjZf֬FMiz!mKw&e<3{:ۺG8NF?nm咻m.?1~yAcĶ213 lm@#lk_5gZl+9w[:{Q܄ikt&%r)_isK׸Ta&(X>^VzRcgٺ&I58q}gZ|ִ?֏_<[g~6[^l]ZPXfbށKl] Ԅ|f~k@8'gMǯ8ێo3K]Xyo)*O룿 , 9?UaK!ޟțnTcͭU[f# sؼEq!S--tc̆oz~wn|MFfSߣk%lڷ1ty&SYEfcsNill ͨ50ͻw=ݜ{vKl!76HS?>-/=ºQ-85(|YYk7*z2;.|lMgj.N'S.;WVfrVf)5Ma2q5M\kWC ~o&֎xyZ{zфJJTb8"fuTe;%L(xzKOQP՛=(Kx9Ѳށa)8E;;QW);;POl{:xZk2P , 3J'ɾWhe*A;&0(>vUwI?*^h:u4p""?בÖ|z*gӐcgEDz.۶ =:U>M+U/if]'YTu_',˃{leb$;uc`uzq\\Xx>FcقbY:Zl1Nl}-KByͿHټ'hʽ17*0Gvy# #_[tsxN3K ZUQ#s(r-Fd#yth;*)xyL:@9n__|©ʼnb4WkEjF~uO՝ex; OV?N9*RѵgOEjΑ$%;_䀥@P֛O~#yK>96'ArW_ r5.  y@Eh;P˯Q!ȋ90;~|j>8Ž}"J~՟I{oȄ~۱vKs'1`ۑO|'.g&W(u֗o!1%*#ib b֔"Y@ȹJ4J *|C*$B9Gw]A*.G_ XfPo^9 _ ɡT*:o4a*{OEc\֟ȃ-T8ۧ wyBg|Ǒ@coEː_7T~ȏ)(a%S(x[!|kC@_Ff,qhA7t߅D>8SOP5G H S3 L3 k< }.b~T|~1j~>}d>nοRzQz(>~؏T43ܓ^6OU_OUrFs!WaA)9sC]=a?$#Bu'|oЗlP}h*{ye-- ~x 4+~<(}**Zq9#v.>WgR4~ejJ.%>U ;覢iL@KQɧC >|| B; BŻ*>UWfX_!pB/h+P鰛:ҏ~ˀ}m%~!3\-8Pz]keP?8Zӽs!{C3<=c@}1x3ڀ_Efyq&BY4Џ@߅\ ㆾBMiӿ@7g?+SM}I%.^+>LOj? s@ =X@=ԺspމN{Iu sSԾ }ȟ+ uu9Iq¿/z n2pR r#?.tqZ7=e-v#{{EcbqA1Uo}3չX O-nz?š/ƍw^Oj`CŗOQDSpDuGeǨ4%H¼I ț8?_C(pB\a_Џ) eU)w~inAl/`-,AG,D2]<׊_9]Dtx[>:.=b%<9_yAVg5y%%ÕkzH;?_M]iC\=r!waveslim/data/japan.rda0000644000176200001440000000152214627073455014610 0ustar liggesuserseTiHTa}9[-B^)aaLR)!ESSh# 0m#HҠ0:j9::Ό9Q=;~%&z&{ "\]* \ Wg3A-b]4TwIܧQqk axM 5 q%1OP9zyeO_ՈNk4|;Dme~ЩQ5R56S V{Rk;K3]Aܕz=?C]w_Q{>Σq0@ЋNoe]G |x x Xp$~57$ ?VOI |on9Myl NʇNF ;&N )cѽ!_:Sgx/t85c=_ n&)f= QX+ t ~z9}d4ȫ M^o8{b4ps~[o\FUyo! 4a= PMaEϭz˺*g?!p,p;qX?w}\oӼq3tfL-9Q[rBX^޼9zrb"l] c /r_ oK7;CY[c|=CŐ;}@rWI{O[^ pI9/p>hwxIu;u|deyN{'V&a'Dwt<7Wz+vѮwaveslim/data/dau.rda0000644000176200001440000011705514627073455014301 0ustar liggesusersBZh91AY&SY/b?.!3TTr@@@@a]EP((P@(P( 4lkF$z-4wdmӧZ* "( JUARRJ*JDJE@%)URR$J R%B**)BTR$R/ Z i ærnݲR٥JRAJ_mP hh )kYiTlԅ^.[Q_l-B@r">(Lx @(XBf-3`-3uLTJ :/gvFD Ǧ!b 4 Efʢ-XRѫX[HOZmV(h G ҆h(SE(OThTM ѡLdb410کD~hhh$STbF&@ 4"I OHɲIL#5 CM%"DS#h@O(44+1`4uܺk,uSjDdgI%]&ZXn0R)s*iqD"֋3ҨIjZ+Z#k*K,XjV951յINf:WhT'ThE+l5:HEpZuic#D֚'rIh)1+)j5k1eijdm&Z9˷"aEfYfZQVeQYXV!dHMZ1Qlf:AwQKEۦ4&dV4he1EѺ3f[Pbf7TRuuEk8jNr&kY\[n-udI3U3MN9*Vul.Fi@JюYc[gsi1Nų]SG5:[SMZFMĪε+::ZjhcUkfm]6elΘ5'PG%QJFPZgjV55-ҍM[&4֥Y!&\V-5dt]kSC]@bjQEUMeZ\ֺ :β0IcY\gDIrjM V"jMjik.5ک4,YdLL4ى4TZ5Rhk%[-M5agkL%usjYhZYUhjr[JӑRcc2VbJiNkZVIV\hk-Mf)cl&dŒԅUI--U+We\UԖ%UkJՕ+01#\k4ժ쵫. 9JeXF:ȶe&B5K`֢%Z[T֬VƬKkM ѵiru.rg9 1rۛItw3"4,D,5f̌&46jVu4gYƙՊUU1nABSpYZLŒk]S%HEZqFv4m3k\&W5̦]cԖV-9 rZM5UYfJ:]WYFծU&nN!YgNZem˦ %*%$DI˻ӱ+Qk+9%ZT5lf-l.8L՛Y1֣R 0VUJgD\᮵iWW]Ub-4s2]-NiԚ 5ԭ555Uf:fҴ.[-AִgTVleFifqҙԜ-V5ZfUSaDmuT֌fj]rus -fZVJЇB*4$rerMIW]4*Աi%3224Yda]fʖiժ).q#sE컹;d\隬VaaT]H cTh'eĺӣS,7RYˮg&ZNLMrVZfuj'LYőiFgc3U-4ņY֝SdkLj PH bn6k#\XZȘf4[VCPfIcPΛ5RZ+59v]YZ,jjG Zi]bл;$裡t2ʝbZUHiiƍj1':Y"˫.39e7+:'u4YdQL:pSI\I1 Mmht!5$*ӢZgj6RMiJmi\`iө5 hTZN#hvd*l(SCafZ#kR-e54iZZS ]K0Ufd ]c1qΦWga܈wt*Xεk9-jYeu:&2fƄխfZiZֲZ!I֮Q)SK[LMi4eٖ-C[ 9.Mk.9FbQVVM9e4%\jvfŢKBnŦ*NPԵK2Ԭ[G22V+qb,K\Y[W.j SVSJihmiV-+Rf,p:k-V֣JՂɕֹ 9Za6fͭmJ֎[MjhC3#S3-9*vZӖZӅ9ֲ!ZP努ImgYKafˌԔ)֦MXYK!ih36V֦K4XLLӢ-ګ5Vk ZWk"ֲVUT`NdUYk[ZkVf&FY¤JKY&vZLڪ,cCR$g8(g+KktNsLY(YHӌeV,kRֱeV&VVQVqMkeQfj[-+#vu)ӝR.☲c5mYDUZe-d$MYVir-16Z4rrZK#YؓS2:9puT6kfřFFu)TZ(5uv2iY:Lh[LZٔ\FbsVe9]%jMFJY'%kf+i:j[VTZ uU\Y9.aLKH٭VVP,*m+26IwN̺93vI.TkS9]m90ifk2)E4,GbDk+*MVdMVLƺ-ZVFZ[+1R\ecjTk+RQu-:ƥ\՘˫NF(ZάsE4lJ.*]ZQTv鬰I3e` j3MƅF1`]rmkV9Ze1-aPkEE*Z,ukYtT4VMsW1[T&+Vak'U:r.:$9CMb f¢SIj5;JUUJL\%9UWE3+Zl'TӮ!UZjMlZrdia5MIjҕ(9+dJ&(fr6S#`#4JtK:&jƭӮsep7cZQiQd+i5hr4&\Le,e*tUtmZ%5KΚ4tEN;iYٌ\uUe]ֳ+! 9:ņeRTS1ZʌR]܌q.\ݓ$Wb#-lSEk9L9\ZvRisK,ueԭJIImilt̳M 1֬4-r5Z٩HbXsg[ E֮,uSWkjXjƚ2MEʫ`a:LliZ) *\b%eLjbZUfYJФ96H)["ֲ XiZPS'fm":΄s-femald5k; a["Td,.tAVKjkJ9 ģ:ٌfZM,:3bX,UR ,#2bFՖ˪֠ks%VR5IHZUdNNntvebYt\"fɲTMhW-iN]*Wv\j֍buuRV4-jƵUZb,MPrtDPYkZʉDj*,W:ZլlV331s$&c4iiZѦ\[GAY[V*襎jVK&cIں.: LZYV\3NeR4_玘QEf9Kc[#5(V]dZb̙RUZV:6:6),S3(H5:ڝʵGYRfs2:֩+1S2T'Zefҳi 7IBc\6TUk54i+4"թ[e5k4JVu*XjY)sYaZ&G'Zjզ6YZ32jC1:i3&5fjX)VsWY31Vحbj͊eb-iYFmJ5jfY; fqF٪j]nc4c\R,lg]e Hj\֬)jk2ZZKl,D֦TV5;FVFtɄ9̺Λ%]rqeX5դ5Ү$S27YUPeYcZRӕ#d-Eu ma\c\]:-c5(Z2&[9U2LL:ʥѓ4]fu qd1EYmf`%\"Z+JԒ%Ek c)YZL2e'3-tMZlullP-լ2UteaY]i-.S:\ke$eY- @U,Җ4g,e\IP LuUJAuu:r ֝%GIÒv:l\6.ZŽ[u.[S%ڋfv­j:[;|ϞWVVkAEÁ]tkSuÈӭjլ4Kri9VT[NtUXW5*`kJ j65f ek6MZ.aekY:(eQ )J-[VfZək 5G(Mla+Khɦps'i.ffYZJֵWb1KYb9dTu2g4Է MLAƴ+ kMSUHVrF4V.EE$9jٹv-cVdVXΚk-j3HjR]]pl-VD0Z-,:u\.9NquQAJ\3kNi[Zjj9g,sEj5FZֳ,Hң6d5M,L7R #r;g7rMV[5]Ae4ɩ*X43WQծYkU*He˪j U53Fk35"V8\[6UkT橫+#u0X.ZTk-ZRmZ骬KCfZ15I34SUYelMi l˦M]ZҴfJZMUd-U֝8&٪siI,1ղadZ+MưTu.V0VZd2ΐTY3+bu4:m eZ 3'ULLYZˍeփe&VNeeWhZZ̕rVkH5BNΩ&ʓLjҤrvbԻ.FSYSM$jG՗"ō-+MGSM5ffY4K\sY3ESS4jk2Lh1|{݄ʬj9Rkr4Y"c0͝QKc[XիEGK 3%,j-\GD YJMJ2DM!v9uQIdS3Vk3tWjզR`dWqv+hDe]DһY$֦r[ӬPjaQjZB\sWQ&Y[]RXjeVN:YgJS[6Gc(F64V2VaLՌT5:Xg0,a'UWV$KV4U3kFXMUG3ArZTESf(jƺUZaˣFc5kjLc[2խ:ȋRѵj \_pSƵkcGu3*sS jY+VRڋ2bruVNjD&UkIDtRfeHѮ gZ]2M\+" Pk4ffMVYK [IVJf%TؤVSFV]4)"2Fք¾Yr+V1Luj͙iĮ6WHVD̴QkW!kIS[ZblLE4cV-uu3EV U-l5iʋ.ƭ.ZʧS-k:,Riiϵ]ufUJJ8N eC¶ڛS.ժ*YWbM&rW9KkkZe!q5֚mkSt&vkE ͅ&uV;2Ġ+J$t.+;>UYhs)WLZ5QsB Ue[RʦrS*d)rWY:(9e,aIl2րShVU%;YXՙM 5jV"qjCWURZ{7ϊk*"8дk:`i:YL8!JRejVKQu*jUIkY&[maa\r骍E\g]VLi޽Cs՜gW]KYUX̦\j5]RV Q3MNU´4WjֹeKi"IfZcά4miNufVu|n*Rjm GjS%saR!;GI8nZ425\jVTӎr&QjfsN0K3.s#Es82eZ3H)TN\ɎL2z*譙`Vգ$ZZ宪bNXNI0IFnzieAYkJ=λbvqRg_]Զӆj2Ub>U2Ո֍+1u .ZuVƴJ(;om־y-ԳGZ[s2\g.sq7OKw5$[TbX4fd;[u.JQk:PAeO]=u%\,jTYkIjju:SC33*Ru dթMfE,NmK$$i@ H\Ԭc(E Z1R.5j2:Fgc)fd+V]W9ѥjڤvO+_6 i/mzuji{{{b MZYF:6~=^fΪ켪ūJڗ2ljյmXՏϻnyE-mF8MeZ׶G*j8NZHyM(u#t%YgHՕeUR\"mqN!j7XoxեZN7z֛"-~}]}lZưZty[]i$Qmk[NX14#|)SRD+ڝӖEmŪQ ZkvR*̜V5ZZ?%n)9^ʸ=)vSYm3-K8ATMkZѩt֬` v,CeŁDRR$*-Vo8SتE;ұ[[ dog^mjy<|)Zx ʥ,؊^c-:׏ulV7#1ƅexn#u*y3q7*ѥlb6n}hiK:\-+-5񺖞w{q3:摛ijSv|v!mqםEvmW(xl3 zP\@V.g\HԎJvnB&Klqzr3<&Dj+ґνokU2hTST69zTQVD*YאXьc\S;1ֻ.'$dPhN16JIQ-XbcK Z˺e;V8Z]Y[o<4iU5[ R3[טv @zݹj9]6k0LjVf6훵zSA.()rH"ORr< #9:^{ՃB|Ӳ;'6Z)(J\a WEAtᲂ3\۝/*b]wZ+棭UFܓyW-<5v*sBr=n kC vô6n5iYSq֌LL!DMéB.YN[wij{"y5+ ׊@x@ԶΊs0n݇*k-̪!  [umǵ.ם[n^.5[W̍Z5ש`]pR;:NTlglDŘPB6LG@NT1&g\]#eIe{, ;9 3t$2RX׷O8-S[EYs M;iLec%|ӎ Z*vm75!,9 PI" H\v) $ނCZs 9 ">cONXxٜke3BkHh;`]N;n]tWKyإk>6!M*39ѹ"#D6k(;kDC*CC#X3{h bQO@lWo;VUR2LV2D'w\ueϷ AΎ477U 1-)v孻j.;Zfgm*횙 s'H YINEξW{зb却m^]%ͽxM\۠rFҕ>}s,Z1vUJ=v.lL|M[0vD-S`s"]ZdW+:֞#ֲRmVɺs[Pal謲]XWI.sEb\" mU*Y[E7X j]`,R,,h8\30вZzj7t#*fᜣo(lrDdLhg0LF2HjJKcHpײdb"mn jw^*%13S\B[nne5h$ Vf+rvr5s؞IN fSأ`B.51(G Ws6^̬hԺe*PVE O:j>No3sM_i%̽RբL#:͢X23i7rٺ)%XN ٬.EWohc=(9YI.umuqIJM\E&:l\mD:K2aɮor&66F;2A1i,j )i,>YS-AyH&bQ2l6TChNt|#k6 RU-m3IשkZN*."heLӄ<^6m"Z"lx"XB՘.&XuNH=n4ٞ}RQBJgy^ka,$dV0rTf"bv ;)5qqx:ROuJ4Bp/QJ>#Ubd&#e%4NO0EK#Ug!d.by9[dqn̏8۶ |4a$+ )5D¨'sb]VU[3qc-锜 V7*vۙ9sz!@|8l8. (PaN#8{PdӬyIj-ԳHJWrK\`뺸l:9m4Y1 xjBq)c X$ZhˡN6qDL745&ˢצldm(][A-2("]}d)Nw]rnfU,Bl%+vg- :fj-2a;ǥr];꫍S(K1ULnhۇe׻:5,˻ 9ָ:7ʩ7A2:w4Uan&X`e&J|ZE 3 qѧ %Ʌ9eeܝjr(tVʂg x!.fWf856t;dZ-պs3Mqf+=('˫G$$𑌔X%L9&blВŴ,UYV[#%MS>#[_8r (gsD$VJf`v⬁M^fƞ}B#!r40RSel) ru<]8liI,Ɯwiqgɋ(| tnd՘c":UQ, IٍYR Z3vώʔ[6lRFAl˚:KgX}+RHnZN2F̬(E;őgJe oA-bNkҡ>z# ר4C3'm2ãslؙh e)JaJ2Ht^M,rJ+(Jޔjo=  V@ʸqfōkx*AvzmnZ^EgX [n;+<:UaW2j&a4Bn !Jd155)TYXdN&F([uF uSY&AyM'm&PYE3HMX69ց5 ,^]1Yxq9߶)I1B㦊ͮPU":aE+SqSi"ζJs >. /ifH%$$yXb20g$O~Suo:-ld'e.])Sv1ɋMÁvI'2䜑VA"Ҕ#$;zZs+$Q'%+pt!P"˱#U)Lcy+g@H"=i!l4&5h$!Nh]XDYHOH("h-C KeFř蝁,m&ym=&ڲgsp`Rq9Sfq^s5SG)n60s>=ҕ=ȏtWZ$J!˰m4] ڜt~1`o Lj!i90;ؤNeZ&!;|𢡄;1IEDeuD{Euj;N%1<&.URzؤb-tRKx*GYZѢj&22PBQ4NJT˦xQ6GqV“jt T P%SuJRL7QeD45#wֳgAl赜֯X8"5L܂8ʅRB'w=[̻xX:NrPn1r硻\DvEhxRbA.̘EYldΥMz4`;z<+.FHxgSYᠠ`h\VEڤ) Z`Rv;D6"dn·ftC(Q3*blajmM5$_>#Xī5nFZ202]EuR iLeN {^\|лJμ9%dڨs5E㑵Xc4fڣR26[5rZFQ|10MlMwS˝T%@DѧHykAEavińW*uȝݷvM+UvGEEuÉJ%1.gRs);PW"n7-[Fه& ӆ5t훑]Qw;9$( !ld!-4`JI)iAcre:CWaWhv#tKTu6lO)IR܅EfNmq1U]S[,4#(x 0;ܵ \06훜&=^F%$r='u 1 NSm58N5&L*٤%Cc,0?S<ZKku@5(7m:gn,O.JL8U^P\RLBgNsM;*ld`cέljHE Gx[*Cx]tvbP%ڛv;#tŷcgNZl a0LЕU$XvW{28N+y1qb˯ 9>ۯAyZM;;m !p\v芩:㑮0v椬R8y\^ ;8xB,@V-2u[wC7 59qؔaHX) yHh,.osӢ2L&ȳ dh<'' # sC1L'i9cUfWn{ԎѮÄtP4f;`m-.EjIe4M6AFsnrt[r`,APDTY**ԚjЦg508AE*RDwS `hAVn+S5f镔mHޥ@Aˢ(q/1VL޵4'q%{,Ngukg+<,dʾqo:^{fqtY|1ml&UGDsvbUլ6s]OIvKVQ՝Mar=}d9nm +=3f{d1%MX"B2 aLQX8VBUUaB(E|IrZ9qxCPTKC-#i&VmYuPƝY1pRR'^)ՉΏ+Sa "*FXձBRuH KM P:(w&,t6S@LT[wQ-sAF F z.1 ]%JK\ۚp^ku+E "yK<}=s`9]ݲIs,97uv(kX1g 5!ɓyGw{i󩚓 wgpuE1F$k,k[Φu׻r0\$${W~w(ڀRgy`b#iB$W"w4̉Et0D $ܐ A糺Mˠ2Iov܉M9u=M_?=,6DbvW4JI0QR"#1#!rgu^HL3$\w<M$u3찢*[KZsY"6 eETNܛ+ԣ:؂v**Szd#&\vXwB%w |k]90%H樆kVm6T*sk$}}ˣ?qWS blQ*:ec%]v[,QCE+XQ?=5w(w]C:uȌq˳=\LV\R([?,*Q|}قOv<-\>YڄDEEcRəb ݹ9ALK{^wtQ p(A[Fا/=O6~_7,E߼we. &c&Zhyѫκ_]3~PPs 3F6[<·Pw=7T'-3b=j̊j `f[Z2(1EQV(ZTrSZžXsC5ݤ3(3Q8Xǯ_BW6UAS20# yv\s;oԿ>[?>/m0 !KlDkG': D=>n]>Pl&"D\߽iq.pХ əGE5;R"kM6:-fQQm]fy~uO, Ef=p(2Mq\p1Y@ΎP CD~r sCst0!q1 .+d]F .9&n!~{$9#IF3D}HC1߳seժJ[;4" PcBBnk݋FvfA'.1';-\rM4j]C2..6 (d6*\=su$9t|W$mkwͪ3' 3;燁I$𴶭jnV>.ZY7ĶU6Vjja4o~71 Fij/ nj!\-C9MK,ףh+|׫hn TJ`;5fҵ| $e~vOr7,QWWT%O((fBBzW҂~_y9Q_(^'رA6A G}<]oFԑ%QIю_~~=e9dn? B3ѫ"&oZ^hf,owsF%ꃶƃ[S 'P(~A[TQ&?^?Te`+ļ ϳߔt6Q*%+x:|e>dxG|̣ϟD/:v?-#D0_|#࠙0?Z>}z=>F i$q0gY' (N 88!B3.>A$3`7PG}ݬ<}w45 -E"*'S6|޲V,U-=v`I659#Id6"-W/[|6$Dj-QA1j@ II3[3}uZQ/E`B1D%O-SUإ^[tX5K1>ЧzSemIh2ޛVQo 6tFsɌ&'0pYmXs "\9 2oA<;$#Wyܸ湹6LE]W p1Au*u c9{ IPu܉4 TcFEeB}Rc/UXX\ W.H +5fyId r,Ơ*²)eD6@?H o :25V :&V>沧 [V*MvU+D(b"?>_bͶsfu[|J,Si-|VJ ޻^L%"B5?^iݿjQ܄3W9˻ǫ_;} (JR^y*ee|J̌0D`ڻhY:ɶRչ"#Q/ŪBݬ*jJXrkZw;(uYK,9߳Hi=! _־fkSYfBZ(ҋfaU*L²(UnBͶ_L*^ַy;:iYi,$՜.*n+wtGL-Jp-a:~;aD۬R O%D DD[dŬiiEj4Ыc`R')!C:fXUd(}IQ?iu'm_UwwE9-O1AcԈ-ϵp0V1mvO6'K٠"S!5'xmb~훹|<dgGH]%`r?~w6$Q0"P(ʾ)LM(l4K ]>}r5pzUhT_&  )Hy8MI&-r(ϟnK|SAUS U~w,[W(yaTXyyk!X󖨢PFu.MwA027sK뫈\BGw$2VBVT=bSām+B,PFfJ0""#2kRo{W`I"tGuwD.ԉ4U y{-]j,K`VEC;yl mͽ|Eѱt{\_5srDXwv \\ƨQ`Nr0R\$Eܟ"E6SBmق$0)$I#%r hf+סo9FEo+sr,[Jʹ06Kr$b,2Bc,cڊ_mEj62 fѨHI -UDFf"  V,%13!-[EE EF4XM%hchhXɍRiV6e@ThIM"DhQEQj ,50 $I$Ejfb,b,FĕL,!HIb"D"E6J *!hlhSE٘DLX$4b,`bF-cDZ,Y#dDhԘ20 ,$PȤɳ-AfdX4)MADbɣE5Hm 4Q&6Ơ,lI1,F(Lbi*4j(BBQR&-TFfcRLf̢$,JEI1&LQX lBŌFAX jFF&h * I%SER"jB4T&ThL& LTc&S)(ZB1D&Y-%PfmD"2#),hdɌATlX "d&0RI&PI F25Y5I+cF4!L2TAДQb4D" (b2Q ,cRI-&44f4Z#$lLbF00kh-2Ɠh2EFCF h"*1h(R"J"A4bJBJ[*D*bEF56JcX 4QDRPe** (MDRF3#X4D̘M, 44Ik6,0EI@&cRT`AflؤII$E26-+Ed6H(5lTBM*SImѢ-a(ڋEdHC`i%Dh#E4mUѤ 1DX6JbŋE!LD5Q،Ab FAi1QDlTE P-FDaC$QQb66QJ4aѨ34Ebe&24Bi#RhC`Dh#Ȋ1$E$1cdA,lbK3EjB#!Ab 5h0kZ b bll,ch "0P2b1L!DT2I#h 0e!S 4Ed"+%ʌFQ,QIIFPXIԚ%Qd4 "Ji"d4TP5I-I E&( E5%&RlY6#i(($R4QAb1QfIk*0TF(""T@dČlZ1QHFFcE IIF@lb$f B QbF$&0i "DXXRThY I664cIAQ2`$1%F4(d #%  KT!I "61b)"(**fX61AQM!XlT 1I%2eЕ20IJ(S&eQh4[1ML$DEETQLcL1F2P!B"X(F6E $Ɗ XDbBƢ `lcAb$"4XĐ EITVb"SDl HF1(1dh(l4b()dF1%%hF5&+&4͢BX 2E`6 5hR 2hThِmĆLEFJb$!LJ1LAl1h -d%4 dDL+MY5%cXэEPk!PP IQƋR3T!d6#3ccDj4!b-$h 4lXHF$0QQK 4H!(LA" PFƂEDlBTȊ65b""+%$lll-(Lh QFdi$F#L&h4رhKRQb6DX*$F`hL4k c%04QE!6fc (dTdM4Z I$j(%$hƤXm(A`2Z2X1QcEI`,"DbѱJ@Ě,(`ѩ&AE1E%IY-h2dA"0 "6IHؠRTd%lXQIɌ%5FcH%3d 30BDi"B $Z& *LEV5%c, QI)&RTJŊSbB2DEآ65cleDX1S1@ʙѩ$Di*Rd 1ME$`EkLRUF)()0[b(2lh2"ɢ LL" IT+hAF0I [A&Ţ1EADY2CIDlh# F#1hĤƑL)(QH!%&-Lڍ Q$El 6MHjK(Ee4QDEb$H͓B QhiFōAbb f1I4Ql5C# *D5#BU%`RhJ3Q 2dQh$FH"ɢ)1$b,d &ыDj*,T@E65 RTJ6-EAFe,AF Dh؈$TDPHѨA bZ,b4QfY41IFE$Td,dRIlE!QLc3DK E!h4F5D BAb$Lh((L(6D34cьIQIRi*MQPb1FhL"(͉2EH,Rf( "64TFI"L͘ l)IX4QPX֊),hf$!A3Ici(ch,B!#QɍX!4QHi4Rh5&H6"QRlQh&Db0I4MQ LL(R"Ć6B4DJ`RTbj cI)5U0aFf-% ɍD10cS6bAT`Ţbh”jM@F&F$cF2kT`I3Q"1I$XJhɋ3dbd2cdMBQ *5I&M3LFDF4AaƋhŠ$Z&((eT)$%%&5(* ő6LFjBƴ&I5)4(0Qj6Ih -"54i ,XBED#C52,b F*M,IQ23$ 2XX1D(04T(QD ȈȘhF F a)hY4ZfF&1H$%3Q! 6Y&TFX,I0fa)$HPEFQb 1ѓD@$(F4ES"Pj"B2ca*͊(E#cF) &`H5bbʼn,!BE(Q A*L&M5c$ID-F&J1db $1F #PmDI6H(R6Q$0*0V2IQ %4mPm؈4"2hABI2!D"MbX # 4ẖQ4,"ll$&KIMhAcؓE%I)*C jH4Db1RQƢKEXcPT$`(ƌFL2CѶ60b $ lbMƴBI2Ba*BC%h̰Bd,dcf ѱDm)hԔZ, PXEE4b$XmcLebi"bFXŢѤhMAElbH4l4mM`,J,Q$Dh+a"Ɉh4Ԓ[f*I,+ER&eeA(I#i*1LI6E`&EQl46h0FQJ XFli"ea4YQE2b ES1e,$lE*"ԖfQE e(Q*E&4 $ID UQdY*( bD`(I( ZabɤV X1ID$T&5)!Ŋh "YHll5h(`#!F,BchKd1%&F i$ARF4Q& fATX4RlkDFرA0bFɈY4$%lXPZș(F̃3&AcX(6HT*LI L30lFŌa4X,L Ʊ4 2lhD`21REDBbP$A%J(lX E4$j6K-`M VH"#5J &5A4E(ĤZ4a1(KAYaJeQ1E%&J#%DbAD$bJF ЉBHlZ" ,Z@(DEFjL!Lb)&a*4A4hbMFbKI&HE@ThL, 1Eъ,h F,#(*Jc$X((DI4bi X̌B#jJ* $`hFIQ52),lEc@lRIJbTcDFjfbTm ,ZH h`IId(J1&"6" Ō4h0 VMƱ&4Ib1Fōb4PAEhd&(Bŋ2jMF"5&F4LX$E`1If 3dR 2I&ad*5*"MF*+&"I&6"1d$Z3X("1Ah$+!I (Fэ"EIAh 1T2e lLJL$ll"IP`Պ"5Ţ,HXB5DŒE 66((hbj4DkI!Pa0`4R&6,bb FДFImX6l+!b)&Cc`Qhج[%$j,l%b$4"a`آ(Ƣf4DlQc&#d$V1%MHEm,hbؠTcHQDؐ&h)6щPlE1b*HfXF5 (hɍ@1 hXRhAlTll$b2QbJRh6&D1IDhѢJ)Q%&"ŌLi4IF,Ae,B&I6"4Qj R4DT2F&6)!)M QAEQI4hH4Qm$0#!Ac$LXƍLEb2 QE 35F6$ AE#lQ ( d-%DhF"Uh`d$jlFI1Q#Fň%%ImcE&1-",ęҔT*F$i0cc%A# kQ"4&ƍF,lhY 1#بZ$D%L $j رb1fZJeb  0flZ21-(Q& mIA,Lcc&Ȗ3 F5IDb0m!$V m!*52EDŊ 0h$F&bH,FjJ!2E!A% D)IlQcFX@ @m$Fd`dlQ$I h" FH4Eh53F"1IRblF63#QQ2jDE4h*CF$mŤbƊ ARRAPI(Bh i$DE$RXM+QX*$AZ6ɬD!M+$bQZ$5+hMD%Qd؍&JV-5cɍF"ѓlXd-4F- HQhB& "؍bR6Y653jf0ZLThK),AhQfcDlb4FA6Pi*1lRFŲVFѨi1,Z F1b1h2cF#Aa4lV6Ebd1lZfi(1XE&DhجZ4mEE66(QQThѱmc&-h5m f`ƒ#jmEAPZ-&X+EQţTmi6-ckh$Rj *&6(1E(h65EjɣbѨb4Y(mTƤj"*6M$TTbشcbF F[EXXlѣmh6-% -`hCQQchcF-4UEc*6+QcTlZ6-E"ѭƨBƍبTj5Eэ-QlAmEEccXj%QDlU"VKbj5֓jDm-TZA(*-Flj-ѵƂ21T-lQ,ZŊ5b*V*$MbĕAƋl` F6hƓXbEJѢ6c1+EX[*6F(Dd5dllVIQkDhѣmDXبՂ1R-&EcchEEQcPQEEQ Y cIX4TcѶTm&4Z%شfX" 5Z-Q cb-PF1hBE%FUأdmb-Z5Z-V1chZƊhQIXRPmLmi"h64mbѱdFű1IL,Z"[&VMljɲT64ZQlV666AƃFѵFF6bQbh-Rk H6*M#F6+&ōZŨF(mI6-`ŊFLEQcXDj4Z* b̭l[hXbb5b-%E 40i,bd`Xڂ`m4mj+ETlZ"IL(Ѩ1T E$m!ZmF&-&h2Z"5TA*DBX5J1bb@lmF#cd,LEd+lh5E[&TX5%h24cRlbQdť,m&1Ia1k%,i6(5H$bƢF 4j6JƍKbLk3mXب"QQF,Xؤ5Z(4chѭVX655b lUب(ch*elFh1%+dXZ5(4F1chت6#hbѣQE,6+Di6bcZmEF5F(ljYAkEXmb-Fdlب6["dkDllmcEQ*4j66FŶBQTY"%Z4m`ړb*XljhU5E6ƋF66 6ELhm lcj(*6lAlVQXlZ5l[KhF,Fcmb6,EEb66#RhX#h6Ѫ5FMѬ[2VDb#hQcmlE6(FhKQ6X*,QhZ5Dj#Rm,[4Xh6 Eb4Z6,֌mcld+%EF4bd66Qj+ "ѣIQb- XFEcX 5(h4j4FѲk,bX2mEhC% j*6h1$lAF(hF4E&1-b6ɱcl&Ѷ ֌lh[FحBhClU%XEchUX1V5EQlj EF ԥX"*)K"mj&VQ`-QfEj6jڍF#d66+h5&hj4b- hX- EImQc`1kFj2Dk[VKQH,J5QVk6i#&5bŶAIF*mDXB-lhQTb,h1cAmEFi 6,[F `PjmQfmclb-IbcRQ4DQIm2جZ1hѨUEdi-khY4lk`i-+2@FbY HF+6"fcFBHX**@(dbZAS"i6ű5-IF1T[ŃQhd5"ZL6,hLl%l[bfV(X""ذcj5ŊŴd1ڍFj*M H, ާ"@DâTD3FAI*ֱJ%BeFFVh[6[5v0)SԬ;Zes 5tL4MSǻL7ɦyQ5[ȥ/dٵUeVjDw<ثzꖤDtkF,TWU/5 ͂_(*yyueFyJEDa3yܭ j3D+´b+R_4<|Ո+(̖>)K֥&1Np&;1o:$7By^Uro;x/RT"t"1iݍ;t`9h˻[-}i Q73g(#Ml[naM$ng‰"Q4E#^nxmwH &MhB"I6,tl\%jJkEr/oW؋y&1'*-{^>c\4m$L(@(|Ww~|wsd0~{$T[cnrV؋[h;nQ2^ ,!R,S\4Je}ļLV %_PhG (*-dݩˢ2c stoϗzUQy|_c&"KA~:"#/ӻUU}bNs/}L 'shRWoU|8XBųE=ZPEmG$BIwZPkv㢕%gݷرeqQ]5’R.ZLBMmrrI=뾼P_2+Pu(kMyIQs`/뻻syƹnI.)7uhDYHrUW:~_Y̫s&F *۝i#(B拻 D /. L~ +lmߺ15`.hպM~{FE=kn292P~sg$]&)9mwdW(( LZݮQENŻ0Hi XJ\quħ%9;PP=R}|_~o~YYRc&Pϟ/}@COuBh\wsn1dQ# i(F;t]øFM9I3_72mt+˛BowCmJփr+* ROޛVru*Eձ[xZVbŭT* lA&/\1E˺[ssnAGu:hslPZ-mUνs(󲮤ܰ]uuW,h~}4q,R59 n9}2AsnnPd IӎQ9ԜKW q^rrdQSAg][qð\]8k]Kymyȍ7P)=ǻd(YHaSZ2Vio˩S3P~kw_Md euXW%ѕ5r4܈UKUd|^bʋ+mVP+mkiK޴ɷqQܑ%+6]uztBpq7wKb*5*VTqRZoj+཭6kw'[Er^Bڣ9FOw__H ,{/]K&}hѶoiVW [xװ-bJGj_2y6+YUmjJ eG%{ẙ.J]v25k&*մr t/箌hʕmQ,a3,_|^>~()V*RD3XAB.a [WJ#\r[d g89I^kKѓ{ ENhٿsZ:LJs>%Hsm4-,"qȣ, 6>IfEDL'[VdeÄ`ZȳZ|hhh]pkYhۗeKe˵'Vq4j*ŎV`<^.ZI]/vw_rP^f׻^ #( v_km5/bJ-(~!(x/:g022J漼ݤe*VɭC?Q :boԢ1?蔟-;VQr2-ea!\AAEXJBRV $t1 @E wQ't=F32M"_?\3MIWw\$ܝj띏wno'e)%l`f*]*'RNbB,V,fQ,]uE,[Ew\DNKUkmpys墳~U07~^Lo*2Ugu`;h1\NE/;眑5]Wv2YUYQѵAVF{Ejmʕk_>wGÍSX쭹OdE*,Ej δU`(m3R4Pȵ+=ayQw]]v?#+tRZXZ·̈́jj{K~/~;ʨELQOֹbeR/\׮-u&ޞʕPKnhBmY?>}|ǗUSYfU6)V+]h){chռo̗o WO=%Bȇ<+tP:E&y7)?0Ff/ߨo(āK/B<4>ҹ-Z^b],"lD,Ilr#e{~ȋ*[\>qTH5|>}DϩO}/3Ea7&F#J!yK\ 䴤 @Ob DXog-M h@$DBd@j$ UAP$O{,cc<Pr|CEk\ùz,û!('E)1~҉H A.zI>uG=yo3/+$=z;ђHWNk"-|f]X(0*]=OSUܳ?;QA;$Qk|D_}y+*%G߾k,bDE)m&w bK _tX0_y=DXmDHFyeYcª jBX^@O!ȫNܫsFܹ9~{$ch#%BXѱE!PԞ&T,@s~^^J1B.v{/?FdRL A<$AP1$$h1b#Te[bE[+ԞvhV4߻wt*+kͮ[~~EQU4k{30bѲI}u;]hH'u̒KJi&Tߛ_y%ЫFAccmcQFɧ !IȳrJ6E[嫚Y?9lj]ܱVh_ܓ.fQFJmJ\"Vk5(1TQCUfЬ1FMu[/͓_npe]v.]R%0Sn&9U[g8سiP|mkErg)*ZE .j9Nf*P*M]תce=G0UDwzb+Z6[J R@95u,Yes~aL#I䶫"Els(QǞoE"'W?B/D3c|\+ܴr湵J3\\-pܮŗ\omdۜ~}|FѿCgwBdDX w\I %__ FR 1o޸'}}cFJLK?6Dhw~td-tر6ܫ6 tn^jjW-Nch6cZ}5rы$jJ65/8E )`fL(DY4M QA,RbF 6';XEۘڋ]ѱwU=Z e/9%/PK>GN~r0aCA""Hu޵A?"|wMlmWjegƧE& {*S:͖]>lO||usN[ߣ|EVZj*ǣbd`U^!Y !mTyhC[6uk DdhawoϞ>BDfԻkaDaXVTPHJ^v_{^F*Ν h:r$!\4l9ڍsLHܸcGw[FC^LC[Wo˹ZŻ}ܐ_}5T+ ʋqs\JZ\W +^f;X$F,"J3I*=ݎs Pyb*VQ)AT~W;F(xˌe[Uj^yyu M`5vc$J)ICg~LIKDy>wflD3=wW$b="svg˛{7u>=緎ڠeǛwBGn#rFkAHOu;MsG/Ie"s^G,c!!M^tvvܳ]֔gKk?Yt}zWYYh-VNs/>.&.qLW Иd!.7=׺b/S1NAKmJ;_}FCeW7wG E*) j>{J'^L*)*(A ؾv(Sz9G]5.f[]ʘ]#.n}@Ҙ $wyJҭ;17?N*}NIi2EP^9`b25Ҙ@O#76`:ydkj[#)Dkzu(GjF,_/YXV]ffh(IRrYR3^6{<)SiT,FasDdy7* d((Z뵅bmi907u@QS!땇5*ѧ8b3Yu$&.j{^ T1[2kPzzUwDlPGQ L+u~V]v]-7X7Wj蝓Iwpb]}uwL Dwq.v1Uѐ/s{ډ]aZ"өUȢ({5LE%}umGSݭ쳐X}lh˪rѹeyfVuU'VMwTLߛuEwqF.[rMXJrwXv"*R_w`BѠT-m\(ur]sWZkurb8#2_ 1 "*|jJd/%LͶ օL&IX4e'3%r$Ѵn/7^erݭus^(d )j ¥@" J%AP5K[_ɐQ ƥLn0TʊdUkvQ&Cu'K}QߺƂȹEscWR*8au9-*K^Ri8ZAG;*?6+^f8xbgs?z}fV0r|=|GbV햑E;l[6ڵm|{bԜ|ht%MV-$@%I-3nv1ɪ[g?|g\I|O;ơ+W6'Ekx{>Ÿ<̉$J2M~IΎVHB?Gvߟ62:L N) B"dgwEx٧2(=[MPGw^;$@(?;l* y<= k> N.rI.~G{xXm5O㷽,WDm}C$a h{u}ZoV󽞪J8y{Ev <|P7wF̢w(Wϟ izD,υG;P VDΎΔoj =,yҼkQܻrAoqi hA~(`N#yE>|̈B(=QHy^ :f <-.!`C`i )u͖BMuOwZ+"ѵ~guhks]5 ~Ky͉"fBeN޼XfE=׭+Rb#X1Zq)n> &ŋF4cLǻ߷ᑱ<&4߻t^fĒ 1AIDȰ2FLȣb1m%y{sk*krkݯ*FTyrV-tkTiTZr9\#vッ1LR@I_F(Ԗh,cbm*6sd[X(mͫѪ#w\tl/Y"`RTiW1e疮[U+և˔S<׺p)r8J*^CzyL^l6xׁv{շmfnJ&[DV/&ovճ%-bA+E+/XRs+a6zک{ A0~_*(~q~G[侩.\e6}Jzbdd=߷ 2J 7#\?hD,op$軹0 wp;#6%3Dwi &B :ȠrQ$U5bZcϾbsQDS<չV۰h *VjZRu0`6!ݮтK݉Bi"a Q~1~m2^ph+#ѹj0dƤѨrwyjk&-sskFˑs[rŢ$ѱ堵279WKƱX.]"S'n$"0;H(in"JdVf΄> %ڍE"ʊ6PmFmnh;FQܑN$ ؏ˀwaveslim/data/acvs.andel10.rda0000644000176200001440000014037414627073455015707 0ustar liggesusers7zXZi"6!X@])TW"nRʟx8Og0ܲ%|< }!$իj1|fz[yè3̉X4/Rh45ެ)YHq2ݚ <^䢏7w7a,v=ыs X{#`LJprKFXp]m@L&nN3ZXAiOq$ /?src;Ʉ7GW1wil3b.KiʵpܣzT‡Bor?nA[ҨF_kbvaş-BpGR6Myy;Mm6h:Šb;1އ\DSGL\&vgsڰ`vs{iQV%ޛr9*yٺL>) Iݓa7¦Drꄅіx &6\9ܑ6RC_@K[Mrĝ$֝&l9676%ά/ȌHZW5wvXXui}uJB/y %~3ɱh&% +r{<1&g\t!>V dW)jףZ-3+cɦiȞŮl.o7\*Q,~C5hJ!R)pg*,mu*^_!@?d%HFHE;#ۈf.s,.[6 hd:7j62sE^nx"rz}FxN{d6H mJz5fdFl, ^ X>Og@,0dTKSjNm@UT欇CpRDX+'K3g @٠4au׮@uњ1UOє 1إn^b֥7%1;5^}r e^H v|v8"fj}$PF}i]Yjy‹~>'vqdfݸ_Gą^ŝ^hVF^}1^}@:w+=ޫrbDrHvV J GqIi+9"^ K|%<ś[Wj{55. @# H:^(K]S1J[rmI"فfvIziIyM<)XaN馊e);:(C;M ^6UUKa3&L'5i|*|6ٝq":/tc[)0AUSKݒFrҗ^tGu&$30}a3s&H.|b;vz{ߪ*yEχteeN}uQti4fC1?p5McM3&++V<%E{sD%n׻UEa8]; צ`%LjgCm҆*vs)EM]=9aWPQKߏ9@#Ple+ym TRޒʝb E<$*ǃ#GLbo]h\Sc(>%1m_^*"6XN?]ԯx ݜ*2A4f̝ѬY O8.b?p`AL+݀*f`!y6 [s䢋8rϮbdj]AeФizݓP[s Z,c K$ Pħ}( &vDK&ė 8x:Jƻ8ړ!qoOu5XNj' KIbZXV2,mq 2oVa*"⧤fQvh &N1y*&7h _xBßh];_ErSZYǥ"TY%6`TzBn@E~t)ck^Q3D¼"u/|cx!ȝI$$,BmI )•P0JM^I"`Q;?[ASUh}[=@gu}2{}{QݙlNý8u4dc^9^ہ}l>Y(δ:C;֙%&",hԗ#_Nlq++87IB7kK0𐖷M;OT0? r;(nYYe mD5}1TB10~ Ԕ2At諅 9H\T}Sڄ/oG4tr҄t՚T}J4j30R diWk*zAw7r̬O 4ᎈރ4q =U5_^ka;OC{ ?*S^T#^HyiVnTty>V^ǨHxnEز禔52;^d'(t-JIzqŗO bDŽe~~NJ|Qk#!qm8Un4d]+2wbw7Gx.o6O^r839&Vle'/\2IJ3~& bL A!Onez{Ds꫻dÿ}Xz M6X2HET>4u߭Q9Z9l#Ο`7>O )_2ao(4!; .+ძdR08(*>;9iʅȢ8IQ xPy׿&B.14pZ 2jsХb<쇞ʼI[lu3E>\~G5Xx@9(˷GO8ט빯fRΝ6=Z.t~&*f𙸋t⹴FHdWK-]91(ج4+[O]$5Dx uHPo<7Ņx<E"ӎj "B\6LjۃBW#f<.ee()K3@7Z?rҬ۠I DB F4_SMѤtz9P} {S,?R~/c}2;\1+{ U[={" h4 M\O ]mg~[f}XNN8A2 >fͧ8vs,r30]݄.nFvybdNu^l[0ߪbh~2 =0u[Wl,lUpʘOЉж!׻oPk#sؖ+@:chJ#)fUpuTdZ6y7pqEXDD#I1ӽ6D"ÿkXcƦIVCO'SwCp'AQqVåw#U>YKXj܍/H<ɸqw3]oџWS F JeF1d X)@  }:ycg~ae;$|>fQh9+;GXLT.2=mhNؐqWoCǯm sN\&, 5 8[/ܛ'? Úx_o-JcW*dAQe$B!qP,΀GOTa獒Gdxb斒;pv0dA`E5RYIHmklMQIn\Nu#EC{\%" q;PݙۚIKzV'?峴(35 SKI!RN< ЀԤQ2I( VJS# mT8wӴ9fN&Q51)ɘبiRG,?6hbsIO<\!C(OVڰ 5 Ƒ3ǃ$oۧ_H$ O %{ʇ} I#w |ԖR*fW!WYUc؊%n8hZ&tw7C/z!&uh~l 81[-R26"_0<$ÆZ,4H`B[~aOMUB4][).ϔtLg:x1z>Z%CV)oۂ! ?ȪUǿZp %aHS)!{~|*# 5C|;uJ^ޅ${^W׆V~\=b;c}ik]J{}M^U޿\!i3E@5fDT8_9'0[i :L Aq7|qt`z?/jۉt k[W78Rۄ&rY8j% ^Y/mT;` XԎC o(OkNȍ$V.-ƶfwx o be,=;p'"Kʑ&1* Xn%2FN AʥuP`M1s$NXq(H֤Sb[x%"W5^1fHvNʫ&=Eޡ0~pLOn (?J5tMCuu:vUF}QDdP/} {mqS,_{QW:XbQpUn{҄YV2#WSH/g}dVopV mIҠ_1ž zCYZPg"8}Nt/!Fd]9#ԍ b?Nb%:kMHZ{ "B:~p {e7"Ml/w?0 a7̇g =$+m|gjw$b[V.ŷSwԴmg<_bax١ w{IßxS&/)Xa~/>mL:(aM`\ O3ѡ(0I4`[[6*U'754Ki DXܜѸݸ_M0lչ!3}e_>ۼ Ӎ 厭ݓ#C$,ѓ.Ok GQtOZړ z71,ZЫ ݪ+&cv|~J0S,+ ZXy zy )PzLH(LP*|-Oާ/ivWqnl@2oGUUxzbqxM7BEIA,! ibܱbP@l9gcn#ɚ(FIWk qRG䪫jJ-fv&,4x=ptL!4֪l@: k4 d(jm+&x^>>Jigrt*R6FM|7T e6vh4i*p<l+fnAĉsZ9 -< A"Փ { ddE$p*F)֌ݶz }4 S͗c Sew&v0W̢mXrC2?:hRǕ5l``d)"$ saH|#*wl+"㆙uת>΃{S .pyЪss;TC[N_~Q }7e@_y_iN&Q,H4b8T9-W~  h蚎L~<ȱJ$ywc'ۋ3؞2d;(g&AGBxSO҂OҌ57c=m{D}ͩ3L@H{In= 1.i~2ܕsB.1_LLHCu vcSEE L,₧P?DدO:x|ok ʎҗI eaHmQ Qε" ro"Ղ'X!}Z.w Gx'G\ؾTN(EqzZ, M, }= 3C@iC^}* ((j;qBqOaϡ2s_Ĕ= ]t+Z!mtubNy/U='XV sY>RmYEeؕCu"ʾCIszUwP+]er ɓ;i_0ӓ ʽKt9m3۝ hYf|uirʥGSYkd'NWI[;MT? xoiM2frѪxDOn2U^;;ܙWͣ$M%(OEQ1{A$mG1EB=NvdZ*uF;p䢴KˁTFخCb[+$A^&~u"MNHI2] 9ؙ7>2ל1q1Q}RX9odt ZÁ ^ ę0{NF07gqߦp{7/u%Z-!Lv:>,^~*|9]cJ!Rj:.W&ɒj>su,QmMQҏ48@ސv;R 랪YD]*}3`7ik=<6kH]6ƫc)juf}AcWO;Ch N&ZoE؅T+n:@7uKy2<*5zK^ aYG |ݶ+s*tK-I]_ټ*SC ъav7$Cr6$W/@M1(a'[LgI f<1uwMwtZlv`dٲ:')Qk).Xn?m8X&Uz2,Ov;4Zсs*vb+;Q <oΡ6^,)+M{>8x)f{O7i<\R_Qv5.~e}D-r-6\\7xrx~3ݎwX-\ɛrRmVa8+PN\uoi06R^~v뜽Է^v^6 3 זbxD8?P f.2 3}R \ 'ID%ЎA"`İ&z־b/;] 8ݵ2p-6@g7eej]KqC=2ƌ]+x=u9\FVtӞ||O=Do[ @Aɬcgs2P[뵧F#578o/¯j.ߍwK_|Ùf˲ZKEYt!ѢPtsµ=1q±cKDYڽEk+Ko:2]˷]wjCѳ3>OXa2aGk.ICzuq!8#ت )>.D@U; JSLq|$ՔνB8/,tE#7 7e5_0hZդCǜrx5'<[vЦ՜Vߔ)H$zg2%<>8AKU"^%A[{ŅBaf[vw#ܗV6Z2q>f @5IPP =qD''T&_'Gb <=uaѴK 53 32[xT3`un +i4 ZBB^Q~%-{K$I(q{D 5%nN%@.Rqarǭ=J̑3g\pm̝ CbH9d.ɫ28YVRWӍHY[XyBLN\?'=2c/C x%lZco1u(܁k5ޅTä#Nq%'Tݞ?I14RC Ы;P}glPta$A!y(|b]"yAVRLy`勑દp#Ssԕ ܄߷jw{F>LYC3R,%FJRs#V-[M&5Vl/<'ŀ*ޣ6$29V[ۗ>oQ}bH`33p8<+|>>=&ssӼP,p1mPhLK ڀ2#o3lԏU.tSεB; XeAsp7' wWDO֗t/$Nm5+i|<["a`wjLvWj:G` 㥗l#:Bh'A@؜xMb:8~ېS08|B[X rR%!SIo%U,sLe}!6#4'?rd3H]*lREvA؏T x҃4:]k@{]~,t+SٖA12Uuf<ЂCHZ$*uw)p&˚N˰njhg%)MۗR6&7 ɍc. dn'gs??U[ gtI[B>Nf֦IC=R}|t,ۏ*#4Ps@>J>/Z~XkH8F!I+c]'ih\ ?4gu] /QZ{gN>99tzSg彊Sյ۰=r3=76B'=9Vq*za0`>Jװ "QS62o(p뒾BC\R"|U΅jYTA]U {Sk5( E*s'_IQU.?_\d /`!/l&FzAKRy)egG7yb$!Lv"V4ůӎ*QF]s({ulApD4KY} ڼ#/d Uև_U[0TbMwh`ӎɱ!Ht;C$PRZ@N?mZ"Bn\IHgJgQG-dDD"-<оhӴ}GO~J }uC-;B^R'+_@xӹieB-=r_{k/޷C&6O7KekE9.ͧtݚJg[~֙`ۉ!PBy򣲕("{`dboˠZ>8`:z[ ͐V V,S&YcTsxcnv1Е$ 6k(:_!ѩ}6-A˧"x}i?%29} }ͩĹsЇr"Y,A`8ޮ>9ϴnG) _Z ug?%&9%YO8웈w]; N`@!>B).D/I+?咴{IukCJd7H`QMvuY36c[p-y-*P){MN|R-#0cvu)ĐgHy[5׈1^)3iͶYQZ^781)i1!K\a3M`ܻ̃FQ{ ĤWJunԸˎSZBpw&gSæcБ8`3Lօ_ZC3Ob볬ܳjo4B.3- *^ŗ*Ew!H~y]Jk `QPGe1Y((ϏTyPm#5@]Sz @S9C",#  '-#KIaDnJISH![Փ.pJ>iT\lJ#ǝw*ª99mp<Kz|~,UUJp~kQo/UX 3P@ u ?PTJT+,(f"(|+v%'GuCV(p$7AYY'\XtVaTE쟈{orS QaM[wʭiH:hԛn$h=&չ;ErgŎDVO6uu&ZRS"Т ]jC7\gM?4?,\傺_+s}Ef~%~ nih H(ݝsK1 Ӝ>̈́CB>XBj0KgFpxi5[^eB; ;)|1U!8O*x11}?EUJlcaa  ):[?K~\+I=Am);'uaXqK݉onJ#jfe0=ŝ@}=B`4'y/:/ eJBe`ApJ߅6Z:.#ĂvvfOg&\]\guq~7wLjލ@sM+)[9ȉQ =3 ߓm87x9 i7A+,9Zqzi,9;auwyGITT'd Qism} *t3l2=%3حE>Yⶾ˾'Pm;df΃?ȶ2f"\P6:R=wlI >UF+#:w]eO+8_]1ި~OXJ_e^:S^/;P(dIWM+F._|xJe)ٛ(܃) +`W;4om2tRYف5!ɋP*MCs 7{͐\堮͝Zv_-3ts2jnwyBv~33ϬPK v&#7ر&6C3Q/"@" UYM EHjzN=A ѽ:Ad\d2(o#aѼ3"+ aDs[nU?/vQ]>7j py3ѡ̾ \Gan7]Fy!?ZAy|5%O Q7Ffd]:ёi[;A0z:mR:[Φ$2-4̗lಇPd j %[o{1h*ZI}\WURe(< ɶ0AJ*>+.>(Ѩ-#Ikrx+Os]\LG4kM^?ABgawNub OW8 +9oSrWcze. SGNlj_g!x+wȹh4iWZC 2acM/lӂTn'TХc܉%9pUָ-_8]d*WqZƳT]4qSLG:pAB "+6x8w"gZJ.<`W)}fƁ18_TD>I̐2!L79ǓhCn,o*ʡƯ+.KWAua7P2+ni&K~qMEfXo`M"tʧU1/l܆)=IO|92Ռ' t7j2#n񥊿QSE^'2JHe#߭'I]&vj.Q7oRwi8˰xG-g;6F 5xa/,uV+ t2#}߷d{M΢YX0ATL\"Y]065^~4ckb0?]nQ@MLq2++:#XrmMAYELj$Uͳ{0p4q8 y?[q"4n6º)jq`&OP>+2}u5n=Ieؤ,Hei建e5pdqaCGsH}}j&Hobt#M> @i1+:*Y\zrBoƧrPCUqiyk CzEfZs1se1EЦ͌ 3hOhYZ^bU]*K!p7'v7g:gi1:#t\9wak.Mk[m*Sk @@u(X*sB] mZIS'y5ҪU'0DL X {ſ.a&>x$5B􌨨RBcCƋUݭU>(z9.V֞-_u!0;зGB|G\Ll.Y[E3a/Ghtnn 1\q?A?Mh]C⪰B`{q(^~0>|ۢCp^:*JR%qo889.&J&Ҷ/84=h:6k%T|$lY'hH^Va7P]"ǩFV Y=d_H?D[W  ~,71Uܯm~׺]eP'*'զU"Ҁ?4QP-0Tx!}wOF )lzHLa(#*$bGq>TQ+3aoz_Ug( $A~1/;3+Nk-'`4R.x>;j\WpL* E/, v1/uiǢHw\1ձ8KzE& 2Pe-@,X QY \FfzB:"ӘY)Ka@zɞ/o LՔzF˗ UZ93SF W{Wzqz☹aI^Bl!M3ȨѼ\:4!3= d](|2a4ZO5ISt\[ Ft^G;QRXl4lb~=Jd ʋel Dt}Sl`YsIUϋԒȌK+DL&i$(+h /N9pL/`yrإe3 Ҧ?VB 0'ՏHg.H1\`5Ma*d)frl^Z[Xv9KL`dVD#F[ߎ2]h4k'IV 0f]:{TZΧĥ'ZB|Q_ou܁fG5|u70g(&xrWqDa ]4FmƬnjQh{:,"MPb;b3da 4 AIד]?H{@}03Wy?qS p߉}^b^Ƣ'Q dȤb\Ey*S-&wDppא@:|L DlY]+iY.V?"mҔu(_*DbYS'yQrߛ: L@Nz8'F4N|%LZt6M$i!6,_/ F>C)ŭyeS`h@+E"U ڇi$q<z:b"'yTc./gx%c"&3?[8~d!+ pұdVIp mG.j|z%j)S ?l9^U4l'SAEg&27M(tl7aH!{J"Psvl,p, ?T_9-/\^$'a>6UWD#B-( poxOƨԥ`8TnN5)'j"@M._rclnN=F_*Bǀ»y4dd5!UdE`UÖh)Ma .ߣHETS%5z%b]ںv{ū|_Hs]"siZQ+R2 kOEQPP@k JoER@k\vf(946 >:Kp ^G >) J㈊nlԩݞΘ HِGo͗!_=GIۊ;FKm"?>nJ ;Hwf}Jv'H9,w(uRJ564dSaw[ YiGoj elc0MOR^8xz@;v 0/zvjʗ1"pjMNP&xUng-9\z=ntuK gxR;oYTU 6olwkSr㷠J^v(B!0AۥN&1g(uQl}m9>˿Af4UtqAnP-y ³unϐY4c2. 71 vYy`1$֯ p-Rye9g/wsO'0vi nPV qM϶d?v~K؆sN'P>=> W+w"s8#| P#m^[Ì'Z@c69U#'zЂ-x;ǓwNEP'2;?)X*FZY:B䳄Ozhx( PQF@M#8PE`1PXYF9p>~g9g7%3jV E]~]:gCj1< u+n񓶛ƬIeh92ǧS/|DrTuDf2&i pXCV`k11ҭ-0vPD*ymp /ek&~ёnj\JE[7 A-&%R]OpBAm/vj7#iQςӳ"()Jܖ'''ɣFUVBT"]"e_ְj?ϽFz.J ;oLFa^!$;yzgoi)]f|wy-g j#C#r] |wqh9X(ΘQX,WМ5?#aoũ$_@p AgdO?$۾& J/t`N lh`Ne kN<O5m5EsA3p= MPhk8/Z6[=GI3/w%^="OF΁MLS nCG]#RUA@ =+niCK72ڒB8(M*Pp7,f]\Ak3ybT$;ǭ2'R*R'w g:LhpR҆g۲ӽ q*yG'ZT]I'*! þZCIi3)Y~(\/~]ߍϿ!x1nĪͻj*BԦ9ys~xrJt-6_eaB/]uA0c(-! OJs{z{>C>I AT,Z(yf 2!V"6k;ãmD$_3A0Lk_3{i񌰬孼_: Ɖ8ݒ,(o()$M-4ˌx,/EiPdV\u$gl ܾ"sEq4?3nL+85zTU*1,J|[ˈ.K0G7ì^kKQn9w,(D^yԿbضomW|ӨX2ofP|h!` U>920iFƫ? y 2!@ԅNCT|CTCF6į3Tō^QOٙ~'r4рz'u( ]Xp6i:CFGieQo@+_J& bQw `&=XpvmEJ %v|xۆiѪt~ށ殕ېx(>[VVQb9abe<HTIe [lY:.ac.p/RnyJ{\ܻxp"s)PqW߄uF)LKi6 @^lR ] }1 Cs;RSʱkNo ǽTJiICBjA0 G&UD NB |Ҥ$׀oo^LO ,rۅ!蝟Pa ˂8iՂ(Q@QQ 4%@% r8}"s&90m^iCZ'E珖p˜}[*2YU%bl| bK1)פBeh<8,z02קҜr:#oJ!At~E.)B8W=V0}17EA|ܥ`; zTe1Cm<#B:;l )!֧HQ0Wly* :7 U*W~gᦒV c&7AAZ\PB4,wQ\%M3Ȣ-=UW5͉U8qr: 4T:eple#kC6B!39F)61~kɫNhrzcfZn$L$-ۧ8RZ} +F2i).g 9_Zv ͷ4 M^#v] ocs$/P>A`Pslڹ8j߲3bhEVT71~so~ CŶV)~XČR`Kx4Ն `Bkku@tJ [ʟbk| 57uBKĠs1[X$.7 0Zf3w57B5,TvjK~WI}( ۰/ D(jS XsDT͸&l榩eJ<" #yL`[3 ,!-<%>c9*I؞-2)'Ѿb56,n?oA*4[Fpیܜtu] uzdrsCgک0*jnzr0-P(lwdbd0o?0Y-\(53aL#(e6(M:՝*J>AɞTTiYՖ;<$k ÊR2Io6b&d_OﮚOOO =[,y;*hv\h*L=2Ұ"1%F^hG3W$r^n];:{f.vq2+[tN?`b qe/VȆQO#! {Y;X#EGaq)̌|>(eZ*,Ŵ<Җ&VG TRcs $G-^}f-.V%)\+Vuqp,.|~$K*C :7s a]xyN`p$85aXᖎ&z bގdISP4Q}e`>u|"&Тa$ۆpP Xgl?挥X2 ߕsEҺ)l`cY%B.͕ IQ)4I#{Ze!v4/~]+[u{tA}G<DgXȓ$'I/{S8},.0S:sfdHn>vиDZG6Xo%Ws 0[[b3p}Y:(U& e*ͳrq&R~r8ȳ8b%ȁ (,} Z_`Qv #iaı0Z|Ħ酄կj$K'žLs`PkH ?W?l`E\6 j#_dn|?Eww+?ZX:''onquC8N$L|3\_=U,nEB@DH<ؤG;"Sw9l0L§2]%#8jyA7R+̼}`hI'CbI%+k}IG-t RwyҔ^gg"FE"zyK 线B#x}R̷U,SM<['UHF5`Kt۱@ sd֘i`d]nqM?q ŮLOG7UU P˚z !p3mF:mt֡3Wwy&k5IjU.g,[я^rKmsH,zydfNRE|鲶**_Vr;HD' FOmify x"} 4".GЛvSf޶|sOE'^5#aik@u ԻO tr;a6Vjf]_u7gDZ%xDuW,L'2r@*8[@:N[?k/mW7EQk(,q+*EǨ`tkevG:zZRTv!ŏNpZhM4{ȲX/yxr_1$FiTr ( 0K.3_ >p$FqLU'&˱j&eJӮXIt(oW*qI#qƋA5Y'Y7ɫNv8Qzǐͮ54Ǫ fqIzZ[*!'Y6gU˒aj^, HdxZbv1O-%Q5hT2 ZƉD Q֦w"}y9n'<|C/ڍ *k& !c,l9?)Rni{7ǪbX,Q5<4t-C.4zs?TRiC].p!yJqm+LFM͊lѾPIQ]<(L\24B|QkґLHf9>+ZM9X_#ft" RW!GĥT<>IFVE#!Zk'nzE̲(U!ѥn=DC[O0t'AQq]0~7%D Uu ^@;xAR :׏AY[Bi?_1pfw<B 䧛yXCqòxpɔ h%wq< N[n 5޾#WB?\B Gfg0?Ż-6; U|g}Vg沱y_JG?RCdZ9__J]|ET~=Wv]|NoógJ9J@rd~Gj\(\0g dP6%щM x&;Wr۬_KfyMX&cU5 lFӦ2mѐVNG e$!%*D1^] ~Z}R ?z(S8k=@g *9^,odA6S-G^ow-s"/czN;IgPf s4Vb#|G s ]XgAsncuJV,,Msz~ڋc`\d IOB/doQ8갉K!(@ pssaS08p aUV(ߑ~1hO8q[iEC 6λ=MD'0V;(h4WF2W(abu) 9tNWSE<" QdwˏWthpP/#9JtX~el rfTל%7P AyL mF[֡C)Ǯ"H+'k`m aE/끄9@S<>Px^I,v& A+")YM0Uk5Ϋ"Q({'Xe^ë;yԯMIA<VQ&$#mp狞#6da+`Qp V\_I* G< AE><.PT~ -XA Llp?-fs cRxV_drX(ޠ7&$>%m}~5"s+:%*o0kIb2bjI1]!.YQ%>'2o,c &1.Yh8 {拉IAf{mH}6w ީE)Վ$ xYTh9&lEO Ob+`>SVsF|;y9*n[#F7a﷣|M6\Vƈw܋[j`F:YS+ s-$P5np v9r_JSA% 0V)cBbaz?LLLo{9]˝_Fb$cRGф'RPFX0Ɂf]. ۲F]_X%04 ICvm'fX§rҊё-;gZGI|1kөIhYHzsQ!2+N6B3& ߂#,+J}sjDc8D #/#u. Zl {eq}wGAA1˜ c)S;`'|{%rQM 6cR.S}7dVٜ b\O_5xOlit>mn6mop I̯GQ=/w&QPQi5șGʷ1d]i*GqwZy!iewAH.OQÀ]"q@ŜDa2zC$) I ""% m` $d{Tw~QQ;N![2EeQߖ0R ʃ$P֔ e4BI,?-+x.l3Ϛq0gy/>ar3bo|rhgCS`GCĆ*_E,%c"u:jr S]9\A1"0Gjҍ2Ɩ=s:ܖh(mOZX%w"Is2~u79ńM>ެ滳%묔<8p\kKvõ>$d$&.Xx`e3]9pg )~HխD&TP,⌱݊ ̺4ހR6xM?Uj/lt~oȁQ dh6f)nR lш]U";Vr01B ɭ5b&xeGOU;4 O@Zc"'OM.?%ML*Y`S.(oO<\Gb0 !.w߳2ÍkWQU?> 4Jj/΀6 y@Ej )?%s \` %*?zcwuBxgß9!oYTfaW;% FߛX}_gJVljĸ̆Yz:&D^:a}R۷-F:Lܖ ^%x|\7`=3|-"Vh<ˤR?c ,:9}ĥ d-CuVHsT41""%%LYeQCD+sc6J&s@5Տ06oʣ:.MА"⩒Q^xc{jJM7`il}*< [;G&Sv"`qԔbjk1"rsgG] POW 6-4zVU +jGcr-m5gEJ'4alGT?ܕH%_7)b$3Hgsz 7DCqMxXz'WfB-tLpOϣrF HzZ¿9 }.5fMǚW|2E :ʵ˲ɴc#XvUYV)8>hHѹv?twϻ insYxၾI*b+%7$^IR> #?$ LF~^#m5[dw&M5wՎtئ3Dc)Ц/B-R|{,x7OE^3u^(N- M,0WN!Yvہx#_4WO-^3rP [nvpn|c*iS. 5PHFOz'¾|Fn/5]HGvR;$n2U Ot/s~Ѳ̏? &ReEN6.]142o' 4H_}ݖgJ;uM pf8N}`--3'lV mb%zQQV`EvN["7b%=N ]R ORZNm7Be=;\&'Je=d%c9،6=k?r$eލ}P\ڢAK A6okA,ɜǏK83849+`hFN>@k O|.{䌒qT;Ska(#iU\Xd%o'iMfT&KAv{a3 Fl]=:Xlsk3bǛ(֘l>E$wAdfKk'|FX#8NߎS\3y>2D/t:Yb'2ƺ02$_4+17tz@ \0Ӫi:@ǝߞs8IfP]M rtH$O WpkuǞ-lHWVC2$'[g51(E8 3rX+\TSڶ:, fs(rbmCOQ4<̞Ap}X_9A\_V0i/q/x\k7IO5{B!GԨz`JĨy/K$ F_}䌬 WL&54Sj>˃bG6i-h.ZqJ#T]EntY,(!^- n:KFyd&Hfw BnrC϶=>W׎><3}z&’[zܘ,D?>;ˍ4Kv/b}e0^9L˃ Hy ;Ѽ}D9lj_?xHQW#t^4DA_x!.PtO;+"ITeEp :aXb:"  8Y'^V,%Tw|aeMѝs9H0KLc4%Q Ncw-OyaXFgdv#WGQ-: `dFqKܓ'\"mu*bƍ6/v4t)W<QfT|C GǓOXٹM֨hy6+DҪ;oIjbQ! 揔Wauߏ͞#%8av=qNHTRA#݁;?+SJו~Tٯ:Hz|XʞAJc-U#(;Lm&R6,<56I!qQsjiFTj${OԬesT~6ʌߗ?[DlIZ7{{2[rweUԶtgqxcxX1e~B[a"a nf@34nQXZRa3Dkhbps)\%u$ˇRL셏v6A 'W1DpzBx6*G{Ye1t MVۆ9)c`!r~uUvBִ%*+ӼAm3YUE y! C_F2 p] g9y~| BVveV~PDAVZ݆C-LK/%R,>2k4&\R ʔ7c7gcbE$N2;/E(>p[epnq6=2f? 5]bUTlAQq9ƌ^x$}*]sc,Snan_4S1gt`qL X(86.@T0(gQ{-僈w~ڂ!s8|W-jpGQM,Cm!VG} A3ҧ&ZEjZTo@K]h2]V oeE7̙S qX5e ;:0wMrxb WɲwL\,|q?>`d֐:bҧHBh/MX5D7)"Iy|Dhk]PJϸ%X?\Fی-ݦ/EZlp<|Zw#F[Hvb\tmU" >~1cTqk¯v ѰјN^+/,F,"c LF!@- U=AmAi%@ML<>}4pcS6./N=X T/1Sc<30y .YԴ) 7moB޴gs$ݦQ*P]MqsČn s(Þꕁ YILUxe`v-Î[ݟ:-*}1}63l)V_YNၳ%mv(A⮞2Ot""f^pI`ЯHQ7|{V6l}!<^bV(0t+F<_IH*y巟z%ѝ-j +y6vCO773h%s1:/韪gn W4.r7ȿ3DZPQ 70#ݶ 3` nq%-Ou s ނI /F-y(&h Q&af{|r`yZ ,syz M5hA,|| ˄,AsYO;B>f;k:kwUKkC1a0|N n72'zWGy~"vG q٘4:MKj,픞 ov5)dÏ '[@U(]Ebccx>_ –Lє tN&#V TFM=dOڈB}Y}U 3|YUD>hx=2wUx\uU'yżb@*ө)!&Cð@t{N󹀚x:>ޛs6I,{%v^<}V;uİw ~Sնh8-+QMSBg E{yY TCP0TpmlJmć-&p+RaV^ax]I긁8Pm3Amnh?4is'_f|&f|^1/ cuOn2Vt͒4Z#b*Y@Кǃ Jf٫)1K'a1MˤU+PN׎4n}7=7PqM4]l`>6$&M=fӀ(#OJ_,NjILKݮwD*(*zcUgHʜ(ϗQ;K^„#TA#~@읪o<_4;]8щp?OHgjgQnѾf}|niSD=(V{ ]iBR6xpq,m:bÁY叹vD/`~ySt2&Rb1۳ {2HUvo*24QD4VNP>9ma%V|27mg#W{y )U}Ŀ^{a)%\C- G<.S1dضU8N \rfNh=Os@3S)m190;'*ENtC{w*軤ul%#ü~5ӭ(/}%rd>/.C :6{V_BoB'VYDk3,ҋF4 F@]wDdRdw[ZFç .'jpnͳksM)Ip 2<~tfP]^9p!e\xvĂP7ޥ)lů@9e\./O(Iĉ_ʑ@;fu8hu p'dY撟o}oAɃQdR2:iv>&2Τ65'}.){N1qB6ΌCPw |{oU~,.ZN7p]Z6|\ 5G #<%[,.FR\0zj\NnDƀ8y7b] v@if?f#ob͌5{M\m!"fGgOi@61*%ՁnVqo(`{L0os G+BDQzKN,nD!gˇ莈] G"G+{Q(9MT eS/ƕ]f:1f,#+IɗaNʨ}I#z Ș臦oaw kS0`"6TҒ&L;^mScE l8hHhK"&o֫a5l\%[a;ԇk&(h> 1 :h Ϟy}qbզ*[#w4oO3j0]YW,>Y9cGi鹒PjV(á+cl\4j`p-i3+,E{Z"(]1B& nI9K zt΢%fN a Fڳy;6F!~sk}@29I= .q1RM_#S p9 GّP653ۉ=DchF:-K3E`-"Ha}D H7.uFhW~-ݥ қ @v\wO'z<7;mI jwoJ~)A{ C~̙i9&@\ʺƎZ+ :E-]1%q-uǥ+iyv-Iu@q6#5 Ѷ2#YէBDVDO[JNO { 0we4Ko&QA ݀/iކFщ$y8:؅AG}G_#/`JAF2w3D`kӘ݀HS,Y֩Q Tu2WxqE}܉)GD6%L2Rpٝ+,nZ*]P]}'U8d@pb~x^3,k "f@~Pkh>V*Kp`.'X4̒.f> tFC,IGঔ84ufxSP,uH^燐gU?<W׎sjܷm(Fړ%!?Ex(.cㅰj*贉 |(حH'x w\hn(&=s6*tBgf F$0ujmdarsEW2Ԓae=oCitڬ`p^?HmPs# ,C5;] Y |X3~  +Q9LXڂ|͸(gvԫ`%hf/u2eA5Zj'}G2n!3+5E7^Ì#e'ncɭX6LQnI4TnY:8]S44n'BU:zNʣjX,j=!/hJmE(B<@VC_-IW#jU?ԡ}64$B†//^Axjs{4->x'&AQvlٓb.hR6X$Eǧפ@)y#P_"=?fP6y_3+:ҧ fkjB k\ ֆz-yn$l&2|3!״9.TD aYAe\ÑnrOJW 0َEK흨/J@E&/ҪQMf!7;㧜'PB36%t=ﬗ m100ygl¬fz {wRDѷք-@_`qR3ݹgx+DЅo֝7kaO!%~%S\0D'1 j8ö! ~ *k Y!ђ1qgvRֲ!ЙǛ5kϰY.sⲺaXnjfZcȟOwIi 㹸_}k/$ry(ܧ`k(:pw64J%e9Hb.z%vk:-CuǃYNe+zdͨb[U] 2ٚ~sӧ_h\88rէj3s⻘m? [ɀv Bt#jei%uy2Pwc-ur9v.{.i{8Q ' CP,5.Ym_.Kx$<=pZZ۴8­=W?k{N7<]t;++ao L, 8|̯% ? rQ'//Yٵ?t4}`'/)pyBXhΐkŚh">]@Uoaݤ qL eõ29f'3){6=zdNXB6 ^`+dMh4HCx^}@ﲥA3rztkx/ş< :ki0ǭzoNʡxm!:I2Dr)v &WUШe"P6@٢+l%e8IPed5ʘ7QFF&N X`yퟲXЅ~F{w``$U ķ> h`^$ӿMwH:$.bJ)j့=\ϖy@TP*A_ÉYQg9;ra.;,15n:@)b|_@8f3M7^!.!~:&Ӛ4udcp x 2:Fmܹ\cOI~eOܵg731&^+FZ:w[xqlNȺ̙=ʅhcWe6`B| )=`6È^A -Jf@E=i; Vk瀽9Jj&Ƣc8,W5ȁ `wg2-|?<$d"LgeRc*2wY7ݛ/ $D^0!ћq4nN5=Ƈn\KSף4ʧRUUX!wS+z]" $`=oBTA l93 GvY592pm¸1g!.FI`C8SCd3ra(jg&;#0|Δ9 .[ jn%p :qwVq.^3&IpT~̠/, >^=U_PNmZddtԅFs 0$jC Ja*ZÑ :SbpE >XC۽pgO50uh2LRS!mŞgҊAt.s(U3RI)6|}-1pە[)n=W&Ysߡ_u֕}Epv鼃KYbK-uo ƈSb`jRJJr=1s0wj whE}<;5&ۘՅ٪q**"5{'nC&&w1qpq!~[9,B0[{FZ y(,œ_g52W{poU*hfΆ!D%M^*E(gKGz["cg6@Z 9b*P)-&&i OH>Za{m{OeqKz8Z]uU2h! s^eA o pdRa*  XїevC"!\0/?^|x? kdj*:p<*~(衮]Zwز3e!*-ѐ[r]z)f+*lxL%)(\S@c<@,Sf^6ٕ&zկ8ɶC磋_ci1m.DAPƸL[BĆ*:坷:FG,A*)=8/Ï%W|~!)xR&@V^H8m%ZfBr\LSOi±2ii: M;NDsX5AFa۾nM4FT}TrR:wlE* _#uvo@ ]NuDo٥\v:MYu[dIѧ}VQ5o~ڠyr3ͱAl؜n݂ ?b,&$2~9 ԡ@C U4 {D'=T9mŃGf"37K\N(irW@R L@chhWipd$>-\,Zz~ (LBwK#NF@h(5nZ4WGs=)O'[氐 1[ (9tN[6x5sğ3sJkqV :⨣4 ͳ@"b|FR,(vPeЇ6Cp] WI}y8; ~t.1KPɮYb RPARcx}"'Eƅ3šEY~G]?Tx/ŋ+5l:|ZohrxCZ%=E₶5H"m`H !_y1t%w7bc5Q?~FF(|ǩb?x+,~\b+ );+j&y|=9p Su.Ѐ z E75Jf"_$Eڗ]#o +.^^_YW:D2]䪞(jm[YS['1CJ3e**2}c|q %N'x &Q4v{PS">ex6BЯ-r9aMirX6B_EdXYUeZȑkYƾs Hk I:x{h#rP<~_ݿ}ǻIu -+0ټDjVz /R+d@L=x#Lu/_} Z1nW/Ӥӟ f-aCqZxd\(fD:XZ:DΘ.ob36͋(uDXNR64`3Tty1g;HaݰY]E%Zv+^BYVmPcbܔX:H^+sғ >`4JB2+ VʴC]af XNu.v]ek̵ظHoYAW4wCgFm 8Qq<s5PkKs g| *j [M-|٨׸^X\-u9kThY#ډ!'C[+-)?foK>\wZB.Hчe>|A:~!1^ɫ. -=c)k tvReƒPm{ZBu0U p4Z|,A^͡f_@t_X sFr[ 1,a˓iܝ¿5D<82Aѯ(+mL zY'm@#˸ߨ^i4xV3x4;V (y(t\;- CkSW`6~!;Y|I[Pĭޘ% !;֙fL_dGwQ}%+-9uLsz=,_=ȽUk|dDʄ:"Z#閪I Ȩ 9OJ GMi,=j3bD:~X3ebFH-Ɣ?vwo=&+,k4įy[K;Cx7t(^J&LeeRzm^tMG|F QcPUE '"|$΀CI:ݠP$Rz!FK85v}[ܬO%3汁u<5D{2|t{ ޾>2&!-ׁnӣ>0 YZwaveslim/data/kobe.rda0000644000176200001440000001707714627073455014453 0ustar liggesusersBZh91AY&SYp$6_Ġ(R{ <W@y@[+)>2DSAidM4dh&jT i&Ƅ<*~S&j&FBh2ILLi221=!4i{AII<Ӏ1^F:6+Ϛ-(/hV .G6rd,Ad&6gy[TNdl],fD|v#m4.Vy1t7Bٙ q{43aXI-z;Ÿ7E.a=q}eS͂ _%ǭLvPVǟm.+4&6gޗ.\:H!dmw4;.kX s}".J܈} W_km<-$\&E8B~3<5x?QݢB H6r=|,c(7}k} ?95%W~>=X4HP5DTyy{ȫƽEm#˱]=aC FĵG%ibkǙp >Z󱰅UPӴoqI+v z*[>cFH@\+]E$')>y_PFB8OwmVPA:9"XT&ugGV *,f1A'3R.=VWlo&>fjJjE=u*\RIv݉(Ltu.V-"𯾗tEwI[_%kX5vzwr "Yi0r XH5:G,G|(:bx&d/nN(ͻ`Ap[EG/qC ;I&y;蟥L&c@IXʮ|һjC1w޹[ƙW{6 k' 29S!? ɜyC-w}a#"/\[\uP,=Q˞oCιL%Nm}D" W,Û*QPA9Rp-RTȱv>?~FmZlv=r9H'S'n /;"#).(ߑ/c3SZ^(KA;b n m$$jhdLљ$pOng;S@&F:>`&>~iPekRDd .OCZnv9H2i^~P-{"{M7u>ky>M0|v?r+r*vr 铐Wd_j1oxm0Bpd dF2Z!Ihʫ[tg^A NjaT\+l9G=iҪo{+)RL\4u!&U$4cx9Z::t :6qn8I( %l^Z˅SW:O**[[`ҶfLDUb1nL~:'zp;4~G{rPb4T?]0@x_|Cnt8 ܶR8J a&Y4*-IɃoK[ƌ vLElnpzڨt@7B:lӀfq*SOKqr# r6J~^lHz&ÂGFǪxkVr/&{Vxf1\Oowa@H 2ZQ I d*R Ӓ:J@Y!TAFH9PSHR9YfJ  P 9&@PJd+@Y-@ (- &T4JU SM AC@QfeU(Q* 220#̌*$)Ħ) !i (Y &IabXdDI0Rc `1!HFE%#$)2( )" D vρ mVت#ap2 KF]rKRL;/os/|$cn_/}$^ϼh%iأNo)I,MI6hE%Jwh:$ Ii@5w[vu9jS'3*ֵ!*En7&t a!{5D9FҶvKK57 Q-Df12p <}RCM推]>Qfn|FާSp1oI } m\'$Ꮖ͊XZI_5*9SvNqd>TB}G;%ɀqYHNcgH t h_c8L{fK08(CjA0@vI8nKv\zYlډ &KEJ:mjCD6UmӾ*݋$zf TGb y:; j!Ah ϱpR-oXBxvdJh=,#zW"n_HX=S.5-]m.xMP+Y$ 0%]5.as9mŋo}UhRVs[v`>` ΰxԐLa vwOgrZ\TY`Cv}9P PaSW5I-O0(ڐ(VjDؙT'鬦拎sbTv^?Ōx;>\(+L"[\wj9pF >_(/=.ͳ"?*)쀊O\}݄=[i|o$ofå޷|R>#$arA.UWV~ӹ:R*,{=ۦ;$)zN{^?H"Rk'h}*Гķ{v#y>tAs D_"\VNLaOˈ)<v[h.q_kvV3oܽ;:Ђ5VJhhIt[ lQSr {|}L`y)Q `CEp%/q H.wu|N4=|r.3qs"+ ѠJOC_|wgnle;7ߎ_gKA\i0,Ģ/%Uy0rqkWҐ ɷ}L}>bM-:t!9LX*=Mxb u{wm*a̳]}*W5Ta;9WfI骥1`bL}M(`IpZ:1Y?Q1+`@-/-u!iJe )bdؼ}ѓ{N,lJ4l;Z{Yn@Ir])ޭn+EXgR.iq}nP#7 7mS40$-<ǁ5\*U*}W[+no~ȅȿX$!g46/qy%c)~((%6?v;+,g'ᆘӓf/i4  >j( tiZ Ir P#Hd)J idHIJ)HPӤ&@Rid&B:U12"3J,AP$$f0)F-uZ ;`Eq7)o{lMza&8зM1%f a|=޷N-afdn|;6q7_lnѐPRUt-9-I84Ҙm>۲r%ݧV 0'k~u=)Q%[<@2&mr1,][xi!1i +8\_9K NTdSv߃ʐ$G`9ךq3%CiKrr +>jǰ'sJ_>=;XTL JxRcYz! c8V.Œu XK֨4;:Ԫªk*S-rJ ҼFʻ B<Aח? ݘR[P{\ʋ3`IBymfܺM**zuIDԕ5#0>hVH =Nwaveslim/data/acvs.andel8.rda0000644000176200001440000012640414627073455015634 0ustar liggesusers7zXZi"6!X@])TW"nRʟx8Og0܅>_U3{ũ@!jkUT0ʁ\v~szHyk7#,@ιGc뼌_Pܸ@sȭ_}5vvdWU?ӭ#?*ln[KA]!xl0 iլyh@f-X/zуH0qR M|HSgWk{ҕ3[CˡW2qKt'uҍ.s(#58V@`&l^6LŁ(kmYt;"Ý)&OO cZrR"^q|!JQ*nY|*)~yAZ 2$zY}/4֦_AgՏͳH-CsJW j<9gO @<6xN1ŶH>VL.>4Ѽa!f;4K,=(+ ֪G[)#eRп^ >n%br쮾 JLR:e7XpmqzC4Iܕ`vղkyC[,;C=KE.~23Tzձv5S.sǽ3e ^03r,A<}d^%:+3hh*߁[D,i ]Hh $Мllקpefrޱ^!WJ!}dМ".,r319 L_\xքg+Ӊr,s M8 ~k`_fSaKMX9UL:N c^x7FV=Cths2X'6*aZKs4QˌX+6'ްү Pp 񖨠yJLQdΩ5 `w޶V9Mžb>i@}F?vyM,/ oe RBoGC!NLoS""5O w.`W9XB|7 ం-~d h1H:ޫ4Ҿtsoo8OY? U.RmwU >F5.⽪b񉽿?҅CZgj͗WȤy' %9UnH)R0 ~4&k]))h@ކ¦||Ldb!\5-/Veͩ-ȒjL#OdzIQrQZxpch+HaX63m'e=Q{0e#w |*xb8ŞLl'/8-/*CPRVr>ؙlaX _|Y%C QGc~Ƕ4IA 6]B7!$I'dCdC8 VhjҊ?>9B%)D\fԗ0CnQc$*6Hy/4gOn i^ a$7#?$#wlҮsg|NhxWv/kI}Lvy}Ԁa&HT7Bq0սཙdwO- v;./&m4W&+Ja}_6EOzHjRIjo|wW:ظ7:/a8c"LdbK)[YbЏ%½XZ%އ?̣hUԧ"©}6ɤS=rM7Dw ᵜ9@Zp O16=exsݟK%FɱȐÈ&,UckZN ԍ쎫Fyꦩ[C?'-f763vSݡa,<PDpMͨ?MV)_"һ!u'rM@o;/zF>QwAxvҚ|qa=d_c햢(],AbY@w?9/Y} ~g0Ӈy|Q%PW>fS;Y2`q:3zHIG7lГhɛ#v[\_ \Cy,cSzZ[--(O6 :Tm5CFO+Tg42)MѵRfƒ4.%x2 IpeiY{jé^LDPmɗ5jޤlG6E9*[΢Va|0z?$,`wzAcxI6w*8E_L=OmoǙYZYUG6+ؖ'ìŵAtKZ8!m? g&^q\tOȣ ȆD*ԡR, 2qDE6*%p ;o1b.\)>Ls^B&ʕP*弻ߊSpbcM:H{zG͔```kO/8BUQ+l,p*i-(5<Юe^/ˢva*6tD']Xޚa  E:Oץ$U~?JaP0Ly6 =<) Fqz N F[_jz"c14Xp% ɜPm;"QDtSUS)QNC&%{B.w"=12QӃmfCo#*|NhՃՄ»xyկN'WڻpZrx> *o=QYvpX(IkneA1UǖꁐJSRpՇ1D^Ro ]rHz1$:oּTi\iyÏ>1+6t,@EZ knjxL8sB]),`IOwuybF*F+*AϩFx+{,T !k5_!<ߩm~|j] zDx3rMjYU.<\bqɘKH@/Q#+A <@)Blژq.d{} EE`Q)' }4OZ!ЎP]W !Ih D9&EQA%/X80IKj_ˉdFzX*fT)(H mdP a Ѓt]qD8衩܌7}D֠Hp@|3prNgX&Mۄۥbrk. 旀'tPKh?,Gt0kFoig!_=wk,/϶'"}:OCU,!9.h/ÆM :Af ߩ%1PHY"_vQaHQ WؿWKp;!L,"bsf0I?J_T#cϞ8#22.бByҎ bW|l$7BFd!ˬa^2>7\.h;ǛPd` !U Z_}+gi{<iQ[ӵ (}ᢏӬxDsA^hދ3`3S"}8BdFJY9|RKK5nn@nI aB4Y=nO fBTw OP⼌gvP]}3 #%0(!ڲa9(nto-]q*sHȀ1Xe1JoωBf1&Vtڍ I G. ?7‘NF@co,D.\]x9]Q pQDd?L8B5OR"+ON5lS3dFq"e$_YpqFCQxVQyH}"eh%֡2@nЍTH#=ЛVp:ko#@ζXo䭒4 q?# e!G$vg  `hXA2"t.CqB=~y^JɰUD#Eh 0{2/"" n"V =ec*S iyuJ1 :+Hf  ;h^pLڕk<{ApU;I˒#ϝ5_R(Яԍ IU +b+p{F V;(8MwQ\Bzm@i.d菝X1? ?wnXZ]ׇ: ]t13|-"l34_͒d9U Z\c}|Ηw$ p1q'Hp;ڣlky̼\-'分wKk JE d24񳭈!k '=]Է=Q7MG񴮭 +GsRN$*DD pK|2Ę ƅqpG S=䛮sN%Ѯ/Tigq5UQQRqD-&#*ɺBqjubId%Z8M3?<$e]c~C)g~fӱA$0oKRɯ &ka\Gv=o,'j5sm)f\y+&(mWI:iEu$=c[RRBл&>%{F1,/sɖ>6dpwu,bZ(nwGtTs\ ><99x:G?&f!Cz#8iV-`+d-<6s)ria2$[mʇƬlÅA_=dY.v/`8nV "!Ene .R}l5jı$ùÈ"O"N`oP_hѹqa 0æ)ne ;^迫b*?, JU1\ ]4܆u ?m<˾rEzצEh̔"^xӭ1:`$}C"=Z FY9M՜v8Cf`+nl56^9tѰ&4AHiӔuNLr,'0(1naN "R3S?`cj o&7*&@xӑڮHQ`iLNY_y2.*p1ɍԆUVHtS&ʟ4{\hwL+|~q<3?K \Mڔ)P$+>|$aB 7}b#KaRT]oeS/ >i:tV?2NkI l ,[bu)qAu1r&hUjӻ GM%@HxqWmJκȨLƟ~0nD5ÞR )1 -p^"0KNZ:y^] TqGޅ Dh4 7@ w[$2٘=X"8tHj79w%mw`XPwC!J9fDsZ uu7L8\. XDa:mȊ@Qڰǫ eW$> 8QtNvK2Ld8@3- T`9 W ~ B6w*0(+_eQ;ʁv/6@V{kM,>=s=w`(#AXζNA5),i 4JZF2V#^~wځRA8|8'&HX<  <$!SK#F9S ]pǎ؏X2)Q&u kW. y pX2Yu<߬T6@ Qd7phYgOp>6)<*b3oQ9>#FR(@WM|tP5 ??̏4|'kߜ K&Y428m|VzMOjpaՄP џMDC1tm bl4V%&zFzm/@'o3gӕ}vwC{})/9$Be>&Zҵy2"&`ƵҮ 2Y[t~S8LB P#>,P*߈H,ǼԻ֩R#QAԠY0U(,짧&[ 0;8,Rˡ)>wҠ[Yi%RUjJ2.St]; `l%2PoVϘI/ Q*+_maqސ{B$at vOYw4 6ʞ^%p7 tߵG'Um*o @Yy{];;$c%*ȝ&e8 *Fc)vo`џj2rB -9N>6ǫEF=@s!0s`_i4 ^B 7 *O+G49@2&.u߹e"J~}4r^rS y]%Ōw Fߡ0=6LŸzjIHTVܽ2l{6 Qas>k`0~.{v Wpmhl̜v0aǬo1#uk_2;:_)mg V Y}yۭ[}9}1`zoC]b`惢 W\yj0&- _xXɅUOC}uѕ"GXedWO8NDm-?&Z<Vrx( _B*Qez7YO(j$}ܟa O_Q$÷&鳗a:dYB܋ Yl1`'+N((a@)K6k.x\^F( _T͐46\+cqTȸ0 ?v[#hzQ.kc8 ,j>VF䁳unyznV5-wOWBPϑ s/F{4&J=gr_;/a+ZNXnH6KjQta!5Fˈb袥J{@Q:n. Ѻm]k5s B@Ŵ ]OaO8ӶKolӗKEܢpdt[ʏSx<:YL3d^.rp~xȢ=[VË \V M2;|w{[5Wx:b*-n8e6A"\AOp'}SlJv^,$7$'00+΍1].7u&~3+@q*F*K> v Yӑes IߢJBDz="d._{Z؈uAɪ>Qi`d @F#y 0jiSЃDuۓsf/lE )!b崅" ]H[2bEI[{kEI:О"_%kc_Fƒб2I3&17$6ßfȸokZi OiypsGW9[K=ZnANJO|fx:$-~@V QJù}PbFP٢Ӝm ì7"q(Uc;#^yE۠"z~JE"uA9 g#6Ю_\cDD"R s%r; oO<"v)I"WxVYy9m!rh-2@EQbe ڑڽw#joM@ި{6=ύX9# K'$:$VTb ='Ŝ*0jE(cX3(la+8ksأTfFy&Ah#jגŷ0(#= p/#kTNIj'b,+U"i 7l8l`orW#dDn'Hv7:mL;b[ d7wP&w'n>'rEwt*_?Ӟ1(!2acd!LIG~aV]HEl=WNGB20%>Ng_CgWj^æC33p1kcffzN<")]68k!:VVSjI X2mF9YeB3Ds>U4WJid80PD90,RE@z5{ bn\{Kp聘2>'~./L/0;9 |JDf>ӵ8N#"{Z8chajzB;쁴15c Fwwc،z.6Lƥ?Abߣz"Nrx,1qOf`BS81/»Sڎj0Yof}#eɤKGY\Z=wJ>?gb)*azS 5oz{SKb{_Fꖜʁ(;8 Ƴ/}rK;g 5N ^𒟤=[z⍞8GϐO'?"(cj,dMH-V$꧸IF '+x),/H@BC"3eh6 Tb9ceĴTb'ME3A?kOJ1/KȈ t[kKiw)jyx=NdoUhzZ BG;9l=¬+}A>,Y" ;lKJaOj Gݹ ν?+[1@74t/6@Rd* c-B#0pc o=_qok30HA2qSGˆ}:6@U⼱V~fsIso@o>Z~;s{i82t:4hx@biĠXUSӆTG tz d%/Jϐ~C =H%>FsYN'AZfeNӴqAjD>pzGTW",Q7(RjHT1|P#| EJ8z<ۂP}|! ^M'e(? r:PF >9Z O y͜j(Ġ,QUq5Qliç=$fŽ3OXZ0bkو&X(v"s*[;iphe-*@iZ[Np ߂Sl←"t;^Do ޏ]~Ѽ=z8܎ۉa#wZ5W;P;ܤ9-]"$yg :6D56 ]ވLGX흋>p5ټ52Y[I3W-iIbПh䭆W2٥B2N  [!QiN8/r60{Q2[pk9Xঃ׹n1{ ڱU U|j~M[`/.*Wt~ެk$NBP)A?q_"WOyMa&d! /ot =-m Dcrd;npGY;OPc S.s2P1Ӫ+];4 ;lp1(:Xd?Iakg|VoCʽ 쁘=Vyjy7cdL+p^9j=B.s`zzB3ɠG%x12ʑ-M4ykb}mb. " Wk 4 !#0o0.5,R=HYJ,jD<+ |-ut> e eËچ(B^ 7/("&Lnx_R7<) x+t=S>jf!G{ Շ|7͆C k)Kb Ag#z~_ŕfEߝ3`n`C[vC[ ?AV9-l5@Pg+8x_1$"!͑~fFRws"5p|)&kTζΨe=^^gr;IwjާeI̋J/j\UjXB,c9"L =ltսYiDZߴdA<<,bω=C8Hze }CMT"Ǜ[gqװTdW"k]Dž zܬ=;Ջhio/#u i1=vJIqLjߣxi\ݲńI|%w-MãZӓ'6U"{܌t-،3L 9Ƶ/D6檫}}WkrwH~~d*3< IB^'"+3+3O}bz`AP~mr`;!:?[Ւ_FI6?̸0|xxڌ8\TAqS}"2CE܅YD7&(R" 83h `f);|⠟( F֍?ȧ2 ~R˺[_!hzcTf7&I}M2XˉS3l F ծA(a Rlېuw>4Azypvj(ޛZE^m5sݼm8[Yׁ_>$$ۧ>2DuJܳ)ۀpƏz~T&Ym蘷%3u~h•̠L}'}]zBe"9ɮ{~b!O9)˦>җmSj!GHv HQ`9K|Z ʸq?lRMI m^(s5ry I%N+1< Mu,VYoU(5$> Ez6jȢ<) 6cb+P# 'd r2Jk1nA.l7D\ t. `V7D||X|#oxs[%ۗgơү$JOgafXl(WxEw6x2ڹ…kFwf6g7K~sP9hH؛ TÝMoaB@z=gJn%]=0ûlчhw"[ 縿'f<`lULӑ"?1 HA|]qa%8pK/:; hKzf^&q7@ $4N̰48,:~;²ל uAGQ"-{E5 62gCzCC4U 509eugsQ0O;  dQ"M[<5 Ŭ[734qlB榋48T1ewZ3~'w-uSYKǬV+NTb-?nsEpzHJ Gk47anWs(Zhh;xj~Wn )}``ty~u/p9C^^bډA_ [r* d U)jA/V d0[ d#a_É Nox@FX'_/\a6_k:%uD -ٮ),nF*d$o9CðR´10c*J5,PP⑧ );J]} ,⑃Ĉ|`q͙A;p/]9x` yHe7g-1w{somkt!SDCAFXՂ ? 5Lrj" M$fG7A,冲a>6F`pڑ׳yJLt-[lX[7B鈮_ǝJDj]UREjF^mw-/N'*SATd1UFU";i7@qʼo2${;2s({? V-(4—Q߻օDuIQNd3\CYR;_j?k^EdC06`Quȼ*u J䅘~/0TTXhǚ^4Y|cʋ$f1h W$ !P )b#vqZ-'PXwxV鎪vY5~sI . &dbA@nWFWrUɶeӶIp$BDDZ05|xAoAWW/2,%>AkOy*C`t1)O# lԏz"M ycV4PLpwjdqdʛ%UM>^T7=AW@&5U*ǝ2H޾L9Ayϧ\& o 1 iX ,5v퐾 /BjF,(_m~\3':s' mRWvuAGH x2mZ@6!^k@i4ᎉ^9ѭcx*3G*Nm"֚Έ+"%޼ HH+\LM9D!!`?<'TIwEǩ4XȻқq+ RyEE4sHg٩#1e!(.Qfd ǼY%r mFF-s?S۲J*yS:abFVg?QsჇ~"ӋZȎ^]arڿuK?bf.% r՜G.SCJBt/ Ha˄uQp* gmbA9l_}E҂p`+^=!} ʑ|4 ĵG"nLۯU~J#T4ZzPe֑I䶩 mszuqvWΨR~(.d2[*L'^B古:Sl]!kK Jӭ'͔G^!mԌqbGD圳.{"-Ldxd6\_p0Ly9Q=8x2# 3l4[vtaD A+{T b VrBEBSܠz\\2,{\0KO5Cc>'^'m;:5s UQ21{5]3JZ)3=vܗ'{<5-S,xaĘ^sGv4CLUgy;f ]hG3$:o"0FXati`LT&r=Ix }9~jaM,^1B3Š'LYE{bXG=G |٤Kn E3D9 -Ef(oާk9vw)=ιD+"^dSN[Bye.JΣ.&eUcc@Ҧ>ϕBwtBiK͊M|D9r K#TNgYMPHwK2XVJ"83팼 xUFoc7 JOa93Sݣ>32H9Aü߰H jH"NeJpK(C=K$ĭyt8e"q^ h" fve|*.!h;J7G!1}ۅ3` R[hNyTp5d VTUMyZWTX8SPGp9U!\V q Xy$7n^bCu%O C.UGYfWam%fB,C[n 0w#۠@՝ N;6 x 2*EJWGu1}{y(:XNB3AI b^lZշv߹!|v."Bmaw{ 㡐wE>9JX^ 8`d,ʚQK0+û(evj`56u- VTfijR1 D;p)rB!('r3F|O48L"I!m~YDrӎ5ȟ0*@, XkkeOP7s61),/.aIpܩKvqW e0^CdcIg;Ȝo$#>S5]N1gztp%m,ڲ r,P)l D_ -Wo7 S#\킒ʛ3@jP0-B'"Vi6e+@DR/. ";[8ӱ53Nv|@C(Wz[[e ޸E~r|B7v Gfɳ,xX|* /#MMsYXw4ܤim#ǟ K_(k7:3#pj(*TJSEYU윌 ֵ+ л(Ud7$**ÛBvPSu*x 5:eN ٹhɍ% Ð0a944!cb>Q5(J|{OC\nEyVJ*wo";?5dcNj3:@50s*UJN_-bε"`*17M^JCe :LS":RjqIuP}% m%K'B΃mmv!}|<Ϲ[|C^~V'@T?7KEp!\pG_=Mk D^>1` u1剌֡>6*_ᵠ_'}~ۂAhbi8WFfXp6u WNLP:Xj $UVsvNYQzp.:aCs]Дk'YxeKp;^ Rg3)sfQ]A H8(".*X^I<\Cxi-2:MXN㥛I7JX4M\×&lXfz[8kFh}TuO@i `A-5|K䗞AGD f&:d:qŇY?16L$y6R9KYha%Ph ێ, J&@)n]ۓe0g Mڋ38Oānyrs6Uj[9|R`48$WJIUȅLaQ@V\@P^u v*^jf_B5?Q)S7 n={Ϣ$6)3סk I)mG} )S!o$"#;/$ hPfNS O>aZe<~}2(k^!y_[5cČ3CC1WQ#g#򏫚[F`N7uᗝmq?B|AQ|Aojk˥;Ȑg[{p- ^cӄŐR]BKF;]astKJE=!&#Nn;?elM+ovD>5QSprIHJ3'-ÝX;tr36W'FuHq6qfQ_i`1V8YLjxL4 3?mU̒@wO iYº Oj/JCr -Ajah+@#A ;f9cVE)>(kY`\n@6onUis[)1Zݓ4膡Ѡ}w*B,wYǮY;Zt>|6<~ Cl'W5)$XsyӞ~Z>C]a QY,HS9׹J]Ng8||A$‡wok m׎v,pjlΟgQ'Mtb}w礳եS0JD&wIшd5WN WXyԟÒQ2wBqvg;ԅԒ /j.Nf `/}XZo:)wCڅkORږs7<YHtYZZ0i;l ޕ EHI#_KAJoiz}BoP"S\koY4SB#LZ@,Eտ.1HKy|_Ry|n޺60Sm+QLܟNldOނ(՛G7Sk'g(w:L͸409l|V)T].?;E9OO+Hbrhb+P= /KV@:tpEz@ ][~S# $P"-"zm?H8k {{ihBra_.g˪5Z+%Og–XG7[cXB: S";g$ZTzr^F @ =U9&i1^!Hl٫ty5.x,_I@w*i6g `U;"p!/WmXZj&ylM˥-6U/j{E#̪>&w[]*Ґ9a4&'{8`q s oKm^G/ERs;'DMN|!E3[W3Tc "HA7!-6ݗhϟm TD>z,'Zcmssz_Z_ߪY}{륒T!mR,zPVqz0[vySR1V={h#wAi᠕iKx軯>֩@Y, e% c*MǴhai 3y+0"UL취fLͳC܋͞0+-ZmBB 헻b'wVԤcUoż+!{柰lSHSɻ5ߣUxU~JƎB9QvO!Ϳ+WM˒ngS4\of_F3l^t.f2׆_^_MhK%bb~+-pMm* 5m`P~lV\moWzVU^rb0dR<&xX>FL&NreKcxYm]2!9Pd< ?'( 1H ؏:Ƈqx`U$iU,3|6f/m*(8]w9aD(a"X-9ƘM(i+iFJw5&lhʍi.|15eL]88R`pg\Wwr#Vre[5 o;&vl6ԞPMO/B@X/Ev_1h=BVDκ S>LKF9 ![>ZJQ5{˫0U5`J1Qԣ(!EYu|rT~okydC'֘3R47,$ 7|fOK]cI/-oֺ3Dk]B^NG&ew1ӅJYEXVn= `e%7$?%O1 LUgƎf[Ã|JFlR܈u?v  r@"86z{.Gf5G7e csd/+UP{wq#0 1NFry^( Y΍ h[Ʒȕ,y&g{5!Ru+}F bv :`GECˉC78`P>+/ iD6k^&vw$B&?y* b8jrk)CAjEmIϡYX?޲JHevjmj6Zg#uGf(Uʽ|H ^P'.}wA?e[jRFizT=N+&#iᢂE[:WB7Mr@IǜZVnl;چPBp+e @dHV_ؐ+CeҶmͥ|QO4ā[.&>[]"; G ɄЏԱ WK;} ;E>K_FIEZ-vq4N*ȵ}s|B=)BBfhirվR-$%C:{v(ԄGz3o~d2]GQNm~"Up_ (eX4Ȣ䏖]zDҐpwgH1EAm':.{o7A6=(8 j{KCPSUެCҏ2so uVKہYOm<(1\fLlߚ^&UJ IBhdцIu},mb<wcs$¤.`q[X*a ĥpW(ַdܶFt16Uo~C@5܆9^,rѤI,.BG_ˏB;bcU2 <嘣UlzhzKɕ.Kj8l_T"j7ahRc Y׏skcrQb&d] b JUrd؟z:5C^BH>in!I?ڧ {BQB_fwq R갽P}( 5$7n*U4N w_n7# f@#a!{!r1f]WrgW(Tv8ˎ3 ? cv &L3E]~$ŴR'4tk?% LbDdk$kGtgQDe7Oż&3%N,f_cB b0\gdXj 0w{5/MN{qY0>DU'Q?8 (Pe!,`豅D(K*ǜ,S|GHBJ2 qBǿ{eF¿Cԏ}RpMt=*1"XƝ:!EmՄYݟ,b uڏ]1ML)߇LhKi|cDBr/wS">WoSyK "clG= 埽qv3WR3܋,``_SctF~Ϋ;WGDj&=|baw'3J;vKkOf<<O@se>)>;S%Li(yئA8 81]wͣ/qZ-~"J} O^E*?àVqD LE=ꌟu5,{2 qq/RMfY!?BgU y x'- m։wy ü[$kVx%ed1E& _$DĤ ^W/C︆ H)Ժz |ݬ K{a3m`/^8B҄p{ qKΖyzڧ^c9UѺ9 '\ A,#wڌσKqI=jipHܸ_JaNK=}_ 5G*>fiHq*D&Ad@scA4͞ ',, Y +NO޴aSPТwWR_m=F !uꛠ쫭^1<-VfW;SK! 29$&4^q~h+]p;w1孍ذؑZt*q00?xt< :! |}QmӣCy49r4I- p &(Q.̮K${`Zl?/ x{Du+~)z,ݴ{I=W:rpV KFRSA-[(‚1H c?$PeTښN#y74Tz7&>:;X>+.2_Q\ph/>T{>wF$U\D!촇c0ff{"(D R .ض7G_Ƒ4z-4v%_wc A֎alo.т؜!)̡XvvaW`4,7hoLf Y0w _w5~b Al}C7J nDYc?Kٵ!cZHұ\>6FWcH:C-RJtNԡ|( u]w p,]$T\%pXF}Zfi-aV>̦׵&O%5E<;|lnҟ{n̯i a6};\.D6htƄ*8n8!=ƕGJTkU[ nx(g7  V^5^F=ּ[9ymMt+ʢBPt(t~vMB]Ǿ|KV|6%_jY0YMZE;t4QvRFW^1DQ+###:y:]I?EIR=D3Pw@V~0`M2JwV9_ArSJP3F~JvQq?! jVݢЮVese#;KC%CCf>1&o|N皲=C}rXzUQsGp-NۜHḿ8^҅V,fmw/ <=qICҲv~\sysohƹbV@K+&~E㐀ƎfABofčpd7 G8jtS6f$K99t~uxTI;>Db㾴__8Dd:Rc[803Ij)hb5)Zߏ& }"q^R-P^%txtfkvb7i1 8Q!}f~1n'<{nc&b6h^oTH5JlEq#UĥOh,+rA p{9li/8٧=fVY~4{{E4PF$]p%Rۂޗ$g 8&ĝVCBx|8O"=5] mWG+:fѡԶ+Mq=?wL쵶 ~ʼn[m[*Zi# zFlV`Qb*nz}:}Wp9D 1k,g>ѹ!Umd8WixV?ҌtmԞ6pIG:zc4&q3WvGH[F vJl^ODc(W&=/jbe'H% R 4P˱zʞS 7ݛGHzyZTɭ予:(k5 2C|q*?ԙ#r92qB>Xw~c|W;o2j*E&FL;}; kq-UAq?تɨ7jkR8J/XDQwM!q*3w'^]eT7]cfCnGq/JTN!09M@Wo]S̍~Ճ{>[o4zv:hY6XΉl o " ;6$ڬN0Sk5 ghC9C|¤, czIv1\/qڝS~ͷRА$!́J!/;!cc _cG.1#W^ג H{l9ڢXH^F [g_גn>\F[plD35 * Ts..ߧh+5% aD.Z-![-)EkKqN@FrgD~~c$J} [~ `3İ0$B b|BYzSU޸Rv`VdNz-vR|$e"bSu̳xw.@W2(BaM9fE3Msi>+N@ou ˦XL%h<9pA)<(OðzlBV(cMDHaO|eLC{z幵GA?|x]<\XZtw&RЌV%e<<@ HE@’. [z1F*~u cj*M? \Al|<} ??aQIO4`.h&j0ߧܦ,[rATt7 Gꮲv;ŀ͟"5 ſJtǎz+Ia*q3EZuhQ]׎vO`yVl1Y@ˤG_LHvnIe/IUIf\3X%GպmOY-[r?xS){Ic,u(nDk}"D bET|X9!a-V$ _w#\{,o'}Pg\ O($P ûT6 p䣯~k/_GE42(;O*6g4 ;v2'/quDϥ rǓ"F߼y=y(2A:4b$}SiZ8P2 :xw݇ xQou`,ׯZJʋ5[AJ%1Fp>0݉T$BBLٗo"0+z|7B{*O@>^lCyFfSleeRn S"Pt_`l 9a ,ׇtzpfaoM4avo>$sNw9IS[-Fn"3!C9W& s/Ou8Gs뢤ɮJi1S8c-cd\8p;@|!=  >t?j)bD)Vt"zx)8Xv3fwn<7THsd3*WۄDC2 _$GUV;>QƜ$:68wz?)`\pj뼶bI5kTh_8t 7T$?]Faxsӈ#HR"vWn#T#).?y`L&F~E}L͚w"R~ݒ}+JsqO\s{n$kؤT>zyV7vWe~WRӸ|3` qr:J?"J_b˧ݯ0To¹bI$řp0:Ylv; +od8H.9MQvG1'a<݅_U\k=`>S+Tr*zGuζ[ ctqJ t '@(AOw{wzt̻>s6t?u}T )չ%/knYYq2WKxq>Ƽ_O`ڠ.P;9i.5j5sd10\Mgt c_Ϙn+# K  @4*{ M%%5S Tdmfcp#mMX*j0U)#{n̬GKMWPBޛך!O TvpSR@*:l EzjA`}kuFj&_BRle[{-/Cv~G^po|pū<"KJu@х#8rI$r5nNW]>*v#"&=R(cL'U+(Yr+#))cK+%L6|aުU 0#*{l*[{aw@nRZ;h(уbzjୁ xiV'(%iմ(6X[2S5(߉ޢA]nv)a8 QAYugOb1Gَ'uqJ,`32&GLdʾˣP,<̰D8P'b)ɏ畮$qj% @d*4^\/b~X֨]>,vH|73y/Y0YvhG _(X?9Y-9ľԙW5<1frdjn%۽ 5 lm\;Jֻ׽X }ЄK?diZ6Mkq*kf(-QNX*FY+ c~cUM3a/)5]};;S"#aJn rMF]r+@,[;h\B،dxՁjUܺsC rsk OKfa1 nA-7N2쯸uY(⩡ﶖYRfT =.uwWSnlccrs FnܽWirA-6d BdSınFـJpRZ+~3iޮlTl&yrTAvʒ4W*\1Ti;F{{n9dQK0"IrrJRwLZo_/?fR/fT<^l/K88GNu59LglB"Ǔ+ɲuO*x0qgM0JKUkIz`Ęh.G> ^D;? vTX<ʋ%A\MOr$,zi|9>2qqBC-MP '#ͶfSV@IX MٟSEMJ!!W u~>%쐗Fi wqCD al_2b5.FdDFH5d% 83RӏL;#8KiP7#Emu@Nn8 zoΦt0 ilpXuNXZ;QQEQ7.Ni=hzXHe#&[~Ĩ=|H쿠wi\.w0:=)=΃P4)5 NdA,2`?GGTq\Y@T׬ nvpA%B`6c9. ]N=y/Df tgys+ؔ&|+{3_.գxT?FLvmn4cTGrd^ 4in zQE=.WrߖgrOŁ~VVhî56$]t|e_ʗqQhRkI~Ќ8M6Y{yTŴ&Ru28Yzw&W2bB,N6$Wvm@IW ޑ@5KrjH ^iXyGӪq;)!mb*MV=c&ӂA:hvmUiƋL;<Xr,\Mj~Mm g-ǝʶj_Z@O1fN=]G4vhtgΞ}21)arAr\(1fk^b?1W0,"7[OƐЩ[1(A伅)V+8wWÀ}fvLq^&7?f*qõ ݖΣ[3ypI4 q9ifbw:M!1, yl$6Mskrn\b݀-G$KMys^Du֙ 7Z* {dSqR. %*+soUn;e/ewq3(N.QbaV3˃"Bہ6i7O'r4$4EVzޛȪ-^_3S[Y,l?N.ѵ`jN-EndƧ(M)M#6J?>&FPkLKh}\̝{l .`G{ʼnDv˷z[vvCؑptrb? ;#C<kooP} ƺn#粰Xg. LgJ:a3+R4 Bb1oѢ];mL"ܴS11OMI( /E~L P ջBUJmo_Nhcg y"=kQm6#6PAyvj.a׊5u?XsZt0n͛f)f+M:dbwSXKY4- kp%Lz M*c\ "Ly7`73:U-Nb=y9TW ]ih@QBȆg%; 8J:)u|9?uhP0:/OeSKvs$wSCS$X<5p''U w$g,q`'Cew&ê9LύMN܇Jܟ.2-Ir:v LZ67 BpGGBX,B@{;"8Qn{nu{4N+U !2xhRz iO09nEJ[\˞yJJXc$ELfܫ5%> QMƟ"Aqȑ0BKkef vֽ8w{Drμe{(ola.:mV+EHdzl/nL^ZkuH*鏢l/\ŽlQ6/ǟvZϓ(gW/>H.^9*X4\Щݝ;P9NcmWy{cw}mu ܑԝHly6`7#U֏G#'h6~p2 ZFzi̋ ةYach•>Xț񰥏4`2:谀+ z(<ݑojaBrѫ/+cstM6y Z5?eYk[vݳ'ɟ_4xSբ+s07)άiF!MClesBm14滱iw~$A &9M{U(M X]۞xl7›FIDcNR{ d}uo |X6͒ d5 G+\V& 72S,1 :0Q,ֈ?쐨>kG);€MoDW. \llEhLh@ye|'daًͯΙHxAsit `pRGXzJڕ^y6 E|Y--rZ qA5wq3̷xvsʍ*9QͿ+ o;FɪW }_$k$W(&ӡer;'*+*`yI_jxT WLwˮfgx.|vTOʊeVJa+ jU7KȺT92N&|EKGCv4LR"PhՐ"Ux@lw ɔ;L92E h2y;h==hi֧ǼKLۛZ!XRG΃CIMσh[9]VY@-u!,wH ,BgvTߧIl+QG U ^Z:"]/Fq èbVVLJW0zq1-Η{趥`)|,LUg|!.[m[}wDwQ/X J+ȁ U` U50Z1DMJ}7ߤ?)eWT*C{ɶq4{5&2wOO;,3-L[s-rKM3 -um}QpT} @f,pbw5?-bKg0Qorװ%ܲ,PipUPg?s|Y{J\z3i!G֩[w(rM j a<4*|9.()+PXp _0^7 SiATN5eڟDc@:=TJr5mDU:{3_bʋL3BAN#FNgD؍6= M?-uGGL׮='=қoʄ-G4AsZHVPp]FPu`]X[Q^\hc<eNNN\ŏOcqh Nu22ެ/5yF_-%*Vr"V'90WdRiFff?xv-AkÁ[aX4'K%~)M;*ŝ&AEMX`4o}Ӆnf suwQ1.v I/SB}}͇ eūju@ʹzI"1wEWnRM~B M!o2A)_wp@ >yt`у~QjPDqslRj@`Dg{Q6o^O#ީK&? ?ȴ%ޜl&-_$@?]I&TݠkѯoڅÄD bUM !tDSg[Cd?i-՝b>-x(3vT]Z Z6h'4TI6H/0K8jSHbG2ą7v]VӬSRa[<7MJZw]nʟw01(GgmrU1g`~xE k 1} l՗;Q gBnoE'?U(},ܮ15ozGi=BNm#f~^7Ã̲8HQߌt;]M~=SLРΩǂ`r]Bd8H΋欓evy~l 5n|t˪FNõ:cmwctsH!;{1޼$||8'GqN ;d|ev)]EQh"6k| PW)ɞb:b|ήHy5d'ò$O#@)ji.6L6rn;RJ!8)x.GKd>|ۖ5hʜp@ !* ɞ:y!ck˒Q[HUiܦB*p DH-(\_( &\ `;v!FHƛ~TwL}9-ܭYY;9Tl pQs,ǶP`H= i =-t'k4"&>6̰؍D$xYq?ޞs}K8-T,ėr+t[ܖMڤ=0WIP-DPp[eM?8 켎ga Hx]wb.M4Pk m.4ڲ}F^HQ+uR 1%ehdN&-VR[D?A/{&+d3mc[úNBXQ^MOdpL#$RRKw lLC$] S-_U-kydF `Xߌ0T^GV4Y}0_Xibe L Ց-c]r4ўvKW.8Pp d&{^Ha6}ZƋKޟz\f!vHX "4K53#p+T|Q l,r7+' ri̩hz(f4L(>]&nP [g-±Zu~Iii4 Sjfk@̨ @Z@ )Bu[}zrqO݊AoݘXF>Ys4O^)[BCQ  @$>]TwyE*W}߈ 0L^#C/4ATD5GgC+LemYn@']PDvNn M76D4e4#YQT;mݩ~ 7rX2n ݆I]l{vvV5] lZv{ʶo?j}kKxT\' 7}+KLr8R_RrWLM^0)#4'5Yt~E+8 :{s.O8񥉺c3P-OF dm'|"g۠vŽ9@Cp]L(E9&i /Uxi4wg JEhԂ\ʬlJ'Pővcm}gHW[:%>>@{=5.}wb/F2|va!0O X'& w3؅IUmO27ޯdw-\dޙ(Oɮ侔$/>i&w|Bx7q\3>)cw 0^#T-`D- -V1bgv ŹE#0HQZ]`\=ǟ)rNb*WIT1"AY+Q=)=#\˦m2Ec±kr дr lpc>"b|5/?m9!XJd?,~ڊD/[9M/ / dq[D}1P*e( c grn/4tQWd7?iu#?I%[U*eHf뛹U}ό)> v}YC%eGѕfKN}Z{3 gܩտ& _ݧUy+*dTuK(Y4WX:niLw/5_^KbaI1]ڴ{ ^GL $G^Pa6P&&^0b΢p#`%}3Iޥ>HrXZkiLzlKC{lsZ@dHrx f《}̣k`!~(AYX wfۙ) ep4[ "FkCg9!Sdոx.bms|YQy֥0,iP\ݒ{&UI("4umk4[=`M^&IX BvܷԪaXY-7I{4GF Lp͌.!3;4+Ds?>Њlz?M]~GGYs9 Y_P$re-MR-nRHdbO=»kT B)#cL|*N첀|J8IN*¹ YW1w+~&,ʘ⌦co.ͤjcKj.L!miWtM@g$ɲ>JŞ'?|[Ìxq +y$gf܁Blɷn16ܙ4-r@ݞd<=GLL!'eٙ ]u𽡦<*_×yfYn/953"m吐SHE' Q@0~x:ړs6pb,}M=`i\JAǭ[q\fd3(k#'3M>t =ifnd!Pt/):)N5>0 YZwaveslim/data/blocks.rda0000644000176200001440000000025714627073455015000 0ustar liggesusers r0b```b`fab`b24# 'fKO.f``)8 uiQ*sң4`o΀QzG;Âf2-004(mtH  459'@d*a\iwaveslim/data/nile.rda0000644000176200001440000000176114627073455014453 0ustar liggesusersBZh91AY&SY1nuDDDDTDDTDneLDLGDDDDDDDDDDDEPiP^LOBzOSOOS5d=0@ #E<4AfmM4@@= zHdшhb 2F9F@4h!F#CdIBj4bd 12@@h HԀRk\o?%h$NOq Lv7c-]A"VcxW遁hv x YTv*${X rVKI!dZ ǭAT8x;y&_a":^a?`}v~W D=9vlw+gB ND 'K Q檲4߶Cz#KQAYi^eʻ8: S z^BBo5xs*cP1eWu%Cd93(sؿjZYSPv*%E_>7>!l _Rh>,P\jf*|xyOS"gk _3юΏ{*_݆f& :) }GDe?W),}0oʟYǃX[ir;igl ~!xeFb `4dd秽06v׃Y^0MuU`HhRڶtۤC"4XW{J3} ou]Y*p(ޝU ܗpbdՖ@,tb:6c Nޭ/5BBp$Ӌ1{ ,Pe`cMw*ity{ah̽q0l=FjˮeNG%WBx_}_#Lb]_*!)[6t ,ʲxvlZە m o`wܗ68\inƫky)"]+uHEF@"+XU-gF(EB'anBK_a_I$fnʺ{̶hEzz|dXyy7{᧑6fc+0/_fdf, 6Dïh+/>&*2_.ORaC/`׉/KuX!B5)v@!8w?}}[fot=􅙟oW&k Au5Mc~"Q=8gbs=g՗_E g@@$ K‘lvcn+^^i3T=ؽ]]'D+V>B\RhXX6 4N\?7A9J4'- k? *\ Z!8( m?,0HW.~a9?02H 9J!d`ueOq|CeCeJ,Ri\kyS#JȂQ-}"; p{W5pF T`|faMށF"XP8OeK~-9EL34 z7`Iv/#ЍRa62>17# jo# 4?^=>utP8[R@uoDAv .ҙ..;}4(>B:KDBC~Q0]| +~r-{7JR@ _' CO6淓8W2]Rjq@۶3y\-*^;k"Å]G4.A;s6ӪZu!>Yve5Ҵ# l鼩;)@}zD1GP'+\ kU#G"s#: gUAi{?.N4w>DOS*FF\\>~J㐐Ο?s#4#i]CUjl0~Mٵ@XD̦$|=H4 9z!6&P=(WM u\Ϻ{pu [ta}'OM^&,,-Ul> n Q!j*p6դ7@OFh4 {:l$IȤ$]Z|16 nz4i5f@ ^Q6RB&P>dX$p,S{ecғcWCgtqee9m0VEEOcTB,~*[MMC#S hwM<;uUh+i6MC}N8:Y{"WnM2[oqr#6;obZ5hG&fdn8ՙ ާ"Ym m bI}fp%-[:nDjx4tW;wO&fјF@.="S#150;v٨y)h#-`w5/z݃٫_#oceUЭ#+ן3m{_z""Ճ,(/PW I)=J/Go:&5EVHzd3cHQf-L\Id($%Ay3A : Mɧ"U~F+M$Xp[,`b{R :0\6_jCs n<~6T#%jwx0\\,`^]Y{Tжw@N:M}wuylH#h{F !6H!hu4ˬ>by8+4Yk˖ͻGm @BRW 0E--yG'$#H%1.|L '}<{rAَJ$csnFtR1$Jy(CˆD޻vOvp}6ma (k]T.z9O[ief]'ښ},^溵Ѥ';x(w/p:5vm-ҫH;Ps|TO; !BYo6 EsŬ@۸,IQ=_pYwazw9^n*C*!!.(fhgP6䬶)1U,bf+~ -c۸9 nsWod5>\@ Έ[ȎT z:'O-=^=@J Bܻ$U$aF;Sv{:xǕWhgM?_6J:O†J@1Y;LًNdjC%oJ{nFݩ5z y rZV[ScF_o.H]vyON>-"߿W΅Zwaveslim/data/xbox.rda0000644000176200001440000000100214627073455014470 0ustar liggesusersBZh91AY&SY{ i;X:P\X@\EA*jO*45=LOP h0a4ѣb4ɉ4 d@h 0#LL #@Lb4 @44 hѦM $%)RRJ)JR(*QJTE)jXE**%TUETUETUETUUUUYVUUTJQ$cC?6 1FHn$ذG&̱!4T,H"A2"}Zi̤Deaq_Fm+eZ<6jW}[̌?*6Xn+0Mä1@O2&tNӻե̭轕WWaX5~/ɟP=O7Y)U5Ъ][V*iDCJ躬:j0+MaVUZeBBS!*HD#,f)Щ7hM489I"p ܑN$#waveslim/src/0000755000176200001440000000000014627406037012701 5ustar liggesuserswaveslim/src/dwt2.c0000644000176200001440000002674614627073455013750 0ustar liggesusers#include #include #include #include #include "dwt.h" /*************************************************************************** *************************************************************************** 2D DWT *************************************************************************** ***************************************************************************/ void two_D_dwt(double *X, int *M, int *N, int *L, double *h, double *g, double *LL, double *LH, double *HL, double *HH) { int i, j, k; double *data, *Wout, *Vout, *Low, *High; // Perform one-dimensional DWT on columns (length M). Wout = (double *) malloc((*M) * sizeof(double)); Vout = (double *) malloc((*M) * sizeof(double)); // Create temporary "matrices" to store DWT of columns. Low = (double *) malloc((*N*(*M/2)) * sizeof(double)); High = (double *) malloc((*N*(*M/2)) * sizeof(double)); for(i = 0; i < *N; i++) { // Must take column from X and place into vector for DWT. data = (double *) malloc((*M) * sizeof(double)); for(j = 0; j < *M; j++) { data[j] = X[i*(*M)+j]; //printf("X[%d][%d] = %f\n", i, j, X[i*(*M)+j]); } //Perform DWT and read into temporary matrices. dwt(data, M, L, h, g, Wout, Vout); for(k = 0; k < (int) *M/2; k++) { Low[i*(*M/2)+k] = Vout[k]; High[i*(*M/2)+k] = Wout[k]; // printf("Low[%d][%d] = %f\n", i, k, Low[i*(*M/2)+k]); //printf("High[%d][%d] = %f\n", i, k, High[i*(*M/2)+k]); } free(data); } free(Wout); free(Vout); // Perform one-dimensional DWT on rows (length N). Wout = (double *) malloc((*N) * sizeof(double)); Vout = (double *) malloc((*N) * sizeof(double)); for(i = 0; i < (int) *M/2; i++) { // Must take row from "Low" and place into vector for DWT. data = (double *) malloc((*N) * sizeof(double)); for(j = 0; j < *N; j++) { data[j] = Low[i+j*(*M/2)]; // printf("Low[%d][%d] = %f\n", i, j, Low[i+j*(*M/2)]); } // Perform DWT and read into final "Low" matrices. dwt(data, N, L, h, g, Wout, Vout); for(k = 0; k < (int) *N/2; k++) { LL[i+k*(*M/2)] = Vout[k]; HL[i+k*(*M/2)] = Wout[k]; //LL[i+k*(*N/2)] = Vout[k]; // Original ones //HL[i+k*(*N/2)] = Wout[k]; // Original ones // printf("LL[%d][%d] = %f\n", i, k, LL[i+k*(*N/2)]); // printf("LH[%d][%d] = %f\n", i, k, HL[i+k*(*N/2)]); } free(data); //Must take row from "High" and place into vector for DWT. data = (double *) malloc((*N) * sizeof(double)); for(j = 0; j < *N; j++) { data[j] = High[i+j*(*M/2)]; // printf("High[%d][%d] = %f\n", j, i, High[i+j*(*M/2)]); } // Perform DWT and read into final "High" matrices. dwt(data, N, L, h, g, Wout, Vout); for(k = 0; k < (int) *N/2; k++) { LH[i+k*(*M/2)] = Vout[k]; HH[i+k*(*M/2)] = Wout[k]; //LH[i+k*(*N/2)] = Vout[k]; //Original ones //HH[i+k*(*N/2)] = Wout[k]; //Original ones // printf("HL[%d][%d] = %f\n", i, k, LH[i+k*(*N/2)]); // printf("HH[%d][%d] = %f\n", i, k, HH[i+k*(*N/2)]); } free(data); } free(Wout); free(Vout); free(Low); free(High); } /*************************************************************************** *************************************************************************** printdvec() *************************************************************************** ***************************************************************************/ /* void printdvec(double *v, int n) { int i; for(i = 0; i <= n-1; i++) printf("%f ", v[i]); printf("\n"); } */ /*************************************************************************** *************************************************************************** 2D iDWT *************************************************************************** ***************************************************************************/ void two_D_idwt(double *LL, double *LH, double *HL, double *HH, int *M, int *N, int *L, double *h, double *g, double *image) { int i, j, k; /* int debug = 0; */ double *Win, *Vin, *Low, *High, *Xout; Low = (double *) malloc((*M)*2*(*N) * sizeof(double)); High = (double *) malloc((*M)*2*(*N) * sizeof(double)); Win = (double *) malloc((*N) * sizeof(double)); Vin = (double *) malloc((*N) * sizeof(double)); Xout = (double *) malloc(2*(*N) * sizeof(double)); for(i = 0; i < *M; i++) { /* * Must take row from LL and HL and place into vectors for iDWT. */ for(j = 0; j < *N; j++) { Win[j] = HL[i+j*(*M)]; Vin[j] = LL[i+j*(*M)]; } idwt(Win, Vin, N, L, h, g, Xout); for(k = 0; k < 2*(*N); k++) { Low[i+k*(*M)] = Xout[k]; /* if(debug) printf("Low[%d][%d] = %f\n", k, i, Low[i+k*(*M)]); */ } /* * Must take row from LH and HH and place into vectors for iDWT. */ for(j = 0; j < *N; j++) { Win[j] = HH[i+j*(*M)]; Vin[j] = LH[i+j*(*M)]; } idwt(Win, Vin, N, L, h, g, Xout); for(k = 0; k < 2*(*N); k++) { High[i+k*(*M)] = Xout[k]; /* if(debug) printf("High[%d][%d] = %f\n", k, i, High[i+k*(*M)]); */ } } free(Vin); free(Win); free(Xout); Vin = (double *) malloc((*M) * sizeof(double)); Win = (double *) malloc((*M) * sizeof(double)); Xout = (double *) malloc(2*(*M) * sizeof(double)); for(i = 0; i < 2*(*N); i++) { /* * Must take columns from High and Low and place into vectors for iDWT. */ for(k = 0; k < *M; k++) { Vin[k] = Low[i*(*M)+k]; Win[k] = High[i*(*M)+k]; } idwt(Win, Vin, M, L, h, g, Xout); for(j = 0; j < 2*(*M); j++) image[i*2*(*M)+j] = Xout[j]; } free(Vin); free(Win); free(Xout); free(Low); free(High); } /*************************************************************************** *************************************************************************** 2D MODWT *************************************************************************** ***************************************************************************/ void two_D_modwt(double *X, int *M, int *N, int *J, int *L, double *h, double *g, double *LL, double *LH, double *HL, double *HH) { int i, j, k, index; /* int debug = 0; */ double *data, *Wout, *Vout, *Low, *High; /* * Perform one-dimensional MODWT on columns (length M). */ Wout = (double *) malloc((*M) * sizeof(double)); Vout = (double *) malloc((*M) * sizeof(double)); /* * Create temporary "matrices" to store MODWT of columns. */ Low = (double *) malloc((*N*(*M)) * sizeof(double)); High = (double *) malloc((*N*(*M)) * sizeof(double)); for(i = 0; i < *N; i++) { /* * Must take column from X and place into vector for MODWT. */ data = (double *) malloc((*M) * sizeof(double)); for(j = 0; j < *M; j++) { /* index = i * (*N) + j; */ index = i * (*M) + j; data[j] = X[index]; /* if(debug) printf("X[%d][%d] = %f\n", i, j, X[index]); */ } /* * Perform MODWT and read into temporary matrices. */ modwt(data, M, J, L, h, g, Wout, Vout); for(k = 0; k < *M; k++) { /* index = i * (*N) + k; */ index = i * (*M) + k; Low[index] = Vout[k]; High[index] = Wout[k]; /* *if(debug) { *printf("Low[%d][%d] = %f\n", i, k, Low[index]); *printf("High[%d][%d] = %f\n", i, k, High[index]); * } */ } free(data); } free(Wout); free(Vout); /* * Perform one-dimensional MODWT on rows (length N). */ Wout = (double *) malloc((*N) * sizeof(double)); Vout = (double *) malloc((*N) * sizeof(double)); for(i = 0; i < *M; i++) { /* * Must take row from "Low" and place into vector for DWT. */ data = (double *) malloc((*N) * sizeof(double)); for(j = 0; j < *N; j++) { index = i + j * (*M); data[j] = Low[index]; /* if(debug) printf("Low[%d][%d] = %f\n", i, j, Low[index]); */ } /* * Perform MODWT and read into final "Low" matrices. */ modwt(data, N, J, L, h, g, Wout, Vout); for(k = 0; k < *N; k++) { index = i + k * (*M); LL[index] = Vout[k]; LH[index] = Wout[k]; /* *if(debug) { *printf("LL[%d][%d] = %f\n", i, k, LL[index]); *printf("LH[%d][%d] = %f\n", i, k, LH[index]); * } */ } free(data); /* * Must take row from "High" and place into vector for MODWT. */ data = (double *) malloc((*N) * sizeof(double)); for(j = 0; j < *N; j++) { index = i + j * (*M); data[j] = High[index]; /* if(debug) printf("High[%d][%d] = %f\n", j, i, High[index]); */ } /* * Perform MODWT and read into final "High" matrices. */ modwt(data, N, J, L, h, g, Wout, Vout); for(k = 0; k < *N; k++) { index = i + k * (*M); HL[index] = Vout[k]; HH[index] = Wout[k]; /* * if(debug) { * printf("HL[%d][%d] = %f\n", i, k, HL[index]); * printf("HH[%d][%d] = %f\n", i, k, HH[index]); * } */ } free(data); } free(Wout); free(Vout); free(Low); free(High); } /*************************************************************************** *************************************************************************** 2D iMODWT *************************************************************************** ***************************************************************************/ void two_D_imodwt(double *LL, double *LH, double *HL, double *HH, int *M, int *N, int *J, int *L, double *h, double *g, double *image) { int i, j, k, index; double *Win, *Vin, *Low, *High, *Xout; Low = (double *) malloc((*M)*(*N) * sizeof(double)); High = (double *) malloc((*M)*(*N) * sizeof(double)); Win = (double *) malloc((*N) * sizeof(double)); Vin = (double *) malloc((*N) * sizeof(double)); Xout = (double *) malloc((*N) * sizeof(double)); for(i = 0; i < *M; i++) { /* * Must take row from LL and LH and place into vectors for iMODWT. */ for(j = 0; j < *N; j++) { index = i + j * (*M); Win[j] = LH[index]; Vin[j] = LL[index]; } imodwt(Win, Vin, N, J, L, h, g, Xout); for(k = 0; k < *N; k++) { index = i + k * (*M); Low[index] = Xout[k]; } /* * Must take row from HL and HH and place into vectors for iMODWT. */ for(j = 0; j < *N; j++) { index = i + j * (*M); Win[j] = HH[index]; Vin[j] = HL[index]; } imodwt(Win, Vin, N, J, L, h, g, Xout); for(k = 0; k < *N; k++) { index = i + k * (*M); High[index] = Xout[k]; } } free(Vin); free(Win); free(Xout); Vin = (double *) malloc((*M) * sizeof(double)); Win = (double *) malloc((*M) * sizeof(double)); Xout = (double *) malloc((*M) * sizeof(double)); for(i = 0; i < *N; i++) { /* * Must take columns from High and Low and place into vectors for iMODWT. */ for(k = 0; k < *M; k++) { /* index = i * (*N) + k; */ index = i * (*M) + k; Vin[k] = Low[index]; Win[k] = High[index]; } imodwt(Win, Vin, M, J, L, h, g, Xout); for(j = 0; j < *M; j++) { /* index = i * (*N) + j; */ index = i * (*M) + j; image[index] = Xout[j]; } } free(Vin); free(Win); free(Xout); free(Low); free(High); } waveslim/src/init.c0000644000176200001440000000466514627077456014034 0ustar liggesusers#include #include // for NULL #include /* FIXME: Check these declarations against the C/Fortran source code. */ /* .C calls */ extern void dwt(void *, void *, void *, void *, void *, void *, void *); extern void hosking(void *, void *, void *); extern void idwt(void *, void *, void *, void *, void *, void *, void *); extern void imodwt(void *, void *, void *, void *, void *, void *, void *, void *); extern void modwt(void *, void *, void *, void *, void *, void *, void *, void *); extern void three_D_dwt(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void three_D_idwt(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void three_D_imodwt(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void three_D_modwt(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void two_D_dwt(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void two_D_idwt(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void two_D_imodwt(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void two_D_modwt(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); static const R_CMethodDef CEntries[] = { {"dwt", (DL_FUNC) &dwt, 7}, {"hosking", (DL_FUNC) &hosking, 3}, {"idwt", (DL_FUNC) &idwt, 7}, {"imodwt", (DL_FUNC) &imodwt, 8}, {"modwt", (DL_FUNC) &modwt, 8}, {"three_D_dwt", (DL_FUNC) &three_D_dwt, 15}, {"three_D_idwt", (DL_FUNC) &three_D_idwt, 15}, {"three_D_imodwt", (DL_FUNC) &three_D_imodwt, 16}, {"three_D_modwt", (DL_FUNC) &three_D_modwt, 16}, {"two_D_dwt", (DL_FUNC) &two_D_dwt, 10}, {"two_D_idwt", (DL_FUNC) &two_D_idwt, 10}, {"two_D_imodwt", (DL_FUNC) &two_D_imodwt, 11}, {"two_D_modwt", (DL_FUNC) &two_D_modwt, 11}, {NULL, NULL, 0} }; void R_init_waveslim(DllInfo *dll) { R_registerRoutines(dll, CEntries, NULL, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } waveslim/src/dwt3.c0000644000176200001440000005657214627073455013751 0ustar liggesusers#include #include #include #include #include "dwt.h" /*************************************************************************** *************************************************************************** 3D DWT *************************************************************************** ***************************************************************************/ void three_D_dwt(double *X, int *NX, int *NY, int *NZ, int *L, double *h, double *g, double *LLL, double *HLL, double *LHL, double *LLH, double *HHL, double *HLH, double *LHH, double *HHH) { int i, j, k, l, index; /* int printall = 0; */ double *data, *Wout, *Vout, *Xl, *Xh, *Yll, *Ylh, *Yhl, *Yhh; /* printf("Original Data (N = %d)...\n", *NX * (*NY) * (*NZ)); printdvec(X, *NX * (*NY) * (*NZ)); */ /* * Perform one-dimensional DWT on first dimension (length NX). */ Wout = (double *) malloc((*NX) * sizeof(double)); Vout = (double *) malloc((*NX) * sizeof(double)); data = (double *) malloc((*NX) * sizeof(double)); /* * Create temporary "hyperrectangles" to store DWT of X-dimension. */ Xl = (double *) malloc((*NZ*(*NY)*(*NX/2)) * sizeof(double)); Xh = (double *) malloc((*NZ*(*NY)*(*NX/2)) * sizeof(double)); for(i = 0; i < *NZ*(*NY); i++) { /* * Must take column from X-dimension and place into vector for DWT. */ for(j = 0; j < *NX; j++) { index = i * (*NX) + j; data[j] = X[index]; /* printf("X[%d][%d] = %f\n", i, j, X[index]); */ } /* * Perform DWT and read into temporary matrices. */ dwt(data, NX, L, h, g, Wout, Vout); for(j = 0; j < (int) *NX/2; j++) { index = i * (*NX/2) + j; Xl[index] = Vout[j]; Xh[index] = Wout[j]; /* printf("Low[%d][%d] = %f\n", i, j, Low[index]); printf("High[%d][%d] = %f\n", i, j, High[index]); */ } } free(Wout); free(Vout); free(data); /* printf("X Low...\n"); printdvec(Xl, (*NX/2) * (*NY) * (*NZ)); printf("X High...\n"); printdvec(Xh, (*NX/2) * (*NY) * (*NZ)); */ /* * Perform one-dimensional DWT on second dimension (length NY). */ Wout = (double *) malloc((*NY) * sizeof(double)); Vout = (double *) malloc((*NY) * sizeof(double)); data = (double *) malloc((*NY) * sizeof(double)); /* * Create temporary "hyperrectangles" to store DWT of X-dimension. */ Yll = (double *) malloc((*NZ*(*NY/2)*(*NX/2)) * sizeof(double)); Ylh = (double *) malloc((*NZ*(*NY/2)*(*NX/2)) * sizeof(double)); Yhl = (double *) malloc((*NZ*(*NY/2)*(*NX/2)) * sizeof(double)); Yhh = (double *) malloc((*NZ*(*NY/2)*(*NX/2)) * sizeof(double)); k = 0; l = 0; for(i = 0; i < *NZ * (int) *NX/2; i++) { /* * Must adjust for 3D array structure. * k: vertical dimension (Z) adjustment when reading in data * l: vertical dimension (Z) adjustment when writing wavelet coeffs. */ if(i > 0 && fmod(i, (int) *NX/2) == 0.0) { k = k + (*NY - 1) * ((int) *NX/2); l = l + ((int) *NY/2 - 1) * ((int) *NX/2); } /* printf("fmod(%d, %d) = %f\n", i, (int) *NX/2, fmod(i, (int) *NX/2)); printf("i = %d\tk = %d\tl = %d\n", i, k, l); */ /* * Must take row from "Xl" and place into vector for DWT. */ for(j = 0; j < *NY; j++) { index = i + j * ((int) *NX/2) + k; data[j] = Xl[index]; } /* * Perform DWT and read into temporary "Yll" and "Yhl" hyperrectangles. */ dwt(data, NY, L, h, g, Wout, Vout); for(j = 0; j < (int) *NY/2; j++) { index = i + j * ((int) *NX/2) + l; Yll[index] = Vout[j]; Ylh[index] = Wout[j]; /* if(printall == 1) printf("Y.LL[%d][%d] = %f\nY.HL[%d][%d] = %f\n", i, j, Yll[index], i, j, Ylh[index]); */ } /* * Must take row from "Xh" and place into vector for DWT. */ for(j = 0; j < *NY; j++) { index = i + j * ((int) *NX/2) + k; data[j] = Xh[index]; } /* * Perform DWT and read into temporary "Yhl" and "Yhh" hyperrectangles. */ dwt(data, NY, L, h, g, Wout, Vout); for(j = 0; j < (int) *NY/2; j++) { index = i + j * ((int) *NX/2) + l; Yhl[index] = Vout[j]; Yhh[index] = Wout[j]; /* if(printall == 1) printf("Y.LH[%d][%d] = %f\nY.HH[%d][%d] = %f\n", i, j, Yhl[index], i, j, Yhh[index]); */ } } free(Wout); free(Vout); free(data); free(Xl); free(Xh); /* printf("Y Low-Low...\n"); printdvec(Yll, (*NX/2) * (*NY/2) * (*NZ)); printf("Y High-Low...\n"); printdvec(Yhl, (*NX/2) * (*NY/2) * (*NZ)); printf("Y Low-High...\n"); printdvec(Ylh, (*NX/2) * (*NY/2) * (*NZ)); printf("Y High-High...\n"); printdvec(Yhh, (*NX/2) * (*NY/2) * (*NZ)); */ /* * Perform one-dimensional DWT on third dimension (length NZ). */ Wout = (double *) malloc((*NZ) * sizeof(double)); Vout = (double *) malloc((*NZ) * sizeof(double)); data = (double *) malloc((*NZ) * sizeof(double)); for(i = 0; i < (int) *NY/2 * (int) *NX/2; i++) { /* * Must take vertical column from "Yll" and place into vector for DWT. */ for(j = 0; j < *NZ; j++) { index = i + j * ((int) *NY/2 * (int) *NX/2); data[j] = Yll[index]; } /* * Perform DWT and read into final "LLL" and "LLH" hyperrectangles. */ dwt(data, NZ, L, h, g, Wout, Vout); for(j = 0; j < (int) *NZ/2; j++) { index = i + j * ((int) *NY/2 * (int) *NX/2); LLL[index] = Vout[j]; LLH[index] = Wout[j]; /* if(printall == 1) printf("LLL[%d][%d] = %f\nLLH[%d][%d] = %f\n", i, j, LLL[index], i, j, LLH[index]); */ } /* * Must take row from "Yhl" and place into vector for DWT. */ for(j = 0; j < *NZ; j++) { index = i + j * ((int) *NY/2 * (int) *NX/2); data[j] = Yhl[index]; } /* * Perform DWT and read into final "HLL" and "HLH" hyperrectangles. */ dwt(data, NZ, L, h, g, Wout, Vout); for(j = 0; j < (int) *NZ/2; j++) { index = i + j * ((int) *NY/2 * (int) *NX/2); HLL[index] = Vout[j]; HLH[index] = Wout[j]; /* printf("HLL[%d][%d] = %f\n", i, j, HLL[index]); printf("HLH[%d][%d] = %f\n", i, j, HLH[index]); */ } /* * Must take row from "Ylh" and place into vector for DWT. */ for(j = 0; j < *NZ; j++) { index = i + j * ((int) *NY/2 * (int) *NX/2); data[j] = Ylh[index]; } /* * Perform DWT and read into final "LHL" and "LHH" hyperrectangles. */ dwt(data, NZ, L, h, g, Wout, Vout); for(j = 0; j < (int) *NZ/2; j++) { index = i + j * ((int) *NY/2 * (int) *NX/2); LHL[index] = Vout[j]; LHH[index] = Wout[j]; /* printf("LHH[%d][%d] = %f\n", i, j, LHH[index]); printf("LHL[%d][%d] = %f\n", i, j, LHL[index]); */ } /* * Must take row from "Yhh" and place into vector for DWT. */ for(j = 0; j < *NZ; j++) { index = i + j * ((int) *NY/2 * (int) *NX/2); data[j] = Yhh[index]; } /* * Perform DWT and read into final "HHL" and "HHH" hyperrectangles. */ dwt(data, NZ, L, h, g, Wout, Vout); for(j = 0; j < (int) *NZ/2; j++) { index = i + j * ((int) *NY/2 * (int) *NX/2); HHL[index] = Vout[j]; HHH[index] = Wout[j]; /* printf("HHH[%d][%d] = %f\n", i, j, HHH[index]); printf("HHL[%d][%d] = %f\n", i, j, HHL[index]); */ } } free(Wout); free(Vout); free(data); free(Yll); free(Ylh); free(Yhl); free(Yhh); } /*************************************************************************** *************************************************************************** 3D iDWT *************************************************************************** ***************************************************************************/ void three_D_idwt(double *LLL, double *HLL, double *LHL, double *LLH, double *HHL, double *HLH, double *LHH, double *HHH, int *NX, int *NY, int *NZ, int *L, double *h, double *g, double *image) { int i, j, k, l; /* int printall = 0; */ double *Win, *Vin, *Xl, *Xh, *Yll, *Ylh, *Yhl, *Yhh, *Xout; /* * Create temporary "hyperrectangles" to store iDWT of Z-dimension. */ Yll = (double *) malloc((2*(*NZ)*(*NY)*(*NX)) * sizeof(double)); Ylh = (double *) malloc((2*(*NZ)*(*NY)*(*NX)) * sizeof(double)); Yhl = (double *) malloc((2*(*NZ)*(*NY)*(*NX)) * sizeof(double)); Yhh = (double *) malloc((2*(*NZ)*(*NY)*(*NX)) * sizeof(double)); Win = (double *) malloc((*NZ) * sizeof(double)); Vin = (double *) malloc((*NZ) * sizeof(double)); Xout = (double *) malloc(2*(*NZ) * sizeof(double)); for(i = 0; i < *NY * (*NX); i++) { /* * Must take row from LLL and LLH and place into vectors for iDWT. */ for(j = 0; j < *NZ; j++) { Win[j] = LLH[i + j * (*NY) * (*NX)]; Vin[j] = LLL[i + j * (*NY) * (*NX)]; } idwt(Win, Vin, NZ, L, h, g, Xout); for(j = 0; j < 2 * (*NZ); j++) Yll[i + j * (*NY) * (*NX)] = Xout[j]; /* * Must take row from HLL and HLH and place into vectors for iDWT. */ for(j = 0; j < *NZ; j++) { Win[j] = HLH[i + j * (*NY) * (*NX)]; Vin[j] = HLL[i + j * (*NY) * (*NX)]; } idwt(Win, Vin, NZ, L, h, g, Xout); for(j = 0; j < 2 * (*NZ); j++) Yhl[i + j * (*NY) * (*NX)] = Xout[j]; /* * Must take row from LHL and LHH and place into vectors for iDWT. */ for(j = 0; j < *NZ; j++) { Win[j] = LHH[i + j * (*NY) * (*NX)]; Vin[j] = LHL[i + j * (*NY) * (*NX)]; } idwt(Win, Vin, NZ, L, h, g, Xout); for(j = 0; j < 2 * (*NZ); j++) Ylh[i + j * (*NY) * (*NX)] = Xout[j]; /* * Must take row from HHL and HHH and place into vectors for iDWT. */ for(j = 0; j < *NZ; j++) { Win[j] = HHH[i + j * (*NY) * (*NX)]; Vin[j] = HHL[i + j * (*NY) * (*NX)]; } idwt(Win, Vin, NZ, L, h, g, Xout); for(j = 0; j < 2 * (*NZ); j++) Yhh[i + j * (*NY) * (*NX)] = Xout[j]; } free(Vin); free(Win); free(Xout); /* printf("Y Low-Low...\n"); printdvec(Yll, (*NX) * (*NY) * 2 * (*NZ)); printf("Y High-Low...\n"); printdvec(Yhl, (*NX) * (*NY) * 2 * (*NZ)); printf("Y Low-High...\n"); printdvec(Ylh, (*NX) * (*NY) * 2 * (*NZ)); printf("Y High-High...\n"); printdvec(Yhh, (*NX) * (*NY) * 2 * (*NZ)); */ Xl = (double *) malloc((2*(*NZ)*2*(*NY)*(*NX)) * sizeof(double)); Xh = (double *) malloc((2*(*NZ)*2*(*NY)*(*NX)) * sizeof(double)); Vin = (double *) malloc((*NY) * sizeof(double)); Win = (double *) malloc((*NY) * sizeof(double)); Xout = (double *) malloc(2*(*NY) * sizeof(double)); k = 0; l = 0; for(i = 0; i < 2 * (*NZ) * (*NX); i++) { /* * Must adjust for 3D array structure. * k: vertical dimension (Z) adjustment when reading in data * l: vertical dimension (Z) adjustment when writing wavelet coeffs. */ if(i > 0 && fmod(i, *NX) == 0.0) { k = k + (*NY - 1) * (*NX); l = l + (2 * (*NY) - 1) * (*NX); } /* printf("k = %d \t l = %d\n", k, l); */ /* * Must take columns from Yll and Ylh and place into vectors for iDWT. */ for(j = 0; j < *NY; j++) { Vin[j] = Yll[i + j * (*NX) + k]; Win[j] = Ylh[i + j * (*NX) + k]; } idwt(Win, Vin, NY, L, h, g, Xout); for(j = 0; j < 2 * (*NY); j++) Xl[i + j * (*NX) + l] = Xout[j]; /* * Must take columns from Yhl and Yhh and place into vectors for iDWT. */ for(j = 0; j < *NY; j++) { Vin[j] = Yhl[i + j * (*NX) + k]; Win[j] = Yhh[i + j * (*NX) + k]; } idwt(Win, Vin, NY, L, h, g, Xout); for(j = 0; j < 2 * (*NY); j++) Xh[i + j * (*NX) + l] = Xout[j]; } /* printf("X Low...\n"); printdvec(Xl, (*NX) * 2 * (*NY) * 2 * (*NZ)); printf("X High...\n"); printdvec(Xh, (*NX) * 2 * (*NY) * 2 * (*NZ)); */ free(Vin); free(Win); free(Xout); free(Yll); free(Ylh); free(Yhl); free(Yhh); Vin = (double *) malloc((*NX) * sizeof(double)); Win = (double *) malloc((*NX) * sizeof(double)); Xout = (double *) malloc(2*(*NX) * sizeof(double)); for(i = 0; i < 2 * (*NZ) * 2 * (*NY); i++) { /* * Must take columns from Xl and Xh and place into vectors for iDWT. */ for(j = 0; j < *NX; j++) { Vin[j] = Xl[i * (*NX) + j]; Win[j] = Xh[i * (*NX) + j]; } idwt(Win, Vin, NX, L, h, g, Xout); for(j = 0; j < 2 * (*NX); j++) image[i * 2 * (*NX) + j] = Xout[j]; } free(Vin); free(Win); free(Xout); free(Xl); free(Xh); } /*************************************************************************** *************************************************************************** 3D MODWT *************************************************************************** ***************************************************************************/ void three_D_modwt(double *X, int *NX, int *NY, int *NZ, int *J, int *L, double *h, double *g, double *LLL, double *HLL, double *LHL, double *LLH, double *HHL, double *HLH, double *LHH, double *HHH) { int i, j, k, index; double *data, *Wout, *Vout, *Xl, *Xh, *Yll, *Ylh, *Yhl, *Yhh; /* printf("Original Data (N = %d)...\n", *NX * (*NY) * (*NZ)); printdvec(X, *NX * (*NY) * (*NZ)); */ /* * Perform one-dimensional MODWT on first dimension (length NX). */ Wout = (double *) malloc((*NX) * sizeof(double)); Vout = (double *) malloc((*NX) * sizeof(double)); data = (double *) malloc((*NX) * sizeof(double)); /* * Create temporary "hyperrectangles" to store MODWT of X-dimension. */ Xl = (double *) malloc((*NZ*(*NY)*(*NX)) * sizeof(double)); Xh = (double *) malloc((*NZ*(*NY)*(*NX)) * sizeof(double)); for(i = 0; i < *NZ*(*NY); i++) { /* * Must take column from X-dimension and place into vector for DWT. */ for(j = 0; j < *NX; j++) { index = i * (*NX) + j; data[j] = X[index]; } /* * Perform MODWT and read into temporary matrices. */ modwt(data, NX, J, L, h, g, Wout, Vout); for(j = 0; j < *NX; j++) { index = i * (*NX) + j; Xl[index] = Vout[j]; Xh[index] = Wout[j]; } } free(Wout); free(Vout); free(data); /* printf("X Low...\n"); printdvec(Xl, (*NX) * (*NY) * (*NZ)); printf("X High...\n"); printdvec(Xh, (*NX) * (*NY) * (*NZ)); */ /* * Perform one-dimensional MODWT on second dimension (length NY). */ Wout = (double *) malloc((*NY) * sizeof(double)); Vout = (double *) malloc((*NY) * sizeof(double)); data = (double *) malloc((*NY) * sizeof(double)); /* * Create temporary "hyperrectangles" to store MODWT of X-dimension. */ Yll = (double *) malloc((*NZ*(*NY)*(*NX)) * sizeof(double)); Ylh = (double *) malloc((*NZ*(*NY)*(*NX)) * sizeof(double)); Yhl = (double *) malloc((*NZ*(*NY)*(*NX)) * sizeof(double)); Yhh = (double *) malloc((*NZ*(*NY)*(*NX)) * sizeof(double)); k = 0; for(i = 0; i < *NZ * (*NX); i++) { /* * Must adjust for 3D array structure. * k: vertical dimension (Z) adjustment when reading in data * l: vertical dimension (Z) adjustment when writing wavelet coeffs. */ if(i > 0 && fmod(i, *NX) == 0.0) k = k + (*NY - 1) * (*NX); /* * Must take row from "Xl" and place into vector for DWT. */ for(j = 0; j < *NY; j++) { index = i + j * (*NX) + k; data[j] = Xl[index]; } /* * Perform MODWT and read into temporary "Yll" and "Ylh" hyperrectangles. */ modwt(data, NY, J, L, h, g, Wout, Vout); for(j = 0; j < *NY; j++) { index = i + j * (*NX) + k; Yll[index] = Vout[j]; Ylh[index] = Wout[j]; } /* * Must take row from "Xh" and place into vector for DWT. */ for(j = 0; j < *NY; j++) { index = i + j * (*NX) + k; data[j] = Xh[index]; } /* * Perform MODWT and read into temporary "Yhl" and "Yhh" hyperrectangles. */ modwt(data, NY, J, L, h, g, Wout, Vout); for(j = 0; j < *NY; j++) { index = i + j * (*NX) + k; Yhl[index] = Vout[j]; Yhh[index] = Wout[j]; } } free(Wout); free(Vout); free(data); free(Xl); free(Xh); /* printf("Y Low-Low...\n"); printdvec(Yll, (*NX) * (*NY) * (*NZ)); printf("Y High-Low...\n"); printdvec(Yhl, (*NX) * (*NY) * (*NZ)); printf("Y Low-High...\n"); printdvec(Ylh, (*NX) * (*NY) * (*NZ)); printf("Y High-High...\n"); printdvec(Yhh, (*NX) * (*NY) * (*NZ)); */ /* * Perform one-dimensional MODWT on third dimension (length NZ). */ Wout = (double *) malloc((*NZ) * sizeof(double)); Vout = (double *) malloc((*NZ) * sizeof(double)); data = (double *) malloc((*NZ) * sizeof(double)); for(i = 0; i < *NY * (*NX); i++) { /* * Must take vertical column from "Yll" and place into vector for MODWT. */ for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); data[j] = Yll[index]; } /* * Perform MODWT and read into final "LLL" and "LLH" hyperrectangles. */ modwt(data, NZ, J, L, h, g, Wout, Vout); for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); LLL[index] = Vout[j]; LLH[index] = Wout[j]; } /* * Must take row from "Yhl" and place into vector for MODWT. */ for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); data[j] = Yhl[index]; } /* * Perform MODWT and read into final "HLL" and "HLH" hyperrectangles. */ modwt(data, NZ, J, L, h, g, Wout, Vout); for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); HLL[index] = Vout[j]; HLH[index] = Wout[j]; } /* * Must take row from "Ylh" and place into vector for MODWT. */ for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); data[j] = Ylh[index]; } /* * Perform MODWT and read into final "LHL" and "LHH" hyperrectangles. */ modwt(data, NZ, J, L, h, g, Wout, Vout); for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); LHL[index] = Vout[j]; LHH[index] = Wout[j]; } /* * Must take row from "Yhh" and place into vector for MODWT. */ for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); data[j] = Yhh[index]; } /* * Perform MODWT and read into final "LHH" and "HHH" hyperrectangles. */ modwt(data, NZ, J, L, h, g, Wout, Vout); for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); HHL[index] = Vout[j]; HHH[index] = Wout[j]; } } free(Wout); free(Vout); free(data); free(Yll); free(Ylh); free(Yhl); free(Yhh); } /*************************************************************************** *************************************************************************** 3D iMODWT *************************************************************************** ***************************************************************************/ void three_D_imodwt(double *LLL, double *HLL, double *LHL, double *LLH, double *HHL, double *HLH, double *LHH, double *HHH, int *NX, int *NY, int *NZ, int *J, int *L, double *h, double *g, double *image) { int i, j, k, index; double *Win, *Vin, *Xl, *Xh, *Yll, *Ylh, *Yhl, *Yhh, *Xout; /* * Create temporary "hyperrectangles" to store imodwt of Z-dimension. */ Yll = (double *) malloc(((*NZ)*(*NY)*(*NX)) * sizeof(double)); Ylh = (double *) malloc(((*NZ)*(*NY)*(*NX)) * sizeof(double)); Yhl = (double *) malloc(((*NZ)*(*NY)*(*NX)) * sizeof(double)); Yhh = (double *) malloc(((*NZ)*(*NY)*(*NX)) * sizeof(double)); Win = (double *) malloc((*NZ) * sizeof(double)); Vin = (double *) malloc((*NZ) * sizeof(double)); Xout = (double *) malloc((*NZ) * sizeof(double)); for(i = 0; i < *NY * (*NX); i++) { /* * Must take row from LLL and LLH and place into vectors for imodwt. */ for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); Win[j] = LLH[index]; Vin[j] = LLL[index]; } imodwt(Win, Vin, NZ, J, L, h, g, Xout); for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); Yll[index] = Xout[j]; } /* * Must take row from HLL and HLH and place into vectors for imodwt. */ for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); Win[j] = HLH[index]; Vin[j] = HLL[index]; } imodwt(Win, Vin, NZ, J, L, h, g, Xout); for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); Yhl[index] = Xout[j]; } /* * Must take row from LHL and LHH and place into vectors for imodwt. */ for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); Win[j] = LHH[index]; Vin[j] = LHL[index]; } imodwt(Win, Vin, NZ, J, L, h, g, Xout); for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); Ylh[index] = Xout[j]; } /* * Must take row from HHL and HHH and place into vectors for imodwt. */ for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); Win[j] = HHH[index]; Vin[j] = HHL[index]; } imodwt(Win, Vin, NZ, J, L, h, g, Xout); for(j = 0; j < *NZ; j++) { index = i + j * (*NY) * (*NX); Yhh[index] = Xout[j]; } } free(Vin); free(Win); free(Xout); /* printf("Y Low-Low...\n"); printdvec(Yll, (*NX) * (*NY) * (*NZ)); printf("Y High-Low...\n"); printdvec(Yhl, (*NX) * (*NY) * (*NZ)); printf("Y Low-High...\n"); printdvec(Ylh, (*NX) * (*NY) * (*NZ)); printf("Y High-High...\n"); printdvec(Yhh, (*NX) * (*NY) * (*NZ)); */ Xl = (double *) malloc(((*NZ)*(*NY)*(*NX)) * sizeof(double)); Xh = (double *) malloc(((*NZ)*(*NY)*(*NX)) * sizeof(double)); Vin = (double *) malloc((*NY) * sizeof(double)); Win = (double *) malloc((*NY) * sizeof(double)); Xout = (double *) malloc((*NY) * sizeof(double)); k = 0; for(i = 0; i < (*NZ) * (*NX); i++) { /* * Must adjust for 3D array structure. * k: vertical dimension (Z) adjustment when reading in data */ if(i > 0 && fmod(i, *NX) == 0.0) k = k + (*NY - 1) * (*NX); /* * Must take columns from Yll and Ylh and place into vectors for imodwt. */ for(j = 0; j < *NY; j++) { index = i + j * (*NX) + k; Vin[j] = Yll[index]; Win[j] = Ylh[index]; } imodwt(Win, Vin, NY, J, L, h, g, Xout); for(j = 0; j < (*NY); j++) { index = i + j * (*NX) + k; Xl[index] = Xout[j]; } /* * Must take columns from Yhl and Yhh and place into vectors for imodwt. */ for(j = 0; j < *NY; j++) { index = i + j * (*NX) + k; Vin[j] = Yhl[index]; Win[j] = Yhh[index]; } imodwt(Win, Vin, NY, J, L, h, g, Xout); for(j = 0; j < (*NY); j++) { index = i + j * (*NX) + k; Xh[i + j * (*NX) + k] = Xout[j]; } } /* printf("X Low...\n"); printdvec(Xl, (*NX) * (*NY) * (*NZ)); printf("X High...\n"); printdvec(Xh, (*NX) * (*NY) * (*NZ)); */ free(Vin); free(Win); free(Xout); free(Yll); free(Ylh); free(Yhl); free(Yhh); Vin = (double *) malloc((*NX) * sizeof(double)); Win = (double *) malloc((*NX) * sizeof(double)); Xout = (double *) malloc((*NX) * sizeof(double)); for(i = 0; i < (*NZ) * (*NY); i++) { /* * Must take columns from Xl and Xh and place into vectors for imodwt. */ for(j = 0; j < *NX; j++) { index = i * (*NX) + j; Vin[j] = Xl[index]; Win[j] = Xh[index]; } imodwt(Win, Vin, NX, J, L, h, g, Xout); for(j = 0; j < (*NX); j++) { index = i * (*NX) + j; image[index] = Xout[j]; } } free(Vin); free(Win); free(Xout); free(Xl); free(Xh); } waveslim/src/hosking.c0000644000176200001440000000377614627073455014530 0ustar liggesusers#include #include void hosking(double *Xt, int *N, double *vin) { int i, j, t; int nrl = 1, nrh = *N-1, ncl = 1, nch = *N-1; int nrow=nrh-nrl+1,ncol=nch-ncl+1; double *vt, *mt, *Nt, *Dt, *rhot; double **phi; /* = dmatrix(1, *N-1, 1, *N-1); */ vt = (double *) malloc((size_t) ((*N + 2) * sizeof(double))); mt = (double *) malloc((size_t) ((*N + 2) * sizeof(double))); Nt = (double *) malloc((size_t) ((*N + 2) * sizeof(double))); Dt = (double *) malloc((size_t) ((*N + 2) * sizeof(double))); rhot = (double *) malloc((size_t) ((*N + 2) * sizeof(double))); /*** Begin dmatrix code ***/ /* allocate pointers to rows */ phi=(double **) malloc((size_t)((nrow+1)*sizeof(double*))); /* if (!phi) nrerror("allocation failure 1 in matrix()"); */ phi += 1; phi -= nrl; /* allocate rows and set pointers to them */ phi[nrl]=(double *) malloc((size_t)((nrow*ncol+1)*sizeof(double))); /* if (!phi[nrl]) nrerror("allocation failure 2 in matrix()"); */ phi[nrl] += 1; phi[nrl] -= ncl; for(i=nrl+1;i<=nrh;i++) phi[i]=phi[i-1]+ncol; /*** End dmatrix code ***/ for(i = 1; i <= *N-1; i++) for(j = 1; j <= *N-1; j++) phi[i][j] = 0.0; vt[0] = vin[0]; Nt[0] = 0.0; Dt[0] = 1.0; Xt[0] *= sqrt(vt[0]); rhot[0] = 1.0; /* phi[1][1] = d / (1.0 - d); */ for(t = 1; t <= *N-1; t++) { rhot[t] = vin[t] / vin[0]; Nt[t] = rhot[t]; if(t > 1) for(j = 1; j <= t-1; j++) Nt[t] -= phi[t-1][j] * rhot[t-j]; Dt[t] = Dt[t-1] - (Nt[t-1] * Nt[t-1]) / Dt[t-1]; phi[t][t] = Nt[t] / Dt[t]; for(j = 1; j <= t-1; j++) phi[t][j] = phi[t-1][j] - phi[t][t] * phi[t-1][t-j]; } for(t = 1; t <= *N-1; t++) { mt[t] = 0.0; for(j = 1; j <= t; j++) mt[t] += phi[t][j] * Xt[t-j]; vt[t] = (1.0 - phi[t][t] * phi[t][t]) * vt[t-1]; Xt[t] = Xt[t] * sqrt(vt[t]) + mt[t]; } free((char*) (vt)); free((char*) (mt)); free((char*) (Nt)); free((char*) (Dt)); free((char*) (rhot)); free((char*) (phi[1])); free((char*) (phi)); } waveslim/src/dwt.h0000644000176200001440000000065514627073455013662 0ustar liggesusersextern void dwt(double *Vin, int *M, int *L, double *h, double *g, double *Wout, double *Vout); extern void idwt(double *Win, double *Vin, int *M, int *L, double *h, double *g, double *Xout); extern void modwt(double *Vin, int *N, int *j, int *L, double *ht, double *gt, double *Wout, double *Vout); extern void imodwt(double *Win, double *Vin, int *N, int *j, int *L, double *ht, double *gt, double *Vout); waveslim/src/dwt.c0000644000176200001440000000722414627073455013654 0ustar liggesusers#include #include #include #include /*************************************************************************/ void dwt(double *Vin, int *M, int *L, double *h, double *g, double *Wout, double *Vout) { int n, t, u; for(t = 0; t < *M/2; t++) { u = 2 * t + 1; Wout[t] = h[0] * Vin[u]; Vout[t] = g[0] * Vin[u]; for(n = 1; n < *L; n++) { u -= 1; if(u < 0) u = *M - 1; Wout[t] += h[n] * Vin[u]; Vout[t] += g[n] * Vin[u]; } } } /*************************************************************************/ void idwt(double *Win, double *Vin, int *M, int *L, double *h, double *g, double *Xout) { int i, j, l, t, u; int m = -2, n = -1; for(t = 0; t < *M; t++) { m += 2; n += 2; u = t; i = 1; j = 0; Xout[m] = h[i] * Win[u] + g[i] * Vin[u]; Xout[n] = h[j] * Win[u] + g[j] * Vin[u]; if(*L > 2) { for(l = 1; l < *L/2; l++) { u += 1; if(u >= *M) u = 0; i += 2; j += 2; Xout[m] += h[i] * Win[u] + g[i] * Vin[u]; Xout[n] += h[j] * Win[u] + g[j] * Vin[u]; } } } } /*************************************************************************/ void modwt(double *Vin, int *N, int *j, int *L, double *ht, double *gt, double *Wout, double *Vout) { int k, n, t; for(t = 0; t < *N; t++) { k = t; Wout[t] = ht[0] * Vin[k]; Vout[t] = gt[0] * Vin[k]; for(n = 1; n < *L; n++) { k -= (int) pow(2.0, (double) *j - 1.0); if(k < 0) k += *N; Wout[t] += ht[n] * Vin[k]; Vout[t] += gt[n] * Vin[k]; } } } /*************************************************************************/ void imodwt(double *Win, double *Vin, int *N, int *j, int *L, double *ht, double *gt, double *Vout) { int k, n, t; for(t = 0; t < *N; t++) { k = t; Vout[t] = (ht[0] * Win[k]) + (gt[0] * Vin[k]); for(n = 1; n < *L; n++) { k += (int) pow(2.0, (double) *j - 1.0); if(k >= *N) k -= *N; Vout[t] += (ht[n] * Win[k]) + (gt[n] * Vin[k]); } } } /*************************************************************************** *************************************************************************** This DWT algorithm is shifted to the left by one in order to match with the interval boundary conditions. *************************************************************************** ***************************************************************************/ void dwt_shift(double *Vin, int *M, int *L, double *h, double *g, double *Wout, double *Vout) { int n, t, u; for(t = 0; t < *M/2; t++) { /* u = 2 * t + 1; */ u = 2 * t + 2; Wout[t] = h[0] * Vin[u]; Vout[t] = g[0] * Vin[u]; for(n = 1; n < *L; n++) { u -= 1; if(u < 0) u = *M - 1; Wout[t] += h[n] * Vin[u]; Vout[t] += g[n] * Vin[u]; } } } /*************************************************************************** *************************************************************************** shifted iDWT *************************************************************************** ***************************************************************************/ void idwt_shift(double *Win, double *Vin, int M, int L, double *h, double *g, double *Xout) { int i, j, l, t, u; int m = -2, n = -1; for(t = 0; t < M; t++) { m += 2; n += 2; u = t; i = 1; j = 0; Xout[m] = h[i] * Win[u] + g[i] * Vin[u]; Xout[n] = h[j] * Win[u] + g[j] * Vin[u]; if(L > 2) { for(l = 1; l < L/2; l++) { u += 1; if(u >= M) u = 0; i += 2; j += 2; Xout[m] += h[i] * Win[u] + g[i] * Vin[u]; Xout[n] += h[j] * Win[u] + g[j] * Vin[u]; } } } } waveslim/NAMESPACE0000644000176200001440000000072314627101665013332 0ustar liggesusersuseDynLib("waveslim", .registration = TRUE, .fixes = "C_") exportPattern("^[^C_]") importFrom("grDevices", "rainbow") importFrom("graphics", "axis", "box", "image", "lines", "mtext", "par", "plot") importFrom("stats", "convolve", "fft", "filter", "integrate", "lsfit", "mad", "median", "mvfft", "optim", "optimize", "pchisq", "qchisq", "qnorm", "rnorm", "runif", "spec.taper") importFrom("multitaper", "dpss") S3method(plot, dwt.2d) waveslim/LICENSE0000644000176200001440000000013014627073455013115 0ustar liggesusersYEAR: 1997-2013 COPYRIGHT HOLDER: Brandon Whitcher ORGANIZATION: Rigorous Analytics Ltd.waveslim/README.md0000644000176200001440000000131614627073455013376 0ustar liggesusers# waveslim ![Travis-CI Build Status](https://travis-ci.org/bjw34032/waveslim.svg?branch=master) ![CRAN_Status_Badge](https://www.r-pkg.org/badges/version/waveslim) ![CRAN Downloads Badge](http://cranlogs.r-pkg.org/badges/grand-total/waveslim) ![CRAN Downloads Badge](http://cranlogs.r-pkg.org/badges/waveslim) The R packages **waveslim** contains basic wavelet routines for time series (1D), image (2D) and array (3D) analysis. The code provided is based on wavelet methodology developed in * Percival and Walden (2000) * Gencay, Selcuk and Whitcher (2001) * the dual-tree complex wavelet transform (CWT) from Kingsbury (1999, 2001) as implemented by Selesnick, and * Hilbert wavelet pairs (Selesnick 2001, 2002) waveslim/man/0000755000176200001440000000000014627405616012667 5ustar liggesuserswaveslim/man/wave.filter.Rd0000644000176200001440000000234314627105402015374 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/wave.filter.R \name{wave.filter} \alias{wave.filter} \title{Select a Wavelet Filter} \usage{ wave.filter(name) } \arguments{ \item{name}{Character string of wavelet filter.} } \value{ List containing the following items: \item{L}{Length of the wavelet filter.} \item{hpf}{High-pass filter coefficients.} \item{lpf}{Low-pass filter coefficients.} } \description{ Converts name of wavelet filter to filter coefficients. } \details{ Simple \code{switch} statement selects the appropriate filter. } \references{ Daubechies, I. (1992) \emph{Ten Lectures on Wavelets}, CBMS-NSF Regional Conference Series in Applied Mathematics, SIAM: Philadelphia. Doroslovacki (1998) On the least asymmetric wavelets, \emph{IEEE Transactions for Signal Processing}, \bold{46}, No. 4, 1125-1130. Morris and Peravali (1999) Minimum-bandwidth discrete-time wavelets, \emph{Signal Processing}, \bold{76}, No. 2, 181-193. Nielsen, M. (2000) On the Construction and Frequency Localization of Orthogonal Quadrature Filters, \emph{Journal of Approximation Theory}, \bold{108}, No. 1, 36-52. } \seealso{ \code{\link{wavelet.filter}}, \code{\link{squared.gain}}. } \author{ B. Whitcher } \keyword{ts} waveslim/man/rotcumvar.Rd0000644000176200001440000000234714627105402015174 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/multiple.R \name{rotcumvar} \alias{rotcumvar} \title{Rotated Cumulative Variance} \usage{ rotcumvar(x) } \arguments{ \item{x}{vector of coefficients to be cumulatively summed (missing values excluded)} } \value{ Vector of coefficients that are the sumulative sum of squared input coefficients. } \description{ Provides the normalized cumulative sums of squares from a sequence of coefficients with the diagonal line removed. } \details{ The rotated cumulative variance, when plotted, provides a qualitative way to study the time dependence of the variance of a series. If the variance is stationary over time, then only small deviations from zero should be present. If on the other hand the variance is non-stationary, then large departures may exist. Formal hypothesis testing may be performed based on boundary crossings of Brownian bridge processes. } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. } \author{ B. Whitcher } \keyword{ts} waveslim/man/ar1.Rd0000644000176200001440000000075214627105401013632 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{ar1} \alias{ar1} \title{Simulated AR(1) Series} \format{ A vector containing 200 observations. } \usage{ data(ar1) } \description{ Simulated AR(1) series used in Gencay, Selcuk and Whitcher (2001). } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. } \keyword{datasets} waveslim/man/exchange.Rd0000644000176200001440000000122114627105402014722 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{exchange} \alias{exchange} \title{Exchange Rates Between the Deutsche Mark, Japanese Yen and U.S. Dollar} \format{ A bivariate time series containing 348 observations. } \source{ Unknown. } \usage{ data(exchange) } \description{ Monthly foreign exchange rates for the Deutsche Mark - U.S. Dollar (DEM-USD) and Japanese Yen - U.S. Dollar (JPY-USD) starting in 1970. } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. } \keyword{datasets} waveslim/man/blocks.Rd0000644000176200001440000000102014627105402014412 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{blocks} \alias{blocks} \title{A Piecewise-Constant Function} \format{ A vector containing 512 observations. } \source{ S+WAVELETS. } \usage{ data(blocks) } \description{ \deqn{blocks(x) = \sum_{j=1}^{11}(1 + {\rm sign}(x-p_j)) h_j / 2}{% blocks(x) = sum[j=1,11] (1 + sign(x - p_j)) h_j/2} } \references{ Bruce, A., and H.-Y. Gao (1996) \emph{Applied Wavelet Analysis with S-PLUS}, Springer: New York. } \keyword{datasets} waveslim/man/squared.gain.Rd0000644000176200001440000000403214627105401015523 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cascade.R \name{squared.gain} \alias{squared.gain} \title{Squared Gain Function of a Filter} \usage{ squared.gain(wf.name, filter.seq = "L", n = 512) } \arguments{ \item{wf.name}{Character string of wavelet filter.} \item{filter.seq}{Character string of filter sequence. \code{H} means high-pass filtering and \code{L} means low-pass filtering. Sequence is read from right to left.} \item{n}{Length of zero-padded filter. Frequency resolution will be \code{n}/2+1.} } \value{ Squared gain function. } \description{ Produces the modulus squared of the Fourier transform for a given filtering sequence. } \details{ Uses \code{cascade} subroutine to compute the squared gain function from a given filtering sequence. } \examples{ par(mfrow=c(2,2)) f.seq <- "H" plot(0:256/512, squared.gain("d4", f.seq), type="l", ylim=c(0,2), xlab="frequency", ylab="L = 4", main="Level 1") lines(0:256/512, squared.gain("fk4", f.seq), col=2) lines(0:256/512, squared.gain("mb4", f.seq), col=3) abline(v=c(1,2)/4, lty=2) legend(-.02, 2, c("Daubechies", "Fejer-Korovkin", "Minimum-Bandwidth"), lty=1, col=1:3, bty="n", cex=1) f.seq <- "HL" plot(0:256/512, squared.gain("d4", f.seq), type="l", ylim=c(0,4), xlab="frequency", ylab="", main="Level 2") lines(0:256/512, squared.gain("fk4", f.seq), col=2) lines(0:256/512, squared.gain("mb4", f.seq), col=3) abline(v=c(1,2)/8, lty=2) f.seq <- "H" plot(0:256/512, squared.gain("d8", f.seq), type="l", ylim=c(0,2), xlab="frequency", ylab="L = 8", main="") lines(0:256/512, squared.gain("fk8", f.seq), col=2) lines(0:256/512, squared.gain("mb8", f.seq), col=3) abline(v=c(1,2)/4, lty=2) f.seq <- "HL" plot(0:256/512, squared.gain("d8", f.seq), type="l", ylim=c(0,4), xlab="frequency", ylab="", main="") lines(0:256/512, squared.gain("fk8", f.seq), col=2) lines(0:256/512, squared.gain("mb8", f.seq), col=3) abline(v=c(1,2)/8, lty=2) } \seealso{ \code{\link{wave.filter}}, \code{\link{wavelet.filter}}. } \author{ B. Whitcher } \keyword{ts} waveslim/man/japan.Rd0000644000176200001440000000117414627105402014240 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{japan} \alias{japan} \title{Japanese Gross National Product} \format{ A vector containing 169 observations. } \source{ Unknown. } \usage{ data(japan) } \description{ Quarterly Japanese gross national product from 1955:1 to 1996:4. } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. Hecq, A. (1998) Does seasonal adjustment induce common cycles?, \emph{Empirical Economics}, \bold{59}, 289-297. } \keyword{datasets} waveslim/man/FSfarras.Rd0000644000176200001440000000147614627105402014663 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dualtree.R \name{FSfarras} \alias{FSfarras} \alias{farras} \title{Farras nearly symmetric filters} \usage{ FSfarras() } \value{ \item{af}{List (i=1,2) - analysis filters for tree i} \item{sf}{List (i=1,2) - synthesis filters for tree i} } \description{ Farras nearly symmetric filters for orthogonal 2-channel perfect reconstruction filter bank and Farras filters organized for the dual-tree complex DWT. } \references{ A. F. Abdelnour and I. W. Selesnick. \dQuote{Nearly symmetric orthogonal wavelet bases}, Proc. IEEE Int. Conf. Acoust., Speech, Signal Processing (ICASSP), May 2001. } \seealso{ \code{\link{afb}}, \code{\link{dualtree}}, \code{\link{dualfilt1}}. } \author{ Matlab: S. Cai, K. Li and I. Selesnick; R port: B. Whitcher } \keyword{ts} waveslim/man/dwpt.Rd0000644000176200001440000000530414627105402014124 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dwpt.R \name{dwpt} \alias{dwpt} \alias{idwpt} \alias{modwpt} \title{(Inverse) Discrete Wavelet Packet Transforms} \usage{ dwpt(x, wf = "la8", n.levels = 4, boundary = "periodic") idwpt(y, y.basis) } \arguments{ \item{x}{a vector or time series containing the data be to decomposed. This must be a dyadic length vector (power of 2).} \item{wf}{Name of the wavelet filter to use in the decomposition. By default this is set to \code{"la8"}, the Daubechies orthonormal compactly supported wavelet of length L=8 (Daubechies, 1992), least asymmetric family.} \item{n.levels}{Specifies the depth of the decomposition.This must be a number less than or equal to \eqn{\log(\mbox{length}(x),2)}{log2[length(x)]}.} \item{boundary}{Character string specifying the boundary condition. If \code{boundary=="periodic"} the default, then the vector you decompose is assumed to be periodic on its defined interval,\cr if \code{boundary=="reflection"}, the vector beyond its boundaries is assumed to be a symmetric reflection of itself.} \item{y}{Object of S3 class \code{dwpt}.} \item{y.basis}{Vector of character strings that describe leaves on the DWPT basis tree.} } \value{ Basically, a list with the following components \item{w?.?}{Wavelet coefficient vectors. The first index is associated with the scale of the decomposition while the second is associated with the frequency partition within that level.} \item{wavelet}{Name of the wavelet filter used.} \item{boundary}{How the boundaries were handled.} } \description{ All possible filtering combinations (low- and high-pass) are performed to decompose a vector or time series. The resulting coefficients are associated with a binary tree structure corresponding to a partitioning of the frequency axis. } \details{ The code implements the one-dimensional DWPT using the pyramid algorithm (Mallat, 1989). } \examples{ data(mexm) J <- 4 mexm.mra <- mra(log(mexm), "mb8", J, "modwt", "reflection") mexm.nomean <- ts( apply(matrix(unlist(mexm.mra), ncol=J+1, byrow=FALSE)[,-(J+1)], 1, sum), start=1957, freq=12) mexm.dwpt <- dwpt(mexm.nomean[-c(1:4)], "mb8", 7, "reflection") } \references{ Mallat, S. G. (1989) A theory for multiresolution signal decomposition: the wavelet representation, \emph{IEEE Transactions on Pattern Analysis and Machine Intelligence}, \bold{11}(7), 674--693. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. Wickerhauser, M. V. (1994) \emph{Adapted Wavelet Analysis from Theory to Software}, A K Peters. } \seealso{ \code{\link{dwt}}, \code{\link{modwpt}}, \code{\link{wave.filter}}. } \author{ B. Whitcher } \keyword{ts} waveslim/man/cpi.Rd0000644000176200001440000000077014627105402013723 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{cpi} \alias{cpi} \title{U.S. Consumer Price Index} \format{ A vector containing 624 observations. } \source{ Unknown. } \usage{ data(cpi) } \description{ Monthly U.S. consumer price index from 1948:1 to 1999:12. } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. } \keyword{datasets} waveslim/man/denoise.dwt.2d.Rd0000644000176200001440000000445614627105402015704 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/two_D.R \name{denoise.dwt.2d} \alias{denoise.dwt.2d} \alias{denoise.modwt.2d} \title{Denoise an Image via the 2D Discrete Wavelet Transform} \usage{ denoise.dwt.2d( x, wf = "la8", J = 4, method = "universal", H = 0.5, noise.dir = 3, rule = "hard" ) } \arguments{ \item{x}{input matrix (image)} \item{wf}{name of the wavelet filter to use in the decomposition} \item{J}{depth of the decomposition, must be a number less than or equal to log(minM,N,2)} \item{method}{character string describing the threshold applied, only \code{"universal"} and \code{"long-memory"} are currently implemented} \item{H}{self-similarity or Hurst parameter to indicate spectral scaling, white noise is 0.5} \item{noise.dir}{number of directions to estimate background noise standard deviation, the default is 3 which produces a unique estimate of the background noise for each spatial direction} \item{rule}{either a \code{"hard"} or \code{"soft"} thresholding rule may be used} } \value{ Image of the same dimension as the original but with high-freqency fluctuations removed. } \description{ Perform simple de-noising of an image using the two-dimensional discrete wavelet transform. } \details{ See \code{\link{Thresholding}}. } \examples{ ## Xbox image data(xbox) n <- nrow(xbox) xbox.noise <- xbox + matrix(rnorm(n*n, sd=.15), n, n) par(mfrow=c(2,2), cex=.8, pty="s") image(xbox.noise, col=rainbow(128), main="Original Image") image(denoise.dwt.2d(xbox.noise, wf="haar"), col=rainbow(128), zlim=range(xbox.noise), main="Denoised image") image(xbox.noise - denoise.dwt.2d(xbox.noise, wf="haar"), col=rainbow(128), zlim=range(xbox.noise), main="Residual image") ## Daubechies image data(dau) n <- nrow(dau) dau.noise <- dau + matrix(rnorm(n*n, sd=10), n, n) par(mfrow=c(2,2), cex=.8, pty="s") image(dau.noise, col=rainbow(128), main="Original Image") dau.denoise <- denoise.modwt.2d(dau.noise, wf="d4", rule="soft") image(dau.denoise, col=rainbow(128), zlim=range(dau.noise), main="Denoised image") image(dau.noise - dau.denoise, col=rainbow(128), main="Residual image") } \references{ See \code{\link{Thresholding}} for references concerning de-noising in one dimension. } \seealso{ \code{\link{Thresholding}} } \author{ B. Whitcher } \keyword{ts} waveslim/man/ibm.Rd0000644000176200001440000000072414627105402013716 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{ibm} \alias{ibm} \title{Daily IBM Stock Prices} \format{ A vector containing 369 observations. } \source{ Box, G. E.P. and Jenkins, G. M. (1976) \emph{Time Series Analysis: Forecasting and Control}, Holden Day, San Francisco, 2nd edition. } \usage{ data(ibm) } \description{ Daily IBM stock prices spanning May~17, 1961 to November~2, 1962. } \keyword{datasets} waveslim/man/spp.mle.Rd0000644000176200001440000000360014627105402014521 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/spp.R \name{spp.mle} \alias{spp.mle} \alias{spp2.mle} \title{Wavelet-based Maximum Likelihood Estimation for Seasonal Persistent Processes} \usage{ spp.mle(y, wf, J = log(length(y), 2) - 1, p = 0.01, frac = 1) spp2.mle(y, wf, J = log(length(y), 2) - 1, p = 0.01, dyadic = TRUE, frac = 1) } \arguments{ \item{y}{Not necessarily dyadic length time series.} \item{wf}{Name of the wavelet filter to use in the decomposition. See \code{\link{wave.filter}} for those wavelet filters available.} \item{J}{Depth of the discrete wavelet packet transform.} \item{p}{Level of significance for the white noise testing procedure.} \item{frac}{Fraction of the time series that should be used in constructing the likelihood function.} \item{dyadic}{Logical parameter indicating whether or not the original time series is dyadic in length.} } \value{ List containing the maximum likelihood estimates (MLEs) of \eqn{\delta}, \eqn{f_G} and \eqn{\sigma^2}, along with the value of the likelihood for those estimates. } \description{ Parameter estimation for a seasonal persistent (seasonal long-memory) process is performed via maximum likelihood on the wavelet coefficients. } \details{ The variance-covariance matrix of the original time series is approximated by its wavelet-based equivalent. A Whittle-type likelihood is then constructed where the sums of squared wavelet coefficients are compared to bandpass filtered version of the true spectral density function. Minimization occurs for the fractional difference parameter \eqn{d} and the Gegenbauer frequency \eqn{f_G}, while the innovations variance is subsequently estimated. } \references{ Whitcher, B. (2004) Wavelet-based estimation for seasonal long-memory processes, \emph{Technometrics}, \bold{46}, No. 2, 225-238. } \seealso{ \code{\link{fdp.mle}} } \author{ B. Whitcher } \keyword{ts} waveslim/man/css.test.Rd0000644000176200001440000000346114627105402014716 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dwpt.R \name{css.test} \alias{css.test} \alias{cpgram.test} \alias{entropy.test} \alias{portmanteau.test} \title{Testing the Wavelet Packet Tree for White Noise} \usage{ cpgram.test(y, p = 0.05, taper = 0.1) css.test(y) entropy.test(y) portmanteau.test(y, p = 0.05, type = "Box-Pierce") } \arguments{ \item{y}{wavelet packet tree (from the DWPT)} \item{p}{significance level} \item{taper}{weight of cosine bell taper (\code{cpgram.test} only)} \item{type}{\code{"Box-Pierce"} and \code{other} recognized (\code{portmanteau.test} only)} } \value{ Boolean vector of the same length as the number of nodes in the wavelet packet tree. } \description{ A wavelet packet tree, from the discrete wavelet packet transform (DWPT), is tested node-by-node for white noise. This is the first step in selecting an orthonormal basis for the DWPT. } \details{ Top-down recursive testing of the wavelet packet tree is } \examples{ data(mexm) J <- 6 wf <- "la8" mexm.dwpt <- dwpt(mexm[-c(1:4)], wf, J) ## Not implemented yet ## plot.dwpt(x.dwpt, J) mexm.dwpt.bw <- dwpt.brick.wall(mexm.dwpt, wf, 6, method="dwpt") mexm.tree <- ortho.basis(portmanteau.test(mexm.dwpt.bw, p=0.025)) ## Not implemented yet ## plot.basis(mexm.tree) } \references{ Brockwell and Davis (1991) \emph{Time Series: Theory and Methods}, (2nd. edition), Springer-Verlag. Brown, Durbin and Evans (1975) Techniques for testing the constancy of regression relationships over time, \emph{Journal of the Royal Statistical Society B}, \bold{37}, 149-163. Percival, D. B., and A. T. Walden (1993) \emph{Spectral Analysis for Physical Applications: Multitaper and Conventional Univariate Techniques}, Cambridge University Press. } \seealso{ \code{\link{ortho.basis}}. } \author{ B. Whitcher } \keyword{ts} waveslim/man/modwt.3d.Rd0000644000176200001440000000124114627105402014601 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/three_D.R \name{modwt.3d} \alias{modwt.3d} \alias{imodwt.3d} \title{Three Dimensional Separable Maximal Ovelrap Discrete Wavelet Transform} \usage{ modwt.3d(x, wf, J = 4, boundary = "periodic") imodwt.3d(y) } \arguments{ \item{x}{input array} \item{wf}{name of the wavelet filter to use in the decomposition} \item{J}{depth of the decomposition} \item{boundary}{only \code{"periodic"} is currently implemented} \item{y}{an object of class \code{modwt.3d}} } \description{ Three-dimensional separable maximal overlap discrete wavelet transform (MODWT). } \author{ B. Whitcher } \keyword{ts} waveslim/man/dualtree.Rd0000644000176200001440000000467514627105402014765 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dualtree.R \name{dualtree} \alias{dualtree} \alias{idualtree} \alias{dualtree2D} \alias{idualtree2D} \title{Dual-tree Complex Discrete Wavelet Transform} \usage{ dualtree(x, J, Faf, af) idualtree(w, J, Fsf, sf) dualtree2D(x, J, Faf, af) idualtree2D(w, J, Fsf, sf) } \arguments{ \item{x}{N-point vector or MxN matrix.} \item{J}{number of stages.} \item{Faf}{analysis filters for the first stage.} \item{af}{analysis filters for the remaining stages.} \item{w}{DWT coefficients.} \item{Fsf}{synthesis filters for the last stage.} \item{sf}{synthesis filters for the preceeding stages.} } \value{ For the analysis of \code{x}, the output is \item{w}{DWT coefficients. Each wavelet scale is a list containing the real and imaginary parts. The final scale (J+1) contains the low-pass filter coefficients.} For the synthesis of \code{w}, the output is \item{y}{output signal} } \description{ One- and two-dimensional dual-tree complex discrete wavelet transforms developed by Kingsbury and Selesnick \emph{et al.} } \details{ In one dimension \eqn{N} is divisible by \eqn{2^J} and \eqn{N\ge2^{J-1}\cdot\mbox{length}(\mbox{\code{af}})}. In two dimensions, these two conditions must hold for both \eqn{M} and \eqn{N}. } \examples{ ## EXAMPLE: dualtree x = rnorm(512) J = 4 Faf = FSfarras()$af Fsf = FSfarras()$sf af = dualfilt1()$af sf = dualfilt1()$sf w = dualtree(x, J, Faf, af) y = idualtree(w, J, Fsf, sf) err = x - y max(abs(err)) ## Example: dualtree2D x = matrix(rnorm(64*64), 64, 64) J = 3 Faf = FSfarras()$af Fsf = FSfarras()$sf af = dualfilt1()$af sf = dualfilt1()$sf w = dualtree2D(x, J, Faf, af) y = idualtree2D(w, J, Fsf, sf) err = x - y max(abs(err)) ## Display 2D wavelets of dualtree2D.m J <- 4 L <- 3 * 2^(J+1) N <- L / 2^J Faf <- FSfarras()$af Fsf <- FSfarras()$sf af <- dualfilt1()$af sf <- dualfilt1()$sf x <- matrix(0, 2*L, 3*L) w <- dualtree2D(x, J, Faf, af) w[[J]][[1]][[1]][N/2, N/2+0*N] <- 1 w[[J]][[1]][[2]][N/2, N/2+1*N] <- 1 w[[J]][[1]][[3]][N/2, N/2+2*N] <- 1 w[[J]][[2]][[1]][N/2+N, N/2+0*N] <- 1 w[[J]][[2]][[2]][N/2+N, N/2+1*N] <- 1 w[[J]][[2]][[3]][N/2+N, N/2+2*N] <- 1 y <- idualtree2D(w, J, Fsf, sf) image(t(y), col=grey(0:64/64), axes=FALSE) } \seealso{ \code{\link{FSfarras}}, \code{\link{farras}}, \code{\link{convolve}}, \code{\link{cshift}}, \code{\link{afb}}, \code{\link{sfb}}. } \author{ Matlab: S. Cai, K. Li and I. Selesnick; R port: B. Whitcher } \keyword{ts} waveslim/man/ortho.basis.Rd0000644000176200001440000000245114627105402015401 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dwpt.R \name{ortho.basis} \alias{ortho.basis} \title{Derive Orthonormal Basis from Wavelet Packet Tree} \usage{ ortho.basis(xtree) } \arguments{ \item{xtree}{is a vector whose entries are associated with a wavelet packet tree.} } \value{ Boolean vector describing the orthonormal basis for the DWPT. } \description{ An orthonormal basis for the discrete wavelet transform may be characterized via a disjoint partitioning of the frequency axis that covers \eqn{[0,\frac{1}{2})}{[0,1/2)}. This subroutine produces an orthonormal basis from a full wavelet packet tree. } \details{ A wavelet packet tree is a binary tree of Boolean variables. Parent nodes are removed if any of their children exist. } \examples{ data(japan) J <- 4 wf <- "mb8" japan.mra <- mra(log(japan), wf, J, boundary="reflection") japan.nomean <- ts(apply(matrix(unlist(japan.mra[-(J+1)]), ncol=J, byrow=FALSE), 1, sum), start=1955, freq=4) japan.nomean2 <- ts(japan.nomean[42:169], start=1965.25, freq=4) plot(japan.nomean2, type="l") japan.dwpt <- dwpt(japan.nomean2, wf, 6) japan.basis <- ortho.basis(portmanteau.test(japan.dwpt, p=0.01, type="other")) # Not implemented yet # par(mfrow=c(1,1)) # plot.basis(japan.basis) } \author{ B. Whitcher } \keyword{ts} waveslim/man/shift.2d.Rd0000644000176200001440000000316514627105402014572 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/shift.2d.R \name{shift.2d} \alias{shift.2d} \title{Circularly Shift Matrices from a 2D MODWT} \usage{ shift.2d(z, inverse = FALSE) } \arguments{ \item{z}{Two-dimensional MODWT object} \item{inverse}{Boolean value on whether to perform the forward or inverse operation.} } \value{ Two-dimensional MODWT object with circularly shifted coefficients. } \description{ Compute phase shifts for wavelet sub-matrices based on the ``center of energy'' argument of Hess-Nielsen and Wickerhauser (1996). } \details{ The "center of energy" technique of Wickerhauser and Hess-Nielsen (1996) is employed to find circular shifts for the wavelet sub-matrices such that the coefficients are aligned with the original series. This corresponds to applying a (near) linear-phase filtering operation. } \examples{ n <- 512 G1 <- G2 <- dnorm(seq(-n/4, n/4, length=n)) G <- 100 * zapsmall(outer(G1, G2)) G <- modwt.2d(G, wf="la8", J=6) k <- 50 xr <- yr <- trunc(n/2) + (-k:k) par(mfrow=c(3,3), mar=c(1,1,2,1), pty="s") for (j in names(G)[1:9]) { image(G[[j]][xr,yr], col=rainbow(64), axes=FALSE, main=j) } Gs <- shift.2d(G) for (j in names(G)[1:9]) { image(Gs[[j]][xr,yr], col=rainbow(64), axes=FALSE, main=j) } } \references{ Hess-Nielsen, N. and M. V. Wickerhauser (1996) Wavelets and time-frequency analysis, \emph{Proceedings of the IEEE}, \bold{84}, No. 4, 523-540. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. } \seealso{ \code{\link{phase.shift}}, \code{\link{modwt.2d}}. } \author{ B. Whitcher } \keyword{ts} waveslim/man/stackPlot.Rd0000644000176200001440000000214614627105402015113 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stack.plot.R \name{stackPlot} \alias{stackPlot} \title{Stack Plot} \usage{ stackPlot( x, plot.type = c("multiple", "single"), panel = lines, log = "", col = par("col"), bg = NA, pch = par("pch"), cex = par("cex"), lty = par("lty"), lwd = par("lwd"), ann = par("ann"), xlab = "Time", main = NULL, oma = c(6, 0, 5, 0), layout = NULL, same.scale = 1:dim(x)[2], ... ) } \arguments{ \item{x}{\code{ts} object} \item{plot.type, panel, log, col, bg, pch, cex, lty, lwd, ann, xlab, main, oma, ...}{See \code{plot.ts}.} \item{layout}{Doublet defining the dimension of the panel. If not specified, the dimensions are chosen automatically.} \item{same.scale}{Vector the same length as the number of series to be plotted. If not specified, all panels will have unique axes.} } \description{ Stack plot of an object. This function attempts to mimic a function called \code{stack.plot} in S+WAVELETS. } \details{ Produces a set of plots, one for each element (column) of \code{x}. } \author{ B. Whitcher } \keyword{hplot} waveslim/man/dwpt.boot.Rd0000644000176200001440000000375714627105402015100 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dwpt_boot.R \name{dwpt.boot} \alias{dwpt.boot} \title{Bootstrap Time Series Using the DWPT} \usage{ dwpt.boot(y, wf, J = log(length(y), 2) - 1, p = 1e-04, frac = 1) } \arguments{ \item{y}{Not necessarily dyadic length time series.} \item{wf}{Name of the wavelet filter to use in the decomposition. See \code{\link{wave.filter}} for those wavelet filters available.} \item{J}{Depth of the discrete wavelet packet transform.} \item{p}{Level of significance for the white noise testing procedure.} \item{frac}{Fraction of the time series that should be used in constructing the likelihood function.} } \value{ Time series of length $N$, where $N$ is the length of \code{y}. } \description{ An adaptive orthonormal basis is selected in order to perform the naive bootstrap within nodes of the wavelet packet tree. A bootstrap realization of the time series is produce by applying the inverse DWPT. } \details{ A subroutines is used to select an adaptive orthonormal basis for the piecewise-constant approximation to the underlying spectral density function (SDF). Once selected, sampling with replacement is performed within each wavelet packet coefficient vector and the new collection of wavelet packet coefficients are reconstructed into a bootstrap realization of the original time series. } \references{ Percival, D.B., S. Sardy, A. Davision (2000) Wavestrapping Time Series: Adaptive Wavelet-Based Bootstrapping, in B.J. Fitzgerald, R.L. Smith, A.T. Walden, P.C. Young (Eds.) \emph{Nonlinear and Nonstationary Signal Processing}, pp. 442-471. Whitcher, B. (2001) Simulating Gaussian Stationary Time Series with Unbounded Spectra, \emph{Journal of Computational and Graphical Statistics}, \bold{10}, No. 1, 112-134. Whitcher, B. (2004) Wavelet-Based Estimation for Seasonal Long-Memory Processes, \emph{Technometrics}, \bold{46}, No. 2, 225-238. } \seealso{ \code{\link{dwpt.sim}}, \code{\link{spp.mle}} } \author{ B. Whitcher } \keyword{ts} waveslim/man/mexm.Rd0000644000176200001440000000076014627105402014115 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{mexm} \alias{mexm} \title{Mexican Money Supply} \format{ A vector containing 516 observations. } \source{ Unknown. } \usage{ data(mexm) } \description{ Percentage changes in monthly Mexican money supply. } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. } \keyword{datasets} waveslim/man/wavelet.filter.Rd0000644000176200001440000000435614627105401016106 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cascade.R \name{wavelet.filter} \alias{wavelet.filter} \title{Higher-Order Wavelet Filters} \usage{ wavelet.filter(wf.name, filter.seq = "L", n = 512) } \arguments{ \item{wf.name}{Character string of wavelet filter.} \item{filter.seq}{Character string of filter sequence. \code{H} means high-pass filtering and \code{L} means low-pass filtering. Sequence is read from right to left.} \item{n}{Length of zero-padded filter. Frequency resolution will be \code{n}/2+1.} } \value{ Vector of wavelet coefficients. } \description{ Create a wavelet filter at arbitrary scale. } \details{ Uses \code{cascade} subroutine to compute higher-order wavelet coefficient vector from a given filtering sequence. } \examples{ ## Figure 4.14 in Gencay, Selcuk and Whitcher (2001) par(mfrow=c(3,1), mar=c(5-2,4,4-1,2)) f.seq <- "HLLLLL" plot(c(rep(0,33), wavelet.filter("mb4", f.seq), rep(0,33)), type="l", xlab="", ylab="", main="D(4) in black, MB(4) in red") lines(c(rep(0,33), wavelet.filter("d4", f.seq), rep(0,33)), col=2) plot(c(rep(0,35), -wavelet.filter("mb8", f.seq), rep(0,35)), type="l", xlab="", ylab="", main="D(8) in black, -MB(8) in red") lines(c(rep(0,35), wavelet.filter("d8", f.seq), rep(0,35)), col=2) plot(c(rep(0,39), wavelet.filter("mb16", f.seq), rep(0,39)), type="l", xlab="", ylab="", main="D(16) in black, MB(16) in red") lines(c(rep(0,39), wavelet.filter("d16", f.seq), rep(0,39)), col=2) } \references{ Bruce, A. and H.-Y. Gao (1996). \emph{Applied Wavelet Analysis with S-PLUS}, Springer: New York. Doroslovacki, M. L. (1998) On the least asymmetric wavelets, \emph{IEEE Transactions on Signal Processing}, \bold{46}, No. 4, 1125-1130. Daubechies, I. (1992) \emph{Ten Lectures on Wavelets}, CBMS-NSF Regional Conference Series in Applied Mathematics, SIAM: Philadelphia. Morris and Peravali (1999) Minimum-bandwidth discrete-time wavelets, \emph{Signal Processing}, \bold{76}, No. 2, 181-193. Nielsen, M. (2001) On the Construction and Frequency Localization of Finite Orthogonal Quadrature Filters, \emph{Journal of Approximation Theory}, \bold{108}, No. 1, 36-52. } \seealso{ \code{\link{squared.gain}}, \code{\link{wave.filter}}. } \author{ B. Whitcher } \keyword{ts} waveslim/man/mra.3d.Rd0000644000176200001440000000376014627105402014236 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/three_D.R \name{mra.3d} \alias{mra.3d} \title{Three Dimensional Multiresolution Analysis} \usage{ mra.3d(x, wf = "la8", J = 4, method = "modwt", boundary = "periodic") } \arguments{ \item{x}{A three-dimensional array containing the data be to decomposed. This must be have dyadic length in all three dimensions (but not necessarily the same) for \code{method="dwt"}.} \item{wf}{Name of the wavelet filter to use in the decomposition. By default this is set to \code{"la8"}, the Daubechies orthonormal compactly supported wavelet of length \eqn{L=8} least asymmetric family.} \item{J}{Specifies the depth of the decomposition. This must be a number less than or equal to \eqn{\log(\mbox{length}(x),2)}{log(length(x),2)}.} \item{method}{Either \code{"dwt"} or \code{"modwt"}.} \item{boundary}{Character string specifying the boundary condition. If \code{boundary=="periodic"} the default and only method implemented, then the matrix you decompose is assumed to be periodic on its defined interval.} } \value{ List structure containing the filter triplets associated with the multiresolution analysis. } \description{ This function performs a level \eqn{J} additive decomposition of the input array using the pyramid algorithm (Mallat 1989). } \details{ This code implements a three-dimensional multiresolution analysis by performing the one-dimensional pyramid algorithm (Mallat 1989) on each dimension of the input array. Either the DWT or MODWT may be used to compute the multiresolution analysis, which is an additive decomposition of the original array. } \references{ Mallat, S. G. (1989) A theory for multiresolution signal decomposition: the wavelet representation, \emph{IEEE Transactions on Pattern Analysis and Machine Intelligence}, \bold{11}, No. 7, 674-693. Mallat, S. G. (1998) \emph{A Wavelet Tour of Signal Processing}, Academic Press. } \seealso{ \code{\link{dwt.3d}}, \code{\link{modwt.3d}} } \author{ B. Whitcher } \keyword{ts} waveslim/man/sine.taper.Rd0000644000176200001440000000117714627105402015222 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tapers.R \name{sine.taper} \alias{sine.taper} \title{Computing Sinusoidal Data Tapers} \usage{ sine.taper(n, k) } \arguments{ \item{n}{length of data taper(s)} \item{k}{number of data tapers} } \value{ A vector or matrix of data tapers (cols = tapers). } \description{ Computes sinusoidal data tapers directly from equations. } \details{ See reference. } \references{ Riedel, K. S. and A. Sidorenko (1995) Minimum bias multiple taper spectral estimation, \emph{IEEE Transactions on Signal Processing}, \bold{43}, 188-195. } \author{ B. Whitcher } \keyword{ts} waveslim/man/dpss.taper.Rd0000644000176200001440000000154314627405616015244 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tapers.R \name{dpss.taper} \alias{dpss.taper} \title{Calculating Thomson's Spectral Multitapers by Inverse Iteration} \usage{ dpss.taper(n, k, nw = 4) } \arguments{ \item{n}{length of data taper(s)} \item{k}{number of data tapers; 1, 2, 3, ... (do not use 0!)} \item{nw}{product of length and half-bandwidth parameter (w)} } \value{ \item{v}{matrix of data tapers (cols = tapers)} \item{eigen}{eigenvalue associated with each data taper, discarded} } \description{ This is now a wrapper to the function multitaper::dpss(). } \references{ Percival, D. B. and A. T. Walden (1993) \emph{Spectral Estimation for Physical Applications: Multitaper and Conventional Univariate Techniques}, Cambridge University Press. } \seealso{ \code{\link{sine.taper}}. } \author{ B. Whitcher } \keyword{ts} waveslim/man/bandpass.var.spp.Rd0000644000176200001440000000270714627105402016335 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dwpt_sim.R \name{bandpass.var.spp} \alias{bandpass.var.spp} \alias{bandpass.fdp} \alias{bandpass.spp} \alias{bandpass.spp2} \title{Bandpass Variance for Long-Memory Processes} \usage{ bandpass.fdp(a, b, d) bandpass.spp(a, b, d, fG) bandpass.spp2(a, b, d1, f1, d2, f2) bandpass.var.spp(delta, fG, J, Basis, Length) } \arguments{ \item{fG, f1, f2}{Gegenbauer frequency.} \item{J}{Depth of the wavelet transform.} \item{Basis}{Logical vector representing the adaptive basis.} \item{Length}{Number of elements in Basis.} \item{a}{Left-hand boundary for the definite integral.} \item{b}{Right-hand boundary for the definite integral.} \item{d, delta, d1, d2}{Fractional difference parameter.} } \value{ Band-pass variance for the FD or SP process between \eqn{a} and \eqn{b}. } \description{ Computes the band-pass variance for fractional difference (FD) or seasonal persistent (SP) processes using numeric integration of their spectral density function. } \details{ See references. } \references{ McCoy, E. J., and A. T. Walden (1996) Wavelet analysis and synthesis of stationary long-memory processes, \emph{Journal for Computational and Graphical Statistics}, \bold{5}, No. 1, 26-56. Whitcher, B. (2001) Simulating Gaussian stationary processes with unbounded spectra, \emph{Journal for Computational and Graphical Statistics}, \bold{10}, No. 1, 112-134. } \author{ B. Whitcher } \keyword{ts} waveslim/man/testing.hov.Rd0000644000176200001440000000372314627105402015421 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/multiple.R \name{testing.hov} \alias{testing.hov} \title{Testing for Homogeneity of Variance} \usage{ testing.hov(x, wf, J, min.coef = 128, debug = FALSE) } \arguments{ \item{x}{Sequence of observations from a (long memory) time series.} \item{wf}{Name of the wavelet filter to use in the decomposition.} \item{J}{Specifies the depth of the decomposition. This must be a number less than or equal to \eqn{\log(\mbox{length}(x),2)}{log(length(x),2)}.} \item{min.coef}{Minimum number of wavelet coefficients for testing purposes. Empirical results suggest that 128 is a reasonable number in order to apply asymptotic critical values.} \item{debug}{Boolean variable: if set to \code{TRUE}, actions taken by the algorithm are printed to the screen.} } \value{ Matrix whose columns include (1) the level of the wavelet transform where the variance change occurs, (2) the value of the test statistic, (3) the DWT coefficient where the change point is located, (4) the MODWT coefficient where the change point is located. Note, there is currently no checking that the MODWT is contained within the associated support of the DWT coefficient. This could lead to incorrect estimates of the location of the variance change. } \description{ A recursive algorithm for detecting and locating multiple variance change points in a sequence of random variables with long-range dependence. } \details{ For details see Section 9.6 of Percival and Walden (2000) or Section 7.3 in Gencay, Selcuk and Whitcher (2001). } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. } \seealso{ \code{\link{dwt}}, \code{\link{modwt}}, \code{\link{rotcumvar}}, \code{\link{mult.loc}}. } \author{ B. Whitcher } \keyword{ts} waveslim/man/dualfilt1.Rd0000644000176200001440000000151214627105402015030 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dualtree.R \name{dualfilt1} \alias{dualfilt1} \alias{AntonB} \title{Kingsbury's Q-filters for the Dual-Tree Complex DWT} \usage{ dualfilt1() } \value{ \item{af}{List (i=1,2) - analysis filters for tree i} \item{sf}{List (i=1,2) - synthesis filters for tree i} Note: \code{af[[2]]} is the reverse of \code{af[[1]]}. } \description{ Kingsbury's Q-filters for the dual-tree complex DWT. } \details{ These cofficients are rounded to 8 decimal places. } \references{ Kingsbury, N.G. (2000). A dual-tree complex wavelet transform with improved orthogonality and symmetry properties, \emph{Proceedings of the IEEE Int. Conf. on Image Proc.} (ICIP). } \seealso{ \code{\link{dualtree}} } \author{ Matlab: S. Cai, K. Li and I. Selesnick; R port: B. Whitcher } \keyword{ts} waveslim/man/phase.shift.hilbert.Rd0000644000176200001440000000202414627105402017006 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hilbert.R \name{phase.shift.hilbert} \alias{phase.shift.hilbert} \alias{phase.shift.hilbert.packet} \title{Phase Shift for Hilbert Wavelet Coefficients} \usage{ phase.shift.hilbert(x, wf) } \arguments{ \item{x}{Discete Hilbert wavelet transform (DHWT) object.} \item{wf}{character string; Hilbert wavelet pair used in DHWT} } \value{ DHWT (DHWPT) object with coefficients circularly shifted. } \description{ Wavelet coefficients are circularly shifted by the amount of phase shift induced by the discrete Hilbert wavelet transform. } \details{ The "center-of-energy" argument of Hess-Nielsen and Wickerhauser (1996) is used to provide a flexible way to circularly shift wavelet coefficients regardless of the wavelet filter used. } \references{ Hess-Nielsen, N. and M. V. Wickerhauser (1996) Wavelets and time-frequency analysis, \emph{Proceedings of the IEEE}, \bold{84}, No. 4, 523-540. } \seealso{ \code{\link{phase.shift}} } \author{ B. Whitcher } \keyword{ts} waveslim/man/cplxdual2D.Rd0000644000176200001440000000263014627105401015146 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cplxdual2D.R \name{cplxdual2D} \alias{cplxdual2D} \alias{icplxdual2D} \title{Dual-tree Complex 2D Discrete Wavelet Transform} \usage{ cplxdual2D(x, J, Faf, af) icplxdual2D(w, J, Fsf, sf) } \arguments{ \item{x}{2D array.} \item{J}{number of stages.} \item{Faf}{first stage analysis filters for tree i.} \item{af}{analysis filters for the remaining stages on tree i.} \item{w}{wavelet coefficients.} \item{Fsf}{last stage synthesis filters for tree i.} \item{sf}{synthesis filters for the preceeding stages.} } \value{ For the analysis of \code{x}, the output is \item{w}{wavelet coefficients indexed by \code{[[j]][[i]][[d1]][[d2]]}, where \eqn{j=1,\ldots,J} (scale), \eqn{i=1} (real part) or \eqn{i=2} (imag part), \eqn{d1=1,2} and \eqn{d2=1,2,3} (orientations).} For the synthesis of \code{w}, the output is \item{y}{output signal.} } \description{ Dual-tree complex 2D discrete wavelet transform (DWT). } \examples{ \dontrun{ ## EXAMPLE: cplxdual2D x = matrix(rnorm(32*32), 32, 32) J = 5 Faf = FSfarras()$af Fsf = FSfarras()$sf af = dualfilt1()$af sf = dualfilt1()$sf w = cplxdual2D(x, J, Faf, af) y = icplxdual2D(w, J, Fsf, sf) err = x - y max(abs(err)) } } \seealso{ \code{\link{FSfarras}}, \code{\link{farras}}, \code{\link{afb2D}}, \code{\link{sfb2D}}. } \author{ Matlab: S. Cai, K. Li and I. Selesnick; R port: B. Whitcher } \keyword{ts} waveslim/man/hosking.sim.Rd0000644000176200001440000000302214627105402015372 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hosking.R \name{hosking.sim} \alias{hosking.sim} \title{Generate Stationary Gaussian Process Using Hosking's Method} \usage{ hosking.sim(n, acvs) } \arguments{ \item{n}{Length of series.} \item{acvs}{Autocovariance sequence of series with which to generate, must be of length at least \code{n}.} } \value{ Length \code{n} time series from true autocovariance sequence \code{acvs}. } \description{ Uses exact time-domain method from Hosking (1984) to generate a simulated time series from a specified autocovariance sequence. } \examples{ dB <- function(x) 10 * log10(x) per <- function (z) { n <- length(z) (Mod(fft(z))^2/(2 * pi * n))[1:(n\%/\%2 + 1)] } spp.sdf <- function(freq, delta, omega) abs(2 * (cos(2*pi*freq) - cos(2*pi*omega)))^(-2*delta) data(acvs.andel8) n <- 1024 \dontrun{ z <- hosking.sim(n, acvs.andel8[,2]) per.z <- 2 * pi * per(z) par(mfrow=c(2,1), las=1) plot.ts(z, ylab="", main="Realization of a Seasonal Long-Memory Process") plot(0:(n/2)/n, dB(per.z), type="l", xlab="Frequency", ylab="dB", main="Periodogram") lines(0:(n/2)/n, dB(spp.sdf(0:(n/2)/n, .4, 1/12)), col=2) } } \references{ Hosking, J. R. M. (1984) Modeling persistence in hydrological time series using fractional differencing, \emph{Water Resources Research}, \bold{20}, No. 12, 1898-1908. Percival, D. B. (1992) Simulating Gaussian random processes with specified spectra, \emph{Computing Science and Statistics}, \bold{22}, 534-538. } \author{ B. Whitcher } \keyword{ts} waveslim/man/my.acf.Rd0000644000176200001440000000165714627105402014332 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.R \name{my.acf} \alias{my.acf} \alias{my.ccf} \title{Autocovariance Functions via the Discrete Fourier Transform} \usage{ my.acf(x) my.ccf(a, b) } \arguments{ \item{x, a, b}{time series} } \value{ The autocovariance function for all nonnegative lags or the cross-covariance function for all lags. } \description{ Computes the autocovariance function (ACF) for a time series or the cross-covariance function (CCF) between two time series. } \details{ The series is zero padded to twice its length before the discrete Fourier transform is applied. Only the values corresponding to nonnegative lags are provided (for the ACF). } \examples{ data(ibm) ibm.returns <- diff(log(ibm)) plot(1:length(ibm.returns) - 1, my.acf(ibm.returns), type="h", xlab="lag", ylab="ACVS", main="Autocovariance Sequence for IBM Returns") } \author{ B. Whitcher } \keyword{ts} waveslim/man/heavisine.Rd0000644000176200001440000000117214627105402015120 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{heavisine} \alias{heavisine} \title{Sine with Jumps at 0.3 and 0.72} \format{ A vector containing 512 observations. } \source{ S+WAVELETS. } \usage{ data(heavisine) } \description{ \deqn{heavisine(x) = 4\sin(4{\pi}x) - \mathrm{sign}(x-0.3) - }{% heavisine(x) = 4*sin(4*pi*x) - sign(x-0.3) - sign(0.72-x)}\deqn{ \mathrm{sign}(0.72-x)}{% heavisine(x) = 4*sin(4*pi*x) - sign(x-0.3) - sign(0.72-x)} } \references{ Bruce, A., and H.-Y. Gao (1996) \emph{Applied Wavelet Analysis with S-PLUS}, Springer: New York. } \keyword{datasets} waveslim/man/doppler.Rd0000644000176200001440000000115014627105402014606 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{doppler} \alias{doppler} \title{Sinusoid with Changing Amplitude and Frequency} \format{ A vector containing 512 observations. } \source{ S+WAVELETS. } \usage{ data(doppler) } \description{ \deqn{doppler(x) = \sqrt{x(1 - x)} }{% doppler(x) = sqrt{x(1-x)} sin[(2.1*pi)/(x+0.05)]}\deqn{ \sin\left(\frac{2.1\pi}{x+0.05}\right)}{% doppler(x) = sqrt{x(1-x)} sin[(2.1*pi)/(x+0.05)]} } \references{ Bruce, A., and H.-Y. Gao (1996) \emph{Applied Wavelet Analysis with S-PLUS}, Springer: New York. } \keyword{datasets} waveslim/man/jumpsine.Rd0000644000176200001440000000105714627105402015001 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{jumpsine} \alias{jumpsine} \title{Sine with Jumps at 0.625 and 0.875} \format{ A vector containing 512 observations. } \source{ S+WAVELETS. } \usage{ data(jumpsine) } \description{ \deqn{jumpsine(x) = 10\left( \sin(4{\pi}x) + I_{[0.625 < x \leq 0.875]}\right)}{% jumpsine(x) = 10*(sin(4*pi*x) + I_[0.625 < x <= 0.875])} } \references{ Bruce, A., and H.-Y. Gao (1996) \emph{Applied Wavelet Analysis with S-PLUS}, Springer: New York. } \keyword{datasets} waveslim/man/manual.thresh.Rd0000644000176200001440000000451114627105402015716 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/denoise.R \name{manual.thresh} \alias{manual.thresh} \alias{Thresholding} \alias{da.thresh} \alias{hybrid.thresh} \alias{sure.thresh} \alias{universal.thresh} \alias{universal.thresh.modwt} \alias{bishrink} \alias{soft} \title{Wavelet Shrinkage via Thresholding} \usage{ da.thresh(wc, alpha = .05, max.level = 4, verbose = FALSE, return.thresh = FALSE) hybrid.thresh(wc, max.level = 4, verbose = FALSE, seed = 0) manual.thresh(wc, max.level = 4, value, hard = TRUE) sure.thresh(wc, max.level = 4, hard = TRUE) universal.thresh(wc, max.level = 4, hard = TRUE) universal.thresh.modwt(wc, max.level = 4, hard = TRUE) } \arguments{ \item{wc}{wavelet coefficients} \item{max.level}{maximum level of coefficients to be affected by threshold} \item{value}{threshold value (only utilized in \code{manual.thresh})} \item{hard}{Boolean value, if \code{hard=F} then soft thresholding is used} \item{alpha}{level of the hypothesis tests} \item{verbose}{if \code{verbose=TRUE} then information is printed to the screen} \item{seed}{sets random seed (only utilized in \code{hybrid.thresh})} \item{return.thresh}{if \code{return.thresh=TRUE} then the vector of threshold values is returned, otherwise the surviving wavelet coefficients are returned} } \value{ The default output is a list structure, the same length as was input, containing only those wavelet coefficients surviving the threshold. } \description{ Perform wavelet shrinkage using data-analytic, hybrid SURE, manual, SURE, or universal thresholding. } \details{ An extensive amount of literature has been written on wavelet shrinkage. The functions here represent the most basic approaches to the problem of nonparametric function estimation. See the references for further information. } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. Ogden, R. T. (1996) \emph{Essential Wavelets for Statistical Applications and Data Analysis}, Birkhauser. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. Vidakovic, B. (1999) \emph{Statistical Modeling by Wavelets}, John Wiley and Sons. } \author{ B. Whitcher (some code taken from R. Todd Ogden) } \keyword{ts} waveslim/man/spp.var.Rd0000644000176200001440000000202214627105402014531 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/sdf.R \name{spp.var} \alias{spp.var} \alias{Hypergeometric} \title{Variance of a Seasonal Persistent Process} \usage{ spp.var(d, fG, sigma2 = 1) Hypergeometric(a, b, c, z) } \arguments{ \item{d}{Fractional difference parameter.} \item{fG}{Gegenbauer frequency.} \item{sigma2}{Innovations variance.} \item{a, b, c, z}{Parameters for the hypergeometric series.} } \value{ The variance of an SP process. } \description{ Computes the variance of a seasonal persistent (SP) process using a hypergeometric series expansion. } \details{ See Lapsa (1997). The subroutine to compute a hypergeometric series was taken from \emph{Numerical Recipes in C}. } \references{ Lapsa, P.M. (1997) Determination of Gegenbauer-type random process models. \emph{Signal Processing} \bold{63}, 73-90. Press, W.H., S.A. Teukolsky, W.T. Vetterling and B.P. Flannery (1992) \emph{Numerical Recipes in C}, 2nd edition, Cambridge University Press. } \author{ B. Whitcher } \keyword{ts} waveslim/man/up.sample.Rd0000644000176200001440000000077214627105402015056 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/up.sample.R \name{up.sample} \alias{up.sample} \title{Upsampling of a vector} \usage{ up.sample(x, f, y = NA) } \arguments{ \item{x}{vector of observations} \item{f}{frequency of upsampling; e.g, 2, 4, etc.} \item{y}{value to upsample with; e.g., NA, 0, etc.} } \value{ A vector twice its length. } \description{ Upsamples a given vector. } \references{ Any basic signal processing text. } \author{ B. Whitcher } \keyword{ts} waveslim/man/hilbert.filter.Rd0000644000176200001440000000251114627105402016060 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hilbert.R \name{hilbert.filter} \alias{hilbert.filter} \title{Select a Hilbert Wavelet Pair} \usage{ hilbert.filter(name) } \arguments{ \item{name}{Character string of Hilbert wavelet pair, see acceptable names below (e.g., \code{"k3l3"}).} } \value{ List containing the following items: \item{L}{length of the wavelet filter} \item{h0,g0}{low-pass filter coefficients} \item{h1,g1}{high-pass filter coefficients} } \description{ Converts name of Hilbert wavelet pair to filter coefficients. } \details{ Simple \code{switch} statement selects the appropriate HWP. There are two parameters that define a Hilbert wavelet pair using the notation of Selesnick (2001,2002), \eqn{K} and \eqn{L}. Currently, the only implemented combinations \eqn{(K,L)} are (3,3), (3,5), (4,2) and (4,4). } \examples{ hilbert.filter("k3l3") hilbert.filter("k3l5") hilbert.filter("k4l2") hilbert.filter("k4l4") } \references{ Selesnick, I.W. (2001). Hilbert transform pairs of wavelet bases. \emph{IEEE Signal Processing Letters} \bold{8}(6), 170--173. Selesnick, I.W. (2002). The design of approximate Hilbert transform pairs of wavelet bases. \emph{IEEE Transactions on Signal Processing} \bold{50}(5), 1144--1152. } \seealso{ \code{\link{wave.filter}} } \author{ B. Whitcher } \keyword{ts} waveslim/man/modwt.2d.Rd0000644000176200001440000000515114627105402014604 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/two_D.R \name{modwt.2d} \alias{modwt.2d} \alias{imodwt.2d} \title{Two-Dimensional Maximal Overlap Discrete Wavelet Transform} \usage{ modwt.2d(x, wf, J = 4, boundary = "periodic") imodwt.2d(y) } \arguments{ \item{x}{input matrix} \item{wf}{name of the wavelet filter to use in the decomposition} \item{J}{depth of the decomposition} \item{boundary}{only \code{"periodic"} is currently implemented} \item{y}{an object of class \code{dwt.2d}} } \value{ List structure containing the \eqn{3J+1} sub-matrices from the decomposition. } \description{ Performs a separable two-dimensional maximal overlap discrete wavelet transform (MODWT) on a matrix of arbitrary dimensions. } \details{ See references. } \examples{ ## Xbox image data(xbox) xbox.modwt <- modwt.2d(xbox, "haar", 2) ## Level 1 decomposition par(mfrow=c(2,2), pty="s") image(xbox.modwt$LH1, col=rainbow(128), axes=FALSE, main="LH1") image(xbox.modwt$HH1, col=rainbow(128), axes=FALSE, main="HH1") frame() image(xbox.modwt$HL1, col=rainbow(128), axes=FALSE, main="HL1") ## Level 2 decomposition par(mfrow=c(2,2), pty="s") image(xbox.modwt$LH2, col=rainbow(128), axes=FALSE, main="LH2") image(xbox.modwt$HH2, col=rainbow(128), axes=FALSE, main="HH2") image(xbox.modwt$LL2, col=rainbow(128), axes=FALSE, main="LL2") image(xbox.modwt$HL2, col=rainbow(128), axes=FALSE, main="HL2") sum((xbox - imodwt.2d(xbox.modwt))^2) data(dau) par(mfrow=c(1,1), pty="s") image(dau, col=rainbow(128), axes=FALSE, main="Ingrid Daubechies") sum(dau^2) dau.modwt <- modwt.2d(dau, "d4", 2) ## Level 1 decomposition par(mfrow=c(2,2), pty="s") image(dau.modwt$LH1, col=rainbow(128), axes=FALSE, main="LH1") image(dau.modwt$HH1, col=rainbow(128), axes=FALSE, main="HH1") frame() image(dau.modwt$HL1, col=rainbow(128), axes=FALSE, main="HL1") ## Level 2 decomposition par(mfrow=c(2,2), pty="s") image(dau.modwt$LH2, col=rainbow(128), axes=FALSE, main="LH2") image(dau.modwt$HH2, col=rainbow(128), axes=FALSE, main="HH2") image(dau.modwt$LL2, col=rainbow(128), axes=FALSE, main="LL2") image(dau.modwt$HL2, col=rainbow(128), axes=FALSE, main="HL2") sum((dau - imodwt.2d(dau.modwt))^2) } \references{ Liang, J. and T. W. Parks (1994) A two-dimensional translation invariant wavelet representation and its applications, \emph{Proceedings ICIP-94}, Vol. 1, 66-70. Liang, J. and T. W. Parks (1994) Image coding using translation invariant wavelet transforms with symmetric extensions, \emph{IEEE Transactions on Image Processing}, \bold{7}, No. 5, 762-769. } \seealso{ \code{\link{dwt.2d}}, \code{\link{shift.2d}}. } \author{ B. Whitcher } \keyword{ts} waveslim/man/plot.dwt.2d.Rd0000644000176200001440000000176414627105402015233 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/two_D.R \name{plot.dwt.2d} \alias{plot.dwt.2d} \title{Plot Two-dimensional Discrete Wavelet Transform} \usage{ \method{plot}{dwt.2d}(x, cex.axis = 1, plot = TRUE, ...) } \arguments{ \item{x}{input matrix (image)} \item{cex.axis}{\code{par} plotting parameter that controls the size of the axis text} \item{plot}{if \code{plot = FALSE} then the matrix of wavelet coefficients is returned, the default is \code{plot = TRUE}} \item{...}{additional graphical parameters if necessary} } \value{ Image plot. } \description{ Organizes the wavelet coefficients from a 2D DWT into a single matrix and plots it. The coarser resolutions are nested within the lower-lefthand corner of the image. } \details{ The wavelet coefficients from the DWT object (a list) are reorganized into a single matrix of the same dimension as the original image and the result is plotted. } \seealso{ \code{\link{dwt.2d}}. } \author{ B. Whitcher } \keyword{ts} waveslim/man/modwt.Rd0000644000176200001440000000716614627105402014310 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dwt.R \name{modwt} \alias{modwt} \alias{imodwt} \title{(Inverse) Maximal Overlap Discrete Wavelet Transform} \usage{ modwt(x, wf = "la8", n.levels = 4, boundary = "periodic") imodwt(y) } \arguments{ \item{x}{a vector or time series containing the data be to decomposed. There is \bold{no} restriction on its length.} \item{wf}{Name of the wavelet filter to use in the decomposition. By default this is set to \code{"la8"}, the Daubechies orthonormal compactly supported wavelet of length L=8 (Daubechies, 1992), least asymmetric family.} \item{n.levels}{Specifies the depth of the decomposition. This must be a number less than or equal to log(length(x),2).} \item{boundary}{Character string specifying the boundary condition. If \code{boundary=="periodic"} the defaulTRUE, then the vector you decompose is assumed to be periodic on its defined interval,\cr if \code{boundary=="reflection"}, the vector beyond its boundaries is assumed to be a symmetric reflection of itself.} \item{y}{an object of class \code{"modwt"}} } \value{ Basically, a list with the following components \item{d?}{Wavelet coefficient vectors.} \item{s?}{Scaling coefficient vector.} \item{wavelet}{Name of the wavelet filter used.} \item{boundary}{How the boundaries were handled.} } \description{ This function performs a level \eqn{J} decomposition of the input vector using the non-decimated discrete wavelet transform. The inverse transform performs the reconstruction of a vector or time series from its maximal overlap discrete wavelet transform. } \details{ The code implements the one-dimensional non-decimated DWT using the pyramid algorithm. The actual transform is performed in C using pseudocode from Percival and Walden (2001). That means convolutions, not inner products, are used to apply the wavelet filters. The MODWT goes by several names in the statistical and engineering literature, such as, the ``stationary DWT'', ``translation-invariant DWT'', and ``time-invariant DWT''. The inverse MODWT implements the one-dimensional inverse transform using the pyramid algorithm (Mallat, 1989). } \examples{ ## Figure 4.23 in Gencay, Selcuk and Whitcher (2001) data(ibm) ibm.returns <- diff(log(ibm)) # Haar ibmr.haar <- modwt(ibm.returns, "haar") names(ibmr.haar) <- c("w1", "w2", "w3", "w4", "v4") # LA(8) ibmr.la8 <- modwt(ibm.returns, "la8") names(ibmr.la8) <- c("w1", "w2", "w3", "w4", "v4") # shift the MODWT vectors ibmr.la8 <- phase.shift(ibmr.la8, "la8") ## plot partial MODWT for IBM data par(mfcol=c(6,1), pty="m", mar=c(5-2,4,4-2,2)) plot.ts(ibm.returns, axes=FALSE, ylab="", main="(a)") for(i in 1:5) plot.ts(ibmr.haar[[i]], axes=FALSE, ylab=names(ibmr.haar)[i]) axis(side=1, at=seq(0,368,by=23), labels=c(0,"",46,"",92,"",138,"",184,"",230,"",276,"",322,"",368)) par(mfcol=c(6,1), pty="m", mar=c(5-2,4,4-2,2)) plot.ts(ibm.returns, axes=FALSE, ylab="", main="(b)") for(i in 1:5) plot.ts(ibmr.la8[[i]], axes=FALSE, ylab=names(ibmr.la8)[i]) axis(side=1, at=seq(0,368,by=23), labels=c(0,"",46,"",92,"",138,"",184,"",230,"",276,"",322,"",368)) } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. Percival, D. B. and P. Guttorp (1994) Long-memory processes, the Allan variance and wavelets, In \emph{Wavelets and Geophysics}, pages 325-344, Academic Press. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. } \seealso{ \code{\link{dwt}}, \code{\link{idwt}}, \code{\link{mra}}. } \author{ B. Whitcher } \keyword{ts} waveslim/man/dwt.Rd0000644000176200001440000001016714627105402013747 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dwt.R \name{dwt} \alias{dwt} \alias{dwt.nondyadic} \alias{idwt} \title{Discrete Wavelet Transform (DWT)} \usage{ dwt(x, wf = "la8", n.levels = 4, boundary = "periodic") dwt.nondyadic(x) idwt(y) } \arguments{ \item{x}{a vector or time series containing the data be to decomposed. This must be a dyadic length vector (power of 2).} \item{wf}{Name of the wavelet filter to use in the decomposition. By default this is set to \code{"la8"}, the Daubechies orthonormal compactly supported wavelet of length L=8 (Daubechies, 1992), least asymmetric family.} \item{n.levels}{Specifies the depth of the decomposition. This must be a number less than or equal to log(length(x),2).} \item{boundary}{Character string specifying the boundary condition. If \code{boundary=="periodic"} the default, then the vector you decompose is assumed to be periodic on its defined interval,\cr if \code{boundary=="reflection"}, the vector beyond its boundaries is assumed to be a symmetric reflection of itself.} \item{y}{An object of S3 class \code{dwt}.} } \value{ Basically, a list with the following components \item{d?}{Wavelet coefficient vectors.} \item{s?}{Scaling coefficient vector.} \item{wavelet}{Name of the wavelet filter used.} \item{boundary}{How the boundaries were handled.} } \description{ This function performs a level \eqn{J} decomposition of the input vector or time series using the pyramid algorithm (Mallat 1989). } \details{ The code implements the one-dimensional DWT using the pyramid algorithm (Mallat, 1989). The actual transform is performed in C using pseudocode from Percival and Walden (2001). That means convolutions, not inner products, are used to apply the wavelet filters. For a non-dyadic length vector or time series, \code{dwt.nondyadic} pads with zeros, performs the orthonormal DWT on this dyadic length series and then truncates the wavelet coefficient vectors appropriately. } \examples{ ## Figures 4.17 and 4.18 in Gencay, Selcuk and Whitcher (2001). data(ibm) ibm.returns <- diff(log(ibm)) ## Haar ibmr.haar <- dwt(ibm.returns, "haar") names(ibmr.haar) <- c("w1", "w2", "w3", "w4", "v4") ## plot partial Haar DWT for IBM data par(mfcol=c(6,1), pty="m", mar=c(5-2,4,4-2,2)) plot.ts(ibm.returns, axes=FALSE, ylab="", main="(a)") for(i in 1:4) plot.ts(up.sample(ibmr.haar[[i]], 2^i), type="h", axes=FALSE, ylab=names(ibmr.haar)[i]) plot.ts(up.sample(ibmr.haar$v4, 2^4), type="h", axes=FALSE, ylab=names(ibmr.haar)[5]) axis(side=1, at=seq(0,368,by=23), labels=c(0,"",46,"",92,"",138,"",184,"",230,"",276,"",322,"",368)) ## LA(8) ibmr.la8 <- dwt(ibm.returns, "la8") names(ibmr.la8) <- c("w1", "w2", "w3", "w4", "v4") ## must shift LA(8) coefficients ibmr.la8$w1 <- c(ibmr.la8$w1[-c(1:2)], ibmr.la8$w1[1:2]) ibmr.la8$w2 <- c(ibmr.la8$w2[-c(1:2)], ibmr.la8$w2[1:2]) for(i in names(ibmr.la8)[3:4]) ibmr.la8[[i]] <- c(ibmr.la8[[i]][-c(1:3)], ibmr.la8[[i]][1:3]) ibmr.la8$v4 <- c(ibmr.la8$v4[-c(1:2)], ibmr.la8$v4[1:2]) ## plot partial LA(8) DWT for IBM data par(mfcol=c(6,1), pty="m", mar=c(5-2,4,4-2,2)) plot.ts(ibm.returns, axes=FALSE, ylab="", main="(b)") for(i in 1:4) plot.ts(up.sample(ibmr.la8[[i]], 2^i), type="h", axes=FALSE, ylab=names(ibmr.la8)[i]) plot.ts(up.sample(ibmr.la8$v4, 2^4), type="h", axes=FALSE, ylab=names(ibmr.la8)[5]) axis(side=1, at=seq(0,368,by=23), labels=c(0,"",46,"",92,"",138,"",184,"",230,"",276,"",322,"",368)) } \references{ Daubechies, I. (1992) \emph{Ten Lectures on Wavelets}, CBMS-NSF Regional Conference Series in Applied Mathematics, SIAM: Philadelphia. Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. Mallat, S. G. (1989) A theory for multiresolution signal decomposition: the wavelet representation, \emph{IEEE Transactions on Pattern Analysis and Machine Intelligence}, \bold{11}(7), 674--693. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. } \seealso{ \code{\link{modwt}}, \code{\link{mra}}. } \author{ B. Whitcher } \keyword{ts} waveslim/man/mult.loc.Rd0000644000176200001440000000270214627105402014702 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/multiple.R \name{mult.loc} \alias{mult.loc} \title{Wavelet-based Testing and Locating for Variance Change Points} \usage{ mult.loc(dwt.list, modwt.list, wf, level, min.coef, debug) } \arguments{ \item{dwt.list}{List of wavelet vector coefficients from the \code{dwt}.} \item{modwt.list}{List of wavelet vector coefficients from the \code{modwt}.} \item{wf}{Name of the wavelet filter to use in the decomposition.} \item{level}{Specifies the depth of the decomposition.} \item{min.coef}{Minimum number of wavelet coefficients for testing purposes.} \item{debug}{Boolean variable: if set to \code{TRUE}, actions taken by the algorithm are printed to the screen.} } \value{ Matrix. } \description{ This is the major subroutine for \code{\link{testing.hov}}, providing the workhorse algorithm to recursively test and locate multiple variance changes in so-called long memory processes. } \details{ For details see Section 9.6 of Percival and Walden (2000) or Section 7.3 in Gencay, Selcuk and Whitcher (2001). } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. } \seealso{ \code{\link{rotcumvar}}, \code{\link{testing.hov}}. } \author{ B. Whitcher } \keyword{ts} waveslim/man/spin.covariance.Rd0000644000176200001440000000502514627105401016227 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cov.R \name{spin.covariance} \alias{spin.covariance} \alias{spin.correlation} \title{Compute Wavelet Cross-Covariance Between Two Time Series} \usage{ spin.covariance(x, y, lag.max = NA) spin.correlation(x, y, lag.max = NA) } \arguments{ \item{x}{first time series} \item{y}{second time series, same length as \code{x}} \item{lag.max}{maximum lag to compute cross-covariance (correlation)} } \value{ List structure holding the wavelet cross-covariances (correlations) according to scale. } \description{ Computes wavelet cross-covariance or cross-correlation between two time series. } \details{ See references. } \examples{ ## Figure 7.9 from Gencay, Selcuk and Whitcher (2001) data(exchange) returns <- diff(log(exchange)) returns <- ts(returns, start=1970, freq=12) wf <- "d4" demusd.modwt <- modwt(returns[,"DEM.USD"], wf, 8) demusd.modwt.bw <- brick.wall(demusd.modwt, wf) jpyusd.modwt <- modwt(returns[,"JPY.USD"], wf, 8) jpyusd.modwt.bw <- brick.wall(jpyusd.modwt, wf) n <- dim(returns)[1] J <- 6 lmax <- 36 returns.cross.cor <- NULL for(i in 1:J) { blah <- spin.correlation(demusd.modwt.bw[[i]], jpyusd.modwt.bw[[i]], lmax) returns.cross.cor <- cbind(returns.cross.cor, blah) } returns.cross.cor <- ts(as.matrix(returns.cross.cor), start=-36, freq=1) dimnames(returns.cross.cor) <- list(NULL, paste("Level", 1:J)) lags <- length(-lmax:lmax) lower.ci <- tanh(atanh(returns.cross.cor) - qnorm(0.975) / sqrt(matrix(trunc(n/2^(1:J)), nrow=lags, ncol=J, byrow=TRUE) - 3)) upper.ci <- tanh(atanh(returns.cross.cor) + qnorm(0.975) / sqrt(matrix(trunc(n/2^(1:J)), nrow=lags, ncol=J, byrow=TRUE) - 3)) par(mfrow=c(3,2), las=1, pty="m", mar=c(5,4,4,2)+.1) for(i in J:1) { plot(returns.cross.cor[,i], ylim=c(-1,1), xaxt="n", xlab="Lag (months)", ylab="", main=dimnames(returns.cross.cor)[[2]][i]) axis(side=1, at=seq(-36, 36, by=12)) lines(lower.ci[,i], lty=1, col=2) lines(upper.ci[,i], lty=1, col=2) abline(h=0,v=0) } } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. Whitcher, B., P. Guttorp and D. B. Percival (2000) Wavelet analysis of covariance with application to atmospheric time series, \emph{Journal of Geophysical Research}, \bold{105}, No. D11, 14,941-14,962. } \seealso{ \code{\link{wave.covariance}}, \code{\link{wave.correlation}}. } \author{ B. Whitcher } \keyword{ts} waveslim/man/mra.2d.Rd0000644000176200001440000000545314627105402014236 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/mra.2d.R \name{mra.2d} \alias{mra.2d} \title{Multiresolution Analysis of an Image} \usage{ mra.2d(x, wf = "la8", J = 4, method = "modwt", boundary = "periodic") } \arguments{ \item{x}{A matrix or image containing the data be to decomposed. This must be have dyadic length in both dimensions (but not necessarily the same) for \code{method="dwt"}.} \item{wf}{Name of the wavelet filter to use in the decomposition. By default this is set to \code{"la8"}, the Daubechies orthonormal compactly supported wavelet of length L=8 least asymmetric family.} \item{J}{Specifies the depth of the decomposition. This must be a number less than or equal to log(length(x),2).} \item{method}{Either \code{"dwt"} or \code{"modwt"}.} \item{boundary}{Character string specifying the boundary condition. If \code{boundary=="periodic"} the default, then the matrix you decompose is assumed to be periodic on its defined interval,\cr if \code{boundary=="reflection"}, the matrix beyond its boundaries is assumed to be a symmetric reflection of itself.} } \value{ Basically, a list with the following components \item{LH?}{Wavelet detail image in the horizontal direction.} \item{HL?}{Wavelet detail image in the vertical direction.} \item{HH?}{Wavelet detail image in the diagonal direction.} \item{LLJ}{Wavelet smooth image at the coarsest resolution.} \item{J}{Depth of the wavelet transform.} \item{wavelet}{Name of the wavelet filter used.} \item{boundary}{How the boundaries were handled.} } \description{ This function performs a level \eqn{J} additive decomposition of the input matrix or image using the pyramid algorithm (Mallat 1989). } \details{ This code implements a two-dimensional multiresolution analysis by performing the one-dimensional pyramid algorithm (Mallat 1989) on the rows and columns of the input matrix. Either the DWT or MODWT may be used to compute the multiresolution analysis, which is an additive decomposition of the original matrix (image). } \examples{ ## Easy check to see if it works... ## -------------------------------- x <- matrix(rnorm(32*32), 32, 32) # MODWT x.mra <- mra.2d(x, method="modwt") x.mra.sum <- x.mra[[1]] for(j in 2:length(x.mra)) x.mra.sum <- x.mra.sum + x.mra[[j]] sum((x - x.mra.sum)^2) # DWT x.mra <- mra.2d(x, method="dwt") x.mra.sum <- x.mra[[1]] for(j in 2:length(x.mra)) x.mra.sum <- x.mra.sum + x.mra[[j]] sum((x - x.mra.sum)^2) } \references{ Mallat, S. G. (1989) A theory for multiresolution signal decomposition: the wavelet representation, \emph{IEEE Transactions on Pattern Analysis and Machine Intelligence}, \bold{11}, No. 7, 674-693. Mallat, S. G. (1998) \emph{A Wavelet Tour of Signal Processing}, Academic Press. } \seealso{ \code{\link{dwt.2d}}, \code{\link{modwt.2d}} } \author{ B. Whitcher } \keyword{ts} waveslim/man/per.Rd0000644000176200001440000000054714627105402013740 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/periodogram.R \name{per} \alias{per} \title{Periodogram} \usage{ per(z) } \arguments{ \item{z}{time series} } \description{ Computation of the periodogram via the Fast Fourier Transform (FFT). } \author{ Author: Jan Beran; modified: Martin Maechler, Date: Sep 1995. } \keyword{ts} waveslim/man/dwt.hilbert.Rd0000644000176200001440000000316314627105402015375 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hilbert.R \name{dwt.hilbert} \alias{dwt.hilbert} \alias{dwt.hilbert.nondyadic} \alias{idwt.hilbert} \alias{modwt.hilbert} \alias{imodwt.hilbert} \alias{modwpt.hilbert} \title{Discrete Hilbert Wavelet Transforms} \usage{ dwt.hilbert(x, wf, n.levels = 4, boundary = "periodic", ...) dwt.hilbert.nondyadic(x, ...) idwt.hilbert(y) modwt.hilbert(x, wf, n.levels = 4, boundary = "periodic", ...) imodwt.hilbert(y) modwpt.hilbert(x, wf, n.levels = 4, boundary = "periodic") } \arguments{ \item{x}{Real-valued time series or vector of observations.} \item{wf}{Hilbert wavelet pair} \item{n.levels}{Number of levels (depth) of the wavelet transform.} \item{boundary}{Boundary treatment, currently only \code{periodic} and \code{reflection}.} \item{\ldots}{Additional parametes to be passed on.} \item{y}{An object of S3 class \code{dwt.hilbert}.} } \value{ Hilbert wavelet transform object (list). } \description{ The discrete Hilbert wavelet transforms (DHWTs) for seasonal and time-varying time series analysis. Transforms include the usual orthogonal (decimated), maximal-overlap (non-decimated) and maximal-overlap packet transforms. } \references{ Selesnick, I. (200X). \emph{IEEE Signal Processing Magazine} Selesnick, I. (200X). \emph{IEEE Transactions in Signal Processing} Whither, B. and P.F. Craigmile (2004). Multivariate Spectral Analysis Using Hilbert Wavelet Pairs, \emph{International Journal of Wavelets, Multiresolution and Information Processing}, \bold{2}(4), 567--587. } \seealso{ \code{\link{hilbert.filter}} } \author{ B. Whitcher } \keyword{ts} waveslim/man/dwt.3d.Rd0000644000176200001440000000125314627105402014250 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/three_D.R \name{dwt.3d} \alias{dwt.3d} \alias{idwt.3d} \title{Three Dimensional Separable Discrete Wavelet Transform} \usage{ dwt.3d(x, wf, J = 4, boundary = "periodic") idwt.3d(y) } \arguments{ \item{x}{input array} \item{wf}{name of the wavelet filter to use in the decomposition} \item{J}{depth of the decomposition, must be a number less than or equal to log(minZ,Y,Z,2)} \item{boundary}{only \code{"periodic"} is currently implemented} \item{y}{an object of class \code{dwt.3d}} } \description{ Three-dimensional separable discrete wavelet transform (DWT). } \author{ B. Whitcher } \keyword{ts} waveslim/man/barbara.Rd0000644000176200001440000000057314627105401014542 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{barbara} \alias{barbara} \title{Barbara Test Image} \format{ A 256 \eqn{\times}{x} 256 matrix. } \source{ Internet. } \usage{ data(barbara) } \description{ The Barbara image comes from Allen Gersho's lab at the University of California, Santa Barbara. } \keyword{datasets} waveslim/man/linchirp.Rd0000644000176200001440000000073714627105402014763 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{linchirp} \alias{linchirp} \title{Linear Chirp} \format{ A vector containing 512 observations. } \source{ S+WAVELETS. } \usage{ data(linchirp) } \description{ \deqn{linchirp(x) = \sin(0.125 \pi n x^2)}{% linchirp(x) = sin(0.125*pi*n*x^2)} } \references{ Bruce, A., and H.-Y. Gao (1996) \emph{Applied Wavelet Analysis with S-PLUS}, Springer: New York. } \keyword{datasets} waveslim/man/cshift.Rd0000644000176200001440000000130614627105402014424 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dualtree.R \name{cshift} \alias{cshift} \alias{cshift2D} \alias{pm} \title{Miscellaneous Functions for Dual-Tree Wavelet Software} \usage{ cshift(x, m) cshift2D(x, m) pm(a, b) } \arguments{ \item{x}{N-point vector} \item{m}{amount of shift} \item{a, b}{input parameters} } \value{ \item{y}{vector \code{x} will be shifed by \code{m} samples to the left or matrix \code{x} will be shifed by \code{m} samples down.} \item{u}{(a + b) / sqrt(2)} \item{v}{(a - b) / sqrt(2)} } \description{ Miscellaneous functions for dual-tree wavelet software. } \author{ Matlab: S. Cai, K. Li and I. Selesnick; R port: B. Whitcher } \keyword{ts} waveslim/man/fdp.sdf.Rd0000644000176200001440000000316314627105402014473 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/sdf.R \name{fdp.sdf} \alias{fdp.sdf} \alias{spp.sdf} \alias{spp2.sdf} \alias{sfd.sdf} \title{Spectral Density Functions for Long-Memory Processes} \usage{ fdp.sdf(freq, d, sigma2 = 1) spp.sdf(freq, d, fG, sigma2 = 1) spp2.sdf(freq, d1, f1, d2, f2, sigma2 = 1) sfd.sdf(freq, s, d, sigma2 = 1) } \arguments{ \item{freq}{vector of frequencies, normally from 0 to 0.5} \item{d, d1, d2}{fractional difference parameter} \item{sigma2}{innovations variance} \item{fG, f1, f2}{Gegenbauer frequency} \item{s}{seasonal parameter} } \value{ The power spectrum from an FD, SP or SFD process. } \description{ Draws the spectral density functions (SDFs) for standard long-memory processes including fractional difference (FD), seasonal persistent (SP), and seasonal fractional difference (SFD) processes. } \examples{ dB <- function(x) 10 * log10(x) fdp.main <- expression(paste("FD", group("(",d==0.4,")"))) sfd.main <- expression(paste("SFD", group("(",list(s==12, d==0.4),")"))) spp.main <- expression(paste("SPP", group("(",list(delta==0.4, f[G]==1/12),")"))) freq <- 0:512/1024 par(mfrow=c(2,2), mar=c(5-1,4,4-1,2), col.main="darkred") plot(freq, dB(fdp.sdf(freq, .4)), type="l", xlab="frequency", ylab="spectrum (dB)", main=fdp.main) plot(freq, dB(spp.sdf(freq, .4, 1/12)), type="l", xlab="frequency", ylab="spectrum (dB)", font.main=1, main=spp.main) plot(freq, dB(sfd.sdf(freq, 12, .4)), type="l", xlab="frequency", ylab="spectrum (dB)", main=sfd.main) } \seealso{ \code{\link{fdp.mle}}, \code{\link{spp.mle}}. } \author{ B. Whitcher } \keyword{ts} waveslim/man/qmf.Rd0000644000176200001440000000132614627105402013731 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/wave.filter.R \name{qmf} \alias{qmf} \title{Quadrature Mirror Filter} \usage{ qmf(g, low2high = TRUE) } \arguments{ \item{g}{Filter coefficients.} \item{low2high}{Logical, default is \code{TRUE} which means a low-pass filter is input and a high-pass filter is output. Setting \code{low2high=F} performs the inverse.} } \value{ Quadrature mirror filter. } \description{ Computes the quadrature mirror filter from a given filter. } \details{ None. } \examples{ ## Haar wavelet filter g <- wave.filter("haar")$lpf qmf(g) } \references{ Any basic signal processing text. } \seealso{ \code{\link{wave.filter}}. } \author{ B. Whitcher } \keyword{ts} waveslim/man/dwpt.sim.Rd0000644000176200001440000000460714627105402014720 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dwpt_sim.R \name{dwpt.sim} \alias{dwpt.sim} \title{Simulate Seasonal Persistent Processes Using the DWPT} \usage{ dwpt.sim(N, wf, delta, fG, M = 2, adaptive = TRUE, epsilon = 0.05) } \arguments{ \item{N}{Length of time series to be generated.} \item{wf}{Character string for the wavelet filter.} \item{delta}{Long-memory parameter for the seasonal persistent process.} \item{fG}{Gegenbauer frequency.} \item{M}{Actual length of simulated time series.} \item{adaptive}{Logical; if \code{TRUE} the orthonormal basis used in the DWPT is adapted to the ideal spectrum, otherwise the orthonormal basis is performed to a maximum depth.} \item{epsilon}{Threshold for adaptive basis selection.} } \value{ Time series of length \code{N}. } \description{ A seasonal persistent process may be characterized by a spectral density function with an asymptote occuring at a particular frequency in \eqn{[0,\frac{1}{2})}{[0,1/2)}. It's time domain representation was first noted in passing by Hosking (1981). Although an exact time-domain approach to simulation is possible, this function utilizes the discrete wavelet packet transform (DWPT). } \details{ Two subroutines are used, the first selects an adaptive orthonormal basis for the true spectral density function (SDF) while the second computes the bandpass variances associated with the chosen orthonormal basis and SDF. Finally, when \eqn{M>N}{\code{M} > \code{N}} a uniform random variable is generated in order to select a random piece of the simulated time series. For more details see Whitcher (2001). } \examples{ ## Generate monthly time series with annual oscillation ## library(ts) is required in order to access acf() x <- dwpt.sim(256, "mb16", .4, 1/12, M=4, epsilon=.001) par(mfrow=c(2,1)) plot(x, type="l", xlab="Time") acf(x, lag.max=128, ylim=c(-.6,1)) data(acvs.andel8) lines(acvs.andel8$lag[1:128], acvs.andel8$acf[1:128], col=2) } \references{ Hosking, J. R. M. (1981) Fractional Differencing, \emph{Biometrika}, \bold{68}, No. 1, 165-176. Whitcher, B. (2001) Simulating Gaussian Stationary Time Series with Unbounded Spectra, \emph{Journal of Computational and Graphical Statistics}, \bold{10}, No. 1, 112-134. } \seealso{ \code{\link{hosking.sim}} for an exact time-domain method and \code{\link{wave.filter}} for a list of available wavelet filters. } \author{ B. Whitcher } \keyword{ts} waveslim/man/xbox.Rd0000644000176200001440000000131514627105402014124 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{xbox} \alias{xbox} \title{Image with Box and X} \format{ A 128 \eqn{\times}{x} 128 matrix. } \source{ S+WAVELETS. } \usage{ data(xbox) } \description{ \deqn{xbox(i,j) = I_{[i=n/4,\;3n/4,\;j;~ n/4 \leq j \leq 3n/4]} + }{% xbox(i,j) = I_[i = n/4, 3n/4, j; n/4 \leq j \leq 3n/4] + I_[n/4 \leq i \leq 3n/4; j = n/4, 3n/4, i]}\deqn{ I_{[n/4 \leq i \leq 3n/4;~ j=n/4,\;3n/4,\;i]}}{% xbox(i,j) = I_[i = n/4, 3n/4, j; n/4 \leq j \leq 3n/4] + I_[n/4 \leq i \leq 3n/4; j = n/4, 3n/4, i]} } \references{ Bruce, A., and H.-Y. Gao (1996) \emph{Applied Wavelet Analysis with S-PLUS}, Springer: New York. } \keyword{datasets} waveslim/man/convolve2D.Rd0000644000176200001440000000236014627105402015166 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dualtree2D.R \name{convolve2D} \alias{convolve2D} \title{Fast Column-wise Convolution of a Matrix} \usage{ convolve2D(x, y, conj = TRUE, type = c("circular", "open")) } \arguments{ \item{x}{MxN matrix.} \item{y}{numeric sequence of length N.} \item{conj}{logical; if \code{TRUE}, take the complex \emph{conjugate} before back-transforming (default, and used for usual convolution).} \item{type}{character; one of \code{circular}, \code{open} (beginning of word is ok). For \code{circular}, the two sequences are treated as \emph{circular}, i.e., periodic. For \code{open} and \code{filter}, the sequences are padded with zeros (from left and right) first; \code{filter} returns the middle sub-vector of \code{open}, namely, the result of running a weighted mean of \code{x} with weights \code{y}.} } \description{ Use the Fast Fourier Transform to perform convolutions between a sequence and each column of a matrix. } \details{ This is a corrupted version of \code{convolve} made by replacing \code{fft} with \code{mvfft} in a few places. It would be nice to submit this to the R Developers for inclusion. } \seealso{ \code{\link{convolve}} } \author{ B. Whitcher } \keyword{ts} waveslim/man/fdp.mle.Rd0000644000176200001440000000472014627105402014474 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/fdp.R \name{fdp.mle} \alias{fdp.mle} \title{Wavelet-based Maximum Likelihood Estimation for a Fractional Difference Process} \usage{ fdp.mle(y, wf, J = log(length(y), 2)) } \arguments{ \item{y}{Dyadic length time series.} \item{wf}{Name of the wavelet filter to use in the decomposition. See \code{\link{wave.filter}} for those wavelet filters available.} \item{J}{Depth of the discrete wavelet transform.} } \value{ List containing the maximum likelihood estimates (MLEs) of \eqn{d} and \eqn{\sigma^2}, along with the value of the likelihood for those estimates. } \description{ Parameter estimation for a fractional difference (long-memory, self-similar) process is performed via maximum likelihood on the wavelet coefficients. } \details{ The variance-covariance matrix of the original time series is approximated by its wavelet-based equivalent. A Whittle-type likelihood is then constructed where the sums of squared wavelet coefficients are compared to bandpass filtered version of the true spectrum. Minimization occurs only for the fractional difference parameter \eqn{d}, while variance is estimated afterwards. } \examples{ ## Figure 5.5 in Gencay, Selcuk and Whitcher (2001) fdp.sdf <- function(freq, d, sigma2=1) sigma2 / ((2*sin(pi * freq))^2)^d dB <- function(x) 10 * log10(x) per <- function(z) { n <- length(z) (Mod(fft(z))**2/(2*pi*n))[1:(n \%/\% 2 + 1)] } data(ibm) ibm.returns <- diff(log(ibm)) ibm.volatility <- abs(ibm.returns) ibm.vol.mle <- fdp.mle(ibm.volatility, "d4", 4) freq <- 0:184/368 ibm.vol.per <- 2 * pi * per(ibm.volatility) ibm.vol.resid <- ibm.vol.per/ fdp.sdf(freq, ibm.vol.mle$parameters[1]) par(mfrow=c(1,1), las=0, pty="m") plot(freq, dB(ibm.vol.per), type="l", xlab="Frequency", ylab="Spectrum") lines(freq, dB(fdp.sdf(freq, ibm.vol.mle$parameters[1], ibm.vol.mle$parameters[2]/2)), col=2) } \references{ M. J. Jensen (2000) An alternative maximum likelihood estimator of long-memory processes using compactly supported wavelets, \emph{Journal of Economic Dynamics and Control}, \bold{24}, No. 3, 361-387. McCoy, E. J., and A. T. Walden (1996) Wavelet analysis and synthesis of stationary long-memory processes, \emph{Journal for Computational and Graphical Statistics}, \bold{5}, No. 1, 26-56. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. } \author{ B. Whitcher } \keyword{ts} waveslim/man/dau.Rd0000644000176200001440000000112614627105402013715 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{dau} \alias{dau} \title{Digital Photograph of Ingrid Daubechies} \format{ A 256 \eqn{\times}{x} 256 matrix. } \source{ S+WAVELETS. } \usage{ data(dau) } \description{ A digital photograph of Ingrid Daubechies taken at the 1993 AMS winter meetings in San Antonio, Texas. The photograph was taken by David Donoho with a Canon XapShot video still frame camera. } \references{ Bruce, A., and H.-Y. Gao (1996) \emph{Applied Wavelet Analysis with S-PLUS}, Springer: New York. } \keyword{datasets} waveslim/man/dwpt.2d.Rd0000644000176200001440000000505214627105402014430 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/two_D.R \name{dwpt.2d} \alias{dwpt.2d} \alias{idwpt.2d} \title{(Inverse) Discrete Wavelet Packet Transforms in Two Dimensions} \usage{ dwpt.2d(x, wf = "la8", J = 4, boundary = "periodic") idwpt.2d(y, y.basis) } \arguments{ \item{x}{a matrix or image containing the data be to decomposed. This ojbect must be dyadic (power of 2) in length in each dimension.} \item{wf}{Name of the wavelet filter to use in the decomposition. By default this is set to \code{"la8"}, the Daubechies orthonormal compactly supported wavelet of length \eqn{L=8} (Daubechies, 1992), least asymmetric family.} \item{J}{Specifies the depth of the decomposition. This must be a number less than or equal to \eqn{\log(\mbox{length}(x),2)}.} \item{boundary}{Character string specifying the boundary condition. If \code{boundary=="periodic"} the default, then the vector you decompose is assumed to be periodic on its defined interval,\cr if \code{boundary=="reflection"}, the vector beyond its boundaries is assumed to be a symmetric reflection of itself.} \item{y}{\code{dwpt.2d} object (list-based structure of matrices)} \item{y.basis}{Boolean vector, the same length as \eqn{y}, where \code{TRUE} means the basis tensor should be used in the reconstruction.} } \value{ Basically, a list with the following components \item{w?.?-w?.?}{Wavelet coefficient matrices (images). The first index is associated with the scale of the decomposition while the second is associated with the frequency partition within that level. The left and right strings, separated by the dash `-', correspond to the first \eqn{(x)} and second \eqn{(y)} dimensions.} \item{wavelet}{Name of the wavelet filter used.} \item{boundary}{How the boundaries were handled.} } \description{ All possible filtering combinations (low- and high-pass) are performed to decompose a matrix or image. The resulting coefficients are associated with a quad-tree structure corresponding to a partitioning of the two-dimensional frequency plane. } \details{ The code implements the two-dimensional DWPT using the pyramid algorithm of Mallat (1989). } \references{ Mallat, S. G. (1989) A theory for multiresolution signal decomposition: the wavelet representation, \emph{IEEE Transactions on Pattern Analysis and Machine Intelligence}, \bold{11}, No. 7, 674-693. Wickerhauser, M. V. (1994) \emph{Adapted Wavelet Analysis from Theory to Software}, A K Peters. } \seealso{ \code{\link{dwt.2d}}, \code{\link{modwt.2d}}, \code{\link{wave.filter}}. } \author{ B. Whitcher } \keyword{ts} waveslim/man/wave.variance.2d.Rd0000644000176200001440000000177314627105402016211 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/var_2D.R \name{wave.variance.2d} \alias{wave.variance.2d} \title{Wavelet Analysis of Images} \usage{ wave.variance.2d(x, p = 0.025) } \arguments{ \item{x}{image} \item{p}{(one minus the) two-sided p-value for the confidence interval} } \value{ Data frame with 3J+1 rows. } \description{ Produces an estimate of the multiscale variance with approximate confidence intervals using the 2D MODWT. } \details{ The wavelet variance is basically the average of the squared wavelet coefficients across each scale and direction of an image. As shown in Mondal and Percival (2012), the wavelet variance is a scale-by-scale decomposition of the variance for a stationary spatial process, and certain non-stationary spatial processes. } \references{ Mondal, D. and D. B. Percival (2012). Wavelet variance analysis for random fields on a regular lattice. \emph{IEEE Transactions on Image Processing} \bold{21}, 537–549. } \author{ B. Whitcher } waveslim/man/afb.Rd0000644000176200001440000000555614627105402013707 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dualtree.R \name{afb} \alias{afb} \alias{afb2D} \alias{afb2D.A} \alias{sfb} \alias{sfb2D} \alias{sfb2D.A} \title{Filter Banks for Dual-Tree Wavelet Transforms} \usage{ afb(x, af) afb2D(x, af1, af2 = NULL) afb2D.A(x, af, d) sfb(lo, hi, sf) sfb2D(lo, hi, sf1, sf2 = NULL) sfb2D.A(lo, hi, sf, d) } \arguments{ \item{x}{vector or matrix of observations} \item{af}{analysis filters. First element of the list is the low-pass filter, second element is the high-pass filter.} \item{af1, af2}{analysis filters for the first and second dimension of a 2D array.} \item{sf}{synthesis filters. First element of the list is the low-pass filter, second element is the high-pass filter.} \item{sf1, sf2}{synthesis filters for the first and second dimension of a 2D array.} \item{d}{dimension of filtering (d = 1 or 2)} \item{lo}{low-frequecy coefficients} \item{hi}{high-frequency coefficients} } \value{ In one dimension the output for the analysis filter bank (\code{afb}) is a list with two elements \item{lo}{Low frequecy output} \item{hi}{High frequency output} and the output for the synthesis filter bank (\code{sfb}) is the output signal. In two dimensions the output for the analysis filter bank (\code{afb2D}) is a list with four elements \item{lo}{low-pass subband} \item{hi[[1]]}{'lohi' subband} \item{hi[[2]]}{'hilo' subband} \item{hi[[3]]}{'hihi' subband} and the output for the synthesis filter bank (\code{sfb2D}) is the output array. } \description{ Analysis and synthesis filter banks used in dual-tree wavelet algorithms. } \details{ The functions \code{afb2D.A} and \code{sfb2D.A} implement the convolutions, either for analysis or synthesis, in one dimension only. Thus, they are the workhorses of \code{afb2D} and \code{sfb2D}. The output for the analysis filter bank along one dimension (\code{afb2D.A}) is a list with two elements \describe{ \item{lo}{low-pass subband} \item{hi}{high-pass subband} } where the dimension of analysis will be half its original length. The output for the synthesis filter bank along one dimension (\code{sfb2D.A}) will be the output array, where the dimension of synthesis will be twice its original length. } \examples{ ## EXAMPLE: afb, sfb af = farras()$af sf = farras()$sf x = rnorm(64) x.afb = afb(x, af) lo = x.afb$lo hi = x.afb$hi y = sfb(lo, hi, sf) err = x - y max(abs(err)) ## EXAMPLE: afb2D, sfb2D x = matrix(rnorm(32*64), 32, 64) af = farras()$af sf = farras()$sf x.afb2D = afb2D(x, af, af) lo = x.afb2D$lo hi = x.afb2D$hi y = sfb2D(lo, hi, sf, sf) err = x - y max(abs(err)) ## Example: afb2D.A, sfb2D.A x = matrix(rnorm(32*64), 32, 64) af = farras()$af sf = farras()$sf x.afb2D.A = afb2D.A(x, af, 1) lo = x.afb2D.A$lo hi = x.afb2D.A$hi y = sfb2D.A(lo, hi, sf, 1) err = x - y max(abs(err)) } \author{ Matlab: S. Cai, K. Li and I. Selesnick; R port: B. Whitcher } \keyword{ts} waveslim/man/mra.Rd0000644000176200001440000000650014627105402013724 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dwt.R \name{mra} \alias{mra} \title{Multiresolution Analysis of Time Series} \usage{ mra(x, wf = "la8", J = 4, method = "modwt", boundary = "periodic") } \arguments{ \item{x}{A vector or time series containing the data be to decomposed. This must be a dyadic length vector (power of 2) for \code{method="dwt"}.} \item{wf}{Name of the wavelet filter to use in the decomposition. By default this is set to \code{"la8"}, the Daubechies orthonormal compactly supported wavelet of length L=8 least asymmetric family.} \item{J}{Specifies the depth of the decomposition. This must be a number less than or equal to log(length(x), 2).} \item{method}{Either \code{"dwt"} or \code{"modwt"}.} \item{boundary}{Character string specifying the boundary condition. If \code{boundary=="periodic"} the default, then the vector you decompose is assumed to be periodic on its defined interval,\cr if \code{boundary=="reflection"}, the vector beyond its boundaries is assumed to be a symmetric reflection of itself.} } \value{ Basically, a list with the following components \item{D?}{Wavelet detail vectors.} \item{S?}{Wavelet smooth vector.} \item{wavelet}{Name of the wavelet filter used.} \item{boundary}{How the boundaries were handled.} } \description{ This function performs a level \eqn{J} additive decomposition of the input vector or time series using the pyramid algorithm (Mallat 1989). } \details{ This code implements a one-dimensional multiresolution analysis introduced by Mallat (1989). Either the DWT or MODWT may be used to compute the multiresolution analysis, which is an additive decomposition of the original time series. } \examples{ ## Easy check to see if it works... x <- rnorm(32) x.mra <- mra(x) sum(x - apply(matrix(unlist(x.mra), nrow=32), 1, sum))^2 ## Figure 4.19 in Gencay, Selcuk and Whitcher (2001) data(ibm) ibm.returns <- diff(log(ibm)) ibm.volatility <- abs(ibm.returns) ## Haar ibmv.haar <- mra(ibm.volatility, "haar", 4, "dwt") names(ibmv.haar) <- c("d1", "d2", "d3", "d4", "s4") ## LA(8) ibmv.la8 <- mra(ibm.volatility, "la8", 4, "dwt") names(ibmv.la8) <- c("d1", "d2", "d3", "d4", "s4") ## plot multiresolution analysis of IBM data par(mfcol=c(6,1), pty="m", mar=c(5-2,4,4-2,2)) plot.ts(ibm.volatility, axes=FALSE, ylab="", main="(a)") for(i in 1:5) plot.ts(ibmv.haar[[i]], axes=FALSE, ylab=names(ibmv.haar)[i]) axis(side=1, at=seq(0,368,by=23), labels=c(0,"",46,"",92,"",138,"",184,"",230,"",276,"",322,"",368)) par(mfcol=c(6,1), pty="m", mar=c(5-2,4,4-2,2)) plot.ts(ibm.volatility, axes=FALSE, ylab="", main="(b)") for(i in 1:5) plot.ts(ibmv.la8[[i]], axes=FALSE, ylab=names(ibmv.la8)[i]) axis(side=1, at=seq(0,368,by=23), labels=c(0,"",46,"",92,"",138,"",184,"",230,"",276,"",322,"",368)) } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. Mallat, S. G. (1989) A theory for multiresolution signal decomposition: the wavelet representation, \emph{IEEE Transactions on Pattern Analysis and Machine Intelligence}, \bold{11}, No. 7, 674-693. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. } \seealso{ \code{\link{dwt}}, \code{\link{modwt}}. } \author{ B. Whitcher } \keyword{ts} waveslim/man/basis.Rd0000644000176200001440000000225514627105402014251 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dwpt.R \name{basis} \alias{basis} \title{Produce Boolean Vector from Wavelet Basis Names} \usage{ basis(x, basis.names) } \arguments{ \item{x}{Output from the discrete wavelet package transfrom (DWPT).} \item{basis.names}{Vector of character strings that describe leaves on the DWPT basis tree. See the examples below for appropriate syntax.} } \value{ Vector of zeros and ones. } \description{ Produce a vector of zeros and ones from a vector of basis names. } \details{ None. } \examples{ data(acvs.andel8) \dontrun{ x <- hosking.sim(1024, acvs.andel8[,2]) x.dwpt <- dwpt(x, "la8", 7) ## Select orthonormal basis from wavelet packet tree x.basis <- basis(x.dwpt, c("w1.1","w2.1","w3.0","w4.3","w5.4","w6.10", "w7.22","w7.23")) for(i in 1:length(x.dwpt)) x.dwpt[[i]] <- x.basis[i] * x.dwpt[[i]] ## Resonstruct original series using selected orthonormal basis y <- idwpt(x.dwpt, x.basis) par(mfrow=c(2,1), mar=c(5-1,4,4-1,2)) plot.ts(x, xlab="", ylab="", main="Original Series") plot.ts(y, xlab="", ylab="", main="Reconstructed Series") } } \seealso{ \code{\link{dwpt}}. } \keyword{ts} waveslim/man/find.adaptive.basis.Rd0000644000176200001440000000241014627105402016755 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dwpt_sim.R \name{find.adaptive.basis} \alias{find.adaptive.basis} \title{Determine an Orthonormal Basis for the Discrete Wavelet Packet Transform} \usage{ find.adaptive.basis(wf, J, fG, eps) } \arguments{ \item{wf}{Character string; name of the wavelet filter.} \item{J}{Depth of the discrete wavelet packet transform.} \item{fG}{Gegenbauer frequency.} \item{eps}{Threshold for the squared gain function.} } \value{ Boolean vector describing the orthonormal basis for the DWPT. } \description{ Subroutine for use in simulating seasonal persistent processes using the discrete wavelet packet transform. } \details{ The squared gain functions for a Daubechies (extremal phase or least asymmetric) wavelet family are used in a filter cascade to compute the value of the squared gain function for the wavelet packet filter at the Gengenbauer frequency. This is done for all nodes of the wavelet packet table. The idea behind this subroutine is to approximate the relationship between the discrete wavelet transform and long-memory processes, where the squared gain function is zero at frequency zero for all levels of the DWT. } \seealso{ Used in \code{\link{dwpt.sim}}. } \author{ B. Whitcher } \keyword{ts} waveslim/man/unemploy.Rd0000644000176200001440000000077714627105402015027 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{unemploy} \alias{unemploy} \title{U.S. Unemployment} \format{ A vector containing 624 observations. } \source{ Unknown. } \usage{ data(unemploy) } \description{ Monthly U.S. unemployment figures from 1948:1 to 1999:12. } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. } \keyword{datasets} waveslim/man/tourism.Rd0000644000176200001440000000076314627105402014654 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{tourism} \alias{tourism} \title{U.S. Tourism} \format{ A vector containing 160 observations. } \source{ Unknown. } \usage{ data(tourism) } \description{ Quarterly U.S. tourism figures from 1960:1 to 1999:4. } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. } \keyword{datasets} waveslim/man/modhwt.coh.Rd0000644000176200001440000000351314627105402015220 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hilbert.R \name{modhwt.coh} \alias{modhwt.coh} \alias{modhwt.phase} \alias{modhwt.coh.seasonal} \alias{modhwt.phase.seasonal} \title{Time-varying and Seasonal Analysis Using Hilbert Wavelet Pairs} \usage{ modhwt.coh(x, y, f.length = 0) modhwt.phase(x, y, f.length = 0) modhwt.coh.seasonal(x, y, S = 10, season = 365) modhwt.phase.seasonal(x, y, season = 365) } \arguments{ \item{x}{MODHWT object.} \item{y}{MODHWT object.} \item{f.length}{Length of the rectangular filter.} \item{S}{Number of "seasons".} \item{season}{Length of the "season".} } \value{ Time-varying or seasonal coherence and phase between two time series. The coherence estimates are between zero and one, while the phase estimates are between \eqn{-\pi}{-pi} and \eqn{\pi}{pi}. } \description{ Performs time-varying or seasonal coherence and phase anlaysis between two time seris using the maximal-overlap discrete Hilbert wavelet transform (MODHWT). } \details{ The idea of seasonally-varying spectral analysis (SVSA, Madden 1986) is generalized using the MODWT and Hilbert wavelet pairs. For the seasonal case, \eqn{S} seasons are used to produce a consistent estimate of the coherence and phase. For the non-seasonal case, a simple rectangular (moving-average) filter is applied to the MODHWT coefficients in order to produce consistent estimates. } \references{ Madden, R.A. (1986). Seasonal variation of the 40--50 day oscillation in the tropics. \emph{Journal of the Atmospheric Sciences} \bold{43}(24), 3138--3158. Whither, B. and P.F. Craigmile (2004). Multivariate Spectral Analysis Using Hilbert Wavelet Pairs, \emph{International Journal of Wavelets, Multiresolution and Information Processing}, \bold{2}(4), 567--587. } \seealso{ \code{\link{hilbert.filter}} } \author{ B. Whitcher } \keyword{ts} waveslim/man/dwt.2d.Rd0000644000176200001440000000325114627105402014247 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/two_D.R \name{dwt.2d} \alias{dwt.2d} \alias{idwt.2d} \title{Two-Dimensional Discrete Wavelet Transform} \usage{ dwt.2d(x, wf, J = 4, boundary = "periodic") idwt.2d(y) } \arguments{ \item{x}{input matrix (image)} \item{wf}{name of the wavelet filter to use in the decomposition} \item{J}{depth of the decomposition, must be a number less than or equal to log(minM,N,2)} \item{boundary}{only \code{"periodic"} is currently implemented} \item{y}{an object of class \code{dwt.2d}} } \value{ List structure containing the \eqn{3J+1} sub-matrices from the decomposition. } \description{ Performs a separable two-dimensional discrete wavelet transform (DWT) on a matrix of dyadic dimensions. } \details{ See references. } \examples{ ## Xbox image data(xbox) xbox.dwt <- dwt.2d(xbox, "haar", 3) par(mfrow=c(1,1), pty="s") plot.dwt.2d(xbox.dwt) par(mfrow=c(2,2), pty="s") image(1:dim(xbox)[1], 1:dim(xbox)[2], xbox, xlab="", ylab="", main="Original Image") image(1:dim(xbox)[1], 1:dim(xbox)[2], idwt.2d(xbox.dwt), xlab="", ylab="", main="Wavelet Reconstruction") image(1:dim(xbox)[1], 1:dim(xbox)[2], xbox - idwt.2d(xbox.dwt), xlab="", ylab="", main="Difference") ## Daubechies image data(dau) par(mfrow=c(1,1), pty="s") image(dau, col=rainbow(128)) sum(dau^2) dau.dwt <- dwt.2d(dau, "d4", 3) plot.dwt.2d(dau.dwt) sum(plot.dwt.2d(dau.dwt, plot=FALSE)^2) } \references{ Mallat, S. (1998) \emph{A Wavelet Tour of Signal Processing}, Academic Press. Vetterli, M. and J. Kovacevic (1995) \emph{Wavelets and Subband Coding}, Prentice Hall. } \seealso{ \code{\link{modwt.2d}}. } \author{ B. Whitcher } \keyword{ts} waveslim/man/acvs.andel8.Rd0000644000176200001440000000150614627105401015253 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{acvs.andel8} \alias{acvs.andel8} \alias{acvs.andel9} \alias{acvs.andel10} \alias{acvs.andel11} \title{Autocovariance and Autocorrelation Sequences for a Seasonal Persistent Process} \format{ A data frame with 4096 rows and three columns: lag, autocovariance sequence, autocorrelation sequence. } \usage{ data(acvs.andel8) data(acvs.andel9) data(acvs.andel10) data(acvs.andel11) } \description{ The autocovariance and autocorrelation sequences from the time series model in Figures 8, 9, 10, and 11 of Andel (1986). They were obtained through numeric integration of the spectral density function. } \references{ Andel, J. (1986) Long memory time series models, \emph{Kypernetika}, \bold{22}, No. 2, 105-123. } \keyword{datasets} waveslim/man/wave.variance.Rd0000644000176200001440000000730114627105401015675 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cov.R \name{wave.variance} \alias{wave.variance} \alias{wave.covariance} \alias{wave.correlation} \title{Wavelet Analysis of Univariate/Bivariate Time Series} \usage{ wave.variance(x, type = "eta3", p = 0.025) wave.covariance(x, y) wave.correlation(x, y, N, p = 0.975) } \arguments{ \item{x}{first time series} \item{type}{character string describing confidence interval calculation; valid methods are \code{gaussian}, \code{eta1}, \code{eta2}, \code{eta3}, \code{nongaussian}} \item{p}{(one minus the) two-sided p-value for the confidence interval} \item{y}{second time series} \item{N}{length of time series} } \value{ Matrix with as many rows as levels in the wavelet transform object. The first column provides the point estimate for the wavelet variance, covariance, or correlation followed by the lower and upper bounds from the confidence interval. } \description{ Produces an estimate of the multiscale variance, covariance or correlation along with approximate confidence intervals. } \details{ The time-independent wavelet variance is basically the average of the squared wavelet coefficients across each scale. As shown in Percival (1995), the wavelet variance is a scale-by-scale decomposition of the variance for a stationary process, and certain non-stationary processes. } \examples{ ## Figure 7.3 from Gencay, Selcuk and Whitcher (2001) data(ar1) ar1.modwt <- modwt(ar1, "haar", 6) ar1.modwt.bw <- brick.wall(ar1.modwt, "haar") ar1.modwt.var2 <- wave.variance(ar1.modwt.bw, type="gaussian") ar1.modwt.var <- wave.variance(ar1.modwt.bw, type="nongaussian") par(mfrow=c(1,1), las=1, mar=c(5,4,4,2)+.1) matplot(2^(0:5), ar1.modwt.var2[-7,], type="b", log="xy", xaxt="n", ylim=c(.025, 6), pch="*LU", lty=1, col=c(1,4,4), xlab="Wavelet Scale", ylab="") matlines(2^(0:5), as.matrix(ar1.modwt.var)[-7,2:3], type="b", pch="LU", lty=1, col=3) axis(side=1, at=2^(0:5)) legend(1, 6, c("Wavelet variance", "Gaussian CI", "Non-Gaussian CI"), lty=1, col=c(1,4,3), bty="n") ## Figure 7.8 from Gencay, Selcuk and Whitcher (2001) data(exchange) returns <- diff(log(as.matrix(exchange))) returns <- ts(returns, start=1970, freq=12) wf <- "d4" J <- 6 demusd.modwt <- modwt(returns[,"DEM.USD"], wf, J) demusd.modwt.bw <- brick.wall(demusd.modwt, wf) jpyusd.modwt <- modwt(returns[,"JPY.USD"], wf, J) jpyusd.modwt.bw <- brick.wall(jpyusd.modwt, wf) returns.modwt.cov <- wave.covariance(demusd.modwt.bw, jpyusd.modwt.bw) par(mfrow=c(1,1), las=0, mar=c(5,4,4,2)+.1) matplot(2^(0:(J-1)), returns.modwt.cov[-(J+1),], type="b", log="x", pch="*LU", xaxt="n", lty=1, col=c(1,4,4), xlab="Wavelet Scale", ylab="Wavelet Covariance") axis(side=1, at=2^(0:7)) abline(h=0) returns.modwt.cor <- wave.correlation(demusd.modwt.bw, jpyusd.modwt.bw, N = dim(returns)[1]) par(mfrow=c(1,1), las=0, mar=c(5,4,4,2)+.1) matplot(2^(0:(J-1)), returns.modwt.cor[-(J+1),], type="b", log="x", pch="*LU", xaxt="n", lty=1, col=c(1,4,4), xlab="Wavelet Scale", ylab="Wavelet Correlation") axis(side=1, at=2^(0:7)) abline(h=0) } \references{ Gencay, R., F. Selcuk and B. Whitcher (2001) \emph{An Introduction to Wavelets and Other Filtering Methods in Finance and Economics}, Academic Press. Percival, D. B. (1995) \emph{Biometrika}, \bold{82}, No. 3, 619-631. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. Whitcher, B., P. Guttorp and D. B. Percival (2000) Wavelet Analysis of Covariance with Application to Atmospheric Time Series, \emph{Journal of Geophysical Research}, \bold{105}, No. D11, 14,941-14,962. } \author{ B. Whitcher } \keyword{ts} waveslim/man/nile.Rd0000644000176200001440000000211214627105402014067 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{nile} \alias{nile} \title{Nile River Minima} \format{ A length 663 vector. } \source{ Toussoun, O. (1925) M\'emoire sur l'Histoire du Nil, Volume 18 in \emph{M\'emoires a l'Institut d'Egypte}, pp. 366-404. } \usage{ data(nile) } \description{ Yearly minimal water levels of the Nile river for the years 622 to 1281, measured at the Roda gauge near Cairo (Tousson, 1925, p. 366-385). The data are listed in chronological sequence by row. } \details{ The original Nile river data supplied by Beran only contained only 500 observations (622 to 1121). However, the book claimed to have 660 observations (622 to 1281). The remaining observations from the book were added, by hand, but the series still only contained 653 observations (622 to 1264). Note, now the data consists of 663 observations (spanning the years 622-1284) as in original source (Toussoun, 1925). } \references{ Beran, J. (1994) \emph{Statistics for Long-Memory Processes}, Chapman Hall: Englewood, NJ. } \keyword{datasets} waveslim/man/brick.wall.Rd0000644000176200001440000000304414627105402015175 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dwt.R \name{brick.wall} \alias{brick.wall} \alias{dwpt.brick.wall} \alias{brick.wall.2d} \title{Replace Boundary Wavelet Coefficients with Missing Values} \usage{ brick.wall(x, wf, method = "modwt") dwpt.brick.wall(x, wf, n.levels, method = "modwpt") brick.wall.2d(x, method = "modwt") } \arguments{ \item{x}{DWT/MODWT/DWPT/MODWPT object} \item{wf}{Character string; name of wavelet filter} \item{method}{Either \code{\link{dwt}} or \code{\link{modwt}} for \code{brick.wall}, or either \code{\link{dwpt}} or \code{\link{modwpt}} for \code{dwpt.brick.wall}} \item{n.levels}{Specifies the depth of the decomposition. This must be a number less than or equal to log(length(x),2).} } \value{ Same object as \code{x} only with some missing values. } \description{ Sets the first \eqn{n} wavelet coefficients to \code{NA}. } \details{ The fact that observed time series are finite causes boundary issues. One way to get around this is to simply remove any wavelet coefficient computed involving the boundary. This is done here by replacing boundary wavelet coefficients with \code{NA}. } \references{ Lindsay, R. W., D. B. Percival and D. A. Rothrock (1996). The discrete wavelet transform and the scale anlaysis of the surface properties of sea ice, \emph{IEEE Transactions on Geoscience and Remote Sensing}, \bold{34}, No. 3, 771-787. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. } \author{ B. Whitcher } \keyword{ts} waveslim/man/phase.shift.Rd0000644000176200001440000000243514627105402015364 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dwt.R \name{phase.shift} \alias{phase.shift} \alias{phase.shift.packet} \title{Phase Shift Wavelet Coefficients} \usage{ phase.shift(z, wf, inv = FALSE) phase.shift.packet(z, wf, inv = FALSE) } \arguments{ \item{z}{DWT object} \item{wf}{character string; wavelet filter used in DWT} \item{inv}{Boolean variable; if \code{inv=TRUE} then the inverse phase shift is applied} } \value{ DWT (DWPT) object with coefficients circularly shifted. } \description{ Wavelet coefficients are circularly shifted by the amount of phase shift induced by the wavelet transform. } \details{ The center-of-energy argument of Hess-Nielsen and Wickerhauser (1996) is used to provide a flexible way to circularly shift wavelet coefficients regardless of the wavelet filter used. The results are not identical to those used by Percival and Walden (2000), but are more flexible. \code{phase.shift.packet} is not yet implemented fully. } \references{ Hess-Nielsen, N. and M. V. Wickerhauser (1996) Wavelets and time-frequency analysis, \emph{Proceedings of the IEEE}, \bold{84}, No. 4, 523-540. Percival, D. B. and A. T. Walden (2000) \emph{Wavelet Methods for Time Series Analysis}, Cambridge University Press. } \author{ B. Whitcher } \keyword{ts} waveslim/man/kobe.Rd0000644000176200001440000000104714627105402014066 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{kobe} \alias{kobe} \title{1995 Kobe Earthquake Data} \format{ A vector containing 3048 observations. } \source{ Data management centre, Washington University. } \usage{ data(kobe) } \description{ Seismograph (vertical acceleration, nm/sq.sec) of the Kobe earthquake, recorded at Tasmania University, HobarTRUE, Australia on 16 January 1995 beginning at 20:56:51 (GMTRUE) and continuing for 51 minutes at 1 second intervals. } \keyword{datasets} waveslim/DESCRIPTION0000644000176200001440000000205714627612203013616 0ustar liggesusersPackage: waveslim Version: 1.8.5 Date: 2024-06-02 Title: Basic Wavelet Routines for One-, Two-, and Three-Dimensional Signal Processing Author: Brandon Whitcher Maintainer: Brandon Whitcher Depends: R (>= 2.11.0), graphics, grDevices, stats, utils, multitaper Suggests: fftw, covr Description: Basic wavelet routines for time series (1D), image (2D) and array (3D) analysis. The code provided here is based on wavelet methodology developed in Percival and Walden (2000); Gencay, Selcuk and Whitcher (2001); the dual-tree complex wavelet transform (DTCWT) from Kingsbury (1999, 2001) as implemented by Selesnick; and Hilbert wavelet pairs (Selesnick 2001, 2002). All figures in chapters 4-7 of GSW (2001) are reproducible using this package and R code available at the book website(s) below. License: BSD_3_clause + file LICENSE URL: https://waveslim.blogspot.com RoxygenNote: 7.3.1 Encoding: UTF-8 NeedsCompilation: yes Packaged: 2024-06-03 18:31:59 UTC; brandon Repository: CRAN Date/Publication: 2024-06-04 13:20:03 UTC