otivation for this
section is explained in the remarks
(
Unsuitability of spline
wavelets
), (
Unsuitability
of spline wavelets 2
).
We seek a symmetric factorization
,
of the
expression
where the polynomial
that has to
satisfy
and was constructed in the proof of the proposition
(
Existence of
smooth compactly supported
wavelets
):
Proposition
(Biorthogonal symmetry 1) Let
where
Then
is a polynomial with the following properties:
1.
2.
,
3.
.
Proof
Direct verification.
Proposition
(Biorthogonal symmetry 3) Any polynomial
of the
form
satisfies
Proof
Direct verification.
The steps 1-5 may be executed using the following Mathematica script:
n=5
CC[k_, n_] := Binomial[n, k]
Pnm1[n_, y_] := Expand[Sum[CC[k, 2*n - 1]*y^k*(1 - y)^(n - 1 - k), {k, 0, n -
1}]]
Pin[n_,x_]:=x^(2*n-1)*(1/2+1/4*(x+1/x))^n*Pnm1[n,1/2-1/4*(x+1/x)]
F[n_, x_] := Simplify[Expand[Pin[n, x]]]
eq = F[n, x]
sol=NSolve[eq == 0, {x}]
sol1 = Map[Function[x, x[[1]][[2]]], sol]
m=Length[Select[sol1, Function[x, x == -1.]]]
sol2 = Select[sol1, Function[x, x != -1.]]
takePairs = Function[L,
Module[{x
= L, y, z, r},
r
= {};
While[Length[x]
> 0,
y
= First[x];
x
= Drop[x, 1];
z
= Select[x, Function[a, Abs[a - 1/y] < 0.000000001]][[1]];
x
= Select[x, Function[a, a != z]];
r
= Append[r, y];
];
r
]
]
xk=takePairs[sol2]
K=Length[xk]
Pmk=(x+1)^m*Product[(x-xk[[k]])*(x-1/xk[[k]]),{k,1,K}]
a = D[Pmk, {x, m + 2*K}]/D[eq, {x, m + 2*K}]
{n,m,K,xk}
The following continuation of Mathematica script calculates the
according to the last remarks. The result for n=4 agrees with
[Walnut]
, page 326, "The 8/8 filter pair".
takePairs2 = Function[L,
Module[{x=L,y,z,r,c},
r={};
c={};
While[Length[x]>0,
y=First[x];
x=Drop[x,1];
If[Im[y]==0,r=Append[r,y],c=Append[c,y]];
];
x=c;
c={};
While[Length[x]>0,
y=First[x];
x=Drop[x,1];
z=Select[x,Function[a,Abs[a-Conjugate[y]]<0.000000001]][[1]];
x=Select[x,Function[a,a!=z]];
c=Append[c,y];
];
{r,c}
]
]
xx=takePairs2[xk]
makeMs=Function[{roots,m},
Module[{reals=roots[[1]],complex=roots[[2]],y,z,tom0,toM0,m0,M0,d1,d2},
Clear[x];
m0=1;
M0=1;
tom0=True;
While[Length[reals]>0,
y=First[reals];
reals=Drop[reals,1];
z=(x-y)*(x-1/y);
If[tom0,m0=m0*z,M0=M0*z];
If[tom0,tom0=False,tom0=True];
];
toM0=True;
While[Length[complex]>0,
y=First[complex];
complex=Drop[complex,1];
z=(x-y)*(x-1/y)*(x-Conjugate[y])*(x-Conjugate[1/y]);
If[toM0,M0=M0*z,m0=m0*z];
If[toM0,toM0=False,toM0=True];
];
d1=Exponent[m0,x];
d2=Exponent[M0,x];
m0=m0*(x+1)^(m/2-(d1-d2)/2);
M0=M0*(x+1)^(m/2+(d1-d2)/2);
m0=m0/Re[m0
/. x->1];
M0=M0/Re[M0
/. x->1];
{m0,M0}
]
]
mm=makeMs[xx,m]
h=Re[N[CoefficientList[mm, x]*Sqrt[2]]]
|