? Has anyone worked on Algebraic manipulations

new

« Prev
1
Next »

bplus
Global Moderator

b = b + ...

Posts: 1,043

? Has anyone worked on Algebraic manipulations Oct 27, 2022 4:22:37 GMT

Quote

Post by bplus on Oct 27, 2022 4:22:37 GMT

Has anyone worked on Algebraic manipulations in code? isolating the unknow variable(s) on left side of = and moving everything else to right?

Started thinking about it with Math Challenge here at JB Forum: justbasiccom.proboards.com/thread/905/math-puzzle-challenge

I had already done this work and thought it might be easy to go from there:

_Title "Formula Saver mod 1 trans from JB" ' B+ 2020-10-23
' More Evaluate.txt bplus started 2020-05-10 inspired by honkytonk app
' 2020-10-23 translate from JB but install latest Evaluate
' copy of Evaluate subs used in this Forumla Saver Project Folder
' Should be able to do all this without Word$ tools
' 2020-10-23 need to fix this like Tabulator so that the formula string does not have to be spoaced out.
' Also allowing 2 formulas with the same name.

'evaluate$ and evalW setup
Dim Shared evalErr$, pi, rad, deg, Dflag, globalx, vTopI As Integer, fTopI As Integer, debug
debug = 0 ' this is for checking the Evaluate stuff

pi = _Pi: rad = pi / 180: deg = 180 / pi '<<<<<<<<<<< true constants
vTopI = 0: fTopI = 0 'track variables and functions we have changeable global variables change as needed

Dflag = 0 ' degrees flag
evalErr$ = ""
globalx = 5 'changeable
rad = _Pi / 180.0
deg = 180 / _Pi
ReDim Shared fList(1 To 1) As String
Split "int, sin, cos, tan, asin, acos, atan, log, exp, sqr, rad, deg,", ", ", fList()
ReDim Shared oList(1 To 1) As String
Split "^, %, /, *, -, +, =, <, >, <=, >=, <>, or, and, not", ", ", oList()


Dim Shared varNames$(1 To 100), varValues(1 To 100), fNames$(50), fExprs$(50)
Open "vf.txt" For Append As #1
Close #1
Open "vf.txt" For Input As #1
While EOF(1) = 0
    Line Input #1, fline$
    If InStr(fline$, "=") Then count = count + 1
Wend
Close #1
If count Then
    Open "vf.txt" For Input As #1
    While EOF(1) = 0
        Line Input #1, fline$
        If InStr(fline$, "Formulas:") Then fF = 1
        If InStr(fline$, "=") Then '                        putting first formula or variable as item 1 no 0
            If fF Then
                fTopI = fTopI + 1
                fNames$(fTopI) = _Trim$(leftOf$(fline$, "=")): fExprs$(fTopI) = _Trim$(rightOf$(fline$, "="))
            Else
                vTopI = vTopI + 1
                varNames$(vTopI) = _Trim$(leftOf$(fline$, "=")): varValues(vTopI) = Val(_Trim$(rightOf$(fline$, "=")))
            End If
        End If
    Wend
    Close #1
