Процедуры

Рейтинг:   / 0
ПлохоОтлично 

Процедуры

Нахождение наибольшего числа из четырёх.

Program largest;

Uses Crt;

var a, b, c, d, mab, mcd, max : Real;

Procedure max2(x, у : Real; var z : Real);

Begin

    if x >= у then z := x else z := y;   {z = max(x ,y)}

end; {max2}

Begin {Основная программа}

CIrScr;

write('Введите четыре числа ');

readln(a, b, c, d);

max2(a, b, mab); {Вызов процедуры}

max2(с, d, mcd); {Процедура работает именно в момент вызова}

max2(mab, mcd, max);

writeln ('Большее из ', а:10:5, b:19:5, с:10:5, d:10:5, ‘ = ‘, max:10:5);

readln;

End.

 

Определение принадлежности хотя бы одной точки заданного множества точек на плоскости внутренней области круга с центром в точке(a, b) и радиусом R.

Program SetOfPoints;

Uses Crt;

Type Mas = Array [1..20] of Real;

Var     X, Y: Mas;      {массивы координат точек}

            i, NPoints : Integer;   {NPoints - количество точек}

            a, b, Radius: Real;      {координаты центра и радиус}

            Flag: Boolean;

Procedure Input; {описание процедуры ввода данных}

Begin

    CIrScr;

write('Введите координаты центра круга:'); readln(a, b);

