作図サブルーチン集（図形と方程式）

 投稿者：山中和義  投稿日：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


続く 		 

Re: 作図サブルーチン集（図形と方程式）

 投稿者：山中和義  投稿日：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
 

Re: 作図サブルーチン集（図形と方程式）

 投稿者：山中和義  投稿日：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
 

戻る