'===========================================================================
' Subject: STRING NUMBER CALC LIBRARY         Date: 04-10-00 (11:22)       
'  Author: Andreas van Cranenburgh            Code: QB, QBasic, PDS        
'  Origin: andreaswolf@mail.com             Packet: MISC.ABC
'===========================================================================
'String-Number library                    By Andreas van Cranenburgh (C) 2000
'    Mail any suggestions and bug reports to andreaswolf@mail.com
'You can calculate with numbers of upto 32767 digits (limit of a string).
'The code is sometimes very inefficient and buggy so don't expect too much.
'Things that seem to work:
' o Addition
' o Substraction
' o (integer) Powers
' o Multiplication
' o Faculty
'Things that need work:
' o (integer) Division (it works correct but it is VERY slow)
' o Modulus (same)
'Things that I do not know how to make:
' o Square root  (yes, I can think of something very inefficient)
'Things that will NOT be implented:
' o Floating point
'Zero is returned as "". Error checking is done but it is not possible to check
'what error occured.
DEFINT A-Z                              'All variables are assumed to be integers.
DECLARE SUB NumTrim (Num$)              'Delete spaces and excess of zeros in a number.
DECLARE FUNCTION StrAdd$ (Num1$, Num2$) 'Add two numbers.
DECLARE FUNCTION StrSub$ (Num1$, Num2$) 'Subtract two numbers.
DECLARE FUNCTION StrMul$ (Num1$, Num2$) 'Multiplicate two numbers.
DECLARE FUNCTION StrDiv$ (Num1$, Num2$) 'Divide two numbers
DECLARE FUNCTION StrPwr$ (Num1$, Num2$) 'Raise Num1$ to the power of Num2$
DECLARE FUNCTION StrMod$ (Num1$, Num2$) 'Modulus of Num1$ and Num2$
DECLARE FUNCTION StrFac$ (Fac$)         'Returns faculty of a number
DECLARE FUNCTION StrSmaller (Num1$, Num2$) 'Is first one smaller than last one?
DECLARE FUNCTION StrGreater (Num1$, Num2$) 'Is first one greater than last one?
DECLARE FUNCTION Faculty# (Num)         'Returns faculty (a maximum of 171)
DECLARE FUNCTION Min (Num1, Num2)       'Returns lowest number of two numbers.
DECLARE FUNCTION Max (Num1, Num2)       'Returns highest number of two numbers.
'-Í=ð=Í-Í=ð=Í-Í=ð=Í-DEMO STARTS HEREð=Í-Í=ð=Í-Í=ð=Í-Í=ð=Í-Í=ð=Í-Í=ð=Í-Í=ð=Í-ÍON ERROR GOTO Handler                   'To trap division by zero
CLS                                     'Clear screen
INPUT "Enter first number: ", Num1$
INPUT "Enter second number: ", Num2$
NumTrim Num1$
NumTrim Num2$
OldNum1$ = Num1$
OldNum2$ = Num2$
PRINT "               ", "StrNum:", "QuickBasic:"
PRINT "Sum:           ", StrAdd$(Num1$, Num2$), LTRIM$(STR$(VAL(Num1$) + VAL(Num2$)))
PRINT "Difference:    ", StrSub$(Num1$, Num2$), LTRIM$(STR$(VAL(Num1$) - VAL(Num2$)))
PRINT "Product:       ", StrMul$(Num1$, Num2$), LTRIM$(STR$(VAL(Num1$) * VAL(Num2$)))
PRINT "Quotient (INT):", StrDiv$(Num1$, Num2$), LTRIM$(STR$(VAL(Num1$) \ VAL(Num2$)))
PRINT "Modulus:       ", StrMod$(Num1$, Num2$), LTRIM$(STR$(VAL(Num1$) MOD VAL(Num2$)))
PRINT "Power:         ", StrPwr$(Num1$, Num2$), LTRIM$(STR$(VAL(Num1$) ^ VAL(Num2$)))
PRINT "Calculate faculty? [Y,N] ";
DO                                  'Poll keyboard until right answer is given
  k$ = INKEY$
LOOP UNTIL UCASE$(k$) = "Y" OR UCASE$(k$) = "N"
PRINT k$;
LOCATE , 1
PRINT "Faculty (of first number):",
t! = TIMER
a$ = StrFac$(Num1$)
t! = TIMER - t!         'Calculate time needed to calculate faculty
PRINT a$,
IF VAL(Num1$) < 171 THEN          '171 is the maximum, any higher will cause overflow
  PRINT LTRIM$(STR$(Faculty#(VAL(Num1$))))
END IF
PRINT "Calculated in "; t!; "seconds"
FOR a = LEN(a$) TO 1 STEP -1
  IF MID$(a$, a, 1) <> "0" THEN EXIT FOR
NEXT a
PRINT LEN(a$) - a; "zero's in faculty"
PRINT "Write to file? [Y,N] ";
DO                                  'Poll keyboard until right answer is given
  k$ = INKEY$
LOOP UNTIL UCASE$(k$) = "Y" OR UCASE$(k$) = "N"
PRINT k$
IF UCASE$(k$) = "Y" THEN
  INPUT "Enter file: "; File$
  OPEN File$ FOR OUTPUT AS #1        'First write some shameless selfpromotion...
  PRINT #1, "The factorial of "; Num1$; " calulated by Andreas van Cranenburgh's StrNum"
  PRINT #1,
  PRINT #1, a$
  CLOSE #1
END IF
END
Handler:                'Error handler to make sure program doesn't end after
RESUME NEXT             'a division by zero
'-Í=ð=Í-Í=ð=Í-Í=ð=Í-DEMO ENDS HERE-=ð=Í-Í=ð=Í-Í=ð=Í-Í=ð=Í-Í=ð=Í-Í=ð=Í-Í=ð=Í-Í
FUNCTION Faculty# (Num)
'Calculate faculty without recursion
IF Num = 0 OR Num = 1 THEN
  Faculty# = 1
  EXIT FUNCTION
END IF
b# = 1
FOR a = 2 TO Num
  b# = b# * a
NEXT a
Faculty# = b#
END FUNCTION

FUNCTION Max (Num1, Num2)
IF Num1 > Num2 THEN Max = Num1 ELSE Max = Num2
END FUNCTION

FUNCTION Min (Num1, Num2)
IF Num1 < Num2 THEN Min = Num1 ELSE Min = Num2
END FUNCTION


SUB NumTrim (Num$)
'Delete excess of spaces and zero's from string number
FOR a = 1 TO LEN(Num$)
  IF MID$(Num$, a, 1) <> "0" AND MID$(Num$, a, 1) <> CHR$(0) THEN EXIT FOR
NEXT a
Num$ = MID$(Num$, a)
FOR a = LEN(Num$) TO 1 STEP -1
  IF MID$(Num$, a, 1) <> CHR$(0) THEN EXIT FOR
NEXT a
Num$ = LEFT$(Num$, a)
END SUB

FUNCTION StrAdd$ (Num1$, Num2$)
DIM Keep                'Holds values to be transported to next digit
DIM OutNum$             'Holds the result
DIM Swapped             'True if variables were swapped (need to be swapped again)
NumTrim Num1$
NumTrim Num2$
IF LEFT$(Num1$, 1) = "-" AND LEFT$(Num2$, 1) <> "-" THEN      ' -a + b = b -a
  StrAdd$ = StrSub$(Num2$, MID$(Num1$, 2))
  EXIT FUNCTION
END IF

IF LEFT$(Num1$, 1) <> "-" AND LEFT$(Num2$, 1) = "-" THEN      ' a + -b = b - a
  StrAdd$ = "-" + StrSub$(MID$(Num2$, 2), Num1$)
  EXIT FUNCTION
END IF

IF LEFT$(Num1$, 1) = "-" AND LEFT$(Num2$, 1) = "-" THEN       ' -a + -b = -(a+b)
  Num1$ = MID$(Num1$, 2)
  Num2$ = MID$(Num2$, 2)
  SignDel = -1
  Sign$ = "-"
END IF

IF LEN(Num1$) < LEN(Num2$) THEN
  OutNum$ = STRING$(LEN(Num2$) - LEN(Num1$), "0") + Num2$
  Num1$ = STRING$(2 * (LEN(Num2$) - LEN(Num1$)), 48) + Num1$
ELSE
  Swapped = -1
  SWAP Num1$, Num2$
  Num1$ = STRING$(LEN(Num2$) - LEN(Num1$) + 1, 48) + Num1$
  OutNum$ = "0" + Num2$
END IF
FOR a = LEN(Num1$) TO 1 STEP -1
  OutCome = (ASC(MID$(Num1$, a, 1)) - 48) + (ASC(MID$(OutNum$, a, 1)) - 48) + Keep
  IF OutCome > 9 THEN
    Keep = OutCome \ 10             'the excess
    OutCome = OutCome MOD 10        'the rest
  ELSE
    Keep = 0
  END IF
  IF OutCome >= 0 AND OutCome <= 9 THEN MID$(OutNum$, a, 1) = CHR$(OutCome + 48)
NEXT a
IF Swapped THEN SWAP Num1$, Num2$
IF SignDel THEN
  Num1$ = "-" + Num1$
  Num2$ = "-" + Num2$
END IF
NumTrim OutNum$
StrAdd$ = Sign$ + OutNum$
END FUNCTION

FUNCTION StrDiv$ (Num1$, Num2$)
'Perform integer division
NumTrim Num1$
NumTrim Num2$
IF Num2$ = "" THEN EXIT FUNCTION             'Division by zero....

IF LEFT$(Num1$, 1) = "-" AND LEFT$(Num2$, 1) <> "-" THEN    ' -a * b = -(a * b)
  Sign$ = "-"
  Num1$ = MID$(Num1$, 2)
  SignDel = 1
END IF

IF LEFT$(Num2$, 1) = "-" AND LEFT$(Num1$, 1) <> "-" THEN    ' a * -b = -(a * b)
  Sign$ = "-"
  Num2$ = MID$(Num2$, 2)
  SignDel = 2
END IF

IF LEFT$(Num1$, 1) = "-" AND LEFT$(Num2$, 1) = "-" THEN    ' -a * -b = a * b
  Num1$ = MID$(Num1$, 2)
  Num2$ = MID$(Num2$, 2)
  SignDel = 3
END IF

IF Num2$ = "1" THEN                          'Division by one
  StrDiv$ = Num1$
  EXIT FUNCTION
END IF
IF Num2$ = Num1$ THEN                        'Division by itself
  StrDiv$ = "1"
  EXIT FUNCTION
END IF
IF StrSmaller(Num1$, Num2$) THEN             'This is an integer division!
  StrDiv$ = "0"
  EXIT FUNCTION
END IF
OutNum$ = "1" + STRING$(LEN(Num1$) - LEN(Num2$), "0")
OutTest$ = StrMul$(Num2$, OutNum$)
DO
  OutTest$ = StrAdd$(OutTest$, Num2$)
  IF StrGreater(OutTest$, Num1$) THEN
    StrDiv$ = Sign$ + OutNum$
    SELECT CASE SignDel
    CASE 1
      Num1$ = "-" + Num1$
    CASE 2
      Num2$ = "-" + Num2$
    CASE 3
      Num1$ = "-" + Num1$
      Num2$ = "-" + Num2$
    END SELECT
    EXIT FUNCTION
  END IF
  OutNum$ = StrAdd$(OutNum$, "1")
  LOCATE , 30
  PRINT OutNum$;
LOOP
'Program shouldn't reach this point.
END FUNCTION

FUNCTION StrFac$ (Fac$)
'Returns faculty of Fac
NumTrim Fac$
IF StrSmaller(Fac$, "0") THEN EXIT FUNCTION
IF Fac$ = "" OR Fac$ = "1" THEN
  StrFac$ = "1"
  EXIT FUNCTION
END IF
OutCome$ = "1"
p = POS(0)
Counter$ = "2"
IF LEN(Fac$) < 17 THEN
  Fac# = VAL(Fac$)                   'This method is WAY faster...
  FOR a# = 2 TO Fac#
    OutCome$ = StrMul$(OutCome$, LTRIM$(STR$(a#)))
    LOCATE , p                      '***remove***
    COLOR 23, 0: PRINT "Faculty: "; '***remove***
    COLOR 15, 0: PRINT a#;    '***remove***
  NEXT a#
ELSE
  DO
    OutCome$ = StrMul$(OutCome$, Counter$)
    LOCATE , p                      '***remove***
    COLOR 23, 0: PRINT "Faculty: "; '***remove***
    COLOR 15, 0: PRINT Counter$;    '***remove***
    Counter$ = StrAdd$(Counter$, "1")
  LOOP UNTIL Counter$ = StrAdd$(Fac$, "1")
END IF
LOCATE , p                        '***remove***
PRINT "               ";          '***remove***
LOCATE , p                        '***remove***
NumTrim OutCome$
StrFac$ = OutCome$
END FUNCTION

FUNCTION StrGreater (Num1$, Num2$)
'Returns true if Num1$ is greater than Num2$
NumTrim Num1$
NumTrim Num2$
IF LEFT$(Num1$, 1) = "-" AND LEFT$(Num2$, 1) <> "-" THEN      ' -a + b = b -a
  StrGreater = 0
  EXIT FUNCTION
END IF

IF LEFT$(Num1$, 1) <> "-" AND LEFT$(Num2$, 1) = "-" THEN      ' a + -b = b - a
  StrGreater = -1
  EXIT FUNCTION
END IF

IF Num1$ = Num2$ THEN
  EXIT FUNCTION                             'Useless to test
ELSEIF LEN(Num1$) > LEN(Num2$) THEN         'Also
  StrGreater = -1
  EXIT FUNCTION
ELSEIF LEN(Num1$) < LEN(Num2$) THEN         'Also
  StrGreater = 0
  EXIT FUNCTION
ELSEIF LEN(Num1$) = LEN(Num2$) THEN         'Here begins the real work
  FOR a = 1 TO LEN(Num1$)
    IF ASC(MID$(Num1$, a, 1)) > ASC(MID$(Num2$, a, 1)) THEN
      StrGreater = -1
      EXIT FUNCTION
    ELSEIF ASC(MID$(Num1$, a, 1)) < ASC(MID$(Num2$, a, 1)) THEN
      StrGreater = 0
      EXIT FUNCTION
    END IF
  NEXT a
END IF
'Program shouldn't reach this point.
END FUNCTION


FUNCTION StrMod$ (Num1$, Num2$)
'Modulus (remainder of an integer division)
NumTrim Num1$
NumTrim Num2$
IF Num2$ = "" THEN EXIT FUNCTION             'Division by zero....
IF Num2$ = "1" THEN                          'Division by one
  StrMod$ = "0"
  EXIT FUNCTION
END IF
IF Num2$ = Num1$ THEN                        'Division by itself
  StrMod$ = "0"
  EXIT FUNCTION
END IF
IF StrSmaller(Num1$, Num2$) THEN             'Faster
  StrMod$ = Num1$
  EXIT FUNCTION
END IF
'VERY inefficient but I needed something that worked....
StrMod$ = StrSub$(Num1$, StrMul$(StrDiv$(Num1$, Num2$), Num2$))
'Program shouldn't reach this point.
END FUNCTION

FUNCTION StrMul$ (Num1$, Num2$)
DIM Keep                'Holds values to be transported to next digit
DIM OutNum$             'Holds the result
DIM OutStep$            'Holds eaqch step of the result
NumTrim Num1$
NumTrim Num2$
IF Num1$ = "" OR Num2$ = "" THEN EXIT FUNCTION          'Zero...

IF LEFT$(Num1$, 1) = "-" AND LEFT$(Num2$, 1) <> "-" THEN    ' -a * b = -(a * b)
  Sign$ = "-"
  Num1$ = MID$(Num1$, 2)
  SignDel = 1
END IF

IF LEFT$(Num2$, 1) = "-" AND LEFT$(Num1$, 1) <> "-" THEN    ' a * -b = -(a * b)
  Sign$ = "-"
  Num2$ = MID$(Num2$, 2)
  SignDel = 2
END IF

IF LEFT$(Num1$, 1) = "-" AND LEFT$(Num2$, 1) = "-" THEN    ' -a * -b = a * b
  Num1$ = MID$(Num1$, 2)
  Num2$ = MID$(Num2$, 2)
  SignDel = 3
END IF

FOR a = LEN(Num2$) TO 1 STEP -1
  OutStep$ = STRING$(LEN(Num1$) + LEN(Num2$), "0")
  FOR b = LEN(Num1$) TO 1 STEP -1
    OutCome = (ASC(MID$(Num1$, b, 1)) - 48) * (ASC(MID$(Num2$, a, 1)) - 48)
    OutCome = OutCome + Keep
    IF OutCome > 9 THEN
      Keep = OutCome \ 10             'the excess
      OutCome = OutCome MOD 10        'the rest
    ELSE
      Keep = 0
    END IF
    IF OutCome >= 0 AND OutCome < 10 THEN MID$(OutStep$, b + a, 1) = CHR$(OutCome + 48)
  NEXT b
  IF Keep THEN
    MID$(OutStep$, b + a, 1) = CHR$(Keep + 48)
    Keep = 0
  END IF
  OutNum$ = StrAdd$(OutNum$, OutStep$)
NEXT a
NumTrim OutNum$
SELECT CASE SignDel
CASE 1
  Num1$ = "-" + Num1$
CASE 2
  Num2$ = "-" + Num2$
CASE 3
  Num1$ = "-" + Num1$
  Num2$ = "-" + Num2$
END SELECT
StrMul$ = Sign$ + OutNum$
END FUNCTION

FUNCTION StrPwr$ (Num1$, Num2$)
'Raise Num1$ to the power of Num2$. You can only raise to an integer power
'higher than zero.
TempNum$ = Num2$
OutCome$ = "1"
NumTrim Num1$
NumTrim Num2$
IF LEFT$(Num1$, 1) = "-" THEN
  Sign$ = "-"
END IF
IF LEFT$(Num2$, 1) = "-" THEN EXIT FUNCTION     'Don't know how this works...
IF Num2$ = "" THEN
  StrPwr$ = "1"
  EXIT FUNCTION
ELSEIF Num2$ = "1" THEN
  StrPwr$ = Num1$
  EXIT FUNCTION
END IF

DO
  TempNum$ = StrSub$(TempNum$, "1")
  OutCome$ = StrMul$(OutCome$, Num1$)
LOOP UNTIL TempNum$ = "0"
IF LEFT$(OutCome$, 1) = "-" THEN Sign$ = ""
StrPwr$ = Sign$ + OutCome$
END FUNCTION

FUNCTION StrSmaller (Num1$, Num2$)
'Returns true if Num1$ is smaller than Num2$
NumTrim Num1$
NumTrim Num2$
IF LEFT$(Num1$, 1) = "-" AND LEFT$(Num2$, 1) <> "-" THEN      ' -a + b = b -a
  StrSmaller = -1
  EXIT FUNCTION
END IF

IF LEFT$(Num1$, 1) <> "-" AND LEFT$(Num2$, 1) = "-" THEN      ' a + -b = b - a
  StrSmaller = 0
  EXIT FUNCTION
END IF

IF Num1$ = Num2$ THEN
  EXIT FUNCTION                             'Useless to test
ELSEIF LEN(Num1$) > LEN(Num2$) THEN         'Also
  StrSmaller = 0
  EXIT FUNCTION
ELSEIF LEN(Num1$) < LEN(Num2$) THEN         'Also
  StrSmaller = -1
  EXIT FUNCTION
ELSEIF LEN(Num1$) = LEN(Num2$) THEN         'Here begins the real work
  FOR a = 1 TO LEN(Num1$)
    IF ASC(MID$(Num1$, a, 1)) < ASC(MID$(Num2$, a, 1)) THEN
      StrSmaller = -1
      EXIT FUNCTION
    ELSEIF ASC(MID$(Num1$, a, 1)) > ASC(MID$(Num2$, a, 1)) THEN
      StrSmaller = 0
      EXIT FUNCTION
    END IF
  NEXT a
END IF
'Program shouldn't reach this point.
END FUNCTION

FUNCTION StrSub$ (Num1$, Num2$)
DIM Keep                'Holds values to be transported to next digit
DIM OutNum$             'Holds the result
NumTrim Num1$
NumTrim Num2$
IF LEFT$(Num1$, 1) = "-" AND LEFT$(Num2$, 1) <> "-" THEN      ' -a - b = -(a + b)
  StrSub$ = "-" + StrAdd$(Num2$, MID$(Num1$, 2))
  EXIT FUNCTION
END IF

IF LEFT$(Num1$, 1) <> "-" AND LEFT$(Num2$, 1) = "-" THEN      ' a - -b = a + -(b)
  StrSub$ = StrAdd$(MID$(Num2$, 2), Num1$)
  EXIT FUNCTION
END IF

IF LEFT$(Num1$, 1) = "-" AND LEFT$(Num2$, 1) = "-" THEN       ' -a - -b = -(b - a)
  SWAP Num1$, Num2$
  Swapped = -1
  Num1$ = MID$(Num1$, 2)
  Num2$ = MID$(Num2$, 2)
  SignDel = -1
END IF

IF Num1$ = "" THEN
  StrSub$ = "-" + Num2$
  EXIT FUNCTION
END IF
IF Num2$ = "" THEN
  StrSub$ = Num1$
  EXIT FUNCTION
END IF
IF Num1$ = Num2$ THEN
  StrSub$ = "0"
  IF SingDel THEN
    Num1$ = "-" + Num1$
    Num2$ = "-" + Num2$
  END IF
  EXIT FUNCTION
END IF
IF StrGreater(Num2$, Num1$) THEN
  Sign$ = "-"
  Swapped = NOT Swapped
  SWAP Num1$, Num2$
END IF
IF LEN(Num1$) < LEN(Num2$) THEN
  Num1$ = STRING$(LEN(Num2$) - LEN(Num1$) + 1, 48) + Num1$
  OutNum$ = "0" + Num2$
ELSEIF LEN(Num1$) > LEN(Num2$) THEN
  OutNum$ = STRING$(LEN(Num1$) - LEN(Num2$) + 1, 48) + Num2$
  Num1$ = "0" + Num1$
ELSE
  OutNum$ = Num2$
END IF
FOR a = LEN(Num1$) TO 1 STEP -1
  OutCome = (ASC(MID$(Num1$, a, 1)) - 48) - (ASC(MID$(OutNum$, a, 1)) - 48) - Keep
  IF OutCome < 0 THEN
    OutCome = 10 - (ASC(MID$(OutNum$, a, 1)) - 48) - Keep   'seems to work...
    Keep = -(OutCome \ 10) + 1                              'the excess
  ELSE
    Keep = 0
  END IF
  IF OutCome >= 0 AND OutCome <= 9 THEN MID$(OutNum$, a, 1) = CHR$(OutCome + 48)
NEXT a
NumTrim OutNum$
IF OutNum$ = "" THEN OutNum$ = "0"
IF Swapped THEN SWAP Num1$, Num2$
IF SignDel THEN
  Num1$ = "-" + Num1$
  Num2$ = "-" + Num2$
END IF
StrSub$ = Sign$ + OutNum$
END FUNCTION