End If
If fTopI > 0 Then curFormI = 1
Do
    Cls
    Print
    Print "         Formula Evaluation Menu"
    Print
    Print "   Current Formula: "; fNames$(curFormI); " = "; fExprs$(curFormI)
    Print
    Print " 1 for setting / resetting a variable and value"
    Print " 2 for getting a list of variables and values"
    Print " 3 for settimg a new formula"
    Print " 4 for selecting a formula from list saved"
    Print " 5 for Evaluating Current Formula with current variable values"
    Print " 6 for saving all current variables = values and formulas"
    Print " 7 for quitting"
    Print
    Input "    Please enter your choice number "; choice
    Select Case choice
        Case 1
            Print: Print "Please enter variable name = variable value"
            Input ""; vv$
            setVar _Trim$(leftOf$(vv$, "=")), Val(_Trim$(rightOf$(vv$, "=")))
        Case 2
            Cls
            Print
            Print "        Variables Listing:"
            Print
            For i = 1 To vTopI
                Print varNames$(i); " = "; varValues(i),
                If i Mod 5 = 0 Then Print
            Next
            Print: Print
            Input " Press enter to continue..."; wate$
        Case 3
            Print: Print "Please enter the formula name = formula with variables and constants, space everything!"
            Input ""; fx$
            If InStr(fx$, "=") Then
                fTopI = fTopI + 1
                fNames$(fTopI) = _Trim$(leftOf$(fx$, "=")): fExprs$(fTopI) = _Trim$(rightOf$(fx$, "="))
                curFormI = fTopI
            End If
        Case 4
            Cls
            Print
            Print "     Formulas Listing:": Print
            For i = 1 To fTopI
                Print " "; i; " "; fNames$(i); " = "; fExprs$(i)
            Next
            Print
            Input " Press a number to select or just enter to continue..."; wate$
            If Val(wate$) > 0 And Val(wate$) <= fTopI Then curFormI = Val(wate$)
        Case 5
            fs$ = fExprs$(curFormI)

            preEvalSubst fs$
            Print " "; fs$
            'INPUT " after preEvalSubst OK "; w$

            result$ = _Trim$(Evaluate$(fs$))
            If evalErr$ = "" Then
                Print " "; fNames$(curFormI); " = "; Val(result$)
            Else
                Print "Error found: "; evalErr$
            End If
            Print
            Input " Press enter to continue..."; wate$

        Case 6
            Open "vf.txt" For Output As #1
            For i = 1 To vTopI
                Print #1, varNames$(i); " = "; varValues(i)
            Next
            Print #1, "Formulas:"
            For i = 1 To fTopI
                Print #1, fNames$(i); " = "; fExprs$(i)
            Next
            Close #1
            Print "   Data filed in vf.txt"
            Input " Press enter to continue..."; wate$
        Case 7
            quit = 1
    End Select
Loop Until quit
Print "               Goodbye!"
End

Function value (vName$) ' find vName$ index to get value of variable
    For i = 1 To vTopI
        If _Trim$(varNames$(i)) = _Trim$(vName$) Then
            value = varValues(i)
            Exit Function
        End If
    Next
    value = -99.11 ' no value found can't be -1 or 0 too common
End Function

Sub preEvalSubst (eString$) ' this is meant to modify eString$ inserting values for variables
    ReDim ev$(1 To 1)
    Split eString$, " ", ev$()
    For i = LBound(ev$) To UBound(ev$) 'replace variables for values
        v = value(ev$(i))
        If v <> -99.11 Then ev$(i) = _Trim$(Str$(v))
    Next
    'rebuild eString$
    For i = LBound(ev$) To UBound(ev$) ' rejoin as b$
        If i = LBound(ev$) Then b$ = ev$(1) Else b$ = b$ + " " + ev$(i)
    Next
    eString$ = b$
End Sub

Sub setVar (vName$, vValue) 'simply store or update a variable and it's value
    'try to find variable in array
    For i = 1 To vTopI
        If varNames$(i) = vName$ Then
            varValues(i) = vValue
            Exit Sub
        End If
    Next
    'if not found add it
    If vTopI + 1 <= 100 Then
        vTopI = vTopI + 1
        varNames$(vTopI) = vName$
        varValues(vTopI) = vValue
    Else
        Print: Print "Sorry, no more room for variables. Goodbye!"
    End If
End Sub

Function leftOf$ (source$, of$)
    If InStr(source$, of$) > 0 Then leftOf$ = Mid$(source$, 1, InStr(source$, of$) - 1)
End Function

Function rightOf$ (source$, of$)
    If InStr(source$, of$) > 0 Then rightOf$ = Mid$(source$, InStr(source$, of$) + Len(of$))
End Function

