VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   6840
   ClientLeft      =   60
   ClientTop       =   510
   ClientWidth     =   9765
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   6840
   ScaleWidth      =   9765
   StartUpPosition =   3  '系統預設值
   Begin VB.CommandButton CmdExecute 
      Caption         =   "Go"
      Height          =   495
      Left            =   6960
      TabIndex        =   23
      Top             =   1800
      Width           =   975
   End
   Begin VB.TextBox txtAns 
      Height          =   855
      Left            =   1200
      MultiLine       =   -1  'True
      TabIndex        =   21
      Text            =   "FrnNomlinearEquation.frx":0000
      Top             =   5280
      Width           =   5415
   End
   Begin VB.ListBox ListA 
      BeginProperty Font 
         Name            =   "新細明體"
         Size            =   9.75
         Charset         =   136
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1230
      Left            =   0
      TabIndex        =   19
      ToolTipText     =   "雙擊以輸入函數"
      Top             =   360
      Width           =   9495
   End
   Begin VB.CommandButton CndNewton 
      Caption         =   "Newton"
      Height          =   255
      Left            =   3600
      TabIndex        =   18
      Top             =   6360
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.CommandButton CmdSteepest 
      Caption         =   "Steepest"
      Height          =   375
      Left            =   1920
      TabIndex        =   17
      Top             =   6360
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.TextBox txtVarsI 
      Height          =   375
      Left            =   4800
      TabIndex        =   15
      Text            =   "Text1"
      Top             =   1680
      Width           =   1815
   End
   Begin VB.TextBox txtEqs 
      Height          =   375
      Index           =   5
      Left            =   1200
      MultiLine       =   -1  'True
      TabIndex        =   9
      Text            =   "FrnNomlinearEquation.frx":0006
      Top             =   4560
      Width           =   5415
   End
   Begin VB.TextBox txtEqs 
      Height          =   375
      Index           =   4
      Left            =   1200
      MultiLine       =   -1  'True
      TabIndex        =   8
      Text            =   "FrnNomlinearEquation.frx":000C
      Top             =   4080
      Width           =   5415
   End
   Begin VB.TextBox txtEqs 
      Height          =   375
      Index           =   3
      Left            =   1200
      MultiLine       =   -1  'True
      TabIndex        =   7
      Text            =   "FrnNomlinearEquation.frx":0012
      Top             =   3600
      Width           =   5415
   End
   Begin VB.TextBox txtEqs 
      Height          =   375
      Index           =   2
      Left            =   1200
      MultiLine       =   -1  'True
      TabIndex        =   6
      Text            =   "FrnNomlinearEquation.frx":0018
      Top             =   3120
      Width           =   5415
   End
   Begin VB.TextBox txtEqs 
      Height          =   375
      Index           =   1
      Left            =   1200
      MultiLine       =   -1  'True
      TabIndex        =   5
      Text            =   "FrnNomlinearEquation.frx":001E
      Top             =   2640
      Width           =   5415
   End
   Begin VB.TextBox txtEqs 
      Height          =   375
      Index           =   0
      Left            =   1200
      MultiLine       =   -1  'True
      TabIndex        =   3
      Text            =   "FrnNomlinearEquation.frx":0024
      Top             =   2160
      Width           =   5415
   End
   Begin VB.TextBox txtVars 
      Height          =   375
      Left            =   1200
      TabIndex        =   1
      Text            =   "Text1"
      Top             =   1680
      Width           =   2415
   End
   Begin VB.PictureBox PicPrint 
      AutoRedraw      =   -1  'True
      Height          =   3255
      Left            =   7560
      ScaleHeight     =   3195
      ScaleWidth      =   1995
      TabIndex        =   0
      Top             =   2880
      Visible         =   0   'False
      Width           =   2055
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackColor       =   &H008080FF&
      Caption         =   "Answer"
      Height          =   180
      Left            =   3600
      TabIndex        =   22
      Top             =   5040
      Width           =   525
   End
   Begin VB.Label Label16 
      Alignment       =   1  '靠右對齊
      AutoSize        =   -1  'True
      Caption         =   "(1)請雙擊選擇函數:"
      BeginProperty Font 
         Name            =   "新細明體"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   180
      Left            =   480
      TabIndex        =   20
      Top             =   120
      Width           =   1515
   End
   Begin VB.Label LblVarsI 
      AutoSize        =   -1  'True
      Caption         =   "Initial Values"
      Height          =   180
      Left            =   3720
      TabIndex        =   16
      Top             =   1680
      Width           =   915
   End
   Begin VB.Label lbleqs 
      AutoSize        =   -1  'True
      Caption         =   "Eq_6:"
      Height          =   180
      Index           =   5
      Left            =   240
      TabIndex        =   14
      Top             =   4560
      Width           =   420
   End
   Begin VB.Label lbleqs 
      AutoSize        =   -1  'True
      Caption         =   "Eq_5:"
      Height          =   180
      Index           =   4
      Left            =   240
      TabIndex        =   13
      Top             =   4080
      Width           =   420
   End
   Begin VB.Label lbleqs 
      AutoSize        =   -1  'True
      Caption         =   "Eq_4:"
      Height          =   180
      Index           =   3
      Left            =   240
      TabIndex        =   12
      Top             =   3600
      Width           =   420
   End
   Begin VB.Label lbleqs 
      AutoSize        =   -1  'True
      Caption         =   "Eq_3:"
      Height          =   180
      Index           =   2
      Left            =   240
      TabIndex        =   11
      Top             =   3120
      Width           =   420
   End
   Begin VB.Label lbleqs 
      AutoSize        =   -1  'True
      Caption         =   "Eq_2:"
      Height          =   180
      Index           =   1
      Left            =   240
      TabIndex        =   10
      Top             =   2640
      Width           =   420
   End
   Begin VB.Label lbleqs 
      AutoSize        =   -1  'True
      Caption         =   "Eq_1:"
      Height          =   180
      Index           =   0
      Left            =   240
      TabIndex        =   4
      Top             =   2160
      Width           =   420
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Varaiabls:(x,y,z)"
      Height          =   180
      Left            =   0
      TabIndex        =   2
      Top             =   1680
      Width           =   1155
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim stArray() As String, stEqs() As String
Dim stArrayA() As String
Dim math As New ClsMath

