1次元ウェーブレット変換の例

Mathematica  パッケージや関数の指定

Mathematica  utilities

<<Utilities`MemoryConserve`
$MemoryIncrement=10000000;
Off[General::spell,General::spell1,
MemoryConserve::start,MemoryConserve::end];
<< LinearAlgebra`MatrixManipulation`;

相関係数を求める関数

\(\(corRelation = 
        Compile[{{a, _Real, 1}, {b, _Real, 1}}, 
		Module[{av = 0. , 
              bv = 0. , aP = {0. }, bP = {0. }}, 
			av = 
              Apply[Plus, a]/Length[a]; 
			bv = 
              Apply[Plus, b]/Length[b]; 
			aP = a - av; 
			bP = 
              b - bv; 
			aP . 
                bP/\((Sqrt[aP . aP]*Sqrt[bP . bP])\)
			]];\)\)

使用メモリを求める関数

memoryUsed:=Module[{},
	Unprotect[In,Out];Clear[In,Out];Protect[In,Out];
	Print[Round[N[MemoryInUse[]/1000]],"K Bytes used"]];

離散値系ウェーブレット変換用の関数

高須賀義弘
2002/6/28

ウェーブレット基底関数

ドビッシーの基底関数

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}};

コフマン(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.];

ベイキン(Baylkin)の基底関数

bay6={{ .038580777748,-.126969125396,-.077161555496, 
 		.607491641386, .745687558934, .226584265197},
 	  { .226584265197,-.745687558934, .607491641386,
 	    .077161555496,-.126969125396,-.038580777748}};
 	    
bay12={{ .001194572696,-.012845579553, .024804330519, 
 		 .050023519962,-.155357222860,-.071638282295, 
 		 .570465001450, .750336305853, .280611651902,
		-.007410383519,-.014611552521,-.001358799059},
	   {-.001358799059, .014611552521,-.007410383519,
	    -.280611651902, .750336305853,-.570465001450,
	    -.071638282295, .155357222860, .050023519962,
	    -.024804330519,-.012845579553,-.001194572696}};
	    
bay18={{-.001691851019,-.003487876220, .019191160680, 
 		 .021671094636,-.098507213321,-.056997424478, 
 		 .456787122173, .789319409004, .380557130852,
		-.070438748795,-.056514193868, .036409962613,
 		 .008760130709,-.011194759274,-.001921335414,
 		 .002041380977, .000445830398,-.000216257277},
 	   {-.000216257277,-.000445830398, .002041380977,
 	     .001921335414,-.011194759274,-.008760130709,
 	     .036409962613, .056514193868,-.070438748795,
 	    -.380557130852, .789319409004,-.456787122173,
 	    -.056997424478, .098507213321, .021671094636,
 	    -.019191160680,-.003487876220, .001691851019}};

1次元ウェーブレット変換関数定義

\(\(waveletTransform[daTa_, 
          baseType_] := 
Module[
{i, 
            n = Length[daTa], nn = Length[baseType[\([1]\)]], tempData, 
            dataHead = {}, 
            dataLast = {}}, 
Do[
tempData = Take[\ RotateLeft[daTa, i], 
                nn]; \ 
dataHead = {dataHead\ , \((baseType[\([1]\)]\  . \ \ tempData)\)\ }; 
dataLast = {dataLast, \((baseType[\([2]\)]\  . \ \ \ tempData\ )\)}, 
	{i, 0, n - 1, 
              2}
\ ]; 
dataHead = 
            Flatten[dataHead]; 
If[Length[dataHead] >= nn, 
            Flatten[{waveletTransform[dataHead, baseType], 
                dataLast}], 
Flatten[{dataHead, 
                dataLast}]
]
];\)\)

1次元ウェーブレット逆変換関数定義

InverseWaveletTransform[inData_, 
          baseType_] := 