' ================================================================================ from Evaluate
'this preps e$ string for actual evaluation function and makes call to it,
'checks results for error returns that or string form of result calculation
'the new goal is to do string functions along side math
Function Evaluate$ (e$)
    Dim b$, c$
    Dim i As Integer, po As Integer ', isolateNeg AS _BIT
    ' isolateNeg = 0
    b$ = "" 'rebuild string with padded spaces
    'this makes sure ( ) + * / % ^ are wrapped with spaces, on your own with - sign
    For i = 1 To Len(e$) 'filter chars and count ()
        c$ = LCase$(Mid$(e$, i, 1))
        If c$ = ")" Then
            po = po - 1: b$ = b$ + " ) "
        ElseIf c$ = "(" Then
            po = po + 1: b$ = b$ + " ( "
        ElseIf InStr("+*/%^", c$) > 0 Then
            b$ = b$ + " " + c$ + " "
        ElseIf c$ = "-" Then
            If Len(b$) > 0 Then
                If InStr(".0123456789abcdefghijklmnopqrstuvwxyz)", Right$(RTrim$(b$), 1)) > 0 Then
                    b$ = b$ + " " + c$ + " "
                Else
                    b$ = b$ + " " + c$
                End If
            Else
                b$ = b$ + " " + c$
            End If
        ElseIf InStr(" .0123456789abcdefghijklmnopqrstuvwxyz<>=", c$) > 0 Then
            b$ = b$ + c$
        End If
        If po < 0 Then evalErr$ = "Too many )": Exit Function
    Next
    If po <> 0 Then evalErr$ = "Unbalanced ()": Exit Function
    ReDim ev(1 To 1) As String
    Split b$, " ", ev()
    For i = LBound(ev) To UBound(ev) 'subst constants
        If ev(i) = "pi" Then
            ev(i) = LTrim$(Str$(_Pi))
            'ELSEIF ev(i) = "x" THEN
            '    ev(i) = LTRIM$(STR$(globalx))
        ElseIf ev(i) = "e" Then
            ev(i) = LTrim$(Str$(Exp(1)))
        End If
    Next
    c$ = evalW$(ev())
    If evalErr$ <> "" Then Evaluate$ = evalErr$ Else Evaluate$ = c$

End Function

