Mathematica Overview C (in Japanese)

Programming in Mathematica

Mathematicaでのプログラミングの例．

FFT

高速フーリエ変換の例．与えられたデータの近似式を求める．

In[130]:=

FFT[data_, x_, m_] :=
	Block[ {n, a, k}, 
		n = Length[data];
		a = N[ InverseFourier[data]/Sqrt[n] ];
		Re[a[[1]]]+Sum[ 2 Re[a[[k+1]]] Cos[2 Pi k x / n] -
					    2 Im[a[[k+1]]] Sin[2 Pi k x / n] ,
					  {k,1,m} ]
	];
PlotOver[data_, f_, x_] :=
	Plot[ f, {x,0,Length[data]-1}, 
		Epilog -> Map[Point, addX[data]] ];
addX[data_] := Transpose[{Range[0,Length[data]-1],data}];

In[131]:=

data = Table[
		N[E^(-((2i/128-1)Pi)^2)+0.2Random[]],
		{i,0,127}];
ListPlot[addX[data]];

In[132]:=

FFT[data, x, 3]

Out[132]=

                       Pi x                Pi x
0.37974 - 0.453637 Cos[----] + 0.21434 Cos[----] - 
                        64                  32
 
                3 Pi x                   Pi x
  0.0629601 Cos[------] + 0.00224806 Sin[----] - 
                  64                      64
 
                 Pi x                   3 Pi x
  0.00250614 Sin[----] + 0.00300746 Sin[------]
                  32                      64

In[133]:=

PlotOver[data, %, x]

Out[133]=

-Graphics-

Drawing Binary Trees

木構造を描く．placeTree で節点をうまく配置して，drawPlacedTree で描く．

In[134]:=

placeTree[node_] := {node,0} /; ! ListQ[node];
placeTree[{node_,left_,right_}] :=
	Block[{lplace,rplace,lpos,rpos,sep},
		lplace = placeTree[left];
		rplace = placeTree[right];
		lpos = Max[rposlist[lplace]];
		rpos = Min[lposlist[rplace]];
		sep = lpos-rpos+1;
		lplace = moveright[lplace,-sep/2.];
		rplace = moveright[rplace, sep/2.];
		{node,0,lplace,rplace}
	]

In[135]:=

lposlist[{node_,x_}] := {x};
lposlist[{node_,x_,lplace_,rplace_}] :=
	{x,lposlist[lplace]};
rposlist[{node_,x_}] := {x};
rposlist[{node_,x_,lplace_,rplace_}] :=
	{x,rposlist[rplace]};

In[136]:=

moveright[{node_,x_}, dx_] := {node,x+dx};
moveright[{node_,x_,lplace_,rplace_}, dx_] :=
	{node, x+dx, moveright[lplace,dx], moveright[rplace,dx] }

In[137]:=

drawPlacedTree[{node_,x_}, y_] := {Point[{x,y}]};
drawPlacedTree[{node_,x_,lplace_,rplace_}, y_] :=
	Join[
		{ Point[{x,y}],
		  Line[{{x,y},{lplace[[2]],y-1}}],
		  Line[{{x,y},{rplace[[2]],y-1}}] },
		drawPlacedTree[lplace,y-1],
		drawPlacedTree[rplace,y-1]
	]

In[138]:=

tree = placeTree[
	{1,{1,1,
		  {1,1,1}},
	   {1,{1,{1,{1,1,1},
	   			1},
	   		  1},
	   	  {1,1,1}}}]

Out[138]=

{1, 0, {1, -2.78125, {1, -3.53125}, 
 
   {1, -2.03125, {1, -2.53125}, {1, -1.53125}}}, 
 
  {1, 2.78125, {1, 1.59375, 
 
    {1, 0.71875, {1, -0.03125, {1, -0.53125}, 
 
      {1, 0.46875}}, {1, 1.46875}}, {1, 2.46875}}, 
 
   {1, 3.96875, {1, 3.46875}, {1, 4.46875}}}}

In[139]:=

Show[Graphics[
	{PointSize[0.05],drawPlacedTree[tree,0]}
	],PlotRange->All]

Out[139]=

-Graphics-

Modifying Built-in Functions

組込み関数の計算規則を書換える．次の式は簡単化してくれない．

In[140]:=

E^(a+b Log[x])

Out[140]=

 a + b Log[x]
E

In[141]:=

FullForm[%]

Out[141]=

Power[E, Plus[a, Times[b, Log[x]]]]

次のように，計算規則を追加する．

In[142]:=

Unprotect[Power];
Power[E, a_+b_] := E^a E^b;
Power[E, a_ b_] := (E^b)^a;
Power[E, Log[a_]] := a;
Protect[Power];

In[143]:=

??Power

Out[143]=

x^y gives x to the power y.

Attributes[Power] = {Listable, OneIdentity, Protected}
 
0^0 = 1
 
E^((a_) + (b_)) := E^a*E^b
 
E^((a_)*(b_)) := (E^b)^a
 
E^Log[a_] := a
 
Power/: Default[Power, 2] := 1

すると簡単化してくれる．

In[144]:=

E^(a+b Log[x])

Out[144]=

 a  b
E  x

もとに戻しておく．

In[145]:=

Unprotect[Power]; Clear[Power]; Protect[Power];

Perfect Hash Function

完全ハッシュ関数の例．bit 19巻 9号 48ページ (1987年8月号)参照．

In[146]:=

Needs["NumberTheory`NumberTheoryFunctions`"]

In[147]:=

pr1[n_] = n^2-n+41;

In[148]:=

perfectHash[keys_, pfunc_, x_] :=
	Mod[ 
		ChineseRemainderTheorem[
			Range[Length[keys]], Map[pfunc, keys] ],
		pfunc[x]
	]

2,4,6,8,10,12,19,36を1から8の整数に割り当てる関数を求める．

In[149]:=

ks = {2,4,6,8,10,12,19,36};
h1[n_] = perfectHash[ks,pr1,n]

Out[149]=

                                 2
Mod[16599229625856279, 41 - n + n ]

In[150]:=

Map[h1, ks]

Out[150]=

{1, 2, 3, 4, 5, 6, 7, 8}

最初に戻る

Dept. CS / Faculty of Eng. / Kobe Univ. / Naoyuki Tamura