VPF::Уравнение в виде строки - Форум программистов

I_Am_Rock

Дата 19.3.2008, 20:09 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 523
Регистрация: 18.1.2008

Репутация: 12
Всего: 15

Всем привет!

Я давно где-то в инете видел пример, как решать уравнения, представленные в виде строки.
Например, пользователь вводит строку "1 + (2 *4)" и получает 9.

Никто не знает, как это можно организовать на VB?
Или, может, кто-нибудь может дать ссылки?

Заранее спасибо! smile

iff

Дата 19.3.2008, 21:33 (ссылка)

(голосов:1)

Загрузка ...

Администратор

Профиль
Группа: Участник
Сообщений: 949
Регистрация: 23.3.2007

Репутация: -1
Всего: 16

Объявляем функции:

Код


Private Function EvaluateExpr(ByVal expr As String) As Single
On Error Resume Next

Const PREC_NONE = 11
Const PREC_UNARY = 10   ' Not actually used.
Const PREC_POWER = 9
Const PREC_TIMES = 8
Const PREC_DIV = 7
Const PREC_INT_DIV = 6
Const PREC_MOD = 5
Const PREC_PLUS = 4

Dim is_unary As Boolean
Dim next_unary As Boolean
Dim parens As Integer
Dim pos As Integer
Dim expr_len As Integer
Dim ch As String
Dim lexpr As String
Dim rexpr As String
Dim value As String
Dim status As Long
Dim best_pos As Integer
Dim best_prec As Integer

    ' Remove leading and trailing blanks.
    expr = Trim$(expr)
    expr_len = Len(expr)
      
    If expr_len = 0 Then Exit Function

    ' If we find + or - now, it is a unary operator.
    is_unary = True

    ' So far we have nothing.
    best_prec = PREC_NONE

    ' Find the operator with the lowest precedence.
    ' Look for places where there are no open
    ' parentheses.
    For pos = 1 To expr_len
        ' Examine the next character.
        ch = Mid$(expr, pos, 1)

        ' Assume we will not find an operator. In
        ' that case the next operator will not
        ' be unary.
        next_unary = False

        If ch = " " Then
            ' Just skip spaces.
            next_unary = is_unary
        ElseIf ch = "(" Then
            ' Increase the open parentheses count.
            parens = parens + 1

            ' An operator after "(" is unary.
            next_unary = True
        ElseIf ch = ")" Then
            ' Decrease the open parentheses count.
            parens = parens - 1

            ' An operator after ")" is not unary.
            next_unary = False

            ' If parens < 0, too many ')'s.
            If parens < 0 Then
                Err.Raise vbObjectError + 1001, _
                    "EvaluateExpr", _
                    "Too many )s in '" & _
                    expr & "'"
            End If
        ElseIf parens = 0 Then
            ' See if this is an operator.
            If ch = "^" Or ch = "*" Or _
               ch = "/" Or ch = "\" Or _
               ch = "%" Or ch = "+" Or _
               ch = "-" _
            Then
                ' An operator after an operator
                ' is unary.
                next_unary = True
                
                Select Case ch
                    Case "^"
                        If best_prec >= PREC_POWER Then
                            best_prec = PREC_POWER
                            best_pos = pos
                        End If
                    
                    Case "*", "/"
                        If best_prec >= PREC_TIMES Then
                            best_prec = PREC_TIMES
                            best_pos = pos
                        End If
                    
                    Case "\"
                        If best_prec >= PREC_INT_DIV Then
                            best_prec = PREC_INT_DIV
                            best_pos = pos
                        End If
                    
                    Case "%"
                        If best_prec >= PREC_MOD Then
                            best_prec = PREC_MOD
                            best_pos = pos
                        End If
                    
                    Case "+", "-"
                        ' Ignore unary operators
                        ' for now.
                        If (Not is_unary) And _
                            best_prec >= PREC_PLUS _
                        Then
                            best_prec = PREC_PLUS
                            best_pos = pos
                        End If
                End Select
            End If
        End If
        is_unary = next_unary
    Next pos
    
    ' If the parentheses count is not zero,
    ' there's a ')' missing.
    If parens <> 0 Then
        Err.Raise vbObjectError + 1002, _
            "EvaluateExpr", "Missing ) in '" & _
            expr & "'"
    End If
    
    ' Hopefully we have the operator.
    If best_prec < PREC_NONE Then
        lexpr = Left$(expr, best_pos - 1)
        rexpr = Right$(expr, expr_len - best_pos)
        Select Case Mid$(expr, best_pos, 1)
            Case "^"
                'If lexpr <> 0 Then
                EvaluateExpr = _
                    EvaluateExpr(lexpr) ^ _
                    EvaluateExpr(rexpr)
                'Else
                '    EvaluateExpr = 0
                'End If
            Case "*"
                EvaluateExpr = _
                    EvaluateExpr(lexpr) * _
                    EvaluateExpr(rexpr)
            Case "/"
                EvaluateExpr = _
                    EvaluateExpr(lexpr) / _
                    EvaluateExpr(rexpr)
            Case "\"
                EvaluateExpr = _
                    EvaluateExpr(lexpr) \ _
                    EvaluateExpr(rexpr)
            Case "%"
                EvaluateExpr = _
                    EvaluateExpr(lexpr) Mod _
                    EvaluateExpr(rexpr)
            Case "+"
                EvaluateExpr = _
                    EvaluateExpr(lexpr) + _
                    EvaluateExpr(rexpr)
            Case "-"
                EvaluateExpr = _
                    EvaluateExpr(lexpr) - _
                    EvaluateExpr(rexpr)
        End Select
        Exit Function
    End If
    
    ' If we do not yet have an operator, there
    ' are several possibilities:
    '
    ' 1. expr is (expr2) for some expr2.
    ' 2. expr is -expr2 or +expr2 for some expr2.
    ' 3. expr is Fun(expr2) for a function Fun.
    ' 4. expr is a primitive.
    ' 5. It's a literal like "3.14159".
    
    ' Look for (expr2).
    If Left$(expr, 1) = "(" And Right$(expr, 1) = ")" Then
        ' Remove the parentheses.
        EvaluateExpr = EvaluateExpr(Mid$(expr, 2, expr_len - 2))
        Exit Function
    End If
        
    ' Look for -expr2.
    If Left$(expr, 1) = "-" Then
        EvaluateExpr = -EvaluateExpr( _
            Right$(expr, expr_len - 1))
        Exit Function
    End If
    
    ' Look for +expr2.
    If Left$(expr, 1) = "+" Then
        EvaluateExpr = EvaluateExpr( _
            Right$(expr, expr_len - 1))
        Exit Function
    End If
    
    ' Look for Fun(expr2).
    If expr_len > 5 And Right$(expr, 1) = ")" Then
        lexpr = LCase$(Left$(expr, 4))
        rexpr = Mid$(expr, 5, expr_len - 5)
        Select Case lexpr
            Case "sin("
                EvaluateExpr = Sin(EvaluateExpr(rexpr))
                Exit Function
            Case "cos("
                EvaluateExpr = Cos(EvaluateExpr(rexpr))
                Exit Function
            Case "tan("
                EvaluateExpr = Tan(EvaluateExpr(rexpr))
                Exit Function
            Case "atn("
                EvaluateExpr = Atn(EvaluateExpr(rexpr))
                Exit Function
            Case "sqr("
                EvaluateExpr = Sqr(EvaluateExpr(rexpr))
                Exit Function
            Case "log("
                EvaluateExpr = Log(EvaluateExpr(rexpr)) / Log(10)
                Exit Function
            Case "lne("
                EvaluateExpr = Log(EvaluateExpr(rexpr))
                Exit Function
            Case "exp("
                EvaluateExpr = Exp(EvaluateExpr(rexpr))
                Exit Function
            Case "abs("
                EvaluateExpr = Abs(EvaluateExpr(rexpr))
                Exit Function
        End Select
    End If
    
    
    On Error Resume Next
    EvaluateExpr = CSng("0" & expr)
    status = Err.Number
    On Error GoTo 0
    If status <> 0 Then
        Err.Raise status, _
            "EvaluateExpr", _
            "Error evaluating '" & expr & _
            "' as a constant."
    End If
