rwavelet: Wavelet Analysis

Documented in MakeONFilter

#' Generate Orthonormal QMF Filter for Wavelet Transform
#'
#' The Haar filter (which could be considered a Daubechies-2) was the
#' first wavelet, though not called as such, and is discontinuous.
#'
#' The Beylkin filter places roots for the frequency response function
#' close to the Nyquist frequency on the real axis.
#'
#' The Coiflet filters are designed to give both the mother and father
#' wavelets 2*Par vanishing moments; here Par may be one of 1,2,3,4 or 5.
#'
#' The Daubechies filters are minimal phase filters that generate wavelets
#' which have a minimal support for a given number of vanishing moments.
#' They are indexed by their length, Par, which may be one of
#' 4,6,8,10,12,14,16,18 or 20. The number of vanishing moments is par/2.
#'
#' Symmlets are also wavelets within a minimum size support for a given
#' number of vanishing moments, but they are as symmetrical as possible,
#' as opposed to the Daubechies filters which are highly asymmetrical.
#' They are indexed by Par, which specifies the number of vanishing
#' moments and is equal to half the size of the support. It ranges
#' from 4 to 10.
#'
#' The Vaidyanathan filter gives an exact reconstruction, but does not
#' satisfy any moment condition.  The filter has been optimized for
#' speech coding.
#'
#' The Battle-Lemarie filter generate spline orthogonal wavelet basis.
#' The parameter Par gives the degree of the spline. The number of
#' vanishing moments is Par+1.
#'
#' @export MakeONFilter
#' @param Type string, 'Haar', 'Beylkin', 'Coiflet', 'Daubechies'
#'             'Symmlet', 'Vaidyanathan','Battle'.
#' @param Par integer, it is a parameter related to the support and vanishing
#'            moments of the wavelets, explained below for each wavelet.
#' @return \code{qmf} quadrature mirror filter.
#' @examples
#' Type <- 'Coiflet'
#' Par <- 1
#' qmf <- MakeONFilter(Type, Par)
#' @seealso \code{\link{FWT_PO}}, \code{\link{IWT_PO}}, \code{\link{FWT2_PO}}, \code{\link{IWT2_PO}}.

