Шкиль Владимир Григорьевич практическая работа

Вид материалаПрактическая работа

Содержание


Особенности отладки и компиляции программ, содержащих процедуры и функции
2. Решение задач
Te = 2*3.1416/28.4261; ti = 2*3.1416/33.1638; interval = 30
Подобный материал:
1   2   3   4   5

Особенности отладки и компиляции программ,

содержащих процедуры и функции


При пошаговой отладке программ, содержащих процедуры и функции, при нажатии клавиши F7 в строке, которая содержит вызов подпрограммы, мы переходим в начало (на слово begin) данной подпрограммы. При завершении работы подпрограммы – если подсвечена конечная строка end или exit. При следующем нажатии F7 мы возвращаемся в ту строку основной программы, с которой попали в подпрограмму. Постоянный заход в подпрограммы часто бывает не нужен. Для пошагового исполнения основной программы без захода в подпрограммы используйте клавишу F8.

В меню Debug предусмотрено специальное окно для просмотра последовательности вызываемых функций и процедур. Это окно открывается клавишами Ctrl+F4 или через пункт меню Debug/Call stack. В этом окне прослеживается текущее, то есть изменяющееся при пошаговой отладке, состояние стека вызова подпрограмм. В верхней строке – исполняемая в данный момент подпрограмма, в нижней – основная программа, в промежутке между ними – последовательность вызовов подпрограмм от основной программы до текущей программы.

При выходе из подпрограммы стек программы освобождается от ее вызова, и верхняя строка в окне стека убирается. Это окно следует применять при сложной иерархии взаимных вызовов подпрограмм, когда не очевидно, каким путем выполнение алгоритма привело к данной подпрограмме.

При разработке программных проектов, содержащих несколько модулей, удобно использовать многооконный интерфейс среды, позволяющий одновременно работать со всеми файлами данного проекта.

Пункты этого меню позволяют выбрать расположение окон на экране, переключаться между окнами, закрывать окна. Пункт Tile разделяет экран на отдельные кусочки, в каждом из которых находится свое окно. Такой способ разбиения имеет смысл применить, если открыто 2-4 окна. Пункт Cascade накладывает окна одно на другое таким образом, что край нижних окон виден из-под верхних. При таком раскладе окон каждое из них имеет достаточно большой размер и легко может быть активизировано.



Переключение между окнами производится нажатием клавиш, указанными в меню. Для изменения размера и положения окна нужно нажатием клавиш Ctrl+F5 вызвать пункт Size/Move. Размеры окна изменяются клавишами перемещения курсора. Когда требуемый размер установлен, нужно нажать Enter для фиксации положения окна. Если Вы забудете нажать Enter, все действия будут блокированы. Для перемещения окна при нажатии клавиш управления курсором надо держать нажатой клавишу Shift.

При компиляции проектов, использующих модули, можно использовать различные режимы компиляции.

По нажатию клавиш Alt+F9 компилируется программа или модуль, находившиеся в активном окне. Используемые этой программой модули должны быть предварительно откомпилированы.

Компиляцию проектов, состоящих из нескольких модулей, удобно производить, установив основной файл – это, как правило, файл с основной программой. Для этого выбирается пункт Primary file и вводится имя файла. Уничтожение этой записи производится путем выбора пункта Clear primary file. Если начальный файл установлен, компиляция или компиляция с исполнением происходит всегда так, как будто активным окном являлось окно основной программы. Это позволяет вносить изменения в отдельных модулях и сразу запускать компиляцию и исполнение всего проекта, не переключаясь специально к основной программе.

Для подключения к основной программе модулей компилятор ищет их прежде всего в рабочем каталоге, а затем в каталогах, указанных в строке Units окна настройки, которое появляется при выборе пункта меню Options/Directories.

При нажатии клавиши F9 (Make) прежде всего происходит компиляция начального файла, заданного в строке Primary file. Если эта строка пуста, компиляция начинается с активного окна. когда в процессе компиляции программы или модуля встречаются ссылки на другие модули, проверяется необходимость перекомпиляции подключаемых модулей. Проверка заключается в сверке изменений файла с текстом модуля на Паскале и откомпилированного модуля (по времени внесения последних изменений в файл). Если в текст были внесены изменения, данный модуль компилируется вновь. Если файл модуля с текстом не найден , берется откомпилированный файл без проверки. Эта опция компилятора оптимальна по затратам времени на компиляцию, так как компилируется только то, что нужно. Компиляция и запуск на исполнение, вызываемые клавишами Ctrl+F9, производит компиляцию по данной логике.

