'*  Program     LINSYS.BAS           (c) 1991, 1998   **>>  G.H. George  <<**
'=============================================================================
'  Purpose:  to help the user to solve linear systems
'                     * ONE STEP at a time *
'            by carrying out the tedious arithmetic for
'                  each elementary row operation.
'=============================================================================

'   Procedures:
'        InfoPage:  print a welcome message to the screen.
'     EnterSystem:  ask the user for the initial augmented matrix [A|b].
' SelectProcedure:  ask the user to select a row operation.
DECLARE SUB InfoPage ()
DECLARE SUB EnterSystem (Done AS INTEGER, Valid AS INTEGER, nVar%, nRows%, An&(), Ad&(), Bn&(), Bd&())
DECLARE SUB EnterFraction (Row AS INTEGER, numLong AS LONG, denLong AS LONG)
DECLARE SUB ReduceFraction (Num AS LONG, Den AS LONG)
DECLARE FUNCTION NextPrime& (Number AS LONG)
DECLARE SUB SelectProcedure (Done AS INTEGER, nVar%, nRows%, An&(), Ad&(), Bn&(), Bd&())
DECLARE SUB MultiplyRow (nVar%, nRows%, An&(), Ad&(), Bn&(), Bd&())
DECLARE SUB DivideRow (nVar%, nRows%, An&(), Ad&(), Bn&(), Bd&())
DECLARE SUB ExchangeRow (nVar%, nRows%, An&(), Ad&(), Bn&(), Bd&())
DECLARE SUB RowLinComb (nVar%, nRows%, An&(), Ad&(), Bn&(), Bd&())
DECLARE FUNCTION TooLarge% (A AS LONG, B AS LONG, C AS LONG)
DECLARE SUB Crash ()
DECLARE SUB WhichRow (ThisRow AS INTEGER, nRows AS INTEGER)
DECLARE SUB Clearlines (Upper AS INTEGER, Lower AS INTEGER)
DECLARE SUB NewMatrix (Offset AS INTEGER, nRows%, nVar%, An&(), Ad&(), Bn&(), Bd&())
DECLARE SUB PressAnyKey ()
DECLARE SUB WaitForKey (KeyPressed AS STRING)

'   Global constants:
'       True       logical true, = -1
'       False      logical false, = 0
DEFINT F, T
CONST False = 0, True = NOT False

'  Variables:
'       Done        logical variable (= true to exit loops in main program)
'      Valid        logical variable (= true iff file name is valid)
'       nVar        number of variables in the linear system
'      nRows        number of equations in the linear system
'   an&(i,j)        coefficient matrix (numerators)
'   ad&(i,j)        coefficient matrix (denominators)
'     bn&(i)        right side constants vector (numerators)
'     bd&(i)        right side constants vector (denominators)

DIM Done AS INTEGER, Valid AS INTEGER, nVar AS INTEGER, nRows AS INTEGER

' NOTE:  The comment below is needed in order to allow the four arrays
'        to be redimensioned inside the EnterSystem subprogram.
'        In this way, the use of global variables can be avoided completely.
' $DYNAMIC
DIM An&(10, 10), Ad&(10, 10), Bn&(10), Bd&(10)

CALL InfoPage
LET Done = True       ' Put flag up initially to force first pass.

DO
   CALL EnterSystem(Done, Valid, nVar, nRows, An&(), Ad&(), Bn&(), Bd&())
LOOP UNTIL Done

DO
   CALL SelectProcedure(Done, nVar, nRows, An&(), Ad&(), Bn&(), Bd&())
LOOP UNTIL Done      ' Flag up only when the user chooses to quit.

END

'---------------------------------------------------------------------------
ErrorTrap:
SELECT CASE ERR
    CASE 52, 64
        PRINT USING "Error ##: Bad file name"; ERR
    CASE 54, 58, 70
        PRINT USING "Error ##: A read-only file "; ERR;
        PRINT "may exist with the same name."
    CASE 68, 71, 72
        PRINT USING "Error ##: Disk not ready or not available."; ERR
    CASE 75, 76
        PRINT USING "Error ##: Path inaccessible or not found."; ERR
    CASE ELSE
        PRINT USING "Error ##: Unrecoverable error."; ERR
        PRINT "This program has terminated."
        SLEEP 3
        STOP
END SELECT

LET Valid = False
PRINT "Try again."
RESUME NEXT

REM $STATIC
DEFSNG F, T
SUB Clearlines (Upper AS INTEGER, Lower AS INTEGER)
'=============================================================================
' **  SUBprogram  **                 **>> (c) 1991, 1998  G.H.  George  <<**
'                      - overwrite lines  (Upper)  to  (Lower)  with spaces.
'=============================================================================

'   No procedures.

'   Parameters:
'     Upper:  upper boundary (row number) of the area of the screen to clear
'     Lower:  lower boundary (row number) of the area of the screen to clear

'   Local variable:
'       Row:  current row number being cleared
DIM Row AS INTEGER

LOCATE Upper, 1

FOR Row = Upper TO Lower     ' If Upper is below Lower, then NO rows are
   PRINT SPC(78); " "        '  blanked.
NEXT Row

LOCATE Upper, 1       ' Restore the cursor to the top of the blanked region.

END SUB

SUB Crash
'=============================================================================
' **  SUBprogram  **                       **>> (c) 1998  G.H.  George  <<**
'   Terminate execution because the numerator and/or denominator in a
'   fraction is too big to be stored as a long integer.
'=============================================================================

