加法展開のサンプルプログラムと、その使用法を挙げておく。記述言語は
Quick Basic 、MS-DOS 上で動作する。
起動する前に、展開したい式をファイルにする。エディタで作成してもよいし、下記の如く
COPY コマンドで直接生成してもよい。最後の ^Z は [CTRL]キーと[Z]キーを同時に押下して入力されるファイルエンド・コードである。
A:\>copy con pi1[c/r]
arctan(1/1)[c/r]
^Z[c/r]
A:\>type pi1[c/r]
arctan(1/1)
A:\>
プログラムに同ファイルを与えると、記述された式を逐次展開し結果を表示する。結果を別ファイルとして保存したければ
> を使用すればよい。
A:\>tenkai pi1>pi2[c/r]
A:\>type pi2[c/r]
arctan(1/2)+arctan(1/3)
A:\>tenkai pi2>pi3[c/r]
A:\>type pi3[c/r]
2arctan(1/3)+arctan(1/7)
arctan(1/2)+arctan(1/4)+arctan(1/13)
2arctan(1/2)-arctan(1/7)
arctan(1/2)+arctan(1/5)+arctan(1/8)
A:\>
'
[tenkai.bas] Kaho Tenkai routine (C)Inoguchi.K
/ 961217
'
'
arctan(1/n)=arctan(1/p)+arctan(1/q)
'
p1 = n+m
p2 = n-m
'
q1 = (n*p1+1)/(p1-n) q2 = (n*p2+1)/(p2-n)
[m=1,2,,n]
defdbl a-z
lmt=1000 :max=100 :dim x(max,1),y(max,1)
'1 =< m =< lmt
open command$ for input as #1
while not eof(1)
'=== read one line ===
line input #1,w$ :ww$=left$(w$,1)
if ww$="'" then print w$ :goto skip1
if ww$<>"+" and ww$<>"-" then w$="+"+w$
p0=1 :for w=0 to max:x(w,0)=0:x(w,1)=0:next w
for xm=0 to lmt
p1=instr(p0,w$,"a") :if p1=0 then exit for
p2=instr(p1,w$,")")
x(xm,0)=val(mid$(w$,p0+1,p1-p0-1)) :if x(xm,0)=0 then x(xm,0)=1
x(xm,1)=val(mid$(w$,p1+9,p2-p1-9))
if mid$(w$,p0,1)="-" then x(xm,0)=0-x(xm,0)
p0=p2+1
next xm :xm=xm-1
'=== main loop ===
for xn=0 to xm
n=x(xn,1)
'=== arctan(1/p)±arctan(1/q) ===
for m=1 to lmt
p1=n+m :p2=n-m
if (p1-n)<>0 then
q=(n*p1+1)/(p1-n)
'(+)
if instr(str$(q),".")=0 and abs(q)>abs(p1) then
e0=p1 :e1=q :gosub sub1
end if
end if
if (p2-n)<>0 then
q=(n*p2+1)/(p2-n)
'(-)
if instr(str$(q),".")=0 and abs(q)>abs(p2) then
e0=p2 :e1=q :gosub sub1
end if
end if
next m
next xn
skip1: wend
end
sub1: '=== matome proc.
===
for w=0 to xm :y(w,0)=x(w,0) :y(w,1)=x(w,1) :next w
y(xn+1,0)=y(xn,0) :y(xn,1)=e0 :y(xn+1,1)=e1 :bb=xm+1
if e1<0 then y(xn+1,0)=0-y(xn+1,0) :y(xn+1,1)=abs(e1)
for w=xn+1 to xm :y(w+1,0)=x(w,0) :y(w+1,1)=x(w,1) :next w
'=== sort/merge ===
for k=0 to max :c=0 :sw=0
for j=0 to bb-1
if y(j,1)=>y(j+1,1) and y(j+1,1)<>0 then
swap y(j,0),y(j+1,0) :swap y(j,1),y(j+1,1) :c=c+1
if y(j,1)=y(j+1,1) then
y(j,0)=y(j,0)+y(j+1,0) :r=1 :if y(j,0)=0 then r=2
for w=j+2-r to bb:y(w,0)=y(w+r,0):y(w,1)=y(w+r,1):next w :bb=bb-r
end if
end if
if y(j,1)<2 then sw=1 :exit for
next j :if c=0 then exit for
next k
'=== print out ===
if sw=0 then
w$=""
for k=0 to bb
if y(k,0)=>0 then w$=w$+"+" else w$=w$+"-"
if abs(y(k,0))<>1 then q$=str$(y(k,0)):w$=w$+right$(q$,len(q$)-1)
q$=str$(y(k,1)):w$=w$+"arctan(1/"+right$(q$,len(q$)-1)+")"
next k
if left$(w$,1)="+" then w$=right$(w$,len(w$)-1)
print w$
end if
return