【初心者向け】方形描画関数(Square Drawing Function)②距離空間(Metric Space)との関係。

今回は以下の投稿とは別の観点から出発します。
【初心者向け】方形描画関数(Square Drawing Function)①三角関数(Trigonometric Function)との関係。

#直径上の1次元運動(Linear motion)からX+Y=1の世界へ。
X軸上で+1と-1の間を等速で往復する単振動運動(Simple vibration,往復距離4)から出発します。すなわち既に対蹠(Antipodes)/直径(Diameter)は発見済みで1次元状態からは脱却しているものと考えます。いわゆる二辺形(Bilateral)状態…
【オイラーの多面体定理と正多面体】内接円/球面の半径と外接円/球面の半径の狭間

Simple_Vibration_X<-function(Radian){
c0<-seq(0,pi*2,length=61)
cx<-cos(c0)
cy<-sin(c0)
plot(cx,cy,type="l",xlim=c(-1,1),asp=1,ylim=c(-1,1),main="Simple Vibration X",xlab="x=1→0→-1→0→1",ylab="y=0", col=rgb(0,1,0))
abline(h=0,col=rgb(1,0,0))
abline(v=0,col=rgb(1,0,0))
# x位置を書き添える 。
text(0,0,"0",col=rgb(0,0,1))
text(Radian,0,"x",col=rgb(0,0,1))
segments(0,0,Radian,0,col=rgb(0,0,1))
# 凡例を書き添える 。
legend("topright", legend=c("Circle(Radius=1,Augment=θ)","x=y=0","x=1→0→-1→0→1"), lty =c(1,1,1),col=c(rgb(0,1,0),rgb(1,0,0),rgb(0,0,1)))
}

#アニメーション
library("animation")
c0<-seq(-1,1,length=31)
Time_Code<-c(rev(c0[2:31]),c0)
saveGIF({
for (i in Time_Code){
　Simple_Vibration_X(i)
}
}, interval = 0.1, movie.name = "Simple_Vibration_X.gif")

直線移動時、線分長1を保つと考えると周期が半分(X1=1→0→1,X2=0→-1→0,往復距離2)となります。すなわち三角不等式(Triangle inequality)でいう|x+y|=|x|+|y|(三角形の高さ0)の状態です。
【初心者向け】「三角不等式」の体感方法？

Simple_Vibration_X<-function(Radian){
c0<-seq(0,pi*2,length=61)
cx<-cos(c0)
cy<-sin(c0)
plot(cx,cy,type="l",xlim=c(-1,1),asp=1,ylim=c(-1,1),main="Simple Vibration X",xlab="x=1→0→-1→0→1",ylab="y=0", col=rgb(0,1,0))
abline(h=0,col=rgb(0,0,0))
abline(v=0,col=rgb(0,0,0))
# x位置を書き添える 。
text(0,0,"0",col=rgb(0,0,1))
text(Radian,0,"x1",col=rgb(0,0,1))
text(-(1-Radian),0,"x2",col=rgb(1,0,0))
segments(0,0,Radian,0,col=rgb(0,0,1))
segments(0,0,-(1-Radian),0,col=rgb(1,0,0))
# 凡例を書き添える 。
legend("topright", legend=c("Circle(Radius=1,Augment=θ)","x1","x2"), lty =c(1,1,1),col=c(rgb(0,1,0),rgb(0,0,1),rgb(1,0,0)))
}

#アニメーション
library("animation")
c0<-seq(0,1,length=21)
Time_Code<-c(rev(c0[2:21]),c0)
saveGIF({
for (i in Time_Code){
　Simple_Vibration_X(i)
}
}, interval = 0.1, movie.name = "Simple_Vibration_X1X2.gif")

この移動をY軸に振って周回させると周期が戻り(距離4)、以下の動きが観測されるのです。

Square_XY<-function(Radius){

c0<-seq(-1,1,length=31)
cx<-c(rev(c0),c0[2:31])
c1<-seq(0,1,length=16)
cy<-c(c1,rev(c1[1:15]),-c1[2:16],-rev(c1[1:15]))
complex(real=cx*Radius,imaginary=cy*Radius)
}

