|
|
!Ｎ角形の Simson Line（シムソン線） Ver7.5.4 以降で動きます。
!定理（シムソン）円に内接する三角形 ABC 、同円周上に点Ｐ。
! ＿BC ＿CA ＿AB 各辺の線（３本）へ
!点Ｐから引いた垂線の交点（３個）は、同一直線上にある。
!この直線を、点Ｐの三角形 ABC に対するシムソン線。
!定理（四角形） 円に内接する四角形 ABCD 、同円周上に点Ｐ。
!点Ｐの △BCD △ACD △ABD △ABC に対するシムソン線（４本）へ
!点Ｐから引いた垂線の交点（４個）は、同一直線上にある。
!この直線を、点Ｐの四角形 ABCD に対するシムソン線。
!定理（五角形） 円に内接する五角形 ABCDE 、同円周上に点Ｐ。
!点Ｐの □BCDE □ACDE □ABDE □ABCE □ABCD に対するシムソン線（５本）へ
!点Ｐから引いた垂線の交点（５個）は、同一直線上にある。
!この直線を、点Ｐの五角形 ABCDE に対するシムソン線。
!----------------------------------------------------------
! （Ｎ角形） 円に内接するＮ角形 、同円周上に点Ｐ。
!点Ｐの (Ｎ-1)角形 *Ｎ個 に対するシムソン線（Ｎ本）へ
!点Ｐから引いた垂線の交点（Ｎ個）は、同一直線上にある？？
!この直線を、点ＰのＮ角形 に対するシムソン線 ？？
!----------------------------------------------------------
! k 角形での Simson Line の本数Ｓk
! k=3 k=4 k=5 k=6 k=7 ... k=n
! Ｓ3=1 Ｓ4=4*Ｓ3+1=5 Ｓ5=5*Ｓ4+1=26 Ｓ6=6*Ｓ5+1=157 Ｓ7=7*Ｓ6+1=1100 ... Ｓn= n*Ｓn-1 +1
!Ｎ角について、実際のグラフを描く。が、８角形位から、画面がパンクぎみで、
!N=11 で止めてある。（必要なら、注釈マーク ※N ※N-1 の個所で変える）
!------------------------
OPTION ARITHMETIC COMPLEX
SET BEAM MODE "IMMORTAL"
LET N=11 !※N
DIM p(N), px(N)
!
PRINT "シムソン線の直線性検査"
PRINT "線上の交点(1,2,3,4,…)間ベクトルの、"
PRINT "絶対値積／内積。"
PRINT "|3-2||2-1|/(3-2・2-1) |4-3||3-2|/(4-3・3-2) …"
SET TEXT COLOR "red"
RANDOMIZE
FOR K0=3 TO N
! ---make sample
LET P0=EXP(COMPLEX(0, RND*2*PI) ) !Ｐ点 サンプル作成 P0
FOR i=1 TO K0 !K0角形サンプル作成 p()
IF i=1 THEN
LET b0=.3/K0
LET b=0
ELSE
LET w=(1-b)/(K0-i+2)
DO
LET a=RND
LOOP UNTIL .7*w< a AND a< 1.4*w
LET b=b+a
END IF
LET p(i)=EXP(COMPLEX(0, (b0+b)*2*PI+arg(P0)) )
NEXT i
!---start with whole view
CALL s_main(0, 1.5) !(画面中心, 半幅)
!---checking simson px() on the straight
PRINT K0;"角形: ";
FOR i=3 TO K0
PRINT ABS(px(i)-px(i-1))*ABS(px(i-1)-px(i-2))/DOTc( px(i)-px(i-1), px(i-1)-px(i-2) );
NEXT i
PRINT
!---repeat with zoom up
IF 4< K0 THEN
LET w$=CONFIRM$("次は､同"& STR$(K0)& "角形のズームアップ")
IF w$="NO" THEN STOP
CALL s_main((px(1)+px(K0))/2, ABS(px(K0)-px(1))) !(画面中心, 半幅)
END IF
!---how to start next K0+1?
IF K0< N THEN
LET w$=CONFIRM$("次は､"& STR$(K0+1)& "角形")
IF w$="NO" THEN STOP
END IF
NEXT K0
SUB s_main(c,hw)
SET WINDOW re(c)-hw, re(c)+hw ,im(c)-hw ,im(c)+hw !zooming
CLEAR
SET LINE COLOR "black"
DRAW circle !円周 、描画
CALL GRAPH_p(K0, p) !K0角形 、描画
CALL simson(K0, p,px) !シムソン線、描画
!---
SET POINT COLOR "red"
SET POINT STYLE 6
PLOT POINTS: P0 !P0点 、描画
PLOT label ,AT P0:"P"
END SUB
SUB simson(K, p(),px()) !( 角数 K, K角形 p(), →シムソン線 px() )
local i, s(10),sx(10) !※N-1 !s(K-1),sx(K-1)の使用量だが、副プログラムでの変数は×。手書き！
!---
FOR i=1 TO K !K角形 p()の下の、(K-1)角形 s()を、K通り作成
! ---
FOR j=1 TO i-1 !ｉ番目頂点の抜けた(K-1)角形 s()を、１個作成。
LET s(j)=p(j)
NEXT j
FOR j=i+1 TO K
LET s(j-1)=p(j)
NEXT j
!---
IF K=3 THEN !※K角形 p()が３角の時、i番目の２角形 s()の扱い。(形態は線分)
LET sx(1)=s(1) ! それに対する P0点からの垂線は２本とも s()自身に交わるため、
LET sx(2)=s(2) ! ２角形 s()に対するシムソン線 sx()は、自身 s()に重なるとする。
ELSE ! ２角形を考える事で、３角も、Ｎ角の連続として扱える。
CALL simson(K-1, s,sx) !i番目の(K-1)角形 s()に対するシムソン線 sx()を自己呼出しで採取。
CALL GRAPH_p(K-1, s) !i番目の(K-1)角形 s() の描画。
END IF
!--- !(K-1)角形 s()に対するシムソン線 sx()は、その下の、
! ! 角形 s()に対するシムソン線への(K-1)個の垂線交点の配列。
LET px(i)=pxab(P0, sx(1),sx(K-1)) !px(i)= P0点から sx(1)~sx(K-1)線 に引く１個の垂線交点。
PLOT LINES: P0;px(i) ! P0点から sx(1)~sx(K-1)線 に引く１個の垂線 の描画。
!---
IF 0< DOTc(px(i)-sx(1), px(i)-sx(K-1)) THEN !交点px(i)が sx(1)~sx(K-1)線の延長上なら破線 の描画。
SET LINE STYLE 3
IF ABS(px(i)-sx(1))< ABS(px(i)-sx(K-1)) THEN PLOT LINES:px(i);sx(1) ELSE PLOT LINES:px(i);sx(K-1)
SET LINE STYLE 1
END IF
NEXT i
CALL GRAPH_px(K, p,px) !K角形 p()についてのシムソン線 px()の描画
END SUB
SUB GRAPH_px(K, p(),px())
SET LINE COLOR K0-K+1
SET POINT COLOR K0-K+1
!---simson line
IF K=K0 THEN
SET LINE width 2
SET POINT STYLE 7
ELSE
SET LINE width 1
SET POINT STYLE 6
END IF
FOR i=1 TO K !シムソン線 px()の描画。
IF 1< i THEN PLOT LINES: px(i-1);px(i) !交点間、px(i-1)~px(i)線
PLOT POINTS: px(i) !px(i)交点
IF K=K0 THEN PLOT label,AT px(i):STR$(i) !交点番号
NEXT i
END SUB
SUB GRAPH_p(K, p())
SET LINE COLOR K0-K+2
IF K=K0 THEN SET LINE width 2
FOR i=1 TO K !K角形 p()の描画。
PLOT LINES: p(i);p(MOD(i,K)+1) !頂点間、p(i)~p(i+1)線
IF K=K0 THEN PLOT label,AT p(i):CHR$(64+i) !頂点名、A,B,,,
NEXT i
SET LINE width 1
END SUB
FUNCTION pxab(p, a, b)
LET h1=(b-a)/ABS(b-a) !h1= a~b 線 に平行な単位ベクトル (ａ→ｂ方向）
LET n1=COMPLEX(-im(h1),re(h1)) !n1= a~b 線 に垂直な単位ベクトル (ａ→ｂの左方向)
LET pxab= DOTc( a-p, n1 )*n1 +p !pxab= p 点 から a~b 線 に引く垂線の交点
END FUNCTION
DEF DOTc(a,b)=re(a)*re(b)+im(a)*im(b) !内積(a・b) …complex
END
|
|