Расчет статистической модели абсорбера с использованием метода Брандона

Расчет проводился на основе данных из Приложения 3 в программе, написанной в Visual Basic.

Код программы:

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

'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

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

 

Результаты расчета:

1) для степени абсорбции:

 

В данных обозначениях Х1-начальная температура, Х2-плотность орошения, Х3-объем абсорбера, Y-степень абсорбции данная, YR-степень абсорбции рассчитанная.

2) для температуры:

 

В данных обозначениях Х1-начальная температура, Х2-плотность орошения, Х3-объем абсорбера, Y-данная конечная температура, YR- рассчитанная конечная температура.