\(\(\(
\)\(<< \ LinearAlgebra`MatrixManipulation`;\)\)\)

■  基底関数

Daubechies:

daub2={{1.,1.},{1.,-1.}}/Sqrt[2.];
daub4={{1.+Sqrt[3.], 3.+Sqrt[3.],3.-Sqrt[3.], 1.-Sqrt[3.]},
	{1.-Sqrt[3.],-3.+Sqrt[3.],3.+Sqrt[3.],-1.-Sqrt[3.]}}/
	(4 Sqrt[2.]);
daub6={{ .332670552950, .806891509311, .459877502118,
		-.135011020010, -.085441273882, .035226291882},
	   { .035226291882, .085441273882,-.135011020010,
	    -.459877502118,.806891509311,-.332670552950}};
daub8={{ 0.325803428051, 1.010945715092, 0.892200138246,
	    -0.039575026236,-0.264507167369, 0.043616300475,
	     0.046503601071,-0.014986989330},
	   {-0.014986989330,-0.046503601071, 0.043616300475,
		 0.264507167369,-0.039575026236,-0.892200138246,
		 1.010945715092,-0.325803428051}}/Sqrt[2.];
daub10={{ .160102397974, .603829269797, .724308528438,
		  .138428145901,-.242294887066,-.032244869585,
		  .077571493840,-.006241490213,-.012580751999,
		  .003335725285},
	    { .003335725285, .012580751999,-.006241490213,
	     -.077571493840,-.032244869585, .242294887066,
	      .138428145901,-.724308528438, .603829269797,
	     -.160102397974}};
daub12={{ 0.111540743350, 0.494623890398, 0.751133908021,
		  0.315250351709,-0.226264693965,-0.129766867567,
		  0.097501605587, 0.027522865530,-0.031582039318,
		  0.000553842201, 0.004777257511,-0.001077301085},
		{-0.001077301085,-0.004777257511, 0.000553842201,
		  0.031582039318, 0.027522865530,-0.097501605587,
		 -0.129766867567, 0.226264693965, 0.315250351709,
		 -0.751133908021, 0.494623890398,-0.111540743350}};
daub14={{ .077852054085, .396539319482, .729132090846, 
 		  .469782287405,-.143906003929,-.224036184994,
 		  .071309219267, .080612609151,-.038029936935, 
		 -.016574541631, .012550998556, .000429577973, 
		 -.001801640704, .000353713800},
		{ .000353713800, .001801640704, .000429577973, 
		 -.012550998556,-.016574541631, .038029936935,
		  .080612609151,-.071309219267,-.224036184994,
		  .143906003929, .469782287405,-.729132090846,
		  .396539319482,-.077852054085}};
daub16={{ .054415842243, .312871590914, .675630736297, 
 		  .585354683654,-.015829105256,-.284015542962,
 		  .000472484574, .128747426620,-.017369301002, 
		 -.044088253931, .013981027917, .008746094047, 
		 -.004870352993,-.000391740373, .000675449406,
		 -.000117476784},
		{-.000117476784,-.000675449406,-.000391740373,
		  .004870352993, .008746094047,-.013981027917,
		 -.044088253931, .017369301002, .128747426620,
		 -.000472484574,-.284015542962, .015829105256,
		  .585354683654,-.675630736297, .312871590914,
		 -.054415842243}};
daub18={{ .038077947364, .243834674613, .604823123690, 
 		  .657288078051, .133197385825,-.293273783279, 
		 -.096840783223, .148540749338, .030725681479,
		 -.067632829061, .000250947115, .022361662124,
		 -.004723204758,-.004281503682, .001847646883,
          .000230385764,-.000251963189, .000039347320},
        { .000039347320, .000251963189, .000230385764,
         -.001847646883,-.004281503682, .004723204758,
          .022361662124,-.000250947115,-.067632829061,
         -.030725681479, .148540749338, .096840783223,
         -.293273783279,-.133197385825, .657288078051, 
         -.604823123690, .243834674613,-.038077947364}};
