【記述統計情報倉庫】フーリエ変換の記述統計面②　とりあえず「極座標系ヒストグラム表示」について。

「単位円（Unut Circle、半径１の円弧）」は「直交座標系（Rectangular coordinate system/Orthogonal coordinate system）」3Dヒストグラムにおいては「円周上に観測される出現頻度１の点の集合」、「極座標系（Polar coordinates system）」ヒストグラムにおいては「（観測単位に対応する数量の）長さ１の線の集合」と観測されます。

f:id:ochimusha01:20191003022548g:plain

f:id:ochimusha01:20191003055756p:plain

この観点から「（正弦波の足し合わせだけであらゆる波形を再現する）フーリエ解析による波形合成過程」を観察してみました。直交座標系3Dヒストグラムによる観察結果は以下。

ここでは極座標系ヒストグラムによる観察結果をまとめてみたいと思います。
＊周期２の円弧の半径は0.5である点に注意。グラフを見ても分かる通り、半径未満となる線分は存在しないので一番左端のバーは常に「（0-半径を含む）原点間近のグループ」を表示している。

三角波（Triangular wave）

f:id:ochimusha01:20190815110144g:plain

その時の複素数空間（complex n-space）上のXZ（Cos）面…「偶数系」なので実数部を正面にすると確かに三角波が合成されている（周期２）。

f:id:ochimusha01:20191003213631g:plain

f:id:ochimusha01:20190830054423g:plain

f:id:ochimusha01:20190828002902p:plain

その時の複素数空間（complex n-space）上のXY（円弧）面。

f:id:ochimusha01:20190822154404g:plain

f:id:ochimusha01:20191003213257g:plain

統計言語Rによる極座標系ヒストグラム表示

FATW_xy<-function(x){
switch(x,
"0"= f0<-function(x) {pi/4*x/x},
"1"= f0<-function(x) {pi/4-2*pi/pi^2*exp(2*pi*x/pi*(0+1i))},
"2"= f0<-function(x) {pi/4-2*pi/pi^2*(exp(2*pi*x/pi*(0+1i))+exp(6*pi*x/pi*(0+1i))/3^2)},
"3"= f0<-function(x) {pi/4-2*pi/pi^2*(exp(2*pi*x/pi*(0+1i))+exp(6*pi*x/pi*(0+1i))/3^2+exp(10*pi*x/pi*(0+1i))/5^2)},
"4"= f0<-function(x) {pi/4-2*pi/pi^2*(exp(2*pi*x/pi*(0+1i))+exp(6*pi*x/pi*(0+1i))/3^2+exp(10*pi*x/pi*(0+1i))/5^2+exp(14*pi*x/pi*(0+1i))/7^2)},
"5"= f0<-function(x) {pi/4-2*pi/pi^2*(exp(2*pi*x/pi*(0+1i))+exp(6*pi*x/pi*(0+1i))/3^2+exp(10*pi*x/pi*(0+1i))/5^2+exp(14*pi*x/pi*(0+1i))/7^2+exp(18*pi*x/pi*(0+1i))/9^2)}
)

z_axis<-seq(1,-1,length=60)
radian_axis<-seq(0,2*pi,length=60)
x_axis<-Re(f0(radian_axis))
y_axis<-Im(f0(radian_axis))
polygon_60 <- data.frame(X=x_axis, Y=y_axis,Z=z_axis)
Radius_60<-data.frame(Radius=sqrt(polygon_60$X^2+polygon_60$Y^2))
hist(Radius_60$Radius,col=rgb(1,0,0))
rug(Radius_60$Radius)

}

#アニメーション
library("animation")
Time_Code=c("0","0","0","0","0","1","1","1","2","2","2","3","3","3","4","4","4","5","5")
saveGIF({
for (i in Time_Code){
　FATW_xy(i)
}
}, interval = 0.1, movie.name = "FA_hist2d.gif")

f:id:ochimusha01:20191004092031g:plain

放物線（Parabola）

f:id:ochimusha01:20190815171145g:plain