Private Sub CmdExecute_Click()
Dim i As Integer
ReDim stEqs(1 To nEq)
For i = 1 To nEq
stEqs(i) = txtEqs(i - 1).Text
Next i

stArray = Split(txtVars.Text, ",", -1, vbTextCompare)
For i = 0 To UBound(stArray)
    ReDim Preserve xVS(1 To i + 1)
    xVS(i + 1) = stArray(i)
    'MsgBox ("XVS=" & xVS(i + 1))
Next i
stArray = Split(txtVarsI.Text, ",", -1, vbTextCompare)
For i = 0 To UBound(stArray)
    ReDim Preserve xVI(1 To i + 1)
    xVI(i + 1) = Val(stArray(i))
     'MsgBox ("XVI=" & xVI(i + 1))
Next i
For i = 0 To nEq - 1
    ReDim Preserve glVbScriptA(0 To i)
    Set glVbScriptA(i) = New MSScriptControl.ScriptControl
    glVbScriptA(i).Language = "VBScript"
    glVbScriptA(i).AddObject "math", math, True
Next i
 Dim XAns() As Double
If nEq = 3 Then
SteepEstMethod PicPrint, "y", nEq, stEqs, xVS, xVI, 30, 0.0001, XAns
 ReDim Preserve XAns(1 To nEq)
 For i = 1 To nEq
  xVI(i) = XAns(i)
  Next
