vba最小二乘法.docVIP

Function AxAT A As Double, m, n Dim AAT As Double Dim i, j, k As Integer ReDim AAT 1 To m, 1 To m For i 1 To m For k 1 To m AAT i, k 0 For j 1 To n AAT i, k A j, i * A j, k + AAT i, k Next Next Next For i 1 To m For k 1 To m A i, k AAT i, k Next Next End Function Function HLS A As Double, m Dim i, j, k As Integer Dim rt As Double For i 1 To m For j 2 To m A 1, i A j, i + A 1, i Next Next For k 1 To m - 1 For i k + 1 To m For j m To k Step -1 A i, j A i, j - A k, j * A i, k / A k, k Next Next Next rt 1 For i 1 To m rt rt * A i, i Next HLS rt End Function Function QiuBanSuiZhen A As Double, m Dim bsz As Double 伴随阵 Dim yzs As Double 代数余子式 ReDim bsz 1 To m, 1 To m As Double 伴随阵 ReDim yzs 1 To m - 1, 1 To m - 1 As Double 代数余子式 Dim i, j, r, l As Integer For i 1 To m For j 1 To m For r 1 To m For l 1 To m If r i Then If l j Then yzs r, l A r, l End If If l j Then yzs r, l - 1 A r, l End If End If If r i Then If l j Then yzs r - 1, l A r, l End If If l j Then yzs r - 1, l - 1 A r, l End If End If Next Next bsz j, i 1 For r 1 To i + j bsz j, i bsz j, i * -1 Next bsz j, i bsz j, i * HLS yzs, m - 1 Cells j + 8, i bsz j, i Next Next For i 1 To m For j 1 To m A i, j bsz i, j Next Next End Function Sub testAxAT Dim r, l, mm, nn As Integer Dim A As Double 原始参数阵 Dim x As Double 多项式的系数 Dim AAT As Double Dim AAT_ni As Double Dim TempA As Double Dim y As Double Dim ATy As Double Dim HlsZhi As Double 一次多项式X a1*x+b1*y+c1 一次多项式Y a2*x+b2*y+c2 mm 3 nn 3 ////////////////////////////////////// 二次多项式Y a1*x*x+b1*x*y+c1*y*y+d1*x+e1*y+f1 二次多项式X a2*x*x+b2*x*y+c2*y*y+d2*x+e2*y+f2 m 6 nn 6 mm 3 nn 4 ReDim A 1 To nn, 1 To mm ReDim AAT 1 To nn, 1 To mm ReDim AAT_ni 1 To nn, 1 To mm ReDim TempA 1 To nn, 1 To mm ReDim y 1 To nn ReDim ATy 1 To mm ReDim x 1 To mm ////////////////////////////////////////// 参数A For r 1 To nn F