В ряде случаев нам необходима обязательная перекомпиляция всех файлов (Build). В частности, это необходимо, если мы изменили опции компиляции в меню Options/Compiler. Изменение опций компиляции через окно не прослеживается далее автоматически, то есть среда не определяет, откомпилирован файл с новыми или старыми опциями, и не производит автоматически перекомпиляцию. Для полной компиляции всех файлов вызывается пункт Build.

Пункт Target устанавливает, для какой платформы – реального режима, защищенного режима или Windows – должны компилироваться файлы.


2. Решение задач


Задача 1. Описать пpоцедуpу "аналитического" сложения обыкновенных дробей, вычисляющую по числам P1,Q1,P2,Q2, являющимися числителями и знаменателями дробей и последняя дробь несократима. Результат вывести в виде

P1 P2 P

---- + ---- = ---

Q1 Q2 Q

Program drobi;

Uses

Crt;

Var

P1, Q1, P2, Q2, P, Nod_2, Celaya : Longint;

Dop_1, Dop_2 : integer;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}

Procedure Nod(A,B : Longint;Var Nod_2 : Longint);

Begin

Nod_2:=A*B;

End;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}

Procedure Vivod_Otveta(Celaya,P1,Q1,P2,Q2,P,Nod_2,X,Y:integer);

Var

i : integer;

Begin

if P > Nod_2

then

begin

Celaya:=P div Nod_2;

P:=P mod Nod_2;

end

else

begin

Gotoxy(X+1,Y);

write(P1);

Gotoxy(X+10,Y);

write(P2);

if P = 0

then

begin

Gotoxy(X+1,Y+1);

write('---- + ---- = ',Celaya,'');

Gotoxy(X+1,Y+2);

write(Q1);

Gotoxy(X+10,Y+2);

write(Q2);

end

else

begin

for I:=10 downto 2 do

begin

if ((P mod I) = 0) and ((Nod_2 mod I) = 0) then

begin

P:=P div I;

Nod_2:=Nod_2 div I;

end;

end;

Gotoxy(X+19,Y);

write(P);

Gotoxy(X+1,Y+1);

write('---- + ---- = ',Celaya,' ------');

Gotoxy(X+1,Y+2);

write(Q1);

Gotoxy(X+10,Y+2);

write(Q2);

Gotoxy(X+19,Y+2);

write(Nod_2);

end;

end;

End;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}

Procedure Podshet(P1, Q1, P2, Q2 : Longint);

Begin

Nod(Q1,Q2,Nod_2);

Dop_1:=Nod_2 div Q1;

Dop_2:=Nod_2 div Q2;

P:=(Dop_1*P1)+(Dop_2*P2);

if P > Nod_2

then

begin

Celaya:=P div Nod_2;

P:=P mod Nod_2;

end;

End;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}

Begin

Clrscr;

Q1:=0;

Q2:=0;

Textcolor(LightCyan);

writeln(' P1 P2 P');

writeln('---- + ---- = ---');

writeln(' Q1 Q2 Q');

writeln;

write('Введите P1 -> ');

readln(P1);

while Q1 = 0 do

begin

write('Введите Q1 -> ');

readln(Q1);

if Q1 = 0

then

writeln('Число Q1 не должно pавнятся 0');

end;

write('Введите P2 -> ');

readln(P2);

while Q2 = 0 do

begin

write('Введите Q2 -> ');

readln(Q2);

if Q2 = 0

then

writeln('Число Q2 не должно равняться 0');

end;

Podshet(P1,Q1,P2,Q2);

Vivod_Otveta(Celaya,P1,Q1,P2,Q2,P,Nod_2,2,10);

readkey;

End.


Задача 2. Для заданного N составить алгоритм вычисления значения выражения:

(1*1) (2*2) (3*3) (N*N)

----------- * ------------ * ----------- * * -----------

(1+(3*3)) (2+(3*3)) (3+(3*3)) ... (N+(3*3))

Program NNN;

Uses Crt;

Var

N, Ch, Zn, Celaya : Longint;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}

Procedure Podshet(N : Longint; Var Chislitel, Znamenatel : Longint);

Var

A, Z : integer;

Begin

Chislitel:=1;

Znamenatel:=1;

for A:=1 to N do

begin

Chislitel:=Chislitel*(A*A);

Znamenatel:=Znamenatel*(9+A);

for Z:=2 to 10 do

begin

if ((Chislitel mod Z) = 0) and ((Znamenatel mod Z) = 0)

then

begin

Chislitel:=Chislitel div Z;

Znamenatel:=Znamenatel div Z;

end;

end;

end;

End;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}

Begin

Clrscr;

TextBackground(Black);

Textcolor(Yellow);

write('Введите N -> ');

read(N);

Podshet(N,Chl,Zn);

Celaya:=Ch div Zn;

Chislitel:=Ch mod Zn;

writeln('Ответ');

writeln(' ',Ch);

