|
投稿者：山中和義
投稿日：2011年10月12日(水)10時49分40秒
|
|
|
|
図形と方程式の問題をプログラミングで解法するための作図ツールです。
連立方程式や２次方程式を解くのが一般ですが、極力避けた別解をコード化しています。
!図形と方程式
SET WINDOW -8,8,-8,8 !表示領域を設定する ※
DRAW grid !XY座標
PUBLIC NUMERIC cEps !精度 ※調整が必要である
LET cEPS=1E-8
PUBLIC NUMERIC gcCOLOR,gcSTYLE,gcLINESTYLE !描画色、線種
LET gcCOLOR=1
LET gcLINESTYLE=1
!------------------------------ ここまでがサブルーチン
!●円(x+1)^2+y^2=5に、円周上の点(-3,-1)での接線の方程式を求めよ。
LET A=2 !円
LET B=0
LET C=-4
CALL gcDRAWCIRCLE(A,B,C,"",0) !円を描く
LET px=-3 !点(-3,-1)
LET py=-1
CALL gcDRAWPOINT(px,py,"") !点を描く
CALL gcTANGENTLINE1C(px,py,A,B,C, L,M,N)
CALL gcDRAWLINE(L,M,N,"",0) !接線を描く
END
!各処理の階層構造
!基本ルーチン
!点
! 作図 gcDRAWPOINT
! 中点 gcCENTER
! 内分・外分する点 gcDIVIDE
! 直線と直線 gcINTERSECTION
!直線
! 作図 gcDRAWLINE
! 2点を通る gcLINE
! 1点を通り、直線に平行 gcLINEP
! 1点を通り、直線に垂直 gcLINEX
! 直線を一定間隔だけ平行移動させる gcPARALLELLINE
! 2直線のなす角を二等分する線 gcA2LINE
! 円上の点における接線 gcTANGENTLINE1C
!円
! 作図 gcDRAWCIRCLE
! 中心と半径 gcCIRCLE
! 2点を結ぶ線分を直径とする gcCIRCLE2R
!その他
! 2点間の距離 DIST
! 点と直線との距離 DIST1L
! 2次方程式ax^2+bx+c=0を解く Solve2Equ
!下位ルーチン
!点
! 1点から直線への垂線の足 gcFOOTofPERPENDICULAR
! 1点から2点を通る直線への垂線の足 gcFOOTofPERPENDICULAR2
!交点
! 直線と円 gcINTERSECTION1C
!直線
! 1点を通り、2点を通る直線に平行 * gcLINEP2
! 1点を通り、2点を通る直線に垂直 * gcLINEX2
! 1点から2点を結ぶ線分の中点を通る（中線） gcD2LINE
! 2点を結ぶ線分の垂直二等分線 gcP2LINE
!円
! 2点と半径 gcCIRCLE2
! 3点を通る（3点を頂点とする三角形の外接円） gcCIRCLE3
!中位ルーチン
!交点
! 円と円 gcINTERSECTION2C
!上位ルーチン
!直線
! 円外の点からの接線 gcTANGENTLINE
!最上位ルーチン
!直線
! 2円の共通接線、接点 gcTANGENTLINE2C
!作図ツール（Geometric Constructor）
!図形と方程式
! 点 (x,y)
! 直線 Lx+My+N=0
! 円 x^2+y^2+Ax+By+C=0
!
! 角度の単位は度、反時計まわりが正とする。
!作図ルーチン
EXTERNAL SUB gcDRAWPOINT(x,y,s$) !点(x,y)を描く
SET AREA COLOR gcCOLOR
DRAW disk WITH SCALE(0.1)*SHIFT(x,y) !※拡大率0.1は調整が必要である
IF s$<>"" THEN PLOT TEXT ,AT x,y: s$
END SUB
EXTERNAL SUB gcDRAWLINE(L,M,N,s$,o) !直線Lx+My+N=0を描く
ASK WINDOW x1,x2,y1,y2
IF (L=0 AND M=0) THEN
PRINT "L=M=0なので、直線が成立しません。"; L;M;N
ELSEIF M=0 THEN !y軸に平行な直線
SET LINE COLOR gcCOLOR
SET LINE STYLE gcLINESTYLE
PLOT LINES: -N/L,y1; -N/L,y2
IF s$<>"" THEN PLOT TEXT ,AT -N/L,0: s$ !x切片
ELSE
SET LINE COLOR gcCOLOR
SET LINE STYLE gcLINESTYLE
PLOT LINES: x1,-(L*x1+N)/M; x2,-(L*x2+N)/M
IF s$<>"" THEN !注釈
IF L=0 THEN !x軸に平行なら
LET x=0 !y切片
LET y=-N/M
ELSE !x軸とy軸の両方と交差するなら（いわゆる斜めの直線）
SELECT CASE o !記入位置
CASE 0 !y切片
LET x=0
LET y=-N/M
CASE 1 !x切片
LET x=-N/L
LET y=0
CASE 2 !x切片とy切片との中点
LET x=-N/L*0.5
LET y=-N/M*0.5
CASE ELSE
END SELECT
END IF
PLOT TEXT ,AT x,y: s$
END IF
END IF
END SUB
EXTERNAL SUB gcDRAWCIRCLE(A,B,C,s$,o) !円x^2+y^2+Ax+By+C=0を描く
LET RR=(A^2+B^2)/4-C !判別式
IF RR>=0 THEN
SET LINE COLOR gcCOLOR
SET LINE STYLE gcLINESTYLE
LET CX=-A/2 !中心
LET CY=-B/2
LET R=SQR(RR) !半径
FOR i=0 TO 360 !(x-CX)^2+(y-CY)^2=R^2として描く
PLOT LINES: R*COS(RAD(i))+CX,R*SIN(RAD(i))+CY;
NEXT i
PLOT LINES
IF s$<>"" THEN !注釈
SELECT CASE o !記入位置
CASE 0 !右
LET x=CX+R
LET y=CY
CASE 1 !上
LET x=CX
LET y=CY+R
CASE 2 !右上
LET x=R*SQR(2)/2+CX !45度
LET y=R*SQR(2)/2+CY
CASE ELSE
END SELECT
PLOT TEXT ,AT x,y: s$
END IF
ELSE
PRINT "半径が負なので、円が成立しません。"; A;B;C
END IF
END SUB
!補助ルーチン
EXTERNAL FUNCTION DIST(x1,y1,x2,y2) !2点(x1,y1),(x2,y2)間の距離
LET DIST=SQR((x1-x2)^2+(y1-y2)^2)
END FUNCTION
!点(x,y)と直線Lx+My+N=0との距離（点から直線へ下した垂線の長さ）
EXTERNAL FUNCTION DIST1L(x,y,L,M,N)
LET DIST1L=ABS(L*x+M*y+N)/SQR(L^2+M^2)
END FUNCTION
EXTERNAL SUB Solve2Equ(a,b,c, x1,x2,K) !2次方程式ax^2+bx+c=0を解く
IF a=0 THEN
PRINT "2次の係数が0なので、2次方程式ではありません。"; a;b;c
LET K=0
ELSE
LET D=b^2-4*a*c !判別式
IF D>=0 THEN !実数解なら
LET x1=(-b+SQR(D))/(2*a) !1つの解
IF D=0 THEN !重解なら
LET K=1
ELSE
LET x2=(-b-SQR(D))/(2*a) !もう1つの解
LET K=2
END IF
ELSE !虚数解なら
LET K=0
END IF
END IF
END SUB
!演算ルーチン
!●点
EXTERNAL SUB gcCENTER(x1,y1,x2,y2, xx,yy) !点A(x1,y1),B(x2,y2)を結ぶ線分ABの中点
LET xx=(x1+x2)/2
LET yy=(y1+y2)/2
END SUB
!点A(x1,y1),B(x2,y2)を結ぶ線分ABをm:nに分ける点（内分・外分する点）
EXTERNAL SUB gcDIVIDE(x1,y1,x2,y2,m,n, xx,yy)
LET xx=(n*x1+m*x2)/(m+n) !※外分m:nは、m:(-n)となる
LET yy=(n*y1+m*y2)/(m+n)
END SUB
!直線Lx+My+N=0と直線Px+Qy+R=0との交点
! 平行でない、すなわち
! | L M |≠0 なら、交点がある。
! | P Q |
EXTERNAL SUB gcINTERSECTION(L,M,N,P,Q,R, xx,yy,K)
LET D=L*Q-M*P !判別式
IF D=0 THEN
PRINT "2直線は平行です。"; L;M;N; P;Q;R
LET K=0
ELSE
LET xx=(M*R-Q*N)/D
LET yy=(P*N-L*R)/D
LET K=1
END IF
END SUB
!点(x1,y1)から直線Lx+My+N=0への垂線の足H
EXTERNAL SUB gcFOOTofPERPENDICULAR(x1,y1,L,M,N, xx,yy)
CALL gcLINEX(x1,y1,L,M,N, P,Q,R) !点を通り、直線と垂直な直線
CALL gcINTERSECTION(L,M,N,P,Q,R, xx,yy,K) !交点
END SUB
!点A(x1,y1)から点B(x2,y2),C(x3,y3)を通る直線BCへの垂線の足H
EXTERNAL SUB gcFOOTofPERPENDICULAR2(x1,y1,x2,y2,x3,y3, xx,yy)
IF (x2=x3 AND y2=y3) THEN
PRINT "2点は同一点なので、直線が成立しません。"; x1;y1;x2;y2;x3;y3
ELSE
CALL gcLINE(x2,y2,x3,y3, L,M,N) !直線BC
CALL gcLINEX(x1,y1,L,M,N, P,Q,R) !点Aを通り、直線BCと垂直な直線
CALL gcINTERSECTION(L,M,N,P,Q,R, xx,yy,K) !交点
END IF
END SUB
!直線Lx+My+N=0と円x^2+y^2+Ax+By+C=0との交点
! M≠0のとき
! y=-(Lx+N)/Mを代入して、x^2 +{-(Lx+N)/M}^2 +Ax +B{-(Lx+N)/M} +C = 0
! {L^2+M^2}x^2 +{L(2N-BM)+AM^2}x +{N^2-BMN+CM^2} = 0
! xについての2次方程式を解く。
! M=0のとき（y軸に平行な直線）
! x=-N/Lより、(-N/L)^2+y^2+A(-N/L)+By+C=0
! yについての2次方程式を解く。
EXTERNAL SUB gcINTERSECTION1C(L,M,N,A,B,C, x1,y1,x2,y2,K)
IF M=0 THEN !y軸に平行な直線
LET aa=1
LET bb=B
LET cc=(-N/L)^2+A*(-N/L)+C
CALL Solve2Equ(aa,bb,cc, y1,y2,K)
IF K>0 THEN
LET x1=-N/L !1点目
IF K=2 THEN LET x2=-N/L !2点目
ELSE
PRINT "交点なし"
END IF
ELSE
LET aa=L^2+M^2
LET bb=L*(2*N-B*M)+A*M^2
LET cc=N^2-B*M*N+C*M^2
CALL Solve2Equ(aa,bb,cc, x1,x2,K)
IF K>0 THEN
LET y1=-(L*x1+N)/M !1点目
IF K=2 THEN LET y2=-(L*x2+N)/M !2点目
ELSE
PRINT "交点なし"
END IF
END IF
END SUB
!円x^2+y^2+A1x+B1y+C1=0と円x^2+y^2+A2x+B2y+C2=0との交点
! 2円の交点を通る曲線は、(x^2+y^2+A1x+B1y+C1)+k(x^2+y^2+A2x+B2y+C2)=0より、
! k=-1として、極線は(A1-A2)x+(B1-B2)y+(C1-C2)=0
! 交点は、極線と円1との交点で求まる。
EXTERNAL SUB gcINTERSECTION2C(A1,B1,C1,A2,B2,C2, x1,y1,x2,y2,K)
CALL gcINTERSECTION1C(A1-A2,B1-B2,C1-C2,A1,B1,C1, x1,y1,x2,y2,K)
END SUB
!円外の点(Px,Py)から円x^2+y^2+Ax+By+C=0への接点
! 点(Px,Py)と元の円の中心点を直径とする円
! (x-Px)(x+A/2)+(y-Py)(y+B/2)=0 ∴x^2+y^2+{A/2-Px}x+{B/2-Py}y+{Px(A/2)+Py(B/2)}=0
! この円と元の円との交点が接点となる。
EXTERNAL SUB gcTANGENTLINE(Px,Py,A,B,C, x1,y1,x2,y2,K)
LET D=Px^2+Py^2+A*Px+B*Py+C !判別式
IF D<-cEPS THEN
PRINT "点は円内です。"; Px;Py;A;B;C
LET K=0
ELSEIF D>cEPS THEN !円外なら
CALL gcCIRCLE2R(Px,Py,-A/2,-B/2, S,T,U)
CALL gcINTERSECTION2C(S,T,U,A,B,C, x1,y1,x2,y2,K)
ELSE !円周上なら
LET x1=Px
LET y1=Py
LET K=1
END IF
END SUB
続く
|
|
|
|
投稿者：山中和義
投稿日：2011年10月12日(水)10時51分52秒
|
|
|
|
続き
!●直線
!2点(x1,y1), (x2,y2)を通る直線Lx+My+N=0
!公式 -(y2-y1)(x-x1)+(x2-x1)(y-y1)=0 より
EXTERNAL SUB gcLINE(x1,y1,x2,y2, L,M,N)
IF (x1=x2 AND y1=y2) THEN !同一点なら
PRINT "異なる2点ではないので、直線が成立しません。"; x1;y1;x2;y2
ELSE
LET L=y1-y2
LET M=x2-x1
LET N=x1*y2-y1*x2
END IF
END SUB
!点(x1,y1)と通り、直線Ax+By+C=0に平行な直線
!公式 直線BCがLx+My+N=0のとき、L(x-x1)+M(y-y1)=0
EXTERNAL SUB gcLINEP(x1,y1,L,M,N, A,B,C)
LET A=L
LET B=M
LET C=-L*x1-M*y1
END SUB
!点(x1,y1)と通り、2点(x2,y2), (x3,y3)を通る直線に平行な直線
!公式 直線BCがLx+My+N=0のとき、L(x-x1)+M(y-y1)=0
EXTERNAL SUB gcLINEP2(x1,y1,x2,y2,x3,y3, L,M,N)
IF (x2=x3 AND y2=y3) THEN
PRINT "2点は同一点なので、直線が成立しません。"; x1;y1;x2;y2;x3;y3
ELSE
CALL gcLINE(x2,y2,x3,y3, L,M,N)
LET N=-L*x1-M*y1
END IF
END SUB
!点(x1,y1)と通り、直線Ax+By+C=0に垂直な直線
!公式 直線BCがLx+My+N=0のとき、L(y-y1)=M(x-x1)
EXTERNAL SUB gcLINEX(x1,y1,L,M,N, A,B,C)
LET A=-M
LET B=L
LET C=-L*y1+M*x1
END SUB
!点(x1,y1)と通り、2点(x2,y2), (x3,y3)を通る直線に垂直な直線
!公式 直線BCがLx+My+N=0のとき、L(y-y1)=M(x-x1)
EXTERNAL SUB gcLINEX2(x1,y1,x2,y2,x3,y3, L,M,N)
IF (x2=x3 AND y2=y3) THEN
PRINT "2点は同一点なので、直線が成立しません。"; x1;y1;x2;y2;x3;y3
ELSE
CALL gcLINE(x2,y2,x3,y3, S,T,U)
LET L=-T
LET M=S
LET N=-S*y1+T*x1
END IF
END SUB
!点A(x1,y1)から点B(x2,y2), C(x3,y3)を結ぶ線分BCの中点を通る直線（中線）
EXTERNAL SUB gcD2LINE(x1,y1,x2,y2,x3,y3, L,M,N)
IF (x1=x2 AND y1=y2) OR (x1=x3 AND y1=y3) THEN
PRINT "2点は同一点なので、線分が成立しません。"; x1;y1;x2;y2;x3;y3
ELSE
CALL gcLINE(x1,y1,(x2+x3)/2,(y2+y3)/2, L,M,N)
END IF
END SUB
!点A(x1,y1), B(x2,y2)を結ぶ線分ABの垂直二等分線
EXTERNAL SUB gcP2LINE(x1,y1,x2,y2, L,M,N)
IF (x1=x2 AND y1=y2) THEN
PRINT "2点は同一点なので、線分が成立しません。"; x1;y1;x2;y2
ELSE
CALL gcLINE(x1,y1,x2,y2, A,B,C) !直線AB
CALL gcLINEX((x1+x2)/2,(y1+y2)/2,A,B,C, L,M,N) !中点を通り直線ABに垂直
END IF
END SUB
!直線Ax+By+C=0を一定間隔p（平行線の間隔）だけ平行移動させる
! 長さで三角形A,B,√(A^2+B^2)と三角形x,y,pを考える。
! x方向 √(A^2+B^2) : A = p : x より、x=Ap/√(A^2+B^2)
! y方向 √(A^2+B^2) : B = p : y より、y=Bp/√(A^2+B^2)
! よって、(x,y)を移動量とする平行移動された直線は、A(X-x)+B(Y-y)+C=0
EXTERNAL SUB gcPARALLELLINE(A,B,C,p, L,M,N,dx,dy)
LET t=SQR(A^2+B^2)
LET L=A
LET M=B
LET N=C-t*p
LET dx=-A*p/t !x軸,y軸成分
LET dy=-B*p/t
END SUB
!2直線Lx+My+N=0、Px+Qy+R=0のなす角を二等分する線
! 求める直線上の点を(x,y)とする。
! この点から2直線への距離は等しいので、|Lx+My+N|/√(L^2+M^2)=|Px+Qy+R|/√(P^2+Q^2)
! ∴√(P^2+Q^2)(Lx+My+N)=±√(L^2+M^2)(Px+Qy+R)
EXTERNAL SUB gcA2LINE(L,M,N,P,Q,R, A,B,C, D,E,F, K)
LET s=SQR(P^2+Q^2)
LET t=SQR(L^2+M^2)
LET A=s*L+t*P !1つ目
LET B=s*M+t*Q
LET C=s*N+t*R
LET K=1
IF L*Q-M*P<>0 THEN !2直線が交わるなら
LET D=s*L-t*P !2つ目
LET E=s*M-t*Q
LET F=s*N-t*R
LET K=2
END IF
END SUB
!円x^2+y^2+Ax+By+C=0上の円周上の点(x0,y0)における接線
!公式 円(x+A/2)^2+(y+B/2)^2=(A/2)^2+(B/2)^2-Cより、(x0+A/2)(x+A/2)+(y0+B/2)(y+B/2)=(A^2+B^2)/4-C
EXTERNAL SUB gcTANGENTLINE1C(x0,y0,A,B,C, L,M,N)
LET RR=(A^2+B^2)/4-C !判別式
IF RR>0 THEN
IF ABS(x0^2+y0^2+A*x0+B*y0+C)>cEPS THEN
PRINT "点は円周上にありません。"; x0;y0;A;B;C
ELSE
LET L=x0+A/2
LET M=y0+B/2
LET N=x0*A/2+y0*B/2 +C
END IF
ELSE
PRINT "半径が負または０なので、円が成立しません。"; A;B;C
END IF
END SUB
!●円
EXTERNAL SUB gcCIRCLE(x1,y1,R, A,B,C) !中心(x1,y1)、半径Rの円
IF R>0 THEN
LET A=-2*x1
LET B=-2*y1
LET C=x1^2+y1^2-R^2
ELSE
PRINT "半径が負または０なので、円が成立しません。"; x1;y1;R
END IF
END SUB
!2点P(x1,y1),Q(x2,y2)を結ぶ線分を直径とする円
! A=-2(x1+x2)/2、B=-2(y1+y2)/2、C=(x1+x2)^2/4+(y1+y2)^2/4 -{(x1-x2)^2+(y1-y2)^2}/4 より
EXTERNAL SUB gcCIRCLE2R(x1,y1,x2,y2, A,B,C)
IF (x1=x2 AND y1=y2) THEN !同一点なら
PRINT "2点は同一点なので、円が成立しません。"; x1;y1;x2;y2
ELSE
LET A=-(x1+x2)
LET B=-(y1+y2)
LET C=x1*x2+y1*y2
END IF
END SUB
!2点P(x1,y1),Q(x2,y2)を通る半径Rの円
! 2点を通る直線（半径∞の円） Lx+My+N=0
! 2点を直径とする円 x^2+y^2+Sx+Ty+U=0
! これより、2点を通る曲線 (x^2+y^2+Sx+Ty+U)+k(Lx+My+N)=0 とおける。
! 半径がRより、(x+(S+kL)/2)^2+(y+(T+kM)/2)^2={(S+kL)^2+(T+kM)^2}/4-(U+kN)=R^2
! ∴(S+kL)^2+(T+kM)^2-4(U+kN)-4R^2=0
! ∴(L^2+M^2)k^2 +2(SL+TM-2N)k +{(S^2+T^2)-4*(R^2+U)}=0
! kについての2次方程式を解く。
EXTERNAL SUB gcCIRCLE2(x1,y1,x2,y2,R, A,B,C, D,E,F, K)
IF (x1=x2 AND y1=y2) THEN !同一点なら
PRINT "2点は同一点なので、円が成立しません。"; x1;y1;x2;y2;R
ELSEIF R<=0 THEN
PRINT "半径は負または０なので、円が成立しません。"; x1;y1;x2;y2;R
ELSE
CALL gcLINE(x1,y1,x2,y2, L,M,N) !直線
CALL gcCIRCLE2R(x1,y1,x2,y2, S,T,U) !円
LET aa=L^2+M^2
LET bb=2*(S*L+T*M-2*N)
LET cc=(S^2+T^2)-4*(R^2+U)
CALL Solve2Equ(aa,bb,cc, k1,k2,K)
IF K>0 THEN
LET A=S+k1*L
LET B=T+k1*M
LET C=U+k1*N
IF K=2 THEN !2点を結ぶ線分が直径となる場合は１つ
LET D=S+k2*L
LET E=T+k2*M
LET F=U+k2*N
END IF
ELSE
PRINT "半径の長さが短いので、円が成立しません。"; x1;y1;x2;y2;R
LET K=0
END IF
END IF
END SUB
!3点P(x1,y1),Q(x2,y2),R(x3,y3)を通る円（3点を頂点とする三角形の外接円）
! 線分PQを直径とする円 (x-x1)*(x-x2)+(y-y1)*(y-y2)=0 ←式1
! 点P,Qを通る直線（半径∞の円と考える） (x-x1)*(y2-y1)-(y-y1)*(x2-x1)=0 ←式2
! これより、点P,Qを通る曲線（円）は、(式1)+k*(式2)=0と表される。
! 点Rを通るので、(x3,y3)を代入して、kを定める。
EXTERNAL SUB gcCIRCLE3(x1,y1,x2,y2,x3,y3, A,B,C)
IF (x1=x3 AND y1=y2) OR (x2=x3 AND y2=y3) OR (x3=x1 AND y3=y1) THEN !同一点なら
PRINT "異なる3点ではないので、円が成立しません。"; x1;y1;x2;y2;x3;y3
ELSEIF (x3-x1)*(y2-y1)=(y3-y1)*(x2-x1) THEN !直線PQと直線PRの傾きが同じなら
PRINT "3点は一直線上にあるので、円が成立しません。"; x1;y1;x2;y2;x3;y3
ELSE
LET p=(x3-x1)*(x3-x2)+(y3-y1)*(y3-y2)
LET q=(x3-x1)*(y2-y1)-(y3-y1)*(x2-x1)
LET k=-p/q
!!!PRINT k !debug
LET ox=((x1+x2)-k*(y2-y1))/2 !中心点o（外心）
LET oy=((y1+y2)+k*(x2-x1))/2
LET R=DIST(ox,oy,x1,y1) !半径oA
CALL gcCIRCLE(ox,oy,R, A,B,C)
END IF
END SUB
!2円x^2+y^2+A1x+B1y+C1=0、x^2+y^2+A2x+B2y+C2=0の共通接線
! 2円の配置
! 外側で交わらない
! 2つの共通外接線、4つの接点
! 2つの共通内接線、4つの接点
! 外接
! 2つの共通外接線、4つの接点
! 1つの内接線、1つの接点
! 交わる
! 2つの共通外接線、4つの接点
! 内接
! 1つの接線、1つの接点
! 内側で交わらない
! 接線、接点なし
!
!※接点(PX(1),PY(1))と接点(PX(2),PY(2))を通る接線は、L(1)x+M(1)y+N(1)=0となる。
EXTERNAL SUB gcTANGENTLINE2C(A1,B1,C1,A2,B2,C2, L(),M(),N(),K, PX(),PY(),K2)
LET RR1=(A1^2+B1^2)/4-C1 !判別式
LET RR2=(A2^2+B2^2)/4-C2
IF (RR1>0 AND RR2>0) THEN !円と円
LET R1=SQR(RR1) !円1の半径
LET R2=SQR(RR2) !円2の半径
LET cx1=-A1/2 !円1の中心
LET cy1=-B1/2
LET cx2=-A2/2 !円2の中心
LET cy2=-B2/2
LET d=DIST(cx1,cy1,cx2,cy2) !線分o1o2の長さ（中心間の距離）
LET t=ABS(R1-R2)
IF t<d THEN !外側で交わらない、外接、交わる
!--- 共通外接線
IF R1=R2 THEN !※半径が同じなので、接線は平行となる
CALL gcLINE(cx1,cy1,cx2,cy2, S,T,U) !直線o1o2
CALL gcPARALLELLINE(S,T,U, R1, L(1),M(1),N(1),dx,dy) !間隔R1の直線
LET PX(1)=cx1+dx !接点
LET PY(1)=cy1+dy
LET PX(2)=cx2+dx !接点
LET PY(2)=cy2+dy
CALL gcPARALLELLINE(S,T,U,-R1, L(2),M(2),N(2),dx,dy) !反対側
LET PX(3)=cx1+dx !接点
LET PY(3)=cy1+dy
LET PX(4)=cx2+dx !接点
LET PY(4)=cy2+dy
ELSE !※直線o1o2を共通な辺として、半径を1辺とする相似な三角形を考える
CALL gcDIVIDE(cx1,cy1,cx2,cy2,R1,-R2, xx,yy) !線分o1o2の外分点
CALL gcTANGENTLINE(xx,yy,A1,B1,C1, PX(1),PY(1),PX(3),PY(3),K) !この点から円1に接線を引く
CALL gcDIVIDE(PX(1),PY(1),xx,yy,R1-R2,R2, PX(2),PY(2)) !接点と外分点から円2の接点を算出する
CALL gcDIVIDE(PX(3),PY(3),xx,yy,R1-R2,R2, PX(4),PY(4))
CALL gcLINE(PX(1),PY(1),PX(2),PY(2), L(1),M(1),N(1)) !接線
CALL gcLINE(PX(3),PY(3),PX(4),PY(4), L(2),M(2),N(2))
END IF
LET K=2
LET K2=4
!--- 共通内接線
LET tt=R1+R2
IF tt<d THEN !離れている（外側で交わらない）
CALL gcDIVIDE(cx1,cy1,cx2,cy2,R1,R2, xx,yy) !線分o1o2の内分点
CALL gcTANGENTLINE(xx,yy,A1,B1,C1, PX(5),PY(5),PX(7),PY(7),K) !この点から円1に接線を引く
CALL gcDIVIDE(PX(5),PY(5),xx,yy,R1+R2,-R2, PX(6),PY(6)) !接点と内分点から円2の接点を算出する
CALL gcDIVIDE(PX(7),PY(7),xx,yy,R1+R2,-R2, PX(8),PY(8))
CALL gcLINE(PX(5),PY(5),PX(6),PY(6), L(3),M(3),N(3)) !接線
CALL gcLINE(PX(7),PY(7),PX(8),PY(8), L(4),M(4),N(4))
LET K=4
LET K2=8
ELSEIF ABS(tt-d)<=cEPS THEN !外接している
CALL gcDIVIDE(cx1,cy1,cx2,cy2,R1,R2, PX(5),PY(5)) !線分o1o2をR1:R2に分ける点
CALL gcLINE(cx1,cy1,cx2,cy2, P,Q,R) !その点を通り、線分o1o2に垂直
CALL gcLINEX(PX(5),PY(5),P,Q,R, L(3),M(3),N(3))
LET K=3
LET K2=5
ELSE !交わる
!nop
END IF
ELSEIF ABS(t-d)<=cEPS THEN !内接している
CALL gcDIVIDE(cx1,cy1,cx2,cy2,R1,-R2, PX(1),PY(1)) !線分o1o2をR1:-R2に分ける点
CALL gcLINE(cx1,cy1,cx2,cy2, P,Q,R) !その点を通り、線分o1o2に垂直
CALL gcLINEX(PX(1),PY(1),P,Q,R, L(1),M(1),N(1))
LET K=1
LET K2=1
ELSE !含まれる（内側で交わらない）
IF d=0 THEN PRINT "同心円で";
PRINT "接線はありません。"
LET K=0
END IF
ELSE
PRINT "半径が負または０なので、円が成立しません。"; A1;B1;C1; A2;B2;C2
LET K=0
LET K2=0
END IF
END SUB
|
|
|
|
投稿者：山中和義
投稿日：2011年10月12日(水)11時01分47秒
|
|
|
|
> No.1672[元記事へ]
いくつかの使用例です。サブルーチン部分は省略します。
●サンプル１
!図形と方程式
SET WINDOW -8,8,-8,8 !表示領域を設定する ※
DRAW grid !XY座標
PUBLIC NUMERIC cEps !精度 ※調整が必要である
LET cEPS=1E-8
PUBLIC NUMERIC gcCOLOR,gcSTYLE,gcLINESTYLE !描画色、線種
LET gcCOLOR=1
LET gcLINESTYLE=1
!------------------------------ ここまでがサブルーチン
!●3直線4x+3y+12=0, 3x-4y+9=0, 2x-y-4=0で作られる三角形の面積を求めよ。
LET gcCOLOR=1
LET L1=4 !直線1
LET M1=3
LET N1=12
CALL gcDRAWLINE(L1,M1,N1,"L1",2) !直線を描く
LET gcCOLOR=2
LET L2=3 !直線2
LET M2=-4
LET N2=9
CALL gcDRAWLINE(L2,M2,N2,"L2",0) !直線を描く
LET gcCOLOR=4
LET L3=2 !直線3
LET M3=-1
LET N3=-4
CALL gcDRAWLINE(L3,M3,N3,"L3",1) !直線を描く
LET gcCOLOR=1
CALL gcINTERSECTION(L1,M1,N1,L2,M2,N2, xx1,yy1,K) !直線1と直線2との交点
PRINT xx1;yy1 !debug
CALL gcDRAWPOINT(xx1,yy1,"")
CALL gcINTERSECTION(L1,M1,N1,L3,M3,N3, xx2,yy2,K) !直線1と直線3との交点
PRINT xx2;yy2 !debug
CALL gcDRAWPOINT(xx2,yy2,"")
LET D=DIST(xx1,yy1,xx2,yy2) !底辺の長さ
PRINT D !debug
CALL gcINTERSECTION(L2,M2,N2,L3,M3,N3, xx,yy,K) !直線2と直線3との交点
PRINT xx;yy !debug
CALL gcDRAWPOINT(xx,yy,"")
LET H=DIST1L(xx,yy,L1,M1,N1) !高さ
PRINT "面積="; D*H/2 !面積
END
●サンプル２
!図形と方程式
SET WINDOW -8,8,-8,8 !表示領域を設定する ※
DRAW grid !XY座標
PUBLIC NUMERIC cEps !精度 ※調整が必要である
LET cEPS=1E-8
PUBLIC NUMERIC gcCOLOR,gcSTYLE,gcLINESTYLE !描画色、線種
LET gcCOLOR=1
LET gcLINESTYLE=1
!------------------------------ ここまでがサブルーチン
!●点(1,3)から、円x^2+y^2=5に引いた接線の方程式を求めよ。
LET gcCOLOR=4
LET px=1 !点(1,3)
LET py=3
CALL gcDRAWPOINT(px,py,"") !点を描く
LET A=0 !円
LET B=0
LET C=-5
CALL gcDRAWCIRCLE(A,B,C,"",0) !円を描く
CALL gcTANGENTLINE(px,py,A,B,C, x1,y1,x2,y2,K)
LET gcCOLOR=1
IF k>0 THEN
PRINT x1;y1 !接点
CALL gcLINE(px,py,x1,y1, P,Q,R) !接線を描く
CALL gcDRAWLINE(P,Q,R,"",0)
IF K=2 THEN !2つ目
PRINT x2;y2 !接点
CALL gcLINE(px,py,x2,y2, P,Q,R) !接線を描く
CALL gcDRAWLINE(P,Q,R,"",0)
END IF
END IF
END
●サンプル３
!図形と方程式
SET WINDOW -8,8,-8,8 !表示領域を設定する ※
DRAW grid !XY座標
PUBLIC NUMERIC cEps !精度 ※調整が必要である
LET cEPS=1E-8
PUBLIC NUMERIC gcCOLOR,gcSTYLE,gcLINESTYLE !描画色、線種
LET gcCOLOR=1
LET gcLINESTYLE=1
!------------------------------ ここまでがサブルーチン
!●2円(x+1)^2+(y+2)^2=5、(x-2)^2+(y-3)^2=3の共通接線の方程式を求めよ。
LET gcCOLOR=1
CALL gcCIRCLE(-1,-2,SQR(5), A1,B1,C1) !円1
CALL gcDRAWCIRCLE(A1,B1,C1,"C1",0)
CALL gcCIRCLE(4,2,3, A2,B2,C2) !円2 外部で交わらない
!CALL gcCIRCLE(2,3,4, A2,B2,C2) !円2 交わる
!CALL gcCIRCLE(3,4,5, A2,B2,C2) !円2 外接
!CALL gcCIRCLE2R(-1,-2,-2,-4, A2,B2,C2) !円2 内接
!CALL gcCIRCLE2R(-0.5,-0.5,-2,-3, A2,B2,C2) !円2 内部で交わらない
CALL gcDRAWCIRCLE(A2,B2,C2,"C2",0)
DIM LL(4),MM(4),NN(4)
DIM TX(8),TY(8)
CALL gcTANGENTLINE2C(A1,B1,C1,A2,B2,C2, LL,MM,NN,K, TX,TY,K2)
PRINT K;K2
LET gcCOLOR=4
FOR i=1 TO K !接線を描く
CALL gcDRAWLINE(LL(i),MM(i),NN(i),"",0)
NEXT i
FOR i=1 TO K2 !接点を描く
PRINT i;":"; TX(i);TY(i)
CALL gcDRAWPOINT(TX(i),TY(i),"")
NEXT i
END
|
|
|
戻る