Simple_Vibration_XY<-function(Radian){
c0<-seq(0,pi*2,length=61)
cx<-cos(c0)
cy<-sin(c0)
cmpx<-Re(Square_XY(1))
cmpy<-Im(Square_XY(1))
plot(cx,cy,type="l",xlim=c(-1,1),asp=1,ylim=c(-1,1),main="Simple Vibration X+Y=1",xlab="x=1→0→-1→0→1",ylab="y=0→1→0→-1→0", col=rgb(0,1,0))
par(new=T)
plot(cx*sqrt(2)/2,cy*sqrt(2)/2,type="l",xlim=c(-1,1),asp=1,ylim=c(-1,1),main="",xlab="",ylab="",col=c(200,200,200))
par(new=T)
plot(cx*2/sqrt(2),cy*2/sqrt(2),type="l",xlim=c(-1,1),asp=1,ylim=c(-1,1),main="",xlab="",ylab="",col=c(200,200,200))
par(new=T)
plot(cx/2,cy/2,type="l",xlim=c(-1,1),asp=1,ylim=c(-1,1),main="",xlab="",ylab="", col=c(200,200,200))
par(new=T)
plot(cmpx,cmpy,type="l",xlim=c(-1,1),asp=1,ylim=c(-1,1),main="",xlab="",ylab="", col=rgb(1,0,1))
par(new=T)
plot(cmpx*sqrt(2)/2,cmpy*sqrt(2)/2,type="l",xlim=c(-1,1),asp=1,ylim=c(-1,1),main="",xlab="",ylab="",col=c(200,200,200))
par(new=T)
plot(cmpx*2/sqrt(2),cmpy*2/sqrt(2),type="l",xlim=c(-1,1),asp=1,ylim=c(-1,1),main="",xlab="",ylab="",col=c(200,200,200))
par(new=T)
plot(cmpx/2,cmpy/2,type="l",xlim=c(-1,1),asp=1,ylim=c(-1,1),main="",xlab="",ylab="", col=rgb(1,0,1))
abline(h=0,col=rgb(0,0,0))
abline(v=0,col=rgb(0,0,0))
# x位置を書き添える 。
text(0,0,"0",col=rgb(0,0,1))
text(Re(Radian),0,"X",col=rgb(0,0,1))
text(0,Im(Radian),"Y",col=rgb(0,0,1))
text(Re(Radian),Im(Radian),"M",col=rgb(1,0,0))
text(Re(Radian)/2,Im(Radian)/2,"m",col=rgb(1,0,0))
segments(Re(Radian),0,0,Im(Radian),col=rgb(0,0,1))
segments(0,0,Re(Radian),Im(Radian),col=rgb(1,0,0))
# 凡例を書き添える 。
legend("bottomleft", legend=c("Circle(Radius=1,Augment=θ)","x=y=0","x+y=1","M={x,y},m={x/2,y/2}"), lty =c(1,1,1,1),col=c(rgb(0,1,0),rgb(0,0,0),rgb(0,0,1),rgb(1,0,0)))
}

#アニメーション
library("animation")
Time_Code<-Time_Code<-Square_XY(1)
saveGIF({
for (i in Time_Code[1:60]){
　Simple_Vibration_XY(i)
}
}, interval = 0.1, movie.name = "Simple_Vibration_XY.gif")

①背景にここで展開するアニメーションと密接な関係がある「立方体の外接円と内接円の同心円的連鎖(半径の増減0.5)」を目安として追加。
【オイラーの多面体定理と正多面体】内接円/球面の半径と外接円/球面の半径の狭間

• 単位円（Unit circle）上に同心円を描く任意の正方形内で正方形を回すと、その辺長の比はsqrt(2):sqrt(2)と1:2の間を反復し続けるが、この比が多層化された内接円と外接円の半径の推移比とぴったり重なる。
  【初心者向け】ピタゴラスの定理あるいは三平方の定理からの出発
  

	Target_size	Target_names	Target_values
1	2^-1	2^-1(2^-0.5r)	0.5
2	2^-1	2^-1d=2^-1*4	1
3	2^-1	2^-1a1=2^0a0	sqrt(2)=1.414214
4	2^-1	2^-1a1(2^-0.5a0)*4	4sqrt(2)=5.656854
5	2^-0.5	2^-0.5(2^0r)	sqrt(2)/2=0.7071068
6	2^-0.5	2^-0.5d=2^-0.5*4	sqrt(2)=1.414214
7	2^-0.5	2^-0.5a1=2^0a0	1
8	2^-0.5	2^-1a1(2^0.5a0)*4	4
9	2^0	2^0(2^-0.5R,2^0.5r)	1
10	2^0	2^0d=2^0*4	2
11	2^0	2^0a1=2^0.5a0	sqrt(8)=2sqrt(2)=2.828427
12	2^0	2^0a1(2^0.5a0)*4	sqrt(32)=4sqrt(2)=5.656854
13	2^0.5	2^0.5(2^-0R,2^1r)	sqrt(2)=1.414214
14	2^0.5	2^0.5d=2^0.5*4	2sqrt(2)=2.828427
15	2^0.5	2^0.5a1=2^1a0	4
16	2^0.5	2^0.5a1(2^0a0)*4	8
17	2^1	2^1(2^1-0.5R,2^0.5r)	2