'   No procedures, parameters or local variables.

LOCATE 18, 34
COLOR 28, 1
PRINT "Fatal Error"
COLOR 12, 1
PRINT
PRINT "This program has terminated because part of a fraction has become ";
PRINT "too large"
PRINT "to be stored exactly (as a long integer)."
COLOR 15, 1
PRINT #1,
PRINT #1, STRING$(70, "=")
PRINT #1,
PRINT #1, "This program has terminated because part of a fraction has ";
PRINT #1, "become too large"
PRINT #1, "to be stored exactly (as a long integer)."

CLOSE
SLEEP 3
END

END SUB

DEFINT N, T
SUB DivideRow (nVar, nRows, An&(), Ad&(), Bn&(), Bd&())
'=============================================================================
' **  SUBprogram  **                 **>> (c) 1991, 1998  G.H. George  <<**
'
'           - to divide row (i) by  c  --  INPUT, validation and execution.
'=============================================================================

'   Procedures:
'    WaitForKey     pause until the user presses any key
'    ClearLines     clear text from part of the screen
'     NewMatrix     display the linear system entered by the user
'      TooLarge     guard against a product being too large for long integers
'         Crash     stop program because of unrecoverable overflow

'   Parameters:
'       nVar        number of variables in the linear system
'      nRows        number of equations in the linear system
'   An&(i,j)        coefficient matrix (numerators)
'   Ad&(i,j)        coefficient matrix (denominators)
'     Bn&(i)        right side constants vector (numerators)
'     Bd&(i)        right side constants vector (denominators)

'   Local variables:
'    ThisRow        index number of the row to be changed
'        Num        numerator of constant by which to multiply ThisRow
'        Den        denominator of constant by which to multiply ThisRow
'    QuotNum        numerator of product
'    QuotDen        denominator of product
'        Col        loop counter = current column of coefficient matrix
'      Reply        key pressed by the user

DIM ThisRow AS INTEGER, Num AS LONG, Den AS LONG
DIM QuotNum AS LONG, QuotDen AS LONG, Col AS INTEGER, Reply AS STRING

LOCATE (nRows + 2), 1
CALL WhichRow(ThisRow, nRows)

DO
   LOCATE (nRows + 3), 1
   PRINT SPC(70); " "
   LOCATE (nRows + 3), 1
   PRINT "Enter the (non-zero) number by which row"; ThisRow;
   PRINT "is to be divided:"
   CALL EnterFraction(nRows + 4, Num, Den)
LOOP UNTIL Num <> 0                       ' Zero divisor is forbidden.

CALL Clearlines(nRows + 2, nRows + 5)

LOCATE (nRows + 2), 1
PRINT "Divide row"; ThisRow; "by "; Num; "/"; Den; ":"
PRINT "Confirm or abort (C/A)? ";

DO
    CALL WaitForKey(Reply)
LOOP UNTIL Reply = "C" OR Reply = "Y" OR Reply = "A" OR Reply = "N"

CALL Clearlines(nRows + 1, 23)

IF Reply = "C" OR Reply = "Y" THEN               '  Upon confirming choice:
                                                 '  carry out division,
    PRINT #1, "Divide row"; ThisRow; "by "; Num; "/"; Den; ":"
    PRINT #1,                                '    ^--  print header to file.
   
    IF TooLarge(1, Bn&(ThisRow), Den) THEN CALL Crash
    IF TooLarge(1, Bd&(ThisRow), Num) THEN CALL Crash

    LET QuotNum = Bn&(ThisRow) * Den  ' Evaluate num of quotient for r.s.c.
    LET QuotDen = Bd&(ThisRow) * Num  '    "   denominator " "    "      "
    CALL ReduceFraction(QuotNum, QuotDen)' Reduce quotient to its lowest terms
    LET Bn&(ThisRow%) = QuotNum     ' Overwrite array element with new value.
    LET Bd&(ThisRow%) = QuotDen

    FOR Col = 1 TO nVar                       ' Repeat for each coefficient.
       
        IF TooLarge(1, An&(ThisRow, Col), Den) THEN CALL Crash
        IF TooLarge(1, Ad&(ThisRow, Col), Num) THEN CALL Crash

        LET QuotNum = An&(ThisRow, Col) * Den
        LET QuotDen = Ad&(ThisRow, Col) * Num
        CALL ReduceFraction(QuotNum, QuotDen)
        LET An&(ThisRow%, Col) = QuotNum
        LET Ad&(ThisRow%, Col) = QuotDen
    NEXT Col

   CLS
   CALL NewMatrix(0, nRows, nVar, An&(), Ad&(), Bn&(), Bd&())
END IF

CALL Clearlines(nRows + 2, 23)

END SUB

DEFSNG N, T
SUB EnterFraction (Row AS INTEGER, numLong AS LONG, denLong AS LONG)
'=============================================================================
' ** SUBprogram **                  **>> (c) 1991, 1998   G.H.  George  <<**
'
' INPUT a rational number (prompt in Row) and reduce it to lowest terms.
'=============================================================================

'   Procedures:
'  ReduceFraction:  reduce the fraction (num/den) to lowest terms

'   Parameters:
'           Row:    row number on screen for first prompt
'       numLong:    numerator of the fraction in lowest terms
'       denLong:    denominator of the fraction in lowest terms

'   Local variables (both single precision):
'       Num:        numerator of the fraction, as input by the user
'       Den:        denominator of the fraction, as input by the user

IF Row < 1 OR Row > 20 THEN LET Row = 1    ' Guard against bad row number