daub20={{ 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,
		  0.000093588670,-0.000013264203},
		{-0.000013264203,-0.000093588670,-0.000116466855,
		  0.000685856695, 0.001992405295,-0.001395351747,
		 -0.010733175483,-0.003606553567, 0.033212674059,
		  0.029457536822,-0.071394147166,-0.093057364604,
		  0.127369340336, 0.195946274377,-0.249846424327,
		 -0.281172343661, 0.688459039454,-0.527201188932,
		  0.188176800078,-0.026670057901}};

MatrixForm[daub2]

MatrixForm[daub4]

MatrixForm[daub6]

Coifman:

coif6={{-.051429728471, .238929728471, .602859456942, 
 		 .272140543058,-.051429972847,-.011070271529},
 	   {-.011070271529, .051429972847, .272140543058,
		-.602859456942, .238929728471, .051429728471}}*
		Sqrt[2.];
coif12={{ .011587596739,-.029320137980,-.047639590310, 
 		  .273021046535, .574682393857, .294867193696,
		 -.054085607092,-.042026480461, .016744410163, 
 		  .003967883613,-.001289203356,-.000509505399},
 		{-.000509505399, .001289203356, .003967883613,
 		 -.016744410163,-.042026480461, .054085607092,
 		  .294867193696,-.574682393857, .273021046535,
		  .047639590310,-.029320137980,-.011587596739}}*
		 Sqrt[2.];
coif18={{-.002682418671, .005503126709, .016583560479, 
		 -.046507764479,-.043220763560, .286503335274,
 		  .561285256870, .302983571773,-.050770140755, 
		 -.058196250762, .024434094321, .011229240962, 
		 -.006369601011,-.001820458916, .000790205101,
 		  .000329665174,-.000050192775,-.000024465734},
 		{-.000024465734, .000050192775, .000329665174,
 		 -.000790205101,-.001820458916, .006369601011,
 		  .011229240962,-.024434094321,-.058196250762,
 		  .050770140755, .302983571773,-.561285256870,
 		  .286503335274, .043220763560,-.046507764479,
 		 -.016583560479, .005503126709, .002682418671}}*
 		Sqrt[2.];
coif24={{ .000630961046,-.001152224852,-.005194524026, 
 		  .011362459244, .018867235378,-.057464234429, 
		 -.039652648517, .293667390895, .553126452562, 
 		  .307157326198,-.047112738865,-.068038127051,
 		  .027813640153, .017735837438,-.010756318517,
		 -.004001012886, .002652665946, .000895594529,
		 -.000416500571,-.000183829769, .000044080354, 
 		  .000022082857,-.000002304942,-.000001262175},
 		{-.000001262175, .000002304942, .000022082857,
 		 -.000044080354,-.000183829769, .000416500571,
 		  .000895594529,-.002652665946,-.004001012886,
 		  .010756318517, .017735837438,-.027813640153,
 		 -.068038127051, .047112738865, .307157326198,
 		 -.553126452562, .293667390895, .039652648517,
 		 -.057464234429,-.018867235378, .011362459244,
 		  .005194524026,-.001152224852,-.000630961046}}*
 		Sqrt[2.];
coif30={{-.000149963800, .000253561200, .001540245700, 
		 -.002941110800,-.007163781900, .016552066400, 
 		  .019917804300,-.064997262800,-.036800073600,
 		  .298092323500, .547505429400, .309706849000, 
		 -.043866050800,-.074652238900, .029195879500, 
 		  .023110777000,-.013973687900,-.006480090000, 
 		  .004783001400, .001720654700,-.001175822200,
		 -.000451227000, .000213729800, .000099377600,
		 -.000029232100,-.000015072000, .000002640800, 
 		  .000001459300,-.000000118400,-.000000067300},
 		{-.000000067300, .000000118400, .000001459300,
 		 -.000002640800,-.000015072000, .000029232100,
 		  .000099377600,-.000213729800,-.000451227000,
 		  .001175822200, .001720654700,-.004783001400,
 		 -.006480090000, .013973687900, .023110777000,
 		 -.029195879500,-.074652238900, .043866050800,
 		  .309706849000,-.547505429400, .298092323500,
 		  .036800073600,-.064997262800,-.019917804300,
 		  .016552066400, .007163781900,-.002941110800,
 		 -.001540245700, .000253561200, .000149963800}}*
 		Sqrt[2.];

