📄 form1b.frm
字号:
TabIndex = 12
Top = 2460
Width = 555
End
Begin VB.TextBox txt_x_val
Height = 315
Index = 5
Left = 1110
TabIndex = 11
Top = 2100
Width = 555
End
Begin VB.TextBox txt_x_val
Height = 315
Index = 4
Left = 1110
TabIndex = 10
Top = 1740
Width = 555
End
Begin VB.TextBox txt_x_val
Height = 315
Index = 3
Left = 1110
TabIndex = 9
Top = 1380
Width = 555
End
Begin VB.TextBox txt_x_val
Height = 315
Index = 2
Left = 1110
TabIndex = 8
Text = "2"
Top = 1020
Width = 555
End
Begin VB.TextBox txt_x_val
Height = 315
Index = 1
Left = 1110
TabIndex = 7
Text = "0"
Top = 660
Width = 555
End
Begin VB.TextBox txt_x_val
Height = 315
Index = 0
Left = 1110
TabIndex = 6
Text = "-1"
Top = 300
Width = 555
End
Begin VB.ComboBox Combo1
Height = 315
Left = 150
Style = 2 'Dropdown List
TabIndex = 3
Top = 690
Width = 645
End
Begin VB.CommandButton cmdSOLVE
Caption = "Calculate the coefficients"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 161
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 1110
TabIndex = 2
Top = 3960
Width = 2955
End
Begin VB.Label Label2
Caption = "Polynomial:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 161
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 225
Left = 4140
TabIndex = 37
Top = 60
Width = 1215
End
Begin VB.Label Label5
Caption = "Poly. coefficients:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 161
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 225
Left = 2430
TabIndex = 5
Top = 60
Width = 1665
End
Begin VB.Label Label3
Caption = "Number of Data points:"
Height = 435
Left = 60
TabIndex = 4
Top = 180
Width = 855
End
Begin VB.Label Label1
Alignment = 2 'Center
Caption = "yi"
Height = 195
Index = 1
Left = 1710
TabIndex = 1
Top = 60
Width = 555
End
Begin VB.Label Label1
Alignment = 2 'Center
Caption = "xi"
Height = 195
Index = 0
Left = 1110
TabIndex = 0
Top = 60
Width = 555
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Polynomial interpolation
'------------------------
'Polynomial interpolation is the interpolation of a given data set by a polynomial.
'Given some data points {xi, yi}, the aim is to find a polynomial which goes exactly
'through these points. This program calculates the coefficients of that polynomial.
'(c) 2006, Vagelis Plevris, Greece
'mailto: vplevris@tee.gr
Private Sub Form_Load()
'Give numbers 1-10 to combo1 (available numbers for data points)
For n = 1 To 10
Combo1.AddItem n
Next n
'Default = 3 (Polynomial degree 3-1 = 2, thus a polynomial of the kind a*x^2 + b*x + c)
Combo1.Text = 3
Call Hide_Show_Textboxes
End Sub
Private Sub Combo1_Click()
Call Hide_Show_Textboxes
End Sub
Private Sub cmdSOLVE_Click()
Call Build_Matrices
Call Build_Triangular_Matrix
Call Back_Substitution
End Sub
Sub Hide_Show_Textboxes()
Data_POINTS = Val(Combo1.Text) 'Data_POINTS = Degree of the polynomial + 1 = Dimension of the linear system
'Hide all textboxes
For n = 0 To 9
txt_x_val(n).Visible = False
txt_y_val(n).Visible = False
txt_coeff(n).Visible = False
Next n
'Show the appropriate textboxes for the Data_POINTS given
For n = 0 To Data_POINTS - 1
txt_x_val(n).Visible = True 'Array {xi}
txt_y_val(n).Visible = True 'Array {yi}
txt_coeff(n).Visible = True 'Polynomial coefficients - Solution to be calculated
Next n
End Sub
Sub Build_Matrices()
'Builds the [A] and {B} Matrices of the linear system [A]*{x}={B} to be solved, assigning values from the textboxes
'Matrix_A dimensions are set to max 10x10 for the interface needs, yet they can be increased to whatever
'Build Matrix_A
For n = 1 To Data_POINTS
For m = 1 To Data_POINTS
Matrix_A(n, m) = Val(txt_x_val(n - 1)) ^ (m - 1)
Next m
Next n
'Build Array_Yi (Constants)
For n = 1 To Data_POINTS
Array_Yi(n) = Val(txt_y_val(n - 1))
Next n
End Sub
Sub Build_Triangular_Matrix()
'Uses Gauss elimination method in order to build a triangular matrix from the matrix [A]
'Triangularized Matrix Triangular_A has dimensions (Data_POINTS x Data_POINTS + 1)
'because it also includes the array {yi} with the constants:
'[ a11 a12 a13 | y1 ]
'[ a21 a22 a23 | y2 ]
'[ a31 a32 a33 | y3 ] etc
On Error GoTo errhandler 'In case the system cannot be solved (Matrix_A Determinant = 0)
Solution_Problem = False
'Assign values from matrix [A]
For n = 1 To 10
For m = 1 To 10
Triangular_A(m, n) = Matrix_A(m, n)
Next
Next
'Assign values from array {yi}
For n = 1 To Data_POINTS
Triangular_A(n, Data_POINTS + 1) = Array_Yi(n)
Next n
'Triangularize the matrix
For k = 1 To Data_POINTS - 1
'Bring a non-zero element first by changing lines, if necessary
If Triangular_A(k, k) = 0 Then
For n = k To Data_POINTS
If Triangular_A(n, k) <> 0 Then line_1 = n: Exit For 'Finds line_1 with non-zero element
Next n
'Change line k with line_1
For m = k To Data_POINTS
temporary_1 = Triangular_A(k, m)
Triangular_A(k, m) = Triangular_A(line_1, m)
Triangular_A(line_1, m) = temporary_1
Next m
End If
'For other lines, make a zero element by using:
'Ai1=Aij-A11*(Aij/A11)
'and change all the line using the same formula for other elements
For n = k + 1 To Data_POINTS
If Triangular_A(n, k) <> 0 Then 'if it is zero, stays as it is
multiplier_1 = Triangular_A(n, k) / Triangular_A(k, k)
For m = k To Data_POINTS + 1
Triangular_A(n, m) = Triangular_A(n, m) - Triangular_A(k, m) * multiplier_1
Next m
End If
Next n
Next k
Exit Sub
'In case an error occurs...
errhandler:
message$ = "An error occured during the solution process. Make sure that the system is stable and can be solved."
response = MsgBox(message$, vbCritical)
Solution_Problem = True
End Sub
Sub Back_Substitution()
'Calculates the Solution array (of the coefficients {ci}) using back substitution
On Error GoTo errhandler 'In case the system cannot be solved
If Solution_Problem = True Then Exit Sub 'No point in back substituting to find the solution {ci}
'First, calculate last ci (for i = Data_POINTS)
Coefficients(Data_POINTS) = Triangular_A(Data_POINTS, Data_POINTS + 1) / Triangular_A(Data_POINTS, Data_POINTS)
'Back substitution for the other ci:
For n = 1 To Data_POINTS - 1
sum_1 = 0
For m = 1 To n
sum_1 = sum_1 + Coefficients(Data_POINTS + 1 - m) * Triangular_A(Data_POINTS - n, Data_POINTS + 1 - m)
Next m
Coefficients(Data_POINTS - n) = (Triangular_A(Data_POINTS - n, Data_POINTS + 1) - sum_1) / Triangular_A(Data_POINTS - n, Data_POINTS - n)
Next n
'Type the solution to the textboxes
poly$ = "P(x) = "
For n = 1 To Data_POINTS
txt_coeff(n - 1).Text = CStr(Coefficients(n))
poly$ = poly$ + "+ (" + CStr(Coefficients(n)) + ")" + " *x^" + CStr(n - 1) + " "
Next n
txt_Poly.Text = poly$
Exit Sub
'In case an error occurs...
errhandler:
message$ = "An error occured during the solution process. Make sure that the system is stable and can be solved."
response = MsgBox(message$, vbCritical)
Solution_Problem = True
'Note that an error always occures when the same xi corresponds to different values of yi, for example two data points {xi,3} and {xi,5}
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -