'===========================================================================
' Subject: RATIONAL EQUIVALENT (REVISED)     Date: 06-11-99 (17:03)       
' Author:  Donald R. Darden                  Code: PB                     
' Origin:  oldefoxx@earthlink.net          Packet: ALGOR.ABC
'===========================================================================
$option cntlbreak
DEFDBL A-Z
COLOR 15,1
CLS
?
?"                RATIONAL.BAS (revised)  By Donald R. Darden
?"         Original Copyright Nov 11, 1976 (HP25 Calculator version)
?"     Copyright September 9, 1991, June 1999 (IBM Compatable PC version)
?"     Offered as FREEWARE on the following conditions:
?"     a.  That embedded algorythm and/or process included are both
?"           credited to the author (a little recognition, please).
?"     b.  That I am informed where and how this proved applicable.
?"     c.  Any ideas for improvements are shared publicly.
?"========================================================================
?" The purpose of this program is to determine a rational equivalent of any
?" entered real number (such as 3.1415926539...).  The program will proceed
?" through a series of approximations, attempting to narrow the range of
?" error until an acceptable limit of error is reached.  This process
?" involves approximations based on the relationship between the unresol-
?" ved portion of the whole number and the fractional part that remains.
?"========================================================================
?" Comment:  It is interesting to note that the hint that this algorythm
?" could be derived came during an investigation into the possible integers
?" to approximate PI, which is best achieved by 355/113 which is accurate to
?" six decimal places.  It was noted that .25 was 1/4, and 4 is the result of
?" taking the reciprocal (1/.25=4).  Also .333333... was 3 after 1/.33333,
?" and a more advanced example of converting .666666... should provide 2/3.
?" The pivotable behavior around the decimal point on taking reciprocals
?" became the key to the algorythm being used here.
?"Press any key to continue...";
sleep
cls
?
?" Revisons, dated June 10, 1999:
?
?"1.  Addition of function PRIMES$() a routine to find the prime multiples for
?"    a real integer.
?
?"2.  Calls to PRIMES$() to idenfify common primes in the numerator and the
?"    denominator so that the expression a/b=c is reduced to smallest factor.
?
?"3.  Use of reduced factors to prevent redundant results from appearing on
?"    the screen.
?
?"4.  Option to show results as factors involving primes (this is selected and
?"    deselected (toggled) by entering an exclamation point (!) when asked for
?"    the next number to rationalize).
?
?" Your input can be terminated by just using the Enter key alone or entering
?" any nonnumeric text.  Note that the function PRIME$() may find applications
?" other than in this program.
locate 25,1
?"Press any key to continue... ";
sleep
do
loop while inkey$>""
cls
$if 0

  I now wonder if there is other pivotable behaviour, say in deducing what
  the private encryption key might be after decrypting an encrypted message
  that was created with a public key.  Of course that is a far more extreme
  case.  But consider this program that I developed, which is somewhat
  difficult do describe in mathematical terms, since it involves such
  unconventional methods, such as using INT and FRAC, partial values, and
  conditional flow which do not lend themselves to a simple expression.

  So perhaps our present limitation in trying to find the primes to an
  encryption process is due more to our inability to conceptualize a method
  that works with just the tools that we've learned, rather than creating
  tools that capitalize on the nature of the problem and its inherant
  one-ness with itself.
                                                        -- Don Darden
$endif

DOit:
PRINT
INPUT "What Number to Rationalize: ", a$
a$=trim$(a$)
if left$(a$,1)="!" then
  showprimes=not showprimes
  a$=trim$(mid$(a$,2))
  if a$="" then goto doit
end if
if a$="" or val(a$)=0 then
  ?"Done!"
  end
end if
r0 = VAL(a$)
a = INSTR(a$, ".")
r9 = LEN(a$) - a
IF r9 < 6 THEN r9 = 4
r9 = INT(10 ^ (r9 + 2) + .5)
IF r0 = 0 THEN
  ?"This number cannot be rationalized"
  GOTO DOit
END IF
r1 = 1 / r0
r5 = 1
if showprimes then ?"(PRIME) ";
?"Expression = Value:"; TAB(55); "Amount of Error:"
hr4=-1
hr7=-1
DO
  r5 = r1 * r5
  r2 = 1 / r1
  r1 = r2 - INT(r2)
  IF r1 = 0 THEN r1 = 1
  r3 = r2 / r1
  r5 = r5 * r3
  r4 = INT(r5)
  r7 = INT(r4 * r0 + .5)
  pr4$=PRIMES$(r4)
  pr7$=PRIMES$(r7)
  a=1
  do  'eliminate matching primes from numerator and denominator
    b=instr(a+1,pr7$,"*")
    if b=0 then exit do
    a$=mid$(pr7$,a,b-a+1)
    c=instr(pr4$,a$)
    if c then
      pr7$=left$(pr7$,a)+mid$(pr7$,b+1)
      pr4$=left$(pr4$,c)+mid$(pr4$,c+len(a$))
    else
      a=b
    end if
  loop
  r4=1
  a=1
  do
    b=instr(a+1,pr4$,"*")
    if b=0 then exit do
    r4=r4*val(mid$(pr4$,a+1,b-a-1))
    a=b
  loop
  r7=1
  a=1
  do
    b=instr(a+1,pr7$,"*")
    if b=0 then exit do
    r7=r7*val(mid$(pr7$,a+1,b-a-1))
    a=b
  loop
  r6 = r7 / r4 - r0
  r8 = INT(r6 * 100000000)
  if hr4=r4 and hr7=r7 then iterate do
  hr7=r7
  hr4=r4
  a$=str$(r6)
  a = INSTR(2, a$, "-")
  IF a THEN
    a$ = LEFT$(a$,1)+LEFT$(".00000000000000",VAL(MID$(a$, a+1)))+MID$(a$,2,1) + MID$(a$, 4, a - 5)
  END IF
  if showprimes then
    mid$(pr4$,1)="("
    mid$(pr4$,len(pr4$))=")"
    mid$(pr7$,1)="("
    mid$(pr7$,len(pr7$))=")"
    ?pr7$" / "pr4$" = "r7/r4 tab(55)a$
  else
    ?r7; "/"; r4; "="; r7 / r4; TAB(55); a$
  end if
LOOP WHILE r8
GOTO DOit

function primes(number as double)static as string
dim ad as double, bd as double
ad=int(number)
a$="*1*"
if ad and ad=number then
  do
    for bd=2 to sqr(ad)
      if (ad mod bd)=0 then
        a$=a$+ltrim$(str$(bd))+"*"
        ad=ad/bd
        iterate do
      end if
      select case bd mod 4
      case 0
        decr bd,2
      case 1,3
        incr bd
      end select
    next
    a$=a$+ltrim$(str$(ad))+"*"
    exit do
  loop
  replace "*0*" with "*1*" in a$
end if
function=a$
end function