Formula Solver 1.4 1/

 BBS: Inland Empire Archive
Date: 03-19-93 (21:00)             Number: 368
From: QUINN TYLER JACKSON          Refer#: NONE
  To: ALL                           Recvd: NO  
Subj: Formula Solver 1.4    1/       Conf: (2) Quik_Bas

________O_/________________________| SNIP |______________________\_O_______
        O \                        | HERE |                      / O
'This file created by PostIt! v4.0.
'>>> Start of page 1.

 '     THE                                *                  RDF14.BAS
 '  JACK MACK                            *
 '  RECURSIVE                           * ***    *     *
 '   DESCENT                           *     *     * *
 '  ALGEBRAIC       ******             *     *     * *
 '   FORMULA            *               `****'   *     *
 '     AND             **      ***************************************
 '  DEFINABLE            *    *
 '  FUNCTIONS            *   *
 '   ENGINE         *****'  *         *              *
 '                         *         *                *
 '        *               *         *                  *
 '       * *             *         *    5(100-x+2b)     *   *     *
 '      *   *           *          *                    *   *     *
 '           *         *           *   *************    *   *     *
 '            *       *            *                    *   `******
 '             *     *             *       3!+35y       *         *
 '              *   *               *                  *          *
 '               * *                 *                *      `****'
 '  v1.4          *                   *              *
 '              Public Domain Code Written By Quinn Tyler Jackson
 '
 '
 '           *                        *                           *
 '            ****************************************************
 '            *ALL FUTURE VERSIONS WILL LOSE QBASIC COMPATIBILITY*
 '          ***     AND WILL ADOPT PDS/VBDOS EXTENSIONS, SO      ***
 '            *           GRAB THIS ONE WHILE YOU CAN!           *
 '            ****************************************************
 '           *                        *                           *
 '
 '
 ' DEDICATION:
 '
 ' This program is dedicated to my wife Laleh, and our three children,
 '  Ozra, Shahraam, and Arehzou, who give up a lot of their time with
 '           me so I can program at this infernal keyboard!
 '
 ' The superlative, full-featured equation solver, featuring:
 '
 '  1. STANDARD AND ADVANCED OPERATORS
 '  2. STANDARD PRECEDENCE SOLVING ALGORITHM
 '  3. ASSIGNABLE VARIABLES WITH DESCRIPTIVE NAMES
 '  4. NEW TO VERSION 1.4!!!!  Function definition!
 '
 '  I've supplied the module, you figure it out!

DECLARE FUNCTION funSolveEquation! (InText$)
DECLARE FUNCTION fqjEval! (InText$)
DECLARE FUNCTION fqjVAL! (InText$)
DECLARE FUNCTION fqjFetchVar! (VarName$)
DECLARE FUNCTION fqjInList% (OpTyp$, Op$)
DECLARE FUNCTION fqjSolveFormula! (InToken$)
DECLARE FUNCTION fqjEvalErrMsg$ ()
DECLARE FUNCTION fqjEvaluate! (InText$)
DECLARE SUB sjfParse (Word$(), Txt$, Spt$, WordNum%)
DECLARE SUB sqjApplyOp (Op$, x!, y!)
DECLARE SUB sqjAssignFun (FunctName$, Formula$, Protection%)
DECLARE SUB sqjAssignVar (VarName$, VarValue!, Protection%)
DECLARE SUB sqjDesParse (Phase%, x!)
DECLARE SUB sqjGetToken ()

CONST TRUE = -1
CONST FALSE = NOT TRUE

CONST ASSIGNMENT = ":="     ' This can be changed to suit your needs
                            ' Using a simple = is possible, since
' logical
                            ' equality is a double == with this parser,
                            ' but the PASCAL standard := is easier to
' deal
                            ' with as an assignment operator for some.

' Operator classes                PRECEDENCE
'---------------------------------------------------
CONST POWER = "^}?**>><<!`#"       ' FIRST
CONST MULTDIV = "*/\%"             ' SECOND
CONST ADDSUB = "+-"                ' THIRD
CONST LOGICAL = "&|=~<=<>==>"      ' FOURTH
CONST UNARY = "!#`"                ' UNARY operators


DIM SHARED WHITESPACE AS STRING
DIM SHARED OPERATOR AS STRING

CONST OperatorClass = 1
CONST DigitClass = 2
CONST FunctionClass = 3

CONST MAXLEVELS = 10    ' Numbers of levels of nesting allowed
CONST MAXCOMMANDS = 10  ' Number of commands per statement
CONST MAXPARAMS = 10    ' Number of parameters in a function allowed
CONST SYMMAX = 200      ' Total number of symbols allowed
CONST VARMAX = 100      ' Total number of variables allowed
CONST FUNMAX = 100      ' Total number of definable functions allowed
CONST SYSMAX = 25

TYPE SymbolTableType
        SymName AS STRING * 30  ' Name of the symbol
        SymLvl AS INTEGER       ' Level that it was assigned
        SymType AS INTEGER      ' Whether it is a variable or function
        TabPtr AS INTEGER       ' Ptr to data tables
END TYPE

' Used by SymType
CONST SymVARIABLE = 0
CONST SymFUNCTION = 1

CONST PROTECTED = -1
CONST UNPROTECTED = 1

DIM SHARED ErrorCode AS INTEGER
DIM SHARED WarningCode AS INTEGER
' Error code constants
CONST eqjDivisionByZero = 1
CONST eqjProtectedFunction = 2
CONST eqjProtectedVariable = 3
CONST eqjSymbolTableFull = 4
CONST eqjVariableTableFull = 5
CONST eqjFucntionTableFull = 6
CONST eqjMismatchedParenthesis = 7
CONST eqjUndefinedVariable = 8
CONST eqjFunctionDefaultUsed = 9
CONST eqjSyntaxError = 10

' Variables global to this module...
DIM SHARED SymTable(SYMMAX) AS SymbolTableType  ' Table holds symbols
DIM SHARED VarTable(VARMAX) AS SINGLE           ' Table hold variable_
 data
DIM SHARED ParTable(FUNMAX) AS STRING   ' Table holds function_
 parameters
DIM SHARED ForTable(FUNMAX) AS STRING   ' Table holds function formulas
DIM SHARED SysTable(SYSMAX) AS STRING

DIM SHARED SymPtr AS INTEGER    ' Points to highest symbol in table
DIM SHARED VariPtr AS INTEGER   ' Points to highest variable in table
DIM SHARED FunPtr AS INTEGER    ' Points to highest function in table
DIM SHARED LvlPtr AS INTEGER    ' Indicates the current level being
                                ' evaluated
>>> Continued to next message

 * OLX 2.1 TD * A program is just a big bug that happened to work....

--- Maximus/2 2.01wb