|
|
> No.3383[元記事へ]
GAIさんへのお返事です。
>
> を読んでいたら
> 1989年、当時高校生であった高田英行君が発見した定理として命名された問題です「安藤清、佐藤敏明共著、「初等幾何学」新数学入門シリーズ４、一松 信編集、森北出版、1994.」。点が込み入っていますので、用器画的に正確な作図をするのは難しいところです。この場合にも、円に内接する任意の五点を、乱数を使って決めるプログラムで描かせました。
> ミケルの五点円と似たところがあります。データとして与える初期値の五点は、円上にあるとして作図をはじめます。任意の五点A,B,C,D,Eは、円の中心角を乱数比で分解して決めました。今度は、五本の対角線の交点F,G,H,I,Jを求めます。この点と対辺の二点とを通る五つの円を描き、その円の交点U,V,W,X,Yを求めます。この五点が一つの円上に載ると言うものです。
>
!これをG-BASIC という言語でプログラムされているのを、十進BASICへ移植して頂けませんか？
! !10 rem 高田の５点円
! !20 rem --- 円に内接する任意の五角形の生成から始める
OPTION ARITHMETIC COMPLEX
SET WINDOW -400,400,-400,400
RANDOMIZE
SET TEXT background "opaque"
! !30 CLG
! !40 DEF2PT P: DEF2CR C : DEF2ED E: DEF2LN L
DIM ANG(5), PR(5) !50 DIM ANG[5],PR[5]
LET ANG(1)=2*RND !60 ANG[1]=RND(0) ←2* の脱落
FOR i=2 TO 5 !70 FOR I=2 TO 5: ANG[I]=1+2*RND(0)+ANG[I-1] : NEXT
LET ANG(i)=1+2*RND+ANG(i-1)
NEXT i
LET ANG0=2*PI/(ANG(5)+1) !80 ANG0=360/(ANG[5]+1)
!
FOR i=1 TO 5 !90 FOR I=1 TO 5: ANG[I]=ANG0*ANG[I] : NEXT
LET ANG(i)=ANG0*ANG(i)
NEXT i
!
LET R=200 !100 R=200: C=R*C
DRAW circle WITH SCALE(R)
FOR i=1 TO 5 !110 FOR I=1 TO 5
LET PR(i)=R*EXP(COMPLEX(0,ANG(i))) !120 LET P=R*COS(ANG[I]), R*SIN(ANG[I]): PR[I]=P
NEXT i !130 NEXT
!
! !140 E12=PR[1]@PR[2] : E13=PR[1]@PR[3]
! !150 E14=PR[1]@PR[4] : E15=PR[1]@PR[5]
! !160 E23=PR[2]@PR[3] : E24=PR[2]@PR[4]
! !170 E25=PR[2]@PR[5] : E34=PR[3]@PR[4]
! !180 E35=PR[3]@PR[5] : E45=PR[4]@PR[5]
PLOT LINES: PR(1);PR(2);PR(3);PR(4);PR(5);
PLOT LINES: PR(1);PR(3);PR(5);PR(2);PR(4);PR(1)
!
! !190 P12=E13&E25 : P23=E24&E13 : P34=E35&E24
! !200 P45=E14&E35 : P51=E14&E25
LET P12=xpt2L( PR(1),PR(3), PR(2),PR(5))
LET P23=xpt2L( PR(2),PR(4), PR(1),PR(3))
LET P34=xpt2L( PR(3),PR(5), PR(2),PR(4))
LET P45=xpt2L( PR(1),PR(4), PR(3),PR(5))
LET P51=xpt2L( PR(1),PR(4), PR(2),PR(5))
! PLOT POINTS: P12; P23; P34; P45; P51
FUNCTION xpt2L(a,b, c,d) !直線a~b 直線c~d の交点
LET L1=b-a
LET a_=a/L1
LET c_=c/L1
LET d_=d/L1
LET x=(im(a_)-im(c_))*re(d_-c_)/im(d_-c_)+re(c_)
LET xpt2L=COMPLEX(x,im(a_))*L1
END FUNCTION
SUB LBSEC(a,b, c,d) !直線a~b に垂直で a~b の中点を通る直線 → c~d
LET c=(a+b)/2
LET d=(b-a)*COMPLEX(0,1)+c
END SUB
CALL LBSEC( PR(1),PR(2), a,b) !210 GROFF: L1=LBSEC(PR[1],PR[2])
CALL LBSEC( PR(1),P12, c,d) !211 L2=LBSEC(PR[1],P12)
LET P1=xpt2L(a,b, c,d) !220 P0=L1&L2: R0=DIS(P0,PR[1]) : LET C1=P0,R0
LET R1=ABS(PR(1)-P1)
DRAW circle WITH SCALE(R1)*SHIFT(P1) !221 GRON: C1=C1
CALL LBSEC( PR(2),PR(3), a,b) !230 GROFF: L1=LBSEC(PR[2],PR[3])
CALL LBSEC( PR(2),P23 , c,d) !231 L2=LBSEC(PR[2],P23)
LET P2=xpt2L(a,b, c,d) !240 P0=L1&L2: R0=DIS(P0,PR[2]) : LET C2=P0,R0
LET R2=ABS( PR(2)-P2)
DRAW circle WITH SCALE(R2)*SHIFT(P2) !241 GRON: C2=C2
!
! !250 GROFF: L1=LBSEC(PR[3],PR[4])
! !251 L2=LBSEC(PR[3],P34)
! !260 P0=L1&L2: R0=DIS(P0,PR[3]) : LET C3=P0,R0
! !261 GRON: C3=C3
CALL LBSEC( PR(3),PR(4), a,b)
CALL LBSEC( PR(3),P34 , c,d)
LET P3=xpt2L(a,b, c,d)
LET R3=ABS( PR(3)-P3)
DRAW circle WITH SCALE(R3)*SHIFT(P3)
! !270 GROFF: L1=LBSEC(PR[4],PR[5])
! !271 L2=LBSEC(PR[4],P45)
! !280 P0=L1&L2: R0=DIS(P0,PR[4]) : LET C4=P0,R0
! !281 GRON: C4=C4
CALL LBSEC( PR(4),PR(5), a,b)
CALL LBSEC( PR(4),P45 , c,d)
LET P4=xpt2L(a,b, c,d)
LET R4=ABS( PR(4)-P4)
DRAW circle WITH SCALE(R4)*SHIFT(P4)
! !290 GROFF: L1=LBSEC(PR[5],PR[1])
! !291 L2=LBSEC(PR[5],P51)
! !300 P0=L1&L2: R0=DIS(P0,PR[5]) : LET C5=P0,R0
! !301 GRON: C5=C5
CALL LBSEC( PR(5),PR(1), a,b)
CALL LBSEC( PR(5),P51 , c,d)
LET P5=xpt2L(a,b, c,d)
LET R5=ABS( PR(5)-P5)
DRAW circle WITH SCALE(R5)*SHIFT(P5)
!
! !310 PU=C1&C2 : PV=C2&C3 : PW=C3&C4 : PX=C4&C5
! !311 PY=C5&C1
LET PU=xpt2C(P1,R1, P2,R2)
LET PV=xpt2C(P2,R2, P3,R3)
LET PW=xpt2C(P3,R3, P4,R4)
LET PX=xpt2C(P4,R4, P5,R5)
LET PY=xpt2C(P5,R5, P1,R1)
PLOT POINTS: PU; PV; PW; PX; PY
FUNCTION xpt2C(p0,r0, p1,r1) !円(中心p0,半径r0) と 円(中心p1,半径r1) の
LET p01=p1-p0 !交点２個から、原点に近い方。
LET ux=(r0^2+ABS(p01)^2-r1^2)/(2*ABS(p01))
LET uy=SQR(r0^2-ux^2)
LET u=COMPLEX(ux,uy)
LET p=p0+u*p01/ABS(p01)
LET p_=p0+conj(u)*p01/ABS(p01)
LET xpt2C=p
IF ABS(p_)< ABS(p) THEN LET xpt2C=p_
END FUNCTION
! !320 GROFF: L1=LBSEC(PU,PV) : L2=LBSEC(PU,PX)
! !330 P0=L1&L2: R0=DIS(P0,PU) : LET CT=P0,R0
! !331 GRON: CT=CT
CALL LBSEC( PU,PV, a,b)
CALL LBSEC( PU,PX, c,d)
LET P0=xpt2L(a,b, c,d)
LET R0=ABS( PU-P0)
DRAW circle WITH SCALE(R0)*SHIFT(P0)
!
! !340 LET X,Y=PR[1]: DPTEXT X,Y,"A"
! !350 LET X,Y=PR[2]: DPTEXT X,Y,"B"
! !360 LET X,Y=PR[3]: DPTEXT X,Y,"C"
! !370 LET X,Y=PR[4]: DPTEXT X,Y,"D"
! !380 LET X,Y=PR[5]: DPTEXT X,Y,"E"
! !390 LET X,Y=P12: DPTEXT X,Y,"F"
! !400 LET X,Y=P23: DPTEXT X,Y,"G"
! !410 LET X,Y=P34: DPTEXT X,Y,"H"
! !420 LET X,Y=P45: DPTEXT X,Y,"I"
! !430 LET X,Y=P51: DPTEXT X,Y,"J"
! !440 LET X,Y=PU: DPTEXT X,Y,"U"
! !450 LET X,Y=PV: DPTEXT X,Y,"V"
! !460 LET X,Y=PW: DPTEXT X,Y,"W"
! !470 LET X,Y=PX: DPTEXT X,Y,"X"
! !480 LET X,Y=PY: DPTEXT X,Y,"Y"
! !490 DPTEXT -300, 200, "高田の五点円"
PLOT TEXT,AT PR(1):"A"
PLOT TEXT,AT PR(2):"B"
PLOT TEXT,AT PR(3):"C"
PLOT TEXT,AT PR(4):"D"
PLOT TEXT,AT PR(5):"E"
PLOT TEXT,AT P12:"F"
PLOT TEXT,AT P23:"G"
PLOT TEXT,AT P34:"H"
PLOT TEXT,AT P45:"I"
PLOT TEXT,AT P51:"J"
PLOT TEXT,AT PU:"U"
PLOT TEXT,AT PV:"V"
PLOT TEXT,AT PW:"W"
PLOT TEXT,AT PX:"X"
PLOT TEXT,AT PY:"Y"
PLOT TEXT,AT -300, 200: "高田の五点円"
END
|
|