Лекция по теме МЕТОД БРАНДОНА

'm- кол-во факторов, N - колво опытов
Dim a() As Single
Dim n As Integer, m As Integer

Sub mnk6(ftr As Integer, n1 As Integer, masX() As Single, masY() As Single, masYR() As Single, formula As String)
Dim matrYR() As Single, x() As Single, y() As Single, skwOtkl() As Single, i As Integer
Dim ka As Single, kb As Single, AB() As Single, minS As Single, indMin As Integer
ReDim matrYR(1 To n1, 1 To 6) As Single, x(1 To n1) As Single, y(1 To n1) As Single, skwOtkl(1 To 6) As Single
ReDim AB(1 To 6, 1 To 2) As Single
'1 --- Уравнение y=a*x+b
For i = 1 To n1
x(i) = masX(i): y(i) = masY(i)
Next i
Call KoefAB(n1, x(), y(), ka, kb)
AB(1, 1) = ka: AB(1, 2) = kb
skwOtkl(1) = 0

For i = 1 To n1
matrYR(i, 1) = ka * masX(i) + kb
skwOtkl(1) = skwOtkl(1) + (masY(i) - matrYR(i, 1)) ^ 2
Next i
'2 --- Уравнение y=1/(a*x+b)
For i = 1 To n1
x(i) = masX(i): y(i) = 1 / masY(i)
Next i
Call KoefAB(n1, x(), y(), ka, kb)
AB(2, 1) = ka: AB(2, 2) = kb
skwOtkl(2) = 0
For i = 1 To n1
matrYR(i, 2) = 1 / (ka * masX(i) + kb)
skwOtkl(2) = skwOtkl(2) + (masY(i) - matrYR(i, 2)) ^ 2
Next i

'3 --- Уравнение y=a/x+b
For i = 1 To n1
x(i) = 1 / masX(i): y(i) = masY(i)
Next i
Call KoefAB(n1, x(), y(), ka, kb)
AB(3, 1) = ka: AB(3, 2) = kb
skwOtkl(3) = 0
For i = 1 To n1
matrYR(i, 3) = ka / masX(i) + kb
skwOtkl(3) = skwOtkl(3) + (masY(i) - matrYR(i, 3)) ^ 2
Next i
'4 --- Уравнение y=b*x^a
For i = 1 To n1
x(i) = Log(masX(i)): y(i) = Log(masY(i))
Next i
Call KoefAB(n1, x(), y(), ka, kb)
AB(4, 1) = ka: AB(4, 2) = Exp(kb)
skwOtkl(4) = 0

For i = 1 To n1
matrYR(i, 4) = Exp(kb) * masX(i) ^ ka
skwOtkl(4) = skwOtkl(4) + (masY(i) - matrYR(i, 4)) ^ 2
Next I

'5 --- Уравнение y=b*exp(a*x)
For i = 1 To n1
y(i) = Log(masY(i)): x(i) = masX(i)
Next i
Call KoefAB(n1, x(), y(), ka, kb)
AB(5, 1) = ka: AB(5, 2) = Exp(kb)
skwOtkl(5) = 0
For i = 1 To n1
matrYR(i, 5) = Exp(kb) * Exp(ka * masX(i))
skwOtkl(5) = skwOtkl(5) + (y(i) - matrYR(i, 5)) ^ 2
Next i

'6 --- Уравнение y=a*log(x)+b
For i = 1 To n1
y(i) = masY(i): x(i) = Log(masX(i))
Next i
Call KoefAB(n1, x(), y(), ka, kb)
AB(6, 1) = ka: AB(6, 2) = kb
skwOtkl(6) = 0
For i = 1 To n1
matrYR(i, 6) = ka * Log(masX(i)) + kb
skwOtkl(6) = skwOtkl(6) + (y(i) - matrYR(i, 6)) ^ 2
Next I

indMin = 1
minS = skwOtkl(1)
For i = 2 To 6
If minS > skwOtkl(i) Then
indMin = i
minS = skwOtkl(i)
End If
Next i

If indMin = 1 Then
formula = CStr(AB(1, 1)) + "*x" + CStr(ftr) + "+" + CStr(AB(1, 2))
For i = 1 To n1
masYR(i) = matrYR(i, 1)
Next i
End If
If indMin = 2 Then
formula = "1/(" + CStr(AB(2, 1)) + "*x" + CStr(ftr) + "+" + CStr(AB(2, 2)) + ")"
For i = 1 To n1
masYR(i) = matrYR(i, 2)
Next i
End If
If indMin = 3 Then
formula = CStr(AB(3, 1)) + "/x" + CStr(ftr) + "+" + CStr(AB(3, 2))
For i = 1 To n1
masYR(i) = matrYR(i, 3)
Next i
End If

