(*
  Stable integer-keyed radix sorts for unsigned and signed integers
  of the various typekinds.

  The radix is 256.
*)

(*------------------------------------------------------------------*)

#include "share/atspre_staload.hats"
staload UN = "prelude/SATS/unsafe.sats"

(*------------------------------------------------------------------*)

extern fn {a  : [email protected]}
          {tk : tkind}
g0uint_radix_sort
          {n   : int}
          (arr : &array (a, n) >> _,
           n   : size_t n)
    :<!wrt> void

extern fn {a  : [email protected]}
          {tk : tkind}
g0uint_radix_sort$key
          {n   : int}
          {i   : nat | i < n}
          (arr : &RD(array (a, n)),
           i   : size_t i)
    :<> g0uint tk

(*------------------------------------------------------------------*)

extern fn {a        : [email protected]}
          {tki, tku : tkind}
g0int_radix_sort
          {n   : int}
          (arr : &array (a, n) >> _,
           n   : size_t n)
    :<!wrt> void

extern fn {a   : [email protected]}
          {tki : tkind}
g0int_radix_sort$key
          {n   : int}
          {i   : nat | i < n}
          (arr : &RD(array (a, n)),
           i   : size_t i)
    :<> g0int tki

(*------------------------------------------------------------------*)

(* WARNING: Much of the following code does NOT take into account
            the linearity of array entries. But this unsafeness is
            hidden from the user. *)

fn {}
bin_sizes_to_indices
          (bin_indices : &array (size_t, 256) >> _)
    :<!wrt> void =
  let
    fun
    loop {i           : int | i <= 256}
         {accum       : int}
         .<256 - i>.
         (bin_indices : &array (size_t, 256) >> _,
          i           : size_t i,
          accum       : size_t accum)
        :<!wrt> void =
      if i <> i2sz 256 then
        let
          prval () = lemma_g1uint_param i
          val elem = bin_indices[i]
        in
          if elem = i2sz 0 then
            loop (bin_indices, succ i, accum)
          else
            begin
              bin_indices[i] := accum;
              loop (bin_indices, succ i, accum + g1ofg0 elem)
            end
        end
  in
    loop (bin_indices, i2sz 0, i2sz 0)
  end

fn {a  : [email protected]}
   {tk : tkind}
count_entries
          {n            : int}
          {shift        : nat}
          (arr          : &RD(array (a, n)),
           n            : size_t n,
           bin_indices  : &array (size_t?, 256)
                          >> array (size_t, 256),
           all_expended : &bool? >> bool,
           shift        : int shift)
    :<!wrt> void =
  let
    fun
    loop {i : int | i <= n}
         .<n - i>.
         (arr          : &RD(array (a, n)),
          bin_indices  : &array (size_t, 256) >> _,
          all_expended : &bool >> bool,
          i            : size_t i)
        :<!wrt> void =
      if i <> n then
        let
          prval () = lemma_g1uint_param i
          val key : g0uint tk = g0uint_radix_sort$key<tk> (arr, i)
          val key_shifted = key >> shift
          val digit = ($UN.cast{uint} key_shifted) land 255U
          val [digit : int] digit = g1ofg0 digit
          extern praxi set_range :
            () -<prf> [0 <= digit; digit <= 255] void
          prval () = set_range ()
          val count = bin_indices[digit]
          val () = bin_indices[digit] := succ count
        in
          all_expended := all_expended * iseqz key_shifted;
          loop (arr, bin_indices, all_expended, succ i)
        end

    prval () = lemma_array_param arr
  in
    array_initize_elt<size_t> (bin_indices, i2sz 256, i2sz 0);
    all_expended := true;
    loop (arr, bin_indices, all_expended, i2sz 0)
  end

fn {a  : [email protected]}
   {tk : tkind}
sort_by_digit
          {n            : int}
          {shift        : nat}
          (arr1         : &RD(array (a, n)),
           arr2         : &array (a, n) >> _,
           n            : size_t n,
           all_expended : &bool? >> bool,
           shift        : int shift)
    :<!wrt> void =
  let
    var bin_indices : array (size_t, 256)
  in
    count_entries<tk> (arr1, n, bin_indices, all_expended, shift);
    if all_expended then
      ()
    else
      let
        fun
        rearrange {i : int | i <= n}
                  .<n - i>.
                  (arr1        : &RD(array (a, n)),
                   arr2        : &array (a, n) >> _,
                   bin_indices : &array (size_t, 256) >> _,
                   i           : size_t i)
            :<!wrt> void =
          if i <> n then
            let
              prval () = lemma_g1uint_param i
              val key = g0uint_radix_sort$key<tk> (arr1, i)
              val key_shifted = key >> shift
              val digit = ($UN.cast{uint} key_shifted) land 255U
              val [digit : int] digit = g1ofg0 digit
              extern praxi set_range :
                () -<prf> [0 <= digit; digit <= 255] void
              prval () = set_range ()
              val [j : int] j = g1ofg0 bin_indices[digit]

              (* One might wish to get rid of this assertion somehow,
                 to eliminate the branch, should it prove a
                 problem. *)
              val () = $effmask_exn assertloc (j < n)

              val p_dst = ptr_add ([email protected] arr2, j)
              and p_src = ptr_add ([email protected] arr1, i)
              val _ = $extfcall (ptr, "memcpy", p_dst, p_src,
                                 sizeof)
              val () = bin_indices[digit] := succ (g0ofg1 j)
            in
              rearrange (arr1, arr2, bin_indices, succ i)
            end

        prval () = lemma_array_param arr1
      in
        bin_sizes_to_indices<> bin_indices;
        rearrange (arr1, arr2, bin_indices, i2sz 0)
      end
  end

fn {a  : [email protected]}
   {tk : tkind}
g0uint_sort {n    : pos}
            (arr1 : &array (a, n) >> _,
             arr2 : &array (a, n) >> _,
             n    : size_t n)
    :<!wrt> void =
  let
    fun
    loop {idigit_max, idigit : nat | idigit <= idigit_max}
         .<idigit_max - idigit>.
         (arr1       : &array (a, n) >> _,
          arr2       : &array (a, n) >> _,
          from1to2   : bool,
          idigit_max : int idigit_max,
          idigit     : int idigit)
        :<!wrt> void =
      if idigit = idigit_max then
        begin
          if ~from1to2 then
            let
              val _ =
                $extfcall (ptr, "memcpy", [email protected] arr1, [email protected] arr2,
                           sizeof * n)
            in
            end
        end
      else if from1to2 then
        let
          var all_expended : bool
        in
          sort_by_digit<tk> (arr1, arr2, n, all_expended,
                                8 * idigit);
          if all_expended then
            ()
          else
            loop (arr1, arr2, false, idigit_max, succ idigit)
        end
      else
        let
          var all_expended : bool
        in
          sort_by_digit<tk> (arr2, arr1, n, all_expended,
                                8 * idigit);
          if all_expended then
            let
              val _ =
                $extfcall (ptr, "memcpy", [email protected] arr1, [email protected] arr2,
                           sizeof * n)
            in
            end
          else
            loop (arr1, arr2, true, idigit_max, succ idigit)
        end
  in
    loop (arr1, arr2, true, sz2i sizeof<g1uint tk>, 0)
  end

#define SIZE_THRESHOLD 256

extern praxi
unsafe_cast_array
          {a   : [email protected]}
          {b   : [email protected]}
          {n   : int}
          (arr : &array (b, n) >> array (a, n))
    :<prf> void

implement {a} {tk}
g0uint_radix_sort {n} (arr, n) =
  if n <> 0 then
    let
      prval () = lemma_array_param arr

      fn
      sort {n    : pos}
           (arr1 : &array (a, n) >> _,
            arr2 : &array (a, n) >> _,
            n    : size_t n)
          :<!wrt> void =
        g0uint_sort<tk> (arr1, arr2, n)
    in
      if n <= SIZE_THRESHOLD then
        let
          var arr2 : array (a, SIZE_THRESHOLD)
          prval @(pf_left, pf_right) =
            array_v_split {a?} {..} {SIZE_THRESHOLD} {n} ([email protected] arr2)
          prval () = [email protected] arr2 := pf_left
          prval () = unsafe_cast_array{a} arr2

          val () = sort (arr, arr2, n)

          prval () = unsafe_cast_array{a?} arr2
          prval () = [email protected] arr2 :=
            array_v_unsplit ([email protected] arr2, pf_right)
        in
        end
      else
        let
          val @(pf_arr2, pfgc_arr2 | p_arr2) = array_ptr_alloc n
          macdef arr2 = !p_arr2
          prval () = unsafe_cast_array{a} arr2

          val () = sort (arr, arr2, n)

          prval () = unsafe_cast_array{a?} arr2
          val () = array_ptr_free (pf_arr2, pfgc_arr2 | p_arr2)
        in
        end
    end

(*------------------------------------------------------------------*)

fn {a        : [email protected]}
   {tki, tku : tkind}
g0int_sort {n   : int}
           (arr : &array (a, n) >> _,
            n   : size_t n)
    :<!wrt> void =
  let
    macdef get_key = g0int_radix_sort$key<tki>
    prval () = lemma_array_param arr
  in
    if n = 0 then
      ()
    else
      let
        val () = $effmask_exn
          assertloc (sizeof<g0int tki> = sizeof<g0uint tku>)

        fn
        find_least_key (arr : &RD(array (a, n)))
            :<> g0int tki =
          let
            fun
            loop {i : int | i <= n}
                 .<n - i>.
                 (arr       : &RD(array (a, n)),
                  least_key : g0int tki,
                  i         : size_t i)
                :<> g0int tki =
              if i <> n then
                let
                  prval () = lemma_g1uint_param i
                  val key = get_key (arr, i)
                in
                  loop (arr, min (least_key, key), succ i)
                end
              else
                least_key
          in
            if n = 0 then
              get_key (arr, i2sz 0)
            else
              let
                val first_key = get_key (arr, i2sz 0)
              in
                loop (arr, first_key, i2sz 1)
              end
          end

        val least_key = find_least_key arr

        (* The offset is the two's complement of the least key. Thus the
           least key is mapped to zero and the order of keys is
           preserved. *)
        val offset = succ (lnot ($UN.cast{g1uint tku} least_key))

        implement
        g0uint_radix_sort$key<tku> (arr, i) =
          let
            val keyi = get_key (arr, i)
          in
            g0i2u keyi + offset
          end
      in
        g0uint_radix_sort<tku> (arr, n)
      end
  end

implement {a} {tki, tku}
g0int_radix_sort (arr, n) =
  g0int_sort<tki, tku> (arr, n)

(*------------------------------------------------------------------*)

implement
main0 () =
  let
    implement
    g0int_radix_sort$key<int><intknd> (arr, i) =
      arr[i]

    var arr : array (int, 10)
    val () =
      array_initize_list<int>
        (arr, 10, $list (1, 2, 1, ~2, 330, 5000, 16, ~20000, 1, 2))
    val () = g0int_radix_sort<int><intknd, uintknd> (arr, i2sz 10)
    val () = println! (list_vt2t (array2list (arr, i2sz 10)))
  in
  end

(*------------------------------------------------------------------*)


Radix_Sort(data){
	loop, parse, data, `,
		n := StrLen(A_LoopField)>n?StrLen(A_LoopField):n
	loop % n {
		bucket := []	,	i := A_Index
		loop, parse, data, `,
			bucket[SubStr(A_LoopField,1-i)] .= (bucket[SubStr(A_LoopField,1-i)]?",":"") A_LoopField
		data := ""
		for i, v in bucket
			data .= (data?",":"") v
	}
	return data
}


Sub RadixSort (Old() As Int)
	Dim i, j As Int
	Dim tmp(Old.Length) As Int
	For shift = 31 To 0 Step - 1
		j = 0
		For i = 0 To Old.Length - 1
			Dim move As Boolean = Bit.ShiftLeft(Old(i), shift) >= 0
			If (shift = 0 And move = False) Or (shift <> 0 And move) Then
				Old(i - j) = Old(i)
			Else
				tmp(j) = Old(i)
				j = j + 1
			End If
		Next
		Bit.ArrayCopy(tmp, 0, Old, Old.Length - j, j)
	Next