Module[
{i, j, 
            tempData, n = Length[inData], 
            nn = 2 ^ Ceiling[Log[2, Length[baseType[[1]]]]], d1, d2, 
            sumArray = {}}, 

daTa = 
            inData; 

For[j = nn, 
            j ≤ 
              n, 
tmpData = {}; 
Do[
              tmpData = Append[tmpData, daTa[[i]]]; 
              tmpData = Append[tmpData, daTa[[j/2 + i]]], {i, 
                j/2}]; 
d1 = 
              PadRight[baseType[[1]], j]; 
d2 = 
              PadRight[baseType[[2]], j]; 
sumArray = 
              Transpose[
                  Table[RotateRight[If[OddQ[i], d1, d2], 
                      i + If[OddQ[i], -1, -2]], {i, j}] ]  .  
                tmpData; 
daTa = 
              Join[sumArray, 
                Take[daTa, {j + 1, Length[daTa]}]]; 
j *= 
              2;
]; 
daTa
];

ｎ次元ウェーブレット変換関数関数定義

waveletTransformND[dataIn_, 
          baseTypeIn_] := 
Module[{nn, n, tl, data, i, k, 
            d1, d2, dataHead, dataLast, retVal, tempData, 
            dataSub}, 

nn = 
            Depth[dataIn] - 1; 
If[ 
            Depth[baseTypeIn] == 
              3, 
baseType = 
                Table[baseTypeIn, {nn}];, 
If[
                Depth[baseTypeIn] == 4   &&  
                  Length[baseTypeIn] == 
                    nn , 
baseType = 
                    baseTypeIn;, 
Abort[]];
]; 
tl = 
            Table[k, {k, nn}]  //  
              RotateRight; 

data = 
            dataIn; 
Do[
d1 = 
              baseType[[k, 1]]; 
d2 = 
              baseType[[k, 
                  2]]; 
retVal = {}; 
dataSub = data; 
While[
              True, 
dataHead = {}; 
              dataLast = {}; 
Do[
tempData = 
                  Take[RotateLeft[dataSub, i], 
                    Length[d1]]; 
dataHead = 
                  Join[dataHead, {d1  .  
                        tempData}]; 
dataLast = 
                  Join[dataLast, {d2  .  
                        tempData}];
, {i, 0, 
                  Length[dataSub] - 1, 
                  2}
]; 
retVal = 
                Join[dataLast, retVal]; 
If[
                Length[dataHead] >= Length[d1], dataSub = dataHead; 
                Continue[];]; 
data = 
                Transpose[Join[dataHead, retVal], 
                  tl]; 
Break[];
]
, {k, 
              nn}]; 
data
];

ｎ次元ウェーブレット逆変換関数関数定義

InverseWaveletTransformND[dataIn_, 
          baseTypeIn_] := 
Module[{nnn, nn, n, tl, data, i, 
            j, k, d1, d2, dataHead, tempData, dataSub, 
            sumArray}, 

nn = 
            Depth[dataIn] - 1; 
If[ 
            Depth[baseTypeIn] == 
              3, 
baseType = 
                Table[baseTypeIn, {nn}];, 
If[
                Depth[baseTypeIn] == 4   &&  
                  Length[baseTypeIn] == 
                    nn , 
baseType = 
                    baseTypeIn;, 
Abort[]];
]; 
tl = 
            Table[k, {k, nn}]  //  RotateRight; 
data = 
            dataIn; 
Do[
dataSub  = 
              data; 
n = 
              Length[dataSub]; 
nnn = 
              2 ^ Ceiling[
                  Log[2, Length[
                      baseType[[k, 1]]]]]; 
For[
              j = nnn, 
              j ≤ 
                n, 
tmpData = {}; 
Do[
                tmpData = Append[tmpData, dataSub[[i]]]; 
                tmpData = Append[tmpData, dataSub[[j/2 + i]]], {i, 
                  j/2}]; 
d1 = 
                PadRight[baseType[[k, 1]], j]; 
d2 = 
                PadRight[baseType[[k, 2]], 
                  j]; 
sumArray = 
                Transpose[
                    Table[RotateRight[If[OddQ[i], d1, d2], 
                        i + If[OddQ[i], -1, -2]], {i, j}] ]  .  
                  tmpData; 
dataSub = 
                Join[sumArray, 
                  Take[dataSub, {j + 1, 
                      Length[dataSub]}]]; 
j *= 
                2;
]; 
data = 
              Transpose[dataSub, tl]
, {k, 
              nn}]; 
data
];