MakeONFilter <- function(Type, Par) {
  if (Type == "Haar") {
    f <- cbind(1, 1)/sqrt(2)
  }
  if (Type == "Beylkin") {
    f <- cbind(0.099305765374, 0.424215360813, 0.699825214057, 0.449718251149,
      -0.110927598348, -0.264497231446, 0.026900308804, 0.155538731877,
      -0.017520746267, -0.088543630623, 0.019679866044, 0.042916387274,
      -0.017460408696, -0.014365807969, 0.010040411845, 0.001484234782,
      -0.002736031626, 0.000640485329)
  }
  if (Type == "Coiflet") {
    if (Par == 1) {
      f <- cbind(0.038580777748, -0.126969125396, -0.077161555496, 0.607491641386,
        0.745687558934, 0.226584265197)
    }
    if (Par == 2) {
      f <- cbind(0.016387336463, -0.041464936782, -0.067372554722, 0.386110066823,
        0.81272363545, 0.417005184424, -0.076488599078, -0.059434418646,
        0.023680171947, 0.005611434819, -0.001823208871, -0.000720549445)
    }
    if (Par == 3) {
      f <- cbind(-0.003793512864, 0.007782596426, 0.023452696142, -0.065771911281,
        -0.061123390003, 0.40517690241, 0.793777222626, 0.428483476378,
        -0.071799821619, -0.082301927106, 0.034555027573, 0.015880544864,
        -0.009007976137, -0.002574517688, 0.001117518771, 0.00046621696,
        -7.0983303e-05, -3.4599773e-05)
    }
    if (Par == 4) {
      f <- cbind(0.000892313668, -0.001629492013, -0.007346166328, 0.016068943964,
        0.026682300156, -0.08126669968, -0.056077313316, 0.41530840703,
        0.78223893092, 0.434386056491, -0.066627474263, -0.096220442034,
        0.039334427123, 0.025082261845, -0.015211731527, -0.005658286686,
        0.003751436157, 0.001266561929, -0.000589020757, -0.000259974552,
        6.2339034e-05, 3.1229876e-05, -3.25968e-06, -1.784985e-06)
    }
    if (Par == 5) {
      f <- cbind(-0.000212080863, 0.000358589677, 0.002178236305, -0.004159358782,
        -0.010131117538, 0.023408156762, 0.028168029062, -0.091920010549,
        -0.052043163216, 0.421566206729, 0.77428960374, 0.437991626228,
        -0.062035963906, -0.105574208706, 0.041289208741, 0.032683574283,
        -0.019761779012, -0.009164231153, 0.006764185419, 0.002433373209,
        -0.001662863769, -0.000638131296, 0.00030225952, 0.000140541149,
        -4.1340484e-05, -2.1315014e-05, 3.734597e-06, 2.063806e-06, -1.67408e-07,
        -9.5158e-08)
    }
  }
  if (Type == "Daubechies") {
    if (Par == 4) {
      f <- cbind(0.482962913145, 0.836516303738, 0.224143868042, -0.129409522551)
    }
    if (Par == 6) {
      f <- cbind(0.33267055295, 0.806891509311, 0.459877502118, -0.13501102001,
        -0.085441273882, 0.035226291882)
    }
    if (Par == 8) {
      f <- cbind(0.230377813309, 0.714846570553, 0.63088076793, -0.027983769417,
        -0.187034811719, 0.030841381836, 0.032883011667, -0.010597401785)
    }
    if (Par == 10) {
      f <- cbind(0.160102397974, 0.603829269797, 0.724308528438, 0.138428145901,
        -0.242294887066, -0.032244869585, 0.07757149384, -0.006241490213,
        -0.012580751999, 0.003335725285)
    }
    if (Par == 12) {
      f <- cbind(0.11154074335, 0.494623890398, 0.751133908021, 0.315250351709,
        -0.226264693965, -0.129766867567, 0.097501605587, 0.02752286553,
        -0.031582039317, 0.000553842201, 0.004777257511, -0.001077301085)
    }
    if (Par == 14) {
      f <- cbind(0.077852054085, 0.396539319482, 0.729132090846, 0.469782287405,
        -0.143906003929, -0.224036184994, 0.071309219267, 0.080612609151,
        -0.038029936935, -0.016574541631, 0.012550998556, 0.000429577973,
        -0.001801640704, 0.0003537138)
    }
    if (Par == 16) {
      f <- cbind(0.054415842243, 0.312871590914, 0.675630736297, 0.585354683654,
        -0.015829105256, -0.284015542962, 0.000472484574, 0.12874742662,
        -0.017369301002, -0.044088253931, 0.013981027917, 0.008746094047,
        -0.004870352993, -0.000391740373, 0.000675449406, -0.000117476784)
    }
    if (Par == 18) {
      f <- cbind(0.038077947364, 0.243834674613, 0.60482312369, 0.657288078051,
        0.133197385825, -0.293273783279, -0.096840783223, 0.148540749338,
        0.030725681479 - 0.067632829061, 0.000250947115, 0.022361662124,
        -0.004723204758, -0.004281503682, 0.001847646883, 0.000230385764,
        -0.000251963189, 3.934732e-05)
    }
    if (Par == 20) {
      f <- cbind(0.026670057901, 0.188176800078, 0.527201188932, 0.688459039454,
        0.281172343661, -0.249846424327, -0.195946274377, 0.127369340336,
        0.093057364604, -0.071394147166, -0.029457536822, 0.033212674059,
        0.003606553567, -0.010733175483, 0.001395351747, 0.001992405295,
        -0.000685856695, -0.000116466855, 9.358867e-05, -1.3264203e-05)
    }

  }
  if (Type == "Symmlet") {
    if (Par == 4) {
      f <- cbind(-0.107148901418, -0.041910965125, 0.703739068656, 1.136658243408,
        0.421234534204, -0.140317624179, -0.017824701442, 0.045570345896)
    }
    if (Par == 5) {
      f <- cbind(0.038654795955, 0.041746864422, -0.055344186117, 0.281990696854,
        1.023052966894, 0.89658164838, 0.023478923136, -0.247951362613,
        -0.029842499869, 0.027632152958)
    }
    if (Par == 6) {
      f <- cbind(0.021784700327, 0.004936612372, -0.166863215412, -0.068323121587,
        0.694457972958, 1.113892783926, 0.477904371333, -0.102724969862,
        -0.029783751299, 0.06325056266, 0.002499922093, -0.011031867509)
    }
    if (Par == 7) {
      f <- cbind(0.003792658534, -0.001481225915, -0.017870431651, 0.043155452582,
        0.096014767936, -0.070078291222, 0.024665659489, 0.758162601964,
        1.085782709814, 0.408183939725, -0.198056706807, -0.152463871896,
        0.005671342686, 0.014521394762)
    }
    if (Par == 8) {
      f <- cbind(0.002672793393, -0.0004283943, -0.021145686528, 0.005386388754,
        0.069490465911, -0.038493521263, -0.073462508761, 0.515398670374,
        1.099106630537, 0.68074534719, -0.086653615406, -0.202648655286,
        0.010758611751, 0.044823623042, -0.000766690896, -0.004783458512)
    }
    if (Par == 9) {
      f <- cbind(0.001512487309, -0.000669141509, -0.014515578553, 0.012528896242,
        0.087791251554, -0.02578644593, -0.270893783503, 0.049882830959,
        0.873048407349, 1.015259790832, 0.337658923602, -0.077172161097,
        0.000825140929, 0.042744433602, -0.016303351226, -0.018769396836,
        0.000876502539, 0.001981193736)
    }
    if (Par == 10) {
      f <- cbind(0.001089170447, 0.00013524502, -0.01222064263, -0.002072363923,
        0.064950924579, 0.016418869426, -0.225558972234, -0.100240215031,
        0.667071338154, 1.0882515305, 0.542813011213, -0.050256540092,
        -0.045240772218, 0.07070356755, 0.008152816799, -0.028786231926,
        -0.001137535314, 0.006495728375, 8.0661204e-05, -0.000649589896)
    }
  }
  if (Type == "Vaidyanathan") {
    f <- cbind(-6.2906118e-05, 0.000343631905, -0.00045395662, -0.000944897136,
      0.002843834547, 0.000708137504, -0.008839103409, 0.003153847056,
      0.01968721501, -0.014853448005, -0.035470398607, 0.038742619293,
      0.055892523691, -0.077709750902, -0.083928884366, 0.131971661417,
      0.135084227129, -0.194450471766, -0.263494802488, 0.201612161775,
      0.635601059872, 0.572797793211, 0.250184129505, 0.045799334111)
  }
  if (Type == "Battle") {
    if (Par == 1) {
      g <- cbind(0.578163, 0.280931, -0.0488618, -0.0367309, 0.012003,
        0.00706442, -0.00274588, -0.00155701, 0.000652922, 0.000361781,
        -0.000158601, -8.67523e-05)
    }
    if (Par == 3) {
      g <- cbind(0.541736, 0.30683, -0.035498, -0.0778079, 0.0226846, 0.0297468,
        -0.0121455, -0.0127154, 0.00614143, 0.00579932, -0.00307863,
        -0.00274529, 0.00154624, 0.00133086, -0.000780468, -0.00065562,
        0.000395946, 0.000326749, -0.000201818, -0.000164264, 0.000103307)
    }
    if (Par == 5) {
      g <- cbind(0.528374, 0.312869, -0.0261771, -0.0914068, 0.0208414,
        0.0433544, -0.0148537, -0.0229951, 0.00990635, 0.0128754, -0.00639886,
        -0.00746848, 0.00407882, 0.00444002, -0.00258816, -0.00268646,
        0.00164132, 0.00164659, -0.00104207, -0.00101912, 0.000662836,
        0.000635563, -0.000422485, -0.000398759, 0.000269842, 0.000251419,
        -0.000172685, -0.000159168, 0.000110709, 0.000101113)
    }
    l <- length(g)
    f <- rep(0, 2 * l - 1)
    f[l:(2 * l - 1)] <- g
    f[1:l - 1] <- rev(g[2:l])
  }
  # f <- f/normvec(f)
  f <- f/norm(as.matrix(f), "F")
  f
}

# Copyright (c) 1993-5. Jonathan Buckheit and David Donoho

# Part of WaveLab Version 802 Built Sunday, October 3, 1999 8:52:27 AM This
# is Copyrighted Material For Copying permissions see COPYING.m Comments?
# e-mail wavelab@stat.stanford.edu