End Sub

Sub Test
	Dim arr() As Int = Array As Int(34, 23, 54, -123, 543, 123)
	RadixSort(arr)
	For Each i As Int In arr
		Log(i)
	Next
End Sub


      DIM test%(9)
      test%() = 4, 65, 2, -31, 0, 99, 2, 83, 782, 1
      PROCradixsort(test%(), 10, 10)
      FOR i% = 0 TO 9
        PRINT test%(i%) ;
      NEXT
      PRINT
      END

      DEF PROCradixsort(a%(), n%, r%)
      LOCAL d%, e%, i%, l%, m%, b%(), bucket%()
      DIM b%(n%-1), bucket%(r%-1)
      FOR i% = 0 TO n%-1
        IF a%(i%) < l% l% = a%(i%)
        IF a%(i%) > m% m% = a%(i%)
      NEXT
      a%() -= l%
      m% -= l%
      e% = 1
      WHILE m% DIV e%
        bucket%() = 0
        FOR i% = 0 TO n%-1
          bucket%(a%(i%) DIV e% MOD r%) += 1
        NEXT
        FOR i% = 1 TO r%-1
          bucket%(i%) += bucket%(i% - 1)
        NEXT
        FOR i% = n%-1 TO 0 STEP -1
          d% = a%(i%) DIV e% MOD r%
          bucket%(d%) -= 1
          b%(bucket%(d%)) = a%(i%)
        NEXT
        a%() = b%()
        e% *= r%
      ENDWHILE
      a%() += l%
      ENDPROC


#include <stdio.h>
#include <limits.h>
#include <stdlib.h>
#include <time.h>

// Get size of statically allocated array
#define ARR_LEN(ARR) (sizeof ARR / sizeof *ARR)
// Generate random number in the interval [M,N]
#define RAND_RNG(M,N) (M + rand() / (RAND_MAX / (N - M + 1) + 1));

static void swap(unsigned *a, unsigned *b) {
    unsigned tmp = *a;
    *a = *b;
    *b = tmp;
}

/* sort unsigned ints */
static void rad_sort_u(unsigned *from, unsigned *to, unsigned bit)
{
	if (!bit || to < from + 1) return;

	unsigned *ll = from, *rr = to - 1;
	for (;;) {
		/* find left most with bit, and right most without bit, swap */
		while (ll < rr && !(*ll & bit)) ll++;
		while (ll < rr &&  (*rr & bit)) rr--;
		if (ll >= rr) break;
		swap(ll, rr);
	}

	if (!(bit & *ll) && ll < to) ll++;
	bit >>= 1;

	rad_sort_u(from, ll, bit);
	rad_sort_u(ll, to, bit);
}

/* sort signed ints: flip highest bit, sort as unsigned, flip back */
static void radix_sort(int *a, const size_t len)
{
	size_t i;
	unsigned *x = (unsigned*) a;

	for (i = 0; i < len; i++)
            x[i] ^= INT_MIN;

        rad_sort_u(x, x + len, INT_MIN);

        for (i = 0; i < len; i++)
            x[i] ^= INT_MIN;
}

int main(void)
{

    srand(time(NULL));
    int x[16];

     for (size_t i = 0; i < ARR_LEN(x); i++)
        x[i] = RAND_RNG(-128,127)

    radix_sort(x, ARR_LEN(x));

    for (size_t i = 0; i < ARR_LEN(x); i++)
        printf("%d%c", x[i], i + 1 < ARR_LEN(x) ? ' ' : '\n');
}


using System;

namespace RadixSort
{
    class Program
    {
        static void Sort(int[] old)
        {
            int i, j;
            int[] tmp = new int[old.Length];
            for (int shift = 31; shift > -1; --shift)
            {
                j = 0;
                for (i = 0; i < old.Length; ++i)
                {
                    bool move = (old[i] << shift) >= 0;
                    if (shift == 0 ? !move : move)  // shift the 0's to old's head
                        old[i-j] = old[i];
                    else                            // move the 1's to tmp
                        tmp[j++] = old[i];
                }
                Array.Copy(tmp, 0, old, old.Length-j, j);
            }
        }
        static void Main(string[] args)
        {
            int[] old = new int[] { 2, 5, 1, -3, 4 };
            Console.WriteLine(string.Join(", ", old));
            Sort(old);
            Console.WriteLine(string.Join(", ", old));
            Console.Read();
        }
    }
}


#include <algorithm>
#include <iostream>
#include <iterator>

// Radix sort comparator for 32-bit two's complement integers
class radix_test
{
    const int bit; // bit position [0..31] to examine
public:
    radix_test(int offset) : bit(offset) {} // constructor

    bool operator()(int value) const // function call operator
    {
        if (bit == 31) // sign bit
            return value < 0; // negative int to left partition
        else
            return !(value & (1 << bit)); // 0 bit to left partition
    }
};

// Least significant digit radix sort
void lsd_radix_sort(int *first, int *last)
{
    for (int lsb = 0; lsb < 32; ++lsb) // least-significant-bit
    {
        std::stable_partition(first, last, radix_test(lsb));
    }
}

// Most significant digit radix sort (recursive)
void msd_radix_sort(int *first, int *last, int msb = 31)
{
    if (first != last && msb >= 0)
    {
        int *mid = std::partition(first, last, radix_test(msb));
        msb--; // decrement most-significant-bit
        msd_radix_sort(first, mid, msb); // sort left partition
        msd_radix_sort(mid, last, msb); // sort right partition
    }
}

// test radix_sort
int main()
{
    int data[] = { 170, 45, 75, -90, -802, 24, 2, 66 };

    lsd_radix_sort(data, data + 8);
    // msd_radix_sort(data, data + 8);

    std::copy(data, data + 8, std::ostream_iterator<int>(std::cout, " "));

    return 0;
}


import std.stdio, std.math, std.traits, std.range, std.algorithm;

ElementType!R[] radixSort(size_t N=10, R)(R r)
if (hasLength!R && isRandomAccessRange!R &&
    isIntegral!(ElementType!R)) {
    alias ElementType!R E;

    static if (isDynamicArray!R)
        alias r res;         // input is array => in place sort
    else
        E[] res = r.array(); // input is Range => return a new array

    E absMax = r.map!abs().reduce!max();
    immutable nPasses = 1 + cast(int)(log(absMax) / log(N));

    foreach (pass; 0 .. nPasses) {
        auto bucket = new E[][](2 * N - 1, 0);
        foreach (v; res) {
            int bIdx = abs(v / (N ^^ pass)) % N;
            bIdx = (v < 0) ? -bIdx : bIdx;
            bucket[N + bIdx - 1] ~= v;
        }
        res = bucket.join();
    }

    return res;
}

void main() {
    auto items = [170, 45, 75, -90, 2, 24, -802, 66];
    items.radixSort().writeln();
    items.map!q{1 - a}().radixSort().writeln();
}


# Radix sort - sorts positive integers
#
func sort . data[] .
  radix = 10
  for d in data[]
    max = higher d max
  .
  len buck[][] radix
  pos = 1
  while pos <= max
    for i range radix
      buck[i][] = [ ]
    .
    for d in data[]
      h = d / pos mod radix
      buck[h][] &= d
    .
    di = 0
    for i range radix
      for d in buck[i][]
        data[di] = d
        di += 1
      .
    .
    pos *= radix
  .
.
data[] = [ 29 4 72 44 55 26 27 77 92 5 ]
call sort data[]
print data[]


class
	RADIX_SORT

feature

	radix_sort (ar: ARRAY [INTEGER])
			-- Array 'ar' sorted in ascending order.
		require
			ar_not_void: ar /= Void
			not_negative: across ar as a all a.item >= 0 end
		local
			bucket_1, bucket_0: LINKED_LIST [INTEGER]
			j, k, dig: INTEGER
		do
			create bucket_0.make
			create bucket_1.make
			dig := digits (ar)
			across
				0 |..| dig as c
			loop
				across
					ar as r
				loop
					if r.item.bit_test (c.item) then
						bucket_1.extend (r.item)
					else
						bucket_0.extend (r.item)
					end
				end
				from
					j := 1
				until
					j > bucket_0.count
				loop
					ar [j] := bucket_0 [j]
					j := j + 1
				end
				from
					k := j
					j := 1
				until
					j > bucket_1.count
				loop
					ar [k] := bucket_1 [j]
					k := k + 1
					j := j + 1
				end
				bucket_0.wipe_out
				bucket_1.wipe_out
			end
		ensure
			is_sorted: is_sorted (ar)
		end

feature {NONE}

	digits (ar: ARRAY [INTEGER]): INTEGER
			-- Number of digits of the largest item in 'ar'.
		local
			max: INTEGER
			math: DOUBLE_MATH
		do
			create math
			across
				ar as a
			loop
				if a.item > max then
					max := a.item
				end
			end
			Result := math.log_2 (max).ceiling + 1
		end

	is_sorted (ar: ARRAY [INTEGER]): BOOLEAN
			--- Is 'ar' sorted in ascending order?
		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

end


defmodule Sort do
  def radix_sort(list), do: radix_sort(list, 10)

  def radix_sort([], _), do: []
  def radix_sort(list, base) do
    max = abs(Enum.max_by(list, &abs(&1)))
    sorted = radix_sort(list, base, max, 1)
    {minus, plus} = Enum.partition(sorted, &(&1<0))
    Enum.reverse(minus, plus)
  end

  defp radix_sort(list, _, max, m) when max<m, do: list
  defp radix_sort(list, base, max, m) do
    buckets = List.to_tuple(for _ <- 0..base-1, do: [])
    bucket2 = Enum.reduce(list, buckets, fn x,acc ->
      i = abs(x) |> div(m) |> rem(base)
      put_elem(acc, i, [x | elem(acc, i)])
    end)
    list2 = Enum.reduce(base-1..0, [], fn i,acc -> Enum.reverse(elem(bucket2, i), acc) end)
    radix_sort(list2, base, max, m*base)
  end
end

IO.inspect Sort.radix_sort([-4, 5, -26, 58, -990, 331, 331, 990, -1837, 2028])


      SUBROUTINE VARRADIX(A , Siz)

!
!	No Copyright is exerted due to considerable prior art in the Public Domain.
!       This Fortran version by Peter Kelly ~ [email protected]
!
!	Permission is hereby granted, free of charge, to any person obtaining
!	a copy of this software and associated documentation files (the
!	"Software"), to deal in the Software without restriction, including
!	without limitation the rights to use, copy, modify, merge, publish,
!	distribute, sublicense, and/or sell copies of the Software, and to
!	permit persons to whom the Software is furnished to do so, subject to
!	the following conditions:
!	The above copyright notice and this permission notice shall be
!	included in all copies or substantial portions of the Software.
!	THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
!	EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
!	MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
!	IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
!	CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
!	TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
!	SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
!
!
!     LSD sort with a configurable RADIX, Using a RADIX of 256 performs well, hence I have defaulted it in. It is snarly fast.
!     It could be optimized by merging the two routines but this way gives greater clarity as to what's going on.
      IMPLICIT NONE
!
! PARAMETER definitions
!
      INTEGER , PARAMETER  ::  BASE = 256 ! whatever base you need, just change this
!
! Dummy arguments
!
      INTEGER  ::  Siz
      INTEGER , DIMENSION(Siz)  ::  A
!
! Local variables
!
      INTEGER , ALLOCATABLE , DIMENSION(:)  ::  b
      INTEGER , ALLOCATABLE , DIMENSION(:)  ::  c
      INTEGER  ::  exps
      INTEGER  ::  maxs
!
      ALLOCATE(b(Siz))
      ALLOCATE(c(BASE))

      exps = 1
      maxs = MAXVAL(A)
      DO WHILE ( (maxs/exps)>0 )
         CALL XXCOUNTING_SORT(A , Siz , exps , BASE , b , c)
         exps = exps*BASE
      END DO
      deallocate(C)
      deallocate(B)
      RETURN
      CONTAINS
