#defane MAX_STEPS 50
char a[3][3]; //третий ряд забит нулями
char steps[MAX_STEPS][7];
char rez[3][3];

int abs(int numb)   // просто извращаюсь...
{
   if(numb<0)
     return numb*(-1);
   else
    return numb;
}
void step(int step,int pusto_x,int pusto_y)
{                 // step -текущая глубина рекурси
                  // pusto_x - координата пустого места
                 // pusto_y - координата пустого места
   int i,j,k;
   if(steps<MAX_STEPS-1)
   {
      for(i=0;i<2;i++)
         for(j=0;j<3;j++)
           if(i!=pusto_y || j!=pusto_x) // проверяю чтоб счетчики
                                                       // не совпадали с пустой клеткой
             if(i==pusto_y || j==pusto_x)     // проверяю на условие движения
              if(abs(pusto_x-j)==1)               // через клетку не прыгать              
              {
                 // могем менять местами
                 a[pusto_y][pusto_x]=a[i][j];
                 a[i][j]=' ';                              // передвигаю чегото
                 for(k=0,fl=0;k<MAX_STEPS && k<step && fl==0;k++)
                 if(strcmp(a,rez)==0)            // проверяю не встречалось ли
                    fl=1;                                 // данное расположение
                 if(strcmp(a,rez)==0)           // проверяю не получили ли мы то что 
                 {                                        // нужно достичь
                     // вываливай весь steps
                     // хоть в файл хоть на печать 
                     fl=1;
                 }
                 if(fl==0)
                 {
                   strcpy((char *)&steps[step][0],a); // записываю ход
                   step(step+1,j,i);                       // уход в глубь
                   // стирать ход не нужно поскольку ПЕРЕЗАПИСЬ
                 }
                 a[i][j]=a[pusto_y][pusto_x]; // востанавливаю предыдущее
                 a[pusto_y][pusto_x]=' ';       // состояние
              } 
  }
   else
     return ; // возврат если перебор по глубине
}

void main()
{
  int i,j;
  // подготавливаем массивы
  for(i=0;i<MAX_STEPS;i++)
    strcpy((char *)&steps[i][0],"");
  a[0][0]='t'; // исходный массив
  a[0][1]='c';
  a[0][2]='s';
  a[1][0]='c';
  a[1][1]=' ';
  a[1][2]='a';
  a[2][0]=0;  // забиваем нулями для того чтобы
  a[2][1]=0;  // сформировалась идентифицирующая строка
  a[2][2]=0;
   rez[0][0]='t'; // массив который нужно получить
   rez[0][1]='c';
   rez[0][2]='a';
   rez[1][0]='c';
   rez[1][1]=' ';
   rez[1][2]='s';
   rez[2][0]=0;  // забиваем нулями с целью как и
   rez[2][1]=0;  // для массива a
   rez[2][2]=0;
  steps(0,1,1);
}

{-$S}
Program Piramida;

Uses CRT;

Const
     max = 100;

Type myArray = array[0..max] of Integer;

Var dimension, i : Integer;
    arr, sortArray : myArray;
{***********************************\
                                      \**************************************}
Procedure Sift( Var arr : myArray; L, R : Integer );
Var i, j : Integer;
    item : Integer;
Begin
     i := L;
     j := 2*L;
     item := arr[L];
     If ( j < R ) And ( arr[j] < arr[j + 1] ) Then Begin
                                                        j := j + 1;
                                                   End;
     While ( j <= R ) And ( item < arr[j] ) do
      Begin
           arr[i] := arr[j];
           i := j;
           j := 2*j;
           If ( j < R ) And ( arr[j] < arr[j + 1] ) Then Begin
                                                              j := j + 1;
                                                         End;
      End;
     arr[i] := item;
End;
{***********************************\
                                      \**************************************}
Function Anti_Overflow( mas : myArray; rozmir : Integer) : Boolean;
Var
   i , j: Integer;
   max : Integer;
Begin
     For j := 0 To rozmir Do
     Begin
          max := mas[j];
          For i := 1 To rozmir+1 Do
          Begin
               If max > mas[i] Then Anti_Overflow := False
          End;
     End;
End;
{***********************************\
                                      \**************************************}
Procedure HeapSort( arr : myArray; size : Integer );
Var i, L, R : Integer;
    item : Integer;
Begin
     L := ( size div 2 );
     R := size - 1 ;
     While L > 0 do
     Begin
           L := L - 1;
           Sift( arr, L, R );
     End;
         While R > 0 do
         Begin
              item := arr[0];
              arr[0] := arr[R];
              arr[R] := item;
              R := R - 1;
              Sift( arr, L, R );
         End;
     If Anti_Overflow(arr,size) = False Then HeapSort (arr,size)
     Else Begin
               Write('Sorting array: ');
               For i := 0 To size-1 do
               Begin
                    Write( Arr[i] );
                    Write(' ');
               End;
          End;
End;
{***********************************\
                                      \**************************************}
Begin
     ClrScr;
     Write('Rozmirnist Masivu : ');
          ReadLn( dimension );
     Write('Enter ');Write( dimension );Write(' elements: ');
     Randomize;
     For i := 0 To dimension Do Begin
                                     arr[i] := Random(50);
                                     WriteLn(arr[i]);
                                End;
                                HeapSort( arr , dimension );
     WriteLn;
     WriteLn('Press "Enter" to continue...');
     ReadKey;
End.

function HeapSort( arr : myArray; size : Integer ):myArray;
Var i, L, R : Integer;
    item : Integer;
Begin
     L := ( size div 2 );
     R := size - 1 ;
     While L > 0 do
     Begin
           L := L - 1;
           Sift( arr, L, R );
     End;
         While R > 0 do
         Begin
              item := arr[0];
              arr[0] := arr[R];
              arr[R] := item;
              R := R - 1;
              Sift( arr, L, R );
         End;
    heapsort:=arr;
End;

 ClrScr;
     Write('Vvedite rozmirnist'' massiva : ');
     ReadLn( dimension );
     writeln;
     writeln('************************************************');
     Write('Ishodnii massiv iz ');Write( dimension );Write(' elementov: ');
     Randomize;
     For i := 0 To dimension-1 Do
      Begin
       arr[i] := Random(50);
       Write(arr[i]);write(' ');
      End;
      writeln;
     writeln('************************************************');
     SortArray:=HeapSort( arr , dimension );
     write('Otsortirovanii massiv : ');
       for i := 0 to dimension-1 do begin
         write( sortArray[i] ); write(' '); end;
     writeln;
     writeln('************************************************');
     writeln;
     WriteLn('Press "Enter" to continue...');
     Readln; 
     Readln;