DO                                   ' CHR$(30) = cursor up one line.
    LOCATE Row, 1
    PRINT SPC(70);              ' Blank entry out, ready for next input.
    LOCATE Row, 1
    PRINT "Numerator (integer) = ";
    INPUT Num
LOOP UNTIL Num = INT(Num)

DO
    LOCATE Row + 1, 1
    PRINT SPC(70);
    LOCATE Row + 1, 1
    PRINT "Denominator (non-zero integer) = ";
    INPUT Den
LOOP UNTIL Den = INT(Den) AND Den <> 0   ' Avoid zero denominator.
 
LET numLong = CLNG(Num)
LET denLong = CLNG(Den)
CALL ReduceFraction(numLong, denLong)

END SUB

DEFINT N
SUB EnterSystem (Done AS INTEGER, Valid AS INTEGER, nVar, nRows, An&(), Ad&(), Bn&(), Bd&())
'=============================================================================
' **  SUBprogram  **            **>> (c) 1991, 1998   G.H. George  <<**
'
'   Ask the user for the coefficients of the initial augmented matrix [A|b].
'=============================================================================

'   Procedures:
' EnterFraction     ask user to enter numerator and denominator of fraction
'     NewMatrix     display the linear system entered by the user
'    WaitForKey     pause the program until any key is pressed

'   Parameters:
'       Done        logical variable, (= true to exit loop in main program)
'      Valid        logical variable (= true iff file name is valid)
'       nVar        number of variables in the linear system
'      nRows        number of equations in the linear system
'   An&(i,j)        coefficient matrix (numerators)
'   Ad&(i,j)        coefficient matrix (denominators)
'     Bn&(i)        right side constants vector (numerators)
'     Bd&(i)        right side constants vector (denominators)

'   Local variables:
'  FileName$        name of output file
'     Number        a single precision number input by the user
'        Row        loop counter = row [equation] number in the system
'        Col        loop counter = column [variable] number in the system
'    numLong        numerator of current coefficient
'    denLong        denominator of current coefficient
'      Reply        key pressed by the user

DIM Number AS SINGLE, Row AS INTEGER, Col AS INTEGER
DIM numLong AS LONG, denLong AS LONG
DIM Reply AS STRING

IF Done THEN          ' Use same # rows & variables if user rejects system.
    CLS
    ON ERROR GOTO ErrorTrap       ' Catch bad file names.

    ' --------- Obtain name of output file -------------
    DO
        LOCATE 2, 11
        PRINT SPC(60);      ' Blank out any previous invalid filename display.
        LOCATE 2, 11
        INPUT "Choose a filename for output: ", FileName$
        PRINT STRING$(60, 32)     ' Blank out any previous error messages
        PRINT STRING$(60, 32)
        LET Valid = True
        OPEN FileName$ FOR OUTPUT AS #1
    LOOP UNTIL Valid
  
    CALL Clearlines(3, 8)         ' Clear any error messages.
    ON ERROR GOTO 0               ' Switch error trap off.
  
    ' --------- Obtain the number of variables -------------
    DO
        LOCATE 4, 45
        PRINT SPC(30);        ' Blank out any invalid choice of # variables.
        LOCATE 4, 1
        INPUT "Number of variables (2 to 6) in linear system "; Number
    LOOP WHILE Number <> INT(Number) OR Number < 2 OR Number > 6
        
    LET nVar = CINT(Number)

    ' --------- Obtain the number of equations -------------
    DO
        LOCATE 6, 30
        PRINT SPC(40);        ' Blank out any invalid choice of # equations.
        LOCATE 6, 1
        INPUT "Number of equations (2 to 10) "; Number
    LOOP WHILE Number <> INT(Number) OR Number < 2 OR Number > 10

    LET nRows = CINT(Number)

    ' --------- Declare  A  and  b  matrices. --------------
    REDIM An&(nRows, nVar), Bn&(nRows)
    REDIM Ad&(nRows, nVar), Bd&(nRows)

END IF

'---------------------------------------------------------------------------
' Skip to here on 2nd & subsequent runs.

LOCATE 8, 1
PRINT "Enter the elements of the coefficient array one by one."
LET Row = 1

FOR Row = 1 TO nRows
    LOCATE 10, 1
    PRINT USING "Row ## "; Row
      
    FOR Col = 1 TO nVar         ' Ask user for each coefficient in this row.
        LOCATE 11, 1
        PRINT "Element A("; Row; ","; Col; ") :"
     
        CALL EnterFraction(12, numLong, denLong)
        LET An&(Row, Col) = numLong
        LET Ad&(Row, Col) = denLong
     
        LOCATE 11, 1
        PRINT SPC(70); " "          ' Blank entry out, ready for next input.
        PRINT SPC(70); " "
        PRINT SPC(70); " "
    NEXT Col
  
    LOCATE 11, 1             ' Ask user for numerator of right side constant.
    COLOR 14, 3                ' Reverse image (yellow on cyan).
    PRINT "Right side constant :"
    COLOR 15, 1                ' Restore normal colour (bold white on blue).
   
    CALL EnterFraction(12, numLong, denLong)
    LET Bn&(Row) = numLong
    LET Bd&(Row) = denLong

    LOCATE 11, 1
    PRINT SPC(70); " "    ' Blank entry out, ready for first input next row.
    PRINT SPC(70); " "
    PRINT SPC(70); " "
NEXT Row

'---------------------------------------------------------------------------
' Confirm that this is the desired linear system.

