hscool ONLINE: Heap Sutra

    


(* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * )
( Heap.PAS      hscool sutra                                      Pascal )
(                                                                        )
( Heap sorting -- timing is _always_ .LE. N*log N                        )
( * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)

Program Heap(Input,Output);
Const
  N_MAX=99;

Type
  TElement=Integer;

Var
  iNum,i: Integer;
  elTemp: TElement;
     elA: Array[1..N_MAX] of TElement; { Source array, tree and result }


Procedure FixTree(iFrom,iTo: Integer);
Var
  elTop,elLeft,elRight: TElement;
	    iFromTwice: Integer;
	       flgDone: Boolean;
Begin
  elTop:=elA[iFrom];

  Repeat
    iFromTwice:=iFrom*2;
    flgDone:=iFromTwice>iTo;
    If not flgDone then
      Begin
	elLeft:=elA[iFromTwice];
	If iFromTwice=iTo then elRight:=elLeft
			  else elRight:=elA[iFromTwice+1];

	If (elRight>elTop) and (elRight>elLeft) then
	  Begin
	    elA[iFrom]:=elRight;  iFrom:=iFromTwice+1
	  end
	else If elLeft>elTop then
	  Begin
	    elA[iFrom]:=elLeft;   iFrom:=iFromTwice
	  end
	else flgDone:=true

      end
  until flgDone;

  elA[iFrom]:=elTop
end;


Begin
  WriteLn;
  WriteLn('Heap.  Array sorting by tree building.');

  { Read unsorted array   }
  iNum:=0;
  Repeat
    iNum:=iNum+1;  Read(elA[iNum])
  until (iNum=N_MAX) or eof;
  WriteLn;

  { Build a sorting tree  }
  For i:=iNum div 2 downto 1 do FixTree(i,iNum);

  { Convert tree to array }
  For i:=iNum downto 2 do Begin elTemp:=elA[1];
				elA[1]:=elA[i];
				elA[i]:=elTemp;
				FixTree(1,i-1)
			  end;

  { Display the result    }
  WriteLn('  * Sorted array *');
  For i:=1 to iNum-1 do Write(elA[i]:1,' ');
  WriteLn(elA[iNum]:1);
  WriteLn('P.S. Thank you for using our software.')
end.

    

    

• Back to: Sutras, hscool ONLINE, hscool, REMOTE

: hscool@netclub.ru