Лабораторная работа №7.
Приближенное интегрирование функций.
Вариант 13.
Задание:
-
На рабочем листе Excel составить таблицу вычисления интеграла по формулам: “левых” прямоугольников, “правых” прямоугольников, “средних” прямоугольников, используя для оценки точности двойной просчет с шагом H1=0,2 иH2=0,1.
-
Составить программу вычисления интеграла с заданной точностью методом парабол (Симпсона). Для этого нужно изменить в приведённом тексте программы содержание процедуры Calc в соответствии с вариантом.
Const eps = 0.01
Sub Integral()
Dim Xn As Single, Xk As Single, Xt As Single
Sheets("Программа").Activate
'очистка ячеек рабочего листа
Cells.ClearContents
Cells.Borders.LineStyle = xlNone
Cells.BorderAround Weight:=xlThin
Cells.Interior.ColorIndex = 0
Range("A1").Select
ActiveCell.Offset(0, 1).FormulaR1C1 = _
" Вычисление интеграла от функции f(x)"
ActiveCell.Offset(0, 1).Range("A1:E1").Select
With Selection
.Font.ColorIndex = 3
.Borders(xlLeft).LineStyle = xlNone
.Borders(xlRight).LineStyle = xlNone
.Borders(xlTop).LineStyle = xlNone
.Borders(xlBottom).LineStyle = xlNone
.BorderAround Weight:=xlMedium, ColorIndex:=Automatic
End With
With Selection.Interior 'цвет выделенного диапазона
.ColorIndex = 19
.Pattern = xlSolid
End With
Range("A1").Select
'присвоениепеременнойK2 имениx
ActiveWorkbook.Names.Add Name:="x", _
RefersToR1C1:="=R2C11"
inputfunc = Application.InputBox("Введите функцию f(x)")
Xf = "=" & inputfunc
inputVal = Application.InputBox("Введите левую границу отрезка по X - Xn")
Xn = inputVal
inputVal = Application.InputBox("Введите правую границу отрезка по X - Xk")
Xk = inputVal
ActiveCell.Offset(2, 2).Select
ActiveCell.FormulaR1C1 = "f(x)=" & inputfunc
With Selection
.Font.Size = 14
.Font.Name = "Arial"
End With
Range("A1").Select
ActiveCell.Offset(3, 6).FormulaR1C1 = "f(x)"
ActiveCell.Offset(4, 6).FormulaR1C1 = "Граничные условия"
ActiveCell.Offset(5, 6).FormulaR1C1 = "Xn"
ActiveCell.Offset(6, 6).FormulaR1C1 = "Xk"
ActiveCell.Offset(7, 6).FormulaR1C1 = "Точность"
ActiveCell.Offset(0, 10).FormulaR1C1 = "X текущее"
ActiveCell.Offset(2, 10).FormulaR1C1 = "Значение f(x)"
ActiveCell.Offset(3, 10).FormulaR1C1 = "X"
ActiveCell.Offset(3, 11).FormulaR1C1 = "f(x)"
ActiveCell.Offset(3, 6).Range("A1:B5").Select
With Selection
.Borders(xlLeft).LineStyle = xlNone
.Borders(xlRight).LineStyle = xlNone
.Borders(xlTop).LineStyle = xlNone
.Borders(xlBottom).LineStyle = xlNone
.BorderAround Weight:=xlMedium, ColorIndex:=Automatic
End With
Range("A1").Select
ActiveCell.Offset(3, 7).Select 'ячейка H4
ActiveCell.FormulaR1C1 = Xf
ActiveCell.Offset(2, 0).Select
ActiveCell.FormulaR1C1 = Xn
ActiveCell.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = Xk
ActiveCell.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = eps
Call Calc 'вызов процедуры вычисления интеграла
Call Grafic 'вызов процедуры табулирования функции
End Sub
Function FuncI(Xt As Single)
Range("A1").Select
ActiveCell.Offset(1, 10).FormulaR1C1 = Xt
FuncI = ActiveCell.Offset(3, 7).Value
End Function
Sub Calc() 'вычисление интеграла методом парабол
Dim Xt As Single, Xn As Single, Xk As Single
Range("A1").Select
Xn = ActiveCell.Offset(5, 7).Value
Xk = ActiveCell.Offset(6, 7).Value
ActiveCell.Offset(9, 6).FormulaR1C1 = "Метод парабол(симпсона)"
ActiveCell.Offset(10, 6).FormulaR1C1 = "№"
ActiveCell.Offset(10, 7).FormulaR1C1 = "Шаг"
ActiveCell.Offset(10, 8).FormulaR1C1 = "Интеграл"
s1 = 1000000#
Nx = 2
i = 1
1: Hx = (Xk - Xn) / Nx
s = (FuncI(Xn) + FuncI(Xk))
Xt = Xn
Odd = True
Do
Xt = Xt + Hx
If Odd Then
s = s + 4 * FuncI(Xt)
Odd = False
Else
s = s + 2 * FuncI(Xt)
Odd = True
End If
Loop Until Xt > (Xk - Hx) + 0.001
s = s * Hx / 3
ActiveCell.Offset(10 + i, 6).FormulaR1C1 = i
ActiveCell.Offset(10 + i, 7).FormulaR1C1 = Hx
ActiveCell.Offset(10 + i, 8).FormulaR1C1 = s
If Abs(s - s1) > eps Then
s1 = s
Nx = 2 * Nx
i = i + 1
GoTo 1
End If
Range("A1").Select
End Sub
Sub Grafic()
Dim Xt As Single
Range("A1").Select
Xn = ActiveCell.Offset(5, 7).Value
Xk = ActiveCell.Offset(6, 7).Value
Hx = (Xk - Xn) / 20
i = 0
t = "K5:L"
Xt = Xn
Do
Yt = FuncI(Xt)
Range("A1").Select
ActiveCell.Offset(i + 4, 10).FormulaR1C1 = Xt
ActiveCell.Offset(i + 4, 11).FormulaR1C1 = Yt
Xt = Xt + Hx
i = i + 1
Loop Until Xt > Xk + 0.001
W = Str(i + 4)
W = Trim(W)
t = t + W
ChartCreate (t) 'вызов процедуры построения диаграммы
End Sub
Sub ChartCreate(Z) 'процедура построения диаграммы
ActiveSheet.ChartObjects.Add(10, 100, 250, 200).Select
ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
ActiveChart.SetSourceData Source:=Range(Z), PlotBy:=xlColumns
'Форматированиедиаграммы
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "График функции f(x)"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "x"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "f(x)"
.HasLegend = False
End With
'форматированиеосикатегорий
With ActiveChart.Axes(xlCategory)
.Format.Line.Weight = 2
.HasMajorGridlines = True
.MajorGridlines.Border.LineStyle = xlDash
End With
'форматирование оси значений
With ActiveChart.Axes(xlValue)
.Format.Line.Weight = 2
.HasMajorGridlines = True
.MajorGridlines.Border.LineStyle = xlDash
End With
'рамка, ограничивающая область диаграммы
With ActiveChart.ChartArea.Format.Line
.Visible = msoCTrue
.DashStyle = msoLineSolid
.Weight = 3
End With
Range("A1").Select
End Sub
Блок-схема метода: