13518219792
Dim x() As Double
创新互联公司是一家企业级云计算解决方案提供商,超15年IDC数据中心运营经验。主营GPU显卡服务器，站群服务器，香港机房服务器托管，海外高防服务器，机柜大带宽，动态拨号VPS，海外云手机，海外云服务器，海外服务器租用托管等。
Dim y() As Double
Dim xz() As Double
Dim c() As Double
Dim d() As Double
Dim a() As Double
Dim am, bm, cm As Double
dim m,n as long ’m为点的个数，n为自变量个数，一元当然就是1
ReDim x(m, n)'自变量矩阵
ReDim y(m)'因变量矩阵
ReDim xz(n, m)'x（）的转置
ReDim c(n, 2 * n)'增广矩阵
ReDim d(n, m)'这个忘了是啥，过渡用的
ReDim a(n)'回归系数矩阵
For i = 1 To m
x(i, 1) = 1
Next i
For i = 1 To m
For j = 2 To n
x(i, j) = VSFGrid1.TextMatrix(i, j - 1)
Next j
Next i
For i = 1 To m
y(i) = VSFGrid1.TextMatrix(i, n)
Next i
'a=(x'*x)^-1*x'*y
For i = 1 To n
For j = 1 To m
xz(i, j) = x(j, i) '转置
Next j
Next i
For i = 1 To n
For j = 1 To 2 * n
If j = i + n Then
c(i, j) = 1
Else
c(i, j) = 0
End If
Next j
Next i
For i = 1 To n
For j = 1 To n
For k = 1 To m
c(i, j) = c(i, j) + xz(i, k) * x(k, j) '求xz()*x()
Next k
Next j
Next i
For k = 1 To n '用主元除主元所在行的所有元素
am = 1 / c(k, k) '将主元变为1
For j = k To 2 * n
c(k, j) = c(k, j) * am
Next j
'____________________________________
For i = k + 1 To n '将原矩阵变为下三角矩阵
bm = c(i, k)
For j = 1 To 2 * n
c(i, j) = c(i, j) - c(k, j) * bm
Next j
Next i
Next k
'------------------------------------------------
For k = 2 To n
For i = 1 To k - 1 '将下三角矩阵变为单位阵
cm = c(i, k)
For j = k To 2 * n
c(i, j) = c(i, j) - c(k, j) * cm
Next j
Next i
Next k
'------------------------------------------------
For i = 1 To n
For j = 1 To n
c(i, j) = c(i, j + n)
Next j
Next i
For i = 1 To n
For j = 1 To m
For k = 1 To n
d(i, j) = d(i, j) + c(i, k) * xz(k, j)
Next k
Next j
Next i
For i = 1 To n
For j = 1 To m
a(i) = a(i) + d(i, j) * y(j)
Next j
Next i
稍等好吗？
好了，但愿没有耽误你！代码如下（注意不用任何控件即可）：
Private Sub Form_click()
Dim N As Integer, U() As Double, I As Integer
Dim A As Single, B As Single
Form1.Cls
Print "数据：";
N = Val(InputBox("原始数据个数", "输入", 7))
If N = 1 Then Exit Sub
ReDim U(4, N)
Print "共"; N; "组："
For I = 1 To N
U(1, I) = Val(InputBox("自变量 X 的值：", "第一组", I))
U(2, I) = Val(InputBox("因变量 Y 的值：", "第一组", I * 5))
U(3, I) = U(1, I) * U(2, I)
U(4, I) = U(1, I) ^ 2
Print "x("; I; ") = "; U(1, I); " y("; I; ") = "; U(2, I)
U(1, 0) = U(1, 0) + U(1, I)
U(2, 0) = U(2, 0) + U(2, I)
U(3, 0) = U(3, 0) + U(3, I)
U(4, 0) = U(4, 0) + U(4, I)
Next I
U(1, 0) = U(1, 0) / N
U(2, 0) = U(2, 0) / N
B = (U(3, 0) - N * U(1, 0) * U(2, 0)) / (U(4, 0) - N * U(1, 0) ^ 2)
A = U(2, 0) - B * U(1, 0)
Print "拟合公式为："
Print " y = "; A;
If B = 0 Then Print " + ";
Print B; "x"
End Sub
Private Sub Form_Load()
Form1.AutoRedraw = True
Form1.Caption = "最小二乘法拟合程序"
Print "本程序执行的顺序为："
Print "1、输入数据数量；"
Print "3、逐个输入各组数据；"
Print "2、输出拟合公式。"
Print "特别说明：本程序不用任何控件！只要把窗口拉的足够大就行了。"
Form1.Print "单击窗体开始..."
End Sub
已经运行过。
构造Pen的时候可以指定粗细，如果你指定为1，并且放大了10倍，最后就成10了，所以你指定小点就行了，比如 Dim p As New Pen(Color.Black, 0.01) 最终绘制的线的粗细不会小于1
