Главная страница

Курсач. приписка. Курсовая работа по дисциплине Введение в информационные технологии


Скачать 0.9 Mb.
НазваниеКурсовая работа по дисциплине Введение в информационные технологии
АнкорКурсач
Дата17.04.2023
Размер0.9 Mb.
Формат файлаdocx
Имя файлаприписка.docx
ТипКурсовая
#1067857
страница5 из 5
1   2   3   4   5

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.

1   2   3   4   5


написать администратору сайта