PRINT #1, "Reduction of linear system             (c) 1991, 1998   G.H. George"
PRINT #1, STRING$(75, "-")
PRINT #1,
CLS
CALL NewMatrix(0, nRows, nVar, An&(), Ad&(), Bn&(), Bd&())
LOCATE nRows + 2, 1
PRINT "Is this system the one you wanted to enter (Y/N)? ";

DO
   CALL WaitForKey(Reply)
LOOP UNTIL Reply = "Y" OR Reply = "N"

IF Reply = "N" THEN
   LET Done = False             ' User rejects displayed system.
   CLOSE                  ' Close output file and re-enter all coefficients.
   OPEN FileName$ FOR OUTPUT AS #1
ELSE
   LET Done = True              ' User confirms choice of system;  continue.
END IF

CALL Clearlines(nRows + 2, 23)       '< Clear screen EXCEPT for original
'                                     | linear system.

END SUB

SUB ExchangeRow (nVar, nRows, An&(), Ad&(), Bn&(), Bd&())
'=============================================================================
' **  SUBprogram  **                  **>> (c) 1991, 1998  G.H.  George  <<**
'
'            -  to interchange two rows  --  INPUT, validation and execution.
'=============================================================================

'   Procedures:
'    WaitForKey     pause until the user presses any key
'    ClearLines     clear text from part of the screen
'     NewMatrix     display the linear system entered by the user

'   Parameters:
'       nVar        number of variables in the linear system
'      nRows        number of equations in the linear system
'   An&(i,j)        coefficient matrix (numerators)
'   Ad&(i,j)        coefficient matrix (denominators)
'     Bn&(i)        right side constants vector (numerators)
'     Bd&(i)        right side constants vector (denominators)

'   Local variables:
'       RowA        index number of the first row to be interchanged
'       RowB        index number of the other row to be interchanged
'        Col        loop counter = current column of coefficient matrix
'      Reply        key pressed by the user
DIM ThisRow AS INTEGER, RowA AS INTEGER, RowB AS INTEGER, Col AS INTEGER
DIM Reply AS STRING

LOCATE (nRows + 2), 1
CALL WhichRow(RowA, nRows)
LOCATE (nRows + 3), 1
PRINT "to be interchanged with "
CALL WhichRow(RowB, nRows)

CALL Clearlines(nRows + 2, nRows + 5)

LOCATE (nRows + 2), 1
PRINT "Exchange rows"; RowA; "and"; RowB; ":"
PRINT "Confirm or abort (C/A)? ";

DO
   CALL WaitForKey(Reply)
LOOP UNTIL Reply = "C" OR Reply = "Y" OR Reply = "A" OR Reply = "N"

CALL Clearlines(nRows + 1, 23)

IF Reply = "C" OR Reply = "Y" THEN              '  Upon confirming choice,
                                                '  carry out the row swap.
    PRINT #1, "Exchange rows"; RowA; "and"; RowB; ":" 'print header to file.
    PRINT #1,
    SWAP Bn&(RowA), Bn&(RowB)                   '  right side vector  b
    SWAP Bd&(RowA), Bd&(RowB)

    FOR Col = 1 TO nVar                         '  coefficient matrix  A
        SWAP An&(RowA, Col), An&(RowB, Col)
        SWAP Ad&(RowA, Col), Ad&(RowB, Col)
    NEXT Col

    CLS
    CALL NewMatrix(0, nRows, nVar, An&(), Ad&(), Bn&(), Bd&())
END IF

CALL Clearlines(nRows + 2, 23)

END SUB

DEFSNG N
SUB InfoPage
'=============================================================================
' **  SUBprogram  **                 **>> (c) 1991, 1998  G.H. George  <<**
'            - print a welcome message to the screen.
'=============================================================================

'   Procedures:
'       PressAnyKey:    prompt the user to press any key to continue

'   No parameters or local variables.

COLOR 15, 1                          ' bold white letters on blue background.
WIDTH 80
CLS
LOCATE 1, 17
PRINT "General purpose LINEAR ALGEBRA program. "
PRINT
PRINT "This program is designed to carry out the tedious arithmetic in the"
PRINT "reduction of linear systems to echelon form while leaving you in full"
PRINT "control of the decisions as to which row operations to perform and in"
PRINT "what order.": PRINT
PRINT "You may enter a linear system of up to ten equations in up to six"
PRINT "variables.   There is room on the screen only for coefficients whose"
PRINT "numerators and denominators are both less than 1,000 in magnitude."
PRINT "All calculations will be performed on rational numbers.   If this is"
PRINT "not convenient, you will need to use a modification of this program."
PRINT
PRINT "Once your linear system has been entered and confirmed, you may choose"
PRINT "only one elementary row operation at a time to apply to the linear"
PRINT "system.   This program will then carry out your chosen row operation"
PRINT "and display the result.   You will then be asked to select another"
PRINT "row operation (or to exit from this program)."
PRINT
COLOR 31, 1                             ' flashing foreground colour.
PRINT "< Press any key to continue ... >"
COLOR 15, 1                             ' Restore normal colour.

CALL PressAnyKey

END SUB

DEFINT N, T
SUB MultiplyRow (nVar, nRows, An&(), Ad&(), Bn&(), Bd&())
'=============================================================================
' **  SUBprogram  **               **>> (c) 1991, 1998  G.H. George  <<**
'
'                 - to multiply row (i) by  c  --  INPUT and validation.
'=============================================================================