End If
 NewtonMethod PicPrint, "y", nEq, stEqs, xVS, xVI, 30, 0.00001, XAns
 ReDim Preserve XAns(1 To nEq)
 Dim stTpt As String
 stTpt = "x1= " & XAns(1) & vbNewLine
 For i = 2 To nEq
 stTpt = stTpt & "x" & i & "= " & XAns(i) & vbNewLine
 Next i
 txtAns.Text = stTpt
 
 Dim fxyzs() As Double
 ReDim fxyzs(1 To nEq)
 For i = 1 To nEq
 xVI(i) = XAns(i)
 Next i
 For i = 1 To nEq
  fxyzs(i) = FunctionValues(glVbScriptA(i - 1), stEqs(i), xVS, xVI)
  Next i
  
  If nEq = 3 Then
  Form1.Caption = "Fxyz1= " & Round(fxyzs(1), 7) & ";Fxyz2= " & Round(fxyzs(2), 7) & ";Fxyz3= " & Round(fxyzs(3), 7)
  Else
  Form1.Caption = "Fxyz1= " & Round(fxyzs(1), 7) & ";Fxyz2= " & Round(fxyzs(2), 7)
  End If
End Sub

Private Sub CmdSteepest_Click()
Dim i As Integer
For i = 1 To 6
lbleqs(i - 1).Visible = False
txtEqs(i - 1).Visible = False
Next i
nEq = 3
txtVars.Text = "x1,x2,x3"
txtVarsI.Text = "0.0,0.0,0.0"
For i = 1 To nEq
lbleqs(i - 1).Visible = True
txtEqs(i - 1).Visible = True
Next i
'txtEqs(0).Text = "3*x1-cos(x2*x3)-0.5"
'txtEqs(1).Text = "x1*x1-81*(x2+0.1)^2+sin(x3)+1.06"
'txtEqs(2).Text = "exp(-x1*x2)+20*x3+(10*pi-3)/3"
txtEqs(0).Text = "2*x1-3*x2+x3-4" ' "3*x1-cos(x2*x3)-0.5"
txtEqs(1).Text = "2*x1+x2-x3+4" '"x1*x1-81*(x2+0.1)^2+sin(x3)+1.06"
txtEqs(2).Text = "x1*x1+x2*x2+x3*x3-4" '"exp(-x1*x2)+20*x3+(10*pi-3)/3"
ReDim stEqs(1 To nEq)
stEqs(1) = txtEqs(0).Text
stEqs(2) = txtEqs(1).Text
stEqs(3) = txtEqs(2).Text

stArray = Split(txtVars.Text, ",", -1, vbTextCompare)
For i = 0 To UBound(stArray)
    ReDim Preserve xVS(1 To i + 1)
    xVS(i + 1) = stArray(i)
    'MsgBox ("XVS=" & xVS(i + 1))
Next i
stArray = Split(txtVarsI.Text, ",", -1, vbTextCompare)
For i = 0 To UBound(stArray)
    ReDim Preserve xVI(1 To i + 1)
    xVI(i + 1) = Val(stArray(i))
    ' MsgBox ("XVI=" & xVI(i + 1))
Next i
For i = 0 To nEq - 1
    ReDim Preserve glVbScriptA(0 To i)
    Set glVbScriptA(i) = New MSScriptControl.ScriptControl
    glVbScriptA(i).Language = "VBScript"
    glVbScriptA(i).AddObject "math", math, True
Next i

 Dim Vvars() As Double
 ReDim Vvars(1 To 3)
 Vvars(1) = 1
 Vvars(2) = 0
 Vvars(3) = 0
 
 Dim stEq As String
 stEq = "x1+x2+x3+3*x1*x2"
 Dim ans As Double
 ans = FunctionValues(glVbScriptA(0), stEq, xVS, Vvars)
 'msgbox ("ans=" & ans)
 
 Dim pxpx1 As Double
 pxpx1 = PartialDif(glVbScriptA(1), stEq, xVS, Vvars, 2)
 'msgbox ("pxpx1=" & pxpx1)
 Dim XAns() As Double
 'NewtonMethod PicPrint, "y", nEq, stEqs, xVS, xVI, 20, 0.0001
 SteepEstMethod PicPrint, "y", nEq, stEqs, xVS, xVI, 20, 0.0001, XAns