writeln('',Celaya,' ---------');

writeln(' ',Zn);

readkey;

End.


Задача 3. Рассмотрим пример нахождения максимума из трёх чисел:


program Max1;
var a,b,c,m: integer;
begin
write('Введите a: '); readln(a);
write('Введите b: '); readln(b);
write('Введите c: '); readln(c);
if a>b then m:=a else m:=b;
if c>m then m:=c;
writeln('Максимум = ',m);
readln;
end.


Перепишем его с использованием процедуры:

program Max2;
var a,b,c,m: integer;
procedure FindMax;
begin
if a>b then m:=a else m:=b;
if c>m then m:=c;
end;
begin
write('Введите a: '); readln(a);
write('Введите b: '); readln(b);
write('Введите c: '); readln(c);
FindMax;
writeln('Максимум = ',m);
readln;
end.

Этот вариант можно улучшить. Пока наша процедура может искать минимум только среди значений конкретных переменных a, b и c. Заставим её искать минимум среди любых трёх целых чисел и помещать результат в нужную нам переменную, а не всегда в m.
Чтобы была видна польза от такой процедуры, рассмотрим пример программы для поиска максимума среди чисел a+b, b+c и a+c:


program Max3;
var a,b,c,m: integer;
procedure FindMax(n1,n2,n3: integer; var max: integer);
begin
if n1>n2 then max:=n1 else max:=n2;
if n3>max then max:=n3;
end;
begin
write('Введите a: '); readln(a);
write('Введите b: '); readln(b);
write('Введите c: '); readln(c);
FindMax(a+b,b+c,a+c,m);
writeln('Максимум из сумм = ',m);
readln;
end.
В скобках после имени процедуры (в её описании) записаны так называемые параметры. Эта запись обозначает, что внутри процедуры можно использовать целые числа, обозначенные n1, n2 и n3, а также заносить значения в переменную типа integer, которая внутри процедуры называется max (а реально во время работы программы все действия производятся над пере-менной m). Параметры, в которых хранятся числа (n1,n2,n3) называются параметрами-значениями; а те, которые обозначают переменные (max) - параметрами-переменными, перед ними в описании ставится слово var. Параметры, на которые имеются ссылки внутри процеду-ры (n1, n2, n3, max), называются формальными, а те, которые реально используются при вызове (a+b, b+c, a+c, m) - фактическими.
Процедуры последнего вида оказываются достаточно удобными. Можно один раз написать такую процедуру, убедиться в её работоспособности и использовать в других программах. При-мерами таких процедур являются процедуры для работы со строками, встроенные в Турбо-Паскаль.
В нашем примере можно переписать программу и по-другому. Максимум из трёх чисел определяется по ним однозначно, или, говоря математическим языком, является функцией этих трёх чисел. Понятие функции есть также и в Паскале. Рассмотрим такую программу:

program Max4;
var a,b,c,m: integer;
function Max(n1,n2,n3: integer) : integer;
var m: integer;
begin
if n1>n2 then m:=n1 else m:=n2;
if n3>m then m:=n3;
Max:=m;
end;
begin
write('Введите a: '); readln(a);
write('Введите b: '); readln(b);
write('Введите c: '); readln(c);
writeln('Максимум = ',Max(a+b,b+c,a+c));
readln; end.


Нам уже известно как вызывать функцию из программы (например sqrt, sin и т. п.). Рассмотрим описание функции. Оно очень похоже на описание процедур, но есть два отличия:
1. После имени функции и списка параметров (если есть) через двоеточие записывается тип значения функции (возможны не только числовые типы, но и логические, строковые, символьные);
2. Среди операторов в теле функции наиболее важными являются операторы присваивания значения функции (в нашем случае это строчка Max:=m;).
В записанной выше функции используется так называемая локальная переменная m, то есть переменная, которая "видна" только нашей функции, а другие процедуры и функции, а также главная программа её "не видят". Кроме локальных переменных в Турбо-Паскале можно определять локальные константы и типы.


Задача 4 (фрагмент). Вычисление площади треугольника через длины сторон. Здесь будет использована формула Герона: , где p - полупериметр треугольника, a, b, c - длины сторон.


function Square(a,b,c: real): real;
var p: real;
begin
p:=(a+b+c)/2;
Square:=sqrt(p*(p-a)*(p-b)*(p-c));
end;


Задача 5 (фрагмент). Процедура для решения квадратного уравнения. Будем передавать этой процедуре коэффициенты уравнения, а результаты своей работы она будет выдавать в трёх параметрах-переменных. Через первую, логического типа, процедура сообщит, есть ли вещественные корни, а еще в двух она выдаст сами эти корни (если вещественных корней нет, то на эти две переменные пользователь нашей процедуры может не обращать внимания).