②xとyを結ぶ線分長は1とsqrt(2)の間を往復(上掲の外接立方体と内接立方体の挙動に合致)。一方座標{x,y}と座標{x/2,y/2}は正方形を描く。

• x+y=1(θ=0→π/2)(x=1→0,y=0→1)
• x+y=1(θ=π/2→π)(x=0→-1,y=1→0)
• x+y=1(θ=π→3π/2)(x=-1→0,y=0→-1)
• x+y=1(θ=3π/2→2π)(x=0→1,y=-1→0)

ちなみにまだ二辺形(Bilateral)状態と見て関数y=±1-abs(x)によって共役処理(Conjugated Operation)する方法もありますが、結果はもちろん同じとなります(素数2^n族に共通する特徴?)。
【初心者向け】方形描画関数①三角関数との関係。

#X+Y=1が描くのはアステロイド図形そのものではない？
X+Y=1の軌跡がアステロイド図形(Astroid)を描いている様に見えたので(トーラス内を転がる)周回円を重ねてみました。おやおや?
アステロイド (曲線)-Wikipedia

【トーラス構造と古典数学】「単位円筒」から「トーラス構造」へ
【無限遠点を巡る数理】「半径だけの世界」から「直径もある世界」へ

大半径(Major Radius)=2/sqrt(2),小半径(Minor Radius)=1の場合

Square_XY<-function(Radius){
c0<-seq(-1,1,length=31)
cx<-c(rev(c0),c0[2:31])
c1<-seq(0,1,length=16)
cy<-c(c1,rev(c1[1:15]),-c1[2:16],-rev(c1[1:15]))
rev_crcl<-complex(real=cx*Radius,imaginary=cy*Radius)
for (i in rev_crcl[1:60]){
　segments(Re(i),0,0,Im(i),col=c(200,200,200))
}
}

Simple_Vibration_XY<-function(Radian){
c0<-seq(0,pi*2,length=61)

#同心円
cx<-cos(c0)
cy<-sin(c0)
plot(cx,cy,type="l",xlim=c(-1,1),asp=1,ylim=c(-1,1),main="Simple Vibration X+Y=1",xlab="x=1→0→-1→0→1",ylab="y=0→1→0→-1→0", col=rgb(0,1,0))

#逆同心円
Square_XY(1)

#回転円
s1cx<-cos(c0)+cx[Radian]/sqrt(2)*2
s1cy<-sin(c0)+cy[Radian]/sqrt(2)*2
par(new=T)
plot(s1cx,s1cy,type="l",xlim=c(-1,1),asp=1,ylim=c(-1,1),main="",xlab="",ylab="", col=rgb(1,0,0))

polygon(s1cx, #x
s1cy, #y
density=c(30), #塗りつぶす濃度
angle=c(45),　 　　　#塗りつぶす斜線の角度
col=rgb(1,0,0)) 　#塗りつぶす色
abline(h=0,col=rgb(0,0,0))
abline(v=0,col=rgb(0,0,0))
# x位置を書き添える 。
text(0,0,"0",col=rgb(0,0,1))
text(cx[Radian]/sqrt(2)*2,cy[Radian]/sqrt(2)*2,"R",col=rgb(0,0,1))
segments(0,0,cx[Radian]/sqrt(2)*2,cy[Radian]/sqrt(2)*2,col=rgb(1,0,0))
lines(c(1,0,-1,0,1),c(0,1,0,-1,0),col=rgb(0,1,0))
# 凡例を書き添える 。
legend("bottomleft", legend=c("Circle(Radius=1,Augment=θ)","Major Radius=2/sqrt(2),Minor Radius=1"), lty =c(1,1),col=c(rgb(0,1,0),rgb(1,0,0)))
}

#アニメーション
library("animation")
Time_Code=seq(1,59, length=60)
saveGIF({
for (i in Time_Code){
　Simple_Vibration_XY(i)
}
}, interval = 0.1, movie.name = "Simple_Vibration_XYA.gif")

大半径(Major Radius)=1/sqrt(2),小半径(Minor Radius)=1/2の場合

Square_XY<-function(Radius){

c0<-seq(-1,1,length=31)
cx<-c(rev(c0),c0[2:31])
c1<-seq(0,1,length=16)
cy<-c(c1,rev(c1[1:15]),-c1[2:16],-rev(c1[1:15]))
rev_crcl<-complex(real=cx*Radius,imaginary=cy*Radius)

for (i in rev_crcl[1:60]){
　segments(Re(i),0,0,Im(i),col=c(200,200,200))
}

}
Simple_Vibration_XY<-function(Radian){
c0<-seq(0,pi*2,length=61)

#同心円
cx<-cos(c0)
cy<-sin(c0)

plot(cx,cy,type="l",xlim=c(-1,1),asp=1,ylim=c(-1,1),main="Simple Vibration X+Y=1",xlab="x=1→0→-1→0→1",ylab="y=0→1→0→-1→0", col=rgb(0,1,0))

#逆同心円
Square_XY(1/2)

#回転円
s1cx<-cos(c0)/2+cx[Radian]/sqrt(2)
s1cy<-sin(c0)/2+cy[Radian]/sqrt(2)
par(new=T)
plot(s1cx,s1cy,type="l",xlim=c(-1,1),asp=1,ylim=c(-1,1),main="",xlab="",ylab="", col=rgb(1,0,0))

polygon(s1cx, #x
s1cy, #y
density=c(30), #塗りつぶす濃度
angle=c(45),　 　　　#塗りつぶす斜線の角度
col=rgb(1,0,0)) 　#塗りつぶす色

abline(h=0,col=rgb(0,0,0))
abline(v=0,col=rgb(0,0,0))
# x位置を書き添える 。
text(0,0,"0",col=rgb(0,0,1))
text(cx[Radian]/sqrt(2),cy[Radian]/sqrt(2),"R",col=rgb(0,0,1))
segments(0,0,cx[Radian]/sqrt(2),cy[Radian]/sqrt(2),col=rgb(1,0,0))
lines(c(1,0,-1,0,1),c(0,1,0,-1,0),col=rgb(0,1,0))
# 凡例を書き添える 。
legend("bottomleft", legend=c("Circle(Radius=1,Augment=θ)","Major Radius=1/sqrt(2),Minor Radius=1/2"), lty =c(1,1),col=c(rgb(0,1,0),rgb(1,0,0)))}

#アニメーション
library("animation")
Time_Code=seq(1,59, length=60)
saveGIF({
for (i in Time_Code){
　Simple_Vibration_XY(i)
}
}, interval = 0.1, movie.name = "Simple_Vibration_XYB.gif")

X+Y=1の分割をさらに細かくしてみましたが、状況は何も変わりません。
大半径(Major Radius)=2/sqrt(2),小半径(Minor Radius)=1の場合

Square_XY<-function(Radius){
c0<-seq(-1,1,length=101)
cx<-c(rev(c0),c0[2:101])
c1<-seq(0,1,length=51)
cy<-c(c1,rev(c1[1:50]),-c1[2:51],-rev(c1[1:50]))
rev_crcl<-complex(real=cx*Radius,imaginary=cy*Radius)
for (i in rev_crcl[1:200]){
segments(Re(i),0,0,Im(i),col=c(200,200,200))
}
}

Simple_Vibration_XY<-function(Radian){
c0<-seq(0,pi*2,length=61)

#同心円
cx<-cos(c0)
cy<-sin(c0)
plot(cx,cy,type="l",xlim=c(-1,1),asp=1,ylim=c(-1,1),main="Simple Vibration X+Y=1",xlab="x=1→0→-1→0→1",ylab="y=0→1→0→-1→0", col=rgb(0,1,0))

#逆同心円
Square_XY(1)

#回転円
s1cx<-cos(c0)+cx[Radian]/sqrt(2)*2
s1cy<-sin(c0)+cy[Radian]/sqrt(2)*2

par(new=T)
plot(s1cx,s1cy,type="l",xlim=c(-1,1),asp=1,ylim=c(-1,1),main="",xlab="",ylab="", col=rgb(1,0,0))

polygon(s1cx, #x
s1cy, #y
density=c(30), #塗りつぶす濃度
angle=c(45),　 　　　#塗りつぶす斜線の角度
col=rgb(1,0,0)) 　#塗りつぶす色

abline(h=0,col=rgb(0,0,0))
abline(v=0,col=rgb(0,0,0))
# x位置を書き添える 。
text(0,0,"0",col=rgb(0,0,1))
text(cx[Radian]/sqrt(2)*2,cy[Radian]/sqrt(2)*2,"R",col=rgb(0,0,1))
segments(0,0,cx[Radian]/sqrt(2)*2,cy[Radian]/sqrt(2)*2,col=rgb(1,0,0))
lines(c(1,0,-1,0,1),c(0,1,0,-1,0),col=rgb(0,1,0))
# 凡例を書き添える 。
legend("bottomleft", legend=c("Circle(Radius=1,Augment=θ)","Major Radius=2/sqrt(2),Minor Radius=1"), lty =c(1,1),col=c(rgb(0,1,0),rgb(1,0,0)))
}

