二次方程式の解

 投稿者：nuﾒｰﾙ  投稿日：2012年 1月27日(金)23時57分37秒
  !こんな感じになりました。
!ありがとうございました。
!2次方程式Ax^2+Bx+C=0すると、
!　判別式D=B^2-4AC
!　解の公式より、x=(-B/(2A))±√{(B^2-4AC)}/(2A)
!となる。
OPTION ARITHMETIC RATIONAL !有理数モード
DIM A(10)
DIM B(10)
DIM C(10)
LET A(1)=631/254
LET B(1)=25/398
LET C(1)=761/764
LET A(2)=131/521
LET B(2)=727/13
LET C(2)=31/423
LET A(3)=714/29
LET B(3)=2/103
LET C(3)=793/4
LET A(4)=405/26
LET B(4)=245/3
LET C(4)=17/4
LET A(5)=3431/2
LET B(5)=223/106
LET C(5)=441/4
LET A(6)=49/12
LET B(6)=112/113
LET C(6)=317/47
LET A(7)=91/29
LET B(7)=52/39
LET C(7)=73/41
LET A(8)=11/92
LET B(8)=72/13
LET C(8)=37/94
LET A(9)=12/271
LET B(9)=209/32
LET C(9)=79/104
LET A(10)=431/2
LET B(10)=33/74
LET C(10)=75/4

FOR j=1 TO 10
PRINT "(";j;")";A(j);"x^2+";B(j);"x+";C(j);"=0"
LET D=B(j)^2-4*A(j)*C(j)
IF D=0 THEN !重根
PRINT " ⇔";"x=";-B(j)/(2*A(j));"（重根）"
ELSE
LET S=NUMER(D) !分子　※符号なし
LET T=DENOM(D) !分母　※符号なし
!!!PRINT D;S;T !debug
CALL SqNormalize(S,P,Q) !√S=P√Qと変形する
CALL SqNormalize(T,X,Y)
!!!PRINT P;Q; X;Y !debug
IF Q=1 AND Y=1 THEN !平方根の中が平方数なら、m形
PRINT " ⇔";"x=";(-B(j)+P/X)/(2*A(j));",";(-B(j)-P/X)/(2*A(j))
ELSE !m±√n形
LET W=-B(j)/(2*A(j)) !有理数部（実部）
IF W<>0 THEN
PRINT " ⇔";"x="; W;
PRINT "±";
IF D<0 THEN PRINT "i * "; !虚数単位
LET W=(P/X)/(2*A(j)*Y) !平方根部（虚部）※有理化
LET Z=NUMER(W)
IF Z>1 THEN PRINT Z;
PRINT "√"; Q*Y;
LET Z=DENOM(W)
IF Z>1 THEN PRINT "/"; Z
END IF
END IF
END IF
NEXT j
END

EXTERNAL SUB SqNormalize(n,p,q) !平方根の中をできるだけ小さな正の整数に直す
OPTION ARITHMETIC RATIONAL !有理数モード
!※n=p^2*q、n,p,q≧0とすると、SQR(n)=p*SQR(q)と変形できる。
LET q=1 !※SQR(0)=0*SQR(1)とする　※n=0なら、１行下のFOR文でp=0は設定される
FOR p=INTSQR(n) TO 1 STEP -1 !約数p^2の候補を大きい方から
LET q=n/p^2
IF q=INT(q) THEN EXIT FOR !qは自然数より
NEXT p
END SUB 		 

Re: 二次方程式の解

 投稿者：山中和義  投稿日：2012年 1月28日(土)18時59分35秒
  > No.1738[元記事へ]

nuさんへのお返事です。

まず、前出のサンプルには整形表示で不具合がありました。（以下は修正しています）

サブルーチンをご存知なら、こちらの方が簡単です。まとめてブラックボックス化してください。

後は、有理数のプログラムを元に自前で有理数（分数）の計算を導入（差し替え）すればよいでしょう。


!2次方程式Ax^2+Bx+C=0とすると、
!　判別式D=B^2-4AC
!　解の公式より、x=(-B/(2A))±√D/(2A)
!となる。

OPTION ARITHMETIC RATIONAL !有理数モード

LET A=12/45
LET B=23/56
LET C=34/67
CALL Solve2Equ(A,B,C)