「ウェーブレット変換 ｎ次の関数」の使用法
                                             ３次元ウェーブレット変換の例

ウェーブレット変換 ｎ次の関数  waveletTransformND は ｎ次元データのウェーブレット変換をウェーブレット変換行列 wMat を用いて行う関数です。
     たとえば、32×16×64 の大きさの配列データを基底関数  daub2(ドビッシーの2次基底関数), daub4 ,daub8を用いてウェーブレット変換し、ウェーブレットスペクトラムを求める手順は次のとおりです。
1. ウェーブレット変換行列  wMat を作成します。
                  wMat={daub2,daub4,daub8};
2. ウェーブレット変換し、ウェーブレットスペクトラム wSpect を求めます。
                  wSpect=waveletTransformND[data,wMat];

      ウェーブレット逆変換の ｎ次の関数  InverseWaveletTransformND は ｎ次元データのウェーブレット逆変換をウェーブレット変換行列 wMat を用いて行う関数です。	ウェーブレットスペクトラム wSpect を逆変換してデータを復元する手順は次のとおりです
1. ウェーブレット変換行列 wMat を作成します。
                  wMat={daub2,daub4,daub8};
2. 逆変します。
                 recover=InverseWaveletTransformND[wSpect,wMat];
 このとき wMat=daub4 のように 基底関数を１つだけ記述すると、
          wMat={daub4,daub4,daub4}; 
 と同じになります。

多重解像度計算の関数

多重解像度計算の関数（１次元）

expanMatrix[v_,wMat_]:=
 Block[{mdata=Length[v],is=Length[wMat[[1]]],
	ndata=Ceiling[Log[2.,mdata]],mother,emat,exPan},
	mother=Ceiling[Log[2.,is]]-1;	
    emat=InverseWaveletTransform[Join[Take[v,{1,2^mother}],Table[0,{mdata-
    		2^mother}]],wMat];	
   	partInverse[i_]:=(exPan=Table[0,{mdata}];
   		Do[exPan[[j]]=v[[j]],{j,1+2^(i-1),2^i}];
   		InverseWaveletTransform[exPan,wMat]);
    exPan=Table[partInverse[i],{i,mother+1,ndata}];
    emat=AppendColumns[{emat},exPan]		
  ];

多重解像度計算の関数（２次元）

expanMatrix2D[spect2D_,baseTypeIn_]:=
	Block[{dim=Dimensions[spect2D],wMattable,isL,isR,
	       motherL,motherR,emat2D,exPan2D},
	
    If[ Depth[baseTypeIn]==3,
                    wMattable={baseTypeIn,baseTypeIn},
                      wMattable=baseTypeIn];
    isL=Length[wMattable[[1]][[1]]]; isR=Length[wMattable[[2]][[1]]];
    motherL=Ceiling[Log[2.,isL]]-1; motherR=Ceiling[Log[2.,isR]]-1;
	nLdataL=Log[2,dim[[1]]]; nLdataR=Log[2,dim[[2]]];
	 sizeL=dim[[1]]; sizeR=dim[[2]];
	 nL=nLdataL-motherL; nR=nLdataR-motherR;
	  Which[
		nL>=nR, nLdata=nL;sizeR=2^(motherR+nL),
		nR>nL, nLdata=nR;sizeL=2^(motherL+nR)
		];

	 inputMatrix=ZeroMatrix[sizeL,sizeR];
			Do[inputMatrix[[i,j]]=spect2D[[i,j]],
				{i,dim[[1]]},{j,dim[[2]]}];
		
	  exPan2D=ZeroMatrix[dim[[1]],dim[[2]]];
			Do[Do[exPan2D[[i,j]]=spect2D[[i,j]],{i,2^motherL}],
				{j,2^motherR}];
			emat2D=InverseWaveletTransformND[exPan2D,wMattable];
		
	  partInverse2D[i_]:=
			(	iL=motherL+i; iR=motherR+i;
			    dummyMat=ZeroMatrix[sizeL,sizeR];
				Do[dummyMat[[k,m]]=inputMatrix[[k,m]],
					{k,2^iL},{m,1+2^(iR-1),2^iR}];
   				Do[dummyMat[[k,m]]=inputMatrix[[k,m]],
   					{k,1+2^(iL-1),2^iL},{m,2^(iR-1)}];
   				InverseWaveletTransformND[Table[dummyMat[[k,m]],
   					{k,dim[[1]]},{m,dim[[2]]}],wMattable]
   			);
    	
      exPan2D=Table[partInverse2D[i],{i,nLdata}];
    		Flatten[{{emat2D},exPan2D},1]
    ];

