BRAND

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

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

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

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

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

+ 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

+ 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

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

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

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

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

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

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

= 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

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

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

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)

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

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

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())

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

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

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