'   Procedures:
'    WaitForKey     pause until the user presses any key
'    ClearLines     clear text from part of the screen
'     NewMatrix     display the linear system entered by the user
'      TooLarge     guard against a product being too large for long integers
'         Crash     stop program because of unrecoverable overflow

'   Parameters:
'       nVar        number of variables in the linear system
'      nRows        number of equations in the linear system
'   An&(i,j)        coefficient matrix (numerators)
'   Ad&(i,j)        coefficient matrix (denominators)
'     Bn&(i)        right side constants vector (numerators)
'     Bd&(i)        right side constants vector (denominators)

'   Local variables:
'    ThisRow        index number of the row to be changed
'        Num        numerator of constant by which to multiply ThisRow
'        Den        denominator of constant by which to multiply ThisRow
'    ProdNum        numerator of product
'    ProdDen        denominator of product
'        Col        loop counter = current column of coefficient matrix
'      Reply        key pressed by the user

DIM ThisRow AS INTEGER, Num AS LONG, Den AS LONG
DIM ProdNum AS LONG, ProdDen AS LONG, Col AS INTEGER, Reply AS STRING

LOCATE (nRows + 2), 1
CALL WhichRow(ThisRow, nRows)

DO                                     ' Prompt for valid input.
    LOCATE (nRows + 3), 1
    PRINT SPC(70); " "
    LOCATE (nRows + 3), 1
    PRINT "Enter the (non-zero) number by which row"; ThisRow;
    PRINT "is to be multiplied:"
    CALL EnterFraction(nRows + 4, Num, Den)
LOOP UNTIL Num <> 0                     ' Avoid zero multiplier (illegal).

CALL Clearlines(nRows + 2, 23)
LOCATE (nRows + 2), 1
PRINT "Multiply row"; ThisRow; "by "; Num; "/"; Den; ":"
PRINT "Confirm or abort (C/A)? ";

DO
    CALL WaitForKey(Reply)
LOOP UNTIL Reply = "C" OR Reply = "Y" OR Reply = "A" OR Reply = "N"

CALL Clearlines(nRows + 1, 23)

IF Reply = "C" OR Reply = "Y" THEN            '  Upon confirming choice:
                                              '   carry out multiplication
    PRINT #1, "Multiply row"; ThisRow; "by "; Num; "/"; Den; ":"
    PRINT #1,                                '    ^--  print header to file.

    IF TooLarge(1, Bn&(ThisRow), Num) THEN CALL Crash
    IF TooLarge(1, Bd&(ThisRow), Den) THEN CALL Crash
   
    LET ProdNum = Bn&(ThisRow) * Num   ' Multiply r.s. constant top
    LET ProdDen = Bd&(ThisRow) * Den   '  & bottom,
    CALL ReduceFraction(ProdNum, ProdDen)' cancel result down to lowest terms,
    LET Bn&(ThisRow) = ProdNum         ' and overwrite old array elements.
    LET Bd&(ThisRow) = ProdDen

    FOR Col = 1 TO nVar                       ' Repeat for each coefficient.
       
        IF TooLarge(1, An&(ThisRow, Col), Num) THEN CALL Crash
        IF TooLarge(1, Ad&(ThisRow, Col), Den) THEN CALL Crash
       
        LET ProdNum = An&(ThisRow, Col) * Num
        LET ProdDen = Ad&(ThisRow, Col) * Den
        CALL ReduceFraction(ProdNum, ProdDen)
        LET An&(ThisRow, Col) = ProdNum
        LET Ad&(ThisRow, Col) = ProdDen
    NEXT Col

    CLS
    CALL NewMatrix(0, nRows, nVar, An&(), Ad&(), Bn&(), Bd&())
END IF

CALL Clearlines(nRows + 2, 23)

END SUB

DEFSNG T
SUB NewMatrix (Offset AS INTEGER, nRows, nVar, An&(), Ad&(), Bn&(), Bd&())
'=============================================================================
' **  SUBprogram  **                **>> (c) 1991, 1998  G.H. George  <<**
'
'    Print current linear system, starting one line below  Offset .
'=============================================================================

'   Procedures:

'   Parameters:
'     Offset        number of lines to leave unchanged at top of the screen
'       nVar        number of variables in the linear system
'      nRows        number of equations in the linear system
'   An&(i,j)        coefficient matrix (numerators)
'   Ad&(i,j)        coefficient matrix (denominators)
'     Bn&(i)        right side constants vector (numerators)
'     Bd&(i)        right side constants vector (denominators)

'   Local variables:
'        Row        loop counter = row [equation] number in the system
'        Col        loop counter = column [variable] number in the system
DIM Row AS INTEGER, Col AS INTEGER

LOCATE (1 + Offset + INT((nRows - 1) / 2)), 1
PRINT "[A|b] = "

FOR Row = 1 TO nRows
    LOCATE (Row + Offset), 9
    PRINT "[ ";                               ' Start new row.
    PRINT #1, "[ ";
  
    FOR Col = 1 TO nVar
        PRINT USING "####/### "; An&(Row, Col); Ad&(Row, Col);
        PRINT #1, USING "####/### "; An&(Row, Col); Ad&(Row, Col);
    NEXT Col

                                        '   Print  i'th right side constant.
    PRINT USING " | #####/#### ]"; Bn&(Row); Bd&(Row)
    PRINT #1, USING " | #####/#### ]"; Bn&(Row); Bd&(Row)
NEXT Row

PRINT #1, : PRINT #1,

END SUB