#アニメーション
library("animation")
Time_Code=seq(1,59, length=60)
saveGIF({
for (i in Time_Code){
　Simple_Vibration_XY(i)
}
}, interval = 0.1, movie.name = "Simple_Vibration_XYC.gif")

大半径(Major Radius)=1/sqrt(2),小半径(Minor Radius)=1/2の場合

Square_XY<-function(Radius){
c0<-seq(-1,1,length=101)
cx<-c(rev(c0),c0[2:101])
c1<-seq(0,1,length=51)
cy<-c(c1,rev(c1[1:50]),-c1[2:51],-rev(c1[1:50]))
rev_crcl<-complex(real=cx*Radius,imaginary=cy*Radius)
for (i in rev_crcl[1:200]){
segments(Re(i),0,0,Im(i),col=c(200,200,200))
}
}

Simple_Vibration_XY<-function(Radian){
c0<-seq(0,pi*2,length=61)

#同心円
cx<-cos(c0)
cy<-sin(c0)
plot(cx,cy,type="l",xlim=c(-1,1),asp=1,ylim=c(-1,1),main="Simple Vibration X+Y=1",xlab="x=1→0→-1→0→1",ylab="y=0→1→0→-1→0", col=rgb(0,1,0))

#逆同心円
Square_XY(1/2)

#回転円
s1cx<-cos(c0)/2+cx[Radian]/sqrt(2)
s1cy<-sin(c0)/2+cy[Radian]/sqrt(2)
par(new=T)
plot(s1cx,s1cy,type="l",xlim=c(-1,1),asp=1,ylim=c(-1,1),main="",xlab="",ylab="", col=rgb(1,0,0))

polygon(s1cx, #x
s1cy, #y
density=c(30), #塗りつぶす濃度
angle=c(45),　 　　　#塗りつぶす斜線の角度
col=rgb(1,0,0)) 　#塗りつぶす色

abline(h=0,col=rgb(0,0,0))
abline(v=0,col=rgb(0,0,0))
# x位置を書き添える 。
text(0,0,"0",col=rgb(0,0,1))
text(cx[Radian]/sqrt(2),cy[Radian]/sqrt(2),"R",col=rgb(0,0,1))
segments(0,0,cx[Radian]/sqrt(2),cy[Radian]/sqrt(2),col=rgb(1,0,0))
lines(c(1,0,-1,0,1),c(0,1,0,-1,0),col=rgb(0,1,0))
# 凡例を書き添える 。

legend("bottomleft", legend=c("Circle(Radius=1,Augment=θ)","Major Radius=1/sqrt(2),Minor Radius=1/2"), lty =c(1,1),col=c(rgb(0,1,0),rgb(1,0,0)))
}

#アニメーション
library("animation")
Time_Code=seq(1,59, length=60)
saveGIF({
for (i in Time_Code){
　Simple_Vibration_XY(i)
}
}, interval = 0.1, movie.name = "Simple_Vibration_XYD.gif")

周囲にも「アステロイドもどき」を貼るうちに明瞭になった事実。「やはり描かれているのは円とは程遠い何か」でした。まるで量産品の冷凍ハンバーグみたいな形…
大半径(Major Radius)=2/sqrt(2),小半径(Minor Radius)=1の場合

Square_XY<-function(Radius,x,y){
c0<-seq(-1,1,length=101)
cx<-c(rev(c0),c0[2:101])
c1<-seq(0,1,length=51)
cy<-c(c1,rev(c1[1:50]),-c1[2:51],-rev(c1[1:50]))
rev_crcl<-complex(real=cx*Radius,imaginary=cy*Radius)
for (i in rev_crcl[1:200]){
segments(Re(i)+x,0+y,0+x,Im(i)+y,col=c(200,200,200))
}
}