!
!//b is the base you want
!//exp is the value used for the division
      SUBROUTINE XXCOUNTING_SORT(A , Siz , Exps , Base , B , C)
      IMPLICIT NONE
! I used zero based arrays as it made the calcs infinitely easier :)
!
! Dummy arguments
!
      INTEGER  ::  Base
      INTEGER  ::  Exps
      INTEGER  ::  Siz    ! Size
      INTEGER , DIMENSION(0:)  ::  A
      INTEGER , DIMENSION(0:)  ::  B
      INTEGER , DIMENSION(0:)  ::  C
      INTENT (IN) Base , Exps , Siz
      INTENT (INOUT) A , B , C
!
! Local variables
!
      INTEGER  ::  i
      INTEGER  ::  k
!
      C = 0                             ! Init the arrays
      B = 0
!
      DO i = 0 , Siz - 1 , 1
         k = MOD((A(i)/Exps) , Base)    ! Fill Histo
         C(k) = C(k) + 1
      END DO
!
      DO i = 1 , Base - 1 , 1
         C(i) = C(i) + C(i - 1)         ! Build cumulative Histo
      END DO
!
      DO i = Siz - 1 , 0 , -1
         k = MOD(A(i)/Exps , Base)      ! Load the Buffer Array in order
         B(C(k) - 1) = A(i)
         C(k) = C(k) - 1
      END DO
!
      DO i = 0 , Siz - 1 , 1              ! Copy across
         A(i) = B(i)
      END DO
      RETURN
      END SUBROUTINE XXCOUNTING_SORT
    END SUBROUTINE Varradix
!***************************************************************************
!                            End of LSD sort with any Radix
!***************************************************************************
      MODULE LEASTSIG
      IMPLICIT NONE
!
!	No Copyright is exerted due to considerable prior art in the Public Domain.
!       This Fortran version by Peter Kelly ~ [email protected]
!
!	Permission is hereby granted, free of charge, to any person obtaining
!	a copy of this software and associated documentation files (the
!	"Software"), to deal in the Software without restriction, including
!	without limitation the rights to use, copy, modify, merge, publish,
!	distribute, sublicense, and/or sell copies of the Software, and to
!	permit persons to whom the Software is furnished to do so, subject to
!	the following conditions:
!	The above copyright notice and this permission notice shall be
!	included in all copies or substantial portions of the Software.
!	THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
!	EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
!	MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
!	IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
!	CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
!	TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
!	SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
!
!     Implementation of a classic Radix Sort LSD style :)
!     Works well, Integers only but it goes faster than a comparison sort
      CONTAINS

! Main Radix Sort sort function
      SUBROUTINE LSDRADIXSORT(A , N)
      IMPLICIT NONE
!
! Dummy arguments
!
      INTEGER  ::  N
      INTEGER , target, DIMENSION(0:N - 1)  ::  A           ! All arrays based off zero, one day I'll fix it
      INTENT (IN) N
      INTENT (INOUT) A
!
! Local variables
!
      INTEGER , DIMENSION(0:9)  ::  counts
      INTEGER  ::  digitplace
      INTEGER  ::  i
      INTEGER  ::  j
      INTEGER  ::  largestnum
      INTEGER, DIMENSION(0:N - 1)  ::  results
!
      digitplace = 1                                        ! Count of the keys
      largestnum = MAXVAL(A)

      DO WHILE ( (largestnum/digitplace)>0 )
         counts = 0                                         ! Init the count array
        DO i = 0 , N - 1 , 1
            J = (A(i)/digitplace)
            J = MODULO(j , 10)
            counts(j) = counts(j) + 1
        END DO

!  Change count(i) so that count(i) now contains actual position of this digit in result()
!  Working similar to the counting sort algorithm
         DO i = 1 , 9 , 1
            counts(i) = counts(i) + counts(i - 1)       ! Build up the prefix sum
         END DO
!
         DO i = N - 1 , 0 , -1                          ! Move from left to right
            j = (A(i)/digitplace)
            j = MODULO(j, 10)
            results(counts(j) - 1) = A(i)               ! Need to subtract one as we are zero based but prefix sum is 1 based
            counts(j) = counts(j) - 1
         END DO
!
         DO i = 0 , N - 1 , 1                           ! Copy the semi-sorted data into the input
           A(i) = results(i)
         END DO
!
         digitplace = digitplace*10
      END DO                                             ! While loop
      RETURN
      END SUBROUTINE LSDRADIXSORT
      END MODULE LEASTSIG
!***************************************************************************
!                            End of Classic LSD sort with Radix 10
!***************************************************************************
!Superfast FORTRAN LSD sort
! Dataset is input array, Scratch is working array
!
      SUBROUTINE FASTLSDRAD(Dataset , Scratch , Dsize)
!
!	No Copyright is exerted due to considerable prior art in the Public Domain.
!       This Fortran version by Peter Kelly ~ [email protected]
!
!	Permission is hereby granted, free of charge, to any person obtaining
!	a copy of this software and associated documentation files (the
!	"Software"), to deal in the Software without restriction, including
!	without limitation the rights to use, copy, modify, merge, publish,
!	distribute, sublicense, and/or sell copies of the Software, and to
!	permit persons to whom the Software is furnished to do so, subject to
!	the following conditions:
!	The above copyright notice and this permission notice shall be
!	included in all copies or substantial portions of the Software.
!	THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
!	EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
!	MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
!	IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
!	CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
!	TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
!	SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
!
!     This LSD sort is optimized to a base 16,Radix 256 sort which is about as fast as LSD gets. As well as a fast
!     algorithm, it has great cache coherency so performs exceptionally on large data sets,
!     I have optimized out all the divide and modulus functions and replaced them with bit shifts for speed.
!     A further speed optimization is obtained by using pointers to the DATA and TEMP arrays and swapping them each pass of
!     the LSB calculation. In FORTRAN this is a bit clunky but much faster than copying data back and forth between arrays.
!
!     All arrays are zero based as this makes the indexing calculations straightforward without the need for
!     subsequent adds and subtracts to track the correct index
!         .
      IMPLICIT NONE
!
! Dummy arguments
!
      INTEGER  ::  Dsize
      INTEGER , TARGET , DIMENSION(0:Dsize - 1)  ::  Scratch    ! Declared as TARGET as we will manipulate with pointers
      INTEGER , TARGET , DIMENSION(0:Dsize - 1)  ::  Dataset
      INTENT (IN) Dsize
      INTENT (INOUT) Scratch , Dataset
!
! Local variables
!
      INTEGER , POINTER , DIMENSION(:)  ::  a                   ! The pointer to the data
      INTEGER , POINTER , DIMENSION(:)  ::  b                   ! The pointer to the buffer
      INTEGER  ::  i
      INTEGER  ::  j
      INTEGER  ::  m
      INTEGER , DIMENSION(0:255,0:3)  ::  stats_table
      INTEGER  ::  n
      LOGICAL  ::  swap
      INTEGER  ::  u

!
      stats_table = 0                                           !   index matrix
      swap = .TRUE.                                             !   For swapping pointers
!
      a => Dataset
      b => Scratch
!
      DO i = 0 , Dsize - 1 , 1                                  ! generate histograms
         u = a(i)
         DO j = 0 , 3 , 1
            n = IAND(u , z'FF')
            u = SHIFTR(u , 8)
            stats_table(n,j) = stats_table(n,j) + 1
         END DO
      END DO
!
      DO i = 0 , 3 , 1                                          ! convert to indices
         m = 0
         DO j = 0 , 255 , 1
            n = stats_table(j , i)
            stats_table(j , i) = m
            m = m + n
         END DO
      END DO
!
      DO j = 0 , 3 , 1                                          ! Radix Sort, sort by LSB
         DO i = 0 , Dsize - 1 , 1
            u = a(i)
            m = IAND(SHIFTR(u,SHIFTL(j,3)) , z'FF')             ! Eliminate the MOD 16 and div with shifts
            b(stats_table(m,j)) = u                             ! Push the data into the buffer
            stats_table(m,j) = stats_table(m,j) + 1
         END DO
!
!        Instead of copying back from the temp values swap the array pointers
!
         IF( swap )THEN
            a => Scratch                                        ! A now points to the b buffer
            b => Dataset                                        ! B now is the data set
         ELSE
            a => Dataset
            b => Scratch
         END IF
         swap = .NOT.swap                                       ! Set to swap back and forth every pass
      END DO
 !
      RETURN
      END SUBROUTINE FASTLSDRAD
!***************************************************************************
!                            End of Superfast LSD sort
!***************************************************************************
*=======================================================================
* RSORT - sort a list of integers by the Radix Sort algorithm
* Public domain.  This program may be used by any person for any purpose.
* Origin:  Herman Hollerith, 1887
*
*___Name____Type______In/Out____Description_____________________________
*   IX(N)   Integer   Both      Array to be sorted in increasing order
*   IW(N)   Integer   Neither   Workspace
*   N       Integer   In        Length of array
*
* ASSUMPTIONS:  Bits in an INTEGER is an even number.
*               Integers are represented by twos complement.
*
* NOTE THAT:  Radix sorting has an advantage when the input is known
*             to be less than some value, so that only a few bits need
*             to be compared.  This routine looks at all the bits,
*             and is thus slower than Quicksort.
*=======================================================================
      SUBROUTINE RSORT (IX, IW, N)
       IMPLICIT NONE
       INTEGER IX, IW, N
       DIMENSION IX(N), IW(N)

       INTEGER I,                        ! count bits
     $         ILIM,                     ! bits in an integer
     $         J,                        ! count array elements
     $         P1OLD, P0OLD, P1, P0,     ! indices to ones and zeros
     $         SWAP
       LOGICAL ODD                       ! even or odd bit position

*      IF (N < 2) RETURN      ! validate
*
        ILIM = Bit_size(i)    !Get the fixed number of bits
*=======================================================================
* Alternate between putting data into IW and into IX
*=======================================================================
       P1 = N+1
       P0 = N                ! read from 1, N on first pass thru
       ODD = .FALSE.
       DO I = 0, ILIM-2
         P1OLD = P1
         P0OLD = P0         ! save the value from previous bit
         P1 = N+1
         P0 = 0                 ! start a fresh count for next bit

         IF (ODD) THEN
           DO J = 1, P0OLD, +1             ! copy data from the zeros
             IF ( BTEST(IW(J), I) ) THEN
               P1 = P1 - 1
               IX(P1) = IW(J)
             ELSE
               P0 = P0 + 1
               IX(P0) = IW(J)
             END IF
           END DO
           DO J = N, P1OLD, -1             ! copy data from the ones
             IF ( BTEST(IW(J), I) ) THEN
               P1 = P1 - 1
               IX(P1) = IW(J)
             ELSE
               P0 = P0 + 1
              IX(P0) = IW(J)
             END IF
           END DO

         ELSE
           DO J = 1, P0OLD, +1             ! copy data from the zeros
             IF ( BTEST(IX(J), I) ) THEN
               P1 = P1 - 1
               IW(P1) = IX(J)
              ELSE
               P0 = P0 + 1
               IW(P0) = IX(J)
             END IF
           END DO
           DO J = N, P1OLD, -1            ! copy data from the ones
             IF ( BTEST(IX(J), I) ) THEN
               P1 = P1 - 1
               IW(P1) = IX(J)
             ELSE
               P0 = P0 + 1
               IW(P0) = IX(J)
             END IF
          END DO
         END IF  ! even or odd i

         ODD = .NOT. ODD
       END DO  ! next i

*=======================================================================
*        the sign bit
*=======================================================================
       P1OLD = P1
       P0OLD = P0
       P1 = N+1
       P0 = 0

