Task: Sorting algorithms_Patience sort

C: #include<stdlib.h>
#include<stdio.h>

int* patienceSort(int* arr,int size){
	int decks[size][size],i,j,min,pickedRow;
	
	int *count = (int*)calloc(sizeof(int),size),*sortedArr = (int*)malloc(size*sizeof(int));
	
	for(i=0;i<size;i++){
		for(j=0;j<size;j++){
			if(count[j]==0 || (count[j]>0 && decks[j][count[j]-1]>=arr[i])){
				decks[j][count[j]] = arr[i];
				count[j]++;
				break;
			}
		}
	}
	
	min = decks[0][count[0]-1];
	pickedRow = 0;
	
	for(i=0;i<size;i++){
		for(j=0;j<size;j++){
			if(count[j]>0 && decks[j][count[j]-1]<min){
				min = decks[j][count[j]-1];
				pickedRow = j;
			}
		}
		sortedArr[i] = min;
		count[pickedRow]--;
		
		for(j=0;j<size;j++)
			if(count[j]>0){
				min = decks[j][count[j]-1];
				pickedRow = j;
				break;
			}
	}
	
	free(count);
	free(decks);
	
	return sortedArr;
}

int main(int argC,char* argV[])
{
	int *arr, *sortedArr, i;
	
	if(argC==0)
		printf("Usage : %s <integers to be sorted separated by space>");
	else{
		arr = (int*)malloc((argC-1)*sizeof(int));
		
		for(i=1;i<=argC;i++)
			arr[i-1] = atoi(argV[i]);
		
		sortedArr = patienceSort(arr,argC-1);
		
		for(i=0;i<argC-1;i++)
			printf("%d ",sortedArr[i]);
	}
	
	return 0;
}










Fortran: module rosetta_code_patience_sort
  implicit none
  private

  public :: patience_sort

  interface
     function binary_predicate (x, y) result (truth)
       class(*), intent(in) :: x, y
       logical :: truth
     end function binary_predicate
  end interface

