can anyone give me a little hand here with this VB program?

acejj26

Senior member
Dec 15, 1999
886
0
0
I am writing a numerical analysis program, and i am working on Bisection method. I am writing it in VB because I am pretty comfortable with it. However, I cannot seem to figure out how to bring in a text string that contains the function at hand and then manipulate it so I can use the bisection method to figure the root. Below is my code so far. I would appreciate any help.

Option Explicit

Dim Tolerance As Double
Dim a As Double
Dim b As Double
Dim Max As Double
Dim root As Double
Dim funct As String
Dim x As Double
Dim p As Double
Dim i As Integer
Dim z As Integer
Dim f As Double
Dim result_a As Double
Dim result_p As Double
Dim result As Double
Dim newfunct As String
Dim val_funct As Double

Public Sub cmdRoot_Click()

funct = txtFunction.Text
a = txtEndA.Text
b = txtEndB.Text
Tolerance = txtTOL.Text
Max = Int(txtIterations.Text)

i = 1

For z = 1 To Len(funct)

If Mid(funct, z, 1) = "x" Then
newfunct = newfunct & Trim(Str(a))
Else
newfunct = newfunct & Mid(funct, z, 1)
End If

Next z

result_a = Val(newfunct)

Do While i <= Max

p = a + ((b - a) / 2)

For z = 1 To Len(funct)

If Mid(funct, z, 1) = &quot;x&quot; Then
newfunct = newfunct &amp; Trim(Str(p))
Else
newfunct = newfunct &amp; Mid(funct, z, 1)
End If

Next z

result_p = Val(newfunct)

If result_p = 0 Then

lblMessage.Caption = &quot;Procedure completed successfully. The root is at x = &quot; &amp; Str(p)
Exit Do


End If

If ((b - a) / 2) < Tolerance Then

lblMessage.Caption = &quot;Procedure completed successfully. The root is at x = &quot; &amp; Str(p)
Exit Do

End If

i = i + 1

If (result_a * result_p) > 0 Then
a = p
result_a = result_p
Else
b = p
End If

Loop

End Sub

Note that this has been edited from original form to include suggestions.
 

Oli

Member
Jul 20, 2000
98
0
0
If eval1 and eval2 are function you must put:

Dim Result as ...
Result = eval1(a, funct) as the function send back a value

Private Function eval1 ( ByVal a as Double, ByVal Funct as string ) as ... (Type of value you want back)

...
Process
...
eval1 = Result of process
...

End Function

Same for the eval2 function
Remember: Function send back a value in the function name
Procedure don't send back any value in the procedure name

If you need more help ask me
 

acejj26

Senior member
Dec 15, 1999
886
0
0
Okay, everything looks good until the actual eval function.

Here is what happens in my program:

The user enters a function (x^3-3x^2+x-4, for example), the left and right endpoints, the acceptable error level, and the maximum number of iterations (to keep from being an infinite loop). Then he hits a button that says &quot;Find root&quot;. That is my main function, cmdRoot. It then uses the bisection method that I have already written in the main program. The problem I forsee is the text string &quot;funct&quot; and being able to plug values into it. That is what eval is supposed to do. I pass the x-coordinate value (either p or a) and the actual function &quot;funct&quot;. I want eval to plug in &quot;a&quot; or &quot;p&quot; into the function &quot;funct&quot; and return the result.

Know how to do this???
 

Grunt03

Diamond Member
Jun 24, 2000
3,131
0
0
OK,where to begin,

I am not even going to try this is way above my level....

but here is a bump for you .......

up-up-up and away you go.........
 

Oli

Member
Jul 20, 2000
98
0
0
If I'm right you want to return a value in the params funct ?
Use the word ByRef when you declare the function:
Private Function eval1 ( ByVal a as Double, ByRef Funct as string ) as ... (Type of value you want back)
...
Funct = value (String type)
...
End Function

For replacing values in string use the function INSTR(string1, String2), or search char by char as :
Dim NewFunct as string

NewFunct = empty

For i = 1 to len(funct)
if mid ( funct , i, 1 ) = &quot;x&quot; then
NewFunct = NewFunct &amp; trim( str(a) )
else
NewFunct = NewFunct &amp; mid ( funct , i, 1 )
endif
Next i
funct = NewFunct

Put this in your function eval1 and it serach each 'x' and replace by your a value (note the str to convert it to a string type and the trim to take off all spaces)
 

acejj26

Senior member
Dec 15, 1999
886
0
0
Here is my function eval:

Private Function eval(ByVal f As Double, ByRef funct As String) As Double