*          if sign bit is set, send to the zero end
       DO J = 1, P0OLD, +1
         IF ( BTEST(IW(J), ILIM-1) ) THEN
           P0 = P0 + 1
           IX(P0) = IW(J)
         ELSE
           P1 = P1 - 1
           IX(P1) = IW(J)
         END IF
       END DO
       DO J = N, P1OLD, -1
         IF ( BTEST(IW(J), ILIM-1) ) THEN
           P0 = P0 + 1
           IX(P0) = IW(J)
         ELSE
           P1 = P1 - 1
           IX(P1) = IW(J)
         END IF
       END DO

*=======================================================================
*       Reverse the order of the greater value partition
*=======================================================================
       P1OLD = P1
       DO J = N, (P1OLD+N)/2+1, -1
         SWAP = IX(J)
         IX(J) = IX(P1)
         IX(P1) = SWAP
         P1 = P1 + 1
       END DO
       RETURN
      END ! of RSORT

***********************************************************************
*         test program
***********************************************************************
      PROGRAM t_sort
       IMPLICIT NONE
       INTEGER I, N
       PARAMETER (N = 11)
       INTEGER IX(N), IW(N)
       LOGICAL OK

       DATA IX / 2, 24, 45, 0, 66, 75, 170, -802, -90, 1066, 666 /

       PRINT *, 'before: ', IX
       CALL RSORT (IX, IW, N)
       PRINT *, 'after: ', IX

*              compare
       OK = .TRUE.
       DO I = 1, N-1
         IF (IX(I) > IX(I+1)) OK = .FALSE.
       END DO
       IF (OK) THEN
         PRINT *, 't_sort: successful test'
       ELSE
         PRINT *, 't_sort: failure!'
       END IF
      END ! of test program


package main

import (
    "bytes"
    "encoding/binary"
    "fmt"
)

// declarations for word size of data
type word int32
const wordLen = 4
const highBit = -1 << 31

var data = []word{170, 45, 75, -90, -802, 24, 2, 66}

func main() {
    buf := bytes.NewBuffer(nil)
    ds := make([][]byte, len(data))
    for i, x := range data {
        binary.Write(buf, binary.LittleEndian, x^highBit)
        b := make([]byte, wordLen)
        buf.Read(b)
        ds[i] = b
    }
    bins := make([][][]byte, 256)
    for i := 0; i < wordLen; i++ {
        for _, b := range ds {
            bins[b[i]] = append(bins[b[i]], b)
        }
        j := 0
        for k, bs := range bins {
            copy(ds[j:], bs)
            j += len(bs)
            bins[k] = bs[:0]
        }
    }
    fmt.Println("original:", data)
    var w word
    for i, b := range ds {
        buf.Write(b)
        binary.Read(buf, binary.LittleEndian, &w)
        data[i] = w^highBit
    }
    fmt.Println("sorted:  ", data)
}


V tutor = 1B

