重庆分公司,新征程启航

为企业提供网站建设、域名注册、服务器等服务

vb.net二次函数拟合,vb求二次函数的解

VB拟合二次函数

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

VB 最小二乘法线性拟合

稍等好吗?

好了,但愿没有耽误你!代码如下(注意不用任何控件即可):

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 "本程序执行的顺序为:"

Print "1、输入数据数量;"

Print "3、逐个输入各组数据;"

Print "2、输出拟合公式。"

Print

Print "特别说明:本程序不用任何控件!只要把窗口拉的足够大就行了。"

Print

Form1.Print "单击窗体开始..."

End Sub

已经运行过。

VB.net 高次曲线拟合并绘图

构造Pen的时候可以指定粗细,如果你指定为1,并且放大了10倍,最后就成10了,所以你指定小点就行了,比如 Dim p As New Pen(Color.Black, 0.01) 最终绘制的线的粗细不会小于1


网页名称:vb.net二次函数拟合,vb求二次函数的解
文章地址:http://cqcxhl.com/article/hspsgg.html

其他资讯

在线咨询
服务热线
服务热线:028-86922220
TOP