二次方程式を解く1/2(全2/2)

 投稿者：nuﾒｰﾙ  投稿日：2012年 1月29日(日)07時18分1秒
  !1/2
!----------------------------------------------------------------------
!二次方程式を解くためのプログラム
!根はわざと開かないような仕様にいたしました。
!----------------------------------------------------------------------
00500 DECLARE EXTERNAL FUNCTION GCD
01000 !【１】配列
01100 DIM x(2)
01200 DIM y(3)
01300 GOTO 02000 !【２】代入へ

02000 !【２】代入
02001 PRINT "「二次方程式の解を計算します。"
02002 PRINT "  a/d*x^2 + b/e*x + c/f = 0 の形式で、"
02003 PRINT "  a,b,c,d,e,fの順序で入力してください。」"
02004 PRINT "  <例> a*x^2 + b*x + c = 0 のとき、"
02005 PRINT "       a,b,c,1,1,1と入力します。"
02006 INPUT a,b,c,d,e,f
02007 PRINT "a,b,c,d,e,f"
02008 PRINT "(";a;")";"/";"(";d;")";"x^2+";"(";b;")";"/";"(";e;")";"x+";"(";c;")";"/";"(";f;")";"=0"
02009 LET t0=TIME

02010 IF d*e*f=0 THEN GOTO 02398
02011 IF d*e*f><0 THEN GOTO 02013
02012
02013 IF a*b*c*d*e*f><0 THEN GOTO 02400
02014 IF d*e*f><0 AND a><0 AND b><0 AND c=0 THEN GOTO 02040
02015 IF d*e*f><0 AND a><0 AND b=0 AND c><0 THEN GOTO 02046
02016 IF d*e*f><0 AND a><0 AND b=0 AND c=0 THEN GOTO 02386
02017 IF d*e*f><0 AND a=0 AND b><0 AND c><0 THEN GOTO 02388
02018 IF d*e*f><0 AND a=0 AND b><0 AND c=0 THEN GOTO 02394
02019 IF d*e*f><0 AND a=0 AND b=0 AND c><0 THEN GOTO 02396
02020 IF d*e*f><0 AND a=0 AND b=0 AND c=0 THEN GOTO 02398

02040 IF INT(b/GCD(a,b))><INT(a/GCD(a,b)) AND INT(a/GCD(a,b))><1 THEN GOTO 02042
02041 IF INT(b/GCD(a,b))=INT(a/GCD(a,b)) OR INT(a/GCD(a,b))=1 THEN GOTO 02044
02042 PRINT "x(1)=";-b/GCD(a,b);"/";a/GCD(a,b);",";"x(2)=";0
02043 GOTO 20000
02044 PRINT "x(1)=";-b/a;",";"x(2)=";0
02045 GOTO 20000
02046 IF a*f>0 AND c*d>0 THEN GOTO 02050
02047 IF a*f>0 AND c*d<0 THEN GOTO 02070
02048 IF a*f<0 AND c*d>0 THEN GOTO 02090
02049 IF a*f<0 AND c*d<0 THEN GOTO 02110

!x(1)=-i*SQR(c*d/a*f),x(2)=i*SQR(c*d/a*f)
!(1)a*f>0 AND c*d>0
02050 FOR j=INT(SQR(c*d*a*f)) TO 1 STEP -1
02052    IF INT(SQR(c*d*a*f)/j)=SQR(c*d*a*f)/j AND GCD(a*f,j)><1 THEN GOTO 02055
02053    IF INT(SQR(c*d*a*f)/j)=SQR(c*d*a*f)/j AND GCD(a*f,j)=1 AND a*f><1 THEN GOTO 02057
02054    IF INT(SQR(c*d*a*f)/j)=SQR(c*d*a*f)/j AND GCD(a*f,j)=1 AND a*f=1 THEN GOTO 02059
02055    PRINT "x(1)=-i*";j/GCD(a*f,j);"/";a*f/GCD(a*f,j);"√";(c*d*a*f/(j^2));",";"x(2)=i*";j/GCD(a*f,j);"/";a*f/GCD(a*f,j);"√";(c*d*a*f/(j^2))
02056    GOTO 02061
02057    PRINT "x(1)=-i*";j;"/";a*f;"√";(c*d*a*f/(j^2));",";"x(2)=i*";j;"/";a*f;"√";(c*d*a*f/(j^2))
02058    GOTO 02061
02059    PRINT "x(1)=-i*";j/(a*f);"√";(c*d*a*f/(j^2));",";"x(2)=i*";j/(a*f);"√";(c*d*a*f/(j^2))
02060    GOTO 02061
02061 NEXT j
02062 GOTO 20000

!(2)a*f>0 AND c*d<0
      !x(1)=-SQR(-c*d/a*f),x(2)=SQR(-c*d/a*f)
      !x(1)=-SQR(-c*d*a*f/(a^2*f^2)),x(2)=SQR(-c*d*a*f/(a^2*f^2))
      !x(1)=-SQR(-c*d*a*f)/(a*f),x(2)=SQR(-c*d*a*f)/(a*f)