procedure SqEquation(a,b,c: real; var RootsExist: boolean;
var x1,x2: real);
var d: real;
begin
d:=sqr(b)-4*a*c;
if d>=0 then begin
RootsExist:=true;
x1:=(-b+sqrt(d))/(2*a);
x2:=(-b-sqrt(d))/(2*a);
end
else RootsExist:=false; end;

Можно вместо процедуры написать и функцию, по логическому значению которой мы определяем, есть ли корни, а сами корни передаются также как и в процедуре:
function EqHasRoots(a,b,c: real; var x1,x2: real) : boolean;
var d: real;
begin
d:=sqr(b)-4*a*c;
if d>=0 then begin
EqHasRoots:=true;
x1:=(-b+sqrt(d))/(2*a);
x2:=(-b-sqrt(d))/(2*a);
end
else EqHasRoots:=false;
end;

Использовать такую функцию даже проще чем последнюю процедуру:
if EqHasRoots(1,2,1,r1,r2) then writeln(r1,' ',r2) else writeln('Нет вещест-х корней');


Задача 6. В результате применения пенициллина концентрация болезнетворных бактерий в крови больного уменьшается на 1/3 в день от содержимого предыдущего дня. Через сколько дней наступит выздоровление, если концентрация бактерий должна уменьшиться от N1 до N2 ? (N1 > N2)

program baktery;

uses crt;

var

dni : Word;

n1, n2, a : Real;

begin

ClrScr;

ReadLn(n1);

ReadLn(n2);

dni := 0;

a := 0;

if n2 > n1 then begin

TextColor(Red); GotoXY(15,5); GotoXY(15,6);

End else

begin

repeat

a := n1 / 3;

n1 := n1 - a;

Inc(dni)

until n1 <= n2;

WriteLn(dni);

end;

WriteLn;

Write('Press Enter');

ReadLn;

end.


Задача 7. Расход топлива нового трактора составляет 4 литра в час. За каждый рабочий день в связи с износом расход топлива увеличивается на 0,01% в сравнении с предыдущим днем. Через сколько рабочих дней двигатель потребует капитального ремонта, если предельный расход топлива равен Z литров в час?


program dizel;

uses crt;

var

rashod, predel, prozent, a : Real;

dni : Word;

begin

ClrScr;

ReadLn(predel);

rashod := 4;

prozent := 0.01;

a := 0;

dni := 0;

if predel <= rashod then

begin

TextColor(Red);

GotoXY(15,4);

GotoXY(15,5);

end

else

begin

repeat

a := (rashod / 100) * prozent;

rashod := rashod + a;

Inc(dni)

until rashod >= predel;

WriteLn(dni)

end;

WriteLn;

WriteLn('Press Enter');

ReadLn

end.


Задача 8. Имеется убывающий ряд чисел: 1/2, 1/3, 1/4, 1/5,...Найти сумму всех элементов ряда с точностью Z (т.е. если очередной элемент ряда стал меньше Z, то его суммировать уже не нужно).

program 8;

uses crt;

var

z : Real;

drob, b, c, a : Real;

znamenat : Integer;

begin

ClrScr;

Write('Z: ');

ReadLn(z);

drob := 0;

znamenat := 1;

a := 0;

repeat

a := 1 / (znamenat + 1);

Inc(znamenat);

drob := drob + a

until a <= z;

WriteLn(drob:10:2);

WriteLn;

Write('Press Enter');

ReadLn

end.

Задача 9. Подпрограмма-функция - считает .

program Funct;

uses crt;

Var D,A,B,x,y,C:real;

function P(n:real):real;

begin

P:= exp(1/3*ln(n));

end;

begin clrscr;

write('x = '); readln(x);

write('y = '); readln(y);

A:= P(x)+ P(y);

writeln('A = ',A);

readln;

end.


Задача 10. Функция программиста для вычисления факториала.

function Factor(n:integer):integer;

var

f:integer;

i:integer;

begin

f:=1;

for i:=2 to n do

f:=f*i;

factor:=f;

end;


Задача 11. Функция программиста для вычисления кубического корня.

Function cubrt(x:real):real;

var

pr:real;

begin

pr:=sqrt(x);

while abs(pr-x/(pr*pr))>0.001 do

begin

pr:=(2*pr+x/(pr*pr))/3;

end;

cubrt:=pr;

end;

begin

writeln(cubrt(3));

end.

Задача 12. Рекурсивная функция вычисления факториала.

function factorial(k:integer):integer;

begin

if k = 1

then factorial:=1

else factorial:= k*factorial(k-1);

end;


Задача 13. Пример использования рекурсивной функции.

program usfac;

var

n:integer;

f:integer;

function factorial(k:integer):integer;