DEFSNG N
FUNCTION NextPrime& (Number AS LONG)
'=============================================================================
'  **  User defined FUNCTION  **     (c) 1991, 1998  **>>  G.H.  George  <<**
'                    - given input "Number", find the next prime number.
'=============================================================================

'   Procedures:
'       <none>

'   Parameters:
'     Number:  incoming number, the next prime above which is to be found

'   Local Variables:
'      Found:  logical variable (= true when nature of candidate is found)
'       Cand:  candidate next prime number (initially = Number)
' LastFactor:  last factor to try for this candidate prime number
'     Factor:  factor by which to try to divide the candidate prime number

DIM Cand AS LONG, LastFactor AS INTEGER, Factor AS INTEGER, Found AS LONG

LET Cand = Number

DO
   LET Cand = Cand + 1
   LET LastFactor = SQR(Cand)
   LET Factor = 1
   LET Found = False

   DO
      LET Factor = Factor + 1
      IF Factor > LastFactor THEN LET Found = True      ' <-- Prime detected.
      IF Cand MOD Factor = 0 THEN LET Found = True  ' <-- "Cand" is composite.
   LOOP UNTIL Found

LOOP UNTIL Factor > LastFactor                 ' Exit only when prime found.

LET NextPrime& = Cand

END FUNCTION

SUB PressAnyKey
'============================================================================
'                                    **>> (c) 1991, 1998  G.H. George <<**
'   Prompts the user to press a key -- program pauses until user complies.
'============================================================================

'   Procedures:
'     WaitForKey:   pause until any key is pressed

'   Parameters:
'       <none>

'   Local variables:
'       KeyPressed: the key pressed by the user (not needed here)
DIM KeyPressed AS STRING

LOCATE 25, 1
PRINT "Press any key to continue: ";
CALL WaitForKey(KeyPressed)
LOCATE 24, 1

END SUB

SUB ReduceFraction (Num AS LONG, Den AS LONG)
'=============================================================================
' ** SUBprogram **                   (c) 1991, 1998  **>>  G.H.  George  <<**
'               - cancels the fraction (num/den) down to lowest terms.
' [alternate version to try to cope with large fractions]
'=============================================================================

'   Procedures:
'  NextPrime:  returns the next prime number after the argument
' Clearlines:  clear lines of text from the screen

'   Parameters:
'        num:  numerator of the fraction to be reduced
'        den:  denominator of the fraction to be reduced

'   Local Variables:
'    Proceed:  logical variable (= true if further reduction may be needed)
'      Prime:  prime number; used to test Num& & Den& for common factors
'        Row:  remembers the row on which the cursor is located
'        Col:  remembers the column on which the cursor is located

DIM Proceed AS INTEGER, Prime AS LONG, Row AS INTEGER, Col AS INTEGER

LET Proceed = True                                ' no special cases.

IF Den = 0 THEN
   LET Proceed = False                    ' Avoid zero denominator entirely.
ELSE
   IF Num = 0 THEN                 ' Check for zero numerator.
      LET Den = 1
      LET Proceed = False                 '  and no need to reduce further.
   END IF

   IF Den < 0 THEN                 ' Make denominator positive.
      LET Num = -Num        ' - but further reduction may
      LET Den = -Den        '   be needed.
   END IF

   IF ABS(Num) = 1 OR Den = 1 THEN
      LET Proceed = False                 ' No reduction needed for unit
   END IF                                 '  numerator or denominator.

END IF

IF Proceed THEN                           ' Proceed with main routine ONLY
   LET Prime = 2                         '  when no special cases detected.

   DO
   
      DO
         IF Num / Prime = INT(Num / Prime) THEN
            LET Proceed = True            ' Test divisibility of numerator.
         ELSE
            LET Proceed = False
         END IF
'
         IF Den / Prime <> INT(Den / Prime) THEN
            LET Proceed = False           ' Test divisibility of denominator.
         END IF
'
         IF Proceed THEN                  ' Divide out by common factor found.
            LET Num = Num / Prime
            LET Den = Den / Prime
         END IF
    
      LOOP WHILE Proceed                  ' Try same prime again if it's a CF.
   
      LET Prime = NextPrime&(Prime)          '  else go to next prime number.

      IF Prime > 100 THEN                 ' Update progress on screen.
         LET Row = CSRLIN
         LET Col = POS(0)
         LOCATE 23, 40
         PRINT "SUB ReduceFraction:  Factor now ="; Prime;
         LOCATE Row, Col
      END IF

   LOOP UNTIL Prime > ABS(Num) OR Prime > Den
                                             ' until lowest terms.
   CALL Clearlines(23, 23)                ' Clear update message.

END IF

END SUB

DEFINT N, T
SUB RowLinComb (nVar, nRows, An&(), Ad&(), Bn&(), Bd&())
'=============================================================================
' **  SUBprogram  **              **>> (c) 1991, 1998  G.H.  George  <<**
'                    -  subtract a multiple of row (j) from row (i)
'                    -  INPUT, validation and execution.
'=============================================================================

'   Procedures:
'    WaitForKey     pause until the user presses any key
'    ClearLines     clear text from part of the screen
'     NewMatrix     display the linear system entered by the user
'      TooLarge     guard against a product being too large for long integers
'         Crash     stop program because of unrecoverable overflow

'   Parameters:
'       nVar        number of variables in the linear system
'      nRows        number of equations in the linear system
'   An&(i,j)        coefficient matrix (numerators)
'   Ad&(i,j)        coefficient matrix (denominators)
'     Bn&(i)        right side constants vector (numerators)
'     Bd&(i)        right side constants vector (denominators)

