黄金分割法求函数最小值

'测试表达式 x^2+2*x'测试区间[-3 5]'

测试精度e=0.2

'书上最小值x=-1.0255 f=-0.999

Function RESULT(ByVal expression As String, ByVal x As String) As Single 

     Dim tmpStr As String      

    tmpStr = Replace(UCase(expression), "LN", "Log")     

     tmpStr = Replace(tmpStr, "X", x)     

     Dim OBJ As Object     

      Set OBJ = CreateObject("MSScriptControl.ScriptControl")    

       OBJ.Language = "vbscript"    

       RESULT = OBJ.Eval(tmpStr)     

      Set OBJ = Nothing 

   End Function

Private Sub Command1_Click()

Dim e As Single

Dim a1 As String

Dim a3 As String

Const r = 0.618

Dim f As String

f = InputBox("输入表达式")

a1 = InputBox("输入区间左则值")

a3 = InputBox("输入区间右则值")

e = CSng(InputBox("输入允许误差值"))

a11: a11 = CStr(CSng(a3) - r * (CSng(a3) - CSng(a1))) 

  f1 = RESULT(f, a11)  

  a12:  a12 = CStr(CSng(a1) + r * (CSng(a3) - a1)) 

 f2 = RESULT(f, a12)

 22: If Abs((f2 - f1) / f1) <= e Then        

    If Abs((CSng(a12) - CSng(a11)) / CSng(a11)) <= e Then     

            GoTo 33    

         Else           

      a1 = CStr(a11)    

             a3 = CStr(a12)   

              GoTo a11       

      End If  

 Else            If f1 > f2 Then       

      a1 = CStr(a11)         

     a11 = CStr(a12)        

     f1 = f2          

   GoTo a12         

   Else     

        a3 = CStr(a12)    

          a12 = CStr(a11)  

           f2 = f1        

    a11 = CStr(CSng(a3) - r * (CSng(a3) - CSng(a1)))      

      f1 = RESULT(f, a11)    

        GoTo 22      

      End If  

 End If

33: If f1 > f2 Then

  ax = CSng(a12) 

 fax = RESULT(f, a12)  

Else  

 ax = CSng(a11) 

 fax = RESULT(f, a11) 

 End If

 Print "最小值ax=" & ax Print "

最小值fax=" & fax

End Sub

Private Sub Form_Load()

Form1.WindowState = 2

End Sub