多重解像度計算の関数（３次元）

expanMatrix3D[spectrum_,baseTypeIn_]:=
	Block[{dim=Dimensions[spectrum],
	   n=Depth[spectrum]-1,wMattable,is,
	   mother,nwdata,ndata,size,emat3D,exPan3D},
	 
   If[ Depth[baseTypeIn]==3,
                    wMattable=Table[baseTypeIn,{n}],
                      wMattable=baseTypeIn];
   is=Table[Length[wMattable[[i]][[1]]],
	                        {i,Length[wMattable]}];
   mother=Table[Ceiling[Log[2.,is[[i]]]]-1,{i,n}];
   nwdata=Table[Log[2,dim[[i]]]-mother[[i]],{i,n}];
   ndata=Max[nwdata]; size=2^(mother+ndata);
   
   inputMatrix=Table[0,{size[[1]]},{size[[2]]},{size[[3]]}];
   Do[inputMatrix[[k,j,i]]=spectrum[[k,j,i]],
				{k,dim[[1]]},{j,dim[[2]]},{i,dim[[3]]}];
		
   exPanM=Table[0,{dim[[1]]},{dim[[2]]},{dim[[3]]}];;
   Do[exPanM[[k,j,i]]=spectrum[[k,j,i]],{k,2^mother[[1]]},
				{j,2^mother[[2]]},{i,2^mother[[3]]}];
	emat=InverseWaveletTransformND[exPanM,wMattable];
		
   partInverse[i_]:=
	(s=mother+i;
	 dummyMat=Table[0,{size[[1]]},{size[[2]]},{size[[3]]}];
	 Do[dummyMat[[k,l,m]]=inputMatrix[[k,l,m]],
	  {k,1+2^(s[[1]]-1),2^s[[1]]},{l,2^s[[2]]},{m,2^s[[3]]}];
	 Do[dummyMat[[k,l,m]]=inputMatrix[[k,l,m]],
   	  {k,2^(s[[1]]-1)},{l,2^s[[2]]},{m,1+2^(s[[3]]-1),2^s[[3]]}];
   	 Do[dummyMat[[k,l,m]]=inputMatrix[[k,l,m]],
      {k,2^(s[[1]]-1)},{l,1+2^(s[[2]]-1),2^s[[2]]},{m,2^(s[[3]]-1)}];
     InverseWaveletTransformND[Table[dummyMat[[k,l,m]],
   		{k,dim[[1]]},{l,dim[[2]]},{m,dim[[3]]}],wMattable]
   	 );
    	
      exPanM=Table[partInverse[i],{i,ndata}];
      Join[{emat},exPanM]
    ];

離散値系ウェーブレット変換用（１次元の例）

Data    1989年5月 〜 1994年8月  風データ（250hPa）point (140E, 35N)

