Løse likninger i VB?

[Blaster2k]

Hvordan kan jeg løse en likning i VB? Feks:

 

10 * X = 30

 

Private Sub Cmd1_Click()

txt1.Text = her skal X-verdien komme

End Sub

[Jonas]

Løse ligninger? Hah, det hadde vært noe

 

Man kunne jo har gjort det som i virkeligheten, men da trenger man en funksjon lignende denne:

Svar = Calculate("5 + 4 ^ 2")

Noe jeg ikke tror finnes.. Mulig noen har laget det, men jeg har aldri sett det.

 

(Jeg tenker på det måten hvor man flytter X over på den ene siden, osv. Litt streng-manipulasjon, og sa Calculate)

 

Ellers kunne du jo har prøvd brute-force

[Blaster2k]

Bruteforce kan vel bli litt tregt. Sjit om det ikke går på andre måter :\ Finnes vel kanskje noen freeware regnearkprogrammer jeg kan bruke istedefor vb :\

[aadnk]

Dette KAN løses i VB, men da må du imidlertid belage deg på å måtte skrive mesteparten av algoritmen selv. Skjønt, jeg kan fint hjelpe deg litt på vei med en kode som kan regne likninger med addisjon og subtrasjon:

 

Private Type Unknown
   Name As String
   Value As Double
End Type

Private Sub Form_Load()

   MsgBox SolveEquation("45 + 2 - 7 + X + X - X + X + X + 5 + 2 + X = 534 + X")

End Sub

Public Function SolveEquation(Equation As String) As String

   Dim LeftSide, RightSide, Sides
   
   Sides = Split(Equation, "=")
   LeftSide = Split(AbbreviateExpression(Split(Sides(0), " ")), " ")
   RightSide = Split(AbbreviateExpression(Split(Sides(1), " ")), " ")

   'Do Until UBound(LeftSide) <= 1 Or UBound(RightSide) <= 1
   
   ' Du bør egentlig først bestemme deg for hvilken side du vil velge (den med høyest antall ukjente),
   ' men jeg har valgt å kun velge meg venstre side for å forenkle operasjonen en smule.
   
   If UBound(LeftSide) > 0 Then
       MoveOverNumbers LeftSide, RightSide
   End If
   
   MoveOverVariables RightSide, LeftSide
   
   'Loop
   
   ' Forkort begge uttrykkene og returner til funksjon
   SolveEquation = AbbreviateExpression(LeftSide) & " = " & AbbreviateExpression(RightSide)

End Function

' Flytter kun over de første nummerene i uttrykket. Bruk AbbreviateExpression til å flytte dem dit.
Public Sub MoveOverNumbers(destArray, sourceArray)

   Dim Tell As Long, Temp As Long, LastOperator As String

   LastOperator = "+"
   
   If IsOperator(CStr(destArray(0))) Then
       LastOperator = destArray(0)
       destArray(0) = ""
       Temp = 1
   End If
       
   If IsNumeric(destArray(Temp)) Then
       
       ReDim Preserve sourceArray(UBound(sourceArray) + 2)
       
       ' Flytt tallene over
       sourceArray(UBound(sourceArray) - 1) = IIf(LastOperator = "+", "-", "+") ' Omvendt
       sourceArray(UBound(sourceArray)) = Abs(destArray(Temp))
       destArray(Temp) = ""
   End If

End Sub

Public Sub MoveOverVariables(destArray, sourceArray)

   Dim Tell As Long, LastOperator As String

   LastOperator = "+"
   
   For Tell = LBound(destArray) To UBound(destArray)
       
       If IsOperator(CStr(destArray(Tell))) Then
           LastOperator = destArray(Tell)
       Else
       
           If Not IsNumeric(destArray(Tell)) Then ' En variabel
           
               ReDim Preserve sourceArray(UBound(sourceArray) + 2)
           
               ' Flytt tallene over
               sourceArray(UBound(sourceArray) - 1) = IIf(LastOperator = "+", "-", "+") ' Omvendt
               sourceArray(UBound(sourceArray)) = destArray(Tell)
               destArray(Tell) = ""
       
               If Tell > 0 Then
                   If IsOperator(CStr(destArray(Tell - 1))) Then
                       destArray(Tell - 1) = ""
                   End If
               End If
               
           End If
       
       End If
       
   Next

End Sub

