極座標系(Polar Coordinates System)において円弧r(θ)、絶対値関数(の描く正方形)x+y=r、そして正方形{x,y}(±r,±r)はそれぞれこう見えます。
# 円関数
Circle_cmp<-function(Radius){
complex(mod=rep(Radius,41), arg=seq(pi,-pi,length=41))
}
# 絶対値関数(方形)
ABS_cmp<-function(Radius){
# 極座標系における正方形
cx01A<-seq(-1,0,length=11)
cx01B<-seq(0,1,length=11)
cx01C<-rev(seq(0,1,length=11))
cx01D<-rev(seq(-1,0,length=11))
cx01<-c(cx01A,cx01B[2:11],cx01C[2:11],cx01D[2:11])
cy01A<-seq(0,1,length=11)
cy01B<-rev(seq(0,1,length=11))
cy01C<-rev(seq(-1,0,length=11))
cy01D<-seq(-1,0,length=11)
cy01<-c(cy01A,cy01B[2:11],cy01C[2:11],cy01D[2:11])
complex(re=Radius*cx01, im=Radius*cy01)
}
# 方形関数
Square_cmp<-function(Radius){
# 極座標系における正方形
cx02A<-rep(-1,11)
cx02B<-seq(-1,1,length=11)
cx02C<-rep(1,11)
cx02D<-rev(seq(-1,1,length=11))
cx02<-c(cx02A[6:10],cx02B[1:10],cx02C[1:10],cx02D[1:10],cx02A[1:6])
cy02A<-seq(-1,1,length=11)
cy02B<-rep(1,11)
cy02C<-rev(seq(-1,1,length=11))
cy02D<-rep(-1,11)
cy02<-c(cy02A[6:10],cy02B[1:10],cy02C[1:10],cy02D[1:10],cy02A[1:6])
complex(re=Radius*cx02, im=Radius*cy02)
}
# メインプログラム
CC01<-Circle_cmp(1)
RC01<-RevC_cmp(1)
AC01<-ABS_cmp(1)
SC01<-Square_cmp(1)
# 極座標系区分(-pi/2→pi/2)
Ind01<-11:31
c01<-c(CC01[Ind01],AC01[Ind01],SC01[Ind01])
plot(c01,asp=1,xlim=c(-1,1),ylim=c(-1,1),type="l",main="Polar Coordinates System r(θ)",xlab="Real",ylab="Imaginary",col=rgb(0,0,1))
# 極座標系区分(-pi/2→-pi)
par(new=T)#上書き指定
Ind02<-1:11
c02<-c(CC01[Ind02],AC01[Ind02],SC01[Ind02])
plot(c02,asp=1,xlim=c(-1,1),ylim=c(-1,1),type="l",main="",xlab="",ylab="",col=rgb(1,1,0))
# 極座標系区分(pi/2→pi)
par(new=T)#上書き指定
Ind03<-31:41
c03<-c(CC01[Ind03],AC01[Ind03],SC01[Ind03])
plot(c03,asp=1,xlim=c(-1,1),ylim=c(-1,1),type="l",main="",xlab="",ylab="",col=rgb(1,0,1))
abline(h=0)
abline(v=0)
# 凡例を書き添える
legend("bottomright", legend = c("θ=π/2~-π/2","θ=π/2~π","θ=-π/2~-π"), col=c(rgb(0,0,1),rgb(1,1,0),rgb(1,0,1)),lty =c(1,1,1),cex=0.8)
各象限に現れる曲線が、距離関数(Distance Function)の計算結果と合致します。
【初心者向け】方形描画関数②距離空間との関係。
cx<-seq(0,1,length=61)
f0<-function(x,p){(1-(x^p))^(1/p)}
cy10<-f0(cx,1/10)
cy15<-f0(cx,1/1.782273)
cy20<-f0(cx,1)
cy30<-f0(cx,2)
cy40<-f0(cx,99)
plot(cx,cy10,type="l",asp=1,xlim=c(0,1),ylim=c(0,1),main="p-Norm",xlab="",ylab="",col=rgb(1,0,1))
par(new=T)
plot(cx,cy15,type="l",asp=1,xlim=c(0,1),ylim=c(0,1),main="p-Norm",xlab="",ylab="",col=rgb(1,1,0))
par(new=T)
plot(cx,cy20,type="l",asp=1,xlim=c(0,1),ylim=c(0,1),main="",xlab="",ylab="",col=rgb(0,1,0))
par(new=T)
plot(cx,cy30,type="l",asp=1,xlim=c(0,1),ylim=c(0,1),main="",xlab="",ylab="",col=rgb(1,0,0))
par(new=T)
plot(cx,cy40,type="l",asp=1,xlim=c(0,1),ylim=c(0,1),main="",xlab="",ylab="",col=rgb(0,0,1))
# 凡例を書き添える 。
legend("bottomleft", legend=c("p=0.1","p=1/1.78…","p=1","p=2","p=99"), lty =c(1,1,1,1,1),col=c(rgb(1,0,1),rgb(1,1,0),rgb(0,1,0),rgb(1,0,0),rgb(0,0,1)),cex=0.8)
それでは今度はここに放物線(Parabra)とその逆関数を置いてみます。
# 円関数
Circle_cmp<-function(Radius){
complex(mod=rep(Radius,41), arg=seq(pi,-pi,length=41))
}
# 絶対値関数(方形)
ABS_cmp<-function(Radius){
# 極座標系における正方形
cx01A<-seq(-1,0,length=11)
cx01B<-seq(0,1,length=11)
cx01C<-rev(seq(0,1,length=11))
cx01D<-rev(seq(-1,0,length=11))
cx01<-c(cx01A,cx01B[2:11],cx01C[2:11],cx01D[2:11])
cy01A<-seq(0,1,length=11)
cy01B<-rev(seq(0,1,length=11))
cy01C<-rev(seq(-1,0,length=11))
cy01D<-seq(-1,0,length=11)
cy01<-c(cy01A,cy01B[2:11],cy01C[2:11],cy01D[2:11])
complex(re=Radius*cx01, im=Radius*cy01)
}
# 方形関数
Square_cmp<-function(Radius){
# 極座標系における正方形
cx02A<-rep(-1,11)
cx02B<-seq(-1,1,length=11)
cx02C<-rep(1,11)
cx02D<-rev(seq(-1,1,length=11))
cx02<-c(cx02A[6:10],cx02B[1:10],cx02C[1:10],cx02D[1:10],cx02A[1:6])
cy02A<-seq(-1,1,length=11)
cy02B<-rep(1,11)
cy02C<-rev(seq(-1,1,length=11))
cy02D<-rep(-1,11)
cy02<-c(cy02A[6:10],cy02B[1:10],cy02C[1:10],cy02D[1:10],cy02A[1:6])
complex(re=Radius*cx02, im=Radius*cy02)
}
CC01<-Circle_cmp(1)
RC01<-RevC_cmp(1)
AC01<-ABS_cmp(1)
SC01<-Square_cmp(1)
# 極座標系区分(-pi/2→pi/2)
Ind01<-11:31
c01<-c(CC01[Ind01],AC01[Ind01],SC01[Ind01])
plot(c01,asp=1,xlim=c(-1,1),ylim=c(-1,1),type="l",main="Polar Coordinates System r(θ)",xlab="Real",ylab="Imaginary",col=c(200,200,200))
# 極座標系区分(-pi/2→-pi)
par(new=T)#上書き指定
Ind02<-1:11
c02<-c(CC01[Ind02],AC01[Ind02],SC01[Ind02])
plot(c02,asp=1,xlim=c(-1,1),ylim=c(-1,1),type="l",main="",xlab="",ylab="",col=c(200,200,200))
# 極座標系区分(pi/2→pi)
par(new=T)#上書き指定
Ind03<-31:41
c03<-c(CC01[Ind03],AC01[Ind03],SC01[Ind03])
plot(c03,asp=1,xlim=c(-1,1),ylim=c(-1,1),type="l",main="",xlab="",ylab="",col=c(200,200,200))
# 放物線の追加
s00=seq(-1,1,length=41)
s01<-complex(re=s00,im=s00^2)
s02<-complex(re=s00^2,im=s00)
par(new=T)#上書き指定
plot(s01,type="l",asp=1,xlim=c(-1,1),ylim=c(-1,1),main="",xlab="",ylab="",col=rgb(0,0,1))
par(new=T)#上書き指定
plot(-s01,type="l",asp=1,xlim=c(-1,1),ylim=c(-1,1),main="",xlab="",ylab="",col=rgb(1,0,0))
par(new=T)#上書き指定
plot(s02,type="l",asp=1,xlim=c(-1,1),ylim=c(-1,1),main="",xlab="",ylab="",col=rgb(0,1,0))
par(new=T)#上書き指定
plot(-s02,type="l",asp=1,xlim=c(-1,1),ylim=c(-1,1),main="",xlab="",ylab="",col=rgb(1,1,0))
segments(-7,-7,7,7,col=rgb(0,0,0))
segments(-7,7,7,-7,col=rgb(0,0,0))
abline(h=0,col=c(200,200,200))
abline(v=0,col=c(200,200,200))
# 凡例を書き添える
legend("bottomright", legend = c("y=x^2","y=-x^2","y=sqrt(x)","y=-sqrt(x)","y=x/y=-x"), col=c(rgb(0,0,1),rgb(1,0,0),rgb(0,1,0),rgb(1,1,0),rgb(0,0,0)),lty =c(1,1,1,1),cex=0.8)
何だか「単位円上の円描画関数y=sqrt(1-x^2)が半円しか描けない問題」も「N^(1/x)関数でN<0の計算が出来ない問題」も、大元は「符号概念を導入した円は片側からは反面しか見えない」問題に帰着する気がしてきました。
【初心者向け】線形関数や絶対値関数 - Qiita
逆をいえば「符号概念導入以前の円なら裏側まで見通せる」という事です。それでも見た目がそんなに変わらないのが興味深い?
【初心者向け】誤差関数(ERF)と相補誤差関数 (ERFC)。 - Qiita
またN^x系関数と、その逆関数たるN^(1/x)系関数の距離1までの軌跡に注目すると距離関数めいた振る舞いが浮かび上がってきます。
- N^x系関数はy=0から出発し第一象限においては{0,0}{1,0}{1,1}へと収束していく。その間、軌跡の残り部分は第二象限と第三象限(x<0)を往復する(実数値は偶数の時二象限、奇数の時に第三象限。虚数値は両者を半分のピッチで往復)。
- (一次関数y=x/y=-xの軌跡を軸に回転させたN^x系関数の逆関数たる)±N^(1/x)系関数はx=0から出発し第一象限においては{0,0}{0,1}{1,1}へと収束していく。その間、軌跡の残り部分は第三象限と第四象限(y<0)を往復する(実数値は偶数の時四象限、奇数の時に第三象限。虚数値は両者を半分のピッチで往復)。
この数理の具体的解析はこれからですが、最終的には両者を一緒くたに扱える可能性も出てきたという事です。
【Rで球面幾何学】そもそも複素数Xi(x*(0+1i))はどう振る舞う? - Qiita
ちなみに双曲線関数Cosh(x),Sinh(x),Tanh(x)を置いてみましたが、あまり面白い結果にはなりませんでした。何かこのトピックに関する離心率(Eccentricity)についての手掛かりとか得られるかと思ったのですが…
# 円関数
Circle_cmp<-function(Radius){
complex(mod=rep(Radius,41), arg=seq(pi,-pi,length=41))
}
# 絶対値関数(方形)
ABS_cmp<-function(Radius){
# 極座標系における正方形
cx01A<-seq(-1,0,length=11)
cx01B<-seq(0,1,length=11)
cx01C<-rev(seq(0,1,length=11))
cx01D<-rev(seq(-1,0,length=11))
cx01<-c(cx01A,cx01B[2:11],cx01C[2:11],cx01D[2:11])
cy01A<-seq(0,1,length=11)
cy01B<-rev(seq(0,1,length=11))
cy01C<-rev(seq(-1,0,length=11))
cy01D<-seq(-1,0,length=11)
cy01<-c(cy01A,cy01B[2:11],cy01C[2:11],cy01D[2:11])
complex(re=Radius*cx01, im=Radius*cy01)
}
# 方形関数
Square_cmp<-function(Radius){
# 極座標系における正方形
cx02A<-rep(-1,11)
cx02B<-seq(-1,1,length=11)
cx02C<-rep(1,11)
cx02D<-rev(seq(-1,1,length=11))
cx02<-c(cx02A[6:10],cx02B[1:10],cx02C[1:10],cx02D[1:10],cx02A[1:6])
cy02A<-seq(-1,1,length=11)
cy02B<-rep(1,11)
cy02C<-rev(seq(-1,1,length=11))
cy02D<-rep(-1,11)
cy02<-c(cy02A[6:10],cy02B[1:10],cy02C[1:10],cy02D[1:10],cy02A[1:6])
complex(re=Radius*cx02, im=Radius*cy02)
}
CC01<-Circle_cmp(1)
RC01<-RevC_cmp(1)
AC01<-ABS_cmp(1)
SC01<-Square_cmp(1)
# 極座標系区分(-pi/2→pi/2)
Ind01<-11:31
c01<-c(CC01[Ind01],AC01[Ind01],SC01[Ind01])
plot(c01,asp=1,xlim=c(-1,1),ylim=c(-1,1),type="l",main="Polar Coordinates System r(θ)",xlab="Real",ylab="Imaginary",col=c(200,200,200))
# 極座標系区分(-pi/2→-pi)
par(new=T)#上書き指定
Ind02<-1:11
c02<-c(CC01[Ind02],AC01[Ind02],SC01[Ind02])
plot(c02,asp=1,xlim=c(-1,1),ylim=c(-1,1),type="l",main="",xlab="",ylab="",col=c(200,200,200))
# 極座標系区分(pi/2→pi)
par(new=T)#上書き指定
Ind03<-31:41
c03<-c(CC01[Ind03],AC01[Ind03],SC01[Ind03])
plot(c03,asp=1,xlim=c(-1,1),ylim=c(-1,1),type="l",main="",xlab="",ylab="",col=c(200,200,200))
# 放物線の追加
s00=seq(-1,1,length=41)
s01<-complex(re=s00,im=s00^2)
s02<-complex(re=s00^2,im=s00)
par(new=T)#上書き指定
plot(s01,type="l",asp=1,xlim=c(-1,1),ylim=c(-1,1),main="",xlab="",ylab="",col=rgb(0,0,0))
par(new=T)#上書き指定
plot(-s01,type="l",asp=1,xlim=c(-1,1),ylim=c(-1,1),main="",xlab="",ylab="",col=rgb(0,0,0))
par(new=T)#上書き指定
plot(s02,type="l",asp=1,xlim=c(-1,1),ylim=c(-1,1),main="",xlab="",ylab="",col=rgb(0,0,0))
par(new=T)#上書き指定
plot(-s02,type="l",asp=1,xlim=c(-1,1),ylim=c(-1,1),main="",xlab="",ylab="",col=rgb(0,0,0))
# 双曲線の追加
s03<-complex(re=s00,im=(exp(s00)+exp(-s00))/2)
s04<-complex(re=s00,im=(exp(s00)-exp(-s00))/2)
s05<-complex(re=s00,im=(exp(s00)-exp(-s00))/(exp(s00)+exp(-s00)))
par(new=T)#上書き指定
plot(s03,type="l",asp=1,xlim=c(-1,1),ylim=c(-1,1),main="",xlab="",ylab="",col=rgb(0,0,1))
par(new=T)#上書き指定
plot(s04,type="l",asp=1,xlim=c(-1,1),ylim=c(-1,1),main="",xlab="",ylab="",col=rgb(1,0,0))
par(new=T)#上書き指定
plot(s05,type="l",asp=1,xlim=c(-1,1),ylim=c(-1,1),main="",xlab="",ylab="",col=rgb(0,1,0))
segments(-7,-7,7,7,col=rgb(0,0,0))
segments(-7,7,7,-7,col=rgb(0,0,0))
abline(h=0,col=c(200,200,200))
abline(v=0,col=c(200,200,200))
# 凡例を書き添える
legend("bottomright", legend = c("y=Cosh(x)","y=Sinh(x)","y=Tanh(x)"), col=c(rgb(0,0,1),rgb(1,0,0),rgb(0,1,0)),lty =c(1,1,1),cex=0.8)
双曲線(Hyperbola)そのものを置いても似た様な結果。何かこう、このアプローチでは楕円も含む「円錐的連続性」みたいなものが片鱗も感じられないというか…
# 円関数
Circle_cmp<-function(Radius){
complex(mod=rep(Radius,41), arg=seq(pi,-pi,length=41))
}
# 絶対値関数(方形)
ABS_cmp<-function(Radius){
# 極座標系における正方形
cx01A<-seq(-1,0,length=11)
cx01B<-seq(0,1,length=11)
cx01C<-rev(seq(0,1,length=11))
cx01D<-rev(seq(-1,0,length=11))
cx01<-c(cx01A,cx01B[2:11],cx01C[2:11],cx01D[2:11])
cy01A<-seq(0,1,length=11)
cy01B<-rev(seq(0,1,length=11))
cy01C<-rev(seq(-1,0,length=11))
cy01D<-seq(-1,0,length=11)
cy01<-c(cy01A,cy01B[2:11],cy01C[2:11],cy01D[2:11])
complex(re=Radius*cx01, im=Radius*cy01)
}
# 方形関数
Square_cmp<-function(Radius){
# 極座標系における正方形
cx02A<-rep(-1,11)
cx02B<-seq(-1,1,length=11)
cx02C<-rep(1,11)
cx02D<-rev(seq(-1,1,length=11))
cx02<-c(cx02A[6:10],cx02B[1:10],cx02C[1:10],cx02D[1:10],cx02A[1:6])
cy02A<-seq(-1,1,length=11)
cy02B<-rep(1,11)
cy02C<-rev(seq(-1,1,length=11))
cy02D<-rep(-1,11)
cy02<-c(cy02A[6:10],cy02B[1:10],cy02C[1:10],cy02D[1:10],cy02A[1:6])
complex(re=Radius*cx02, im=Radius*cy02)
}
CC01<-Circle_cmp(1)
RC01<-RevC_cmp(1)
AC01<-ABS_cmp(1)
SC01<-Square_cmp(1)
# 極座標系区分(-pi/2→pi/2)
Ind01<-11:31
c01<-c(CC01[Ind01],AC01[Ind01],SC01[Ind01])
plot(c01,asp=1,xlim=c(-1,1),ylim=c(-1,1),type="l",main="Polar Coordinates System r(θ)",xlab="Real",ylab="Imaginary",col=c(200,200,200))
# 極座標系区分(-pi/2→-pi)
par(new=T)#上書き指定
Ind02<-1:11
c02<-c(CC01[Ind02],AC01[Ind02],SC01[Ind02])
plot(c02,asp=1,xlim=c(-1,1),ylim=c(-1,1),type="l",main="",xlab="",ylab="",col=c(200,200,200))
# 極座標系区分(pi/2→pi)
par(new=T)#上書き指定
Ind03<-31:41
c03<-c(CC01[Ind03],AC01[Ind03],SC01[Ind03])
plot(c03,asp=1,xlim=c(-1,1),ylim=c(-1,1),type="l",main="",xlab="",ylab="",col=c(200,200,200))
# 放物線の追加
s00=seq(-1,1,length=41)
s01<-complex(re=s00,im=s00^2)
s02<-complex(re=s00^2,im=s00)
par(new=T)#上書き指定
plot(s01,type="l",asp=1,xlim=c(-1,1),ylim=c(-1,1),main="",xlab="",ylab="",col=rgb(0,0,0))
par(new=T)#上書き指定
plot(-s01,type="l",asp=1,xlim=c(-1,1),ylim=c(-1,1),main="",xlab="",ylab="",col=rgb(0,0,0))
par(new=T)#上書き指定
plot(s02,type="l",asp=1,xlim=c(-1,1),ylim=c(-1,1),main="",xlab="",ylab="",col=rgb(0,0,0))
par(new=T)#上書き指定
plot(-s02,type="l",asp=1,xlim=c(-1,1),ylim=c(-1,1),main="",xlab="",ylab="",col=rgb(0,0,0))
# 双曲線の追加
s03<-complex(re=(exp(s00)+exp(-s00))/2,im=(exp(s00)-exp(-s00))/2)
s04<-complex(re=(-(exp(s00)+exp(-s00))/2),im=(exp(s00)-exp(-s00))/2)
par(new=T)#上書き指定
plot(s03,type="l",asp=1,xlim=c(-1,1),ylim=c(-1,1),main="",xlab="",ylab="",col=rgb(0,0,1))
par(new=T)#上書き指定
plot(s04,type="l",asp=1,xlim=c(-1,1),ylim=c(-1,1),main="",xlab="",ylab="",col=rgb(1,0,0))
segments(-7,-7,7,7,col=rgb(0,0,0))
segments(-7,7,7,-7,col=rgb(0,0,0))
abline(h=0,col=c(200,200,200))
abline(v=0,col=c(200,200,200))
# 凡例を書き添える
legend("bottomright", legend = c("Hyperbola","-Hyperbola"), col=c(rgb(0,0,1),rgb(1,0,0)),lty =c(1,1,1),cex=0.8)
この話については、以下のサイトのアプローチ辺りが有望そうです。
二次曲線の性質
そんな感じで以下続報…