newfunct = Empty

For z = 1 To Len(funct)

If Mid(funct, z, 1) = &quot;x&quot; Then
newfunct = newfunct &amp; Trim(Str(f))
Else
newfunct = newfunct &amp; Mid(funct, z, 1)
End If

Next z

val_funct = Val(newfunct)

End Function

I have two problems: first, I cannot get val_funct to be anything but zero; second, when I assign val_funct a value (by hard coding), it will not return the value into my other function. Any ideas here??

 

acejj26

Senior member
Dec 15, 1999
886
0
0
What if I get rid of the eval function altogether (since I don't care how my code looks...I just want it to run)?? Then my code looks like this:

Option Explicit

Dim Tolerance As Double
Dim a As Double
Dim b As Double
Dim Max As Double
Dim root As Double
Dim funct As String
Dim x As Double
Dim p As Double
Dim i As Integer
Dim z As Integer
Dim f As Double
Dim result_a As Double
Dim result_p As Double
Dim result As Double
Dim newfunct As String
Dim val_funct As Double

Public Sub cmdRoot_Click()

funct = txtFunction.Text
a = txtEndA.Text
b = txtEndB.Text
Tolerance = txtTOL.Text
Max = Int(txtIterations.Text)

i = 1

For z = 1 To Len(funct)

If Mid(funct, z, 1) = &quot;x&quot; Then
newfunct = newfunct &amp; Trim(Str(a))
Else
newfunct = newfunct &amp; Mid(funct, z, 1)
End If

Next z

result_a = Val(newfunct)

Do While i <= Max

p = a + ((b - a) / 2)

For z = 1 To Len(funct)

If Mid(funct, z, 1) = &quot;x&quot; Then
newfunct = newfunct &amp; Trim(Str(p))
Else
newfunct = newfunct &amp; Mid(funct, z, 1)
End If

Next z

result_p = Val(newfunct)

If result_p = 0 Then

lblMessage.Caption = &quot;Procedure completed successfully. The root is at x = &quot; &amp; Str(p)
Exit Do


End If

If ((b - a) / 2) < Tolerance Then

lblMessage.Caption = &quot;Procedure completed successfully. The root is at x = &quot; &amp; Str(p)
Exit Do

End If

i = i + 1

If (result_a * result_p) > 0 Then
a = p
result_a = result_p
Else
b = p
End If

Loop

End Sub

However, I still can't evaulate newfunct by doing Val(newfunct). If newfunct is just a string that contains a number, then the Val function works. However, after running the filter, newfunct is something like &quot;(.5^2)-.5&quot;. How can I evaluate this string to return the actual number? Any help here??
 

Oli

Member
Jul 20, 2000
98
0
0
If you make Val(String_value) it always return 0.
For:
Private Function eval(ByVal f As Double, ByRef funct As String) As Double

newfunct = Empty

For z = 1 To Len(funct)

If Mid(funct, z, 1) = &quot;x&quot; Then
newfunct = newfunct &amp; Trim(Str(f))
Else
newfunct = newfunct &amp; Mid(funct, z, 1)
End If

Next z

val_funct = Val(newfunct) <--- Here is the problem, it's not val_funct, it's funct = newfunct (with ByRef you have the newfunct return the string in the variable

End Function


As for: How can I evaluate this string to return the actual number?
I answer you tomorrow as I don't have msdn installed in my sys now

 

Oli

Member
Jul 20, 2000
98
0
0
The only thing I found is to evaluate char by char, there's no eval or evaluate function ( I remember my HP48Gx do the thing), I paste what I found (it's for vb1,2 and 3 but it work in 5 or 6):
Example to Evaluate Basic Numeric Expressions
Last reviewed: June 21, 1995
Article ID: Q86688
The information in this article applies to:
Microsoft Visual Basic programming system for Windows, versions 1.0, 2.0, and 3.0
The Standard and Professional Editions of Microsoft Visual Basic for MS-DOS, version 1.0


SUMMARY
This article contains an example program that evaluates a numeric expression contained in a string, mimicking the operators, built-in functions, and order of evaluation used by Microsoft Basic language products. This article also explains the operator precedence rules in detail.



MORE INFORMATION
The example program listed below recognizes the following operators and subexpressions, listed by precedence from highest to lowest:


- Constants, function calls, parentheses
- Exponentiation ^
- Unary minus -
- Multiplication and division *, /
- Integer division \
- Integer modulus MOD
- Addition and subtraction +, -
- Relational operators =, <>, <, >, <=, >=
- NOT
- AND
- OR
- XOR
- EQV
- IMP


The precedence of unary minus &quot;-&quot; and operator &quot;NOT&quot; indicate the highest possible precedence of their operand. Unary minus and &quot;NOT&quot; may occur in an expression of any precedence. The following expressions illustrate the precedence rules for unary minus and &quot;NOT&quot;.

Expression Value
---------- -----

-1 ^ 2 -1
-(1 ^ 2) -1
(-1) ^ 2 1
2 ^ -2 .25
NOT 0 = 1 -1
NOT (0 = 1) -1
(NOT 0) = 1 0
NOT 0 AND 1 1
(NOT 0) AND 1 1
NOT (0 AND 1) -1


The example program listed below accepts number constants written as decimal numbers with an optional fraction. For example, it accepts &quot;123&quot; and &quot;123.4&quot;. It is possible to modify the program to recognize hexadecimal, scientific notation, or other formats.
This example program also recognizes the following functions: ABS, ATN, COS, EXP, FIX, INT, LOG, RND, SNG, SIN, SQR, and TAN.



Steps to Create Example Program

Run Visual Basic, or from the File menu, choose New Project (press ALT, F, N) if Visual Basic is already running. Form1 will be created by default.

Add a text box (Text1) and a command button (Command1) to Form1.

Set the Text property for Text1 to the null string (empty).

Enter the following code in the Command1 Click event procedure:

Sub Command1_Click ()
Dim n As Double

If e_eval(Text1.Text, n) Then
MsgBox Format$(n)
End If
End Sub



Add the following code in the general Declarations section of Form1:

' To run this program in Visual Basic for MS-DOS, change the
' following Dim statements to DIM SHARED.
'
Dim e_input As String ' Expression input string.
Dim e_tok As String ' Current token kind.

Dim e_spelling As String ' Current token spelling.
Dim e_error As Integer ' Tells if syntax error occurred.

' e_eval
' Evaluate a string containing an infix numeric expression.
' If successful, return true and place result in <value>.
' This is the top-level function in the expression evaluator.

Function e_eval (ByVal s As String, value As Double) As Integer
' Initialize.
e_error = 0
e_input = s
Call e_nxt

' Evaluate.
value = e_prs(1)

' Check for unrecognized input.
If e_tok <> &quot;&quot; And Not e_error Then
MsgBox &quot;syntax error, token = '&quot; + e_spelling + &quot;'&quot;
e_error = -1
End If

e_eval = Not e_error

End Function

' e_prs
' Parse an expression, allowing operators of a specified
' precedence or higher. The lowest precedence is 1.
' This function gets tokens with e_nxt and recursively
' applies operator precedence rules.

Function e_prs (p As Integer) As Double
Dim n As Double ' Return value.
Dim fun As String ' Function name.

' Parse expression that begins with a token (precedence 12).
If e_tok = &quot;num&quot; Then
' number.
n = Val(e_spelling)
Call e_nxt
ElseIf e_tok = &quot;-&quot; Then
' unary minus.
Call e_nxt
n = -e_prs(11) ' Operand precedence 11.
ElseIf e_tok = &quot;not&quot; Then
' logical NOT.
Call e_nxt
n = Not e_prs(6) ' Operand precedence 6.
ElseIf e_tok = &quot;(&quot; Then
' parentheses.
Call e_nxt
n = e_prs(1)
Call e_match(&quot&quot
ElseIf e_tok = &quot;id&quot; Then
' Function call.
fun = e_spelling
Call e_nxt
Call e_match(&quot;(&quot
n = e_prs(1)
Call e_match(&quot&quot
n = e_function(fun, n)
Else
If Not e_error Then
MsgBox &quot;syntax error, token = '&quot; + e_spelling + &quot;'&quot;
e_error = -1
End If
End If

' Parse binary operators.

Do While Not e_error
If 0 Then ' To allow ElseIf .
ElseIf p <= 11 And e_tok = &quot;^&quot; Then Call e_nxt: n = n ^ e_prs(12)
ElseIf p <= 10 And e_tok = &quot;*&quot; Then Call e_nxt: n = n * e_prs(11)
ElseIf p <= 10 And e_tok = &quot;/&quot; Then Call e_nxt: n = n / e_prs(11)
ElseIf p <= 9 And e_tok = &quot;\&quot; Then Call e_nxt: n = n \ e_prs(10)
ElseIf p <= 8 And e_tok = &quot;mod&quot; Then Call e_nxt: n = n Mod e_prs(9)
ElseIf p <= 7 And e_tok = &quot;+&quot; Then Call e_nxt: n = n + e_prs(8)
ElseIf p <= 7 And e_tok = &quot;-&quot; Then Call e_nxt: n = n - e_prs(8)
ElseIf p <= 6 And e_tok = &quot;=&quot; Then Call e_nxt: n = n = e_prs(7)
ElseIf p <= 6 And e_tok = &quot;<&quot; Then Call e_nxt: n = n < e_prs(7)
ElseIf p <= 6 And e_tok = &quot;>&quot; Then Call e_nxt: n = n > e_prs(7)
ElseIf p <= 6 And e_tok = &quot;<>&quot; Then Call e_nxt: n = n <> e_prs(7)
ElseIf p <= 6 And e_tok = &quot;<=&quot; Then Call e_nxt: n = n <= e_prs(7)
ElseIf p <= 6 And e_tok = &quot;>=&quot; Then Call e_nxt: n = n >= e_prs(7)
ElseIf p <= 5 And e_tok = &quot;and&quot; Then Call e_nxt: n = n And e_prs(6)
ElseIf p <= 4 And e_tok = &quot;or&quot; Then Call e_nxt: n = n Or e_prs(5)
ElseIf p <= 3 And e_tok = &quot;xor&quot; Then Call e_nxt: n = n Xor e_prs(4)
ElseIf p <= 2 And e_tok = &quot;eqv&quot; Then Call e_nxt: n = n Eqv e_prs(3)
ElseIf p <= 1 And e_tok = &quot;imp&quot; Then Call e_nxt: n = n Imp e_prs(2)
Else
Exit Do
End If
Loop

e_prs = n

End Function

' e_function.
' Evaluate a function. This is a helper function to simplify
' e_prs.

Function e_function (fun As String, arg As Double) As Double
Dim n As Double

Select Case LCase$(fun)
Case &quot;abs&quot;: n = Abs(arg)
Case &quot;atn&quot;: n = Atn(arg)
Case &quot;cos&quot;: n = Cos(arg)
Case &quot;exp&quot;: n = Exp(arg)
Case &quot;fix&quot;: n = Fix(arg)
Case &quot;int&quot;: n = Int(arg)
Case &quot;log&quot;: n = Log(arg)
Case &quot;rnd&quot;: n = Rnd(arg)
Case &quot;sgn&quot;: n = Sgn(arg)
Case &quot;sin&quot;: n = Sin(arg)
Case &quot;sqr&quot;: n = Sqr(arg)
Case &quot;tan&quot;: n = Tan(arg)
Case Else
If Not e_error Then
MsgBox &quot;undefined function '&quot; + fun + &quot;'&quot;
e_error = -1
End If
End Select

e_function = n

End Function

' e_nxt
' Get the next token into e_tok and e_spelling and remove the
' token from e_input.
' This function groups the input into &quot;words&quot; like numbers,
' operators and function names.
Sub e_nxt ()
Dim is_keyword As Integer
Dim c As String ' Current input character.

e_tok = &quot;&quot;
e_spelling = &quot;&quot;

' Skip whitespace.
Do
c = Left$(e_input, 1)
e_input = Mid$(e_input, 2)
Loop While c = &quot; &quot; Or c = Chr$(9) Or c = Chr$(13) Or c = Chr$(10)

Select Case LCase$(c)

' Number constant. Modify this to support hexadecimal, etc.
Case &quot;0&quot; To &quot;9&quot;, &quot;.&quot;
e_tok = &quot;num&quot;
Do
e_spelling = e_spelling + c
c = Left$(e_input, 1)
e_input = Mid$(e_input, 2)
Loop While (c >= &quot;0&quot; And c <= &quot;9&quot Or c = &quot;.&quot;
e_input = c + e_input

' Identifier or keyword.
Case &quot;a&quot; To &quot;z&quot;, &quot;_&quot;
e_tok = &quot;id&quot;
Do
e_spelling = e_spelling + c
c = LCase$(Left$(e_input, 1))
e_input = Mid$(e_input, 2)
is_id% = (c >= &quot;a&quot; And c <= &quot;z&quot
is_id% = is_id% Or c = &quot;_&quot; Or (c >= &quot;0&quot; And c <= &quot;9&quot
Loop While is_id%
e_input = c + e_input

' Check for keyword.
is_keyword = -1
Select Case LCase$(e_spelling)
Case &quot;and&quot;
Case &quot;eqv&quot;
Case &quot;imp&quot;
Case &quot;mod&quot;
Case &quot;not&quot;
Case &quot;or&quot;
Case &quot;xor&quot;
Case Else: is_keyword = 0
End Select
If is_keyword Then
e_tok = LCase$(e_spelling)
End If

' Check for <=, >=, <>.
Case &quot;<&quot;, &quot;>&quot;
e_tok = c
c = Left$(e_input, 1)
If c = &quot;=&quot; Or c = &quot;>&quot; Then
e_tok = e_tok + c
e_input = Mid$(e_input, 2)
End If

' Single character token.
Case Else
e_tok = c
End Select

If e_spelling = &quot;&quot; Then
e_spelling = e_tok
End If
End Sub

' e_match
' Check the current token and skip past it.
' This function helps with syntax checking.
Sub e_match (token As String)
If Not e_error And e_tok <> token Then
MsgBox &quot;expected &quot; + token + &quot;, got '&quot; + e_spelling + &quot;'&quot;
e_error = -1
End If
Call e_nxt
End Sub



Press F5 to run the program. Type an expression into Text1 such as &quot;1+2*3^4&quot;. Click Command1.

The program displays the result, 163 in this case.



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

Additional reference words: 1.00 2.00 3.00
KBCategory: kbprg kbcode
KBSubcategory: PrgCtrlsStd


THE INFORMATION PROVIDED IN THE MICROSOFT KNOWLEDGE BASE IS PROVIDED &quot;AS IS&quot; WITHOUT WARRANTY OF ANY KIND. MICROSOFT DISCLAIMS ALL WARRANTIES, EITHER EXPRESS OR IMPLIED, INCLUDING THE WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT SHALL MICROSOFT CORPORATION OR ITS SUPPLIERS BE LIABLE FOR ANY DAMAGES WHATSOEVER INCLUDING DIRECT, INDIRECT, INCIDENTAL, CONSEQUENTIAL, LOSS OF BUSINESS PROFITS OR SPECIAL DAMAGES, EVEN IF MICROSOFT CORPORATION OR ITS SUPPLIERS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. SOME STATES DO NOT ALLOW THE EXCLUSION OR LIMITATION OF LIABILITY FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES SO THE FOREGOING LIMITATION MAY NOT APPLY.


It's a lot of coding for a really simple thing, it's a shame that VB doesn't have an eval function to give you the result back.
Hope it help, if I find other thing I post here.
 
sale-70-410-exam    | Exam-200-125-pdf    | we-sale-70-410-exam    | hot-sale-70-410-exam    | Latest-exam-700-603-Dumps    | Dumps-98-363-exams-date    | Certs-200-125-date    | Dumps-300-075-exams-date    | hot-sale-book-C8010-726-book    | Hot-Sale-200-310-Exam    | Exam-Description-200-310-dumps?    | hot-sale-book-200-125-book    | Latest-Updated-300-209-Exam    | Dumps-210-260-exams-date    | Download-200-125-Exam-PDF    | Exam-Description-300-101-dumps    | Certs-300-101-date    | Hot-Sale-300-075-Exam    | Latest-exam-200-125-Dumps    | Exam-Description-200-125-dumps    | Latest-Updated-300-075-Exam    | hot-sale-book-210-260-book    | Dumps-200-901-exams-date    | Certs-200-901-date    | Latest-exam-1Z0-062-Dumps    | Hot-Sale-1Z0-062-Exam    | Certs-CSSLP-date    | 100%-Pass-70-383-Exams    | Latest-JN0-360-real-exam-questions    | 100%-Pass-4A0-100-Real-Exam-Questions    | Dumps-300-135-exams-date    | Passed-200-105-Tech-Exams    | Latest-Updated-200-310-Exam    | Download-300-070-Exam-PDF    | Hot-Sale-JN0-360-Exam    | 100%-Pass-JN0-360-Exams    | 100%-Pass-JN0-360-Real-Exam-Questions    | Dumps-JN0-360-exams-date    | Exam-Description-1Z0-876-dumps    | Latest-exam-1Z0-876-Dumps    | Dumps-HPE0-Y53-exams-date    | 2017-Latest-HPE0-Y53-Exam    | 100%-Pass-HPE0-Y53-Real-Exam-Questions    | Pass-4A0-100-Exam    | Latest-4A0-100-Questions    | Dumps-98-365-exams-date    | 2017-Latest-98-365-Exam    | 100%-Pass-VCS-254-Exams    | 2017-Latest-VCS-273-Exam    | Dumps-200-355-exams-date    | 2017-Latest-300-320-Exam    | Pass-300-101-Exam    | 100%-Pass-300-115-Exams    |
http://www.portvapes.co.uk/    | http://www.portvapes.co.uk/    |