23. Перевод шестнадцатеричного числа в десятичное

var a : string;

 

function HEX_DEC(x:string):longint;

const digits:array [0..15] of char =

      ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');

var res,ves:longint; i,j:byte;

begin

   res:=0; ves:=1;

   for i:=length(x) downto 1 do begin

      j:=0; a[i]:=UpCase(a[i]);

      while (digits[j]<>x[i]) do inc(j);

      res:=res+ves*j;

      ves:=ves*16;

   end;

   HEX_DEC:=res;

end;

 

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

  readln( a );

  writeln( HEX_DEC(a) );

end.

24. Рекурсивные алгоритмы

Нахождение НОД и НОК двух чисел

var a,b:longint;

 

function NOD(x,y:longint):longint; { фукнция поиска наиб. общ. делителя }

begin

   if x<>0 then NOD:=NOD(y mod x,x) else NOD:=y;

end;

 

function NOK(x,y:longint):longint; { фукнция поиска наим. общ. кратного }

begin

   NOK:=( x div NOD(x,y) ) * y;

end;

 

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

    readln(a,b);

    writeln( 'НОД этих чисел = ', NOD(a,b) );

    writeln( 'НОК этих чисел = ', NOK(a,b) );

end.

Вычисление факториала

var n:integer;

 

function f(x:integer):longint;

begin

   if x = 1 then f := 1 else f := x * f(x-1);

end;

 

begin

     writeln('введите N (N=1..13)');

     readln(n);

     writeln('N!=',f(n));

end.

Генерация перестановок

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;

 

begin

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

      generate( 1,n );

end.

Быстрая сортировка

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

{                           БЫСТРАЯ СОРТИРОВКА.                            }

{       Устанавливаем I=1 и J=N. Сравниваем элементы  A[I]  и  A[J].  Если }

{  A[I]<=A[J], то уменьшаем J на 1 и проводим  следующее сравнение элемен- }

{  тов A[I] с A[J]. Последовательное уменьшение индекса J и сравнение ука- }

{  занных элементов  A[I] с A[J] продолжаем  до тех пор,  пока выполняется }

{  условие A[I] <= A[J]. Как только A[I] станет больше A[J], меняем места- }

{  ми элементы A[I] с A[J], увеличиваем индекс I на 1 и продолжаем сравне- }

{  ние  элементов  A[I] с A[J]. Последовательное увеличение  индекса  I  и }

{  сравнение (элементов A[I] с A[J]) продолжаем до тех  пор, пока выполня- }

{  ется условие A[I] <= A[J].  Как  только A[I] станет больше A[J],  опять }

{  меняем местами элементы A[I] с A[J], снова начинаем уменьшать J.        }

{       Чередуя уменьшение J и увеличение I, сравнение и необходимые обме- }

{  ны, приходим к некоторому элементу, называемому  пороговым или главным, }

{  характеризующим условие  I=J. В результате элементы массива оказываются }

{  разделенными на две части так, что все элементы слева - меньше главного }

{  элемента, а все элементы справа - больше главного элемента.             }

{       К этим  массивам применяем рассмотренный алгоритм, получаем четыре }

{  части и т.д. Процесс закончим, когда массив A станет полностью отсорти- }

{  рованным.                                                               }

{       При программировании алгоритма "Быстрой сортировки" удобно исполь- }

{  зовать рекурентные вызовы процедуры сортировки (рекурсию).              }

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

 

var a:array[1..10] of integer; { массив элементов }

    n:integer;

 

procedure QuickSort( L, R : Integer ); { Быстрая сортировка массива A[] }

var i,j,x,y : integer;

begin

  i := l; j := r;

  x := a[(l+r) div 2];

  repeat

    while (A[i]<x) do inc(i);

    while (x<A[j]) do dec(j);

    if ( i<=j ) then

    begin

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

      inc(i); dec(j);

    end;

  until (i>j);

  if (l<j) then QuickSort(l,j);

  if (i<r) then QuickSort(i,r);

end;

 

begin

     writeln('введите 10 элементов массива:');

     for n:=1 to 10 do readln(a[n]);

     QuickSort( 1, 10 ); { на входе: левая и правая граница сортировки }

     writeln('после сортировки:');

     for n:=1 to 10 do writeln(a[n]);

end.