'       [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


 

              < Ｈｏｍｅ >