Simple_Vibration_XY<-function(Radian){
c0<-seq(0,pi*2,length=61) 

#同心円
cx<-cos(c0)
cy<-sin(c0)
plot(cx,cy,type="l",xlim=c(-1,1),asp=1,ylim=c(-1,1),main="Simple Vibration X+Y=1",xlab="x=1→0→-1→0→1",ylab="y=0→1→0→-1→0", col=rgb(0,1,0))

#逆同心円
Square_XY(1,0,0)
Square_XY(1,1,0)
Square_XY(1,-1,0)
Square_XY(1,0,1)
Square_XY(1,0,-1)
Square_XY(1,1,1)
Square_XY(1,1,-1)
Square_XY(1,-1,1)
Square_XY(1,-1,-1)

#回転円
s1cx<-cos(c0)+cx[Radian]/sqrt(2)*2
s1cy<-sin(c0)+cy[Radian]/sqrt(2)*2
par(new=T)
plot(s1cx,s1cy,type="l",xlim=c(-1,1),asp=1,ylim=c(-1,1),main="",xlab="",ylab="", col=rgb(1,0,0))

polygon(s1cx, #x
s1cy, #y
density=c(30), #塗りつぶす濃度
angle=c(45),　 　　　#塗りつぶす斜線の角度
col=rgb(1,0,0)) 　#塗りつぶす色

abline(h=0,col=rgb(0,0,0))
abline(v=0,col=rgb(0,0,0))
# x位置を書き添える 。
text(0,0,"0",col=rgb(0,0,1))
text(cx[Radian]/sqrt(2)*2,cy[Radian]/sqrt(2)*2,"R",col=rgb(0,0,1))
segments(0,0,cx[Radian]/sqrt(2)*2,cy[Radian]/sqrt(2)*2,col=rgb(1,0,0))
lines(c(1,0,-1,0,1),c(0,1,0,-1,0),col=rgb(0,1,0))
# 凡例を書き添える 。

legend("bottomleft", legend=c("Circle(Radius=1,Augment=θ)","Major Radius=2/sqrt(2),Minor Radius=1"), lty =c(1,1),col=c(rgb(0,1,0),rgb(1,0,0)))
}

#アニメーション
library("animation")
Time_Code=seq(1,59, length=60)
saveGIF({
for (i in Time_Code){
　Simple_Vibration_XY(i)
}
}, interval = 0.1, movie.name = "Simple_Vibration_XYE.gif")

大半径(Major Radius)=1/sqrt(2),小半径(Minor Radius)=1/2の場合

Square_XY<-function(Radius,x,y){
c0<-seq(-1,1,length=101)
cx<-c(rev(c0),c0[2:101])
c1<-seq(0,1,length=51)
cy<-c(c1,rev(c1[1:50]),-c1[2:51],-rev(c1[1:50]))
rev_crcl<-complex(real=cx*Radius,imaginary=cy*Radius)
for (i in rev_crcl[1:200]){
segments(Re(i)+x,0+y,0+x,Im(i)+y,col=c(200,200,200))
}
}

Simple_Vibration_XY<-function(Radian){
c0<-seq(0,pi*2,length=61) 

#同心円
cx<-cos(c0)
cy<-sin(c0)
plot(cx,cy,type="l",xlim=c(-1,1),asp=1,ylim=c(-1,1),main="Simple Vibration X+Y=1",xlab="x=1→0→-1→0→1",ylab="y=0→1→0→-1→0", col=rgb(0,1,0))

#逆同心円
Square_XY(1/2,0,0)
Square_XY(1/2,1/2,0)
Square_XY(1/2,-1/2,0)
Square_XY(1/2,0,1/2)
Square_XY(1/2,0,-1/2)
Square_XY(1/2,1/2,1/2)
Square_XY(1/2,1/2,-1/2)
Square_XY(1/2,-1/2,1/2)
Square_XY(1/2,-1/2,-1/2)
#さらなる外周
Square_XY(1/2,1,0)
Square_XY(1/2,1,1/2)
Square_XY(1/2,1,-1/2)
Square_XY(1/2,-1,0)
Square_XY(1/2,-1,1/2)
Square_XY(1/2,-1,-1/2)
Square_XY(1/2,0,1)
Square_XY(1/2,1/2,1)
Square_XY(1/2,-1/2,1)
Square_XY(1/2,0,-1)
Square_XY(1/2,1/2,-1)
Square_XY(1/2,-1/2,-1)
Square_XY(1/2,1,1)
Square_XY(1/2,1,-1)
Square_XY(1/2,-1,1)
Square_XY(1/2,-1,-1)

#回転円
s1cx<-cos(c0)/2+cx[Radian]/sqrt(2)
s1cy<-sin(c0)/2+cy[Radian]/sqrt(2)
par(new=T)
plot(s1cx,s1cy,type="l",xlim=c(-1,1),asp=1,ylim=c(-1,1),main="",xlab="",ylab="", col=rgb(1,0,0))

polygon(s1cx, #x
s1cy, #y
density=c(30), #塗りつぶす濃度
angle=c(45),　 　　　#塗りつぶす斜線の角度
col=rgb(1,0,0)) 　#塗りつぶす色

abline(h=0,col=rgb(0,0,0))
abline(v=0,col=rgb(0,0,0))
# x位置を書き添える 。
text(0,0,"0",col=rgb(0,0,1))
text(cx[Radian]/sqrt(2),cy[Radian]/sqrt(2),"R",col=rgb(0,0,1))
segments(0,0,cx[Radian]/sqrt(2),cy[Radian]/sqrt(2),col=rgb(1,0,0))
lines(c(1,0,-1,0,1),c(0,1,0,-1,0),col=rgb(0,1,0))
# 凡例を書き添える 。
legend("bottomleft", legend=c("Circle(Radius=1,Augment=θ)","Major Radius=1/sqrt(2),Minor Radius=1/2"), lty =c(1,1),col=c(rgb(0,1,0),rgb(1,0,0)))
}