End Function

Выводим сообщение:

Код


MsgBox EvaluateExpr("1 + (2 *4)")

И ещё. Если пример подоёдёт, нен нада затруднять себя сообщениями об этом. Просто повысь репутацию.

--------------------

DOS... Синей пеленой экран заполнил чистый DOS
Мышь... Стала вдруг квадратной, потеряла форму мышь...
Я разбил окно, девяностопятое мастдайное окно,
И поставил DOS, и тогда увидел: Это счастье, — вот оно.

Akina

Дата 20.3.2008, 09:45 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 34
Всего: 454

http://www.rostix.com/vb/code/s5.htm

--------------------

О(б)суждение моих действий - в соответствующей теме, пожалуйста. Или в РМ. И высшая инстанция - Администрация форума.

daNick

Дата 25.3.2008, 10:09 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 114
Регистрация: 12.8.2006
Где: Казахстан, Астана

Репутация: нет
Всего: нет

iff, ваш код реализует ПОЛИЗ?

--------------------

Долго не кончать - преимущество мужчины, а не оратора.Я так много читал о вреде курения, что решил бросить... читать.(с) Сергей Довлатов

iff

Дата 25.3.2008, 17:50 (ссылка)

(нет голосов)

Загрузка ...

Администратор

Профиль
Группа: Участник
Сообщений: 949
Регистрация: 23.3.2007

Репутация: -1
Всего: 16

daNick, Что такое ПОЛИЗ?

--------------------

daNick

Дата 28.3.2008, 11:20 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 114
Регистрация: 12.8.2006
Где: Казахстан, Астана

Репутация: нет
Всего: нет

iff, ПОЛИЗ=ПОЛьская Инверсионная Запись, она же польская нотация или постфиксная нотация... В общем, типа: 2+3*4 ~ 234*+

--------------------

iff

Дата 28.3.2008, 18:52 (ссылка)

(нет голосов)

Загрузка ...

Администратор

Профиль
Группа: Участник
Сообщений: 949
Регистрация: 23.3.2007

Репутация: -1
Всего: 16

daNick, нет, не реализует.

--------------------

daNick

Дата 29.3.2008, 09:35 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 114
Регистрация: 12.8.2006
Где: Казахстан, Астана

Репутация: нет
Всего: нет

iff, в таком случае, позвольте поинтересоваться, как называется алгоритм, который реализует ваша программа?

Это сообщение отредактировал(а) daNick - 31.3.2008, 06:16

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| VB6 \| Следующая тема »