' the recursive part of EVAL
Function evalW$ (a() As String)
    If evalErr$ <> "" Then Exit Function

    Dim fun$, test$, innerV$, m$, op$
    Dim pop As Integer, lPlace As Integer, i As Integer, rPlace As Integer
    Dim po As Integer, p As Integer, o As Integer, index As Integer
    Dim recurs As Integer
    Dim innerVal As _Float, a As _Float, b As _Float
    If debug Then
        Print "evalW rec'd a() as:"
        For i = LBound(a) To UBound(a)
            Print a(i); ", ";
        Next
        Print: Input "OK enter"; test$: Print
    End If
    pop = find%(a(), "(") 'parenthesis open place
    While pop > 0
        If pop = 1 Then
            fun$ = "": lPlace = 1
        Else
            test$ = a(pop - 1)
            If find%(fList(), test$) > 0 Then
                fun$ = test$: lPlace = pop - 1
            Else
                fun$ = "": lPlace = pop
            End If
        End If
        po = 1
        For i = pop + 1 To UBound(a)
            If a(i) = "(" Then po = po + 1
            If a(i) = ")" Then po = po - 1
            If po = 0 Then rPlace = i: Exit For
        Next
        ReDim inner(1 To 1) As String: index = 0: recurs = 0
        For i = (pop + 1) To (rPlace - 1)
            index = index + 1
            ReDim _Preserve inner(1 To index) As String
            inner(index) = a(i)
            If find%(oList(), a(i)) > 0 Then recurs = -1
        Next
        If recurs Then innerV$ = evalW$(inner()) Else innerV$ = a(pop + 1)
        innerVal = Val(innerV$)

        Select Case fun$
            Case "": m$ = innerV$
            Case "int": m$ = ts$(Int(innerVal))
            Case "sin": If Dflag Then m$ = ts$(Sin(rad * innerVal)) Else m$ = ts$(Sin(innerVal))
            Case "cos": If Dflag Then m$ = ts$(Cos(rad * innerVal)) Else m$ = ts$(Cos(innerVal))
            Case "tan": If Dflag Then m$ = ts$(Tan(rad * innerVal)) Else m$ = ts$(Tan(innerVal))
            Case "asin": If Dflag Then m$ = ts$(_Asin(rad * innerVal)) Else m$ = ts$(_Asin(innerVal))
            Case "acos": If Dflag Then m$ = ts$(_Acos(rad * innerVal)) Else m$ = ts$(_Acos(innerVal))
            Case "atan": If Dflag Then m$ = ts$(Atn(rad * innerVal)) Else m$ = ts$(Atn(innerVal))
            Case "log"
                If innerVal > 0 Then
                    m$ = ts$(Log(innerVal))
                Else
                    evalErr$ = "LOG only works on numbers > 0.": Exit Function
                End If
            Case "exp" 'the error limit is inconsistent in JB
                If -745 <= innerVal And innerVal <= 709 Then 'your system may have different results
                    m$ = ts$(Exp(innerVal))
                Else
                    'what the heck???? 708 works fine all alone as limit ?????
                    evalErr$ = "EXP(n) only works for n = -745 to 709.": Exit Function
                End If
            Case "sqr"
                If innerVal >= 0 Then
                    m$ = ts$(Sqr(innerVal))
                Else
                    evalErr$ = "SQR only works for numbers >= 0.": Exit Function
                End If
            Case "rad": m$ = ts$(innerVal * rad)
            Case "deg": m$ = ts$(innerVal * deg)
            Case Else: evalErr$ = "Unidentified function " + fun$: Exit Function
        End Select
        If debug Then
            Print "lPlace, rPlace"; lPlace, rPlace
        End If
        arrSubst a(), lPlace, rPlace, m$
        If debug Then
            Print "After arrSubst a() is:"
            For i = LBound(a) To UBound(a)
                Print a(i); " ";
            Next
            Print: Print
        End If
        pop = find%(a(), "(")
    Wend

    'all parenthesis cleared
    'ops$ = "% ^ / * + - = < > <= >= <> and or not" 'all () cleared, now for binary ops (not not binary but is last!)
    For o = 1 To 15
        op$ = oList(o)
        p = find%(a(), op$)
        While p > 0
            a = Val(a(p - 1))
            b = Val(a(p + 1))
            If debug Then
                Print Str$(a) + op$ + Str$(b)
            End If
            Select Case op$
                Case "%"
                    If b >= 2 Then
                        m$ = ts$(Int(a) Mod Int(b))
                    Else
                        evalErr$ = "For a Mod b, b value < 2."
                        Exit Function
                    End If
                Case "^"
                    If Int(b) = b Or a >= 0 Then
                        m$ = ts$(a ^ b)
                    Else
                        evalErr$ = "For a ^ b, a needs to be >= 0 when b not integer."
                        Exit Function
                    End If
                Case "/"
                    If b <> 0 Then
                        m$ = ts$(a / b)
                    Else
                        evalErr$ = "Div by 0"
                        Exit Function
                    End If
                Case "*": m$ = ts$(a * b)
                Case "-": m$ = ts$(a - b)
                Case "+": m$ = ts$(a + b)
                Case "=": If a = b Then m$ = "-1" Else m$ = "0"
                Case "<": If a < b Then m$ = "-1" Else m$ = "0"
                Case ">": If a > b Then m$ = "-1" Else m$ = "0"
                Case "<=": If a <= b Then m$ = "-1" Else m$ = "0"
                Case ">=": If a >= b Then m$ = "-1" Else m$ = "0"
                Case "<>": If a <> b Then m$ = "-1" Else m$ = "0"
                Case "and": If a <> 0 And b <> 0 Then m$ = "-1" Else m$ = "0"
                Case "or": If a <> 0 Or b <> 0 Then m$ = "-1" Else m$ = "0"
                Case "not": If b = 0 Then m$ = "-1" Else m$ = "0" 'use b as nothing should be left of not
            End Select
            arrSubst a(), p - 1, p + 1, m$

            If debug Then
                Print "a() reloaded after " + op$ + " as:"
                For i = LBound(a) To UBound(a)
                    Print a(i); ", ";
                Next
                Print: Print
            End If

            p = find%(a(), op$)
        Wend
    Next
    fun$ = ""
    For i = LBound(a) To UBound(a)
        fun$ = fun$ + " " + a(i)
    Next
    evalW$ = LTrim$(fun$)
End Function

Sub arrSubst (a() As String, substLow As Long, substHigh As Long, subst As String)
    Dim i As Long, index As Long
    a(substLow) = subst: index = substLow + 1
    For i = substHigh + 1 To UBound(a)
        a(index) = a(i): index = index + 1
    Next
    ReDim _Preserve a(LBound(a) To UBound(a) + substLow - substHigh)
End Sub

