Javascript must be enabled in your browser to use this page.
Please enable Javascript under your Tools menu in your browser.
Once javascript is enabled Click here to go back to �нтеллектуальная Кобринщина

Процедуры

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

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.