contains

  function patience_sort (less, ifirst, ilast, array) result (sorted)
    procedure(binary_predicate) :: less
    integer, intent(in) :: ifirst, ilast
    class(*), intent(in) :: array(*)
    integer, allocatable :: sorted(:)

    
    
    

    integer :: num_piles
    integer, allocatable :: piles(:)
    integer, allocatable :: links(:)

    
    
    
    
    
    allocate (piles(1 : ilast - ifirst + 1), source = 0)
    allocate (links(1 : ilast - ifirst + 1), source = 0)

    num_piles = 0
    call deal (less, ifirst, ilast, array, num_piles, piles, links)

    allocate (sorted(1 : ilast - ifirst + 1))

    call k_way_merge (less, ifirst, ilast, array, num_piles, piles, &
         &            links, sorted)

  end function patience_sort

  subroutine deal (less, ifirst, ilast, array, &
       &           num_piles, piles, links)
    procedure(binary_predicate) :: less
    integer, intent(in) :: ifirst, ilast
    class(*), intent(in) :: array(*)
    integer, intent(inout) :: num_piles
    integer, intent(inout) :: piles(1 : ilast - ifirst + 1)
    integer, intent(inout) :: links(1 : ilast - ifirst + 1)

    integer :: i, q

    do q = 1, ilast - ifirst + 1
       i = find_pile (q)
       links(q) = piles(i)
       piles(i) = q
       num_piles = max (num_piles, i)
    end do

  contains

    function find_pile (q) result (index)
      integer, value :: q
      integer :: index

      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      
      

      integer :: i, j, k

      if (num_piles == 0) then
         index = 1
      else
         j = 0
         k = num_piles - 1
         do while (j /= k)
            i = (j + k) / 2
            if (less (array(piles(j + 1) + ifirst - 1), &
                 &    array(q + ifirst - 1))) then
               j = i + 1
            else
               k = i
            end if
         end do
         if (j == num_piles - 1) then
            if (less (array(piles(j + 1) + ifirst - 1), &
                 &    array(q + ifirst - 1))) then
               
               j = j + 1
            end if
         end if
         index = j + 1
      end if
    end function find_pile

  end subroutine deal

  subroutine k_way_merge (less, ifirst, ilast, array, num_piles, &
       &                  piles, links, sorted)
    procedure(binary_predicate) :: less
    integer, intent(in) :: ifirst, ilast
    class(*), intent(in) :: array(*)
    integer, intent(in) :: num_piles
    integer, intent(inout) :: piles(1 : ilast - ifirst + 1)
    integer, intent(inout) :: links(1 : ilast - ifirst + 1)
    integer, intent(inout) :: sorted(1 : ilast - ifirst + 1)

    
    
    
    
    
    
    
    
    
    
    
    
    

    integer :: total_external_nodes
    integer :: total_nodes
    integer :: winners(1:2, 1:(2 * next_power_of_two (num_piles)) - 1)
    integer :: isorted, i, next

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

    call build_tree

    isorted = 0
    do while (winners(1, 1) /= 0)
       isorted = isorted + 1
       sorted(isorted) = winners(1, 1) + ifirst - 1
       i = winners(2, 1)
       next = piles(i)          
       if (next /= 0) piles(i) = links(next) 
       i = (total_nodes / 2) + i
       winners(1, i) = next
       call replay_games (i)
    end do

  contains

    subroutine build_tree
      integer :: i
      integer :: istart
      integer :: iwinner

      winners = 0

      do i = 1, total_external_nodes
         
         winners(2, total_external_nodes - 1 + i) = i
      end do

      
      winners(1, total_external_nodes :                  &
           &     total_external_nodes + num_piles - 1) = &
           &  piles(1:num_piles)

      do i = 1, num_piles
         
         piles(i) = links(piles(i))
      end do

      istart = total_external_nodes
      do while (istart /= 1)
         do i = istart, (2 * istart) - 1, 2
            iwinner = play_game (i)
            winners(:, i / 2) = winners(:, iwinner)
         end do
         istart = istart / 2
      end do
    end subroutine build_tree

    subroutine replay_games (i)
      integer, value :: i

      integer :: iwinner

      do while (i /= 1)
         iwinner = play_game (i)
         i = i / 2
         winners(:, i) = winners(:, iwinner)
      end do
    end subroutine replay_games

    function play_game (i) result (iwinner)
      integer, value :: i
      integer :: iwinner

      integer :: j

      j = ieor (i, 1)
      if (winners(1, i) == 0) then
         iwinner = j
      else if (winners(1, j) == 0) then
         iwinner = i
      else if (less (array(winners(1, j) + ifirst - 1), &
           &         array(winners(1, i) + ifirst - 1))) then
         iwinner = j
      else
         iwinner = i
      end if
    end function play_game

  end subroutine k_way_merge

  elemental function next_power_of_two (n) result (pow2)
    integer, value :: n
    integer :: pow2

    
    pow2 = 1
    do while (pow2 < n)
       pow2 = pow2 + pow2
    end do
  end function next_power_of_two

end module rosetta_code_patience_sort

program patience_sort_task
  use, non_intrinsic :: rosetta_code_patience_sort
  implicit none

  integer, parameter :: example_numbers(*) =               &
       & (/ 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 /)

  integer :: i
  integer, allocatable :: sorted(:)

  sorted = patience_sort (less, &
       &                  lbound (example_numbers, 1), &
       &                  ubound (example_numbers, 1), &
       &                  example_numbers)

  write (*, '("unsorted  ")', advance = 'no')
  do i = lbound (example_numbers, 1), ubound (example_numbers, 1)
     write (*, '(1X, I0)', advance = 'no') example_numbers(i)
  end do
  write (*, '()')
  write (*, '("sorted    ")', advance = 'no')
  do i = lbound (sorted, 1), ubound (sorted, 1)
     write (*, '(1X, I0)', advance = 'no') example_numbers(sorted(i))
  end do
  write (*, '()')

contains

  function less (x, y) result (truth)
    class(*), intent(in) :: x, y
    logical :: truth

    select type (x)
    type is (integer)
       select type (y)
       type is (integer)
          truth = (x < y)
       class default
          error stop
       end select
    class default
       error stop
    end select
  end function less

end program patience_sort_task