'   Local variables:
'       RowA        index number of the first row to be interchanged
'       RowB        index number of the other row to be interchanged
'        Num        numerator of multiple of row to be subtracted
'        Den        denominator of multiple of row to be subtracted
'     NewNum        numerator of new coefficient in the changed row
'     NewDen        denominator of new coefficient in the changed row
'       Diff        double precision version of # too large for long integer
'        Col        loop counter = current column of coefficient matrix
'      Reply        key pressed by the user
DIM ThisRow AS INTEGER, RowA AS INTEGER, RowB AS INTEGER, Col AS INTEGER
DIM Num AS LONG, Den AS LONG, NewNum AS LONG, NewDen AS LONG
DIM Diff AS DOUBLE, Reply AS STRING

LOCATE (nRows + 2), 1
PRINT "Enter row to be changed;"
CALL WhichRow(RowA, nRows)

LOCATE (nRows + 5), 1
PRINT "Enter row whose multiple is to be subtracted from row"; RowA; ":"

DO
   LOCATE (nRows + 6), 1
   PRINT SPC(70); " "
   LOCATE (nRows + 6), 1
   CALL WhichRow(RowB, nRows)
LOOP WHILE RowB = RowA        ' In case the user enters the same row twice.

CALL Clearlines(nRows + 1, 23)

LOCATE (nRows + 2), 1
PRINT "Multiple of row"; RowB; "to ";
COLOR 15, 4                                ' Red background for emphasis.
PRINT "subtract";
COLOR 15, 1                          ' Restore normal blue background colour.
PRINT " from row"; RowA; ":"
CALL EnterFraction(nRows + 4, Num, Den)   '  Here,  c = 0  is no problem !

CALL Clearlines(nRows + 1, 23)
LOCATE (nRows + 2), 1
PRINT "Subtract "; Num; "/"; Den; "times row"; RowB;
PRINT "from row"; RowA; "."
PRINT "Confirm or abort (C/A)? ";

DO
   CALL WaitForKey(Reply)
LOOP UNTIL Reply = "C" OR Reply = "Y" OR Reply = "A" OR Reply = "N"

CALL Clearlines(nRows + 1, 23)

IF Reply = "C" OR Reply = "Y" THEN            '  Upon confirming choice,
                                            '  carry out the subtraction.
    PRINT #1, "Subtract "; Num; "/"; Den; "times row"; RowB;
    PRINT #1, "from row"; RowA; "."         '  print header to file.
    PRINT #1,
   
                                      ' Change the right side constant  b :
    IF TooLarge(Den, Bd&(RowB), Bn&(RowA)) OR TooLarge(Num, Bn&(RowB), Bd&(RowA)) THEN
        LET Diff = CDBL(Den) * Bd&(RowB) * Bn&(RowA)
        LET Diff = Diff - CDBL(Num) * Bn&(RowB) * Bd&(RowA)
       
        IF ABS(Diff) > 2 ^ 31 THEN
            CALL Crash
        ELSE
            LET NewNum = CLNG(Diff)
        END IF
    ELSE
        LET NewNum = Den * Bd&(RowB) * Bn&(RowA) - Num * Bn&(RowB) * Bd&(RowA)
    END IF

    IF TooLarge(Den, Bd&(RowA), Bd&(RowB)) THEN CALL Crash

    LET NewDen = Den * Bd&(RowA) * Bd&(RowB)
    CALL ReduceFraction(NewNum, NewDen)
    LET Bn&(RowA) = NewNum
    LET Bd&(RowA) = NewDen

    FOR Col = 1 TO nVar                      ' Change each coefficient  A :
       
        IF TooLarge(Den, Ad&(RowB, Col), An&(RowA, Col)) OR TooLarge(Num, An&(RowB, Col), Ad&(RowA, Col)) THEN
            LET Diff = CDBL(Den) * Ad&(RowB, Col) * An&(RowA, Col)
            LET Diff = Diff - CDBL(Num) * An&(RowB, Col) * Ad&(RowA, Col)
       
            IF ABS(Diff) > 2 ^ 31 THEN
                CALL Crash
            ELSE
                LET NewNum = CLNG(Diff)
            END IF

        ELSE
            LET NewNum = Den * Ad&(RowB, Col) * An&(RowA, Col)
            LET NewNum = NewNum - Num * An&(RowB, Col) * Ad&(RowA, Col)
        END IF

        IF TooLarge(Den, Ad&(RowA, Col), Ad&(RowB, Col)) THEN CALL Crash

        LET NewDen = Den * Ad&(RowA, Col) * Ad&(RowB, Col)
        CALL ReduceFraction(NewNum, NewDen)
        LET An&(RowA, Col) = NewNum
        LET Ad&(RowA, Col) = NewDen
    NEXT Col

    CLS
    CALL NewMatrix(0, nRows, nVar, An&(), Ad&(), Bn&(), Bd&())
END IF

CALL Clearlines(nRows + 2, 23)

END SUB

DEFSNG T
SUB SelectProcedure (Done AS INTEGER, nVar, nRows, An&(), Ad&(), Bn&(), Bd&())
'=============================================================================
' **  SUBprogram  **               **>> (c) 1991, 1998  G.H. George  <<**
'
'                      - ask the user to select a row operation.
'=============================================================================

