Task: Sorting algorithms_Patience sort






PHP: <?php
class PilesHeap extends SplMinHeap {
    public function compare($pile1, $pile2) {
        return parent::compare($pile1->top(), $pile2->top());
    }
}

function patience_sort(&$n) {
    $piles = array();

    foreach ($n as $x) {

        $low = 0; $high = count($piles)-1;
        while ($low <= $high) {
            $mid = (int)(($low + $high) / 2);
            if ($piles[$mid]->top() >= $x)
                $high = $mid - 1;
            else
                $low = $mid + 1;
        }
        $i = $low;
        if ($i == count($piles))
            $piles[] = new SplStack();
        $piles[$i]->push($x);
    }

    $heap = new PilesHeap();
    foreach ($piles as $pile)
        $heap->insert($pile);
    for ($c = 0; $c < count($n); $c++) {
        $smallPile = $heap->extract();
        $n[$c] = $smallPile->pop();
        if (!$smallPile->isEmpty())
        $heap->insert($smallPile);
    }
    assert($heap->isEmpty());
}

$a = array(4, 65, 2, -31, 0, 99, 83, 782, 1);
patience_sort($a);
print_r($a);
?>






Ada: 

with Ada.Text_IO;

procedure patience_sort_task is
  use Ada.Text_IO;

  function next_power_of_two
   (n : in Natural)
    return Positive is
    
    pow2 : Positive;
  begin
    pow2 := 1;
    while pow2 < n loop
      pow2 := pow2 + pow2;
    end loop;
    return pow2;
  end next_power_of_two;

  generic
    type t is private;
    type t_array is array (Integer range <>) of t;
    type sorted_t_indices is array (Integer range <>) of Integer;
  procedure patience_sort
   (less : access function
     (x, y : t)
      return Boolean;
    ifirst : in Integer;
    ilast : in Integer;
    arr : in t_array;
    sorted : out sorted_t_indices);

  procedure patience_sort
   (less : access function
     (x, y : t)
      return Boolean;
    ifirst : in Integer;
    ilast : in Integer;
    arr : in t_array;
    sorted : out sorted_t_indices) is

    num_piles : Integer;
    piles : array (1 .. ilast - ifirst + 1) of Integer :=
     (others => 0);
    links : array (1 .. ilast - ifirst + 1) of Integer :=
     (others => 0);

    function find_pile
     (q : in Positive)
      return Positive is
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      index : Positive;
      i, j, k : Natural;
    begin
      if num_piles = 0 then
        index := 1;
      else
        j := 0;
        k := num_piles - 1;
        while j /= k loop
          i := (j + k) / 2;
          if less
            (arr (piles (j + 1) + ifirst - 1), arr (q + ifirst - 1))
          then
            j := i + 1;
          else
            k := i;
          end if;
        end loop;
        if j = num_piles - 1 then
          if less
            (arr (piles (j + 1) + ifirst - 1), arr (q + ifirst - 1))
          then
            
            j := j + 1;
          end if;
        end if;
        index := j + 1;
      end if;
      return index;
    end find_pile;

    procedure deal is
      i : Positive;
    begin
      for q in links'range loop
        i := find_pile (q);
        links (q) := piles (i);
        piles (i) := q;
        num_piles := Integer'max (num_piles, i);
      end loop;
    end deal;

    procedure k_way_merge is
      
      
      
      
      
      
      
      
      
      
      
      
      
      total_external_nodes : Positive;
      total_nodes : Positive;
    begin

      total_external_nodes := next_power_of_two (num_piles);
      total_nodes := (2 * total_external_nodes) - 1;

      declare

        
        
        
        
        winners : array (1 .. total_nodes, 1 .. 2) of Integer :=
         (others => (0, 0));

        function find_opponent
         (i : Natural)
          return Natural is
        begin
          return (if i rem 2 = 0 then i + 1 else i - 1);
        end find_opponent;

        function play_game
         (i : Positive)
          return Positive is
          j, iwinner : Positive;
        begin
          j := find_opponent (i);
          if winners (i, 1) = 0 then
            iwinner := j;
          elsif winners (j, 1) = 0 then
            iwinner := i;
          elsif less
            (arr (winners (j, 1) + ifirst - 1),
             arr (winners (i, 1) + ifirst - 1))
          then
            iwinner := j;
          else
            iwinner := i;
          end if;
          return iwinner;
        end play_game;

        procedure replay_games
         (i : Positive) is
          j, iwinner : Positive;
        begin
          j := i;
          while j /= 1 loop
            iwinner := play_game (j);
            j := j / 2;
            winners (j, 1) := winners (iwinner, 1);
            winners (j, 2) := winners (iwinner, 2);
          end loop;
        end replay_games;

        procedure build_tree is
          istart, i, iwinner : Positive;
        begin
          for i in 1 .. total_external_nodes loop
            
            winners (total_external_nodes - 1 + i, 2) := i;
          end loop;

          for i in 1 .. num_piles loop
            
            winners (total_external_nodes + i - 1, 1) := piles (i);
          end loop;

          for i in 1 .. num_piles loop
            
            piles (i) := links (piles (i));
          end loop;

          istart := total_external_nodes;
          while istart /= 1 loop
            i := istart;
            while i <= (2 * istart) - 1 loop
              iwinner := play_game (i);
              winners (i / 2, 1) := winners (iwinner, 1);
              winners (i / 2, 2) := winners (iwinner, 2);
              i := i + 2;
            end loop;
            istart := istart / 2;
          end loop;
        end build_tree;

        isorted, i, next : Integer;

      begin
        build_tree;
        isorted := 0;
        while winners (1, 1) /= 0 loop
          sorted (sorted'first + isorted) :=
           winners (1, 1) + ifirst - 1;
          isorted := isorted + 1;
          i := winners (1, 2);
          next := piles (i);     
          if next /= 0 then
            piles (i) := links (next); 
          end if;
          i := (total_nodes / 2) + i;
          winners (i, 1) := next;
          replay_games (i);
        end loop;
      end;

    end k_way_merge;

  begin
    deal;
    k_way_merge;
  end patience_sort;

begin

  

  declare

    type integer_array is array (Integer range <>) of Integer;
    procedure integer_patience_sort is new patience_sort
     (Integer, integer_array, integer_array);

    subtype int25_array is integer_array (1 .. 25);

    example_numbers : constant int25_array :=
     (22, 15, 98, 82, 22, 4, 58, 70, 80, 38, 49, 48, 46, 54, 93, 8,
      54, 2, 72, 84, 86, 76, 53, 37, 90);

    sorted_numbers : int25_array := (others => 0);

    function less
     (x, y : Integer)
      return Boolean is
    begin
      return (x < y);
    end less;

  begin
    integer_patience_sort
     (less'access, example_numbers'first, example_numbers'last,
      example_numbers, sorted_numbers);

    Put ("unsorted  ");
    for i of example_numbers loop
      Put (Integer'image (i));
    end loop;
    Put_Line ("");
    Put ("sorted    ");
    for i of sorted_numbers loop
      Put (Integer'image (example_numbers (i)));
    end loop;
    Put_Line ("");
  end;

end patience_sort_task;