その時の複素数空間（complex n-space）上のXZ（Cos）面…「偶数系」なので実数部を正面にすると確かに放物線が合成されている（周期１）。

f:id:ochimusha01:20191003215605g:plain

f:id:ochimusha01:20190830055226g:plain
f:id:ochimusha01:20190828003425p:plain

その時の複素数空間（complex n-space）上のXY（円弧）面。

f:id:ochimusha01:20190822162110g:plain

f:id:ochimusha01:20191003215108g:plain

統計言語Rによる極座標系ヒストグラム表示

FAPB_xy<-function(x){
switch(x,
"0"= f0<-function(x) {pi^2/3*x/x},
"1"= f0<-function(x) {pi^2/3+4*(-exp(x*(0+1i)))},
"2"= f0<-function(x) {pi^2/3+4*(-exp(x*(0+1i))+exp(x*2*(0+1i))/2^2)},
"3"= f0<-function(x) {pi^2/3+4*(-exp(x*(0+1i))+exp(x*2*(0+1i))/2^2-exp(x*3*(0+1i))/3^2)},
"4"= f0<-function(x) {pi^2/3+4*(-exp(x*(0+1i))+exp(x*2*(0+1i))/2^2-exp(x*3*(0+1i))/3^2+exp(x*4*(0+1i))/4^2)},
"5"= f0<-function(x) {pi^2/3+4*(-exp(x*(0+1i))+exp(x*2*(0+1i))/2^2-exp(x*3*(0+1i))/3^2+exp(x*4*(0+1i))/4^2-exp(x*5*(0+1i))/5^2)},
"6"= f0<-function(x) {pi^2/3+4*(-exp(x*(0+1i))+exp(x*2*(0+1i))/2^2-exp(x*3*(0+1i))/3^2+exp(x*4*(0+1i))/4^2-exp(x*5*(0+1i))/5^2+exp(x*6*(0+1i))/6^2)},
"7"= f0<-function(x) {pi^2/3+4*(-exp(x*(0+1i))+exp(x*2*(0+1i))/2^2-exp(x*3*(0+1i))/3^2+exp(x*4*(0+1i))/4^2-exp(x*5*(0+1i))/5^2+exp(x*6*(0+1i))/6^2-exp(x*7*(0+1i))/7^2)},
"8"= f0<-function(x) {pi^2/3+4*(-exp(x*(0+1i))+exp(x*2*(0+1i))/2^2-exp(x*3*(0+1i))/3^2+exp(x*4*(0+1i))/4^2-exp(x*5*(0+1i))/5^2+exp(x*6*(0+1i))/6^2-exp(x*7*(0+1i))/7^2+exp(x*8*(0+1i))/8^2)},
"9"= f0<-function(x) {pi^2/3+4*(-exp(x*(0+1i))+exp(x*2*(0+1i))/2^2-exp(x*3*(0+1i))/3^2+exp(x*4*(0+1i))/4^2-exp(x*5*(0+1i))/5^2+exp(x*6*(0+1i))/6^2-exp(x*7*(0+1i))/7^2+exp(x*8*(0+1i))/8^2)-exp(x*9*(0+1i))/9^2}
)

z_axis<-seq(1,-1,length=60)
radian_axis<-seq(0,2*pi,length=60)
x_axis<-Re(f0(radian_axis))
y_axis<-Im(f0(radian_axis))
polygon_60 <- data.frame(X=x_axis, Y=y_axis,Z=z_axis)
Radius_60<-data.frame(Radius=sqrt(polygon_60$X^2+polygon_60$Y^2))
hist(Radius_60$Radius,col=rgb(1,0,0))
rug(Radius_60$Radius)

}

#アニメーション
library("animation")
Time_Code=c("0","0","0","0","0","1","1","1","2","2","2","3","3","3","4","4","4","5","5","6","7","8","9")
saveGIF({
for (i in Time_Code){
　FAPB_xy(i)
}
}, interval = 0.1, movie.name = "FA_hist2d.gif")

f:id:ochimusha01:20191004092545g:plain

ノコギリ波（Sawtooth wave）

