Синтез химико- технологической системы

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

'm- кол-во факторов, N - колво опытов

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