LET A=1 !x^2-3x+2=(x-1)(x-2)
LET B=-3
LET C=2
CALL Solve2Equ(A,B,C)

LET A=-1 !-x^2+x+1
LET B=1
LET C=1
CALL Solve2Equ(A,B,C)

LET A=1 !x^2+1=(x+i)(x-i)
LET B=0
LET C=1
CALL Solve2Equ(A,B,C)

LET A=2 !2x^2-2=2(x+1)(x-1)
LET B=0
LET C=-2
CALL Solve2Equ(A,B,C)

LET A=1 !x^2-4x+4=(x-2)^2
LET B=-4
LET C=4
CALL Solve2Equ(A,B,C)

LET A=0 !(1/2)x+3/4
LET B=1/2
LET C=3/4
CALL Solve2Equ(A,B,C)

LET A=0 !2/3
LET B=0
LET C=2/3
CALL Solve2Equ(A,B,C)

END


EXTERNAL SUB Solve2Equ(A,B,C) !2次方程式Ax^2+Bx+C=0を解く
OPTION ARITHMETIC RATIONAL !有理数モード

IF A=0 THEN !1次方程式 Bx+C=0
   IF B=0 THEN !C=0
      PRINT "方程式が成立しません。"; A;B;C
   ELSE
      PRINT "x= "; -C/B
   END IF

ELSE
   PRINT "x= ";

   LET D=B^2-4*A*C !判別式　※平方根の中
   LET S=NUMER(D) !分子　※符号なし
   LET T=DENOM(D) !分母　※符号なし
   !!!PRINT D;S;T !debug
   CALL SqNormalize(S,P,Q) !√S=P√Qと変形する
   CALL SqNormalize(T,X,Y)
   !!!PRINT P;Q; X;Y !debug
   IF D>0 AND (Q=1 AND Y=1) THEN !平方根の中が平方数なら、m形
      PRINT (-B+P/X)/(2*A); ", "; (-B-P/X)/(2*A)

   ELSE !m±√n形
      LET W=-B/(2*A) !有理数部（実部）
      IF D=0 THEN !判別式D=0なら
         PRINT W; "（重根）";
      ELSE
         IF W<>0 THEN PRINT W;

         PRINT "± ";

         LET W=(P/X)/Y/(2*A) !平方根部（虚部）　※有理化 √(P/Q)=(√PQ)/Q
         LET Z=Q*Y
         LET S=NUMER(W)
         LET T=DENOM(W)

         IF D<0 THEN
            PRINT "i "; !虚数単位
            IF NOT(S=1 AND T=1 AND Z=1) THEN PRINT "* "; !虚数単位
         END IF

         IF S>1 THEN PRINT S; !１サプレス
         IF Z>1 THEN PRINT "√("; Z; ") ";
         IF T>1 THEN PRINT "/"; T; !１サプレス

      END IF
      PRINT

   END IF
END IF
END SUB


EXTERNAL SUB SqNormalize(n, p,q) !平方根の中をできるだけ小さな正の整数に直す
OPTION ARITHMETIC RATIONAL !有理数モード
!※n=p^2*q、n,p,q≧0とすると、SQR(n)=p*SQR(q)と変形できる。
LET q=1 !※SQR(0)=0*SQR(1)とする　※n=0なら、１行下のFOR文でp=0は設定される
FOR p=INTSQR(n) TO 1 STEP -1 !約数p^2の候補を大きい方から
   LET q=n/p^2
   IF q=INT(q) THEN EXIT FOR !qは自然数より
NEXT p
END SUB
 		 

Re: 二次方程式の解

 投稿者：nuﾒｰﾙ  投稿日：2012年 1月29日(日)06時26分42秒
  山中和義さんへのお返事です。
お便りをいただきありがとうございます。

当方もプログラムを組んでおりました。
出来は無骨で、中学生には楽しめるのではないかと自負しております。
検索に時間がかかる点が短所ですが、他の解を見られるのは長所だと思います。
!----------------------------------------------------------------------
!二次方程式を解くためのプログラム
!根はわざと開かないような仕様にいたしました。
!----------------------------------------------------------------------
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 a="" and=""><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

!
!x(1)=-i*SQR(c*d/a*f),x(2)=i*SQR(c*d/a*f)
!
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


!x(1)=-i*SQR(c*d/a*f),x(2)=i*SQR(c*d/a*f)
!(3)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)
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
!x(1)=-i*SQR(c*d/a*f),x(2)=i*SQR(c*d/a*f)
!x(1)=-i*SQR(c*d*a*f/(a^2*f^2)),x(2)=i*SQR(c*d*a*f/(a^2*f^2))
!x(1)=-i*SQR(c*d*a*f)/(-a*f),x(2)=i*SQR(c*d*a*f)/(-a*f)
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 and="" b=""><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 !【３】判別式分岐へ

03000 !【３】判別式分岐
03100 LET D=b^2-4*a*c !D＝平方数
03200 IF D>0 THEN GOTO 04000 !【４】実数解のときの平方数分岐
03250 IF D=0 THEN GOTO 04300
03300 IF D<0 THEN GOTO 03400
03400 LET D=-D
03500 GOTO 08000!【８】虚数解のときの分岐


04000 !【４】実数解のときの平方数分岐
04100 IF INT(SQR(D))=SQR(D) THEN GOTO 05000!【５】!実数解のときのD＝平方数のときの解
04200 IF INT(SQR(D))><sqr(d) br="" goto="" then="">04300 IF INT(b/GCD(b,2*a))><int(2*a a="" and=""><1 THEN GOTO 04500
04400 IF INT(b/GCD(b,2*a))=INT(2*a/GCD(b,2*a)) OR 2*a/GCD(b,2*a)=1 THEN GOTO 04700
04500 PRINT "x=";-b/GCD(b,2*a);"/";2*a/GCD(b,2*a);"(重解)"
04600 GOTO 20000
04700 PRINT "x=";-b/2/a;"(重解)"
04800 GOTO 20000

05000 !【５】実数解のときのD＝平方数のときの解
05100 LET x(1)=(-b-SQR(D))/(2*a)
05200 LET x(2)=(-b+SQR(D))/(2*a)
05300 PRINT "x(1)=";x(1)
05400 PRINT "x(2)=";x(2)
05500 GOTO 20000 !ENDへ

06000 !【６】実数解のときのD≠平方数のときの分岐
06100 FOR i=INT(SQR(D)) TO 1 STEP -1
06300 IF FP( D/(i^2))><0 THEN GOTO 06900 !iの探索を行うループ
06400 IF FP( D/(i^2))=0 THEN GOTO 06500 !除数分岐へ
!06410 IF i=GCD(2*a,i) THEN GOTO 06450
!06420 IF i><gcd(2*a,i) 06500="" br="" goto="" then=""> !06450 PRINT "x(1)=";-b/GCD(2*a,b);"/";2*a/GCD(2*a,b);"-";"√";D/(i^2);"/";(2*a)/i
!06460 PRINT "x(2)=";-b/GCD(2*a,b);"/";2*a/GCD(2*a,b);"+";"√";D/(i^2);"/";(2*a)/i
!06470 PRINT "⇔"
!06480 GOTO 06900
06500 PRINT "x(1)=";-b/GCD(2*a,b);"/";2*a/GCD(2*a,b);"-";i/GCD(2*a,i);"/";(2*a)/GCD(2*a,i);"√";D/(i^2)
06600 PRINT "x(2)=";-b/GCD(2*a,b);"/";2*a/GCD(2*a,b);"+";i/GCD(2*a,i);"/";(2*a)/GCD(2*a,i);"√";D/(i^2)
06700 PRINT "⇔"
06900 NEXT i
07000 PRINT"これが解です。"
07100 GOTO 20000 !ENDへ

08000 !【８】虚数解のときの平方数分岐
08100 IF INT(SQR(D))=SQR(D) THEN GOTO 09000!【９】!虚数解のときの-D＝平方数のときの解
08200 IF INT(SQR(D))><sqr(d) br="" goto="" then="">
09000 !【９】虚数解のときの-D＝平方数のときの解
09100 LET x(1)=(-b-SQR(D))/(2*a)
09200 LET x(2)=(-b+SQR(D))/(2*a)
09300 PRINT "x(1)=";x(1)
09400 PRINT "x(2)=";x(2)
09500 GOTO 20000 !ENDへ

10000 !【１０】虚数解のときの-D≠平方数のときの分岐
10100 FOR i=INT(SQR(D)) TO 1 STEP -1
10300 IF FP( D/(i^2))><0 THEN GOTO 10900 !iの探索を行うループ
10400 IF FP( D/(i^2))=0 THEN GOTO 10500 !除数分岐へ
!10410 IF i=GCD(2*a,i) THEN GOTO 10450
!10420 IF i=GCD(2*a,i) THEN GOTO 10500
!10450 PRINT "x(1)=";-b/GCD(2*a,b);"/";2*a/GCD(2*a,b);"-ｉ*";"√";D/(i^2);"/";(2*a)/i
!10460 PRINT "x(2)=";-b/GCD(2*a,b);"/";2*a/GCD(2*a,b);"+ｉ*";"√";D/(i^2);"/";(2*a)/i
!10470 PRINT "⇔"
!10480 GOTO 10900
10500 PRINT "x(1)=";-b/GCD(2*a,b);"/";2*a/GCD(2*a,b);"-ｉ*";i/GCD(2*a,i);"/";(2*a)/GCD(2*a,i);"√";D/(i^2)
10600 PRINT "x(2)=";-b/GCD(2*a,b);"/";2*a/GCD(2*a,b);"+ｉ*";i/GCD(2*a,i);"/";(2*a)/GCD(2*a,i);"√";D/(i^2)
10700 PRINT "⇔"
10900 NEXT i
11000 PRINT"これが解です。"
12000 GOTO 20000 !ENDへ
13000 PRINT TIME-t0;"秒かかりました。"
14000 GOTO 20000 !ENDへ
20000 END

30000 EXTERNAL FUNCTION GCD(a,b)
30100 DO
30200 LET r=MOD(a,b)
30300 IF r=0 THEN EXIT DO
30400 LET a=b
30500 LET b=r
30600 LOOP
30700 LET GCD=b
30800 END FUNCTION

!nu 2012/01/29/06:26</sqr(d)></gcd(2*a,i)></int(2*a></sqr(d)></int(b></int(a> 		 

Re: 二次方程式の解

 投稿者：山中和義  投稿日：2012年 1月29日(日)11時04分56秒
  > No.1740[元記事へ]

nuさんへのお返事です。

整数係数の2次方程式を解くプログラムをベースに考えてみました。
a,b,c,d,e,fがP,Q,Rになるので、すっきりします。


!有理係数の2次方程式(a/d)x^2+(b/e)x+(c/f)=0、d,e,f≠0とすると、
!分母をはらって、(aef)x^2+(bdf)x+(cde)=0
!
!整数係数の2次方程式Ax^2+Bx+C=0とすると、
!　判別式D=B^2-4AC
!　解の公式より、x={-B/(2A)}±{√D/(2A)}
!となるので、
!これを適用する。

LET a=12 !12/45
LET b=23 !23/56
LET c=34 !34/67
LET d=45
LET e=56
LET f=67
LET P=a*e*f
LET Q=b*d*f
LET R=c*d*e
CALL Solve2Equ(P,Q,R)

LET a=1 !x^2-3x+2=(x-1)(x-2)
LET b=-3
LET c=2
LET d=1
LET e=1
LET f=1
LET P=a*e*f
LET Q=b*d*f
LET R=c*d*e
CALL Solve2Equ(P,Q,R)

LET A=-1 !-x^2+x+1
LET B=1
LET C=1
LET d=1
LET e=1
LET f=1
LET P=a*e*f
LET Q=b*d*f
LET R=c*d*e
CALL Solve2Equ(P,Q,R)

LET A=1 !x^2+1=(x+i)(x-i)
LET B=0
LET C=1
LET d=1
LET e=1
LET f=1
LET P=a*e*f
LET Q=b*d*f
LET R=c*d*e
CALL Solve2Equ(P,Q,R)

LET A=2 !2x^2-2=2(x+1)(x-1)
LET B=0
LET C=-2
LET d=1
LET e=1
LET f=1
LET P=a*e*f
LET Q=b*d*f
LET R=c*d*e
CALL Solve2Equ(P,Q,R)

LET A=1 !x^2-4x+4=(x-2)^2
LET B=-4
LET C=4
LET d=1
LET e=1
LET f=1
LET P=a*e*f
LET Q=b*d*f
LET R=c*d*e
CALL Solve2Equ(P,Q,R)

LET A=0 !(1/2)x+3/4
LET B=1
LET C=3
LET d=1
LET e=2
LET f=4
LET P=a*e*f
LET Q=b*d*f
LET R=c*d*e
CALL Solve2Equ(P,Q,R)

LET A=0 !2/3
LET B=0
LET C=2
LET d=1
LET e=1
LET f=3
LET P=a*e*f
LET Q=b*d*f
LET R=c*d*e
CALL Solve2Equ(P,Q,R)

END


EXTERNAL SUB Solve2Equ(A,B,C) !整数係数の2次方程式Ax^2+Bx+C=0を解く
IF A=0 THEN !1次方程式 Bx+C=0
   IF B=0 THEN !C=0
      PRINT "方程式が成立しません。"; A;B;C
   ELSE
      PRINT "x= ";
      CALL RtPrint(-C,B) !x=-C/B
      PRINT
   END IF

ELSE
   PRINT "x= ";

   LET D=B^2-4*A*C !判別式　※平方根の中
   CALL SqNormalize(ABS(D),P,Q) !√D=P√Qと変形する
   IF D>0 AND Q=1 THEN !平方根の中が平方数なら、m形
      CALL RtPrint(-B-P,2*A) !1つの有理数解 x=(-B-P)/(2*A)
      PRINT ", ";
      CALL RtPrint(-B+P,2*A) !もう1つの有理数解 x=(-B+P)/(2*A)

   ELSE !m±√n形
      IF D=0 THEN !判別式D=0なら
         CALL RtPrint(-B,2*A)
         PRINT "（重根）";
      ELSE
         IF B<>0 THEN CALL RtPrint(-B,2*A) !有理数部（実部）-B/(2*A)

         PRINT "± ";

         LET S=P !平方根部（虚部）P√Q
         LET T=2*A
         CALL RtNormalize(S,T)

         IF D<0 THEN
            PRINT "i "; !虚数単位
            IF NOT(S=1 AND T=1 AND Q=1) THEN PRINT "* "; !虚数単位
         END IF

         IF S>1 THEN PRINT S; !１サプレス
         IF Q>1 THEN PRINT "√("; Q; ") ";
         IF T>1 THEN PRINT "/"; T; !１サプレス

      END IF

   END IF
   PRINT

END IF
END SUB


EXTERNAL SUB SqNormalize(n, p,q) !平方根の中をできるだけ小さな正の整数に直す
!※n=p^2*q、n,p,q≧0とすると、SQR(n)=p*SQR(q)と変形できる。
LET q=1 !※SQR(0)=0*SQR(1)とする　※n=0なら、１行下のFOR文でp=0は設定される
FOR p=INT(SQR(n)) TO 1 STEP -1 !約数p^2の候補を大きい方から
   LET q=n/p^2
   IF q=INT(q) THEN EXIT FOR !qは自然数より
NEXT p
END SUB


EXTERNAL SUB RtNormalize(U,V) !分数U/Vを既約分数U'/V'にする　※符号は分子へ
IF V<0 THEN !符号は分子へ
   LET U=-U
   LET V=-V
END IF
LET G=gcd(ABS(U),V)
LET U=U/G
LET V=V/G
END SUB


EXTERNAL SUB RtPrint(U,V) !分数U/Vを既約分数として表示する
CALL RtNormalize(U,V)
PRINT U;
IF V>1 THEN PRINT "/"; V; !１サプレス
END SUB


EXTERNAL FUNCTION gcd(a,b) !最大公約数
DO UNTIL b=0
   LET t=b
   LET b=MOD(a,b)
   LET a=t
LOOP
LET gcd=a
END FUNCTION
 		 

Re: 二次方程式の解

 投稿者：nuﾒｰﾙ  投稿日：2012年 1月29日(日)17時29分3秒
  > No.1743[元記事へ]

山中和義さんへのお返事です。

山中和義　様

お便りいただきありがとうございます。
今度、拡張にも挑戦したいです。
Mathematicaに触発されて、こういうプログラムはないかなと思って組んだ次第です。
お体に気をつけて、これからもご指導ください。

un 		 

戻る