If indMin = 4 Then
formula = CStr(AB(4, 2)) + "*x" + CStr(ftr) + "^" + CStr(AB(4, 1))
For i = 1 To n1
masYR(i) = matrYR(i, 4)
Next i
End If
If indMin = 5 Then
formula = CStr(AB(5, 2)) +"*exp(" + CStr(AB(5, 1)) + "*x" + CStr(ftr) + ")"
For i = 1 To n1
masYR(i) = matrYR(i, 5)
Next i
End If
If indMin = 6 Then
formula = CStr(AB(6, 1)) + "*ln(x" + CStr(ftr) + ")+" + CStr(AB(6, 2))
For i = 1 To n1
masYR(i) = matrYR(i, 6)
Next i
End If
End Sub

Private Sub mnuComp_Click()
Dim stroka As String, i As Integer, ind() As Integer, rabA() As Single, eta As Single, eps As Single
Dim SrZnachY As Single, NormY() As Single, msX() As Single, msY() As Single, formul() As String
Dim j As Integer, YRASCH() As Single, formulka As String, s1 As Single, s2 As Single, s3 As Single
ReDim ind(1 To m) As Integer, rabA(1 To n, 1 To m + 1) As Single, NormY(1 To n, 1 To m) As Single
ReDim msX(1 To n) As Single, msY(1 To n) As Single, msyr(1 To n) As Single, formul(1 To m) As String
ReDim YRASCH(1 To n) As Single
For i = 1 To m
List1.ListIndex = i - 1
stroka = Mid(List1.Text, 2, 7): ind(i) = CInt(stroka)
Next i

For j = 1 To m
For i = 1 To n
rabA(i, j) = a(i, ind(j))
rabA(i, m + 1) = a(i, m + 1)
Next i
Next j
SrZnach = 0
For i = 1 To n
SrZnachY = SrZnachY + rabA(i, m + 1)
Next i
SrZnachY = SrZnachY / n
formulka = "y=" + CStr(SrZnachY)
For i = 1 To n
YRASCH(i) = SrZnachY
NormY(i, 1) = a(i, m + 1) / SrZnachY
Next i
For j = 1 To m
For i = 1 To n
msX(i) = rabA(i, j)
msY(i) = NormY(i, j)
Next i

Call mnk6(ind(j), n, msX(), msY(), msyr(), formul(j))
For i = 1 To n
YRASCH(i) = YRASCH(i) * msyr(i)
Next i
If j < m Then
For i = 1 To n
NormY(i, j + 1) = NormY(i, j) / msyr(i)
Next i
End If
formulka = formulka + "*(" + formul(j) + ")"
Next j
Label1.Caption = "РЕЗУЛЬТАТЫ РАСЧЕТА:"
Label5.Caption = "ПОДОБРАНА МОДЕЛЬ: " + vbCrLf
Label5.Caption = Label5.Caption + formulka
Label5.Visible = True

With MSFlexGrid1
.Cols = .Cols + 1: .Col = .Cols - 1: .Row = 0: .Text = "YR"
For i = 1 To n
.Row = i: .Text = CStr(YRASCH(i))
Next i
End With
s1 = 0: s2 = 0: s3 = 0
For i = 1 To n
s1 = s1 + (a(i, m + 1) - YRASCH(i)) ^ 2
s2 = s2 + (a(i, m + 1) - SrZnachY) ^ 2
s3 = s3 + Abs(a(i, m + 1) - YRASCH(i)) / Abs(a(i, m + 1))
Next i
eps = 100 / n * s3
eta = Sqr(1 - s1 / s2)
Text1.Text = CStr(eta)
Text2.Text = CStr(eps)
End Sub

Private Sub mnuExit_Click()
End
End Sub

Sub KoefAB(n As Integer, x() As Single, y() As Single, ka As Single, kb As Single)
Dim s1 As Single, s2 As Single, s3 As Single, s4 As Single
s1 = 0: s2 = 0: s3 = 0: s4 = 0
For i = 1 To n
s1 = s1 + x(i)
s2 = s2 + x(i) * x(i)
s3 = s3 + x(i) * y(i)
s4 = s4 + y(i)
Next i
ka = (n * s3 - s1 * s4) / (n * s2 - s1 * s1)
kb = (s2 * s4 - s1 * s3) / (n * s2 - s1 * s1)
End Sub

Private Function Opred(n1 As Integer, x1() As Single) As Single
Dim i As Integer, j As Integer, d As Single
Dim e As Single, k As Integer, b1 As Integer, c As Integer
Dim a As Single, s As Single, g As Single, z As Integer
ReDim x(1 To n1, 1 To n1) As Single
z = 1
d = 1
For i = 1 To n1
For j = 1 To n1
x(i, j) = x1(i, j)
Next j
Next i
For k = 1 To n1 - 1
e = 0
For i = k To n1
For j = k To n1
If Abs(e) >= Abs(x(i, j)) Then GoTo m90
e = x(i, j): b1 = i: c = j