#アニメーション
library("animation")
Time_Code=seq(1,59, length=60)
saveGIF({
for (i in Time_Code){
　Simple_Vibration_XY(i)
}
}, interval = 0.1, movie.name = "Simple_Vibration_XYF.gif")

以下の状況を「(プログラミングを通じて)可視化したい」なる当初の目的そのものはとりあえず一応は達成された訳ですが…

①トーラス表現(Torus Expression)を用いると、最初の奇数層(Odd Layer)は大半径(Major Radius)が対角線(Diagonal)の半分の位置に現れる。
2次元空間上

• 小半径(Minor Radius)=1の時、大半径2/sqrt(2)(1.414214)。
• 小半径(Minor Radius)=1/2の時、大半径1/sqrt(2)(0.7071068)。

3次元空間上

• 小半径(Minor Radius)=1の時、大半径2/sqrt(3)(1.154701)。
• 小半径(Minor Radius)=1/2の時、大半径1/sqrt(3)(0.5773503)。

②関数x+y=1の軌跡を敷き詰めると、4個(2×2)単位で中央に「そこに収まる円に対応する図形」が現れる。

…実はこの投稿をするまで中央に現れる「そこに収まる円に対応する図形」はもっと円に近く(数値積分の様に)分割数引き上げによってさらなる近似制度が見込める、そんな存在と勝手にイメージしてたんです。どうやら知識のアップデートが必要な様ですね。

#距離空間(Metric Space)概念の登場。

とりあえずこの辺りの説明が該当しそうですが、現段階では説明を読んでも何が何だかさっぱり分かりません。
Lp空間 - Wikipedia

数学の分野におけるLp空間(Lp Space)とは、有限次元ベクトル空間に対するp-ノルムの自然な一般化を用いることで定義される関数空間である。アンリ・ルベーグの名にちなんでルベーグ空間としばしば呼ばれるが、Bourbaki (1987) によると初めて導入されたのは Riesz (1910) とされている。Lp空間は関数解析学におけるバナッハ空間や、線型位相空間の重要なクラスを形成する。物理学や統計学、金融、工学など様々な分野で応用されている。

• ユークリッド距離sqrt(x^2+y^2+z^2…)が出発点で、辺長1の平方対角線(Square Diagonal)がsqrt(2),立方対角線(Cubic Diagonal)がsqrt(3)となるのをL2空間とし、これを一般化してp-ノルム(x^p+y^p+z^p…)^(1/p)と置いた。
  ノルムの意味とL1，L2，L∞ノルム
• L1空間のマンハッタン距離|x|+|y|+|z|はどうやら今回投稿で扱った絶対値関数と関係が深いらしい。並行/垂直移動しか許されず上掲の場合の距離がそれぞれ「2」「3」となる？
  L1距離（マンハッタン距離）の意味と性質
• L∞空間は定義がマンハッタン距離に似ているが行列式だと行と列の役割が入れ替わるらしい(棒読み)。半径rの円が一辺2rで軸に平行な正方形になるという。
  Lpノルムの極限がL∞ノルムであることを証明する

