Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

Архив1 / docx59 / docx177 / Лаб7 отчет

.docx
Скачиваний:
17
Добавлен:
01.08.2013
Размер:
1.22 Mб
Скачать

Лабораторная работа №7.

Приближенное интегрирование функций.

Вариант 13.

Задание:

  1. На рабочем листе Excel составить таблицу вычисления интеграла по формулам: “левых” прямоугольников, “правых” прямоугольников, “средних” прямоугольников, используя для оценки точности двойной просчет с шагом H1=0,2 иH2=0,1.

  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

Блок-схема метода:

Соседние файлы в папке docx177