begin

if k = 1

then factorial:=1

else factorial:= k*factorial(k-1);

end;

begin

readln(n);

f:=factorial(n);

writeln(f);

end.


Задача 14. Процедура рисования рамки.

program frame;

uses Crt;

procedure Frm(l:integer; t:integer; w:integer; h:integer);

var

x,y:integer;

i:integer;

c1,c2,c3,c4,c5,c6:char;

begin

c1:=chr(218);

c2:=chr(196); c3:=chr(191); c4:=chr(179); c5:=chr(192); c6:=chr(217); GoToXY(l,t);

write(c1);

for i:=1 to w-2 do

write(c2);

write(c3);

y:=t+1;

x:=l+w-1;

for i:=1 to h-2 do

begin

GoToXY(l,y);

write(c4);

GoToXY(x,y);

write(c4);

y:=y+1;

end;

GoToXY(l,y);

write(c5);

for i:=1 to w-2 do

write(c2);

write(c6);

end;

begin

Frm(2,2,15,10);

end.


Задача 15. Эволюция.

program evoluts;

uses crt;

label 1,2,3,4,5;

var ia:word;

c,k:char;

a,b:array [1..30,1..20] of integer;

i,j,mk,z,t,x1,x2,x3,y1,y2,y3,xm,ym,p,m,vm,x,y,ey,ex:integer;

procedure ramka;

const lin='ННННННННННННННННННННННННННННННН';

begin

textcolor(14); for i:=2 to 20 do

begin

gotoxy(6,i); write('є');

gotoxy(36,i); write('є')

end;

gotoxy(6,1); write(lin); gotoxy(6,21); write(lin);

gotoxy(6,1); write('Й'); gotoxy(6,21); write('И');

gotoxy(36,1); write('»'); gotoxy(36,21); write('ј')

end;

procedure ogr1;

begin

if x>29 then x:=29;

if x<2 then x:=2;

if y>19 then y:=19;

if y<1 then y:=1

end;

procedure ogr2;

begin

if x>x3 then x3:=x;

if x
if y>y3 then y3:=y;

if y
end;

procedure np;

label 1,2;

begin

for i:=1 to 30 do for j:=1 to 20 do

begin

a[i,j]:=0; b[i,j]:=0

end;

x:=15; y:=10; m:=0; clrscr; textbackground(0);

ramka; gotoxy(x+5,y+1); textcolor(9);

1: if not(keypressed) then goto 1;

textcolor(6); gotoxy(45,1); write(m);

textcolor(9); gotoxy(x+5,y+1); k:=readkey;

if a[x,y]<>1 then write(' ');

if k=#77 then inc(x);

if k=#75 then dec(x);

if k=#80 then inc(y);

if k=#72 then dec(y);

ogr1; ogr2; gotoxy(x+5,y+1);

if k=#13 then

begin

a[x,y]:=1; inc(m); write('*'); gotoxy(x+5,y+1)

end;

if k=' ' then goto 2;

goto 1;

2: vm:=m

end;

begin

5: x2:=31; x3:=0; y2:=21; y3:=0; p:=0; np;

3: inc(p); m:=0; gotoxy(1,25); textcolor(7);

write(p); x1:=x2-1; xm:=x3+1; y1:=y2-1; ym:=y3+1;

for ey:=y1 to ym do

begin

y:=ey+1; for ex:=x1 to xm do

begin

x:=ex+1; ogr1;

z:=b[x,y]; t:=0; mk:=0; gotoxy(x+5,y+1);

for x1:=-1 to 1 do for y1:=-1 to 1 do

begin

if (x1=0) and (y1=0) then goto 1;

if a[x+x1,y+y1]>0 then inc(mk);

1: end;

if z=0 then goto 2;

c:='*'; if z>5 then

begin

c:=' '; b[x+1,y+1]:=0

end;

textcolor(z); write(c);

if (mk=2) or (mk=3) then

begin

inc(m); t:=z+1; if t>13 then t:=0

end;

goto 4;

2: write(' '); b[x,y]:=0; if mk=3 then

begin

ogr2; inc(m); t:=1+z

end;

4: if t>13 then t:=0;

b[x,y]:=t

end

end;

gotoxy(56,25); textcolor(7); vm:=m; write(' ');

