class
	PANCAKE_SORT [G -> COMPARABLE]

feature {NONE}

	arraymax (array: ARRAY [G]; upper: INTEGER): INTEGER
			--- Max item of 'array' between index 1 and 'upper'.
		require
			upper_index_positive: upper >= 0
			array_not_void: array /= Void
		local
			i: INTEGER
			cur_max: G
		do
			from
				i := 1
				cur_max := array.item (i)
				Result := i
			until
				i + 1 > upper
			loop
				if array.item (i + 1) > cur_max then
					cur_max := array.item (i + 1)
					Result := i + 1
				end
				i := i + 1
			end
		ensure
			Index_positive: Result > 0
		end

	reverse_array (ar: ARRAY [G]; upper: INTEGER): ARRAY [G]
			-- Array reversed from index one to upper.
		require
			upper_positive: upper > 0
			ar_not_void: ar /= Void
		local
			i, j: INTEGER
			new_array: ARRAY [G]
		do
			create Result.make_empty
			Result.deep_copy (ar)
			from
				i := 1
				j := upper
			until
				i > j
			loop
				Result [i] := ar [j]
				Result [j] := ar [i]
				i := i + 1
				j := j - 1
			end
		ensure
			same_length: ar.count = Result.count
		end

	sort (ar: ARRAY [G]): ARRAY [G]
			-- Sorted array in ascending order.
		local
			i: INTEGER
		do
			create Result.make_empty
			Result.deep_copy (ar)
			from
				i := ar.count
			until
				i = 1
			loop
				Result := reverse_array (reverse_array (Result, arraymax (Result, i)), i)
				i := i - 1
			end
		ensure
			same_length: ar.count = Result.count
			Result_sorted: is_sorted (Result)
		end

	is_sorted (ar: ARRAY [G]): BOOLEAN
			--- Is 'ar' sorted in ascending order?
		require
			ar_not_empty: ar.is_empty = False
		local
			i: INTEGER
		do
			Result := True
			from
				i := ar.lower
			until
				i = ar.upper
			loop
				if ar [i] > ar [i + 1] then
					Result := False
				end
				i := i + 1
			end
		end

feature

	pancake_sort (ar: ARRAY [G]): ARRAY [G]
		do
			Result := sort (ar)
		end

end


