Курсач. приписка. Курсовая работа по дисциплине Введение в информационные технологии
Скачать 0.9 Mb.
|
3)Расчёт аппроксимаций по программе, разработанной в среде VBAПрограмма, разработанная в среде VBA рассчитывает аппроксимацию по алгоритму, блок-схема которого представлена на рисунке 12. Рис. 12. Укрупненная блок-схема алгоритма расчета аппроксимации Исходный код программы выглядит следующим образом: Option Explicit Dim Inp_Data As String Dim FileName As String Public UR As Range, CL As Range Dim R1 As Byte, C1 As Byte, R As Byte Dim i As Integer, j As Integer, k As Integer Public n As Integer Dim m_1() As Single, m_2() As Single Dim x() As Single, y() As Single Dim lny() As Single Const n1 = 2 Dim Ftab(1 To n1) As Single Dim Stab(1 To n1) As Single Public alfa As Single Dim stl() As Single, ssrl() As Single, stsqr() As Single, ssrsqr() As _ Single, YL() As Single, Ysqr() As Single, Yexp() As Single, _ lnYexp() As Single Public Sx As Single, Sy As Single, Sxy As Single, Sx2 As Single, _ Sx3 As Single, Sx4 As Single, Sx2y As Single, Sx2sr As Single, _ Sy2sr As Single, Sxysr As Single, Slny As Single, Sxlny As Single Public a1L As Single, a2L As Single, koef_cor As Single, MD As Single Public Sa1L As Single, Sa2L As Single, Xsr As Single, _ Ysr As Single, lnYsr As Single Public SostL As Single, SregrL As Single, SpolnL As Single, _ R_det_L As Single Public Fline As Single, Sline As Single, ta1L As Single, ta2L As Single Public a1sqr As Single, a2sqr As Single, a3sqr As Single Public Sa1sqr As Single, Sa2sqr As Single, Sa3sqr As Single Public Sostsqr As Single, Sregrsqr As Single, Spolnsqr As Single, _ R_det_sqr As Single, DSost As Single Public Fsqr As Single, Ssqr As Single, ta1sqr As Single, _ ta2sqr As Single, ta3sqr As Single Public cexp As Single, a1exp As Single, a2exp As Single Public Sa1exp As Single, Sa2exp As Single Public Sostexp As Single, Sregrexp As Single, Spolnexp As Single, _ R_det_exp As Single Public Fexp As Single, ta1exp As Single, ta2exp As Single Public gr As Integer Public Min As Single, Max As Single, Xpr As Single, Ypr As Single Public f_st As String Public c As Integer Public st1 As String Public cell_1 As Integer Public cell_2 As Integer Public pr1 As Integer Public Sub ReadList() Sheets("VBA").Activate Set UR = ActiveSheet.UsedRange R1 = UR.Rows(1).Row If R1 = 0 Then Exit Sub C1 = UR.Columns(1).Column n = 0 Cells(R1, C1).Activate While ActiveCell <> "" If IsNumeric(ActiveCell.Value) Then n = n + 1 ReDim Preserve m_1(1 To 2, 1 To n) m_1(1, n) = ActiveCell.Value m_1(2, n) = ActiveCell.Offset(0, 1).Value End If ActiveCell.Offset(1, 0).Activate Wend If n > 0 Then ReDim m_2(1 To n, 1 To 2) For j = 1 To n m_2(j, 1) = m_1(1, j) m_2(j, 2) = m_1(2, j) Next j Else ReDim m_2(1 To 1, 1 To 2) End If With UserForm1.ListBox1 .ColumnCount = 2 .List = m_2 End With End Sub Public Sub Read_XY(x, y) ReDim x(1 To n) ReDim y(1 To n) For j = 1 To n x(j) = m_2(j, 1) y(j) = m_2(j, 2) Next j End Sub Public Sub Read_tabl(alfa) Dim d_f1 As Integer, d_f2 As Integer d_f1 = 1 d_f2 = n - 1 On Error GoTo old_func Ftab(1) = WorksheetFunction.F_Inv_RT(alfa, d_f1, d_f2 - 1) Ftab(2) = WorksheetFunction.F_Inv_RT(alfa, d_f1, d_f2 - 2) Stab(1) = WorksheetFunction.T_Inv_2T(alfa, d_f2) Stab(2) = WorksheetFunction.T_Inv_2T(alfa, d_f2 - 1) Exit Sub old_func: Ftab(1) = WorksheetFunction.FInv(alfa, d_f1, d_f2 - 1) Ftab(2) = WorksheetFunction.FInv(alfa, d_f1, d_f2 - 2) Stab(1) = WorksheetFunction.TInv(alfa, d_f2) Stab(2) = WorksheetFunction.TInv(alfa, d_f2 - 1) End Sub Public Sub L_Kram(a11 As Integer, a12 As Single, a21 As Single, _ a22 As Single, b1 As Single, b2 As Single, a1 As Single, a2 As Single) Dim d As Single, d1 As Single, d2 As Single d = a11 * a22 - a21 * a12 d1 = b1 * a22 - b2 * a12 d2 = a11 * b2 - a21 * b1 a1 = d1 / d a2 = d2 / d End Sub Public Sub Sqr_Kram(a11 As Integer, a12 As Single, a13 As Single, _ a21 As Single, a22 As Single, a23 As Single, a31 As Single, _ a32 As Single, a33 As Single, b1 As Single, b2 As Single, _ b3 As Single, a1 As Single, a2 As Single, a3 As Single, MD As Single) Dim d As Single, d1 As Single, d2 As Single, d3 As Single d = a11 * a22 * a33 + a12 * a23 * a31 + a21 * a32 * a13 - a13 * _ a22 * a31 - a21 * a12 * a33 - a11 * a23 * a32 d1 = b1 * a22 * a33 + a12 * a23 * b3 + b2 * a32 * a13 - a13 * _ a22 * b3 - b2 * a12 * a33 - b1 * a23 * a32 d2 = a11 * b2 * a33 + b1 * a23 * a31 + a21 * b3 * a13 - a13 * _ b2 * a31 - a21 * b1 * a33 - a11 * a23 * b3 d3 = a11 * a22 * b3 + a12 * b2 * a31 + a21 * a32 * b1 - b1 * _ a22 * a31 - a21 * a12 * b3 - a11 * b2 * a32 a1 = d1 / d a2 = d2 / d a3 = d3 / d MD = d End Sub Public Sub Koef_det(ns As Integer, a() As Single, b() As Single, _ c As Single, s1 As Single, s2 As Single, s3 As Single, R As Single) Dim i As Integer For i = 1 To ns s1 = s1 + (b(i) - a(i)) ^ 2 s2 = s2 + (b(i) - c) ^ 2 Next i s3 = s1 + s2 R = 1 - s1 / s3 End Sub Public Sub ZnachLine(n As Integer, DS As Single, R2 As Single, _ a As Single, asr As Single, a1 As Single, a2 As Single, s1 As Single, _ s2 As Single, f As Single, t1 As Single, t2 As Single) s1 = Sqr(DS * a / (n * (n - 2) * asr)) s2 = Sqr(DS / ((n - 2) * asr)) f = R2 * (n - 2) / (1 - R2) t1 = Abs(a1) / s1 t2 = Abs(a2) / s2 End Sub Public Sub MinMax(a() As Single, n As Integer, Min As Single, _ Max As Single) Dim i As Integer Min = a(1) Max = a(1) For i = 2 To n If a(i) > Max Then Max = a(i) If a(i) < Min Then Min = a(i) Next i End Sub Public Sub Print_rez(gr As Integer, sa1 As String, sa2 As String, _ sa3 As String, sk As String, sR As String, sm1 As String, _ sm2 As String, sm3 As String, sf As String, st1 As String, _ st2 As String, st3 As String, a1 As Single, a2 As Single, a3 As Single, _ k As Single, R As Single, m1 As Single, m2 As Single, m3 As Single, _ f As Single, t1 As Single, t2 As Single, t3 As Single) Dim Fd As Single, Sd As Single, st As String, str1 As String f_st = "0.0000" ' ôîðìàò âûâîäà ÷èñåë If gr = 2 Then Fd = Ftab(2) Else Fd = Ftab(1) If gr = 2 Then Sd = Stab(2) Else Sd = Stab(1) Select Case gr Case 1 st = "ëèíåéíîé àïïpîêñèìàöèè" With UserForm1 .tb_k1l = Format(a1, f_st) .tb_k2l = Format(a2, f_st) .tb_kc = Format(k, "0.000000") .tb_kdl = Format(R, "0.000000") .tb_k1l_s = Format(m1, "0.000000") .tb_k2l_s = Format(m2, "0.000000") .tb_k1l_tr = Format(t1, f_st) .tb_k2l_tr = Format(t2, f_st) .tb_kl_tt = Format(Sd, f_st) .tb_l_ft = Format(Fd, f_st) .tb_l_fr = Format(f, f_st) If t1 > Sd Then .tb_k1l_z = "çíà÷èì" Else .tb_k1l_z = "íå çíà÷èì" End If If t2 > Sd Then .tb_k2l_z = "çíà÷èì" Else .tb_k2l_z = "íå çíà÷èì" End If If f > Fd Then .tb_l_z = "çíà÷èìî" Else .tb_l_z = "íå çíà÷èìî" End With Case 2 st = "êâàäpàòè÷íîé àïïpîêñèìàöèè" With UserForm1 .tb_k1q = Format(a1, f_st) .tb_k2q = Format(a2, f_st) .tb_k3q = Format(a3, f_st) .tb_kdq = Format(R, "0.000000") .tb_k1q_s = Format(m1, "0.000000") .tb_k2q_s = Format(m2, "0.000000") .tb_k3q_s = Format(m3, "0.000000") .tb_k1q_tr = Format(t1, f_st) .tb_k2q_tr = Format(t2, f_st) .tb_k3q_tr = Format(t3, f_st) .tb_kq_tt = Format(Sd, f_st) .tb_q_ft = Format(Fd, f_st) .tb_q_fr = Format(f, f_st) If t1 > Sd Then .tb_k1q_z = "çíà÷èì" Else .tb_k1q_z = "íå çíà÷èì" End If If t2 > Sd Then .tb_k2q_z = "çíà÷èì" Else .tb_k2q_z = "íå çíà÷èì" End If If t3 > Sd Then .tb_k3q_z = "çíà÷èì" Else .tb_k3q_z = "íå çíà÷èì" End If If f > Fd Then .tb_q_z = "çíà÷èìî" Else .tb_q_z = "íå çíà÷èìî" End With Case 3 st = "ýêñïîíåíöèàëüíîé àïïpîêñèìàöèè" With UserForm1 .tb_k1e = Format(a1, f_st) .tb_k2e = Format(a2, f_st) .tb_kde = Format(R, "0.000000") .tb_k1e_s = Format(m1, "0.000000") .tb_k2e_s = Format(m2, "0.000000") .tb_k1e_tr = Format(t1, f_st) .tb_k2e_tr = Format(t2, f_st) .tb_ke_tt = Format(Sd, f_st) .tb_e_ft = Format(Fd, f_st) .tb_e_fr = Format(f, f_st) If t1 > Sd Then .tb_k1e_z = "çíà÷èì" Else .tb_k1e_z = "íå çíà÷èì" End If If t2 > Sd Then .tb_k2e_z = "çíà÷èì" Else .tb_k2e_z = "íå çíà÷èì" End If If f > Fd Then .tb_e_z = "çíà÷èìî" Else .tb_e_z = "íå çíà÷èìî" End With End Select R1 = ActiveSheet.UsedRange.Row + _ ActiveSheet.UsedRange.Rows.Count + 1 Cells(R1, C1).Activate If gr = 1 Then ActiveCell = "N=" + Str(n) + " - ÷èñëî íàáëþäåíèé" ActiveCell.Offset(1, 0).Activate ActiveCell = "Òàáëè÷íûå çíà÷åíèÿ êðèòåðèåâ:" ActiveCell.Offset(1, 0).Activate ActiveCell = "Ôèøåðà Ñòüþäåíòà" ActiveCell.Offset(1, 0).Activate ActiveCell = Format(Ftab(1), "0.0000") + Space(8) + _ Format(Stab(1), "0.0000") + " - ïðè âû÷èñëåíèè äâóõ êîýôôèöèåíòîâ" ActiveCell.Offset(1, 0).Activate ActiveCell = Format(Ftab(2), "0.0000") + Space(8) + _ Format(Stab(2), "0.0000") + " - ïðè âû÷èñëåíèè òðåõ êîýôôèöèåíòîâ" ActiveCell.Offset(1, 0).Activate End If str1 = sa1 + "=" + Format(a1, f_st) + " " + sa2 + "=" + Format(a2, f_st) If gr = 2 Then str1 = str1 + " " + sa3 + "=" + Format(a3, f_st) End If ActiveCell = str1 + " -êîýôôèöèåíòû " + st ActiveCell.Offset(1, 0).Activate If gr = 1 Then ActiveCell = sk + Format(k, "0.000000") + _ " -êîýôôèöèåíò êîppåëÿöèè" End If ActiveCell.Offset(1, 0).Activate ActiveCell = sR + Format(R, "0.000000") + _ " -êîýôôèöèåíò äåòåpìèíèpîâàííîñòè" ActiveCell.Offset(1, 0).Activate str1 = sm1 + Format(m1, "0.000000") + " " + sm2 + _ Format(m2, "0.000000") If gr = 2 Then str1 = str1 + " " + sm3 + Format(m3, f_st) + _ " -ñòàíäàpòíûå îøèáêè êîýôôèöèåíòîâ " End If ActiveCell = str1 ActiveCell.Offset(1, 0).Activate ActiveCell = "Êpèòåpèè äëÿ ïpîâåpêè íóëåâûõ ãèïîòåç " ActiveCell.Offset(1, 0).Activate str1 = sf + Format(f, f_st) + " " + st1 + Format(t1, f_st) + " " + _ st2 + Format(t2, f_st) If gr = 2 Then str1 = str1 + " " + st3 + Format(t3, f_st) End If ActiveCell = str1 ActiveCell.Offset(1, 0).Activate If f > Fd Then ActiveCell = "Óðàâíåíèå" + st + "çíà÷èìî" Else ActiveCell = "Óðàâíåíèå" + st + "íå çíà÷èìî" End If ActiveCell.Offset(1, 0).Activate If t1 > Sd Then ActiveCell = "Êîýôôèöåíò" + sa1 + "çíà÷èìî" Else ActiveCell = "Êîýôôèöåíò" + sa1 + "íå çíà÷èìî" End If ActiveCell.Offset(1, 0).Activate If t2 > Sd Then ActiveCell = "Êîýôôèöåíò" + sa2 + "çíà÷èìî" Else ActiveCell = "Êîýôôèöåíò" + sa2 + "íå çíà÷èìî" End If ActiveCell.Offset(1, 0).Activate If gr = 2 Then If t3 > Sd Then ActiveCell = "Êîýôôèöåíò" + sa3 + "çíà÷èìî" Else ActiveCell = "Êîýôôèöåíò" + sa3 + "íå çíà÷èìî" End If End If ActiveCell.Offset(1, 0).Activate End Sub Public Sub graf() Dim cell_1 As String, cell_2 As String ' äèàïàçîíà ñ äàííûìè 'çàïîìèíàåì íîìåð ïåðâîé ñòðîêè ñ âûâîäèìûìè äàííûìè R1 = ActiveSheet.UsedRange.Row + _ ActiveSheet.UsedRange.Rows.Count + 1 For i = 1 To n Cells(R1 + i - 1, 1) = x(i) Cells(R1 + i - 1, 2) = a1L + a2L * x(i) Next i cell_1 = Cells(R1, 1).Address cell_2 = Cells(R1 + n - 1, 2).Address ActiveSheet.Shapes.AddChart.Select 'íîâàÿ äèàãðàììà ActiveChart.ChartType = xlXYScatterSmoothNoMarkers 'xlXYScatter ActiveChart.SetSourceData Source:=Range(cell_1 + ":" + cell_2) ActiveChart.SeriesCollection.NewSeries cell_1 = Cells(UR.Row + 1, UR.Column).Address cell_2 = Cells(UR.Row + n - 1, UR.Column).Address ActiveChart.SeriesCollection(2).XValues = Range(cell_1 + ":" + cell_2) ActiveChart.SeriesCollection(2).Values = Range(Cells(UR.Row + 1, _ UR.Column + 1).Address + ":" + Cells(UR.Row + n - 1, UR.Column + _ 1).Address) ActiveChart.SeriesCollection(2).Select ActiveChart.SeriesCollection(2).ChartType = xlXYScatter ActiveChart.SetElement (msoElementChartTitleAboveChart) Selection.Caption = "Ëèíåéíàÿ" ActiveSheet.ChartObjects(1).Left = 430 For i = 1 To n Cells(R1 + i - 1, 3) = a1sqr + a2sqr * x(i) + a3sqr * x(i) * x(i) Next i cell_1 = Cells(R1, 1).Address cell_2 = Cells(R1 + n - 1, 3).Address ActiveSheet.Shapes.AddChart.Select ActiveChart.ChartType = xlXYScatterSmoothNoMarkers ActiveChart.SeriesCollection.NewSeries ActiveChart.SeriesCollection(1).XValues = Range(cell_1 + ":" + _ Cells(R1 + n - 1, 1).Address) ActiveChart.SeriesCollection(1).Values = Range(Cells(R1, 3).Address _ + ":" + cell_2) ActiveChart.SeriesCollection.NewSeries ActiveChart.SeriesCollection(2).XValues = Range(Cells(UR.Row + 1, _ UR.Column).Address + ":" + Cells(UR.Row + n - 1, _ UR.Column).Address) ActiveChart.SeriesCollection(2).Values = Range(Cells(UR.Row + 1, _ UR.Column + 1).Address + ":" + Cells(UR.Row + n - 1, UR.Column + _ 1).Address) ActiveChart.SeriesCollection(2).Select ActiveChart.SeriesCollection(2).ChartType = xlXYScatter ActiveChart.SetElement (msoElementChartTitleAboveChart) Selection.Caption = "Êâàäðàòè÷íàÿ" ActiveSheet.ChartObjects(2).Left = 800 On Error Resume Next ActiveChart.SeriesCollection(3).Delete On Error GoTo 0 For i = 1 To n Cells(R1 + i - 1, 4) = a1exp * Exp(a2exp * x(i)) Next i cell_1 = Cells(R1, 1).Address cell_2 = Cells(R1 + n - 1, 4).Address ActiveSheet.Shapes.AddChart.Select ActiveChart.ChartType = xlXYScatterSmoothNoMarkers ActiveChart.SeriesCollection.NewSeries ActiveChart.SeriesCollection(1).XValues = Range(cell_1 + ":" + _ Cells(R1 + n - 1, 1).Address) ActiveChart.SeriesCollection(1).Values = Range(Cells(R1, 4).Address _ + ":" + cell_2) ActiveChart.SeriesCollection.NewSeries ActiveChart.SeriesCollection(2).XValues = Range(Cells(UR.Row + 1, _ UR.Column).Address + ":" + Cells(UR.Row + n - 1, _ UR.Column).Address) ActiveChart.SeriesCollection(2).Values = Range(Cells(UR.Row + 1, _ UR.Column + 1).Address + ":" + Cells(UR.Row + n - 1, UR.Column _ + 1).Address) ActiveChart.SeriesCollection(2).Select ActiveChart.SeriesCollection(2).ChartType = xlXYScatter ActiveChart.SetElement (msoElementChartTitleAboveChart) Selection.Caption = "Ýêñïîíåíöèàëüíàÿ" ActiveSheet.ChartObjects(3).Left = 1170 On Error Resume Next ActiveChart.SeriesCollection(3).Delete On Error GoTo 0 End Sub 'Ïðîãðàììíûé êîä ôîðìû Private Sub Button2_Click() 'Êíîïêà ×èòàòü Dim Inp_Data As String, Data1 As String, Data2 As String R = 1 c = 1 FileName = TextBox1.Value If FileName = "" Then Dialog: FileName = Application.GetOpenFilename _ (, , "Âûáåðèòå òåêñòîâûé ôàéë ñ äàííûìè") End If If FileName = "" Or VarType(FileName) = vbBoolean Then Exit Sub End If On Error GoTo Dialog Open FileName For Input As #1 On Error GoTo 0 TextBox1.Value = FileName Worksheets("VBA").Cells.Clear R = 0 Do While Not EOF(1) Line Input #1, Inp_Data '×òåíèå ñòðîêè èç ôàéëà â ìàññèâ If Inp_Data = "" Then Exit Do pr1 = InStr(Trim(Inp_Data), " ") Worksheets("VBA").Cells(R + 2, 1) = Val(Left(Trim(Inp_Data), _ pr1 - 1)) Worksheets("VBA").Cells(R + 2, 2) = Val(Trim(Mid(Trim(Inp_Data), _ pr1 + 1))) R = R + 1 Loop Close #1 Worksheets("VBA").Cells(1, 1) = "X" Worksheets("VBA").Cells(1, 2) = "Y" ReadList End Sub Private Sub Button3_Click() Worksheets("VBA").Activate UserForm1.Hide End Sub Private Sub CheckBox1_Click() If CheckBox1.Value = False Then TextBox1.Visible = False Button2.Visible = False Label3.Visible = False Else TextBox1.Visible = True Button2.Visible = True Label3.Visible = True End If End Sub Private Sub CommandButton1_Click() Dim Sx As Single, Sy As Single, Sx2 As Single, Sxy As Single, Sx3 _ As Single, Sx4 As Single, Sx2y As Single, Slny As Single, Sxlny As _ Single, Xsr As Single, Ysr As Single, lnYsr As Single, Sxysr As Single _ , Sx2sr As Single, Sy2sr As Single If n = 0 Then MsgBox "Èñõîäíûå äàííûå îòñóòñòâóþò" Exit Sub End If Call Read_XY(x, y) alfa = Val(TextBox2.Value) Call Read_tabl(alfa) On Error Resume Next ActiveSheet.ChartObjects.Delete On Error GoTo 0 'Óäàëåíèå ðåçóëüòàòîâ ðàñ÷åòîâ If n > 0 Then Range(Cells(UR.Row + n + 2, 1).Address + ":" + Cells(UR.Row + n _ + 100, 4).Address).Clear End If ReDim lny(n) Sx = 0 Sy = 0 Sx2 = 0 Sxy = 0 Sx3 = 0 Sx4 = 0 Sx2y = 0 Slny = 0 Sxlny = 0 For j = 1 To n Sx = Sx + x(j) Sy = Sy + y(j) Sx2 = Sx2 + x(j) * x(j) Sxy = Sxy + x(j) * y(j) Sx3 = Sx3 + x(j) * x(j) * x(j) Sx4 = Sx4 + (x(j)) ^ 4 Sx2y = Sx2y + x(j) * x(j) * y(j) lny(j) = Log(y(j)) Slny = Slny + lny(j) Sxlny = Sxlny + x(j) * lny(j) Next j Xsr = Sx / n Ysr = Sy / n lnYsr = Slny / n Sxysr = 0 Sx2sr = 0 Sy2sr = 0 For j = 1 To n Sxysr = Sxysr + (x(j) - Xsr) * (y(j) - Ysr) Sx2sr = Sx2sr + (x(j) - Xsr) ^ 2 Sy2sr = Sy2sr + (y(j) - Ysr) ^ 2 Next j Call L_Kram(n, Sx, Sx, Sx2, Sy, Sxy, a1L, a2L) koef_cor = Sxysr / (Sqr(Sx2sr) * Sqr(Sy2sr)) ReDim YL(1 To n) For j = 1 To n YL(j) = a1L + a2L * x(j) Next j Call Koef_det(n, y, YL, Ysr, SostL, SregrL, SpolnL, R_det_L) Call ZnachLine(n, SostL, R_det_L, Sx2, Sx2sr, a1L, a2L, Sa1L, Sa2L, _ Fline, ta1L, ta2L) Call Sqr_Kram(n, Sx, Sx2, Sx, Sx2, Sx3, Sx2, Sx3, Sx4, Sy, Sxy, Sx2y, _ a1sqr, a2sqr, a3sqr, MD) ReDim Ysqr(1 To n) For j = 1 To n Ysqr(j) = a1sqr + a2sqr * x(j) + a3sqr * x(j) * x(j) Next j Call Koef_det(n, y, Ysqr, Ysr, Sostsqr, Sregrsqr, Spolnsqr, R_det_sqr) DSost = Sostsqr / (n - 3) Sa1sqr = Sqr(DSost * (Sx2 * Sx4 - Sx3 * Sx3) / MD) Sa2sqr = Sqr(DSost * (n * Sx4 - Sx2 * Sx2) / MD) Sa3sqr = Sqr(DSost * (n * Sx2 - Sx * Sx) / MD) Fsqr = R_det_sqr * (n - 3) / (2 * (1 - R_det_sqr)) ta1sqr = Abs(a1sqr) / Sa1sqr ta2sqr = Abs(a2sqr) / Sa2sqr ta3sqr = Abs(a3sqr) / Sa3sqr Call L_Kram(n, Sx, Sx, Sx2, Slny, Sxlny, cexp, a2exp) a1exp = Exp(cexp) ReDim Yexp(1 To n) ReDim lnYexp(1 To n) For j = 1 To n Yexp(j) = a1exp * Exp(a2exp * x(j)) lnYexp(j) = Log(Yexp(j)) Next j Call Koef_det(n, lny, lnYexp, lnYsr, Sostexp, Sregrexp, Spolnexp, _ R_det_exp) Call ZnachLine(n, Sostexp, R_det_exp, Sx2, Sx2sr, a1exp, a2exp, _ Sa1exp, Sa2exp, Fexp, ta1exp, ta2exp) 'Âûâîä ðåçóëüòàòîâ gr = 1 Call Print_rez(gr, "a1L", "a2L", "", "koef_kor=", "R_det_L=", "Sa1L=", _ "Sa2L=", "", "FLine=", "ta1L=", "ta2L=", "", a1L, a2L, 0, koef_cor, _ R_det_L, Sa1L, Sa2L, 0, Fline, ta1L, ta2L, 0) gr = 2 Call Print_rez(gr, "a1sqr", "a2sqr", "a3sqr", "", "R_det_sqr=", _ "Sa1sqr=", "Sa2sqr=", "Sa3sqr=", "Fsqr=", "ta1sqr=", "ta2sqr=", _ "ta3sqr=", a1sqr, a2sqr, a3sqr, 0, R_det_sqr, Sa1sqr, Sa2sqr, Sa3sqr, _ Fsqr, ta1sqr, ta2sqr, ta3sqr) gr = 3 Call Print_rez(gr, "a1exp", "a2exp", "", "", "R_det_exp=", "Sa1exp=", _ "Sa2exp=", "", "Fexp=", "ta1exp=", "ta2exp=", "", a1exp, a2exp, 0, 0, _ R_det_exp, Sa1exp, Sa2exp, 0, Fexp, ta1exp, ta2exp, 0) Call MinMax(x, n, Min, Max) Xpr = Xsr + 0.1 * (Max - Min) Ypr = a1L + a2L * Xpr st1 = " ïðîãíîçíîé òî÷êå Xpr=" + Format(Xpr, f_st) + _ "ïðîãíîçíîå çíà÷åíèå Ypr=" + Format(Ypr, f_st) ActiveCell = st1 tb_x = Format(Xpr, f_st) tb_y_l = Format(Ypr, f_st) tb_y_q = Format(a1sqr + a2sqr * Xpr + a3sqr * (Xpr) ^ 2, f_st) tb_y_e = Format(a1exp * Exp(a2exp * Xpr), f_st) Call graf End Sub Private Sub CommandButton2_Click() Unload UserForm1 End Sub Private Sub Label19_Click() End Sub Private Sub ListBox1_Change() End Sub Private Sub tb_y1_Change() End Sub Private Sub tb_yq_Change() End Sub Private Sub UserForm_Click() End Sub Результат работы программы представлен на рисунках 13-15 Рис. 13 Результат работы программы с выводом на лист Excel(Текст) Рис. 14 Результат работы программы с выводом на лист Excel(Графики) Рис. 15 Результат работы программы с выводом на UserForm 4)Расчёт аппроксимаций и построение графиков MathCADРешение и графическое представление результатов расчетов аппроксимации линейной, квадратичной, экспоненциальных функцией в MathCad приведено на рисунке 16,17,18 соответственно. Рис.16. Аппроксимация линейной функцией и график результата в MathCad. Рис.17. Аппроксимация квадратичной функцией и график результата в MathCad. Рис.18. Аппроксимация эспоненциальной функцией и график результата в MathCad. 5)Расчёт аппроксимаций и построение графиков MatLabИсходный код программы выглядит следующим образом для расчета аппроксимаций: %%Изначальные данные format shortG Y=[0.02 0.05 0.10 0.2 0.25 0.30 0.35 0.40 0.45 0.50 0.52]; X=[10.0 23.3 36.65 58.9 65.2 74.5 79.2 84.9 86.5 88.1 88.5]; x=0:1:100; n = 11; %%Линейная аппроксимация a=polyfit(X',Y',1) Yl=a(1).*X+a(2); y1 = polyval(a,x); plot(x,y1,'b',X,Y,'o') grid title('Линейная аппроксимация') legend('Линейная модель','Заданные точки','Location','NorthWest'); %%Квадратная аппроксимация l=polyfit(X',Y',2) Ykv=l(1).*X.^2+l(2).*X+l(3); y2 = polyval(l,x); plot(x,y2,'b',X,Y,'o') grid title('Квадратная аппроксимация') legend('Квадратная модель','Заданные точки','Location','NorthWest'); %%Экспоненциальная аппроксимация y_log=log(Y); c=polyfit(X,y_log,1); f=[exp(c(2)) c(1)] p_log=polyval(c,x); p=exp(p_log); plot(x,p,'b',X,Y,'ro') grid title('Экспоненциальная аппроксимация') legend('Экспоненциальная модель','Заданные точки','Location','NorthWest'); Решение и графическое представление результатов расчетов аппроксимации линейной, квадратичной, экспоненциальных функцией в MatLab приведено на рисунке 19,20,21 соответственно. Рис.19. Аппроксимация линейной функцией и график результата в MatLab. Рис.20. Аппроксимация квадратичной функцией и график результата в MatLab. Рис.21. Аппроксимация эспоненциальной функцией и график результата в MatLab. ЗАКЛЮЧЕНИЕВ курсовой работе мы решили задачу проведение эксперимента установления зависимости давления взрыва(Y) от концентрации пыли(X), определили тип и параметры аналитической зависимости, аппроксимирующей результаты испытаний. Лучше всего результаты испытаний, аппроксимирует квадратичная функция: y = 8E-05x2 - 0,0021x + 0,0489 т.к коэффициент детерминированности квадратичной выше других. БИБЛИОГРАФИЧЕСКИЙ СПИСОК1. Елисеева И.И. Общая теория статистики: Учебник для вузов (под ред. Елисеевой И.И.) изд. 5-е, перераб., доп. /Елисеева И.И., Юзбашев М.М. М.: Финансы и статистика, 2008. – 656. 2. Краинский, И. Word 2007 : популярный самоучитель : практическое руководство / И. Краинский. - Санкт-Петербург : Питер, 2008. - 240 с. - (Серия «Популярный самоучитель»). - ISBN 978-5-91180-678-1. - Текст : электронный. - URL: https://znanium.com/catalog/product/1775932 (дата обращения: 06.10.2022). 3 Зайдель А. Н Элементарные оценки ошибок измерений. 1968. Изд. 3-е, испр. и доп. Изд-во «Наука», Ленингр. ютд., Л., 1—96. |