а то с моим алгоритмом очень сложные графики строятся неправильно.

я щас пытаюсь сделать через производную, но не очень-то получается

экспонициальную(<по-моему правильно)

VERSION 1.0 CLASS

BEGIN

MultiUse = -1 'True

Persistable = 0 'NotPersistable

DataBindingBehavior = 0 'vbNone

DataSourceBehavior = 0 'vbNone

MTSTransactionMode = 0 'NotAnMTSObject

END

Attribute VB_Name = "Expression"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = True

Attribute VB_PredeclaredId = False

Attribute VB_Exposed = False

Option Explicit

Private Const MyName As String = "ExpressionClass"

'Класс для вычисления выражений в строковой форме

'(c) Гергерт Сергей, 2003

'Магадан, 04.07.2003 01:10

'Всё, иду спать...

Private Const Plus As String = "+"

Private Const Minus As String = "-"

Private Const Mult As String = "*"

Private Const Div As String = "/"

Private Const DivInt As String = "\"

Private Const Power As String = "^"

Private Const LeftPar As String = ""

Private Const RightPar As String = ""

Public Enum ExprErrors

exprNoError

exprErrorParentheses

exprErrorInvalidExpression

exprErrorUnknownFunction

End Enum

Public Function Value(ByVal E As String) As Double

Attribute Value.VB_UserMemId = 0

Dim i As Long

Dim tmpLng As Long, tmpStr As String


E = LCase$(Replace(E, " ", vbNullString))

E = Replace(E, RightPar + LeftPar, RightPar + Mult + LeftPar)


'Сначал убедимся, что скобки расставлены верно.

'Идём слева направо. Открывающая скобка - плюс 1,

'закрывающая - минус 1. Всё время должно быть >=0, а в конце =0


For i = 1 To Len(E)

tmpStr = Mid$(E, i, 1)

If tmpStr = LeftPar Then

tmpLng = tmpLng + 1

ElseIf tmpStr = RightPar Then

tmpLng = tmpLng - 1

End If

If tmpLng < 0 Then Err.Raise exprErrorParentheses, MyName, "Parentheses do
not match"

Next

If tmpLng Then Err.Raise exprErrorParentheses, MyName, "Parentheses do not
match"


Value = CalcSummand(E)

End Function

Private Function CalcSummand(S As String) As Double

Dim i As Long, minPrior As Byte, minPriorPos As Long

Dim NestingLevel As Long, tmpStr As String


'Не пустая ли строка?

If Len(S) = 0 Then Exit Function 'выходим с нулём


'Проверяем, не являются ли самые внешние скобки лишними

Do While LISP(S)

Loop


'Ищем первый оператор с минимальным приоритетом на текущем уровне
вложенности

minPrior = 2

For i = 1 To Len(S)

Select Case Mid$(S, i, 1)

Case LeftPar

NestingLevel = NestingLevel + 1

Case RightPar

NestingLevel = NestingLevel - 1

Case Plus, Minus

If NestingLevel = 0 Then

minPrior = 0

minPriorPos = i

Exit For

End If

Case Mult, Div, DivInt

If NestingLevel = 0 Then

If minPrior = 2 Then

minPrior = 1

minPriorPos = i

Else

If minPriorPos = 0 Then minPriorPos = i

End If

End If

Case Power

If NestingLevel = 0 Then

If minPrior = 2 And minPriorPos = 0 Then minPriorPos = i

End If

End Select

Next


If minPriorPos = 0 Then

'Сие означает, что операторов на текущем уровне вложенности нет.

'Это, в свою очередь, означает, что либо операнд есть число,

'либо он есть функция.

CalcSummand = IsFunction(S)

If CalcSummand >= 0 Then

Exit Function 'операнд был числом, и он вычислен

Else

'Операнд был функцией. Других вариантов нет, т.к. ошибка генерится в
IsFunction

'Переменная minPriorPos нам больше не нужна по прямому назначению.

'Поэтому заюзаем её для других целей. Просто очень капризная рекурсия

'в VB, стэк экономим-с...

minPriorPos = InStr(S, LeftPar)

tmpStr = Left$(S, minPriorPos - 1)

'Вот почему нельзя вызывать CallByName от модуля?

'Сколько бы гемора исчезло...

Select Case tmpStr

Case "abs"

CalcSummand = Abs(CalcSummand(Mid$(S, minPriorPos + 1, Len(S) -
minPriorPos - 1)))

Case "atn"

CalcSummand = Atn(CalcSummand(Mid$(S, minPriorPos + 1, Len(S) -
minPriorPos - 1)))

Case "cos"

CalcSummand = Cos(CalcSummand(Mid$(S, minPriorPos + 1, Len(S) -
minPriorPos - 1)))

Case "exp"

CalcSummand = Exp(CalcSummand(Mid$(S, minPriorPos + 1, Len(S) -
minPriorPos - 1)))