Public Function AbbreviateExpression(Expression As Variant) As String

   Dim sNew As String, lValue As Double, LastOperator As String, Tell As Long, sName As String
   Dim lTemp As Double, Unknowns() As Unknown, UnknownCount As Long, Index As Long
   
   ' Dersom den siste operatøren ikke er definert i begynnelsen, skal addisjon brukes
   LastOperator = "+"
   
   ' Først regner vi ut samtlige konstanter og ukjente
   For Tell = LBound(Expression) To UBound(Expression)
   
       If Expression(Tell) <> "" Then
           If IsNumeric(Expression(Tell)) Then
               
               Select Case LastOperator
               Case "+": lValue = lValue + Expression(Tell)
               Case "-": lValue = lValue - Expression(Tell)
               Case "*": lValue = lValue * Expression(Tell)
               Case "/": lValue = lValue / Expression(Tell)
               End Select
               
           ElseIf IsOperator(CStr(Expression(Tell))) Then
               LastOperator = Expression(Tell)
           Else
           
               ' Hvor mange ukjente det er snakk om
               lTemp = Val(RemoveCharacters(CStr(Expression(Tell)), True))
               If lTemp = 0 Then lTemp = 1
               
               ' Navnet på den ukjente
               sName = RemoveCharacters(CStr(Expression(Tell)), False)
               
               ' Indeks til elementet i arrayen
               Index = ArrayItem(Unknowns, sName)
               
               ' Finn ut om denne ukjenten er blitt talt
               If Index >= 0 Then
               
                   Select Case LastOperator
                   Case "+": Unknowns(Index).Value = Unknowns(Index).Value + lTemp
                   Case "-": Unknowns(Index).Value = Unknowns(Index).Value - lTemp
                   End Select
               
               Else
                   ' Skap et nytt element i listen
                   ReDim Preserve Unknowns(UnknownCount)
                   
                   Unknowns(UnknownCount).Name = sName
                   Unknowns(UnknownCount).Value = lTemp
                   
                   UnknownCount = UnknownCount + 1
               End If
           
           End If
       End If
       
   Next
   
   ' Deretter setter vi konstanten i begynnelsen
   If lValue <> 0 Then
       sNew = lValue
   End If
   
   ' Og endelig legger vi til alle de ukjente
   For Tell = 0 To UnknownCount - 1
       
       Select Case Unknowns(Tell).Value
       Case 1: sNew = sNew & IIf(Tell = 0 And lValue = 0, "", " + ") & Unknowns(Tell).Name
       Case -1: sNew = sNew & " - " & Unknowns(Tell).Name
       Case Is < 0: sNew = sNew & " - " & Abs(Unknowns(Tell).Value) & Unknowns(Tell).Name
       Case Is > 0: sNew = sNew & IIf(Tell = 0 And lValue = 0, "", " + ") & Abs(Unknowns(Tell).Value) & Unknowns(Tell).Name
       End Select
   
   Next
   
   ' Returner resultatet
   AbbreviateExpression = sNew

End Function

Public Function RemoveCharacters(sText As String, bLetters As Boolean) As String

   Dim Tell As Long, Char As String, bIncludeChar As Boolean
   
   For Tell = 1 To Len(sText)
   
       Char = Mid(sText, Tell, 1)
       bIncludeChar = IsNumeric(Char) Or Char = "," Or Char = "."
   
       If IIf(bLetters, bIncludeChar, Not bIncludeChar) Then
           RemoveCharacters = RemoveCharacters & Char
       End If
       
   Next

End Function

Private Function ArrayItem(Unknowns() As Unknown, sFindItem As String) As Long

   On Error Resume Next
   Dim Tell As Long, UnknownCount As Long
   
   UnknownCount = UBound(Unknowns) + 1
   
   For Tell = 0 To UnknownCount - 1
   
       If Unknowns(Tell).Name = sFindItem Then
           ArrayItem = Tell
           Exit Function
       End If

   Next
   
   ' Kunne ikke finne elementet
   ArrayItem = -1

End Function

Public Function IsOperator(Text As String) As Boolean

   IsOperator = CBool(Text = "+" Or Text = "-" Or Text = "*" Or Text = "/")

End Function

 

Den er uheldigvis LANGT fra ferdig. Den støtter som allerede nevnt kun de to første regneartene, kan ikke regne med paranteser, og kjenner heller ikke til opphøyning.

 

Men umulig er det ikke.