'notes: REDIM the array(0) to be loaded before calling Split '<<<<<<<<<<<<<<<<<<<<<<< IMPORTANT!!!!
Sub Split (mystr As String, delim As String, arr() As String)
    ' bplus modifications of Galleon fix of Bulrush Split reply #13
    ' http://www.qb64.net/forum/index.php?topic=1612.0
    ' this sub further developed and tested here: \test\Strings\Split test.bas
    ' 2018-09-16 modified for base 1 arrays
    Dim copy As String, p As Long, curpos As Long, arrpos As Long, lc As Long, dpos As Long
    copy = mystr 'make copy since we are messing with mystr
    'special case if delim is space, probably want to remove all excess space
    If delim = " " Then
        copy = RTrim$(LTrim$(copy))
        p = InStr(copy, "  ")
        While p > 0
            copy = Mid$(copy, 1, p - 1) + Mid$(copy, p + 1)
            p = InStr(copy, "  ")
        Wend
    End If
    ReDim arr(1 To 1) 'clear it
    curpos = 1
    arrpos = 1
    lc = Len(copy)
    dpos = InStr(curpos, copy, delim)
    Do Until dpos = 0
        arr(arrpos) = Mid$(copy, curpos, dpos - curpos)
        arrpos = arrpos + 1
        ReDim _Preserve arr(1 To arrpos + 1) As String
        curpos = dpos + Len(delim)
        dpos = InStr(curpos, copy, delim)
    Loop
    arr(arrpos) = Mid$(copy, curpos)
    ReDim _Preserve arr(1 To arrpos) As String
End Sub

'assume a() is base 1 array so if find comes back as 0 then found nothing
Function find% (a() As String, s$)
    Dim i%
    For i% = LBound(a) To UBound(a)
        If a(i%) = s$ Then find% = i%: Exit Function
    Next
End Function

'ltrim a number float
Function ts$ (n)
    ts$ = _Trim$(Str$(n))
End Function

It was this part of that Math Challenge that got me think'in:


' Apples and Pears 2
'   Problem from tsh73 JB Forum https://justbasiccom.proboards.com/thread/905/math-puzzle-challenge
'There was a box of apples and pears
'Some are big, some are small;
'some are yellow, rest are green
'There are no small pears
'and no small green apples
'Some numbers are given:
'25 Apples, 17 pears
'32 big fruits
'28 yellow ones.
'There are two more green apples then green pears.
'
'Find the number of big yellow apples
'====================================================================================================

Dim names$(16), values(16) 'the 8 combos of Fruit(2) * Size(2) * Color(2)
'   Use -1 to tell code that that value has not been determined yet
names$(1) = "ASY" : values(1) = -1 ' for now
names$(2) = "ASG" : values(2) = 0 ' stays 0
names$(3) = "ALY" : values(3) = -1 ' > we want answer to this
names$(4) = "ALG" : values(4) = -1 ' for now
names$(5) = "PSY" : values(5) = 0 ' stays = 0 no SP's
names$(6) = "PSG" : values(6) = 0 ' stays = 0 no SP's
names$(7) = "PLY" : values(7) = -1 ' for now
names$(8) = "PLG" : values(8) = -1 ' for now

names$(9) = "A"   : values(9) = 25
names$(10) = "P"  : values(10) = 17
names$(11) = "L"  : values(11) = 32
names$(12) = "Y"  : values(12) = 28
names$(13) = "F"  : values(13) = values(9) + values(10)
names$(14) = "S"  : values(14) = values(13) - values(11)
names$(15) = "G"  : values(15) = values(13) - values(12)

The above was setup except for last line of givens:


'There are two more green apples then green pears
' values(15) is total of green fruit no small fruit is green so total green fruit is total of L
' value(15) = alg + plg
' values(15) = (plg + 2) + plg 'There are two more green apples then green pears
' values(15) = 2 * plg + 2
' plg = (values(15) - 2)/2
' plg = values(8)
values(8) = (values(15) - 2) / 2 ' this is num

That's the part I want Algebraic manipulations for!

Last Edit: Oct 27, 2022 4:24:34 GMT by bplus

Cheers! to the stars of Basic where ever they shine!

dcromley
New Member

Posts: 6