gotoxy(35,25); write('vm);

for i:=1 to 30 do for j:=1 to 20 do if b[i,j]>=13 then b[i,i]:=0;

a:=b; if keypressed then if readkey=#27 then halt;

for ia:=0 to 65535 do;

if (vm>0) and (m>0) then goto 3;

textcolor(7); clrscr; k:=readkey;

if k<>#27 then goto 5;

clrscr

end.


Задача 15. Рассчитать уровень энергии в яме вида Sqrt(E-Sqr(cos(Pi*x)/sin(Pi*x))).

program Yama;

type

RealType = Extended;

FunType = function(x : RealType) : RealType;

var

st, n2, t1, t2, m, h, v0, a0, E, En : RealType;


function Fun(x : RealType) : RealType;

begin

Fun := Sqrt(E-Sqr(cos(Pi*x)/sin(Pi*x)))

end;


function Simpson(Fun : FunType; A, B : RealType;

N : Integer) : RealType;

var

H, I : RealType;

k : Integer;

begin

H := ((B-A)/N)/2; I := Fun(A);

for k := 1 to 2*N-1 do if Odd(k) then

I := I + 4*Fun(A+k*H) else I := I + 2*Fun(A+k*H);

Simpson := (I + Fun(B))*H/3

end { Simpson };


begin

m := 9.11e-31 ;

a0 := 0.53e-10 ;

h := 1.054e-34 ;

v0 := 37.58e-19 ;

en := 20 * v0;

st := 0.25e-20;

writeln(#10#10#10);

repeat

en := en+st; E := En/v0;

t1 := (ArcTan(Sqrt(E))+1.570795)/Pi;

t2 := (ArcTan(-Sqrt(E))+1.570798)/Pi;

n2 := Simpson(Fun, t2, t1, 40)*Sqrt(2*m*v0)*a0/(Pi*h)-0.5;

write(#13, en, ' ', n2:10:6);

if abs(round(n2)-n2) < 0.0001 then

begin

writeln(#13, en, ' ', n2:10:6);

en := en+1e-16; st := 0.2e-19

end

until false

end .


Задача 16. Программа для определения физической, эмоциональной и интеллектуальной активности человека. Вводится дата рождения и текущая дата. Программа
вычисляет и выводит на экран общее количество дней, часов, минут и секунд,
разделяющих обе даты, а также прогнозирует на месяц вперед даты,
соответствующие максимуму и минимуму биоритмов.

const

Size_of_Month: array [1..12] of byte =

(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

var

d0, d, m0, m, y0, y, dmin, dmax, days: integer;

{-------------------------------}

Procedure InputDates(var d0,m0,y0,d,m,y : integer);

var

correctly: Boolean;

{-------------------}

Procedure InpDate(text: string; var d,m,y: integer);

const

YMIN = 1800;

YMAX = 2000;

begin {InpDate}

repeat

Write(text);

ReadLn(d,m,y);

correctly := (y >= YMIN) and (Y <= YMAX) and (m >= 1)

and (m <= 12) and (d > 0);

if correctly then

if (m = 2) and (d = 29) and (y mod 4 = 0)

then

else

correctly := d <= Size_of_Month[m];

if not correctly then WriteLn('!')

until correctly

end; {InpDate}

{-------------------}

begin {InputDates}

repeat

InpDate( d0,m0,y0);

InpDate(d,m,y);

correctly := y > y0;

if not correctly and (y = y0) then

begin

correctly := m > m0;

if not correctly and (m = m0) then

correctly := d >= d0

end

until correctly

end; {InputDates}

{-------------------------------}

Procedure Get_numbers_of_days(d0,m0,y0,d,m,y: integer;

var days: integer);

{-------------------}

Procedure Variant2;

var

mm : integer;

begin {Variant2}

mm := m0;

while mm < m do

begin

days := days + Size_of_Month[mm];

if (mm = 2) and (y0 mod 4 = 0) then

inc(days);

inc(mm)

end

end; {Variant2}

{-------------------}

Procedure Variant3;

var

mm, yy : integer;

begin {Variant3}

mm := m0 + 1;

while mm <= 12 do begin

days := days+Size_of_Month[mm];

if (mm = 2) and (y0 mod 4 = 0) then

inc(days);

inc(mm)

end;

yy := y0 + 1;

while yy < y do

begin

days := days + 365;

if yy mod 4 = 0 then

inc(days);

inc(yy)

end;

mm := 1;

while mm < m do

begin

days := days + Size_of_Month[mm];

if (y mod 4 = 0) and (mm = 2) then

inc(days);

inc(mm)

end

end; {Variant3}

{-------------------}

begin {Get_numbers_of_days}

if (y = y0) and (m = m0) then

days := d - d0

else

begin

days := d + Size_of_Month[m0] - d0;

if (y0 mod 4 = 0) and (m0 = 2) then

inc(days); if y = y0 then

Variant2 else

Variant3

end

end; {Get_numbers_of_days}

{-------------------------------}

Procedure FindMaxMin(var dmin,dmax: integer;

days: integer);

const

TF = 2*3.1416/23.6884;

TE = 2*3.1416/28.4261; TI = 2*3.1416/33.1638; INTERVAL = 30;


var

min,

max,

x : real;

i : integer;

begin {FindMaxMin}

max := sin(days*TF)+sin(days*TE)+sin(days*TI);

min := max;

dmin := days;

dmax := days;

for i := 0 to INTERVAL do

begin

x := sin((days+i)*TF) + sin((days+i)*TE) +

sin((days+i)*TI);

if x > max then

begin

max := x;

dmax := days + i

end

else if x < min then

begin

min := x;

dmin := days + i

end

end;

end; {FindMaxMin}

{-------------------------------}

Procedure WriteDates(dmin,dmax,days : integer);

{-------------------}

Procedure WriteDate(text: string; dd: integer);

const

Names_of_Monthes : array [1..12] of string [3] =

('Январь','Февраль','март', ' апрель', ' май','июнь','июль',

'август', 'сентябрь','октябрь','ноябрь','декабрь');

var

d0,m0,y0,ddd : integer;

begin {WriteDate}

d0 := d;

m0 := m;

y0 := y;

ddd := days;

while ddd<>dd do

begin

inc(d0);

if (y0 mod 4 <> 0) and (d0 > Size_of_Month[m0]) or

(y0 mod 4=0) and (d0=30) then

begin

d0 := 1;

inc(m0);

if m0 = 13 then

begin

m0 := 1;

inc(y0)

end

end;

inc(ddd)

end;

WriteLn(text,d0,'-',Names_of_Monthes[m0],'-',y0)

end; {WriteDate}

{-------------------}

var

LongDays: LongInt;

begin {WriteDates}

LongDays := days;

WriteLn(LongDays,longDays*24, LongDays*24*60,LongDays*24*60*60,);

WriteDate(dmin);

WriteDate(dmax)

end; {WriteDates}

{-------------------------------}

begin

InputDates(d0,m0,y0,d,m,y);

Get_numbers_of_days(d0,m0,y0,d,m,y,days);

FindMaxMin(dmin,dmax,days);

WriteDates(dmin,dmax,days)

end.


Задача 17. Вычисление факториала рекурсивно с использованием указателей.

uses crt;

type facktor=double;

var

n:facktor;

function f(a:double):double;

begin

if a<0 then writeln('Error input')

else if a=0 then f:=1

else f:=a*f(a-1)

end;

begin

clrscr;

new(n);

readln(n);

writeln(n:1:0,' = ',f(n):1:0);

dispose(n);

readkey;

end.


3. Задания


По номеру варианта взять задание и составить программу.


Группа А (Подпрограммы)

1. Написать программу подсчета суммы М введенных с клавиатуры чисел.

2. Составить программу поиска большего из трёх чисел, с использованием процедуры поиска большего из двух чисел.

3. Напишите программу (процедуру), которая будет возвращать значение среднего арифметического двух своих параметров а и b.

4. Написать процедуру, меняющую значения двух переменных а и b местами.

5. Используя процедуру обмена значений двух переменных, упорядочьте по возрастанию переменные a, b, c.

6. Определить длину окружности L и площадь круга S. Радиус окружности задается с клавиатуры. Вычисление S и L оформить в виде процедуры.

7. Напишите подпрограмму, которая будет вычислять сумму правильных делителей заданного числа n. Правильными делителями числа n, являются все делители этого числа, за исключением его самого.

8. Найти сумму цифр числа.

9. Найти первую цифру числа.

10. Найти количество делителей числа.

11. Найти числа из промежутка от А до В, у которых больше всего делителей.

12. Найти сумму всех делителей числа.

13. Определить, является ли число совершенным, то есть равно ли оно сумме своих делителей, кроме самого себя.

14. Определить, является ли число простым.

15. Среди чисел из интервала от А до В найти все простые.

16. Составьте программу, проверяющую, является ли число палиндромом (например, число 12421 – палиндром).

17. Определить, является ли число автоморфным, то есть квадрат этого числа заканчивается этим же числом, например, числа 6 и 25, т.к. их квадратами являются числа 36 и 625.


Группа В (Подпрограммы)

1. Даны координаты вершин четырехугольника ABСВ. Найти сумму длин его диагоналей. Данные для ввода: A(0,1), B(2,5), C(4,8), D(2,0).

2. Найти сумму площадей треугольников ABC и МНР, заданных координатами вершин. Данные для ввода: А(0;1), В(3;1), С(4;2), М(6;7), Н(4;3), Р(3;8).

3. Найти сумму периметров треугольников ABC и МНР, заданных координатами вершин. Данные для ввода: А(0;1), В(3;1), С(4;2), М(6;7), Н(4;3), Р(3;8).

4. Вычислить 1!+2!+3!+......+N! . Вычисление факториала организовать как функцию fact(var r:integer):longint.

5. Составить программу поиска большего из трёх чисел, с использованием процедуры поиска большего из двух чисел.

6. Определить длину окружности С и площадь круга S, удаление L центра окружности от начала координат О. Координаты центра окружности равны X и Y, радиус R. Вычисление С, S, L оформить в виде процедуры.

7. Составьте функцию для определения значений n!, m!,(n-m)!

8. Напишите функцию CUBЕ, которая возвращает куб ее числового параметра.

9. Напишите функцию, которая возвращает объем сферы, радиус которой передается как параметр.

10. Для заданного х составить алгоритм вычисления значения выражения:



11. Для заданного х составить алгоритм вычисления значения выражения:



12. Напишите функцию CUBЕ, которая возвращает куб ее числового параметра.

13. Составьте программу для определения значений n!, m!,(n-m)!

14. Вычислить 1!+2!+3!+......+N! . Вычисление факториала организовать как функцию fact (var r:integer) : longint.

15. Напишите функцию, которая возвращает объем сферы, радиус которой передается как параметр.

16. По координатам вершин двух треугольников, определите их площадь и выведите на печать площадь максимального треугольника. Вычисление длины стороны, площади треугольника оформите в виде функций.

17. Дана отрезки AB, CD, EF, NM. Для каждой тройки отрезков, из которых можно построить треугольник, напечатайте площадь данного треугольника. Воспользуйтесь функциями определения возможности создания треугольника и вычисления площади.

18. С клавиатуры вводятся числа, до тех пор, пока не будет введено первое отрицательное число. Определите, сколько чисел из входного потока, равно сумме кубов своих цифр. При решении задачи используйте функцию, которая будет проверять, равно ли натуральное число сумме кубов своих цифр.

19. Напишите функцию логического типа, проверяющую, являются ли все цифры, входящие в натуральную запись, числа N различными.

20. Даны два натуральных числа. Проверить, является ли второе число перевертышем первого.

21. Составьте программу подсчета числа всех натуральных чисел, меньших М, квадрат суммы цифр которых равен Х.

22. Составьте программу подсчета числа всех натуральных чисел, меньших М и делящихся на каждую из своих цифр.

23. Составьте программу нахождения наименьшего натурального N-значного числа Х (X>=10), равного утроенному произведению своих цифр.

24. Дано натуральное число. Определите, сколько четных цифр используется в записи этого числа.

25. Дана последовательность К чисел. Определите, сколько чисел этой последовательности содержит в своей записи все цифры больше некоторого числа n введенного с клавиатуры.

26. Для последовательности вводимых с клавиатуры чисел, выведите суммы цифр каждого введенного числа. Признак конца ввода - число -1.


Группа С (Рекурсия)

1. Определите члены последовательность Фибоначчи.

2. Найдите максимальный элемент в одномерном массиве.

3. Составьте алгоритм вычисления суммы .

Указание. Обозначьте и используйте соотношения



4. Вычислите

5. Определите n–й член последовательности, в которой каждый следующий член равен сумме обратных величин всех предыдущих.

6. Определите n–й член последовательности, в которой каждый следующий член равен сумме квадратов всех предыдущих.

7. При положительном а решением уравнения х=х/2+а/(2х) служит х=. Рекуррентное соотношение

можно использовать для быстрого вычисления . Определите корень квадратный числа а.

8. Составьте алгоритм для вычисления , используя соотношение



9. Составьте алгоритм, вычисляющий n–й член последовательности, заданной соотношениями:



10. Составить рекурсивную программу ввода с клавиатуры последовательности чисел (окончание ввода - 0) и вывода ее на экран в обратном порядке.


4. Отчёт


Отчёт должен содержать:
  1. задание к работе;
  2. программу;
  3. результаты расчётов.

5. Зачёт



Для сдачи зачета приготовьте файлы и листинги с решенными задачами, а также будьте готовы ответить на теоретические вопросы, рассмотренные в этом методическом пособии.

6. Литература




  1. Новичков В.С. ПАСКАЛЬ – В.С. Новичков, Н.И. Парфилов, А.Н. Пылькин - М.: Высшая школа, 1990г.
  2. Савельев А.Я. ЯЗЫКИ ПРОГРАММИРОВАНИЯ (Паскаль, ПЛ/М). – М.: Высшая школа. 1987г.
  3. Боон К. ПАСКАЛЬ ДЛЯ ВСЕХ. – М.- Энергоатомиздат, 1988г.
  4. Павловская Т.А. ПАСКАЛЬ – Санкт-Петербург, Питер, 2003 г.
  5. Новиков Ф.А. Дискретная математика для программистов– Санкт-Петербург, Питер, 2003 г.



Для заметок


Для заметок


Для заметок


Для заметок