F pancakesort(&data)
   I data.len <= 1
      R
   I :tutor
      print()
   L(size) (data.len .< 1).step(-1)
      V maxindex = max(0 .< size, key' x -> @data[x])
      I maxindex + 1 != size
         I maxindex != 0
            I :tutor
               print(‘With: #. doflip  #.’.format(data.map(x -> String(x)).join(‘ ’), maxindex + 1))
            data.reverse_range(0 .< maxindex + 1)
         I :tutor
            print(‘With: #.  doflip #.’.format(data.map(x -> String(x)).join(‘ ’), size))
         data.reverse_range(0 .< size)
   I :tutor
      print()

V data = ‘6 7 2 1 8 9 5 3 4’.split(‘ ’)
print(‘Original List: ’data.join(‘ ’))
pancakesort(&data)
print(‘Pancake Sorted List: ’data.join(‘ ’))


def radixSort = { final radixExponent, list ->
    def fromBuckets = new TreeMap([0:list])
    def toBuckets = new TreeMap()
    final radix = 2**radixExponent
    final mask = radix - 1
    final radixDigitSize = (int)Math.ceil(64/radixExponent)
    final digitWidth = radixExponent
    (0..<radixDigitSize).each { radixDigit ->
        fromBuckets.values().findAll { it != null }.flatten().each {
            print '.'
            long bucketNumber = (long)((((long)it) >>> digitWidth*radixDigit) & mask)
            toBuckets[bucketNumber] = toBuckets[bucketNumber] ?: []
            toBuckets[bucketNumber] << it
        }
        (fromBuckets, toBuckets) = [toBuckets, fromBuckets]
        toBuckets.clear()
    }
    final overflow = 2**(63 % radixExponent)
    final pos = {it < overflow}
    final neg = {it >= overflow}
    final keys = fromBuckets.keySet()
    final twosComplIndx = [] + (keys.findAll(neg)) + (keys.findAll(pos))
    twosComplIndx.collect { fromBuckets[it] }.findAll { it != null }.flatten()
}


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

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

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessSortOk:       .asciz "Table sorted.\n"
szMessSortNok:      .asciz "Table not sorted !!!!!.\n"
sMessResult:        .asciz "Value  : @ \n"
sMessCounter:       .asciz "sorted in  @ flips \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 pancakeSort
    ldr x0,qAdrTableNumber                         // address number table
    bl displayTable
    mov x0,x10                                     // display counter
    ldr x1,qAdrsZoneConv
    bl conversion10S                               // décimal conversion
    ldr x0,qAdrsMessCounter
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc                          // insert result at @ character
    bl affichageMess                               // display message
    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
qAdrsMessCounter:         .quad sMessCounter
/******************************************************************/
/*     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

/******************************************************************/
/*         flip                                                   */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains first start index
/* x2 contains the number of elements  */
/* x3 contains the position of flip   */
flip:
    //push {r1-r6,lr}             // save registers
    stp x1,lr,[sp,-16]!           // save  registers
    stp x2,x3,[sp,-16]!           // save  registers
    stp x4,x5,[sp,-16]!           // save  registers
    str x6,   [sp,-16]!           // save  registers
    add x10,x10,#1                // flips counter
    cmp x3,x2
    sub x4,x2,1
    csel x3,x4,x3,ge               // last index if position >= size
1:
    cmp x1,x3
    bge 100f
    ldr x5,[x0,x1,lsl 3]         // load value first  index
    ldr x6,[x0,x3,lsl 3]         // load value position index
    str x6,[x0,x1,lsl 3]         // inversion
    str x5,[x0,x3,lsl 3]         //
    sub x3,x3,1
    add x1,x1,1
    b 1b
100:
    ldr x6,   [sp],16              // restaur  1 register
    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
/******************************************************************/
/*         pancake sort                                                   */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains first start index
/* x2 contains the number of elements  */
pancakeSort:
    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
    sub x7,x2,1                // last index
1:
    mov x5,x1                  // index
    mov x4,0                   // max
    mov x3,0                   // position
    mov x8,1                   // top sorted
    ldr x9,[x0,x5,lsl 3]       // load value A[i-1]
2:
    ldr x6,[x0,x5,lsl 3]       // load value
    cmp x6,x4                  // compare max
    csel x4,x6,x4,ge           // max = A[i}
    csel x3,x5,x3,ge           // position = index
    cmp x6,x9                  // cmp A[i] A[i-1] sorted ?
    csel x8,xzr,x8,lt          // no
    mov x9,x6                  //  A[i-1] = A[i]
    add x5,x5,1                // increment index
    cmp x5,x7                  // end ?
    ble 2b
    cmp x8,1                   // sorted ?
    beq 100f                   // yes -> end
    cmp x3,x7                  // position ok ?
    beq 4f                     // yes
    cmp x3,0                   // first position ?
    beq 3f
    bl flip                    // flip if not greather in first position
3:
    mov x3,x7                  // and flip the whole stack
    bl flip
4:
    //bl displayTable          // to display an intermediate state
    subs x7,x7,1               // decrement number of pancake
    bge 1b                     // and loop
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
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


PROC PrintArray(INT ARRAY a INT size)
  INT i

  Put('[)
  FOR i=0 TO size-1
  DO
    IF i>0 THEN Put(' ) FI
    PrintI(a(i))
  OD
  Put(']) PutE()
RETURN

PROC Flip(INT ARRAY a INT last)
  INT i,n,tmp

  n=(last-1)/2
  FOR i=0 TO n
  DO
    tmp=a(i)
    a(i)=a(last-i)
    a(last-i)=tmp
  OD
RETURN

PROC PancakeSort(INT ARRAY a INT size)
  INT i,j,maxpos

  i=size-1
  WHILE i>=0
  DO
    maxpos=i
    FOR j=0 TO i-1
    DO
      IF a(j)>a(maxpos) THEN
        maxpos=j
      FI
    OD

    IF maxpos#i THEN
      IF maxpos#0 THEN
        Flip(a,maxpos)
      FI
      Flip(a,i)
    FI

    i==-1
  OD
RETURN

PROC Test(INT ARRAY a INT size)
  PrintE("Array before sort:")
  PrintArray(a,size)
  PancakeSort(a,size)
  PrintE("Array after sort:")
  PrintArray(a,size)
  PutE()
RETURN

PROC Main()
  INT ARRAY
    a(10)=[1 4 65535 0 3 7 4 8 20 65530],
    b(21)=[10 9 8 7 6 5 4 3 2 1 0
      65535 65534 65533 65532 65531
      65530 65529 65528 65527 65526],
    c(8)=[101 102 103 104 105 106 107 108],
    d(12)=[1 65535 1 65535 1 65535 1
      65535 1 65535 1 65535]

  Test(a,10)
  Test(b,21)
  Test(c,8)
  Test(d,12)
RETURN


with Ada.Text_IO;
procedure Pancake_Sort is
   generic
      type Element_Type is private;
      type Index_Type is range <>;
      type Array_Type is array (Index_Type range <>) of Element_Type;
      with function ">" (Left, Right : Element_Type) return Boolean is <>;
   procedure Pancake_Sort (Data: in out Array_Type);

   procedure Pancake_Sort (Data: in out Array_Type) is
      procedure Flip (Up_To : in Index_Type) is
         Temp : constant Array_Type := Data (Data'First .. Up_To);
      begin
         for I in Temp'Range loop
            Data (I) := Temp (Temp'First + Up_To - I);
         end loop;
      end Flip;
      Max_Index : Index_Type;
   begin
      for I in reverse Data'First + 1 .. Data'Last loop
         Max_Index := Data'First;
         for A in Data'First + 1 .. I loop
            if Data(A) > Data (Max_Index) then
               Max_Index := A;
            end if;
         end loop;
         if Max_Index /= I then
            if Max_Index > Data'First then
               Flip (Max_Index);
            end if;
            Flip (I);
         end if;
      end loop;
   end Pancake_Sort;

   type Integer_Array is array (Positive range <>) of Integer;
   procedure Int_Pancake_Sort is new Pancake_Sort (Integer, Positive, Integer_Array);
   Test_Array : Integer_Array := (3, 14, 1, 5, 9, 2, 6, 3);
begin
   Int_Pancake_Sort (Test_Array);
   for I in Test_Array'Range loop
      Ada.Text_IO.Put (Integer'Image (Test_Array (I)));
   end loop;
   Ada.Text_IO.New_Line;
end Pancake_Sort;


import Data.Bits (Bits(testBit, bitSize))
import Data.List (partition)

lsdSort :: (Ord a, Bits a) => [a] -> [a]
lsdSort = fixSort positiveLsdSort

msdSort :: (Ord a, Bits a) => [a] -> [a]
msdSort = fixSort positiveMsdSort

-- Fix a sort that puts negative numbers at the end, like positiveLsdSort and positiveMsdSort
fixSort sorter list = uncurry (flip (++)) (break (< 0) (sorter list))

positiveLsdSort :: (Bits a) => [a] -> [a]
positiveLsdSort list = foldl step list [0..bitSize (head list)] where
	step list bit = uncurry (++) (partition (not . flip testBit bit) list)

positiveMsdSort :: (Bits a) => [a] -> [a]
positiveMsdSort list = aux (bitSize (head list) - 1) list where
	aux _ [] = []
	aux (-1) list = list
	aux bit list = aux (bit - 1) lower ++ aux (bit - 1) upper where
		(lower, upper) = partition (not . flip testBit bit) list


PROC flip = ([]INT s, INT n) []INT:
   BEGIN
      [UPB s]INT ss := s;
      INT temp;
      FOR i TO n OVER 2 DO
         temp := ss[i];
         ss[i] := ss[n-i+1];
         ss[n-i+1] := temp
      OD;
      ss
   END;

PROC pancake sort = ([]INT s) []INT:
   BEGIN
      INT m;
      [UPB s]INT ss := s;
      FOR i FROM UPB s DOWNTO 2 DO
         m := 1;
         FOR j FROM 2 TO i DO
            IF ss[j] > ss[m] THEN
                m := j
            FI
         OD;

         IF m < i THEN
            IF m > 1 THEN
                ss := flip (ss,m)
            FI;
            ss := flip (ss,i)
         FI
      OD;
    ss
   END;

[10]INT s;
FOR i TO UPB s DO
   s[i] := ENTIER (next random * 100-50)
OD;
printf (($"Pancake sort demonstration"l$));
printf (($"unsorted: "10(g(4) )l$, s));
printf (($"sorted:   "10(g(4) )l$, pancake sort(s)))


procedure main(A)
    every writes((!rSort(A)||" ")|"\n")
end

procedure rSort(A)
    every (min := A[1]) >:= !A
    every (mlen := *(A[1]-min)) <:= (!A - min)
    every i := !*mlen do {
        every put(b := [], |[]\12)
        every a := !A do put(b[(a-min)[-i]+2|1], a)
        every put(A := [],!!b)
        }
    return A
end


on pancake_sort(aList)
    script o
        property lst : aList
        property len : (count my lst)

        on flip(n)
            if (n < len) then
                set my lst to (reverse of items 1 thru n of my lst) & (items (n + 1) thru len of my lst)
            else
                set my lst to reverse of my lst
            end if
        end flip
    end script

    repeat with i from (count o's lst) to 2 by -1
        set maxIdx to 1
        set maxVal to beginning of o's lst
        repeat with j from 2 to i
            tell item j of o's lst
                if (it > maxVal) then
                    set maxIdx to j
                    set maxVal to it
                end if
            end tell
        end repeat
        (* Performancewise, there's little to choose between doing the two 'if' tests below every time and
        occasionally flipping unnecessarily. The flips themselves are of of course a daft way to achieve:
            set item maxIdx of o's lst to item i of o's lst
            set item i of o's lst to maxVal
        *)
        -- if (maxIdx < i) then
        --     if (maxIdx > 1) then ¬
        o's flip(maxIdx)
        o's flip(i)
        -- end if
    end repeat

    return o's lst
end pancake_sort

-- Task code:
local pre, post, astid, output
set pre to {}
repeat 20 times
    set end of pre to (random number 100)
end repeat
set post to pancake_sort(pre)

set astid to AppleScript's text item delimiters
set AppleScript's text item delimiters to ", "
set output to "Before: {" & pre & ("}" & linefeed & "After:  {" & post & "}")
set AppleScript's text item delimiters to astid
return output


radixSortR =: 3 : 0  NB. base radixSort data
16 radixSortR y
:
keys =. x #.^:_1 y NB. compute keys
length =. #{.keys
extra =. (-length) {."0 buckets =. i.x
for_pass. i.-length do.
   keys =. ; (buckets,pass{"1 keys) <@:}./.extra,keys
end.
x#.keys NB. restore the data
)


public static int[] sort(int[] old) {
    // Loop for every bit in the integers
    for (int shift = Integer.SIZE - 1; shift > -1; shift--) {
        // The array to put the partially sorted array into
        int[] tmp = new int[old.length];
        // The number of 0s
        int j = 0;

        // Move the 0s to the new array, and the 1s to the old one
        for (int i = 0; i < old.length; i++) {
            // If there is a 1 in the bit we are testing, the number will be negative
            boolean move = old[i] << shift >= 0;

            // If this is the last bit, negative numbers are actually lower
            if (shift == 0 ? !move : move) {
                tmp[j] = old[i];
                j++;
            } else {
                // It's a 1, so stick it in the old array for now
                old[i - j] = old[i];
            }
        }

        // Copy over the 1s from the old array
        for (int i = j; i < tmp.length; i++) {
            tmp[i] = old[i - j];
        }

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

    return old;
}


/* ARM assembly Raspberry PI  */
/*  program pancakeSort.s  */

 /* REMARK 1 : this program use routines in a include file
   see task Include a file language arm assembly
   for the routine affichageMess conversion10
   see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes                       */
/************************************/
.include "../constantes.inc"

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

.align 4
#TableNumber:      .int   1,11,3,6,2,5,9,10,8,4,7
TableNumber:       .int   10,9,8,7,6,5,4,3,2,1
                   .equ NBELEMENTS, (. - TableNumber) / 4
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
sZoneConv:            .skip 24
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                              @ entry of program

    ldr r0,iAdrTableNumber                         @ address number table
    mov r1,#0                                      @ first element
    mov r2,#NBELEMENTS                             @ number of élements
    mov r10,#0                                     @ flips counter
    bl pancakeSort
    ldr r0,iAdrTableNumber                         @ address number table
    bl displayTable
    mov r0,r10                                     @ display counter
    ldr r1,iAdrsZoneConv                           @
    bl conversion10S                               @ décimal conversion
    ldr r0,iAdrsMessCounter
    ldr r1,iAdrsZoneConv                           @ insert conversion
    bl strInsertAtCharInc
    bl affichageMess                               @ display message

    ldr r0,iAdrTableNumber                         @ address number table
    mov r1,#NBELEMENTS                             @ number of élements
    bl isSorted                                    @ control sort
    cmp r0,#1                                      @ sorted ?
    beq 1f
    ldr r0,iAdrszMessSortNok                       @ no !! error sort
    bl affichageMess
    b 100f
1:                                                 @ yes
    ldr r0,iAdrszMessSortOk
    bl affichageMess
100:                                               @ standard end of the program
    mov r0, #0                                     @ return code
    mov r7, #EXIT                                  @ request to exit program
    svc #0                                         @ perform the system call

iAdrszCarriageReturn:     .int szCarriageReturn
iAdrsMessResult:          .int sMessResult
iAdrTableNumber:          .int TableNumber
iAdrszMessSortOk:         .int szMessSortOk
iAdrszMessSortNok:        .int szMessSortNok
iAdrsMessCounter:         .int sMessCounter
/******************************************************************/
/*     control sorted table                                   */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the number of elements  > 0  */
/* r0 return 0  if not sorted   1  if sorted */
isSorted:
    push {r2-r4,lr}                                    @ save registers
    mov r2,#0
    ldr r4,[r0,r2,lsl #2]
1:
    add r2,#1
    cmp r2,r1
    movge r0,#1
    bge 100f
    ldr r3,[r0,r2, lsl #2]
    cmp r3,r4
    movlt r0,#0
    blt 100f
    mov r4,r3
    b 1b
100:
    pop {r2-r4,lr}
    bx lr                                              @ return
/******************************************************************/
/*         flip                                                   */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains first start index
/* r2 contains the number of elements  */
/* r3 contains the position of flip   */
flip:
    push {r1-r6,lr}               @ save registers
    add r10,r10,#1                @ flips counter
    cmp r3,r2
    subge r3,r2,#1                @ last index if position >= size
    mov r4,r1
1:
    cmp r1,r3
    bge 100f
    ldr r5,[r0,r1,lsl #2]         @ load value first  index
    ldr r6,[r0,r3,lsl #2]         @ load value position index
    str r6,[r0,r1,lsl #2]         @ inversion
    str r5,[r0,r3,lsl #2]         @
    sub r3,r3,#1
    add r1,r1,#1
    b 1b
100:
    pop {r1-r6,lr}
    bx lr                          @ return
/******************************************************************/
/*         pancake sort                                                   */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains first start index
/* r2 contains the number of elements  */
pancakeSort:
    push {r1-r9,lr}            @ save registers
    sub r7,r2,#1
1:
    mov r5,r1                  @ index
    mov r4,#0                  @ max
    mov r3,#0                  @ position
    mov r8,#0                  @ top sorted
    ldr r9,[r0,r5,lsl #2]      @ load value A[i-1]
2:
   ldr r6,[r0,r5,lsl #2]       @ load value
   cmp r6,r4                   @ compare max
   movge r4,r6
   movge r3,r5
   cmp r6,r9                   @ cmp A[i] A[i-1] sorted ?
   movlt r8,#1                 @ no
   mov r9,r6                   @  A[i-1] = A[i]
   add r5,r5,#1                @ increment index
   cmp r5,r7                   @ end
   ble 2b
   cmp r8,#0                   @ sorted ?
   beq 100f                    @ yes -> end
   cmp r3,r7                   @ position ok ?
   beq 3f                      @ yes
   cmp r3,#0                   @ first position ?
   blne flip                   @ flip if not greather in first position
   mov r3,r7                   @ and flip the whole stack
   bl flip                     @
3:
   subs r7,r7,#1               @ decrement number of pancake
   bge 1b                      @ and loop
100:
    pop {r1-r9,lr}
    bx lr                      @ return

/******************************************************************/
/*      Display table elements                                */
/******************************************************************/
/* r0 contains the address of table */
displayTable:
    push {r0-r3,lr}                                    @ save registers
    mov r2,r0                                          @ table address
    mov r3,#0
1:                                                     @ loop display table
    ldr r0,[r2,r3,lsl #2]
    ldr r1,iAdrsZoneConv                               @
    bl conversion10S                                    @ décimal conversion
    ldr r0,iAdrsMessResult
    ldr r1,iAdrsZoneConv                               @ insert conversion
    bl strInsertAtCharInc
    bl affichageMess                                   @ display message
    add r3,#1
    cmp r3,#NBELEMENTS - 1
    ble 1b
    ldr r0,iAdrszCarriageReturn
    bl affichageMess
    mov r0,r2
100:
    pop {r0-r3,lr}
    bx lr
iAdrsZoneConv:           .int sZoneConv
/***************************************************/
/*      ROUTINES INCLUDE                           */
/***************************************************/
.include "../affichage.inc"


# Sort the input array;
# "base" must be an integer greater than 1
def radix_sort(base):
  # We only need the ceiling of non-negatives:
  def ceil: if . == floor then . else (. + 1 | floor) end;

  min as $min
  | map(. - $min)
  | ((( max|log) / (base|log)) | ceil) as $rounds
  | reduce range(0; $rounds) as $i
      # state: [ base^i, buckets ]
      ( [1, .];
        .[0] as $base_i
        | reduce .[1][] as $n
            ([];
             (($n/$base_i) % base) as $digit
             | .[$digit] += [$n] )
        | [($base_i * base), (map(select(. != null)) | flatten)] )
  | .[1]
  | map(. + $min) ;

def radix_sort:
  radix_sort(10);


function radixsort(tobesorted::Vector{Int64})
    arr = deepcopy(tobesorted)
    for shift in 63:-1:0
        tmp = Vector{Int64}(undef, length(arr))
        j = 0
        for i in 1:length(arr)
            if (shift == 0) == ((arr[i] << shift) >= 0)
                arr[i - j] = arr[i]
            else
                tmp[j + 1] = arr[i]
                j += 1
            end
        end
        tmp[j+1:end] .= arr[1:length(tmp)-j]
        arr = tmp
    end
    arr
end

function testradixsort()
    arrays = [[170, 45, 75, -90, -802, 24, 2, 66], [-4, 5, -26, 58, -990, 331, 331, 990, -1837, 2028]]
    for array in arrays
        println(radixsort(array))
    end
end

testradixsort()


pancakeSort: function [items][
    arr: new items
    len: size arr
    loop (len-1)..1 'endIdx [
        maxim: max slice arr 0 endIdx
        maximIdx: index arr maxim
        if maximIdx=endIdx -> continue

        if maximIdx > 0 [
            arr: (reverse slice arr 0 maximIdx) ++ slice arr maximIdx+1 (size arr)-1
        ]

        arr: (reverse slice arr 0 endIdx) ++ slice arr endIdx+1 (size arr)-1
    ]
    arr
]

print pancakeSort [3 1 2 8 5 7 9 4 6]


// version 1.1.2

fun radixSort(original: IntArray): IntArray {
    var old = original // Need this to be mutable
    // Loop for every bit in the integers
    for (shift in 31 downTo 0) {
        val tmp = IntArray(old.size)  // The array to put the partially sorted array into
        var j = 0                     // The number of 0s
        // Move the 0s to the new array, and the 1s to the old one
        for (i in 0 until old.size) {
            // If there is a 1 in the bit we are testing, the number will be negative
            val move = (old[i] shl shift) >= 0
            // If this is the last bit, negative numbers are actually lower
            val toBeMoved = if (shift == 0) !move else move
            if (toBeMoved)
                tmp[j++] = old[i]
            else {
                // It's a 1, so stick it in the old array for now
                old[i - j] = old[i]
            }
        }
        // Copy over the 1s from the old array
        for (i in j until tmp.size) tmp[i] = old[i - j]
        // And now the tmp array gets switched for another round of sorting
        old = tmp
    }
    return old
}

fun main(args: Array<String>) {
    val arrays = arrayOf(
        intArrayOf(170, 45, 75, -90, -802, 24, 2, 66),
        intArrayOf(-4, 5, -26, 58, -990, 331, 331, 990, -1837, 2028)
    )
    for (array in arrays) println(radixSort(array).contentToString())
}


RANDOMIZE TIMER

DIM nums(9) AS INTEGER
DIM L0 AS INTEGER, L1 AS INTEGER, n AS INTEGER

'initial values
FOR L0 = 0 TO 9
    nums(L0) = L0
NEXT
'scramble
FOR L0 = 9 TO 1 STEP -1
    n = INT(RND * (L0)) + 1
    IF n <> L0 THEN SWAP nums(n), nums(L0)
NEXT
'display initial condition
FOR L0 = 0 TO 9
    PRINT nums(L0);
NEXT
PRINT

FOR L1 = 9 TO 1 STEP -1
    n = 0
    FOR L0 = 1 TO L1
        IF nums(n) < nums(L0) THEN n = L0
    NEXT

    IF (n < L1) THEN
        IF (n > 0) THEN
            FOR L0 = 0 TO (n \ 2)
                SWAP nums(L0), nums(n - L0)
            NEXT
            FOR L0 = 0 TO 9
                PRINT nums(L0);
            NEXT
            PRINT
        END IF
        FOR L0 = 0 TO (L1 \ 2)
            SWAP nums(L0), nums(L1 - L0)
        NEXT

        FOR L0 = 0 TO 9
            PRINT nums(L0);
        NEXT
        PRINT
    END IF
NEXT


ClearAll[SortByPos, RadixSort]
SortByPos[data : {_List ..}, pos_Integer] := Module[{digs, order},
  digs = data[[All, pos]];
  order = Ordering[digs];
  data[[order]]
  ]
RadixSort[x : {_Integer ..}] := Module[{y, digs, maxlen, offset},
  offset = Min[x];
  y = x - offset;
  digs = IntegerDigits /@ y;
  maxlen = Max[Length /@ digs];
  digs = IntegerDigits[#, 10, maxlen] & /@ y;
  digs = Fold[SortByPos, digs, -Range[maxlen]];
  digs = FromDigits /@ digs;
  digs += offset;
  digs
  ]


func radixSort[T](a: openArray[T]): seq[T] =

  result = @a

  ## Loop for every bit in the integers.
  for shift in countdown(63, 0):
    var tmp = newSeq[T](result.len)   # The array to put the partially sorted array into.
    var j = 0                         # The number of 0s.
    for i in 0..result.high:
      # If there is a 1 in the bit we are testing, the number will be negative.
      let move = result[i] shl shift >= 0
      # If this is the last bit, negative numbers are actually lower.
      let toBeMoved = if shift == 0: not move else: move
      if toBeMoved:
        tmp[j] = result[i]
        inc j
      else:
        # It's a 1, so stick it in the result array for now.
        result[i - j] = result[i]
    # Copy over the 1s from the old array.
    for i in j..tmp.high:
      tmp[i] = result[i - j]
    # And now the tmp array gets switched for another round of sorting.
    result.shallowCopy(tmp)

when isMainModule:

  const arrays = [@[170, 45, 75, -90, -802, 24, 2, 66],
                  @[-4, 5, -26, 58, -990, 331, 331, 990, -1837, 2028]]

  for a in arrays:
    echo radixSort(a)


:: Pancake Sort from Rosetta Code
:: Batch File Implementation

@echo off
setlocal enabledelayedexpansion

:: put the input sequence of integers (only) on the list variable.
set "list=-2 0 -1 5 2 7 4 3 6 -1 7 2 1 8"

:: create a pseudo-array; start at 0.
set "range=-1"
for %%l in (%list%) do (
	set /a "range+=1"
	set "num!range!=%%l"
)

:: scramble (remove this if you do not want to scramble the integers)
for /l %%l in (%range%,-1,1) do (
	set /a "n=%random% %% %%l"
	rem swapping...
	for %%? in (num!n!) do set "swaptemp=!%%?!"
	set "num!n!=!num%%l!"
	set "num%%l=!swaptemp!"
)

:: display initial condition
set "output="
for /l %%l in (0,1,%range%) do set "output=!output!  !num%%l!"
echo(Initial Sequence:
echo(
echo(       ^>^> %output%
echo(
echo(Sorting:
echo(

:: begin sort
for /l %%l in (%range%,-1,1) do (
	set "n=0"
	for /l %%m in (1,1,%%l) do (
		for %%? in (num!n!) do if !%%?! lss !num%%m! set "n=%%m"
	)

	if !n! lss %%l (
		if !n! gtr 0 (
			set /a "tempvar1=!n!/2" %==  corresponds to (n \ 2) from BASIC code ==%
			for /l %%m in (0,1,!tempvar1!) do (
				set /a "tempvar2=!n!-%%m" %==  corresponds to (n - L0) from BASIC code ==%
				rem swapping...
				for %%? in (num!tempvar2!) do set "swaptemp=!%%?!"
				set "num!tempvar2!=!num%%m!"
				set "num%%m=!swaptemp!"
			)
			rem display the action
			set "output="
			for /l %%x in (0,1,%range%) do set "output=!output!  !num%%x!"
			echo(       ^>^> !output!
		)

		set /a "tempvar1=%%l/2" %==  corresponds to (L1 \ 2) from BASIC code ==%
		for /l %%m in (0,1,!tempvar1!) do (
			set /a "tempvar2=%%l-%%m" %==  corresponds to (L1 - L0) from BASIC code ==%
			rem swapping...
			for %%? in (num!tempvar2!) do set "swaptemp=!%%?!"
			set "num!tempvar2!=!num%%m!"
			set "num%%m=!swaptemp!"
		)
		rem display the action
		set output=
		for /l %%x in (0,1,%range%) do set "output=!output!  !num%%x!"
		echo.       ^>^> !output!
		)
	)

)

echo DONE^^!
exit /b 0


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

runSample(arg)
return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method radixSort(tlist = Rexx[]) public static returns Rexx[]

  -- scale the array to start at zero to allow handling of -ve values
  parse getLimits(tlist) maxn minn maxl .
  tlist = rescale(tlist, minn)

  loop px = maxl to 1 by -1
    bukits = ''
    loop ix = 0 to tlist.length - 1
      cval = tlist[ix].right(maxl, 0)
      parse cval . =(px) digit +1 .
      bukits[digit] = bukits[digit] (cval + 0) -- simulates a stack
      end ix
    intermediates = ''
    loop bi = 0 to 9
      intermediates = intermediates bukits[bi] -- sumulates unstack
      end bi
    -- reload array
    loop iw = 1 to intermediates.words()
      tlist[iw - 1] = intermediates.word(iw)
      end iw
    end px

  -- restore the array to original scale
  tlist = rescale(tlist, -minn)
  return tlist

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method rescale(arry = Rexx[], newbase) private static returns Rexx[]
  loop ix = 0 to arry.length - 1
    arry[ix] = arry[ix] - newbase
    end ix
  return arry
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method getLimits(arry = Rexx[]) private static returns Rexx
  maxn = 0
  minn = 0
  maxl = 0
  loop i_ = 0 to arry.length - 1
    maxn = maxn.max(arry[i_])
    minn = minn.min(arry[i_])
    end i_
  maxl = (maxn - minn).length()
  return maxn minn maxl
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(arg) private static
  lists = [-
    [2, 24, 45, 0, 66, 75, 170, -802, -90, 1066, 666], -
    [170, 45, 75, 90, 2, 24, 802, 66], -
    [10, 9, 8, 7, 8, 5, 4, 3, 2, 1, 0], -
    [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10], -
    [-10, -9, -8, -7, -8, -5, -4, -3, -2, -1, -0], -
    [-0, -1, -2, -3, -4, -5, -6, -7, -8, -9, -10], -
    [-10, -19, -18, -17, -18, -15, -14, -13, -12, -11, -100], -
    [10, 9, 8, 7, 8, 5, 4, 3, 2, 1, 0, -0, -1, -2, -3, -4, -5, -6, -7, -8, -9, -10], -
    [-10, -9, -8, -7, -8, -5, -4, -3, -2, -1, -0, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10] -
  ]

  loop il = 0 to lists.length - 1
    tlist = lists[il]
    say ' Input:' Arrays.asList(tlist)
    say 'Output:' Arrays.asList(radixSort(tlist))
    say
    end il
  return


      DIM test(9)
      test() = 4, 65, 2, -31, 0, 99, 2, 83, 782, 1
      PROCpancakesort(test())
      FOR i% = 0 TO 9
        PRINT test(i%) ;
      NEXT
      PRINT
      END

      DEF PROCpancakesort(a())
      LOCAL i%, j%, m%
      FOR i% = DIM(a(),1)+1 TO 2 STEP -1
        m% = 0
        FOR j% = 1 TO i%-1
          IF a(j%) > a(m%) m% = j%
        NEXT
        m% += 1
        IF m% < i% THEN
          IF m% > 1 PROCflip(a(), m%)
          PROCflip(a(), i%)
        ENDIF
      NEXT
      ENDPROC

      DEF PROCflip(a(), n%)
      IF n% < 2 ENDPROC
      LOCAL i%
      n% -= 1
      FOR i% = 0 TO n% DIV 2
        SWAP a(i%), a(n%-i%)
      NEXT
      ENDPROC


int pancake_sort(int *list, unsigned int length)
{
    //If it's less than 2 long, just return it as sorting isn't really needed...
    if(length<2)
        return 0;

    int i,a,max_num_pos,moves;
    moves=0;

    for(i=length;i>1;i--)
    {
        //Find position of the max number in pos(0) to pos(i)
        max_num_pos=0;
        for(a=0;a<i;a++)
        {
            if(list[a]>list[max_num_pos])
                max_num_pos=a;
        }

        if(max_num_pos==i-1)
            //It's where it need to be, skip
            continue;

        //Get the found max number to the beginning of the list (unless it already is)
        if(max_num_pos)
        {
            moves++;
            do_flip(list, length, max_num_pos+1);
        }

        //And then move it to the end of the range we're working with (pos(0) to pos(i))
        moves++;
        do_flip(list, length, i);

        //Then everything above list[i-1] is sorted and don't need to be touched

    }

    return moves;
}


#!/usr/bin/perl
use warnings;
use strict;

sub radix {
    my @tab = ([@_]);

    my $max_length = 0;
    length > $max_length and $max_length = length for @_;
    $_ = sprintf "%0${max_length}d", $_ for @{ $tab[0] }; # Add zeros.

    for my $pos (reverse -$max_length .. -1) {
        my @newtab;
        for my $bucket (@tab) {
            for my $n (@$bucket) {
                my $char = substr $n, $pos, 1;
                $char = -1 if '-' eq $char;
                $char++;
                push @{ $newtab[$char] }, $n;
            }
        }
        @tab = @newtab;
    }

    my @return;
    my $negative = shift @tab;                            # Negative bucket must be reversed.
    push @return, reverse @$negative;
    for my $bucket (@tab) {
        push @return, @{ $bucket // [] };
    }
    $_ = 0 + $_ for @return;                              # Remove zeros.
    return @return;
}


public static class PancakeSorter
{
    public static void Sort<T>(List<T> list) where T : IComparable
    {
        if (list.Count < 2)
        {
            return;
        }
        int i, a, max_num_pos;
        for (i = list.Count; i > 1; i--)
        {
            max_num_pos = 0;
            for (a = 0; a < i; a++)
            {
                if (list[a].CompareTo(list[max_num_pos]) > 0)
                {
                    max_num_pos = a;
                }
            }
            if (max_num_pos == i - 1)
            {
                continue;
            }
            if (max_num_pos > 0)
            {
                Flip(list, list.Count, max_num_pos + 1);
            }
            Flip(list, list.Count, i);
        }
        return;
    }
    private static void Flip<T>(List<T> list, int length, int num)
    {
        for (int i = 0; i < --num; i++)
        {
            T swap = list[i];
            list[i] = list[num];
            list[num] = swap;
        }
    }
}


with javascript_semantics

function radixSortn(sequence s, integer n)
    sequence buckets = repeat({},10),
             res = {}
    for i=1 to length(s) do
        integer digit = remainder(floor(s[i]/power(10,n-1)),10)+1
        buckets[digit] = append(buckets[digit],s[i])
    end for
    for i=1 to length(buckets) do
        integer len = length(buckets[i])
        if len!=0 then
            if len=1 or n=1 then
                res &= buckets[i]
            else
                res &= radixSortn(buckets[i],n-1)
            end if
        end if
    end for
    return res
end function

function split_by_sign(sequence s)
    sequence buckets = {{},{}}
    for i=1 to length(s) do
        integer si = s[i]
        if si<0 then
            buckets[1] = append(buckets[1],-si)
        else
            buckets[2] = append(buckets[2],si)
        end if
    end for
    return buckets
end function

function radixSort(sequence s)
    integer mins = min(s),
            passes = max(max(s),abs(mins))
    passes = floor(log10(passes))+1
    if mins<0 then
        sequence buckets = split_by_sign(s)
        s = reverse(sq_uminus(radixSortn(buckets[1],passes)))
          & radixSortn(buckets[2],passes)
    else
        s = radixSortn(s,passes)
    end if
    return s
end function

?radixSort({1, 3, 8, 9, 0, 0, 8, 7, 1, 6})
?radixSort({170, 45, 75, 90, 2, 24, 802, 66})
?radixSort({170, 45, 75, 90, 2, 24, -802, -66})
?radixSort({100000, -10000, 400, 23, 10000})


#include <algorithm>
#include <iostream>
#include <iterator>
#include <vector>

// pancake sort template (calls predicate to determine order)
template <typename BidIt, typename Pred>
void pancake_sort(BidIt first, BidIt last, Pred order)
{
    if (std::distance(first, last) < 2) return; // no sort needed

    for (; first != last; --last)
    {
        BidIt mid = std::max_element(first, last, order);
        if (mid == last - 1)
        {
            continue; // no flips needed
        }
        if (first != mid)
        {
            std::reverse(first, mid + 1); // flip element to front
        }
        std::reverse(first, last); // flip front to final position
    }
}

// pancake sort template (ascending order)
template <typename BidIt>
void pancake_sort(BidIt first, BidIt last)
{
    pancake_sort(first, last, std::less<typename std::iterator_traits<BidIt>::value_type>());
}

int main()
{
    std::vector<int> data;
    for (int i = 0; i < 20; ++i)
    {
        data.push_back(i); // generate test data
    }
    std::random_shuffle(data.begin(), data.end()); // scramble data

    std::copy(data.begin(), data.end(), std::ostream_iterator<int>(std::cout, " "));
    std::cout << "\n";

    pancake_sort(data.begin(), data.end()); // ascending pancake sort

    std::copy(data.begin(), data.end(), std::ostream_iterator<int>(std::cout, " "));
    std::cout << "\n";
}


(de radixSort (Lst)
   (let Mask 1
      (while
         (let (Pos (list NIL NIL)  Neg (list NIL NIL)  Flg)
            (for N Lst
               (queue
                  (if2 (ge0 N) (bit? Mask N)
                     (cdr Pos) Pos Neg (cdr Neg) )
                  N )
               (and (>= (abs N) Mask) (on Flg)) )
            (setq
               Lst (conc (apply conc Neg) (apply conc Pos))
               Mask (* 2 Mask) )
            Flg ) ) )
   Lst )


Structure bucket
  List i.i()
EndStructure

DataSection
  ;sets specify the size (1 based) followed by each integer
  set1:
  Data.i 10 ;size
  Data.i 1, 3, 8, 9, 0, 0, 8, 7, 1, 6 ;data
  set2:
  Data.i 8
  Data.i 170, 45, 75, 90, 2, 24, 802, 66
  set3:
  Data.i 8
  Data.i 170, 45, 75, 90, 2, 24, -802, -66
EndDataSection

Procedure setIntegerArray(Array x(1), *setPtr)
  Protected i, count
  count = PeekI(*setPtr) - 1 ;convert to zero based count
  *setPtr + SizeOf(Integer) ;move pointer forward to data
  Dim x(count)
  For i = 0 To count
    x(i) = PeekI(*setPtr + i * SizeOf(Integer))
  Next
EndProcedure

Procedure displayArray(Array x(1))
  Protected i, Size = ArraySize(x())
  For i = 0 To Size
    Print(Str(x(i)))
    If i < Size: Print(", "): EndIf
  Next
  PrintN("")
EndProcedure

Procedure radixSort(Array x(1), Base = 10)
  Protected count = ArraySize(x())
  If Base < 1 Or count < 1: ProcedureReturn: EndIf ;exit due to invalid values

  Protected i, pv, digit, digitCount, maxAbs, pass, index
  ;find element with largest number of digits
  For i = 0 To count
    If Abs(x(i)) > maxAbs
      maxAbs = Abs(x(i))
    EndIf
  Next

  digitCount = Int(Log(maxAbs)/Log(Base)) + 1

  For pass = 1 To digitCount
    Dim sortBuckets.bucket(Base * 2 - 1)
    pv = Pow(Base, pass - 1)

    ;place elements in buckets according to the current place-value's digit
    For index = 0 To count
      digit = Int(x(index)/pv) % Base + Base
      AddElement(sortBuckets(digit)\i())
      sortBuckets(digit)\i() = x(index)
    Next

    ;transfer contents of buckets back into array
    index = 0
    For digit = 1 To (Base * 2) - 1
      ForEach sortBuckets(digit)\i()
        x(index) = sortBuckets(digit)\i()
        index + 1
      Next
    Next
  Next
EndProcedure

If OpenConsole()
  Dim x(0)
  setIntegerArray(x(), ?set1)
  radixSort(x()): displayArray(x())

  setIntegerArray(x(), ?set2)
  radixSort(x()): displayArray(x())

  setIntegerArray(x(), ?set3)
  radixSort(x(), 2): displayArray(x())

  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
  CloseConsole()
EndIf


(defn pancake-sort
  [arr]
  (if (= 1 (count arr))
    arr
    (when-let [mx (apply max arr)]
      (let [tk    (split-with #(not= mx %) arr)
            tail  (second tk)
            torev (concat (first tk) (take 1 tail))
            head  (reverse torev)]
        (cons mx (pancake-sort (concat (drop 1 head) (drop 1 tail))))))))


(defun pancake-sort (seq)
  "A destructive version of Pancake Sort that works with either lists or arrays of numbers."
  (defun flip (lst index)
    (setf (subseq lst 0 index) (reverse (subseq lst 0 index))))
  (loop with lst = (coerce seq 'list)
	for i from (length lst) downto 2
	for index = (position (apply #'max (subseq lst 0 i)) lst)
	do (unless (= index 0)
	     (flip lst (1+ index)))
	(flip lst i)
	finally (return (coerce lst (type-of seq)))))


#python2.6 <
from math import log

def getDigit(num, base, digit_num):
    # pulls the selected digit
    return (num // base ** digit_num) % base

def makeBlanks(size):
    # create a list of empty lists to hold the split by digit
    return [ [] for i in range(size) ]

def split(a_list, base, digit_num):
    buckets = makeBlanks(base)
    for num in a_list:
        # append the number to the list selected by the digit
        buckets[getDigit(num, base, digit_num)].append(num)
    return buckets

# concatenate the lists back in order for the next step
def merge(a_list):
    new_list = []
    for sublist in a_list:
       new_list.extend(sublist)
    return new_list

def maxAbs(a_list):
    # largest abs value element of a list
    return max(abs(num) for num in a_list)

def split_by_sign(a_list):
    # splits values by sign - negative values go to the first bucket,
    # non-negative ones into the second
    buckets = [[], []]
    for num in a_list:
        if num < 0:
            buckets[0].append(num)
        else:
            buckets[1].append(num)
    return buckets

def radixSort(a_list, base):
    # there are as many passes as there are digits in the longest number
    passes = int(round(log(maxAbs(a_list), base)) + 1)
    new_list = list(a_list)
    for digit_num in range(passes):
        new_list = merge(split(new_list, base, digit_num))
    return merge(split_by_sign(new_list))


import std.stdio, std.algorithm;

void pancakeSort(bool tutor=false, T)(T[] data) {
    foreach_reverse (immutable i; 2 .. data.length + 1) {
        immutable maxIndex = i - data[0 .. i].minPos!q{a > b}.length;
        if (maxIndex + 1 != i) {
            if (maxIndex != 0) {
                static if (tutor)
                    writeln("With: ", data, " doflip ", maxIndex + 1);
                data[0 .. maxIndex + 1].reverse();
            }

            static if (tutor)
                writeln("With: ", data, " doflip ", i);
            data[0 .. i].reverse();
        }
    }
}

void main() {
    auto data = "769248135".dup;
    data.pancakeSort!true;
    data.writeln;
}


#lang QB64
'* don't be an a$$. Keep this credit notice with the source:
'* written/refactored by CodeGuy, 2018.
'* also works with negative numbers.
TESTN& = 63
A$ = ""
REDIM b(0 TO TESTN&) AS DOUBLE
FOR s& = -1 TO 1 STEP 2
    A$ = A$ + CHR$(13) + CHR$(10) + "Random order:"
    FOR i = 0 TO TESTN&
        b(i) = (1000 * RND) AND 1023
        IF i MOD 2 THEN b(i) = -b(i)
        IF i < TESTN& THEN
            A$ = A$ + LTRIM$(STR$(b(i))) + ","
        ELSE
            A$ = A$ + LTRIM$(STR$(b(i))) + CHR$(13) + CHR$(10)
        END IF
    NEXT
    RadixSort b(), 0, TESTN&, s&
    IF s& = -1 THEN
        A$ = A$ + "descending order" + CHR$(13) + CHR$(10)
    ELSE
        A$ = A$ + "ascending order" + CHR$(13) + CHR$(10)
    END IF

    FOR i = 0 TO TESTN&
        PRINT b(i);
        IF i < TESTN& THEN
            A$ = A$ + LTRIM$(STR$(b(i))) + ","
        ELSE
            A$ = A$ + LTRIM$(STR$(b(i))) + CHR$(13) + CHR$(10)
        END IF
    NEXT
NEXT
PRINT A$
TYPE MinMaxRec
    min AS LONG
    max AS LONG
END TYPE

SUB RadixSort (CGSortLibArr() AS DOUBLE, start&, finish&, order&)
    ArrayIsInteger CGSortLibArr(), start&, finish&, errindex&, errcon&
    IF errcon& THEN
        '* use another stable sort and sort anyway
        MergeSort CGSortLibArr(), start&, finish&, order&
    ELSE
        DIM RSMMrec AS MinMaxRec
        GetMinMaxArray CGSortLibArr(), start&, finish&, RSMMrec
        IF CGSortLibArr(RSMMrec.min) = CGSortLibArr(RSMMrec.max) THEN EXIT SUB '* no div0 bombs
        delta# = CGSortLibArr(RSMMrec.max) - CGSortLibArr(RSMMrec.min)
        DIM pow2 AS _UNSIGNED _INTEGER64
        DIM NtmpN AS _UNSIGNED _INTEGER64
        DIM Int64MaxShift AS _INTEGER64: Int64MaxShift = 2 ^ 64
        REDIM ct&(-1 TO 1)
        REDIM RadixCGSortLibArr(0 TO 1, finish& - start&) AS DOUBLE
        SELECT CASE order&
            CASE 1
                pow2 = Int64MaxShift
                bits& = LEN(Int64MaxShift) * 8
                DO UNTIL bits& < 0
                    FOR i& = start& TO finish&
                        NtmpN = Int64MaxShift * (CGSortLibArr(i&) - CGSortLibArr(RSMMrec.min)) / (delta#)
                        IF NtmpN AND pow2 THEN
                            tmpradix% = 1
                        ELSE
                            tmpradix% = 0
                        END IF
                        RadixCGSortLibArr(tmpradix%, ct&(tmpradix%)) = CGSortLibArr(i&)
                        ct&(tmpradix%) = ct&(tmpradix%) + 1
                    NEXT
                    c& = start&
                    FOR i& = 0 TO 1
                        FOR j& = 0 TO ct&(i&) - 1
                            CGSortLibArr(c&) = RadixCGSortLibArr(i&, j&)
                            c& = c& + 1
                        NEXT
                        ct&(i&) = 0
                    NEXT
                    pow2 = pow2 / 2
                    bits& = bits& - 1
                LOOP
            CASE ELSE
                pow2 = 1
                FOR bits& = 0 TO 63
                    FOR i& = start& TO finish&
                        NtmpN = Int64MaxShift * (CGSortLibArr(i&) - CGSortLibArr(RSMMrec.min)) / (delta#)
                        IF NtmpN AND pow2 THEN
                            tmpradix% = 1
                        ELSE
                            tmpradix% = 0
                        END IF
                        RadixCGSortLibArr(tmpradix%, ct&(tmpradix%)) = CGSortLibArr(i&)
                        ct&(tmpradix%) = ct&(tmpradix%) + 1
                    NEXT
                    c& = start&
                    FOR i& = 0 TO 1
                        FOR j& = 0 TO ct&(i&) - 1
                            CGSortLibArr(c&) = RadixCGSortLibArr(i&, j&)
                            c& = c& + 1
                        NEXT
                        ct&(i&) = 0
                    NEXT
                    pow2 = pow2 * 2
                NEXT
        END SELECT
        ERASE RadixCGSortLibArr, ct&
    END IF
END SUB

SUB ArrayIsInteger (CGSortLibArr() AS DOUBLE, start&, finish&, errorindex&, IsInt&)
    IsInt& = 1
    errorindex& = start&
    FOR IsIntegerS& = start& TO finish&
        IF CGSortLibArr(IsIntegerS&) MOD 1 THEN
            errorindex& = IsIntegerS&
            IsInt& = 0
            EXIT FUNCTION
        END IF
    NEXT
END FUNCTION

SUB MergeSort (CGSortLibArr() AS DOUBLE, start&, finish&, order&)
    SELECT CASE finish& - start&
        CASE IS > 31
            middle& = start& + (finish& - start&) \ 2
            MergeSort CGSortLibArr(), start&, middle&, order&
            MergeSort CGSortLibArr(), middle& + 1, finish&, order&
            'IF order& = 1 THEN
            EfficientMerge CGSortLibArr(), start&, finish&, order&
            'ELSE
            '    MergeRoutine CGSortLibArr(), start&, finish&, order&
            'END IF
        CASE IS > 0
            InsertionSort CGSortLibArr(), start&, finish&, order&
    END SELECT
END SUB

SUB EfficientMerge (right() AS DOUBLE, start&, finish&, order&)
    half& = start& + (finish& - start&) \ 2
    REDIM left(start& TO half&) AS DOUBLE '* hold the first half of the array in left() -- must be the same type as right()
    FOR LoadLeft& = start& TO half&
        left(LoadLeft&) = right(LoadLeft&)
    NEXT
    SELECT CASE order&
        CASE 1
            i& = start&
            j& = half& + 1
            insert& = start&
            DO
                IF i& > half& THEN '* left() exhausted
                    IF j& > finish& THEN '* right() exhausted
                        EXIT DO
                    ELSE
                        '* stuff remains in right to be inserted, so flush right()
                        WHILE j& <= finish&
                            right(insert&) = right(j&)
                            j& = j& + 1
                            insert& = insert& + 1
                        WEND
                        EXIT DO
                        '* and exit
                    END IF
                ELSE
                    IF j& > finish& THEN
                        WHILE i& < LoadLeft&
                            right(insert&) = left(i&)
                            i& = i& + 1
                            insert& = insert& + 1
                        WEND
                        EXIT DO
                    ELSE
                        IF right(j&) < left(i&) THEN
                            right(insert&) = right(j&)
                            j& = j& + 1
                        ELSE
                            right(insert&) = left(i&)
                            i& = i& + 1
                        END IF
                        insert& = insert& + 1
                    END IF
                END IF
            LOOP
        CASE ELSE
            i& = start&
            j& = half& + 1
            insert& = start&
            DO
                IF i& > half& THEN '* left() exhausted
                    IF j& > finish& THEN '* right() exhausted
                        EXIT DO
                    ELSE
                        '* stuff remains in right to be inserted, so flush right()
                        WHILE j& <= finish&
                            right(insert&) = right(j&)
                            j& = j& + 1
                            insert& = insert& + 1
                        WEND
                        EXIT DO
                        '* and exit
                    END IF
                ELSE
                    IF j& > finish& THEN
                        WHILE i& < LoadLeft&
                            right(insert&) = left(i&)
                            i& = i& + 1
                            insert& = insert& + 1
                        WEND
                        EXIT DO
                    ELSE
                        IF right(j&) > left(i&) THEN
                            right(insert&) = right(j&)
                            j& = j& + 1
                        ELSE
                            right(insert&) = left(i&)
                            i& = i& + 1
                        END IF
                        insert& = insert& + 1
                    END IF
                END IF
            LOOP
    END SELECT
    ERASE left
END SUB

SUB GetMinMaxArray (CGSortLibArr() AS DOUBLE, Start&, Finish&, GetMinMaxArray_minmax AS MinMaxRec)
    DIM GetGetMinMaxArray_minmaxArray_i AS LONG
    DIM GetMinMaxArray_n AS LONG
    DIM GetMinMaxArray_TT AS LONG
    DIM GetMinMaxArray_NMod2 AS INTEGER
    '* this is a workaround for the irritating malfunction
    '* of MOD using larger numbers and small divisors
    GetMinMaxArray_n = Finish& - Start&
    GetMinMaxArray_TT = GetMinMaxArray_n MOD 10000
    GetMinMaxArray_NMod2 = GetMinMaxArray_n - 10000 * ((GetMinMaxArray_n - GetMinMaxArray_TT) / 10000)
    IF (GetMinMaxArray_NMod2 MOD 2) THEN
        GetMinMaxArray_minmax.min = Start&
        GetMinMaxArray_minmax.max = Start&
        GetGetMinMaxArray_minmaxArray_i = Start& + 1
    ELSE
        IF CGSortLibArr(Start&) > CGSortLibArr(Finish&) THEN
            GetMinMaxArray_minmax.max = Start&
            GetMinMaxArray_minmax.min = Finish&
        ELSE
            GetMinMaxArray_minmax.min = Finish&
            GetMinMaxArray_minmax.max = Start&
        END IF
        GetGetMinMaxArray_minmaxArray_i = Start& + 2
    END IF

    WHILE GetGetMinMaxArray_minmaxArray_i < Finish&
        IF CGSortLibArr(GetGetMinMaxArray_minmaxArray_i) > CGSortLibArr(GetGetMinMaxArray_minmaxArray_i + 1) THEN
            IF CGSortLibArr(GetGetMinMaxArray_minmaxArray_i) > CGSortLibArr(GetMinMaxArray_minmax.max) THEN
                GetMinMaxArray_minmax.max = GetGetMinMaxArray_minmaxArray_i
            END IF
            IF CGSortLibArr(GetGetMinMaxArray_minmaxArray_i + 1) < CGSortLibArr(GetMinMaxArray_minmax.min) THEN
                GetMinMaxArray_minmax.min = GetGetMinMaxArray_minmaxArray_i + 1
            END IF
        ELSE
            IF CGSortLibArr(GetGetMinMaxArray_minmaxArray_i + 1) > CGSortLibArr(GetMinMaxArray_minmax.max) THEN
                GetMinMaxArray_minmax.max = GetGetMinMaxArray_minmaxArray_i + 1
            END IF
            IF CGSortLibArr(GetGetMinMaxArray_minmaxArray_i) < CGSortLibArr(GetMinMaxArray_minmax.min) THEN
                GetMinMaxArray_minmax.min = GetGetMinMaxArray_minmaxArray_i
            END IF
        END IF
        GetGetMinMaxArray_minmaxArray_i = GetGetMinMaxArray_minmaxArray_i + 2
    WEND
END SUB

SUB InsertionSort (CGSortLibArr() AS DOUBLE, start AS LONG, finish AS LONG, order&)
    DIM InSort_Local_ArrayTemp AS DOUBLE
    DIM InSort_Local_i AS LONG
    DIM InSort_Local_j AS LONG
    SELECT CASE order&
        CASE 1
            FOR InSort_Local_i = start + 1 TO finish
                InSort_Local_ArrayTemp = CGSortLibArr(InSort_Local_i)
                InSort_Local_j = InSort_Local_i - 1
                DO UNTIL InSort_Local_j < start
                    IF (InSort_Local_ArrayTemp < CGSortLibArr(InSort_Local_j)) THEN
                        CGSortLibArr(InSort_Local_j + 1) = CGSortLibArr(InSort_Local_j)
                        InSort_Local_j = InSort_Local_j - 1
                    ELSE
                        EXIT DO
                    END IF
                LOOP
                CGSortLibArr(InSort_Local_j + 1) = InSort_Local_ArrayTemp
            NEXT
        CASE ELSE
            FOR InSort_Local_i = start + 1 TO finish
                InSort_Local_ArrayTemp = CGSortLibArr(InSort_Local_i)
                InSort_Local_j = InSort_Local_i - 1
                DO UNTIL InSort_Local_j < start
                    IF (InSort_Local_ArrayTemp > CGSortLibArr(InSort_Local_j)) THEN
                        CGSortLibArr(InSort_Local_j + 1) = CGSortLibArr(InSort_Local_j)
                        InSort_Local_j = InSort_Local_j - 1
                    ELSE
                        EXIT DO
                    END IF
                LOOP
                CGSortLibArr(InSort_Local_j + 1) = InSort_Local_ArrayTemp
            NEXT
    END SELECT
END SUB


  [ stack ]                    is digit     (   --> s )

  [ behead swap witheach min ] is smallest  ( [ --> n )

  [ [] over smallest
    rot witheach
      [ over -
        rot swap join swap ]
    swap
    0 digit put
    dup size temp put
    [ ' [ [ ] ] 16 of
      constant
      swap witheach
        [ dup dip
            [ digit share
              >> 15 &
          2dup peek ]
          join
          unrot poke ]
      dup 0 peek size
      temp share != while
      behead swap
      witheach join
      4 digit tally again ]
    behead nip
    temp release
    digit release
    [] unrot
    witheach
      [ over +
        rot swap join swap ]
    drop ]                     is radixsort ( [ --> [ )

  [] 256 times
    [ 1999 random 999 - join ]
  radixsort
  16 times
     [ 16 times
         [ behead
           dup 0 > if sp
           dup abs dup
           10 < if sp
           100 < if sp
           echo sp ] cr ]
  drop