? Has anyone worked on Algebraic manipulations Dec 20, 2022 21:19:47 GMT

Quote

Post by dcromley on Dec 20, 2022 21:19:47 GMT

Hello bplus!! Glad to find you've been here!

This is a brute force (solving simultaneous equations) approach:

_Title "PUZZLE01 - dcromley"
Screen _NewImage(1024, 768, 256) ' 128x48
DefStr S

Dim Shared a(9, 8 + 1), sVars(8), sLetters(8 + 1)
'          a(col, row)

Data 1,1,1,1,0,0,0,0,25,"  A> A A A A . . . .  "
Data 0,0,0,0,1,1,1,1,17,"  B> . . . . P P P P  "
Data 0,0,0,0,1,0,0,0,0,"   C> . . . . P . . .  (SY)"
Data 0,0,0,0,0,1,0,0,0,"   D> . . . . . P . .  (SG)"
Data 0,1,0,0,0,0,0,0,0,"   E> . A . . . . . .  (SG)"
Data 0,0,1,1,0,0,1,1,32,"  F> . . L L . . L L  "
Data 1,0,1,0,1,0,1,0,28,"  G> Y . Y . Y . Y .  "
Data 0,1,0,1,0,-1,0,-1,2," H> Y G Y G . . . .  "
Data "ASY","ASG","ALY","ALG","PSY","PSG","PLY","PLG"

Print "  Puzzle:"
Print "There is a box of apples and pears."
Print "Some are big, some are small."
Print "Some are yellow, Some are green."
Print
Print "  Conditions:"
Print "A: There are 25 Apples"
Print "B: There are 17 Pears"
Print "C: There are no Small Yellow Pears"
Print "D: There are no Small Green Pears"
Print "E: There are no Small Green Apples"
Print "F: There are 32 Large Fruits"
Print "G: There are 28 Yellow Fruits"
Print "H: There are 2 more Green Apples than Green Pears"
Print
Print "Solution of puzzle by solving 8 equations, 8 unknowns by the elimination method."
Print "Hit ENTER to proceed to the next step; hit ESC to exit"
Print
Print "  Equations: (A)pples (P)ears (S)mall (L)arge (Y)ellow (G)reen"

Call populate(0) ' populate arrays
Call prompt("The Initial Setup", 0)
' -- Go down diagonal
For ndiag = 1 To 8
  eqnum = getMaxCoef(ndiag) ' get eqnum with max coefficient
  If eqnum <> ndiag Then Call exchange(ndiag, eqnum) ' if needed
  Call normalize(ndiag) ' make diagonal element = 1.00
  Call zeroDown(ndiag) ' zero below diagonal
  Call zeroUp(ndiag) ' zero above diagonal
Next ndiag
Call printEqs(0) ' print last time
' -- show final
Call populate(1) ' reset original coefficients
Beep: Call prompt("That should do it - check the Conditions:", 1)

Function getMaxCoef (ndiag) ' returns # of eq with max abs(a()) at or below diagonal
  nmax = 0:
  For eqnum = ndiag To 8
    If Abs(a(ndiag, eqnum)) > nmax Then nmax = Abs(a(ndiag, eqnum)): getMaxCoef = eqnum
  Next eqnum
End Function

Sub exchange (eq1, eq2) ' exchange equations if needed
  Call prompt("Exchange Equation " + sLetters(eq1) + " with Equation " + sLetters(eq2), 0)
  Swap sLetters(eq1), sLetters(eq2)
  For icol = 1 To 9: Swap a(icol, eq1), a(icol, eq2): Next icol
End Sub

Sub normalize (ndiag) ' make diagonal element = 1.00
  factor = a(ndiag, ndiag)
  If Abs(factor) < .00001 Then errExit "Probably equations are dependent," + Str$(factor)
  If Abs(factor - 1.00) < .000001 Then Exit Sub
  Call prompt("Normalize equation " + sLetters(ndiag), 0)
  For icol = 1 To 9: a(icol, ndiag) = a(icol, ndiag) / factor: Next icol
End Sub

Sub zeroDown (ndiag) ' zero out below diagonal
  For eq = ndiag + 1 To 8
    If Abs(a(ndiag, eq)) >= .000001 Then ' skip if already zero
      Call makeEqZ(eq, ndiag) '
      Call addEqZ(eq)
    End If
  Next eq