何せ今回の投稿で興味を引かれたのが以下だから難航は必死？

• スーパー楕円(p=3/2)…今回発見された「量産型冷凍ハンバーグ」との距離の近さを感じずにはいられない。
  
• アステロイド(p=2/3)…今回期待してた図形に近い。トーラス表現で大半径3/4,小半径1/4の小円が転がった軌跡らしい。
  アステロイド (曲線)
  

むしろプログラミングの世界に持ち込めそうな以下の記事が一番有望に思えました。
【機械学習】LPノルムってなんだっけ？
線形回帰におけるLpノルム最適化をpythonの凸最適化ツールcvxpyで比較してみる
というより数式が手に入った以上、とりあえず動かせる訳でして…

テスト1(p=1/2,1,2,88)

cx<-seq(0,1,length=61)
f0<-function(x,p){(1-(x^p))^(1/p)}
cy1<-f0(cx,1/2)
cy2<-f0(cx,1)
cy3<-f0(cx,2)
cy4<-f0(cx,88)
plot(cx,cy1,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,cy2,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,cy3,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,cy4,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.5","p=1","p=2","p=88"), lty =c(1,1,1,1),col=c(rgb(1,0,1),rgb(0,1,0),rgb(1,0,0),rgb(0,0,1))) 

テスト2(p=2/3,1,3/2,2)

cx<-seq(0,1,length=61)
f0<-function(x,p){(1-(x^p))^(1/p)}
cy1<-f0(cx,2/3)
cy2<-f0(cx,1)
cy3<-f0(cx,2)
cy4<-f0(cx,3/2)
plot(cx,cy1,type="l",xlim=c(0,1),ylim=c(0,1),main="p-Norm",xlab="",ylab="",col=rgb(1,0,1))
par(new=T)
plot(cx,cy2,type="l",xlim=c(0,1),ylim=c(0,1),main="",xlab="",ylab="",col=rgb(0,1,0))
par(new=T)
plot(cx,cy3,type="l",xlim=c(0,1),ylim=c(0,1),main="",xlab="",ylab="",col=rgb(1,0,0))
par(new=T)
plot(cx,cy4,type="l",xlim=c(0,1),ylim=c(0,1),main="",xlab="",ylab="",col=rgb(0,0,1))
# 凡例を書き添える 。
legend("bottomleft", legend=c("p=2/3","p=1","p=3/2","p=2"), lty =c(1,1,1,1),col=c(rgb(1,0,1),rgb(0,1,0),rgb(0,0,1),rgb(1,0,0))) 

テスト3(p=1/10,1,2,99)

cx<-seq(0,1,length=61)
f0<-function(x,p){(1-(x^p))^(1/p)}
cy1<-f0(cx,1/10)
cy2<-f0(cx,1)
cy3<-f0(cx,2)
cy4<-f0(cx,99)
plot(cx,cy1,type="l",xlim=c(0,1),ylim=c(0,1),main="p-Norm",xlab="",ylab="",col=rgb(1,0,1))
par(new=T)
plot(cx,cy2,type="l",xlim=c(0,1),ylim=c(0,1),main="",xlab="",ylab="",col=rgb(0,1,0))
par(new=T)
plot(cx,cy3,type="l",xlim=c(0,1),ylim=c(0,1),main="",xlab="",ylab="",col=rgb(1,0,0))
par(new=T)
plot(cx,cy4,type="l",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","p=2","p=99"), lty =c(1,1,1,1),col=c(rgb(1,0,1),rgb(0,1,0),rgb(1,0,0),rgb(0,0,1))) 

テスト4(p=1/10,1/2,1,2,99)

cx<-seq(0,1,length=61)
f0<-function(x,p){(1-(x^p))^(1/p)}
cy10<-f0(cx,1/10)
cy15<-f0(cx,1/2)
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=0.5","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))) 

テスト5(p=1/10,1/1.782273,1,2,99)

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) 

ここに突如登場する数1/1.782273(=0.561081276)は何かというとpノウムで「L2空間の真逆の円弧が軌跡として現れるp値」の近似値です。力任せで発見した後で数値検索をかけたら、Python製凸最適化モデリングツールCVXPYなどが採用している模様…
CVXPY matrix style modeling limits
Python による数理最適化モデリングツール CVXPY の初歩

まぁ別にこれで理解が深まる訳でもないのですが、プログラムで動かせると「途中で投げ出す」確率が格段に下がるんです。そんな感じで以下続報…