#lang Racket
(define (radix-sort l r)
  (define queues (for/vector #:length r ([_ r]) (make-queue)))
  (let loop ([l l] [R 1])
     (define all-zero? #t)
     (for ([x (in-list l)])
      (define x/R (quotient x R))
      (enqueue! (vector-ref queues (modulo x/R r)) x)
      (unless (zero? x/R) (set! all-zero? #f)))
    (if all-zero? l
         (loop (let q-loop ([i 0])
                (define q (vector-ref queues i))
                (let dq-loop ()
                  (if (queue-empty? q)
                    (if (< i (sub1 r)) (q-loop (add1 i)) '())
                    (cons (dequeue! q) (dq-loop)))))
              (* R r)))))
(for/and ([i 10000]) ; run some tests on random lists with a random radix
  (define (make-random-list)
     (for/list ([i (+ 10 (random 10))]) (random 100000)))
  (define (sorted? l)
     (match l [(list) #t] [(list x) #t]
          [(list x y more ...) (and (<= x y) (sorted? (cons y more)))]))
  (sorted? (radix-sort (make-random-list) (+ 2 (random 98)))))
;; => #t, so all passed


sub radsort (@ints) {
    my $maxlen = max @ints».chars;
    my @list = @ints».fmt("\%0{$maxlen}d");

    for reverse ^$maxlen -> $r {
        my @buckets = @list.classify( *.substr($r,1) ).sort: *.key;
        @buckets[0].value = @buckets[0].value.reverse.List
            if !$r and @buckets[0].key eq '-';
        @list = flat map *.value.values, @buckets;
    }
    @list».Int;
}

.say for radsort (-2_000 .. 2_000).roll(20);


import extensions;

extension op
{
    pancakeSort()
    {
        var list := self.clone();

        int i := list.Length;

        if (i < 2) { ^ self };

        while (i > 1)
        {
            int max_num_pos := 0;
            int a := 0;
            while (a < i)
            {
                if (list[a] > list[max_num_pos])
                {
                    max_num_pos := a
                };

                a += 1
            };

            if (max_num_pos == i - 1)
            {
            }
            else
            {
                if (max_num_pos > 0)
                {
                    list.flip(list.Length, max_num_pos + 1)
                };

                list.flip(list.Length, i)
            };
            i -= 1
        };

        ^ list
    }

    flip(int length, int num)
    {
        int i := 0;
        int count := num - 1;
        while (i < count)
        {
            var swap := self[i];
            self[i] := self[count];
            self[count] := swap;

            i += 1;
            count -= 1
        }
    }
}

public program()
{
    var list := new int[]{6, 7, 8, 9, 2, 5, 3, 4, 1};

    console.printLine("before:", list.asEnumerable());
    console.printLine("after :", list.pancakeSort().asEnumerable())
}


defmodule Sort do
  def pancake_sort(list) when is_list(list), do: pancake_sort(list, length(list))

  defp pancake_sort(list, 0), do: list
  defp pancake_sort(list, limit) do
    index = search_max(list, limit)
    flip(list, index) |> flip(limit) |> pancake_sort(limit-1)
  end

  defp search_max([h | t], limit), do: search_max(t, limit, 2, h, 1)

  defp search_max(_, limit, index, _, max_index) when limit<index, do: max_index
  defp search_max([h | t], limit, index, max, max_index) do
    if h > max, do:   search_max(t, limit, index+1, h, index),
                else: search_max(t, limit, index+1, max, max_index)
  end

  defp flip(list, n), do: flip(list, n, [])

  defp flip(list, 0, reverse), do: reverse ++ list
  defp flip([h | t], n, reverse) do
    flip(t, n-1, [h | reverse])
  end
end

IO.inspect list = Enum.shuffle(1..9)
IO.inspect Sort.pancake_sort(list)


/*REXX program performs a radix sort on an integer array (can be negative/zero/positive)*/
call gen                                         /*call subroutine to generate numbers. */
call radSort  n, w                               /*invoke the  radix sort  subroutine.  */
call show                                        /*display the elements in the  @  array*/
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
gen: ILF=  0  2  3  4  5  5  7. 6  6  7 11  7 13  9  8  8 17  8 19  9 10 13 23  9 10 15 ,
           9 11 29 10 31 10 14 19 12 10 37 21 16 11 41 12 43 15 11 25 47 11 14 12 20 17 ,
          53 11 16 13 22 31 59 12 61 33 13 12 18 16 67 21 26 14 71 12 73 39 13 23 18 18 ,
          79 13 12 43 83 14 22 45 32 17 89 13 20 27 34 49 24 13 97 16 17 14  101        ,
         '22 103 19 15 55 107 13 109 18 40 15 113  -42'
              /*excluding -42, abbreviated above list is called the integer log function*/
     n= words(ILF)                                            /*    I────── L── F───────*/
     w= 0;         do m=1  for n;   _= word(ILF,m) +0;    @.m= _;    w= max(w, length(_) )
                   end   /*m*/;        return    /*W:  is the maximum width ↑ of numbers*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
radSort: procedure expose @.;  parse arg size,w;   mote= c2d(' ');    #= 1;   !.#._n= size
!.#._b= 1;                     if w==''  then w= 8
!.#._i= 1;  do i=1  for size;  [email protected].i;  @.i= right(abs(y), w, 0);  if y<0  then @.i= '-'@.i
            end  /*i*/                                            /* [↑]  negative case.*/

     do  while #\==0;  ctr.= 0;  L= 'ffff'x;   low= !.#._b;   n= !.#._n;   $= !.#._i;   H=
     #= #-1                                                      /* [↑]   is the radix. */
           do j=low  for n;      parse var  @.j  =($)  _  +1;    ctr._= ctr._ + 1
           if ctr._==1 & _\==''  then do;  if _<<L  then L=_;    if _>>H  then H=_
                                      end  /*  ↑↑                                       */
           end   /*j*/                     /*  └┴─────◄───  <<   is a strict comparison.*/
     _=                                    /*      ┌──◄───  >>    " "    "        "     */
     if L>>H  then iterate                 /*◄─────┘                                    */
     if L==H & ctr._==0  then do; #= #+1;  !.#._b= low;  !.#._n= n;  !.#._i= $+1;  iterate
                              end
     L= c2d(L);   H= c2d(H);      ?= ctr._ + low;        top._= ?;          ts= mote
     max= L
                  do k=L  to H;   _= d2c(k, 1);   c= ctr._  /* [↓]  swap 2 item radices.*/
                  if c>ts  then parse value  c k  with  ts max;     ?= ?+c;       top._= ?
                  end   /*k*/
     piv= low                                    /*set PIVot to the low part of the sort*/
             do  while piv<low+n
             it= @.piv
                        do forever;     parse var it  =($)  _  +1;         c= top._ -1
                        if piv>=c  then leave;   top._= c;    ?= @.c;    @.c= it;    it= ?
                        end   /*forever*/
             top._= piv;                         @.piv= it;        piv= piv + ctr._
             end   /*while piv<low+n */
     i= max
          do  until i==max;  _= d2c(i, 1);     i= i+1;     if i>H  then i= L;     d= ctr._
          if d<=mote  then do;         if d<2  then iterate;          b= top._
                             do k=b+1  for d-1;                       q= @.k
                               do j=k-1  by -1  to b  while q<<@.j;  jp= j+1;   @.jp= @.j
                               end   /*j*/
                                                                     jp= j+1;   @.jp= q
                             end     /*k*/
                           iterate
                           end
          #= #+1;       !.#._b= top._;       !.#._n= d;        !.#._i= $ + 1
          end   /*until i==max*/
     end        /*while #\==0 */
#= 0                                             /* [↓↓↓]  handle neg. and pos. arrays. */
        do i=size  by -1  for size;    if @.i>=0  then iterate;     #= #+1;      @@.#= @.i
        end   /*i*/
        do j=1  for size;   if @.j>=0  then do;  #= #+1;   @@.#= @.j;  end;    @.j= @@.j+0
        end   /*j*/                              /* [↑↑↑]  combine 2 lists into 1 list. */
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
show:  do j=1  for n;   say 'item'   right(j, w)   "after the radix sort:"   right(@.j, w)
       end   /*j*/;     return                   /* [↑]  display sorted items ───► term.*/


function flip(sequence s, integer n)
    object temp
    for i = 1 to n/2 do
        temp = s[i]
        s[i] = s[n-i+1]
        s[n-i+1] = temp
    end for
    return s
end function

function pancake_sort(sequence s)
    integer m
    for i = length(s) to 2 by -1 do
        m = 1
        for j = 2 to i do
            if compare(s[j], s[m]) > 0 then
                m = j
            end if
        end for

        if m < i then
            if m > 1 then
                s = flip(s,m)
            end if
            s = flip(s,i)
        end if
    end for
    return s
end function

constant s = rand(repeat(100,10))

? s
? pancake_sort(s)


open System

let show data = data |> Array.iter (printf "%d ") ; printfn ""
let split (data: int[]) pos = data.[0..pos], data.[(pos+1)..]

let flip items pos =
    let lower, upper = split items pos
    Array.append (Array.rev lower) upper

let pancakeSort items =
    let rec loop data limit =
        if limit <= 0 then data
        else
            let lower, upper = split data limit
            let indexOfMax = lower |> Array.findIndex ((=) (Array.max lower))
            let partialSort = Array.append (flip lower indexOfMax |> Array.rev) upper
            loop partialSort (limit-1)

    loop items ((Array.length items)-1)


class Array
  def radix_sort(base=10)
    ary = dup
    rounds = (Math.log(ary.minmax.map(&:abs).max)/Math.log(base)).floor + 1
    rounds.times do |i|
      buckets = Array.new(2*base){[]}
      base_i = base**i
      ary.each do |n|
        digit = (n/base_i) % base
        digit += base if 0<=n
        buckets[digit] << n
      end
      ary = buckets.flatten
      p [i, ary] if $DEBUG
    end
    ary
  end
  def radix_sort!(base=10)
    replace radix_sort(base)
  end
end

p [1, 3, 8, 9, 0, 0, 8, 7, 1, 6].radix_sort
p [170, 45, 75, 90, 2, 24, 802, 66].radix_sort
p [170, 45, 75, 90, 2, 24, -802, -66].radix_sort
p [100000, -10000, 400, 23, 10000].radix_sort


program Pancake_Demo
  implicit none

  integer :: list(8) = (/ 1, 4, 7, 2, 5, 8, 3, 6 /)

  call Pancake_sort(list)

contains

subroutine Pancake_sort(a)

  integer, intent(in out) :: a(:)
  integer :: i, maxpos

  write(*,*) a
  do i = size(a), 2, -1

! Find position of max number between index 1 and i
    maxpos = maxloc(a(1:i), 1)

! is it in the correct position already?
    if (maxpos == i) cycle

! is it at the beginning of the array? If not flip array section so it is
    if (maxpos /= 1) then
      a(1:maxpos) = a(maxpos:1:-1)
      write(*,*) a
    end if

! Flip array section to get max number to correct position
    a(1:i) = a(i:1:-1)
    write(*,*) a
  end do

end subroutine

end program Pancake_Demo


' version 11-04-2017
' compile with: fbc -s console
' for boundry checks on array's compile with: fbc -s console -exx

' direction = 1, (default) sort ascending
' direction <> 1 sort descending
' show = 0, (default) do not show sorting
' show <> 0, show sorting
Sub pancake_sort(a() As Long,direction As Long = 1, show As Long = 0)
    ' array's can have subscript range from -2147483648 to +2147483647
    Dim As Long i, j, n
    Dim As Long lb = LBound(a)
    Dim As Long ub = UBound(a)

    If show <> 0 Then ' show initial state
        For j = lb To ub
            Print Using "####"; a(j);
        Next
        Print
    End If

    For i = ub To lb +1 Step -1

        n = lb
        For j = lb +1 To i
            If direction = 1 Then
                If a(n) < a(j) Then n = j
            Else
                If a(n) > a(j) Then n = j
            End If
        Next

        If n < i Then
            If n > lb Then
                For j = lb To lb + ((n - lb) \ 2)
                    Swap a(j), a(lb + n - j)
                Next

                If show <> 0 Then
                    For j = lb To ub
                        Print Using "####"; a(j);
                    Next
                    Print
                End If

            End If

            For j = lb To lb + ((i - lb) \ 2)
                Swap a(j), a(lb + i - j)
            Next

            If show <> 0 Then
                For j = lb To ub
                    Print Using "####"; a(j);
                Next
                Print
            End If

        End If
    Next

End Sub

' ------=< MAIN >=------

Dim As Long i, array(-7 To 7)
Dim As Long lb = LBound(array)
Dim As Long ub = UBound(array)

Randomize Timer
For i = lb To ub : array(i) = i : Next
For i = lb To ub ' little shuffle
    Swap array(i), array(Int(Rnd * (ub - lb +1) + lb))
Next

Print "unsorted  ";
For i = lb To ub
    Print Using "####"; array(i);
Next
Print : Print

pancake_sort(array())

Print "  sorted  ";
For i = lb To ub
    Print Using "####"; array(i);
Next

Print : Print
Dim As Long l(10 To ...) = {0, -30, 20, -10, 0, 10, -20}

pancake_sort(l(),0,1)   ' sort array l, ascending and show process

Print : Print "  sorted  l()";
For i = LBound(l) To UBound(l)
    Print Using "####"; l(i);
Next
Print

' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


fn merge(in1: &[i32], in2: &[i32], out: &mut [i32]) {
    let (left, right) = out.split_at_mut(in1.len());
    left.clone_from_slice(in1);
    right.clone_from_slice(in2);
}

// least significant digit radix sort
fn radix_sort(data: &mut [i32]) {
    for bit in 0..31 {
        // types of small and big is Vec<i32>.
        // It will be infered from the next call of merge function.
        let (small, big): (Vec<_>, Vec<_>) = data.iter().partition(|&&x| (x >> bit) & 1 == 0);
        merge(&small, &big, data);
    }
    // last bit is sign
    let (negative, positive): (Vec<_>, Vec<_>) = data.iter().partition(|&&x| x < 0);
    merge(&negative, &positive, data);
}

fn main() {
    let mut data = [170, 45, 75, -90, -802, 24, 2, 66, -17, 2];
    println!("Before: {:?}", data);
    radix_sort(&mut data);
    println!("After: {:?}", data);
}


object RadixSort extends App {
  def sort(toBeSort: Array[Int]): Array[Int] = { // Loop for every bit in the integers
    var arr = toBeSort
    for (shift <- Integer.SIZE - 1 until -1 by -1) { // The array to put the partially sorted array into
      val tmp = new Array[Int](arr.length)
      // The number of 0s
      var j = 0
      // Move the 0s to the new array, and the 1s to the old one
      for (i <- arr.indices) // If there is a 1 in the bit we are testing, the number will be negative
        // If this is the last bit, negative numbers are actually lower
        if ((shift == 0) == (arr(i) << shift >= 0)) arr(i - j) = arr(i)
        else {
          tmp(j) = arr(i)
          j += 1
        }
      // Copy over the 1s from the old array
      arr.copyToArray(tmp, j, arr.length - j)

      // And now the tmp array gets switched for another round of sorting
      arr = tmp
    }
    arr
  }

  println(sort(Array(170, 45, 75, -90, -802, 24, 2, 66)).mkString(", "))
}


package main

import "fmt"

func main() {
    list := pancake{31, 41, 59, 26, 53, 58, 97, 93, 23, 84}
    fmt.Println("unsorted:", list)

    list.sort()
    fmt.Println("sorted!  ", list)
}

type pancake []int

func (a pancake) sort() {
    for uns := len(a) - 1; uns > 0; uns-- {
        // find largest in unsorted range
        lx, lg := 0, a[0]
        for i := 1; i <= uns; i++ {
            if a[i] > lg {
                lx, lg = i, a[i]
            }
        }
        // move to final position in two flips
        a.flip(lx)
        a.flip(uns)
    }
}

func (a pancake) flip(r int) {
    for l := 0; l < r; l, r = l+1, r-1 {
        a[l], a[r] = a[r], a[l]
    }
}


;;; An illustrative implementation of the radix-10 example at
;;; https://en.wikipedia.org/w/index.php?title=Radix_sort&oldid=1070890278#Least_significant_digit

(cond-expand
  (r7rs)
  (chicken (import (r7rs))))

(import (scheme base))
(import (scheme write))

(define (sort-by-decimal-digit data power-of-10)
  (define bins (make-vector 10 '()))
  (do ((i (- (vector-length data) 1) (- i 1)))
      ((= i -1))
    (let* ((element (vector-ref data i))
           (digit (truncate-remainder
                   (truncate-quotient element power-of-10)
                   10)))
      (vector-set! bins digit
                   (cons element (vector-ref bins digit)))))
  (let ((non-zero-found
         (let loop ((i 1))
           (cond ((= i (vector-length bins)) #f)
                 ((pair? (vector-ref bins i)) #t)
                 (else (loop (+ i 1)))))))
    (when non-zero-found
      (let ((i 0))
        (do ((j 0 (+ j 1)))
            ((= j (vector-length bins)))
          (do ((p (vector-ref bins j) (cdr p)))
              ((null? p))
            (vector-set! data i (car p))
            (set! i (+ i 1))))))
    (not non-zero-found)))

(define (radix-sort data)
  (let loop ((power-of-10 1))
    (let ((done (sort-by-decimal-digit data power-of-10)))
      (unless done
        (loop (* 10 power-of-10))))))

(define data (vector-copy #(170 45 75 90 2 802 2 66)))
(write data)
(newline)
(radix-sort data)
(write data)
(newline)


def makeSwap = { a, i, j = i+1 -> print "."; a[[j,i]] = a[[i,j]] }

def flip = { list, n -> (0..<((n+1)/2)).each { makeSwap(list, it, n-it) } }

def pancakeSort = { list ->
    def n = list.size()
    (1..<n).reverse().each { i ->
        def max = list[0..i].max()
        def flipPoint = (i..0).find{ list[it] == max }
        if (flipPoint != i) {
            flip(list, flipPoint)
            flip(list, i)
        }
    }
    list
}


import Data.List
import Control.Arrow
import Control.Monad
import Data.Maybe

dblflipIt :: (Ord a) => [a] -> [a]
dblflipIt = uncurry ((reverse.).(++)). first reverse
  . ap (flip splitAt) (succ. fromJust. (elemIndex =<< maximum))

dopancakeSort :: (Ord a) => [a] -> [a]
dopancakeSort xs = dopcs (xs,[]) where
  dopcs ([],rs) = rs
  dopcs ([x],rs) = x:rs
  dopcs (xs,rs) = dopcs $ (init &&& (:rs).last ) $ dblflipIt xs


class Array {
    method radix_sort(base=10) {
        var arr = self.clone
        var rounds = ([arr.minmax].map{.abs}.max.ilog(base) + 1)
        for i in (0..rounds) {
            var buckets = (2*base -> of {[]})
            var base_i = base**i
            for n in arr {
                var digit = (n/base_i % base)
                digit += base if (0 <= n)
                buckets[digit].append(n)
            }
            arr = buckets.flat
        }
        return arr
    }
}

for arr in [
    [1, 3, 8, 9, 0, 0, 8, 7, 1, 6],
    [170, 45, 75, 90, 2, 24, 802, 66],
    [170, 45, 75, 90, 2, 24, -802, -66],
    [100000, -10000, 400, 23, 10000],
] {
    say arr.radix_sort
}


class PancakeSort {
  @:generic
  inline private static function flip<T>(arr:Array<T>, num:Int) {
    var i = 0;
    while (i < --num) {
      var temp = arr[i];
      arr[i++] = arr[num];
      arr[num] = temp;
    }
  }

  @:generic
  public static function sort<T>(arr:Array<T>) {
    if (arr.length < 2) return;

    var i = arr.length;
    while (i > 1) {
      var maxNumPos = 0;
      for (a in 0...i) {
        if (Reflect.compare(arr[a], arr[maxNumPos]) > 0)
          maxNumPos = a;
      }
      if (maxNumPos == i - 1) i--;
      if (maxNumPos > 0) flip(arr, maxNumPos + 1);
      flip(arr, i--);
    }
  }
}

class Main {
  static function main() {
    var integerArray = [1, 10, 2, 5, -1, 5, -19, 4, 23, 0];
    var floatArray = [1.0, -3.2, 5.2, 10.8, -5.7, 7.3,
                      3.5, 0.0, -4.1, -9.5];
    var stringArray = ['We', 'hold', 'these', 'truths', 'to',
                       'be', 'self-evident', 'that', 'all',
                       'men', 'are', 'created', 'equal'];
    Sys.println('Unsorted Integers: ' + integerArray);
    PancakeSort.sort(integerArray);
    Sys.println('Sorted Integers:   ' + integerArray);
    Sys.println('Unsorted Floats:   ' + floatArray);
    PancakeSort.sort(floatArray);
    Sys.println('Sorted Floats:     ' + floatArray);
    Sys.println('Unsorted Strings:  ' + stringArray);
    PancakeSort.sort(stringArray);
    Sys.println('Sorted Strings:    ' + stringArray);
  }
}


procedure main()                                        #: demonstrate various ways to sort a list and string
   demosort(pancakesort,[3, 14, 1, 5, 9, 2, 6, 3],"qwerty")
   pancakeflip := pancakeflipshow                       # replace pancakeflip procedure with a variant that displays each flip
   pancakesort([3, 14, 1, 5, 9, 2, 6, 3])
end

procedure pancakesort(X,op)                             #: return sorted list ascending(or descending)
local i,m

   op := sortop(op,X)                                   # select how and what we sort

   every i := *X to 2 by -1 do {                        # work back to front
      m := 1
      every j := 2 to i do
         if op(X[m],X[j]) then m := j                   # find X that belongs @i high (or low)
      if i ~= m then {                                  # not already in-place
         X := pancakeflip(X,m)                          # . bring max (min) to front
         X := pancakeflip(X,i)                          # . unsorted portion of stack
         }
      }
   return X
end

procedure pancakeflip(X,tail)                           #: return X[1:tail] flipped
local i

   i := 0
   tail := integer(\tail|*X) + 1   | runerr(101,tail)
   while X[(i +:= 1) < (tail -:= 1)] :=: X[i]              # flip
   return X
end

procedure pancakeflipshow(X,tail)                       #: return X[1:tail] flipped  (and display)
local i

   i := 0
   tail := integer(\tail|*X) + 1   | runerr(101,tail)
   while X[(i +:= 1) < (tail -:= 1)] :=: X[i]              # flip
   every writes("    ["|right(!X,4)|" ]\n")                # show X
   return X
end


templates radixsort&{base:}
  sink bucketize
    def value: $;
    $ ~/ [email protected] -> #
    when <=0 ?($value <0..>)> do
      ..|@radixsort.positives: $value;
    when <=0> do
      ..|@radixsort.negatives(last): $value;
    otherwise
      def bucket: $ mod $base -> \(<?($value<0..>)> $ + 1 ! <=0> $base ! <> $ !\);
      ..|@radixsort.buckets($bucket): $value;
      @radixsort.done: 0;
  end bucketize
  // Negatives get completed in wrong length-order, we need to collect by length and correct at the end
  @: { done: 1, digit: 1"1", positives: [], negatives: [[]], buckets: [1..$base -> []]};
  $... -> !bucketize
  [email protected] -> #
  when <=1> do
    [[email protected](last..1:-1)... ..., [email protected]] !
  otherwise
    def previous: [email protected];
    ..|@: {done: 1, digit: [email protected] * $base, buckets:[1..$base -> []]};
    ..|@.negatives: [];
    $previous... ... -> !bucketize
    [email protected] -> #
end radixsort

[170, 45, 75, 91, 90, 92, 802, 24, 2, 66] -> radixsort&{base:10} -> !OUT::write
'
' -> !OUT::write
[-170, -45, -91, -90, -92, -802, -24, -2, -76] -> radixsort&{base:10} -> !OUT::write
'
' -> !OUT::write
[170, 45, 75, -91, -90, -92, -802, 24, 2, 66] -> radixsort&{base:10} -> !OUT::write
'
' -> !OUT::write
[170, 45, 75, -91, -90, -92, -802, 24, 2, 66] -> radixsort&{base:3} -> !OUT::write


package require Tcl 8.5
proc splitByRadix {lst base power} {
    # create a list of empty lists to hold the split by digit
    set out [lrepeat [expr {$base*2}] {}]
    foreach item $lst {
	# pulls the selected digit
	set digit [expr {($item / $base ** $power) % $base + $base * ($item >= 0)}]
	# append the number to the list selected by the digit
	lset out $digit [list {*}[lindex $out $digit] $item]
    }
    return $out
}

# largest abs value element of a list
proc tcl::mathfunc::maxabs {lst} {
    set max [abs [lindex $lst 0]]
    for {set i 1} {$i < [llength $lst]} {incr i} {
	set v [abs [lindex $lst $i]]
	if {$max < $v} {set max $v}
    }
    return $max
}

proc radixSort {lst {base 10}} {
    # there are as many passes as there are digits in the longest number
    set passes [expr {int(log(maxabs($lst))/log($base) + 1)}]
    # For each pass...
    for {set pass 0} {$pass < $passes} {incr pass} {
	# Split by radix, then merge back into the list
	set lst [concat {*}[splitByRadix $lst $base $pass]]
    }
    return $lst
}


flip=: C.~ [email protected]@-
unsorted=: #~ 1 , [: >./\. 2 >/\ ]
FlDown=: flip 1 + (i. >./)@unsorted
FlipUp=: flip 1 >. [:+/>./\&|[email protected](< {.)

pancake=: [email protected]^:_


public class PancakeSort
{
   int[] heap;

   public String toString() {
      String info = "";
      for (int x: heap)
         info += x + " ";
      return info;
   }

   public void flip(int n) {
      for (int i = 0; i < (n+1) / 2; ++i) {
         int tmp = heap[i];
         heap[i] = heap[n-i];
         heap[n-i] = tmp;
      }
      System.out.println("flip(0.." + n + "): " + toString());
   }

   public int[] minmax(int n) {
      int xm, xM;
      xm = xM = heap[0];
      int posm = 0, posM = 0;

      for (int i = 1; i < n; ++i) {
         if (heap[i] < xm) {
            xm = heap[i];
            posm = i;
         }
         else if (heap[i] > xM) {
            xM = heap[i];
            posM = i;
         }
      }
      return new int[] {posm, posM};
   }

   public void sort(int n, int dir) {
      if (n == 0) return;

      int[] mM = minmax(n);
      int bestXPos = mM[dir];
      int altXPos = mM[1-dir];
      boolean flipped = false;

      if (bestXPos == n-1) {
         --n;
      }
      else if (bestXPos == 0) {
         flip(n-1);
         --n;
      }
      else if (altXPos == n-1) {
         dir = 1-dir;
         --n;
         flipped = true;
      }
      else {
         flip(bestXPos);
      }
      sort(n, dir);

      if (flipped) {
         flip(n);
      }
   }

   PancakeSort(int[] numbers) {
      heap = numbers;
      sort(numbers.length, 1);
   }

   public static void main(String[] args) {
      int[] numbers = new int[args.length];
      for (int i = 0; i < args.length; ++i)
         numbers[i] = Integer.valueOf(args[i]);

      PancakeSort pancakes = new PancakeSort(numbers);
      System.out.println(pancakes);
   }
}


// counting sort of 'a' according to the digit represented by 'exp'
var countSort = Fn.new { |a, exp|
    var n = a.count
    var output = [0] * n
    var count  = [0] * 10
    for (i in 0...n) {
        var t = (a[i]/exp).truncate % 10
        count[t] = count[t] + 1
    }
    for (i in 1..9) count[i] = count[i] + count[i-1]
    for (i in n-1..0) {
        var t = (a[i]/exp).truncate % 10
        output[count[t] - 1] = a[i]
        count[t] = count[t] - 1
    }
    for (i in 0...n) a[i] = output[i]
}

// sorts 'a' in place
var radixSort = Fn.new { |a|
    // check for negative elements
    var min = a.reduce { |m, i| (i < m) ? i : m }
    // if there are any, increase all elements by -min
    if (min < 0) (0...a.count).each { |i| a[i] = a[i] - min }
    // now get the maximum to know number of digits
    var max = a.reduce { |m, i| (i > m) ? i : m }
    // do counting sort for each digit
    var exp = 1
    while ((max/exp).truncate > 0) {
        countSort.call(a, exp)
        exp = exp * 10
    }
    // if there were negative elements, reduce all elements by -min
    if (min < 0) (0...a.count).each { |i| a[i] = a[i] + min }
}

var aa =  [[4, 65, 2, -31, 0, 99, 2, 83, 782, 1], [170, 45, 75, 90, 2, 24, -802, -66]]
for (a in aa) {
    System.print("Unsorted: %(a)")
    radixSort.call(a)
    System.print("Sorted  : %(a)\n")
}


Array.prototype.pancake_sort = function () {
    for (var i = this.length - 1; i >= 1; i--) {
        // find the index of the largest element not yet sorted
        var max_idx = 0;
        var max = this[0];
        for (var j = 1; j <= i; j++) {
            if (this[j] > max) {
                max = this[j];
                max_idx = j;
            }
        }

        if (max_idx == i)
            continue; // element already in place

        var new_slice;

        // flip this max element to index 0
        if (max_idx > 0) {
            new_slice = this.slice(0, max_idx+1).reverse();
            for (var j = 0; j <= max_idx; j++)
                this[j] = new_slice[j];
        }

        // then flip the max element to its place
        new_slice = this.slice(0, i+1).reverse();
        for (var j = 0; j <= i; j++)
            this[j] = new_slice[j];
    }
    return this;
}
ary = [7,6,5,9,8,4,3,1,2,0]
sorted = ary.concat().pancake_sort();


fcn radixSort(ns){ // ints only, inplace, ns is mutable
   b:=(0).pump(20,List,List().copy);  // 20 [empty] buckets: -10..10
   z:=ns.reduce(fcn(a,b){ a.abs().max(b.abs()) },0); // |max or min of input|
   m:=1;
   while(z){
      ns.apply2('wrap(n){ b[(n/m)%10 +10].append(n) }); // sort on right digit
      ns.clear(); b.pump(ns.extend);		// slam buckets over src
      b.apply("clear");			     // reset buckets
      m*=10; z/=10;			// move sort digit left
   }
   ns
}


def pancakeSort:

  def flip(i):
    . as $in | ($in[0:i+1]|reverse) + $in[i+1:] ;

  # If input is [] then return null
  def index_of_max:
    . as $in
    | reduce range(1; length) as $i
        # state: [ix, max]
        ( [ 0, $in[0] ];
          if $in[$i] > .[1] then [ $i, $in[$i] ] else . end )
    | .[0] ;

  reduce range(0; length) as $iup
    (.;
     (length - $iup - 1) as $i
     | (.[0:$i+1] | index_of_max) as $max
     # flip about $max and then about $i unless $i == $max
     | if ($i == $max) then .
       else flip($max) | flip($i)
       end ) ;


function pancakesort!(arr::Vector{<:Real})
    len = length(arr)
    if len < 2 return arr end
    for i in len:-1:2
        j = indmax(arr[1:i])
        if i == j continue end
        arr[1:j] = reverse(arr[1:j])
        arr[1:i] = reverse(arr[1:i])
    end
    return arr
end

v = rand(-10:10, 10)
println("# unordered: $v\n -> ordered: ", pancakesort!(v))


fun pancakeSort(a: IntArray) {
    /** Returns the index of the highest number in the range 0 until n. */
    fun indexOfMax(n: Int): Int = (0 until n).maxByOrNull{ a[it] }!!

    /** Flips the elements in the range 0 .. n. */
    fun flip(index: Int) {
        a.reverse(0, index + 1)
    }

    for (n in a.size downTo 2) {  // successively reduce size of array by 1
        val index = indexOfMax(n) // find index of largest
        if (index != n - 1) {     // if it's not already at the end
            if (index > 0) {      // if it's not already at the beginning
                flip(index)       // move largest to beginning
                println("${a.contentToString()} after flipping first ${index + 1}")
            }
            flip(n - 1)           // move largest to end
            println("${a.contentToString()} after flipping first $n")
        }
    }
}

fun main() {
    val a = intArrayOf(7, 6, 9, 2, 4, 8, 1, 3, 5)
    println("${a.contentToString()} initially")
    pancakeSort(a)
}


-- Initialisation
math.randomseed(os.time())
numList = {step = 0, sorted = 0}

-- Create list of n random values
function numList:build (n)
    self.values = {}
    for i = 1, n do self.values[i] = math.random(-100, 100) end
end

-- Return boolean indicating whether the list is in order
function numList:isSorted ()
    for i = 2, #self.values do
        if self.values[i] < self.values[i - 1] then return false end
    end
    print("Finished!")
    return true
end

-- Display list of numbers on one line
function numList:show ()
    if self.step == 0 then
        io.write("Initial state:\t")
    else
        io.write("After step " .. self.step .. ":\t")
    end
    for _, v in ipairs(self.values) do io.write(v .. " ") end
    print()
end

-- Reverse n values from the left
function numList:reverse (n)
    local flipped = {}
    for i, v in ipairs(self.values) do
        if i > n then
            flipped[i] = v
        else
            flipped[i] = self.values[n + 1 - i]
        end
    end
    self.values = flipped
end

-- Perform one flip of a pancake sort
function numList:pancake ()
    local maxPos = 1
    for i = 1, #self.values - self.sorted do
        if self.values[i] > self.values[maxPos] then maxPos = i end
    end
    if maxPos == 1 then
        numList:reverse(#self.values - self.sorted)
        self.sorted = self.sorted + 1
    else
        numList:reverse(maxPos)
    end
    self.step = self.step + 1
end

-- Main procedure
numList:build(10)
numList:show()
repeat
    numList:pancake()
    numList:show()
until numList:isSorted()


flip := proc(arr, i)
	local start, temp, icopy;
	temp, start, icopy := 0,1,i:
	while (start < icopy) do
		arr[start], arr[icopy] := arr[icopy], arr[start]:
		start:=start+1:
		icopy:=icopy-1:
	end do:
end proc:
findMax := proc(arr, i)
	local Max, j:
	Max := 1:
	for j from 1 to i do
		if arr[j] > arr[Max] then Max := j: end if:
	end do:
	return Max:
end proc:
pancakesort := proc(arr)
	local len,i,Max;
	len := numelems(arr):
	for i from len to 2 by -1 do
		print(arr):
		Max := findMax(arr, i):
		if (not Max = i) then
			flip(arr, Max):
			flip(arr, i):
		end if:
	end do:
	print(arr);
end proc:


ClearAll[LMaxPosition, Flip, pancakeSort]
LMaxPosition[a_, n_] := With[{b = Take[a, n]}, First[Ordering[b, -1]]]
SetAttributes[Flip, HoldAll];
Flip[a_] := Set[a, Reverse[a]]
pancakeSort[in_] := Module[{n, lm, a = in, flips = 0},
  Do[
   lm = LMaxPosition[a, n];
   If[lm < n,
    Flip[a[[;; lm]]];
    Flip[a[[;; n]]];
   ];
   ,
   {n, Length[a], 2, -1}
   ];
  a
 ]
pancakeSort[{6, 7, 8, 9, 2, 5, 3, 4, 1}]


function list = pancakeSort(list)

    for i = (numel(list):-1:2)

        minElem = list(i);
        minIndex = i;

        %Find the min element in the current subset of the list
        for j = (i:-1:1)
            if list(j) <= minElem
                minElem = list(j);
                minIndex = j;
            end
        end

        %If the element is already in the correct position don't flip
        if i ~= minIndex

            %First flip flips the min element in the stack to the top
            list(minIndex:-1:1) = list(1:minIndex);

            %Second flip flips the min element into the correct position in
            %the stack
            list(i:-1:1) = list(1:i);

        end
    end %for
end %pancakeSort


fn flipArr arr index =
(
	local new = #()
	for i = index to 1 by -1 do
	(
		append new arr[i]
	)
	join new (for i in (index+1) to arr.count collect arr[i])
	return new
)

fn pancakeSort arr =
(
	if arr.count < 2 then return arr
	else
	(
		for i = arr.count to 1 by -1 do
		(
			local newArr = for n in 1 to i collect arr[n]
			local oldArr = for o in (i+1) to arr.count collect arr[o]
			local maxIndices = for m in 1 to (newArr.count) where (newArr[m] == amax newArr) collect m
			local lastMaxIndex = maxIndices[maxIndices.count]
			newArr = flipArr newArr lastMaxIndex
			newArr = flipArr newArr newArr.count
			arr = join newArr oldArr
		)
		return arr
	)
)


/* NetRexx */
options replace format comments java crossref symbols nobinary

import java.util.List

runSample(arg)
return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method pancakeSort(tlist = List, debug = (1 == 0)) private static returns List

  if tlist.size() > 1 then do
    loop i_ = tlist.size() by -1 while i_ > 1
      maxPos = 0
      loop a_ = 0 while a_ < i_
        if Rexx tlist.get(a_) > Rexx tlist.get(maxPos) then maxPos = a_
        end a_
      if maxPos = i_ - 1 then iterate i_
      if maxPos > 0 then pancakeFlip(tlist, maxPos + 1, debug)
      pancakeFlip(tlist, i_, debug)
      end i_
    end
  return tlist

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method pancakeFlip(tlist = List, offset, debug = (1 == 0)) private static returns List
  z_ = offset - 1
  pl = 3
  if debug then do
    plx = offset.length()
    if plx > pl then pl = plx
    say '  flip{1-'offset.right(pl, 0)'} Before:' tlist
    end
  loop i_ = 0 while i_ < z_
    Collections.swap(tlist, i_, z_)
    z_ = z_ - 1
    end i_
  if debug then do
    say '  flip{1-'offset.right(pl, 0)'}  After:' tlist
    end
  return tlist

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(arg) private static

  isTrue  = (1 == 1)
  isFalse = \isTrue

  parse arg debug .
  if '-debug'.abbrev(debug.lower(), 2) then debug = isTrue
  else                                      debug = isFalse

  lists = sampleData()
  loop il = 1 to lists[0]
    clist = words2list(lists[il])
    say ' Input:' clist
    say 'Output:' pancakeSort(clist, debug)
    say
    end il

  return
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method sampleData() private static
  lists = ''
  i_ = 0
  i_ = i_ + 1; lists[0] = i_; lists[i_] = '1 4 3 5 2 9 8 7 6'
  i_ = i_ + 1; lists[0] = i_; lists[i_] = '10 -9 8 -7 6 -5 4 -3 2 -1 0 -10 9 -8 7 -6 5 -4 3 -2 1'
  i_ = i_ + 1; lists[0] = i_; lists[i_] = '88 18 31 44 4 0 8 81 14 78 20 76 84 33 73 75 82 5 62 70 12 7 1'
  i_ = i_ + 1; lists[0] = i_; lists[i_] = '10 10.0 10.00 1 -10.0 10. -1'
  i_ = i_ + 1; lists[0] = i_; lists[i_] = 'To be or not to be that is the question'
  i_ = i_ + 1; lists[0] = i_; lists[i_] = '1'
  return lists
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method words2list(wordlist) private static returns List

  clist = ArrayList()
  loop w_ = 1 to wordlist.words()
    clist.add(wordlist.word(w_))
    end w_

  return clist


import algorithm

proc pancakeSort[T](list: var openarray[T]) =
  var length = list.len
  if length < 2: return

  var moves = 0

  for i in countdown(length, 2):
    var maxNumPos = 0
    for a in 0 ..< i:
      if list[a] > list[maxNumPos]:
        maxNumPos = a

    if maxNumPos == i - 1: continue

    if maxNumPos > 0:
      inc moves
      reverse(list, 0, maxNumPos)

    inc moves
    reverse(list, 0, i - 1)

var a = @[4, 65, 2, -31, 0, 99, 2, 83, 782]
pancakeSort a
echo a


let rec sorted = function
  | [] -> (true)
  | x::y::_ when x > y -> (false)
  | x::xs -> sorted xs

let rev_until_max li =
  let rec aux acc greater prefix suffix = function
  | x::xs when x > greater -> aux (x::acc) x acc xs xs
  | x::xs -> aux (x::acc) greater prefix suffix xs
  | [] -> (greater, (prefix @ suffix))
  in
  aux [] min_int [] li li

let pancake_sort li =
  let rec aux i li suffix =
    let greater, li = rev_until_max li in
    let suffix = greater :: suffix
    and li = List.rev li in
    if sorted li
    then (li @ suffix), i
    else aux (succ i) li suffix
  in
  aux 0 li []

let print_list li =
  List.iter (Printf.printf " %d") li;
  print_newline()

let make_rand_list n bound =
  let rec aux acc i =
    if i >= n then (acc)
    else aux ((Random.int bound)::acc) (succ i)
  in
  aux [] 0

let () =
  Random.self_init();
  let li = make_rand_list 8 100 in
  print_list li;
  let res, n = pancake_sort li in
  print_list res;
  Printf.printf " sorted in %d loops\n" n;
;;


pancakeSort(v)={
  my(top=#v);
  while(top>1,
    my(mx=1,t);
    for(i=2,top,if(v[i]>v[mx], mx=i));
    if(mx==top, top--; next);
    for(i=1,mx\2,
      t=v[i];
      v[i]=v[mx+1-i];
      v[mx+1-i]=t
    );
    for(i=1,top\2,
      t=v[i];
      v[i]=v[top+1-i];
      v[top+1-i]=t
    );
    top--
  );
  v
};


Program PancakeSort (output);

procedure flip(var b: array of integer; last: integer);

  var
    swap, i: integer;

  begin
    for i := low(b) to (last - low(b) - 1) div 2 do
    begin
      swap              := b[i];
      b[i]              := b[last-(i-low(b))];
      b[last-(i-low(b))] := swap;
    end;
  end;

procedure PancakeSort(var a: array of integer);

  var
    i, j, maxpos: integer;

  begin
    for i := high(a) downto low(a) do
    begin
// Find position of max number between beginning and i
      maxpos := i;
      for j := low(a) to i - 1 do
        if a[j] > a[maxpos] then
          maxpos := j;

// is it in the correct position already?
      if maxpos = i then
        continue;

// is it at the beginning of the array? If not flip array section so it is
      if maxpos <> low(a) then
        flip(a, maxpos);

// Flip array section to get max number to correct position
      flip(a, i);
    end;
  end;

var
  data: array of integer;
  i: integer;

begin
  setlength(data, 8);
  Randomize;
  writeln('The data before sorting:');
  for i := low(data) to high(data) do
  begin
    data[i] := Random(high(data));
    write(data[i]:4);
  end;
  writeln;
  PancakeSort(data);
  writeln('The data after sorting:');
  for i := low(data) to high(data) do
  begin
    write(data[i]:4);
  end;
  writeln;
end.


sub pancake {
        my @x = @_;
        for my $idx (0 .. $#x - 1) {
                my $min = $idx;
                $x[$min] > $x[$_] and $min = $_           for $idx + 1 .. $#x;

                next if $x[$min] == $x[$idx];

                @x[$min .. $#x] = reverse @x[$min .. $#x] if $x[$min] != $x[-1];
                @x[$idx .. $#x] = reverse @x[$idx .. $#x];
        }
        @x;
}

my @a = map (int rand(100), 1 .. 10);
print "Before @a\n";
@a = pancake(@a);
print "After  @a\n";


with javascript_semantics

function pancake_sort(sequence s)
    s = deep_copy(s)
    for i=length(s) to 2 by -1 do
        integer m = largest(s[1..i],true)
        if m<i then
            if m>1 then
                s[1..m] = reverse(s[1..m])
            end if
            s[1..i] = reverse(s[1..i])
        end if
    end for
    return s
end function

constant s = shuffle(tagset(10))
? s
? pancake_sort(s)


go =>
   Nums = [6,7,8,9,2,5,3,4,1],
   println(Nums),
   Sorted = pancake_sort(Nums),
   println(Sorted),
   nl.

pancake_sort(L) = L =>
  T = L.len,
  while (T > 1)
    Ix = argmax(L[1..T]),
    if Ix == 1 then
      L := L[1..T].reverse ++ L.slice(T+1),
      T := T-1
    else
      L := L[1..Ix].reverse ++ L.slice(Ix+1)
    end
 end.

% Get the index of the (first) maximal value in L
argmax(L) = MaxIx =>
  Max = max(L),
  MaxIx = [I : I in 1..L.length, L[I] == Max].first.


(de pancake (Lst)
   (prog1 (flip Lst (index (apply max Lst) Lst))
      (for (L @  (cdr (setq Lst (cdr L)))  (cdr L))
         (con L (flip Lst (index (apply max Lst) Lst))) ) ) )


pancake_sort: procedure options (main); /* 23 April 2009 */
   declare a(10) fixed, (i, n, loc) fixed binary;

   a(1) = 3; a(2) = 9; a(3) = 2; a(4) = 7; a(5) = 10;
   a(6) = 1; a(7) = 8; a(8) = 5; a(9) = 4; a(10) = 6;

   n = hbound(A,1);
   put skip edit (A) (f(5));
   do i = 1 to n-1;
      loc = max(A, n);
      call flip (A, loc);
      call flip (A, n);
      n = n - 1;
      put skip edit (A) (f(5));
   end;

max: procedure (A, k) returns (fixed binary);
   declare A(*) fixed, k fixed binary;
   declare (i, maximum, loc) fixed binary;
   maximum = A(1); loc = 1;
   do i = 2 to k;
      if A(i) > maximum then do; maximum = A(i); loc = i; end;
   end;
   return (loc);
end max;

flip: procedure (A, k);
   declare A(*) fixed, k fixed binary;
   declare (i, t) fixed binary;
   do i = 1 to (k+1)/2;
      t = A(i); A(i) = A(k-i+1); A(k-i+1) = t;
   end;
end flip;

end pancake_sort;


Function FlipPancake( [Object[]] $indata, $index = 1 )
{
	$data=$indata.Clone()
	$datal = $data.length - 1
	if( $index -gt 0 )
	{
		if( $datal -gt $index )
		{
			$first = $data[ $index..0 ]
			$last = $data[ ( $index + 1 )..$datal ]
			$data = $first + $last
		} else {
			$data = $data[ $index..0 ]
		}
	}
	$data
}

Function MaxIdx( [Object[]] $data )
{
	$data | ForEach-Object { $max = $data[ 0 ]; $i = 0; $maxi = 0 } { if( $_ -gt $max ) { $max = $_; $maxi = $i }; $i++ } { $maxi }
}

Function PancakeSort( [Object[]] $data, $index = 0 )
{
	"unsorted - $data"
	$datal = $data.length - 1
	if( $datal -gt 0 )
	{
		for( $i = $datal; $i -gt 0; $i-- )
		{
			$data = FlipPancake ( FlipPancake $data ( MaxIdx $data[ 0..$i ] ) ) $i
		}
	}
	"sorted - $data"
}

$l = 100; PancakeSort ( 1..$l | ForEach-Object { $Rand = New-Object Random }{ $Rand.Next( 0, $l - 1 ) } )


If OpenConsole()
  Define i, j, k, Loops
  Dim Pile(9)
  ;--------------------------------------------------------------
  ;- Create a Random Pile()
  For i=1 To 9                             ;- Initiate the Pile
    Pile(i)=i
  Next
  For i=9 To 1 Step -1                     ;- Do a Fisher-Yates shuffle
    Swap Pile(i),Pile(Random(i-1)+1)
  Next
  Print("Random Pile()    :")
  For i=1 To 9
    Print(" "+Str(Pile(i)))
  Next
  ;--------------------------------------------------------------
  ;- Start Sorting
  For i=9 To 2 Step -1
    If Pile(i)<>i       ;- Only Flip it if the current cake need Swapping
      Loops+1
      j=0
      Repeat            ;- find place of Pancake(i) in the Pile()
        j+1
      Until Pile(j)=i

      For k=1 To (j/2)  ;- Flip it up
        Swap Pile(k),Pile(j-k+1)
      Next
      For k=1 To i/2    ;- Flip in place
        Swap Pile(k),Pile(i-k+1)
      Next

    EndIf
  Next

  Print(#CRLF$+"Resulting Pile() :")
  For i=1 To 9
    Print(" "+str(Pile(i)))
  Next
  Print(#CRLF$+"All done in "+str(Loops)+" loops.")
  Print(#CRLF$+#CRLF$+"Press ENTER to quit."): Input()
  CloseConsole()
EndIf


tutor = False

def pancakesort(data):
    if len(data) <= 1:
        return data
    if tutor: print()
    for size in range(len(data), 1, -1):
        maxindex = max(range(size), key=data.__getitem__)
        if maxindex+1 != size:
            # This indexed max needs moving
            if maxindex != 0:
                # Flip the max item to the left
                if tutor: print('With: %r doflip  %i'
                                % ( ' '.join(str(x) for x in data), maxindex+1 ))
                data[:maxindex+1] = reversed(data[:maxindex+1])
            # Flip it into its final position
            if tutor: print('With: %r  doflip %i'
                                % ( ' '.join(str(x) for x in data), size ))
            data[:size] = reversed(data[:size])
    if tutor: print()


[ split reverse join ]    is flip        ( [ n --> [ )

[ 0 swap behead swap
  witheach
    [ 2dup > iff
        [ nip nip
          i^ 1+ swap ]
      else drop ]
  drop ]                  is smallest    (   [ --> n )

 [ dup size times
     [ dup i^ split nip
       smallest i^ + flip
       i^ flip ] ]        is pancakesort (   [ --> [ )


#lang racket

(define (pancake-sort l)
  (define (flip l n) (append (reverse (take l n)) (drop l n)))
  (for/fold ([l l]) ([i (in-range (length l) 1 -1)])
    (let* ([i2 (cdr (for/fold ([m #f]) ([x l] [j i])
                      (if (and m (<= x (car m))) m (cons x j))))]
           [l (if (zero? i2) l (flip l (add1 i2)))])
      (flip l i))))

(pancake-sort (shuffle (range 0 10)))
;; => '(0 1 2 3 4 5 6 7 8 9)


sub pancake_sort ( @a is copy ) {
    my $endpoint = @a.end;
    while $endpoint > 0 and not [<] @a {
        my $max_i = [0..$endpoint].max: { @a[$_] };
        my $max   = @a[$max_i];
        if @a[$endpoint] == $max {
            $endpoint-- while @a[$endpoint] == $max;
            next;
        }
        # @a[$endpoint] is not $max, so it needs flipping;
        # Flip twice if max is not already at the top.
        @a[0..$max_i]    .= reverse if $max_i != 0;
        @a[0..$endpoint] .= reverse;
        $endpoint--;
    }
    return @a;
}
my @data = 6, 7, 2, 1, 8, 9, 5, 3, 4;
say 'input  = ' ~ @data;
say 'output = ' ~ @data.&pancake_sort;


/*REXX program  sorts and displays  an array  using the  pancake sort  algorithm.       */
call gen                                         /*generate elements in the   @.  array.*/
call show          'before sort'                 /*display the   BEFORE  array elements.*/
          say copies('▒', 60)                    /*display a separator line for eyeballs*/
call pancakeSort         #                       /*invoke the   pancake  sort.   Yummy. */
call show          ' after sort'                 /*display the    AFTER array elements. */
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
inOrder: parse arg n; do j=1  for n-1;  k= j+1;  if @.j>@.k  then return 0; end;  return 1
panFlip: parse arg y;  do i=1  for (y+1)%2; yi=y-i+1; [email protected].i; @.[email protected].yi; @.yi=_; end; return
show: do k=1  for #;  say @element right(k,length(#)) arg(1)':' right(@.k,9);  end; return
/*──────────────────────────────────────────────────────────────────────────────────────*/
gen:  fibs= '-55 -21 -1 -8 -8 -21 -55 0 0'       /*some non─positive Fibonacci numbers, */
      @element= right('element', 21)             /*     most Fibs of which are repeated.*/

      /* ┌◄─┬──◄─ some paired bread primes which are of the form:  (P-3)÷2  and  2∙P+3  */
      /* │  │     where P is a prime. Bread primes are related to sandwich & meat primes*/
      /* ↓  ↓ ──── ════ ───── ══════ ────── ══════ ────── ═══════ ─────── ═══════ ──────*/
      bp=2 17 5 29 7 37 13 61 43 181 47 197 67 277 97 397 113 461 137 557 167 677 173 701,
                                                      797 1117 307 1237 1597 463 1861 467
      $= bp fibs;       #= words($)              /*combine the two lists; get # of items*/
            do j=1  for #; @.j= word($, j);  end /*◄─── obtain a number from the $ list.*/
      return                                     /* [↑]  populate the  @.  array with #s*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
pancakeSort: procedure expose @.;   parse arg n .;  if inOrder(n)  then return
                  do n=n  by -1  for n-1
                  != @.1;   ?= 1;                   do j=2  to n;  if @.j<=!  then iterate
                                                    != @.j;        ?= j
                                                    end   /*j*/
                  call panFlip ?;  call panFlip n
                  end   /*n*/;                      return


pancakeList = [6, 7, 8, 9, 2, 5, 3, 4, 1]
flag = 0
see "Before :" + nl
for n = 1 to len(pancakeList)
    see pancakeList[n] + " "
next
see nl

pancakeSort(pancakeList)

see "After :" + nl
for n = 1 to len(pancakeList)
    see pancakeList[n] + " "
next
see nl

func pancakeSort A
     n = len(A)
     while flag =  0
           flag = 1
           for i = 1 to n-1
               if A[i] < A[i+1]
                  temp = A[i]
                  A[i] = A[i+1]
                  A [i+1] = temp
                  flag = 0 ok
           next
     end
     return A


class Array
  def pancake_sort!
    num_flips = 0
    (self.size-1).downto(1) do |end_idx|
      max     = self[0..end_idx].max
      max_idx = self[0..end_idx].index(max)
      next if max_idx == end_idx

      if max_idx > 0
        self[0..max_idx] = self[0..max_idx].reverse
        p [num_flips += 1, self]  if $DEBUG
      end

      self[0..end_idx] = self[0..end_idx].reverse
      p [num_flips += 1, self]  if $DEBUG
    end
    self
  end
end

p a = (1..9).to_a.shuffle
p a.pancake_sort!


fn pancake_sort<T: Ord>(v: &mut [T]) {
    let len = v.len();
    // trivial case -- no flips
    if len < 2 {
        return;
    }
    for i in (0..len).rev() {
        // find index of the maximum element within `v[0..i]` (inclusive)
        let max_index = v.iter()
            .take(i + 1)
            .enumerate()
            .max_by_key(|&(_, elem)| elem)
            .map(|(idx, _)| idx)
            // safe because we already checked if `v` is empty
            .unwrap();
        // if `max_index` is not where it's supposed to be
        // do two flips to move it to `i`
        if max_index != i {
            flip(v, max_index);
            flip(v, i);
        }
    }
}

// function to flip a section of a mutable collection from 0..num (inclusive)
fn flip<E: PartialOrd>(v: &mut [E], num: usize) {
    v[0..num + 1].reverse();
}

fn main() {
    // Sort numbers
    let mut numbers = [4, 65, 2, -31, 0, 99, 2, 83, 782, 1];
    println!("Before: {:?}", numbers);
    pancake_sort(&mut numbers);
    println!("After: {:?}", numbers);

    // Sort strings
    let mut strings = ["beach", "hotel", "airplane", "car", "house", "art"];
    println!("Before: {:?}", strings);
    pancake_sort(&mut strings);
    println!("After: {:?}", strings);
}


func pancake(a) {
    for idx in ^(a.end) {
        var min = idx
        for i in (idx+1 .. a.end) { min = i if (a[min] > a[i]) }
        next if (a[min] == a[idx])
        a[min..a.end] = [a[min..a.end]].reverse...
        a[idx..a.end] = [a[idx..a.end]].reverse...
    }
    return a
}

var arr = 10.of{ 100.irand }
say "Before: #{arr}"
say "After:  #{pancake(arr)}"


import Foundation

struct PancakeSort {
    var arr:[Int]

    mutating func flip(n:Int) {
        for i in 0 ..< (n + 1) / 2 {
            swap(&arr[n - i], &arr[i])
        }
        println("flip(0.. \(n)): \(arr)")
    }

    func minmax(n:Int) -> [Int] {
        var xm = arr[0]
        var xM = arr[0]
        var posm = 0
        var posM = 0

        for i in 1..<n {
            if (arr[i] < xm) {
                xm = arr[i]
                posm = i
            } else if (arr[i] > xM) {
                xM = arr[i]
                posM = i
            }
        }

        return [posm, posM]
    }

    mutating func sort(var n:Int, var dir:Int) {
        if n == 0 {
            return
        }

        let mM = minmax(n)
        let bestXPos = mM[dir]
        let altXPos = mM[1 - dir]
        var flipped = false

        if bestXPos == n - 1 {
            n--
        } else if bestXPos == 0 {
            flip(n - 1)
            n--
        } else if altXPos == n - 1 {
            dir = 1 - dir
            n--
            flipped = true
        } else {
            flip(bestXPos)
        }

        sort(n, dir: dir)

        if flipped {
            flip(n)
        }
    }
}

let arr = [2, 3, 6, 1, 4, 5, 10, 8, 7, 9]
var a = PancakeSort(arr: arr)
a.sort(arr.count, dir: 1)
println(a.arr)


templates pancakeSort
  @: {stack: $, flips: 0"1"};
  sink flip
    when <2..> do
      @pancakeSort.stack(1..$): [email protected]($..1:-1)...;
      '[email protected]stack;$#10;' -> !OUT::write
      @pancakeSort.flips: [email protected] + 1;
  end flip
  sink fixTop
    @: 1;
    2..$ -> #
    $ -> \(when <[email protected]> do [email protected] -> !flip $ -> !flip \) -> !VOID
    when <?([email protected]($) <[email protected]([email protected])..>)> do @: $;
  end fixTop
  $::length..2:-1 -> !fixTop
  [email protected] !
end pancakeSort

[6,7,2,1,8,9,5,3,4] -> pancakeSort -> !OUT::write


package require Tcl 8.5
# Some simple helper procedures
proc flip {nlist n} {
    concat [lreverse [lrange $nlist 0 $n]] [lrange $nlist $n+1 end]
}
proc findmax {nlist limit} {
    lsearch -exact $nlist [tcl::mathfunc::max {*}[lrange $nlist 0 $limit]]
}

# Simple-minded pancake sort algorithm
proc pancakeSort {nlist {debug ""}} {
    for {set i [llength $nlist]} {[incr i -1] > 0} {} {
	set j [findmax $nlist $i]
	if {$i != $j} {
	    if {$j} {
		set nlist [flip $nlist $j]
		if {$debug eq "debug"} {puts [incr flips]>>$nlist}
	    }
	    set nlist [flip $nlist $i]
	    if {$debug eq "debug"} {puts [incr flips]>>$nlist}
	}
    }
    return $nlist
}


#lang transd

MainModule: {
    vint: [ 9, 0, 5, 10, 3, -3, -1, 8, -7, -4, -2, -6, 2, 4, 6, -10, 7, -8, -5, 1, -9],

    _start: (λ (with n (- (size vint) 1) m 0
        (textout vint "\n")
        (while n
            (= m (max-element-idx vint Range(0 (+ n 1))))
            (if (neq m n)
                (if m (reverse vint Range(0 (+ m 1))))
                (reverse vint Range(0 (+ n 1))))
            (-= n 1)
        )
        (textout vint "\n")
    ))
}


PRINT "Pancake sort:"
  n = FUNC (_InitArray)
  PROC _ShowArray (n)
  PROC _Pancakesort (n)
  PROC _ShowArray (n)
PRINT

END

_Flip PARAM(1)
  LOCAL(1)

  [email protected] = 0

  DO WHILE [email protected] < [email protected]
    PROC _Swap ([email protected], [email protected])
    [email protected] = [email protected] + 1
    [email protected] = [email protected] - 1
  LOOP
RETURN

_Pancakesort PARAM (1)                 ' Pancakesort
  LOCAL(3)

  IF [email protected] < 2 THEN RETURN

  FOR [email protected] = [email protected] TO 2 STEP -1

    [email protected]  = 0

    FOR [email protected] = 0 TO [email protected] - 1
      IF @([email protected]) > @([email protected]) THEN [email protected] = [email protected]
    NEXT

    IF [email protected] = [email protected] - 1 THEN CONTINUE
    IF [email protected] THEN PROC _Flip ([email protected])
    PROC _Flip ([email protected] - 1)

  NEXT
RETURN

_Swap PARAM(2)                         ' Swap two array elements
  PUSH @([email protected])
  @([email protected]) = @([email protected])
  @([email protected]) = POP()
RETURN

_InitArray                             ' Init example array
  PUSH 4, 65, 2, -31, 0, 99, 2, 83, 782, 1

  FOR i = 0 TO 9
    @(i) = POP()
  NEXT

RETURN (i)

_ShowArray PARAM (1)                   ' Show array subroutine
  FOR i = 0 TO [email protected]
    PRINT @(i),
  NEXT

  PRINT
RETURN


#!/usr/bin/env bash
main() {
  local stack
  local -i n m i
  if (( $# )); then
    stack=("[email protected]")
  else
    stack=($(printf '%s\n' {0..9} | shuf))
  fi
  print_stack 0 "${stack[@]}"

  # start by looking at whole stack
  (( n = ${#stack[@]} ))

  # keep going until we're all sorted
  while (( n > 0 )); do

    # shrink the stack until its bottom is not the right size
    while  (( n > 0 && ${stack[n-1]} == n-1 )); do
      (( n-=1 ))
    done

    # if we got to the top we're done
    if (( n == 0 )); then
      break
    fi

    # find the index of the largest pancake in the unsorted stack
    m=0
    for (( i=1; i < n-1; ++i )); do
      if (( ${stack[i]} > ${stack[m]} )); then
        (( m = i ))
      fi
    done

    # if it's not on top, flip to get it there
    if (( m > 0 )); then
      stack=( $(flip "$(( m + 1 ))" "${stack[@]}") )
      print_stack "$(( m + 1))" "${stack[@]}"
    fi

    # now flip the top to the bottom
    stack=( $(flip "$n" "${stack[@]}" ) )
    print_stack "$n" "${stack[@]}"

    # and move up
    (( n -= 1 ))
  done
  print_stack 0 "${stack[@]}"
}

# display the stack, optionally with brackets around a prefix
print_stack() {
  local prefix=$1
  shift
  if (( prefix )); then
    printf '[%s' "$1"
    if (( prefix > 1 )); then
      printf ',%s' "${@:2:prefix-1}"
    fi
    printf ']'
  else
    printf ' '
  fi
  if (( prefix < $# )); then
    printf '%s' "${@:prefix+1:1}"
    if (( prefix+1 < $# )); then
      printf ',%s' "${@:prefix+2:$#-prefix-1}"
    fi
  fi
  printf '\n'
}

# reverse the first N elements of an array
flip() {
  local -i size end midpoint i
  local stack temp
  size=$1
  shift
  stack=( "[email protected]" )
  if (( size > 1 )); then
    (( end = size - 1 ))
    (( midpoint = size/2 + size % 2 ))
    for (( i=0; i<midpoint; ++i )); do
      temp=${stack[i]}
      stack[i]=${stack[size-1-i]}
      stack[size-1-i]=$temp
    done
  fi
  printf '%s\n' "${stack[@]}"
}

main "[email protected]"


'pancake sort
'uses two auxiliary routines "printarray" and "flip"

Public Sub printarray(A)
  For i = LBound(A) To UBound(A)
    Debug.Print A(i),
  Next
  Debug.Print
End Sub

Public Sub Flip(ByRef A, p1, p2, trace)
'flip first elements of A (p1 to p2)
 If trace Then Debug.Print "we'll flip the first "; p2 - p1 + 1; "elements of the array"
 Cut = Int((p2 - p1 + 1) / 2)
 For i = 0 To Cut - 1
   'flip position i and (n - i + 1)
   temp = A(i)
   A(i) = A(p2 - i)
   A(p2 - i) = temp
 Next
End Sub

Public Sub pancakesort(ByRef A(), Optional trace As Boolean = False)
'sort A into ascending order using pancake sort

lb = LBound(A)
ub = UBound(A)
Length = ub - lb + 1
If Length <= 1 Then 'no need to sort
  Exit Sub
End If

For i = ub To lb + 1 Step -1
  'find position of max. element in subarray A(lowerbound to i)
  P = lb
  Maximum = A(P)
  For j = lb + 1 To i
    If A(j) > Maximum Then
      P = j
      Maximum = A(j)
    End If
  Next j
  'check if maximum is already at end - then we don't need to flip
  If P < i Then
    'flip the first part of the array up to the maximum so it is at the head - skip if it is already there
    If P > 1 Then
      Flip A, lb, P, trace
      If trace Then printarray A
    End If
    'now flip again so that it is in its final position
    Flip A, lb, i, trace
    If trace Then printarray A
  End If
Next i
End Sub

'test routine
Public Sub TestPancake(Optional trace As Boolean = False)
Dim A()
A = Array(5, 7, 8, 3, 1, 10, 9, 23, 50, 0)
Debug.Print "Initial array:"
printarray A
pancakesort A, trace
Debug.Print "Final array:"
printarray A
End Sub


import "/sort" for Find

class Pancake {
    construct new(a) {
        _a = a.toList
    }

    flip(r) {
        for (l in 0...r) {
            _a.swap(r, l)
            r = r - 1
        }
    }

    sort() {
        for (uns in _a.count-1..1) {
            var h = Find.highest(_a[0..uns])
            var lx = h[2][0]
            flip(lx)
            flip(uns)
        }
    }

    toString { _a.toString }
}

var p = Pancake.new([31, 41, 59, 26, 53, 58, 97, 93, 23, 84])
System.print("unsorted: %(p)")
p.sort()
System.print("sorted  : %(p)")


fcn pancakeSort(a){
   foreach i in ([a.len()-1..1,-1]){
      j := a.index((0).max(a[0,i+1]));  // min for decending sort
      if(i != j){ a.swap(0,j); a.swap(0,i); }
   }
   a
}


F patience_sort(&arr)
   I arr.len < 2 {R}

   [[T(arr[0])]] piles
   L(el) arr
      L(&pile) piles
         I pile.last > el
            pile.append(el)
            L.break
      L.was_no_break
         piles.append([el])

   L(i) 0 .< arr.len
      V min = piles[0].last
      V minPileIndex = 0
      L(j) 1 .< piles.len
         I piles[j].last < min
            min = piles[j].last
            minPileIndex = j
      arr[i] = min
      V& minPile = piles[minPileIndex]
      minPile.pop()
      I minPile.empty
         piles.pop(minPileIndex)

V iArr = [4, 65, 2, -31, 0, 99, 83, 782, 1]
patience_sort(&iArr)
print(iArr)

V cArr = [‘n’, ‘o’, ‘n’, ‘z’, ‘e’, ‘r’, ‘o’, ‘s’, ‘u’, ‘m’]
patience_sort(&cArr)
print(cArr)

V sArr = [‘dog’, ‘cow’, ‘cat’, ‘ape’, ‘ant’, ‘man’, ‘pig’, ‘ass’, ‘gnu’]
patience_sort(&sArr)
print(sArr)


/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program patienceSort64.s  */

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeConstantesARM64.inc"

/*******************************************/
/* Structures                               */
/********************************************/
/* structure Doublylinkedlist*/
    .struct  0
dllist_head:                    // head node
    .struct  dllist_head + 8
dllist_tail:                    // tail node
    .struct  dllist_tail  + 8
dllist_fin:
/* structure Node Doublylinked List*/
    .struct  0
NDlist_next:                    // next element
    .struct  NDlist_next + 8
NDlist_prev:                    // previous element
    .struct  NDlist_prev + 8
NDlist_value:                   // element value or key
    .struct  NDlist_value + 8
NDlist_fin:

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessSortOk:       .asciz "Table sorted.\n"
szMessSortNok:      .asciz "Table not sorted !!!!!.\n"
sMessResult:        .asciz "Value  : @ \n"
szCarriageReturn:   .asciz "\n"

.align 4
TableNumber:      .quad   1,3,11,6,2,-5,9,10,8,4,7
#TableNumber:     .quad   10,9,8,7,6,-5,4,3,2,1
                 .equ NBELEMENTS, (. - TableNumber) / 8
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
sZoneConv:       .skip 24
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                              // entry of program
    ldr x0,qAdrTableNumber                         // address number table
    mov x1,0                                       // first element
    mov x2,NBELEMENTS                              // number of élements
    bl patienceSort
    ldr x0,qAdrTableNumber                         // address number table
    bl displayTable

    ldr x0,qAdrTableNumber                         // address number table
    mov x1,NBELEMENTS                              // number of élements
    bl isSorted                                    // control sort
    cmp x0,1                                       // sorted ?
    beq 1f
    ldr x0,qAdrszMessSortNok                       // no !! error sort
    bl affichageMess
    b 100f
1:                                                 // yes
    ldr x0,qAdrszMessSortOk
    bl affichageMess
100:                                               // standard end of the program
    mov x0,0                                       // return code
    mov x8,EXIT                                    // request to exit program
    svc 0                                          // perform the system call

qAdrsZoneConv:            .quad sZoneConv
qAdrszCarriageReturn:     .quad szCarriageReturn
qAdrsMessResult:          .quad sMessResult
qAdrTableNumber:          .quad TableNumber
qAdrszMessSortOk:         .quad szMessSortOk
qAdrszMessSortNok:        .quad szMessSortNok
/******************************************************************/
/*     control sorted table                                   */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the number of elements  > 0  */
/* x0 return 0  if not sorted   1  if sorted */
isSorted:
    stp x2,lr,[sp,-16]!             // save  registers
    stp x3,x4,[sp,-16]!             // save  registers
    mov x2,0
    ldr x4,[x0,x2,lsl 3]
1:
    add x2,x2,1
    cmp x2,x1
    bge 99f
    ldr x3,[x0,x2, lsl 3]
    cmp x3,x4
    blt 98f
    mov x4,x3
    b 1b
98:
    mov x0,0                       // not sorted
    b 100f
99:
    mov x0,1                       // sorted
100:
    ldp x3,x4,[sp],16              // restaur  2 registers
    ldp x2,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/******************************************************************/
/*         patience sort                                                   */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains first start index
/* x2 contains the number of elements  */
patienceSort:
    stp x1,lr,[sp,-16]!        // save  registers
    stp x2,x3,[sp,-16]!        // save  registers
    stp x4,x5,[sp,-16]!        // save  registers
    stp x6,x7,[sp,-16]!        // save  registers
    stp x8,x9,[sp,-16]!        // save  registers
    lsl x9,x2,1                // compute total size of piles (2 list pointer by pile )
    lsl x10,x9,3               // 8 bytes by number
    sub sp,sp,x10              // reserve place to stack
    mov fp,sp                  // frame pointer = stack
    mov x3,0                   // index
    mov x4,0
1:
    str x4,[fp,x3,lsl 3]       // init piles area
    add x3,x3,1                // increment index
    cmp x3,x9
    blt 1b
    mov x3,0                   // index value
    mov x4,0                   // counter first pile
    mov x8,x0                  // save table address
2:
    ldr x1,[x8,x3,lsl 3]       // load value
    add x0,fp,x4,lsl 4         // pile address
    bl isEmpty
    cmp x0,0                   // pile empty ?
    bne 3f
    add x0,fp,x4,lsl 4         // pile address
    bl insertHead              // insert value x1
    b 5f
3:
    add x0,fp,x4,lsl 4         // pile address
    ldr x5,[x0,dllist_head]
    ldr x5,[x5,NDlist_value]   // load first list value
    cmp x1,x5                  // compare value and last value on the pile
    blt 4f
    add x0,fp,x4,lsl 4         // pile address
    bl insertHead              // insert value x1
    b 5f
4:                             // value is smaller créate a new pile
    add x4,x4,1
    add x0,fp,x4,lsl 4         // pile address
    bl insertHead              // insert value x1
5:
    add x3,x3,1                // increment index value
    cmp x3,x2                  // end
    blt 2b                     // and loop

    /* step 2 */
    mov x6,0                   // index value table
6:
    mov x3,0                   // index pile
    mov x5, 1<<62              // min
7:                             // search minimum
    add x0,fp,x3,lsl 4
    bl isEmpty
    cmp x0,0
    beq 8f
    add x0,fp,x3,lsl 4
    bl searchMinList
    cmp x0,x5                 // compare min global
    bge 8f
    mov x5,x0                 // smaller -> store new min
    mov x7,x1                 // and pointer to min
    add x9,fp,x3,lsl 4        // and head list
8:
    add x3,x3,1               // next pile
    cmp x3,x4                 // end ?
    ble 7b
    str x5,[x8,x6,lsl 3]      // store min to table value
    mov x0,x9                 // and suppress the value in the pile
    mov x1,x7
    bl suppressNode
    add x6,x6,1               // increment index value
    cmp x6,x2                 // end ?
    blt 6b

    add sp,sp,x10             // stack alignement
100:
    ldp x8,x9,[sp],16         // restaur  2 registers
    ldp x6,x7,[sp],16         // restaur  2 registers
    ldp x4,x5,[sp],16         // restaur  2 registers
    ldp x2,x3,[sp],16         // restaur  2 registers
    ldp x1,lr,[sp],16         // restaur  2 registers
    ret                       // return to address lr x30

/******************************************************************/
/*      Display table elements                                */
/******************************************************************/
/* x0 contains the address of table */
displayTable:
    stp x1,lr,[sp,-16]!              // save  registers
    stp x2,x3,[sp,-16]!              // save  registers
    mov x2,x0                        // table address
    mov x3,0
1:                                   // loop display table
    ldr x0,[x2,x3,lsl 3]
    ldr x1,qAdrsZoneConv
    bl conversion10S                  // décimal conversion
    ldr x0,qAdrsMessResult
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc            // insert result at // character
    bl affichageMess                 // display message
    add x3,x3,1
    cmp x3,NBELEMENTS - 1
    ble 1b
    ldr x0,qAdrszCarriageReturn
    bl affichageMess
    mov x0,x2
100:
    ldp x2,x3,[sp],16               // restaur  2 registers
    ldp x1,lr,[sp],16               // restaur  2 registers
    ret                             // return to address lr x30
/******************************************************************/
/*     list is empty ?                         */
/******************************************************************/
/* x0 contains the address of the list structure */
/* x0 return 0 if empty  else return 1 */
isEmpty:
    ldr x0,[x0,#dllist_head]
    cmp x0,0
    cset x0,ne
    ret                                // return
/******************************************************************/
/*     insert value at list head                        */
/******************************************************************/
/* x0 contains the address of the list structure */
/* x1 contains value */
insertHead:
    stp x1,lr,[sp,-16]!                  // save  registers
    stp x2,x3,[sp,-16]!                  // save  registers
    stp x4,x5,[sp,-16]!                  // save  registers
    mov x4,x0                            // save address
    mov x0,x1                            // value
    bl createNode
    cmp x0,#-1                           // allocation error ?
    beq 100f
    ldr x2,[x4,#dllist_head]             // load address first node
    str x2,[x0,#NDlist_next]             // store in next pointer on new node
    mov x1,#0
    str x1,[x0,#NDlist_prev]             // store zero in previous pointer on new node
    str x0,[x4,#dllist_head]             // store address new node in address head list
    cmp x2,#0                            // address first node is null ?
    beq 1f
    str x0,[x2,#NDlist_prev]             // no store adresse new node in previous pointer
    b 100f
1:
    str x0,[x4,#dllist_tail]             // else store new node in tail address
100:
    ldp x4,x5,[sp],16                    // restaur  2 registers
    ldp x2,x3,[sp],16                    // restaur  2 registers
    ldp x1,lr,[sp],16                    // restaur  2 registers
    ret                                  // return to address lr x30

/******************************************************************/
/*     search value minimum                                               */
/******************************************************************/
/* x0 contains the address of the list structure */
/* x0 return min   */
/* x1 return address of node */
searchMinList:
    stp x2,lr,[sp,-16]!                  // save  registers
    stp x3,x4,[sp,-16]!                  // save  registers
    ldr x0,[x0,#dllist_head]             // load first node
    mov x3,1<<62
    mov x1,0
1:
    cmp x0,0                             // null -> end
    beq 99f
    ldr x2,[x0,#NDlist_value]            // load node value
    cmp x2,x3                            // min ?
    bge 2f
    mov x3,x2                            // value -> min
    mov x1,x0                            // store pointer
2:
    ldr x0,[x0,#NDlist_next]             // load addresse next node
    b 1b                                 // and loop
99:
    mov x0,x3                            // return minimum
100:
    ldp x3,x4,[sp],16                    // restaur  2 registers
    ldp x2,lr,[sp],16                    // restaur  2 registers
    ret                                  // return to address lr x30
/******************************************************************/
/*     suppress node                                               */
/******************************************************************/
/* x0 contains the address of the list structure */
/* x1 contains the address to node to suppress  */
suppressNode:
    stp x2,lr,[sp,-16]!              // save  registers
    stp x3,x4,[sp,-16]!              // save  registers
    ldr x2,[x1,#NDlist_next]         // load addresse next node
    ldr x3,[x1,#NDlist_prev]         // load addresse prev node
    cmp x3,#0
    beq 1f
    str x2,[x3,#NDlist_next]
    b 2f
1:
    str x3,[x0,#NDlist_next]
2:
    cmp x2,#0
    beq 3f
    str x3,[x2,#NDlist_prev]
    b 100f
3:
    str x2,[x0,#NDlist_prev]
100:

    ldp x3,x4,[sp],16               // restaur  2 registers
    ldp x2,lr,[sp],16               // restaur  2 registers
    ret                             // return to address lr x30
/******************************************************************/
/*     Create new node                                            */
/******************************************************************/
/* x0 contains the value */
/* x0 return node address or -1 if allocation error*/
createNode:
    stp x1,lr,[sp,-16]!              // save  registers
    stp x2,x3,[sp,-16]!              // save  registers
    stp x4,x8,[sp,-16]!              // save  registers
    mov x4,x0                        // save value
                                     // allocation place on the heap
    mov x0,0                         // allocation place heap
    mov x8,BRK                       // call system 'brk'
    svc 0
    mov x3,x0                        // save address heap for output string
    add x0,x0,NDlist_fin                // reservation place one element
    mov x8,BRK                       // call system 'brk'
    svc #0
    cmp x0,-1                        // allocation error
    beq 100f
    mov x0,x3
    str x4,[x0,#NDlist_value]        // store value
    mov x2,0
    str x2,[x0,#NDlist_next]         // store zero to pointer next
    str x2,[x0,#NDlist_prev]         // store zero to pointer previous
100:
    ldp x4,x8,[sp],16                // restaur  2 registers
    ldp x2,x3,[sp],16                // restaur  2 registers
    ldp x1,lr,[sp],16                // restaur  2 registers
    ret                              // return to address lr x30
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


----------------------------------------------------------------------

with Ada.Text_IO;

procedure patience_sort_task is
  use Ada.Text_IO;

  function next_power_of_two
   (n : in Natural)
    return Positive is
    -- This need not be a fast implementation.
    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
      --
      -- Bottenbruch search for the leftmost pile whose top is greater
      -- than or equal to some element x. Return an index such that:
      --
      -- * if x is greater than the top element at the far right, then
      --   the index returned will be num-piles.
      --
      -- * otherwise, x is greater than every top element to the left
      --   of index, and less than or equal to the top elements at
      --   index and to the right of index.
      --
      -- References:
      --
      -- * H. Bottenbruch, "Structure and use of ALGOL 60", Journal of
      --   the ACM, Volume 9, Issue 2, April 1962, pp.161-221.
      --   https://doi.org/10.1145/321119.321120
      --
      --   The general algorithm is described on pages 214 and 215.
      --
      -- * https://en.wikipedia.org/w/index.php?title=Binary_search_algorithm&oldid=1062988272#Alternative_procedure
      --
      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
            -- A new pile is needed.
            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
      --
      -- k-way merge by tournament tree.
      --
      -- See Knuth, volume 3, and also
      -- https://en.wikipedia.org/w/index.php?title=K-way_merge_algorithm&oldid=1047851465#Tournament_Tree
      --
      -- However, I store a winners tree instead of the recommended
      -- losers tree. If the tree were stored as linked nodes, it
      -- would probably be more efficient to store a losers
      -- tree. However, I am storing the tree as an array, and one
      -- can find an opponent quickly by simply toggling the least
      -- significant bit of a competitor's array index.
      --
      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

        -- In Fortran I had the length-2 dimension come first, to
        -- take some small advantage of column-major order. The
        -- recommendation for Ada compilers, however, is to use
        -- row-major order. So I have reversed the order.
        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
            -- Record which pile a winner will have come from.
            winners (total_external_nodes - 1 + i, 2) := i;
          end loop;

          for i in 1 .. num_piles loop
            -- The top of each pile becomes a starting competitor.
            winners (total_external_nodes + i - 1, 1) := piles (i);
          end loop;

          for i in 1 .. num_piles loop
            -- Discard the top of each pile
            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);     -- The next top of pile i.
          if next /= 0 then
            piles (i) := links (next); -- Drop that top.
          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

  -- A demonstration.

  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;

----------------------------------------------------------------------


-- In-place patience sort.
on patienceSort(theList, l, r) -- Sort items l thru r of theList.
    set listLen to (count theList)
    if (listLen < 2) then return
    -- Convert any negative and/or transposed range indices.
    if (l < 0) then set l to listLen + l + 1
    if (r < 0) then set r to listLen + r + 1
    if (l > r) then set {l, r} to {r, l}

    script o
        property lst : theList
        property piles : {}
    end script

    -- Build piles.
    repeat with i from l to r
        set v to o's lst's item i
        set unplaced to true
        repeat with thisPile in o's piles
            if (v > thisPile's end) then
            else
                set thisPile's end to v
                set unplaced to false
                exit repeat
            end if
        end repeat
        if (unplaced) then set o's piles's end to {v}
    end repeat

    -- Remove successive lowest end values to the original list.
    set pileCount to (count o's piles)
    repeat with i from l to r
        set min to o's piles's beginning's end
        set minPile to 1
        repeat with j from 2 to pileCount
            set v to o's piles's item j's end
            if (v < min) then
                set min to v
                set minPile to j
            end if
        end repeat

        set o's lst's item i to min
        if ((count o's piles's item minPile) > 1) then
            set o's piles's item minPile to o's piles's item minPile's items 1 thru -2
        else
            set o's piles's item minPile to missing value
            set o's piles to o's piles's lists
            set pileCount to pileCount - 1
        end if
    end repeat

    return -- nothing
end patienceSort
property sort : patienceSort

local aList
set aList to {62, 86, 59, 65, 92, 85, 71, 71, 27, -52, 67, 59, 65, 80, 3, 65, 2, 46, 83, 72, 47, 5, 26, 18, 63}
sort(aList, 1, -1)
return aList