End Sub

Sub zeroUp (ndiag) ' zero out above diagonal
  For eq = ndiag - 1 To 1 Step -1
    If Abs(a(ndiag, eq)) >= .000001 Then ' skip if already zero
      Call makeEqZ(eq, ndiag) '
      Call addEqZ(eq)
    End If
  Next eq
End Sub

Sub makeEqZ (eqnum, ndiag) ' make equation Z
  factor = -a(ndiag, eqnum)
  If Abs(factor) < .00001 Then errExit "MakeEqZ" + Str$(factor)
  Call prompt("Equation Z = equation " + sLetters(ndiag) + " * " + Str$(factor), 0)
  sLetters(9) = "Z"
  For icol = 1 To 9
    a(icol, 9) = a(icol, ndiag) / factor
  Next icol
End Sub

Sub addEqZ (eqnum) ' add equation Z to equation eqnum
  Call prompt("Add equation Z to equation " + sLetters(eqnum), 0)
  For icol = 1 To 9
    a(icol, eqnum) = a(icol, eqnum) + a(icol, 9)
  Next icol
End Sub

Sub printEqs (finalSw) ' Print the equations
  If finalSw Then Locate 34, 1 Else Locate 21, 1
  For eqnum = 1 To 9 - finalSw ' normally print Z
    If eqnum = 9 Then Print
    Print sLetters(eqnum); ":  ";
    For icol = 1 To 8
      If Abs(a(icol, eqnum)) < .000001 Then
        Print "+ 0   ";
      Else
        Print Using "+##.##"; a(icol, eqnum);
      End If
      Print " * "; sVars(icol); " ";
    Next icol
    Print "=";: Print Using "###.##"; a(9, eqnum)
  Next eqnum
End Sub

Sub prompt (smsg, finalSw)
  Sound 400, 1 ' biip
  printEqs finalSw
  Locate 32, 1: Print Space$(128);
  Locate 32, 7: Print smsg;
  Do: s = InKey$
    If s = Chr$(27) Then System ' quit exit
    If s = Chr$(13) And finalSw = 0 Then Exit Sub
  Loop
End Sub

Sub populate (finalSw) ' -- populate arrays
  Dim nVars(8) ' for saving column 9
  For eqnum = 1 To 8: nVars(eqnum) = a(eqnum, 9): Next eqnum ' save column 9
  Restore
  For eqnum = 1 To 8 ' get equations
    sLetters(eqnum) = Chr$(64 + eqnum) ' Letters A-H
    For icol = 1 To 9: Read a(icol, eqnum): Next icol ' Numbers
    Read S ' throw away the comments
  Next eqnum
  sLetters(9) = "Z" ' temporary equation
  For eqnum = 1 To 8: Read sVars(eqnum): Next eqnum ' read varnames
  If finalSw Then ' restore column 9 for final
    For eqnum = 1 To 8: a(eqnum, 9) = nVars(eqnum): Next eqnum
  End If
End Sub

Sub errExit (sText)
  Do: Locate 47, 1: Print "Error: " + sText;: If inky$ = Chr$(27) Then System
Loop: End Sub

Last Edit: Dec 21, 2022 17:29:58 GMT by dcromley

bplus
Global Moderator

b = b + ...

Posts: 1,043

? Has anyone worked on Algebraic manipulations Dec 21, 2022 18:00:38 GMT

Quote

Post by bplus on Dec 21, 2022 18:00:38 GMT

Interesting, I don't think I even considered brute force for this.

I don't have much time this week to play for this but do you think your setup could be generalized for similar problems?

dcromley so good to hear from you, Merry Christmas!

Cheers! to the stars of Basic where ever they shine!

dcromley
New Member

Posts: 6

? Has anyone worked on Algebraic manipulations Dec 22, 2022 19:53:39 GMT

Quote

Post by dcromley on Dec 22, 2022 19:53:39 GMT

> I don't have much time this week to play for this but do you think your setup could be generalized for similar problems?

It's a good demonstration of making (independent) equations from a set of restrictions and then solving the simultaneous equations. But the output formatting is only ##.##, so if you wanted output with larger numbers and more decimal places, it would make for long lines of output.