m90:
Next j
Next i
If k = b1 Then GoTo m120
For j = k To n1
s = x(k, j)
x(k, j) = x(b1, j)
x(b1, j) = s
Next j
z = -z
m120:
If k = c Then GoTo m150
For i = k To n1
s = x(i, k)
x(i, k) = x(i, c)
x(i, c) = s
Next i
z = -z

m150:
For i = k + 1 To n1
g = x(i, k) / x(k, k)
For j = k To n1
x(i, j) = x(i, j) - g * x(k, j)
Next j
Next i
Next k
For i = 1 To n1
d = d * x(i, i)
Next i
d = d * z
Opred = d
End Function

Function Rxy(n As Integer, x() As Single, y() As Single) As Single
Dim i As Integer, s1 As Single, s2 As Single, s3 As Single
Dim s4 As Single, s5 As Single
s1 = 0: s2 = 0: s3 = 0: s4 = 0: s5 = 0
For i = 1 To n
s1 = s1 + x(i)
s2 = s2 + x(i) ^ 2
s3 = s3 + x(i) * y(i)
s4 = s4 + y(i)
s5 = s5 + y(i) ^ 2
Next i
Rxy = (n * s3 - s1 * s4) / Sqr((n * s2 - s1 * s1) * (n * s5 - s4 * s4))
End Function

Private Sub mnuOpen_Click()
Dim s As String, i As Integer
CommonDialog1.Action = 1
s = CommonDialog1.FileName
Open s For Input As #1
Input #1, m, n
With MSFlexGrid1
.Cols = m + 2: .Rows = n + 1
.Col = 0: .Row = 0: .Text = "№"
For i = 1 To m
.Col = i: .Text = "X" + CStr(i)
Next i
.Col = m + 1: .Text = "Y"
ReDim a(1 To n, 1 To m + 1) As Single
For i = 1 To n
.Col = 0: .Row = i: .Text = CStr(i)

For j = 1 To m + 1
Input #1, a(i, j)
.Col = j: .Text = CStr(a(i, j))
Next j
Next i
Close #1
End With
End Sub

Private Sub mnuRangir_Click()
Dim d() As Single, x1() As Single, y1() As Single
Dim dm1 As Single, dmk() As Single, dkk() As Single, KRxy() As Single
Dim i As Integer, j As Integer, a1() As Single, sz As String
ReDim d(1 To m + 1, 1 To m + 1) As Single, x1(1 To n) As Single, y1(1 To n) As Single
ReDim dmk(1 To m) As Single, dkk(1 To m) As Single, KRxy(1 To m) As Single
ReDim a1(1 To m, 1 To m) As Single, smassiv(1 To m) As String

For i = 1 To m
smassiv(i) = "X" + CStr(i)
Next I
For i = 1 To m + 1
d(i, i) = 1
Next i
For j = 1 To m
For k = j + 1 To m + 1
For i = 1 To n
x1(i) = a(i, j): y1(i) = a(i, k)
Next i
d(j, k) = Rxy(n, x1(), y1())
'транспонирование матрицы
d(k, j) = d(j, k)
Next k
Next j

'вывод матрицы D
With MSFlexGrid2
.Cols = m + 1: .Rows = m + 1
For i = 1 To m + 1
For j = 1 To m + 1
.Col = j - 1: .ColWidth(.Col) = 1500: .Row = i - 1: .Text = CStr(d(i, j))
Next j
Next i
End With
'частн коэфф множ коррел
For i = 1 To m
For j = 1 To m
a1(i, j) = d(i, j)
Next j
Next i
dm1 = Opred(m, a1())

For k = 1 To m
For i = 1 To m
k1 = 0
For j = 1 To m + 1
If j <> k Then
k1 = k1 + 1
a1(i, k1) = d(i, j)
End If
Next j
Next I
dmk(k) = Opred(m, a1())
Next k
For k = 1 To m
k1 = 0
For i = 1 To m + 1
If i <> k Then
k1 = k1 + 1: k2 = 0
For j = 1 To m + 1
If j <> k Then
k2 = k2 + 1

a1(k1, k2) = d(i, j)
End If
Next j
End If
Next I
dkk(k) = Opred(m, a1())
Next k
With MSFlexGrid3
.Rows = m: .Cols = 2: .FixedRows = 0: .FixedCols = 0
For i = 1 To m
.Row = i - 1
.Col = 0: .Text = "Ryx" + CStr(i) + "="
KRxy(i) = dmk(i) / Sqr(dm1 * dkk(i))
.Col = 1: .ColWidth(.Col) = 1500: .Text = CStr(KRxy(i))
Next i
End With

'сортировка
List1.Clear
For i = 1 To m - 1
k = i
For j = i To m
If Abs(KRxy(k)) > Abs(KRxy(j)) Then k = j
Next j
sz = smassiv(k)
smassiv(k) = smassiv(i)
smassiv(i) = sz
Next i
For i = m To 1 Step -1
List1.AddItem (smassiv(i))
Next i
End Sub