End Sub

Private Sub CndNewton_Click()
Dim i As Integer
For i = 1 To 6
lbleqs(i - 1).Visible = False
txtEqs(i - 1).Visible = False
Next i
nEq = 3
'txtVars.Text = "x1,x2,x3,x4"
'txtVarsI.Text = "0.0,0.0,0.0,0,0"
txtVars.Text = "x1,x2,x3"
txtVarsI.Text = "-0.79,-1.54,0.97"
For i = 1 To nEq
lbleqs(i - 1).Visible = True
txtEqs(i - 1).Visible = True
Next i
txtEqs(0).Text = "2*x1-3*x2+x3-4" ' "3*x1-cos(x2*x3)-0.5"
txtEqs(1).Text = "2*x1+x2-x3+4" '"x1*x1-81*(x2+0.1)^2+sin(x3)+1.06"
txtEqs(2).Text = "x1*x1+x2*x2+x3*x3-4" '"exp(-x1*x2)+20*x3+(10*pi-3)/3"
'txtEqs(3).Text = "x1+x2+x3+x4-5"
ReDim stEqs(1 To nEq)
For i = 1 To nEq
stEqs(i) = txtEqs(i - 1).Text
Next i

stArray = Split(txtVars.Text, ",", -1, vbTextCompare)
For i = 0 To UBound(stArray)
    ReDim Preserve xVS(1 To i + 1)
    xVS(i + 1) = stArray(i)
    'MsgBox ("XVS=" & xVS(i + 1))
Next i
stArray = Split(txtVarsI.Text, ",", -1, vbTextCompare)
For i = 0 To UBound(stArray)
    ReDim Preserve xVI(1 To i + 1)
    xVI(i + 1) = Val(stArray(i))
    ' MsgBox ("XVI=" & xVI(i + 1))
Next i
For i = 0 To nEq - 1
    ReDim Preserve glVbScriptA(0 To i)
    Set glVbScriptA(i) = New MSScriptControl.ScriptControl
    glVbScriptA(i).Language = "VBScript"
    glVbScriptA(i).AddObject "math", math, True
Next i
 Dim XAns() As Double
 SteepEstMethod PicPrint, "y", nEq, stEqs, xVS, xVI, 10, 0.05, XAns
 ReDim Preserve XAns(1 To nEq)
 For i = 1 To nEq
  xVI(i) = XAns(i)
  Next
 NewtonMethod PicPrint, "y", nEq, stEqs, xVS, xVI, 20, 0.0001, XAns
End Sub