write(‘Введите радиус круга:'); readln(Radius);

write('Введите количество точек:'); readln(NPoints);         

 For i := 1 to NPoints do

        begin

            writeln(i: 4, '-я точка');         

            write('X ='); readln(X[i]);

        write(‘Y = '); readln(Y[i]);                                     

    end;  

 writeln

                        End;     {of Input}

Procedure Inside(var Flag : Boolean); {описание процедуры проверки}

Begin                                                    {принадлежности точек области}

Flag := FALSE; i:=l;

While (i<=NPoints) and not Flag do

     If Sqr(X[i]-a)+Sqr(Y[i]-b)<Sqr(Radius) then Flag := TRUE else i:=i+l;

End;     {of Inside}

Procedure Output ( Flag: Boolean);    {описание процедуры}

 Begin    {вывода результатов}

Write ('O т в е т: в множестве точек');

If  flag then writeln('coдepжaтcя') else writeln('He содержатся');

Writeln (' точки, принадлежащие заданной области.');

readln;

End;    {of Output}

Begin

Input;                 {вызов процедуры ввода данных}

Inside(Flag);      {вызов процедуры проверки принадлежности}

Output(Flag);     {вызов процедуры вывода результатов}

End.

 

Определение наличия среди элементов главной диагонали заданной целочисленной матрицы А(N, N) хотя бы одного положительного нечётного элемента.

Program Diagonal;                                     

Uses Crt;                                             

Type Mas = Array [1.. 10, 1.. 10] of Integer;  

var   A: Mas;

N, i, j: Integer;

Flag: Boolean;

Procedure InputOutput(Var A : Mas); {описание процедуры ввода- вывода исходных данных}

    Begin                         

    CIrScr;

write('Количество строк и столбцов — ');  readln(N);

For i:= 1 to N do                       

      For j := 1 to N do

           begin

              write('A[', i, ‘, ‘, j, '] =  ');

              readln(A[i, j]);

           end;

writeln;

writeln('Заданная матрица ;');  

For i := 1 to N do

    begin   

        For j := 1 to N do Write(A[i, j] : 5);

    writeln;

end;

                   writeln;

End; { of InputOutput }

Procedure Solution(Var A : Mas);   {описание процедуры поиска решения}

   var Flag : Boolean;

   Begin

Flag:=FALSE;   i:=l;

While (i<=N) and not Flag do

If (A[i, i]>0) and (A[i, i] mod 2 = 1) then Flag:=TRUE else i:=i+l;

writeln(‘ Ответ :’);

write('Cpeди элементов главной диагонали ');

If Flag then writeln('ecть нечетные положительные.') else writeln('нет нечетных положительных.');

readln;

   End;   { Solution}

Begin

InputOutput(A); {вызов процедуры ввода-вывода данных }

Solution(A);   {вызов процедуры поиска решения задачи}

End.

 

Решение биквадратного уравнения ax4+bx2+c=0.

Program bikvur;

Uses Crt;                                            

var

а, b, с : Real;

{Глобальные переменные}

yl, y2 : Real;

flag : Boolean;

Procedure kvur(var yl,y2 : Real; var flag : Boolean);

var d : Real;

{Дискриминант локальная переменная}

begin 

d := sqr(b) - 4 * a * с; {Глобальные переменные a, b и с известны процедуре}

if  d >= 0  then

       begin

     flag := true;                       

     yl := (-b + sqrt(d)) / 2 / a; 

     y2 := (-b - sqrt(d)) /2/a;    

       end                               

else  flag := false;                 

end; {kvur}

Begin

     CIrScr;

    write('Введите значения коэффициентов a, b, с:’);

 readln(a, b, c);

 kvur(yl, y2, flag);

 if  flag  then

    begin

          if  yl >= 0  then  writeln(‘xl= ', sqrt(yl):10:5, ' x2=', -sqrt(yl):18:5)

             else  writeln('Вещественных корней xl и х2 нет');

          if  y2 >= 0  then  writeln(‘x3= ', sqrt(y2):10:5, ' x4=', -sqrt(y2):10:5)

             else writeln('Вещественных корней хЗ и х4 нет');

   end

     else writeln('Вещественных корней нет');

     readln;

End.

 

Задача о Ханойских башнях. Формулировка задачи:

Дано три стержня. На первом стержне размещены п дисков разных диаметров в порядке их уменьшения, так что сверху находится диск с наименьшим диаметром.

Требуется переложить диски на третий стержень, соблюдая следующие правила:

• можно перемещать лишь по одному диску;

• больший диск не разрешается класть на меньший;

• откладывать диски в сторону не разрешается.

Program Hanoy;

Uses Crt;                                            

var n: Integer;

Procedure Solve(h, а, b, с: Integer); {h - количество дисков; а - номер стержня, с которого осуществляется перенос; b - номер стержня, на который осуществляется перенос; с - номер свободного стержня}

Begin

     If h>0 then

         Begin

              Solve(h-1, a, c, b);

              writeln(' Диск ' , h, ' переносится со стержня ' , a, ' на стержень ' , b) ;

              Solve(h-1, с, b, а);

         End;

End; { Solve }

Begin

     CIrScr;

write(' Введите количество дисков n=') ;

readln(n) ;

Solve(n, 1, 3, 2);

readln;

End.

 

Рекурсивные алгоритмы: генерация перестановок.

Program bikvur;

Uses Crt;                                            

const n = 3; { количество элементов в перестановке}

var   a:array[1..n] of integer;

      index : integer;

procedure generate (l,r:integer);

var i, v:integer;

begin

      if (l=r) then begin

        for i:=1 to n do write(a[i],' ');

        writeln;

      end else begin

        for i := l to r do begin

           v:=a[l]; a[l]:=a[i]; a[i]:=v; {обмен a[i],a[j]}

           generate(l+1,r);              {вызов новой генерации}

           v:=a[l]; a[l]:=a[i]; a[i]:=v; {обмен a[i],a[j]}

        end;

      end;

end;

 

Вegin

     CIrScr;

      for index := 1 to N do A[index]:=index;

      generate( 1,n );

      readln;

Еnd.

 

СОРТИРОВКА ХОАРА

Эту сортировку также называют быстрой сортировкой. Метод был разработан в 1962 году профессором Оксфордского университета К. Хоаром. Это прекрасный пример использования рекурсии. Рассмотрим принцип работы алгоритма при упорядочении массива A из N элементов по возрастанию.

Значение какого-нибудь элемента, обычно центрального, записывается в переменную X. Просматриваются элементы массива. При движении слева-направо ищем элемент больше или равный X. А при движении справа-налево ищем элемент меньше или равный X. Найденные элементы меняются местами и продолжается встречный поиск.

После этого массив окажется разделенным на две части. В первой находятся элементы меньше либо равные X, а справа - больше либо равные X. Можно заменить исходную задачу о сортировке массива A на две подзадачи о сортировке полученных частей массива.

Вычислительная сложность одного вызова данного рекурсивного алгоритма пропорциональна количеству элементов сортируемого фрагмента массива. В лучшем случае деление на части производится пополам, поэтому вычислительная сложность всего алгоритма быстрой сортировки составляет величину порядка N*LogN (логарифм по основанию 2). Вычислительная сложность в среднем того же порядка.

ПРИМЕР: Быстрая сортировка по возрастанию массива A из N целых чисел.

Рrogram Quick_Sort;

var    A: array [1..100] of integer;   

N, i : integer;

{В процедуру передаются левая и правая границы сортируемого фрагмента}

procedure QSort(L,R:integer);

Uses Crt;                                            

var    X, y, i, j: integer;

Вegin

    CIrScr;

X:=A[(L+R) div 2];

i:=L; j:=R;

while i<=j do

begin

while A[i]<X do i:=i+1;

while A[j]>X do j:=j-1;

if i<=j then

begin

y:=A[i]; A[i]:=A[j]; A[j]:=y;

i:=i+1; j:=j-1;

end;

end;

if L<j then QSort(L,j);

if i<R then QSort(i,R);

end;

begin

write('количество элементов массива ');

read(N);

for i:=1 to n do read(A[i]);

QSort(1,n); {упорядочить элементы с первого до n-го}

for i:=1 to n do write(A[i],' '); {упорядоченный массив}

readln;

Еnd.

Критические заметки

Здесь представлены комментарии некоторых спортивных состязаний, а также оценка вопросов, сыгранных в телевизионных клубах "Что? Где? Когда?" России и Беларуси.  Особое внимание будет уделено игровым видам спорта (футбол, хоккей). Найдут для себя полезное и любители шахмат и шахматной композиции. 

Читать

Лучшие книги

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

Перейти к книгам