f:id:ochimusha01:20190815072440g:plain

その時の複素数空間（complex n-space）上のYZ（Sin）面…「奇数系」なので虚数部を正面に向けると確かにノコギリ波が合成されている（周期２）。

f:id:ochimusha01:20191004054132g:plain

f:id:ochimusha01:20190830055431g:plain
f:id:ochimusha01:20190828033024p:plain

その時の複素数空間（complex n-space）上のXY（円弧）面。

f:id:ochimusha01:20190822170907g:plain

f:id:ochimusha01:20191003221629g:plain

統計言語Rによる極座標系ヒストグラム表示

FASW_xy<-function(x){
switch(x,
"0"= f0<-function(x) {pi/2*x/x},
"1"= f0<-function(x) {pi/2-exp(x*2*(0+1i))},
"2"= f0<-function(x) {pi/2-exp(x*2*(0+1i))-exp(x*4*(0+1i))/2},
"3"= f0<-function(x) {pi/2-exp(x*2*(0+1i))-exp(x*4*(0+1i))/2-exp(x*6*(0+1i))/3},
"4"= f0<-function(x) {pi/2-exp(x*2*(0+1i))-exp(x*4*(0+1i))/2-exp(x*6*(0+1i))/3-exp(x*8*(0+1i))/4},
"5"= f0<-function(x) {pi/2-exp(x*2*(0+1i))-exp(x*4*(0+1i))/2-exp(x*6*(0+1i))/3-exp(x*8*(0+1i))/4-exp(x*10*(0+1i))/5},
"6"= f0<-function(x) {pi/2-exp(x*2*(0+1i))-exp(x*4*(0+1i))/2-exp(x*6*(0+1i))/3-exp(x*8*(0+1i))/4-exp(x*10*(0+1i))/5-exp(x*12*(0+1i))/6},
"7"= f0<-function(x) {pi/2-exp(x*2*(0+1i))-exp(x*4*(0+1i))/2-exp(x*6*(0+1i))/3-exp(x*8*(0+1i))/4-exp(x*10*(0+1i))/5-exp(x*12*(0+1i))/6-exp(x*14*(0+1i))/7},
"8"= f0<-function(x) {pi/2-exp(x*2*(0+1i))-exp(x*4*(0+1i))/2-exp(x*6*(0+1i))/3-exp(x*8*(0+1i))/4-exp(x*10*(0+1i))/5-exp(x*12*(0+1i))/6-exp(x*14*(0+1i))/7-exp(x*16*(0+1i))/8},
"9"= f0<-function(x) {pi/2-exp(x*2*(0+1i))-exp(x*4*(0+1i))/2-exp(x*6*(0+1i))/3-exp(x*8*(0+1i))/4-exp(x*10*(0+1i))/5-exp(x*12*(0+1i))/6-exp(x*14*(0+1i))/7-exp(x*16*(0+1i))/8-exp(x*18*(0+1i))/9},
"10"= f0<-function(x) {pi/2-exp(x*2*(0+1i))-exp(x*4*(0+1i))/2-exp(x*6*(0+1i))/3-exp(x*8*(0+1i))/4-exp(x*10*(0+1i))/5-exp(x*12*(0+1i))/6-exp(x*14*(0+1i))/7-exp(x*16*(0+1i))/8-exp(x*18*(0+1i))/9-exp(x*20*(0+1i))/10},
"11"= f0<-function(x) {pi/2-exp(x*2*(0+1i))-exp(x*4*(0+1i))/2-exp(x*6*(0+1i))/3-exp(x*8*(0+1i))/4-exp(x*10*(0+1i))/5-exp(x*12*(0+1i))/6-exp(x*14*(0+1i))/7-exp(x*16*(0+1i))/8-exp(x*18*(0+1i))/9-exp(x*20*(0+1i))/10-exp(x*22*(0+1i))/11-exp(x*24*(0+1i))/12},
"12"= f0<-function(x) {pi/2-exp(x*2*(0+1i))-exp(x*4*(0+1i))/2-exp(x*6*(0+1i))/3-exp(x*8*(0+1i))/4-exp(x*10*(0+1i))/5-exp(x*12*(0+1i))/6-exp(x*14*(0+1i))/7-exp(x*16*(0+1i))/8-exp(x*18*(0+1i))/9-exp(x*20*(0+1i))/10-exp(x*22*(0+1i))/11-exp(x*24*(0+1i))/12-exp(x*26*(0+1i))/13-exp(x*28*(0+1i))/14},
"13"= f0<-function(x) {pi/2-exp(x*2*(0+1i))-exp(x*4*(0+1i))/2-exp(x*6*(0+1i))/3-exp(x*8*(0+1i))/4-exp(x*10*(0+1i))/5-exp(x*12*(0+1i))/6-exp(x*14*(0+1i))/7-exp(x*16*(0+1i))/8-exp(x*18*(0+1i))/9-exp(x*20*(0+1i))/10-exp(x*22*(0+1i))/11-exp(x*24*(0+1i))/12-exp(x*26*(0+1i))/13-exp(x*28*(0+1i))/14-exp(x*30*(0+1i))/15-exp(x*32*(0+1i))/16},
"14"= f0<-function(x) {pi/2-exp(x*2*(0+1i))-exp(x*4*(0+1i))/2-exp(x*6*(0+1i))/3-exp(x*8*(0+1i))/4-exp(x*10*(0+1i))/5-exp(x*12*(0+1i))/6-exp(x*14*(0+1i))/7-exp(x*16*(0+1i))/8-exp(x*18*(0+1i))/9-exp(x*20*(0+1i))/10-exp(x*22*(0+1i))/11-exp(x*24*(0+1i))/12-exp(x*26*(0+1i))/13-exp(x*28*(0+1i))/14-exp(x*30*(0+1i))/15-exp(x*32*(0+1i))/16-exp(x*34*(0+1i))/17-exp(x*36*(0+1i))/18},
"15"= f0<-function(x) {pi/2-exp(x*2*(0+1i))-exp(x*4*(0+1i))/2-exp(x*6*(0+1i))/3-exp(x*8*(0+1i))/4-exp(x*10*(0+1i))/5-exp(x*12*(0+1i))/6-exp(x*14*(0+1i))/7-exp(x*16*(0+1i))/8-exp(x*18*(0+1i))/9-exp(x*20*(0+1i))/10-exp(x*22*(0+1i))/11-exp(x*24*(0+1i))/12-exp(x*26*(0+1i))/13-exp(x*28*(0+1i))/14-exp(x*30*(0+1i))/15-exp(x*32*(0+1i))/16-exp(x*34*(0+1i))/17-exp(x*36*(0+1i))/18-exp(x*38*(0+1i))/19-exp(x*40*(0+1i))/20}
)

z_axis<-seq(1,-1,length=60)
radian_axis<-seq(0,2*pi,length=60)
x_axis<-Re(f0(radian_axis))
y_axis<-Im(f0(radian_axis))
polygon_60 <- data.frame(X=x_axis, Y=y_axis,Z=z_axis)
Radius_60<-data.frame(Radius=sqrt(polygon_60$X^2+polygon_60$Y^2))
hist(Radius_60$Radius,col=rgb(1,0,0))
rug(Radius_60$Radius)

}