Private Sub Form_Load()
Dim i As Integer
        For i = 1 To 6
        lbleqs(i - 1).Visible = False
        txtEqs(i - 1).Visible = False
        Next i
        
                       Dim stEqsIn() As String
                         ListA.Clear
                         ReDim stEqsIn(1 To 2)
                        stEqsIn(1) = "x1^2-2*x2-2"
                        stEqsIn(2) = "x1-x2^3-1"
                        ListA.AddItem " Eq_1 =" & stEqsIn(1) & " ;Eq_2=" & stEqsIn(2)
                     
                        
                        ReDim stEqsIn(1 To 2)
                        stEqsIn(1) = "2*x1^2-20*x1+0.25*x2^2+8"
                        stEqsIn(2) = "0.5*x1*x2^2+2*x1-5*x2+8"
                        ListA.AddItem " Eq_1 =" & stEqsIn(1) & " ;Eq_2=" & stEqsIn(2)
                        
             'Case 2
                         ReDim stEqsIn(1 To 2)
                        stEqsIn(1) = "sin(4*pi*x1*x2)-2*x2-x1"
                        stEqsIn(2) = "((4*pi-1)/4/pi)*(exp(2*x1)-exp(1))+4*exp(1)*x2^2-2*exp(1)*x1"
                        ListA.AddItem " Eq_1 =" & stEqsIn(1) & " ;Eq_2=" & stEqsIn(2)
             'Case 3
                        ReDim stEqsIn(1 To 3)
                        stEqsIn(1) = "3*x1-cos(x2*x3)-0.5"
                        stEqsIn(2) = "4*x1^2-625*x2^2+2*x2-1"
                        stEqsIn(3) = "exp(-x1*x2)+20*x3+(10*pi-3)/3"
                         ListA.AddItem " Eq_1 =" & stEqsIn(1) & " ;Eq_2=" & stEqsIn(2) & " ;Eq_3=" & stEqsIn(3)
             'Case 4
                          ReDim stEqsIn(1 To 3)
                        stEqsIn(1) = "x1^2+x2+x3-20"
                        stEqsIn(2) = "x1-x2^2-5"
                        stEqsIn(3) = "x1+x2+x3-13"
                         ListA.AddItem " Eq_1 =" & stEqsIn(1) & " ;Eq_2=" & stEqsIn(2) & " ;Eq_3=" & stEqsIn(3)
             'Case 5
                        ReDim stEqsIn(1 To 2)
                        stEqsIn(1) = "5*x1^2-x2^2"
                        stEqsIn(2) = "x2-0.25*(sin(x1)+cos(x2))"
                         ListA.AddItem " Eq_1 =" & stEqsIn(1) & " ;Eq_2=" & stEqsIn(2)
             'Case 6
                         ReDim stEqsIn(1 To 3)
                        stEqsIn(1) = "15*x1+x2^2+4*x3-13"
                        stEqsIn(2) = "x1^2+10*x2-x3-11"
                        stEqsIn(3) = "x2^3-25*x3+22"
                         ListA.AddItem " Eq_1 =" & stEqsIn(1) & " ;Eq_2=" & stEqsIn(2) & " ;Eq_3=" & stEqsIn(3)
             'Case 7
                         ReDim stEqsIn(1 To 3)
                        stEqsIn(1) = "10*x1-2*x2^2-2*x3-5"
                        stEqsIn(2) = "8*x2^2+4*x3^2-9"
                        stEqsIn(3) = "8*x2*x3+4"
                         ListA.AddItem " Eq_1 =" & stEqsIn(1) & " ;Eq_2=" & stEqsIn(2) & " ;Eq_3=" & stEqsIn(3)
              'Case 8
                         ReDim stEqsIn(1 To 3)
                        stEqsIn(1) = "2*x1-3*x2-x3-4"
                        stEqsIn(2) = "2*x1+x2-x3+4"
                        stEqsIn(3) = "x1^2+x2^2+x3^2-4"
                         ListA.AddItem " Eq_1 =" & stEqsIn(1) & " ;Eq_2=" & stEqsIn(2) & " ;Eq_3=" & stEqsIn(3)
End Sub

        
        
 Sub ListA_DblClick()
        Dim i As Integer, stTptA As String, stTptB As String
        For i = 1 To 6
        lbleqs(i - 1).Visible = False
        txtEqs(i - 1).Visible = False
        Next i
        Dim stArray() As String, stArrayA() As String
        Dim stFunctionIn As String
        stFunctionIn = ListA.List(ListA.ListIndex)
        'MsgBox ("ST=" & stFunctionIn)
        If stFunctionIn = "" Then Exit Sub
        stArray = Split(stFunctionIn, ";", -1, vbTextCompare)
        nEq = UBound(stArray) + 1
        For i = 1 To nEq
        ReDim Preserve stEqs(1 To i)
        stArrayA = Split(stArray(i - 1), "=", -1, vbTextCompare)
        stEqs(i) = stArrayA(1)
        Next i
        
        For i = 1 To nEq
        lbleqs(i - 1).Visible = True
        txtEqs(i - 1).Visible = True
        txtEqs(i - 1).Text = stEqs(i)
        Next i
        
        stTptA = "x1"
        stTptB = "0"
        For i = 2 To nEq
        stTptA = stTptA & Trim(",x" & i)
        stTptB = stTptB & Trim(",0")
        Next
          txtVars.Text = stTptA
          txtVarsI.Text = stTptB
End Sub