x0 = {44.7, 32.1, 14.9, 6.8, 16.4, 42.5, 48.1, 59.4, 64.6, 44.8, 
          51.7, 47.2, 39.8, 26.9, 9.7, 5.4, 16. , 34.1, 45. , 58.1, 64.9, 
          63.6, 49.7, 39.7, 34.7, 31.4, 21.2, 11.6, 21.8, 33.6, 57.5, 54.7, 
          61.5, 62.9, 52. , 42.5, 34. , 34.8, 21.3, 9.2, 25.9, 43.6, 52.5, 
          59.9, 62.7, 59.7, 49.5, 50.8, 39.5, 32.4, 22.1, 15.9, 25.8, 45. , 
          54.3, 66.9, 61.6, 57. , 59.4, 42.3, 37.5, 32.7, 
          2.5, -1.5};
y0 = {8.4, 3.4, -0.2, 1.4, 6. , 10.3, 8.8, 10.7, 8.2, 
          2.1, -2. , -0.7, 1.3, 4.2, -7.4, -0.8, 3. , 15.4, 
          5.8, 11.7, -0.3, 2.1, 1.7, 6.1, 0.1, 2.5, -0.4, 1.2, 7.9, 
          19.4, 16.2, 8.7, 13.8, 3.5, 5.6, 6. , 3.6, 8.6, -1.6, 
          2.2, -2.8, 12.3, 18.6, 3.4, 10.3, 0.5, 1.8, -0.1, -0.1, 
          1.2, 3.5, 2.8, 11.1, 14.4, 7.5, 13.3, 4. , -4.5, 3.1, -2.3, 
          8.5, 2.2, -5.4, -2.8};

v = Transpose[{x0, y0}]; ng = Length[x0];

データのグラフ

g1 = 
        ListPlot[x0, PlotRange -> {All, All}, 
          PlotJoined -> True];
g2 = 
        ListPlot[y0, PlotRange -> {All, All}, 
          PlotJoined -> True];

\(\(\(\ \)\(\(fontc14 = {"Courier", 14. };\)

    \ \(fontc12 = {"Courier", 12. };\)

    \ \(fontc11 = {"Courier", 11. };\)

    \(mt = {5, 6, 7, 8, 9, 10, 11, 12, 
1, 2, 3, 4, 5, 6, 
          7, 8, 9, 10, 11, 12, 
1, 2, 3, 4, 5, 6, 7, 8, 9, 
          10, 11, 12, 
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 
          12, 
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 
          12, 
1, 2, 3, 4, 5, 6, 7, 8};\)

    \(xt = Table[{i, FontForm[mt[\([i]\)], fontc14]}, {i, 3, ng, 6}];\)

    \(ytx = Table[{i, FontForm[i, fontc14]}, {i, \(-20\), 60, 10}];\)

    \(yty = 
        Table[{i, FontForm[i, fontc14]}, {i, \(-20\), 60, 
            5}];\)\)\)\)

\(\(Show[g1, g2, PlotRange -> {All, {\(-12\), 70}}, \ 
        AxesOrigin -> {0, \(-12\)}, 
AxesLabel -> {FontForm["  ", 
              fontc14], \ ""}, 
AspectRatio -> 
          0.5, Ticks -> {xt, ytx}, 
        ImageSize -> {300, 
            180}, 
Epilog -> {Text[
              FontForm["m/sec.", fontc12], {\(-4.28\), 78}, {\(-1\), 
                0}], 
Text[
              FontForm["u", fontc14], {63.1, 54.1}, {\(-1\), 
                0}], 
Text[
              FontForm["v", fontc14], {65, \(-7.2\)}, {\(-1\), 0}], 
            Text[FontForm["Month", fontc11], {63.6, \(-19.63\)}, {\(-1\), 
                0}], 
Text[
              FontForm["1990", fontc12], {7, \(-27\)}, {\(-1\), 
                0}], 
Text[
              FontForm["1991", fontc12], {19, \(-27\)}, {\(-1\), 
                0}], 
\ \ \ \ \ \ \ Text[
              FontForm["1992", fontc12], {31, \(-27\)}, {\(-1\), 
                0}], 
\ \ \ \ \ \ \ Text[
              FontForm["1993", fontc12], {43, \(-27\)}, {\(-1\), 
                0}], 
Text[
              FontForm["1994 Year", fontc12], {55, \(-27\)}, {\(-1\), 
                0}]}];\)\)