#アニメーション
library("animation")
Time_Code=Time_Code=c("0","0","0","0","0","1","1","1","2","2","2","3","3","3","4","4","4","5","5","6","7","8","9","10","11","12","13","14","15")
saveGIF({
for (i in Time_Code){
　FASW_xy(i)
}
}, interval = 0.1, movie.name = "FA_hist2d.gif")

f:id:ochimusha01:20191004092837g:plain

矩形波（Square wave）

f:id:ochimusha01:20190815123000g:plain

その時の複素数空間（complex n-space）上のYZ（Sin）面…「奇数系」なので虚数部を正面にすると確かに矩形波が合成されている（周期２）。

f:id:ochimusha01:20191004060559g:plain

f:id:ochimusha01:20190830055703g:plain

f:id:ochimusha01:20190828033422p:plain

その時の複素数空間（complex n-space）上のXY（円弧）面。

f:id:ochimusha01:20190822173850g:plain

f:id:ochimusha01:20191004055528g:plain

統計言語Rによる極座標系ヒストグラム表示

FASQW_xy<-function(x){
switch(x,
"0"= f0<-function(x) {1/2*x/x},
"1"= f0<-function(x) {1/2+2/pi*exp(x*(0+1i))},
"2"= f0<-function(x) {1/2+2/pi*exp(x*(0+1i))+2/(3*pi)*exp(x*3*(0+1i))},
"3"= f0<-function(x) {1/2+2/pi*exp(x*(0+1i))+2/(3*pi)*exp(x*3*(0+1i))+2/(5*pi)*exp(x*5*(0+1i))},
"4"= f0<-function(x) {1/2+2/pi*exp(x*(0+1i))+2/(3*pi)*exp(x*3*(0+1i))+2/(5*pi)*exp(x*5*(0+1i))+2/(7*pi)*exp(x*7*(0+1i))},
"5"= f0<-function(x) {1/2+2/pi*exp(x*(0+1i))+2/(3*pi)*exp(x*3*(0+1i))+2/(5*pi)*exp(x*5*(0+1i))+2/(7*pi)*exp(x*7*(0+1i))+2/(9*pi)*exp(x*9*(0+1i))},
"6"= f0<-function(x) {1/2+2/pi*exp(x*(0+1i))+2/(3*pi)*exp(x*3*(0+1i))+2/(5*pi)*exp(x*5*(0+1i))+2/(7*pi)*exp(x*7*(0+1i))+2/(9*pi)*exp(x*9*(0+1i))+2/(11*pi)*exp(x*11*(0+1i))},
"7"= f0<-function(x) {1/2+2/pi*exp(x*(0+1i))+2/(3*pi)*exp(x*3*(0+1i))+2/(5*pi)*exp(x*5*(0+1i))+2/(7*pi)*exp(x*7*(0+1i))+2/(9*pi)*exp(x*9*(0+1i))+2/(11*pi)*exp(x*11*(0+1i))+2/(13*pi)*exp(x*13*(0+1i))},
"8"= f0<-function(x) {1/2+2/pi*exp(x*(0+1i))+2/(3*pi)*exp(x*3*(0+1i))+2/(5*pi)*exp(x*5*(0+1i))+2/(7*pi)*exp(x*7*(0+1i))+2/(9*pi)*exp(x*9*(0+1i))+2/(11*pi)*exp(x*11*(0+1i))+2/(13*pi)*exp(x*13*(0+1i))+2/(15*pi)*exp(x*15*(0+1i))},
"9"= f0<-function(x) {1/2+2/pi*exp(x*(0+1i))+2/(3*pi)*exp(x*3*(0+1i))+2/(5*pi)*exp(x*5*(0+1i))+2/(7*pi)*exp(x*7*(0+1i))+2/(9*pi)*exp(x*9*(0+1i))+2/(11*pi)*exp(x*11*(0+1i))+2/(13*pi)*exp(x*13*(0+1i))+2/(15*pi)*exp(x*15*(0+1i))+2/(17*pi)*exp(x*17*(0+1i))}
)

z_axis<-seq(1,-1,length=60)
radian_axis<-seq(0,2*pi,length=60)
x_axis<-Re(f0(radian_axis))
y_axis<-Im(f0(radian_axis))
polygon_60 <- data.frame(X=x_axis, Y=y_axis,Z=z_axis)
Radius_60<-data.frame(Radius=sqrt(polygon_60$X^2+polygon_60$Y^2))
hist(Radius_60$Radius,col=rgb(1,0,0))
rug(Radius_60$Radius)

}

#アニメーション
library("animation")
Time_Code=c("0","0","0","0","0","1","1","1","2","2","2","3","3","3","4","4","4","5","5","6","7","8","9")
saveGIF({
for (i in Time_Code){
　FASQW_xy(i)
}
}, interval = 0.1, movie.name = "FA_hist2d.gif")