Расчет статистической модели абсорбера с использованием метода Брандона
Расчет проводился на основе данных из Приложения 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- рассчитанная конечная температура.
Популярное: Почему двоичная система счисления так распространена?: Каждая цифра должна быть как-то представлена на физическом носителе... Личность ребенка как объект и субъект в образовательной технологии: В настоящее время в России идет становление новой системы образования, ориентированного на вхождение... ©2015-2024 megaobuchalka.ru Все материалы представленные на сайте исключительно с целью ознакомления читателями и не преследуют коммерческих целей или нарушение авторских прав. (271)
|
Почему 1285321 студент выбрали МегаОбучалку... Система поиска информации Мобильная версия сайта Удобная навигация Нет шокирующей рекламы |