Примеры кода.
1.Упорядочить линейный массив
2. Составить рекурсивную функцию вычисления значения факториала заданного натурального числа
3. Решение ОДУ: метод Ейлера, метод Рунге-Кутты 4-го порядка.
1. Упорядочить одномерный числовой массив
program z1;
uses crt;
var A:array[1..100] of integer; {of real} {массив целый или действительный}
t:integer; {real} {переменная такого же типа для временного хранения при обмене}
n:integer; {размерность и счетчики}
i,j:integer;
begin
writeln('введите размерность N');readln(n); {ввод размерности}
clrscr;
writeln('исходный массив');
writeln('');
for i:=1 to n do {ввод с клавиатуры или генерируем}
{write('A[',i,']= ');readln(A[i]);}
A[i]:=random(90)+10;
for i:=1 to n do {вывод массива}
write(A[i]:4);
writeln('');
{сортировка методом пузырька}
for i:=1 to n-1 do {начиная с первого до предпоследнего}
for j:=i+1 to n do {сравнивая со всеми последующими}
if A[i]<A[j] then { if A[i]>A[j] then}
begin {при необходимости меняем местами}
t:=A[i]; A[i]:=A[j]; A[j]:=t
end;
writeln('');
writeln(' полученный массив'); {вывод}
writeln('');
for i:=1 to n do
write(A[i]:4);
readln;
end.
вверх
2.Составить рекурсивную функцию вычисления значения факториала заданного натурального числа.
{...........рекурсивная функция вычисления факториала}
{вх.параметры: число , возвращаемое значение: факториал}
function f(n:integer):integer;
begin
if n <= 1 then {если число меньше 2 то факториал равен 1 и это признак завершения работы}
f := 1
else {иначе функция равна числу умноженному на функцию от параметра на 1 меньшего}
f := n * f(n - 1);
end;
вверх
3.Решение ОДУ: метод Ейлера, метод Рунге-Кутты 4-го порядка.
uses crt;
const h=0.1; {шаг сетки}
const y0=0.7; {начальное условие}
var
a,b:real; {края отрезка }
x,yE0,yRK0,yE1,yRK1:real; {аргумент, значение по методу Ейлера и Рунге-Кутты}
name : string; {имя файла}
f1 : text; {файловая переменная}
dyE,dyRK:real; {погрешности методов}
function f(x,y:real):real; {функция - правая часть ур-я}
begin
{f:=(y+2*x/y);}
f:=x*y-0.2*y*y;
end;
function fE(x,y,h:real):real; {функция - очередное значение по методу Ейлера}
begin
fE:=y+h*f(x,y); {формула метода}
end;
Function fRK(x,y,h:real):real; {функция - коэффициенты метода Рунге-Кутты}
{и очередное значение }
var k1,k2,k3,k4:real; {вычисляемые коэффициенты}
begin
k1:=f(x,y);
k2:=f(x+h/2,y+h*k1/2);
k3:=f(x+h/2,y+h*k2/2);
k4:=f(x+h,y+h*k3);
fRK:=y+h*(k1+2*k2+2*k3+k4)/6; {формула метода}
end;
{======= Основная программа }
begin
TextBackGround(Blue); TextColor(Yellow); ClrScr;
a:=0;b:=1; { Читаем с клавиатуры граныцы отрезка }
{Writeln( 'Введите края отрезка a,b (предполагается 0, 1)' ); readln( a,b );}
if (a<b) then {проверяем корректность ввода}
begin {если ввод корректен}
{ Читаем строку с клавиатуры в переменную name }
{Write( 'Ввведите имя файла для таблицы значений -> ' );
readln( name ); }
name:= 'q.txt';
assign(f1, name ); { Назначаем имя файла файловой переменной }
reWrite(f1); { Открываем файл на запись }
clrscr; {шапка}
Writeln ('Задание 2.');
Writeln ('исполнитель: Иванов И. гр.А1');
Writeln('');
Writeln( 'Решение задачи Коши методами: Ейлера, Рунге-Кутты' );
Writeln( ' y=y+2x/y , y(0)=',y0 ,', xe[0,1]' );Writeln();
Writeln( ' x','y(Eйлер)':15,'y(Рунге-Кутты)':17 );
Writeln( '-----------------------------------------------------');
Writeln(f1, ' x','y(Eйлер)':15,'y(Рунге-Кутты)':17 );
Writeln(f1, '-----------------------------------------------------');
x:=a; {начинаем от левой границы}
dyE:=0; dyRK:=0; {установим для начала нулевые погрешности методов}
{если это левая граница, то значение совпадает}
{с начальным условием иначе вычисляем}
while x<=b do {цикл: пока не достигнем правой границы}
begin
if x=a then
begin yE1:=y0; {по методу Ейлера}
yRK1:=y0; {по методу Рунге-Кутта}
end
else begin { двигаемся на шаг вправо}
yE0:=yE1 ; {по методу Ейлера}
yRK0:=yRK1 ; {по методу Рунге-Кутта}
yE1:=fE(x-h,yE0,h); {по методу Ейлера}
yRK1:=fRK(x-h,yRK0,h); {по методу Рунге-Кутта}
end;
{выводим в файл значениея аргумента}
{точное значение, значение по методу Ейлера, Рунге-Кутта}
writeln(f1,x:5:1,yE1:15:7,yRK1:15:7);;
//writeln(f1);
{и для контроля выводим на экран}
writeln(x:5:1,yE1:15:7,yRK1:15:7);
{вычисляем максимальные погрешности методов}
if x>a then
begin
if dyE<abs(yE1-yE0) then dyE:=abs(yE1-yE0);
if dyRK<abs(yRK1-yRK0) then dyRK:=abs(yRK1-yRK0);
end;
x:=x+h;
end;
close( f1 ); {close( f2 );} { Закрыть файл }
Writeln; { Пропустить строку }
Writeln( 'Погрешность метода Ейлера dE=',dyE:10:10 );
Writeln( 'Погрешность метода Рунге-Кутты dRK=',dyRK:10:10 );
Writeln( 'Файл результатов ', name, ' записан.' );
end
else
Writeln( 'Некорректный ввод' );
Writeln;
end.
вверх
4. Методы численного интегрирования.
Program Integral;
uses crt;
const m=10;
var a,b,eps:real;
i,n: integer;
s1,s2:real;
s3,s4:real;
{Сама функция}
Function F(x:real): real;
begin
F := exp(x)/sqrt(1+x*x+0.3*x) ;
End ;
{--------------------------}
function Rect(a,b:real;n:integer;m:real) :real ;
var h,s:real;
i:integer;
begin
h:= (b - a) / n;
S:= 0;
For i := 1 To n - 1 do
S := S + F(a+ h * (i-1+m));
Rect := S*h;
end;
{--------------------------}
{--------------------------}
function Trap(a,b:real;n:integer) :real ;
var h,s:real;
i:integer;
begin
h := (b - a) / n;
s := 0;
For i := 1 To n - 1 do
s := s + F(a+i*h);
Trap := h * (F(a) + F(b) + 2 * s) / 2;
end;
{--------------------------}
function Simpson(a,b:real;n:integer) :real ;
var h,s1,s2,s:real;
i:integer;
begin
h:= (b - a) / n;
s1 := 0; {вычисление первой суммы (см. формулу)}
For i := 1 To n - 1 do
s1 := s1 + F(h * i + a);
s2 := 0; {Вычисление второй суммы (см. формулу).}
For i:= 1 To n do
s2 := s2 + F(h * i - 0.5 * h + a);
{Итоговая формула }
s := h / 3 * (0.5 * F(a) + s1 + 2 * s2 + 0.5 * F(b));
Simpson:= s ;
end;
{--------------------------}
begin
TextBackGround(Blue); TextColor(Yellow); ClrScr;
a:=2;b:=4;
for i:=1 to m do
begin
n:=10*i;
writeln('n=',n);
s1:=Rect(a,b,n,0);s2:=Rect(a,b,2*n,0) ;
writeln('м. прямоугольников (левые) I=',s2:10:8,' eps=', abs(s2-s1):10:8 );
s1:=Rect(a,b,n,0.5);s2:=Rect(a,b,2*n,0.5) ;
writeln('м. прямоугольников (средние) I=',s2:10:8,' eps=', abs(s2-s1):10:8 );
s1:=Rect(a,b,n,1);s2:=Rect(a,b,2*n,1) ;
writeln('м. прямоугольников (правые) I=',s2:10:8,' eps=', abs(s2-s1):10:8 );
s1:=Trap(a,b,n);s2:=Trap(a,b,2*n) ;
writeln('метод трапеций I=',s2:10:8,' eps=', abs(s2-s1):10:8 );
s1:=Simpson(a,b,n);s2:=Simpson(a,b,2*n);
writeln('метод Симпсона I=',s2:10:8,' eps=', abs(s2-s1):10:8 );
if i<m then writeln('Enter');
readln;
end;
readln;
end.
вверх