'   Procedures:
'    WaitForKey     pause until the user presses any key
'    ClearLines     clear text from part of the screen
'   MultiplyRow     multiply a row of the linear system by a constant
'     DivideRow     divide a row of the linear system by a constant
'   ExchangeRow     interchange two rows of the linear system
'    RowLinComb     from a row subtract a multiple of another row

'   Parameters:
'       Done        logical variable, = true to exit loops in main program
'       nVar        number of variables in the linear system
'      nRows        number of equations in the linear system
'   An&(i,j)        coefficient matrix (numerators)
'   Ad&(i,j)        coefficient matrix (denominators)
'     Bn&(i)        right side constants vector (numerators)
'     Bd&(i)        right side constants vector (denominators)

'   Local variables:
'      Valid        logical variable = true iff chosen menu option is valid.
'      Reply        key pressed by the user

DIM Valid AS INTEGER, Reply AS STRING

'---------------------------------------------------------------------------
'   Print menu options:
LOCATE (nRows + 5), 11
COLOR 12, 1                                       ' Bright red on blue
PRINT "M";
COLOR 15, 1                                       ' Bright white on blue
PRINT "  =  Multiply a row by some constant"

LOCATE (nRows + 7), 11
COLOR 12, 1
PRINT "D";
COLOR 15, 1
PRINT "  =  Divide a row by some constant"

LOCATE (nRows + 9), 11
COLOR 12, 1
PRINT "I";
COLOR 15, 1
PRINT "  =  Interchange two rows"

LOCATE (nRows + 11), 11
COLOR 12, 1
PRINT "C";
COLOR 15, 1
PRINT "  =  To one row add some multiple of another row"

LOCATE (nRows + 13), 11
COLOR 12, 1
PRINT "X";
COLOR 15, 1
PRINT "  =  Exit program"

LOCATE (nRows + 2), 11
PRINT "Select an option";
COLOR 31, 1                 ' blinking bright white colon on blue background.
PRINT ":";
COLOR 15, 1

DO                        ' Pause until 1 of the 5 keys above is pressed.
    CALL WaitForKey(Reply)
    LET Valid = (Reply = "M" OR Reply = "D" OR Reply = "I")
    LET Valid = (Valid OR Reply = "C" OR Reply = "X")
LOOP UNTIL Valid

CALL Clearlines(nRows + 2, 23)
'----------------------------------------------------------------------
LET Done = False                   '   Flag down unless user chooses eXit.

SELECT CASE Reply                  '   Action branches according to choice
    CASE IS = "M"                  '    of option by user.
        CALL MultiplyRow(nVar, nRows, An&(), Ad&(), Bn&(), Bd&())
    CASE IS = "D"
        CALL DivideRow(nVar, nRows, An&(), Ad&(), Bn&(), Bd&())
    CASE IS = "I"
        CALL ExchangeRow(nVar, nRows, An&(), Ad&(), Bn&(), Bd&())
    CASE IS = "C"
        CALL RowLinComb(nVar, nRows, An&(), Ad&(), Bn&(), Bd&())
    CASE ELSE                      '   (Exit option).
        LET Done = True
        LOCATE 23, 1
        PRINT "Thank you for using this program."
        PRINT #1,
        PRINT #1, STRING$(75, "=")
        CLOSE
END SELECT

END SUB

DEFINT T
DEFSNG N
FUNCTION TooLarge (A AS LONG, B AS LONG, C AS LONG)
'=============================================================================
' **  User Defined FUNCTION  **           **>> (c) 1998  G.H.  George  <<**
'   Determine whether the product  A*B*C  is too large to be stored as a
'   long integer.
'=============================================================================

'   No procedures or local variables.

'   Parameters:
'    A, B, C        the three long integers being multiplied together

IF ABS(CDBL(A) * CDBL(B) * CDBL(C)) > 2 ^ 31 THEN
    LET TooLarge = True
ELSE
    LET TooLarge = False
END IF

END FUNCTION

DEFSNG T
SUB WaitForKey (KeyPressed AS STRING)
'=============================================================================
' **  SUBprogram  **                 **>> (c) 1991, 1998  G.H. George  <<**
'                      - cause program to pause until a key is pressed.
'=============================================================================

'   No procedures or local variables.

'   Parameter:
'       KeyPressed:  the upper case version of the key pressed by the user.

DO
   LET KeyPressed = UCASE$(INKEY$)
LOOP UNTIL KeyPressed <> ""              ' Pause until any key is pressed.

IF ASC(KeyPressed) = 13 OR ASC(KeyPressed) = 32 THEN LET KeyPressed = "Y"
                           ' ^--  treat <CR> and <SPACE> as a "YES" response.
END SUB

SUB WhichRow (ThisRow AS INTEGER, nRows AS INTEGER)
'=============================================================================
' **  SUBprogram  **               **>> (c) 1991, 1998  G.H. George  <<**
'
'                 - ask the user to select a row on which to operate.
'=============================================================================

'   No procedures.

'   Parameters:
'    ThisRow        index number of the row to be changed
'      nRows        number of equations in the linear system

'   Local variables:
'        Row        row number input by the user (single precision)

DO                               ' CHR$(30) = move cursor up one line
   PRINT SPC(70); " "
   PRINT CHR$(30);
   PRINT "  Which row (1 -"; nRows; ")";
   INPUT Row
   PRINT CHR$(30);
LOOP UNTIL Row = INT(Row) AND Row > 0 AND Row <= nRows
'      ^--  Check for valid row number - rejecting non-integer choice!

LET ThisRow = CINT(Row)

END SUB