ytx = 
        Table[{i, FontForm[i, fontc14]}, {i, -20, 60, 
            20}];
\(\(epl = {Text[
            FontForm["m/sec.", fontc12], {\(-4.28\), 78}, {\(-1\), 
              0}], 
Text[
            FontForm["Month", fontc11], {63.6, \(-32.63\)}, {\(-1\), 
              0}], 
Text[
            FontForm["1990", fontc12], {7, \(-50\)}, {\(-1\), 
              0}], 
Text[
            FontForm["1991", fontc12], {19, \(-50\)}, {\(-1\), 
              0}], 
\ \ \ \ \ \ \ Text[
            FontForm["1992", fontc12], {31, \(-50\)}, {\(-1\), 
              0}], 
\ \ \ \ \ \ \ Text[
            FontForm["1993", fontc12], {43, \(-50\)}, {\(-1\), 
              0}], 
Text[
            FontForm["1994 Year", fontc12], {55, \(-50\)}, {\(-1\), 
              0}]};\)\)

\(\(Show[g1, PlotRange -> {All, {\(-12\), 70}}, 
        AxesOrigin -> {0, \(-12\)}, 
AxesLabel -> {FontForm["  ", 
              fontc14], \ ""}, 
AspectRatio -> 
          0.2, Ticks -> {xt, ytx}, 
        ImageSize -> {300, 90}, 
Epilog -> 
          epl];\)\)

データを２のべき乗個にそろえる

order = 2;
While[ng > order, (order = order*2)];  
    n = order;
  x = Join[x0, Table[0. , {order - ng}]];   y = 
      Join[y0, Table[0. , {order - ng}]]; 
nv = Transpose[{x, y} ] ;

ウェーブレット変換    １次元

spectrum = waveletTransform[x, daub2];

spectrumG=ListPlot[spectrum,
	DisplayFunction->Identity,PlotRange->All,
	 AspectRatio -> 0.2,
	 ImageSize->{300,90},
	PlotJoined->True,PlotLabel->""];
Show[GraphicsArray[{spectrumG}]];

逆変換

recoverX = InverseWaveletTransform[spectrum, daub2];

Print["  Cor.Coe.=",
	   corRelation[Flatten[x],Flatten[recoverX]]];

多重解像度解析

multiM=expanMatrix[spectrum,daub2];
kL=Length[multiM];
iL=Length[multiM[[1]]];

\(\(ep2 = {Text[
            FontForm["m/sec.", fontc12], {\(-4.28\), 78}, {\(-1\), 
              0}], 
Text[
            FontForm["Month", fontc11], {63.6, \(-40.63\)}, {\(-1\), 
              0}], 
Text[
            FontForm["1990", fontc12], {7, \(-58\)}, {\(-1\), 
              0}], 
Text[
            FontForm["1991", fontc12], {19, \(-58\)}, {\(-1\), 
              0}], 
\ \ \ \ \ \ \ Text[
            FontForm["1992", fontc12], {31, \(-58\)}, {\(-1\), 
              0}], 
\ \ \ \ \ \ \ Text[
            FontForm["1993", fontc12], {43, \(-58\)}, {\(-1\), 
              0}], 
Text[
            FontForm["1994 Year", fontc12], {55, \(-58\)}, {\(-1\), 
              0}]};\)\)

\(\(Do[
ListPlot[multiM[\([k]\)], 
          PlotRange -> {All, {\(-20\), 60}}, PlotJoined -> True, 
          AxesOrigin -> {0, \(-20\)}, 
AxesLabel -> {FontForm["  ", 
                fontc14], \ ""}, 
AspectRatio -> 
            0.2, Ticks -> {xt, 
              ytx}, 
ImageSize -> {300, 
              100}, 
Epilog -> 
            ep2]
\ , {k, kL}];\)\)