'********************************************** '* This program allows making arithmetic * '* operations in any base between 2 and 36. * '* ------------------------------------------ * '* Ref.: "Mathematiques en Turbo-Pascal by * '* M. Ducamp and A. Reverchon (2), * '* Eyrolles, Paris, 1988" [BIBLI 05]. * '* ------------------------------------------ * '* Sample runs: * '* * '* ARITHMETIC OPERATIONS IN ANY BASE * '* BETWEEN 2 AND 36 * '* * '* Enter base (2 to 36): 25 * '* Enter 1st number : AM3G * '* * '* Enter next number: 28 * '* Operator (+-*/^) : + * '* Result : AM50 * '* Enter next number: J * '* Operator (+-*/^) : * * '* Result : 86MD6 * '* Enter next number: 2B * '* Operator (+-*/^) : / * '* Result : 39JM * '* * '* ARITHMETIC OPERATIONS IN ANY BASE * '* BETWEEN 2 AND 36 * '* * '* Enter base (2 to 36): 2 * '* Enter 1st number : 11001010 * '* * '* Enter next number: 1100 * '* Operator (+-*/^) : - * '* Result : 10111110 * '* Enter next number: 1110 * '* Operator (+-*/^) : - * '* Result : 10110000 * '* Enter next number: 10101 * '* Operator (+-*/^) : + * '* Result : 11000101 * '* Enter next number: 10 * '* Operator (+-*/^) : / * '* Result : 1100010 * '* Enter next number: 11 * '* Operator (+-*/^) : * * '* Result : 100100110 * '* * '* ARITHMETIC OPERATIONS IN ANY BASE * '* BETWEEN 2 AND 36 * '* * '* Enter base (2 to 36): 16 * '* Enter 1st number : FEAA * '* * '* Enter next number: FF * '* Operator (+-*/^) : + * '* Result : FFA9 * '* Enter next number: 1799 * '* Operator (+-*/^) : - * '* Result : E810 * '* Enter next number: 2 * '* Operator (+-*/^) : / * '* Result : 7408 * '* * '* Note: Enter null string to exit. * '* * '* Basic Release By J-P Moreau * '* (www.jpmoreau.fr) * '********************************************** 'Explanations: '------------ 'The letters A,B,...,Z represent 10,11,...,36 'in the base > 10. 'The numbers are first converted from base b to 'base 10 by Function Decodebase, then operation 'is made in base 10 and result is converted from 'base 10 to base b by Function Codebase. 'Note: assuming that a real number has a mantissa of ' 40 digits in base 2, the number of useful ' digits udg in base b is given by formula: ' udg = integer(40*log(2)/log(b)) ' b=10: udg = 12 ' b=16: udg = 10 ' b=36: udg = 7 '--------------------------------------------------- defint i-n XMAXREAL = 1E30 'ib:integer (numerical base) cls print print " ARITHMETIC OPERATIONS IN ANY BASE BETWEEN 2 AND 36" print 10 input " Enter base (2 to 36): ", ib input " Enter 1st number : ", x\$ gosub 1000 : r1=r 'Decodebase(x\$,ib,r1) if IERROR<>0 then goto 10 20 print input " Enter next number: ", x\$ if x\$<>"" then gosub 1000 : r2=r 'Decodebase(x\$,ib,r2) if IERROR=0 then input " Operator (+-*/^) : ", op\$ if op\$="+" then r1=r1+r2 if op\$="-" then r1=ABS(r1-r2) if op\$="*" then r1=r1*r2 if op\$="/" then r1=INT(r1/r2) if op\$="^" then r1=INT(EXP(r2*LOG(r1))) r=r1 : gosub 2000 'Codebase(r,ib,y\$) if IERROR=0 then print " Result : "; y\$ else print " Error in coding result." end if else print " Number not valid or decoding error." end if end if if x\$<>"" then goto 20 print END 'Convert a number x\$ from base ib to base 10. The subroutine set 'IERROR to 1 if ib not in [2..36] or if string x\$ contains invalid 'characters in base ib or if result r is too big, else IERROR=0. 'Subroutine Decodebase(x\$,ib,r) 'xmult: REAL 'ch\$:CHAR 1000 IERROR=1 if ib<2 or ib>36 then print " base must be between 2 and 36 !" return end if r=0 : xmult=1 long=len(x\$) for i=1 to long ch\$=mid\$(x\$,long+1-i,1) if ch\$<"0" or ch\$>"Z" or (ch\$>"9" and ch\$<"A") then return if ch\$<="9" then j=asc(ch\$)-asc("0") else j=asc(ch\$)-asc("A")+10 end if if j>=ib then return r=r+xmult*j if xmult>XMAXREAL/ib then return xmult=xmult*ib next i IERROR=0 Return 'Convert a number r from base 10 to base ib. The subroutine set 'IERROR to 1 if ib not in [2..36], else IERROR=0. 'Subroutine Codebase(r,ib,y\$) 2000 IERROR=1 if ib<2 or ib>36 then print " base must be between 2 and 36 !" return end if y\$="": x=r 2010 if x<=0 then goto 2020 n=INT(x-ib*INT(x/ib)) if n<10 then y\$=Chr\$(Asc("0")+n)+y\$ else y\$=Chr\$(Asc("A")+n-10)+y\$ end if x=INT(x/ib) goto 2010 2020 IERROR=0 Return 'end of file basisop.bas