MatrixForm[coif6]

■ Wavelet Matrix

c[n_,baseType_]:=Module[{mat,i,result},
	result=mat=AppendRows[baseType,
		ZeroMatrix[2,n-Length[baseType[[1]]]]];
       	rotateRightofList[a_List]:=RotateRight/@ a;
        rotateRight[b_List,k_]:=
        Nest[rotateRightofList,b,k];
        Do[result=
        	AppendColumns[result,rotateRight[mat,2 i]],
            {i,n/2-1}];
	result]

cPrime[i_,n_,baseType_]:=BlockMatrix[{{c[n/2^i,baseType],
	ZeroMatrix[n/2^i,n-n/2^i]},{ZeroMatrix[n-n/2^i,n/2^i],
	IdentityMatrix[n-n/2^i]}}]

p[n_]:=Module[{mat,i},mat=IdentityMatrix[n];
	Do[mat[[i]]=RotateRight[mat[[i]],i-1],{i,2,n}];
    Do[mat[[i]]=RotateRight[mat[[i]]],{i,n/2+1,n}];
    mat];
pPrime[i_,n_,baseType_]:=BlockMatrix[{{p[n/2^i],
	ZeroMatrix[n/2^i,n-n/2^i]},{ZeroMatrix[n-n/2^i,n/2^i],
  	IdentityMatrix[n-n/2^i]}}];

waveletMatrix[n_,baseType_]:=
	Apply[Dot,Flatten[Table[{pPrime[j,n,baseType],
		cPrime[j,n,baseType]},{j,Log[2,n]-
		Ceiling[Log[2.,Length[baseType[[2]]]]],1,-1}],
		1]].p[n].c[n,baseType];

■  Examples

waveletMatrix[4, daub2]

% // MatrixForm

MatrixForm[waveletMatrix[4, daub4]]

% // MatrixForm

MatrixForm[waveletMatrix[6, daub6]]

MatrixForm[waveletMatrix[6, coif6]]

■ Inverse Matrices

MatrixForm[waveletMatrix[4, daub2]]

MatrixForm[Transpose[waveletMatrix[4, daub2]]]

MatrixForm[
      Transpose[waveletMatrix[4, daub2]] .  waveletMatrix[4, daub2]]

MatrixForm[
      Transpose[waveletMatrix[6, coif6]] . 
        waveletMatrix[6, coif6]]

■  Wavelet Transform

a = {{1, 0, 1, 1}, {0, 0, 1, 1}, {1, 1, 0, 1}, {1, 1, 1, 1}};

ListDensityPlot[a, Mesh -> False]

b = waveletMatrix[4, daub2] . a;

ListDensityPlot[b, Mesh -> False]

■  Inverse Wavelet Transform

c = Transpose[waveletMatrix[4, daub2]] . b;

ListDensityPlot[c, Mesh -> False]

■   Example

■ 128×128 simple

size=Dimensions[sample]

SamplePhoto = 
      ListDensityPlot[sample, Mesh -> False, 
        AspectRatio -> size[[1]]/(2  size[[2]]), 
        PlotLabel -> "Sample Photo"]

b = waveletMatrix[128, coif6] . sample;

ListDensityPlot[b, Mesh -> False]

c = Transpose[waveletMatrix[128, coif6]] . b;

ListDensityPlot[c, Mesh -> False]