Case "log"

CalcSummand = Log(CalcSummand(Mid$(S, minPriorPos + 1, Len(S) -
minPriorPos - 1)))

Case "sgn"

CalcSummand = Sgn(CalcSummand(Mid$(S, minPriorPos + 1, Len(S) -
minPriorPos - 1)))

Case "sin"

CalcSummand = Sin(CalcSummand(Mid$(S, minPriorPos + 1, Len(S) -
minPriorPos - 1)))

Case "sqr"

CalcSummand = Sqr(CalcSummand(Mid$(S, minPriorPos + 1, Len(S) -
minPriorPos - 1)))

Case "tan"

CalcSummand = Tan(CalcSummand(Mid$(S, minPriorPos + 1, Len(S) -
minPriorPos - 1)))

Case Else

Err.Raise exprErrorUnknownFunction, MyName, "Unknown function " +
UCase$(tmpStr) + " detected"

End Select

End If

Else

'Нашли искомый оператор. Рекурсия...

If minPriorPos = 1 Then 'выражение типа -expr

tmpStr = Left$(S, 1)

If tmpStr = Plus Or tmpStr = Minus Then

CalcSummand = IIf(tmpStr = Minus, -1, 1) * CalcSummand(Mid$(S, 2))

Else

Err.Raise exprErrorInvalidExpression, MyName, "Expression is invalid"

End If

Else 'обычное a +-*/\^ b

Select Case Mid$(S, minPriorPos, 1)

Case Plus

CalcSummand = CalcSummand(Left$(S, minPriorPos - 1)) + CalcSummand(Right$(S,
Len(S) - minPriorPos))

Case Minus

CalcSummand = CalcSummand(Left$(S, minPriorPos - 1)) - CalcSummand(Right$(S,
Len(S) - minPriorPos))

Case Mult

CalcSummand = CalcSummand(Left$(S, minPriorPos - 1)) * CalcSummand(Right$(S,
Len(S) - minPriorPos))

Case Div

'Ошибку деления на ноль VB сгенерит и без нас...

CalcSummand = CalcSummand(Left$(S, minPriorPos - 1)) / CalcSummand(Right$(S,
Len(S) - minPriorPos))

Case DivInt

CalcSummand = CalcSummand(Left$(S, minPriorPos - 1)) \ CalcSummand(Right$(S,
Len(S) - minPriorPos))

Case Power

CalcSummand = CalcSummand(Left$(S, minPriorPos - 1)) ^ CalcSummand(Right$(S,
Len(S) - minPriorPos))

Case Else

'В принципе, этого возникать не должно никогда...

Err.Raise exprErrorInvalidExpression, MyName, "Expression is invalid"

End Select

End If

End If

End Function

Private Function LISP(ByRef S As String) As Boolean

Dim i As Long, tmp As Long


'LISP = Lots of Idiot Silly Parentheses!

'Фанаты языка LISP в шоке и готовят помидоры...


'Если уровень скобок по ходу выражения опустится до нуля,

'и это будет не конец выражения, то начальные и конечные

'скобки нужны, поскольку принадлежат разным группам.

'Иначе их можно удалить.


If Left$(S, 1) = LeftPar And Right$(S, 1) = RightPar Then

For i = 1 To Len(S)

If Mid$(S, i, 1) = LeftPar Then

tmp = tmp + 1

ElseIf Mid$(S, i, 1) = RightPar Then

tmp = tmp - 1

If tmp = 0 And i <> Len(S) Then Exit Function

End If

Next

Else

Exit Function

End If


'Скобки нужно удалить

S = Mid$(S, 2, Len(S) - 2)

LISP = True

End Function

Private Function IsFunction(F As String) As Double

'Функция - несколько подряд идущих букв и выражение в скобках.

'И больше ничего! Выражение типа "функция + функция" сюда попадать не
должно,

'по логике основной части программы

Dim i As Long


'правильность скобок гарантируется вызывающим кодом, поэтому достаточно

'проверить наличие одной, а не обоих

i = InStr(F, LeftPar)

If i = 0 Then

'Явно не функция. Может, число?

For i = 1 To Len(F)

If InStr("0123456789.", Mid$(F, i, 1)) = 0 Then Exit For

Next

If i = Len(F) + 1 Then IsFunction = Val(F) Else Err.Raise
exprErrorInvalidExpression, MyName, "Expression is invalid"

'логика программы такова, что отрицательное число вычисляется

'как (-)(expression), поэтому здесь всегда результат положительный,

'и можно использовать отрицательные числа как флаги

Exit Function

End If


'левая (а значит, и правая) скобки есть, и это не начальные ненужные скобки.

'Слева от левой скобки должнно быть имя функции. Его правильность будет

'анализировать вызывающий код

IsFunction = -1 'Флаг, что функция

End Function