02070 FOR j=INT(SQR(-c*d*a*f)) TO 1 STEP -1
02071    IF INT(SQR(-c*d*a*f)/j)=SQR(-c*d*a*f)/j AND GCD(a*f,j)><1 THEN GOTO 02074
02072    IF INT(SQR(-c*d*a*f)/j)=SQR(-c*d*a*f)/j AND GCD(a*f,j)=1 AND a*f><1 THEN GOTO 02076
02073    IF INT(SQR(-c*d*a*f)/j)=SQR(-c*d*a*f)/j AND GCD(a*f,j)=1 AND a*f=1 THEN GOTO 02078
02074    PRINT "x(1)=-";j/GCD(a*f,j);"/";a*f/GCD(a*f,j);"√";(-c*d*a*f/(j^2));",";"x(2)=";j/GCD(a*f,j);"/";a*f/GCD(a*f,j);"√";(-c*d*a*f/(j^2))
02075    GOTO 02080
02076    PRINT "x(1)=-";j;"/";a*f;"√";(-c*d*a*f/(j^2));",";"x(2)=";j;"/";a*f;"√";(-c*d*a*f/(j^2))
02077    GOTO 02080
02078    PRINT "x(1)=-";j/(a*f);"√";(-c*d*a*f/(j^2));",";"x(2)=";j/(a*f);"√";(-c*d*a*f/(j^2))
02079    GOTO 02080
02080 NEXT j
02081 GOTO 20000

!(3)a*f<0 AND c*d>0
02090 FOR j=INT(SQR(-c*d*a*f)) TO 1 STEP -1
02091    IF INT(SQR(-c*d*a*f)/j)=SQR(-c*d*a*f)/j AND GCD(-a*f,j)><1 THEN GOTO 02094
02092    IF INT(SQR(-c*d*a*f)/j)=SQR(-c*d*a*f)/j AND GCD(-a*f,j)=1 AND a*f><1 THEN GOTO 02096
02093    IF INT(SQR(-c*d*a*f)/j)=SQR(-c*d*a*f)/j AND GCD(-a*f,j)=1 AND a*f=1 THEN GOTO 02098
02094    PRINT "x(1)=-";j/GCD(-a*f,j);"/";-a*f/GCD(-a*f,j);"√";(-c*d*a*f/(j^2));",";"x(2)=";j/GCD(-a*f,j);"/";-a*f/GCD(-a*f,j);"√";(-c*d*a*f/(j^2))
02095    GOTO 02100
02096    PRINT "x(1)=-";j;"/";-a*f;"√";(-c*d*a*f/(j^2));",";"x(2)=";j;"/";-a*f;"√";(-c*d*a*f/(j^2))
02097    GOTO 02100
02098    PRINT "x(1)=-";j/(-a*f);"√";(-c*d*a*f/(j^2));",";"x(2)=";j/(-a*f);"√";(-c*d*a*f/(j^2))
02099    GOTO 02100
02100 NEXT j
02101 GOTO 20000

!(4)a*f<0 AND c*d<0
02110 FOR j=INT(SQR(c*d*a*f)) TO 1 STEP -1
02111    IF INT(SQR(c*d*a*f)/j)=SQR(c*d*a*f)/j AND GCD(-a*f,j)><1 THEN GOTO 02114
02112    IF INT(SQR(c*d*a*f)/j)=SQR(c*d*a*f)/j AND GCD(-a*f,j)=1 AND a*f><1 THEN GOTO 02116
02113    IF INT(SQR(c*d*a*f)/j)=SQR(c*d*a*f)/j AND GCD(-a*f,j)=1 AND a*f=1 THEN GOTO 02118
02114    PRINT "x(1)=-i*";j/GCD(-a*f,j);"/";-a*f/GCD(-a*f,j);"√";(c*d*a*f/(j^2));",";"x(2)=i*";j/GCD(-a*f,j);"/";-a*f/GCD(-a*f,j);"√";(c*d*a*f/(j^2))
02115    GOTO 02120
02116    PRINT "x(1)=-i*";j;"/";(-a*f);"√";(c*d*a*f/(j^2));",";"x(2)=i*";j;"/";(-a*f);"√";(c*d*a*f/(j^2))
02117    GOTO 02120
02118    PRINT "x(1)=-i*";j/(-a*f);"√";(c*d*a*f/(j^2));",";"x(2)=i*";j/(-a*f);"√";(c*d*a*f/(j^2))
02119    GOTO 02120
02120 NEXT j
02121 GOTO 20000

02385 GOTO 20000
02386 PRINT "x=";0;"(重解)"
02387 GOTO 20000
02388 IF INT(c/GCD(b,c))><INT(b/GCD(b,c)) AND INT(b/GCD(b,c))><1 THEN GOTO 02390
02389 IF INT(c/GCD(b,c))=INT(b/GCD(b,c)) OR INT(b/GCD(b,c))=1 THEN GOTO 02392
02390 PRINT "x=";-c/GCD(b,c);"/";b/GCD(b,c)
02391 GOTO 20000
02392 PRINT "x=";-c/b
02393 GOTO 20000
02394 PRINT "x=";0
02395 GOTO 20000
02396 PRINT c;"≠0で等号不成立により、不能。（解なし）"
02397 GOTO 20000
02398 PRINT 0;"＝0で、等号成立により、不定。"
02399 GOTO 20000
      !!!!!
02400 LET y(1)=a*e*f !置き換え
02500 LET y(2)=b*d*f
02600 LET y(3)=c*d*e
02700 LET G=GCD(GCD(y(1),y(2)),y(3))
02750 LET a=y(1)/G
02800 LET b=y(2)/G
02850 LET c=y(3)/G
02900 GOTO 03000 !【３】判別式分岐へ
 		 

戻る