program H;

 uses WinCrt, SysUtils;

   const
     min = 10;
     max = 13;
     maxHeap = 1 shl max;

   type
     heap = array [1..maxHeap] of integer;
     heapBase = ^heap;

   var
     currentSize, heapSize: integer;
     A: heapBase;

   procedure SwapInts (var a, b: integer);
   var
     t: integer;
   begin
     t := a;
     a := b;
     b := t
   end;

   procedure InitHeap (size: integer);
   var
     i: integer;
   begin
     heapSize := size;
     currentSize := size;
     Randomize;
     for i := 1 to size do
       A^[i] := Random(size) + 1;
   end;

   procedure Heapify (i: integer);
   var
     left, right, largest: integer;
   begin
     largest := i;
     left := 2 * i;
     right := left + 1;
     if left <= heapSize then
       if A^[left] > A^[i] then
         largest := left;
     if right <= heapSize then
       if A^[right] > A^[largest] then
         largest := right;
     if largest <> i then
       begin
         SwapInts (A^[largest], A^[i]);
         Heapify (largest)
       end
   end;

   procedure BuildHeap;
   var
     i: integer;
   begin
     for i := heapSize div 2 downto 1 do
       Heapify (i)
   end;

   procedure HeapSort;
   var
     i: integer;
   begin
     BuildHeap;
     for i := currentSize downto 2 do
       begin
         SwapInts (A^[i], A^[1]);
         dec (heapSize);
         Heapify (1)
       end
   end;

 type
   TAvgTimes = array [min..max] of TDateTime;
 var
   sTime, eTime, tTime: TDateTime;
   i, idx, size: integer;
   avgTimes: TAvgTimes;


 begin
   tTime := 0;
   i := min;
   size := 1 shl min;
   new (A);
   while i <= max do
     begin
       for idx := 1 to 10 do
         begin
           InitHeap (size);
           sTime := Time;
           HeapSort;
           eTime := Time;
           tTime := tTime + (eTime - sTime)
         end;
       avgTimes[i] := tTime / 10.0;
       inc (i);
       size := size shl 1;
     end;
 end.