/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program combSort64.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"
szCarriageReturn:   .asciz "\n"

.align 4
#TableNumber:      .quad   1,3,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
    mov x2,NBELEMENTS                              // number of élements
    bl combSort
    ldr x0,qAdrTableNumber                         // address number table
    bl displayTable

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

qAdrsZoneConv:            .quad sZoneConv
qAdrszCarriageReturn:     .quad szCarriageReturn
qAdrsMessResult:          .quad sMessResult
qAdrTableNumber:          .quad TableNumber
qAdrszMessSortOk:         .quad szMessSortOk
qAdrszMessSortNok:        .quad szMessSortNok
/******************************************************************/
/*     control sorted table                                   */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the number of elements  > 0  */
/* x0 return 0  if not sorted   1  if sorted */
isSorted:
    stp x2,lr,[sp,-16]!              // save  registers
    stp x3,x4,[sp,-16]!              // save  registers
    mov x2,0
    ldr x4,[x0,x2,lsl 3]
1:
    add x2,x2,1
    cmp x2,x1
    bge 99f
    ldr x3,[x0,x2, lsl 3]
    cmp x3,x4
    blt 98f
    mov x4,x3
    b 1b
98:
    mov x0,0                       // not sorted
    b 100f
99:
    mov x0,1                       // sorted
100:
    ldp x3,x4,[sp],16              // restaur  2 registers
    ldp x2,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/******************************************************************/
/*         comb sort                                              */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the first element    */
/* x2 contains the number of element */
/* this routine use à factor to 1.28  see wikipedia for best factor */
combSort:
    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 x9,x2,x1               // compute gap
    sub x2,x2,1                // compute end index n - 1
    mov x7,100
1:                             // start loop 1
    mul x9,x7,x9               // gap multiply by 100
    lsr x9,x9,7                // divide by 128
    cmp x9,0
    mov x3,1
    csel x9,x9,x3,ne
    mov x3,x1                  // start index
    mov x8,0                   // swaps
2:                             // start loop 2
    add x4,x3,x9               // add gap to indice
    cmp x4,x2
    bgt 4f
    ldr x5,[x0,x3,lsl 3]       // load value A[j]
    ldr x6,[x0,x4,lsl 3]       // load value A[j+1]
    cmp x6,x5                  // compare value
    bge 3f
    str x6,[x0,x3,lsl 3]       // if smaller inversion
    str x5,[x0,x4,lsl 3]
    mov x8,1                   // swaps
3:
    add x3,x3,1                // increment index j
    b 2b

4:
    //bl displayTable
    cmp x9,1                   // gap = 1 ?
    bne 1b                     // no loop
    cmp x8,1                   // swaps ?
    beq 1b                     // yes -> loop 1

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 CombSort(INT ARRAY a INT size)
  INT gap,i,tmp
  BYTE swaps

  gap=size swaps=0
  WHILE gap#1 OR swaps#0
  DO
    gap=(gap*5)/4
    IF gap<1 THEN gap=1 FI

    i=0
    swaps=0

    WHILE i+gap<size
    DO
      IF a(i)>a(i+1) THEN
        tmp=a(i) a(i)=a(i+1) a(i+1)=tmp
        swaps=1
      FI
      i==+1
    OD
  OD
RETURN

PROC Test(INT ARRAY a INT size)
  PrintE("Array before sort:")
  PrintArray(a,size)
  CombSort(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


let split list =
    let rec aux l acc1 acc2 =
        match l with
            | [] -> (acc1,acc2)
            | [x] -> (x::acc1,acc2)
            | x::y::tail ->
                aux tail (x::acc1) (y::acc2)
    in aux list [] []

let rec merge l1 l2 =
    match (l1,l2) with
        | (x,[]) -> x
        | ([],y) -> y
        | (x::tx,y::ty) ->
            if x <= y then x::merge tx l2
            else y::merge l1 ty
let rec mergesort list =
    match list with
        | [] -> []
        | [x] -> [x]
        | _ -> let (l1,l2) = split list
               in merge (mergesort l1) (mergesort l2)


: mergestep ( accum seq1 seq2 -- accum seq1 seq2 )
2dup [ first ] [email protected] <
[ [ [ first ] [ rest-slice ] bi [ suffix ] dip ] dip ]
[ [ first ] [ rest-slice ] bi [ swap [ suffix ] dip ] dip ]
if ;

: merge ( seq1 seq2 -- merged )
[ { } ] 2dip
[ 2dup [ length 0 > ] [email protected] and ]
[ mergestep ] while
append append ;

: mergesort ( seq -- sorted )
dup length 1 >
[ dup length 2 / floor [ head ] [ tail ] 2bi [ mergesort ] [email protected] merge ]
[ ] if ;


module CocktailShakerSorts

using Base.Order, Base.Sort
import Base.Sort: sort!
export CocktailShakerSort

struct CocktailSortAlg <: Algorithm end
const CocktailShakerSort = CocktailSortAlg()

function sort!(A::AbstractVector, lo::Int, hi::Int, a::CocktailSortAlg, ord::Ordering)
    if lo > 1 || hi < length(A)
        return sort!(view(A, lo:hi), 1, length(A), a, ord)
    end
    forward, beginindex, endindex = ord isa ForwardOrdering, 1, length(A) - 1

    while beginindex <= endindex
		newbegin, newend = endindex, beginindex
        for idx in beginindex:endindex
            if (forward && A[idx] > A[idx + 1]) || (!forward && A[idx] < A[idx + 1])
                A[idx + 1], A[idx] = A[idx], A[idx + 1]
                newend = idx
            end
        end
        # end has another in correct place, so narrow end by 1
        endindex = newend - 1

        for idx in endindex:-1:beginindex
            if (forward && A[idx] > A[idx + 1]) || (!forward && A[idx] < A[idx + 1])
                A[idx + 1], A[idx] = A[idx], A[idx + 1]
                newbegin = idx
            end
        end
        # beginning has another in correct place, so narrow beginning by 1
        beginindex = newbegin + 1
    end
    A
end

end # module

using .CocktailShakerSorts
using BenchmarkTools

cocktailshakersort!(v) = sort!(v; alg=CocktailShakerSort)

arr = [5, 8, 2, 0, 6, 1, 9, 3, 4]
println(arr, " => ", sort(arr, alg=CocktailShakerSort), " => ",
    sort(arr, alg=CocktailShakerSort, rev=true))

println("\nUsing default sort, which is Quicksort with integers:")
@btime sort!([5, 8, 2, 0, 6, 1, 9, 3, 4])
println("\nUsing CocktailShakerSort:")
@btime cocktailshakersort!([5, 8, 2, 0, 6, 1, 9, 3, 4])


fun <T> swap(array: Array<T>, i: Int, j: Int) {
    val temp = array[i]
    array[i] = array[j]
    array[j] = temp
}

fun <T> cocktailSort(array: Array<T>) where T : Comparable<T> {
    var begin = 0
    var end = array.size
    if (end == 0) {
        return
    }
    --end
    while (begin < end) {
        var newBegin = end
        var newEnd = begin
        for (i in begin until end) {
            val c1 = array[i]
            val c2 = array[i + 1]
            if (c1 > c2) {
                swap(array, i, i + 1)
                newEnd = i
            }
        }
        end = newEnd
        for (i in end downTo begin + 1) {
            val c1 = array[i - 1]
            val c2 = array[i]
            if (c1 > c2) {
                swap(array, i, i - 1)
                newBegin = i
            }
        }
        begin = newBegin
    }
}

fun main() {
    val array: Array<Int> = intArrayOf(5, 1, -6, 12, 3, 13, 2, 4, 0, 15).toList().toTypedArray()

    println("before: ${array.contentToString()}")
    cocktailSort(array)
    println("after: ${array.contentToString()}")
}


ClearAll[CocktailShakerSort]
CocktailShakerSort[in_List] :=
 Module[{x = in, swapped, begin = 1, end = Length[in] - 1},
  swapped = True;
  While[swapped,
   swapped = False;
   Do[
    If[x[[i]] > x[[i + 1]],
     x[[{i, i + 1}]] //= Reverse;
     swapped = True;
     ]
    ,
    {i, begin, end}
    ];
   end--;

   Do[
    If[x[[i]] > x[[i + 1]],
     x[[{i, i + 1}]] //= Reverse;
     swapped = True;
     ]
    ,
    {i, end, begin, -1}
    ];
   begin++;
   ];
  x
 ]
CocktailShakerSort[{44, 21, 5, 88, 52, 44, 36, 93, 66, 18, 88, 61, 45, 47, 47, 68, 19, 60}]


def quickSort(arr):
    less = []
    pivotList = []
    more = []
    if len(arr) <= 1:
        return arr
    else:
        pivot = arr[0]
        for i in arr:
            if i < pivot:
                less.append(i)
            elif i > pivot:
                more.append(i)
            else:
                pivotList.append(i)
        less = quickSort(less)
        more = quickSort(more)
        return less + pivotList + more

a = [4, 65, 2, -31, 0, 99, 83, 782, 1]
a = quickSort(a)


code ChOut=8, IntOut=11;

proc GnomeSort(A(0..Size-1));   \Sort array A
int  A, Size;
int  I, J, T;
[I:= 1;
J:= 2;
while I < Size do
    if A(I-1) <= A(I) then
        [\ for descending sort, use >= for comparison
        I:= J;
        J:= J+1;
        ]
    else
        [T:= A(I-1);  A(I-1):= A(I);  A(I):= T; \swap
        I:= I-1;
        if I = 0 then
            [I:= J;
            J:= J+1;
            ];
        ];
];

int A, I;
[A:= [3, 1, 4, 1, -5, 9, 2, 6, 5, 4];
GnomeSort(A, 10);
for I:= 0 to 10-1 do [IntOut(0, A(I));  ChOut(0, ^ )];
]


fcn gnomeSort(a){
   i,j,size := 1,2,a.len();
   while(i < size){
      if(a[i-1] > a[i]){ // for descending sort, use < for comparison
	 a.swap(i-1,i);
	 i = i - 1;
	 if(i) continue;
      }
      i = j;
      j = j + 1;
   }//while
   a
}


function combSort(input:Array)
{
	var gap:uint = input.length;
	var swapped:Boolean = false;
	while(gap > 1 || swapped)
	{
		gap /= 1.25;
		swapped = false;
		for(var i:uint = 0; i + gap < input.length; i++)
		{
			if(input[i] > input[i+gap])
			{
				var tmp = input[i];
				input[i] = input[i+gap];
				input[i+gap]=tmp;
				swapped = true;
			}
		}
	}
	return input;
}


with Ada.Text_IO;
procedure Comb_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 <>;
      with function "+" (Left : Index_Type; Right : Natural) return Index_Type is <>;
      with function "-" (Left : Index_Type; Right : Natural) return Index_Type is <>;
   procedure Comb_Sort (Data: in out Array_Type);

   procedure Comb_Sort (Data: in out Array_Type) is
      procedure Swap (Left, Right : in Index_Type) is
         Temp : Element_Type := Data(Left);
      begin
         Data(Left)  := Data(Right);
         Data(Right) := Temp;
      end Swap;
      Gap : Natural := Data'Length;
      Swap_Occured : Boolean;
   begin
      loop
         Gap := Natural (Float(Gap) / 1.25 - 0.5);
         if Gap < 1 then
            Gap := 1;
         end if;
         Swap_Occured := False;
         for I in Data'First .. Data'Last - Gap loop
            if Data (I) > Data (I+Gap) then
               Swap (I, I+Gap);
               Swap_Occured := True;
            end if;
         end loop;
         exit when Gap = 1 and not Swap_Occured;
      end loop;
   end Comb_Sort;

   type Integer_Array is array (Positive range <>) of Integer;
   procedure Int_Comb_Sort is new Comb_Sort (Integer, Positive, Integer_Array);
   Test_Array : Integer_Array := (1, 3, 256, 0, 3, 4, -1);
begin
   Int_Comb_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 Comb_Sort;


: merge-step ( right mid left -- right mid+ left+ )
  over @ over @ < if
    over @ >r
    2dup - over dup cell+ rot move
    r> over !
    >r cell+ 2dup = if rdrop dup else r> then
  then cell+ ;
: merge ( right mid left -- right left )
  dup >r begin 2dup > while merge-step repeat 2drop r> ;

: mid ( l r -- mid ) over - 2/ cell negate and + ;

: mergesort ( right left -- right left )
  2dup cell+ <= if exit then
  swap 2dup mid recurse rot recurse merge ;

: sort ( addr len -- )  cells over + swap mergesort 2drop ;

create test 8 , 1 , 5 , 3 , 9 , 0 , 2 , 7 , 6 , 4 ,

: .array ( addr len -- ) 0 do dup i cells + @ . loop drop ;

test 10 2dup sort .array       \ 0 1 2 3 4 5 6 7 8 9


      program TestMergeSort
        implicit none
        integer, parameter :: N = 8
        integer :: A(N) = (/ 1, 5, 2, 7, 3, 9, 4, 6 /)
        integer :: work((size(A) + 1) / 2)
        write(*,'(A,/,10I3)')'Unsorted array :',A
        call MergeSort(A, work)
        write(*,'(A,/,10I3)')'Sorted array :',A
      contains

      subroutine merge(A, B, C)
        implicit none
! The targe attribute is necessary, because A .or. B might overlap with C.
        integer, target, intent(in) :: A(:), B(:)
        integer, target, intent(inout) :: C(:)
        integer :: i, j, k

        if (size(A) + size(B) > size(C)) stop(1)

        i = 1; j = 1
        do k = 1, size(C)
          if (i <= size(A) .and. j <= size(B)) then
            if (A(i) <= B(j)) then
              C(k) = A(i)
              i = i + 1
            else
              C(k) = B(j)
              j = j + 1
            end if
          else if (i <= size(A)) then
            C(k) = A(i)
            i = i + 1
          else if (j <= size(B)) then
            C(k) = B(j)
            j = j + 1
          end if
        end do
      end subroutine merge

      subroutine swap(x, y)
        implicit none
        integer, intent(inout) :: x, y
        integer :: tmp
        tmp = x; x = y; y = tmp
      end subroutine

      recursive subroutine MergeSort(A, work)
        implicit none
        integer, intent(inout) :: A(:)
        integer, intent(inout) :: work(:)
        integer :: half
        half = (size(A) + 1) / 2
        if (size(A) < 2) then
          continue
        else if (size(A) == 2) then
          if (A(1) > A(2)) then
            call swap(A(1), A(2))
          end if
        else
          call MergeSort(A( : half), work)
          call MergeSort(A(half + 1 :), work)
          if (A(half) > A(half + 1)) then
            work(1 : half) = A(1 : half)
            call merge(work(1 : half), A(half + 1:), A)
          endif
        end if
      end subroutine MergeSort
      end program TestMergeSort


*        Counting sort             - 18/04/2020
COUNTS   CSECT
         USING  COUNTS,R13         base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         SAVE   (14,12)            save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         LA     R6,A               i=1
       DO WHILE=(C,R6,LE,=A(N))    do i=1 to hbound(a)
         L      R8,0(R6)             a(i)
         S      R8,MIN               k=a(i)-min
         LR     R1,R8                k
         SLA    R1,2                 ~
         L      R3,COUNT(R1)         count(k+1)
         LA     R3,1(R3)             +1
         ST     R3,COUNT(R1)         count(k+1)+=1
         LA     R6,4(R6)             i++
       ENDDO    ,                  enddo i
         LA     R7,A               j=1
         L      R6,MIN             i=min
       DO WHILE=(C,R6,LE,MAX)      do i=min to max
         LR     R8,R6                i
         S      R8,MIN               k=i-min
WHILEC   LR     R1,R8                while k
         SLA    R1,2                 ..... ~
         L      R2,COUNT(R1)         ..... count(k+1)
         LTR    R2,R2                ..... test
         BNP    WHENDC               ..... count(k+1)>0
         ST     R6,0(R7)               a(j)=i
         LA     R7,4(R7)               j++
         LR     R1,R8                  k
         SLA    R1,2                   ~
         L      R3,COUNT(R1)           count(k+1)
         BCTR   R3,0                   -1
         ST     R3,COUNT(R1)           count(k+1)-=1
         B      WHILEC               end while
WHENDC   AH     R6,=H'1'             i++
       ENDDO    ,                  enddo i
         LA     R9,PG              @buffer
         LA     R6,A               i=1
       DO WHILE=(C,R6,LE,=A(N))    do i=1 to hbound(a)
         L      R2,0(R6)             a(i)
         XDECO  R2,XDEC              edit a(i)
         MVC    0(3,R9),XDEC+9       output a(i)
         LA     R9,3(R9)             @buffer++
         LA     R6,4(R6)             i++
       ENDDO    ,                  enddo i
         XPRNT  PG,L'PG            print buffer
         L      R13,4(0,R13)       restore previous savearea pointer
         RETURN (14,12),RC=0       restore registers from calling save
MIN      DC     F'-9'              min
MAX      DC     F'99'              max
A        DC     F'98',F'35',F'15',F'46',F'6',F'64',F'92',F'44'
         DC     F'53',F'21',F'56',F'74',F'13',F'11',F'92',F'70'
         DC     F'43',F'2',F'-7',F'89',F'22',F'82',F'41',F'91'
         DC     F'28',F'51',F'0',F'39',F'29',F'34',F'15',F'26'
N        DC     A((N-A)/L'A)       hbound(a)
PG       DC     CL96' '            buffer
XDEC     DS     CL12               temp fo xdeco
COUNT    DC     200F'0'            count
         REGEQU
         END    COUNTS


/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program countSort64.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"
szCarriageReturn:   .asciz "\n"

.align 4
#Caution : number strictly positive and not too big
TableNumber:      .quad   1,3,6,2,5,9,10,8,4,5
//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,NBELEMENTS                              // number of élements
    bl searchMinMax
    mov x3,NBELEMENTS
    bl countSort
    ldr x0,qAdrTableNumber                         // address number table
    bl displayTable

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

qAdrsZoneConv:            .quad sZoneConv
qAdrszCarriageReturn:     .quad szCarriageReturn
qAdrsMessResult:          .quad sMessResult
qAdrTableNumber:          .quad TableNumber
qAdrszMessSortOk:         .quad szMessSortOk
qAdrszMessSortNok:        .quad szMessSortNok
/******************************************************************/
/*     control sorted table                                   */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the number of elements  > 0  */
/* x0 return table address  r1 return min  r2 return max */
searchMinMax:
    stp x3,lr,[sp,-16]!              // save  registers
    stp x3,x4,[sp,-16]!              // save  registers
    mov x3,x1                        // save size
    mov x1,1<<62                     // min
    mov x2,0                         // max
    mov x4,0                         // index
1:
    ldr x5,[x0,x4,lsl 3]
    cmp x5,x1
    csel x1,x5,x1,lt
    cmp x5,x2
    csel x2,x5,x2,gt
    add x4,x4,1
    cmp x4,x3
    blt 1b
100:
    ldp x4,x5,[sp],16                // restaur  2 registers
    ldp x3,lr,[sp],16                // restaur  2 registers
    ret                              // return to address lr x30
/******************************************************************/
/*     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
/******************************************************************/
/*         count sort                                             */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the minimum          */
/* x2 contains the maximum          */
/* x3 contains area size            */
/* caution : the count area is in the stack. if max is very large, risk of error */
countSort:
    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 x3,x3,1                // compute endidx = n - 1
    sub x5,x2,x1               // compute max - min
    add x5,x5,1                // + 1
    lsl x9,x5,3                // 8 bytes by number
    sub sp,sp,x9               // reserve count area in stack
    mov fp,sp                  // frame pointer = stack
    mov x6,0
    mov x4,0
1:                             // loop init stack area
    str x6,[fp,x4, lsl 3]
    add x4,x4,#1
    cmp x4,x5
    blt 1b
    mov x4,#0                  // indice
2:                             // start loop 2
    ldr x5,[x0,x4,lsl 3]       // load value A[j]
    sub x5,x5,x1               // - min
    ldr x6,[fp,x5,lsl 3]       // load count of value
    add x6,x6,1                // increment counter
    str x6,[fp,x5,lsl 3]       // and store
    add x4,x4,1                // increment indice
    cmp x4,x3                  // end ?
    ble 2b                     // no -> loop 2

    mov x7,0                   // z
    mov x4,x1                  // index = min
3:                             // start loop 3
    sub x6,x4,x1               // compute index - min
    ldr x5,[fp,x6,lsl 3]       // load count
4:                             // start loop 4
    cmp x5,0                   // count <> zéro
    beq 5f
    str x4,[x0,x7,lsl 3]       // store value A[j]
    add x7,x7,1                // increment z
    sub x5,x5,1                // decrement count
    b  4b

5:
    add x4,x4,1                // increment index
    cmp x4,x2                  // max ?
    ble 3b                     // no -> loop 3

    add sp,sp,x9               // stack alignement

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

/******************************************************************/
/*      Display table elements                                */
/******************************************************************/
/* x0 contains the address of table */
displayTable:
    stp x1,lr,[sp,-16]!              // save  registers
    stp x2,x3,[sp,-16]!              // save  registers
    mov x2,x0                        // table address
    mov x3,0
1:                                   // loop display table
    ldr x0,[x2,x3,lsl 3]
    ldr x1,qAdrsZoneConv
    bl conversion10S                  // décimal conversion
    ldr x0,qAdrsMessResult
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc            // insert result at @ character
    bl affichageMess                 // display message
    add x3,x3,1
    cmp x3,NBELEMENTS - 1
    ble 1b
    ldr x0,qAdrszCarriageReturn
    bl affichageMess
    mov x0,x2                       // table address
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"


DEFINE MAXSIZE="100"

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 CountingSort(INT ARRAY a INT size,min,max)
  INT ARRAY count(MAXSIZE)
  INT n,i,num,z

  n=max-min+1
  FOR i=0 TO n-1
  DO count(i)=0 OD

  FOR i=0 TO size-1
  DO
    num=a(i)
    count(num-min)==+1
  OD

  z=0
  FOR i=min TO max
  DO
    WHILE count(i-min)>0
    DO
      a(z)=i
      z==+1
      count(i-min)==-1
    OD
  OD
RETURN

PROC Test(INT ARRAY a INT size,min,max)
  PrintE("Array before sort:")
  PrintArray(a,size)
  CountingSort(a,size,min,max)
  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,-6,20)
  Test(b,21,-10,10)
  Test(c,8,101,108)
  Test(d,12,-1,1)
RETURN


function countingSort(array:Array, min:int, max:int)
{
	var count:Array = new Array(array.length);
	for(var i:int = 0; i < count.length;i++)count[i]=0;
	for(i = 0; i < array.length; i++)
	{
		count[array[i]-min] ++;
	}
	var j:uint = 0;
	for(i = min; i <= max; i++)
	{
		for(; count[i-min] > 0; count[i-min]--)
			array[j++] = i;
	}
	return array;
}


proc cocktailShakerSort[T](a: var openarray[T]) =

  var beginIdx = 0
  var endIdx = a.len - 2

  while beginIdx <= endIdx:
    var newBeginIdx = endIdx
    var newEndIdx = beginIdx
    for i in beginIdx..endIdx:
      if a[i] > a[i + 1]:
        swap a[i], a[i + 1]
        newEndIdx = i

    endIdx = newEndIdx - 1

    for i in countdown(endIdx, beginIdx):
      if a[i] > a[i + 1]:
        swap a[i], a[i + 1]
        newBeginIdx = i

    beginIdx = newBeginIdx + 1

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


use strict;
use warnings;
use feature 'say';

sub cocktail_sort {
    my @a = @_;
    my ($min, $max) = (0, $#a-1);
    while (1) {
        my $swapped_forward = 0;
        for my $i ($min .. $max) {
            if ($a[$i] gt $a[$i+1]) {
                @a[$i, $i+1] = @a[$i+1, $i];
                $swapped_forward = 1
            }
        }
        last if not $swapped_forward;
        $max -= 1;

        my $swapped_backward = 0;
        for my $i (reverse $min .. $max) {
            if ($a[$i] gt $a[$i+1]) {
                @a[$i, $i+1] = @a[$i+1, $i];
                $swapped_backward = 1;
            }
        }
        last if not $swapped_backward;
        $min += 1;
    }
    @a
}

say join ' ', cocktail_sort( <t h e q u i c k b r o w n f o x j u m p s o v e r t h e l a z y d o g> );


with javascript_semantics

function cocktailShakerSort(sequence s)
    s = deep_copy(s)
    integer beginIdx = 1,
            endIdx = length(s)-1
    while beginIdx <= endIdx do
        integer newBeginIdx = endIdx,
                newEndIdx = beginIdx
        for ii=beginIdx to endIdx do
            object si = s[ii],
                   sn = s[ii+1]
            if si>sn then
                s[ii] = sn
                s[ii+1] = si
                newEndIdx = ii
            end if
        end for
        -- elements after `newEndIdx` are now in correct order
        endIdx = newEndIdx - 1
        for ii=endIdx to beginIdx by -1 do
            object si = s[ii],
                   sn = s[ii+1]
            if si>sn then
                s[ii] = sn
                s[ii+1] = si
                newBeginIdx = ii
            end if
        end for
        -- elements before `newBeginIdx` are now in correct order.
        beginIdx = newBeginIdx + 1
    end while
    return s
end function
sequence s = shuffle(tagset(12))  ?{s,cocktailShakerSort(s)}
s = {"one","two","three","four"}  ?{s,cocktailShakerSort(s)}


(define keep
  _    []       -> []
  Pred [A|Rest] -> [A | (keep Pred Rest)] where (Pred A)
  Pred [_|Rest] -> (keep Pred Rest))

(define quicksort
  []    -> []
  [A|R] -> (append (quicksort (keep (>= A) R))
                   [A]
                   (quicksort (keep (< A) R))))

(quicksort [6 8 5 9 3 2 2 1 4 7])


BEGIN # comb sort #
    PR read "rows.incl.a68" PR # include row (array) utilities - SHOW is used to display the array #
    # comb-sorts in-place the array of integers input #
    PROC comb sort = ( REF[]INT input )VOID:
         IF INT  input size = ( UPB input - LWB input ) + 1;
            input size > 1
         THEN # more than one element, so must sort #
            INT  gap     := input size; # initial gap is the whole array size #
            BOOL swapped := TRUE;
            WHILE gap /= 1 OR swapped DO
                # update the gap value for a next comb #
                gap := ENTIER ( gap / 1.25 );
                IF gap < 1 THEN
                    # ensure the gap is at least 1 #
                    gap := 1
                FI;
                INT i := LWB input;
                swapped := FALSE;
                # a single "comb" over the input list #
                FOR i FROM LWB input WHILE i + gap <= UPB input DO
                    INT t     = input[ i ];
                    INT i gap = i + gap;
                    IF t > input[ i gap ] THEN
                        # need to swap out-of-order items #
                        input[ i     ] := input[ i gap ];
                        input[ i gap ] := t;
                        swapped := TRUE # Flag a swap has occurred, so the list is not guaranteed sorted yet #
                    FI
                OD
            OD
         FI # comb sort # ;
    # test #
    [ 1 : 7 ]INT data := ( 9, -4, 0, 2, 3, 77, 1 );  # data to sort #
    SHOW data;
    comb sort( data );
    print( ( " -> " ) );
    SHOW data
END


begin % comb sort %
    % comb-sorts in-place the array of integers input with bounds lb :: ub %
    procedure combSort ( integer array input ( * )
                       ; integer value lb, ub
                       ) ;
    begin
        integer inputSize, gap, i;
        inputSize := ( ub - lb ) + 1;
        if inputSize > 1 then begin
            % more than one element, so must sort %
            logical swapped;
            gap     := inputSize; % initial gap is the whole array size %
            swapped := true;
            while gap not = 1 or swapped do begin
                % update the gap value for a next comb %
                gap := entier( gap / 1.25 );
                if gap < 1 then begin
                    % ensure the gap is at least 1 %
                    gap := 1
                end if_gap_lt_1 ;
                swapped := false;
                % a single "comb" over the input list %
                i := lb;
                while i + gap <= ub do begin
                    integer t, iGap;
                    t    := input( i );
                    iGap := i + gap;
                    if t > input( iGap ) then begin
                        % need to swap out-of-order items %
                        input( i    ) := input( iGap );
                        input( iGap ) := t;
                        swapped := true % Flag a swap has occurred, so the list is not guaranteed sorted yet %
                    end if_t_gt_input__iGap ;
                    i := i + 1
                end while_i_plus_gap_le_ub
            end while_gap_ne_1_or_swapped
        end if_inputSize_gt_1
    end combSort ;
    begin % test %
        integer array data ( 1 :: 7 );
        integer       dPos;
        dPos := 0;
        for v := 9, -4, 0, 2, 3, 77, 1 do begin dPos := dPos + 1; data( dPos ) := v end;
        for i := 1 until 7 do writeon( i_w := 1, s_w := 0, " ", data( i ) );
        combSort( data, 1, 7 );
        writeon( ( " -> " ) );
        for i := 1 until 7 do writeon( i_w := 1, s_w := 0, " ", data( i ) )
    end
end.


' FB 1.05.0 Win64

Sub copyArray(a() As Integer, iBegin As Integer, iEnd As Integer, b() As Integer)
  Redim b(iBegin To iEnd - 1) As Integer
  For k As Integer = iBegin To iEnd - 1
    b(k) = a(k)
  Next
End Sub

' Left source half is  a(iBegin  To iMiddle-1).
' Right source half is a(iMiddle To iEnd-1).
' Result is            b(iBegin  To iEnd-1).
Sub topDownMerge(a() As Integer, iBegin As Integer, iMiddle As Integer, iEnd As Integer, b() As Integer)
  Dim i As Integer = iBegin
  Dim j As Integer = iMiddle

  ' While there are elements in the left or right runs...
  For k As Integer = iBegin To iEnd - 1
  ' If left run head exists and is <= existing right run head.
    If i < iMiddle AndAlso (j >= iEnd OrElse a(i) <= a(j)) Then
      b(k) = a(i)
      i += 1
    Else
      b(k) = a(j)
      j += 1
    End If
  Next
End Sub

' Sort the given run of array a() using array b() as a source.
' iBegin is inclusive; iEnd is exclusive (a(iEnd) is not in the set).
Sub topDownSplitMerge(b() As Integer, iBegin As Integer, iEnd As Integer, a() As Integer)
  If (iEnd - iBegin) < 2 Then Return  '' If run size = 1, consider it sorted
  ' split the run longer than 1 item into halves
  Dim iMiddle As Integer = (iEnd + iBegin) \ 2  '' iMiddle = mid point
  ' recursively sort both runs from array a() into b()
  topDownSplitMerge(a(), iBegin,  iMiddle, b())  '' sort the left  run
  topDownSplitMerge(a(), iMiddle, iEnd, b())     '' sort the right run
  ' merge the resulting runs from array b() into a()
  topDownMerge(b(), iBegin, iMiddle, iEnd, a())
End Sub

' Array a() has the items to sort; array b() is a work array (empty initially).
Sub topDownMergeSort(a() As Integer, b() As Integer, n As Integer)
  copyArray(a(), 0, n, b())  '' duplicate array a() into b()
  topDownSplitMerge(b(), 0, n, a())  '' sort data from b() into a()
End Sub

Sub printArray(a() As Integer)
  For i As Integer = LBound(a) To UBound(a)
    Print Using "####"; a(i);
  Next
  Print
End Sub

Dim a(0 To 9) As Integer = {4, 65, 2, -31, 0, 99, 2, 83, 782, 1}

Dim b() As Integer
Print "Unsorted : ";
printArray(a())
topDownMergeSort a(), b(), 10
Print "Sorted   : ";
printArray(a())
Print
Dim a2(0 To 8) As Integer = {7, 5, 2, 6, 1, 4, 2, 6, 3}
Erase b
Print "Unsorted : ";
printArray(a2())
topDownMergeSort a2(), b(), 9
Print "Sorted   : ";
printArray(a2())
Print
Print "Press any key to quit"
Sleep


with Ada.Text_Io; use Ada.Text_Io;

procedure Counting_Sort is
   type Data is array (Integer range <>) of Natural;
   procedure Sort(Item : out Data) is
   begin
      for I in Item'range loop
         Item(I) := I;
      end loop;
   end Sort;
   Stuff : Data(1..140);
begin
   Sort(Stuff);
   for I in Stuff'range loop
      Put(Natural'Image(Stuff(I)));
   end loop;
   New_Line;
end Counting_Sort;


PROC counting sort mm = (REF[]INT array, INT min, max)VOID:
(
  INT z := LWB array - 1;
  [min:max]INT count;

  FOR i FROM LWB count TO UPB count DO count[i] := 0 OD;
  FOR i TO UPB array DO count[ array[i] ]+:=1 OD;

  FOR i FROM LWB count TO UPB count DO
    FOR j TO count[i] DO array[z+:=1] := i OD
  OD
);

PROC counting sort = (REF[]INT array)VOID:
(
  INT min, max;
  min := max := array[LWB array];

  FOR i FROM LWB array + 1 TO UPB array DO
    IF array[i] < min THEN
      min := array[i]
    ELIF array[i] > max THEN
      max := array[i]
    FI
  OD
);

# Testing (we suppose the oldest human being is less than 140 years old). #

INT n = 100;
INT min age = 0, max age = 140;
main:
(
  [n]INT ages;

  FOR i TO UPB ages DO ages[i] := ENTIER (random * ( max age + 1 ) ) OD;
  counting sort mm(ages, min age, max age);
  FOR i TO UPB ages DO print((" ", whole(ages[i],0))) OD;
  print(new line)
)


"""

Python example of

http://rosettacode.org/wiki/Sorting_algorithms/Cocktail_sort_with_shifting_bounds

based on

http://rosettacode.org/wiki/Sorting_algorithms/Cocktail_sort#Python

"""

def cocktailshiftingbounds(A):
    beginIdx = 0
    endIdx = len(A) - 1

    while beginIdx <= endIdx:
        newBeginIdx = endIdx
        newEndIdx = beginIdx
        for ii in range(beginIdx,endIdx):
            if A[ii] > A[ii + 1]:
                A[ii+1], A[ii] = A[ii], A[ii+1]
                newEndIdx = ii

        endIdx = newEndIdx

        for ii in range(endIdx,beginIdx-1,-1):
            if A[ii] > A[ii + 1]:
                A[ii+1], A[ii] = A[ii], A[ii+1]
                newBeginIdx = ii

        beginIdx = newBeginIdx + 1

test1 = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0]
cocktailshiftingbounds(test1)
print(test1)

test2=list('big fjords vex quick waltz nymph')
cocktailshiftingbounds(test2)
print(''.join(test2))


sub cocktail_sort ( @a ) {
    my ($min, $max) = 0, +@a - 2;
    loop {
        my $swapped_forward = 0;
        for $min .. $max -> $i {
            given @a[$i] cmp @a[$i+1] {
                when More {
                    @a[ $i, $i+1 ] .= reverse;
                    $swapped_forward = 1
                }
                default {}
            }
        }
        last if not $swapped_forward;
        $max -= 1;

        my $swapped_backward = 0;
        for ($min .. $max).reverse -> $i {
            given @a[$i] cmp @a[$i+1] {
                when More {
                    @a[ $i, $i+1 ] .= reverse;
                    $swapped_backward = 1
                }
                default {}
            }
        }
        last if not $swapped_backward;
        $min += 1;
    }
    @a
}

my @weights = (flat 0..9, 'A'..'F').roll(2 + ^4 .roll).join xx 100;
say @weights.sort.Str eq @weights.&cocktail_sort.Str ?? 'ok' !! 'not ok';


[ stack ]                      is less      (     --> s )

[ stack ]                      is same      (     --> s )

[ stack ]                      is more      (     --> s )

[ - -1 1 clamp 1+ ]            is <=>       ( n n --> n )

[ tuck take join swap put ]    is append    ( x s -->   )

[ dup size 2 < if done
  [] less put
  [] same put
  [] more put
  behead swap witheach
    [ 2dup swap <=>
      [ table less same more ]
      append ]
  same append
  less take recurse
  same take join
  more take recurse join ]     is quicksort (   [ --> [ )

[] 10 times [ i^ join ] 3 of
dup       echo cr
quicksort echo cr


qsort <- function(v) {
  if ( length(v) > 1 )
  {
    pivot <- (min(v) + max(v))/2.0                            # Could also use pivot <- median(v)
    c(qsort(v[v < pivot]), v[v == pivot], qsort(v[v > pivot]))
  } else v
}

N <- 100
vs <- runif(N)
system.time(u <- qsort(vs))
print(u)


-- Comb sort with insertion sort finish.
-- Comb sort algorithm: Włodzimierz Dobosiewicz and Artur Borowy, 1980. Stephen Lacey and Richard Box, 1991.

on combSort(theList, l, r) -- Sort items l thru r of theLIst.
    set listLen to (count theList)
    if (listLen < 2) then return
    -- Negative and/or transposed range indices.
    if (l < 0) then set l to listLen + l + 1
    if (r < 0) then set r to listLen + r + 1
    if (l > r) then set {l, r} to {r, l}

    script o
        property lst : theList
    end script

    -- This implementation performs fastest with a comb gap divisor of 1.4
    -- and the insertion sort taking over when the gap's down to 8 or less.
    set divisor to 1.4
    set gap to (r - l + 1) div divisor
    repeat while (gap > 8)
        repeat with i from l to (r - gap)
            set j to i + gap
            set lv to o's lst's item i
            set rv to o's lst's item j
            if (lv > rv) then
                set o's lst's item i to rv
                set o's lst's item j to lv
            end if
        end repeat
        set gap to gap div divisor
    end repeat

    insertionSort(theList, l, r)

    return -- nothing.
end combSort

on insertionSort(theList, l, r) -- Sort items l thru r of theList.
    set listLength to (count theList)
    if (listLength < 2) then return
    if (l < 0) then set l to listLength + l + 1
    if (r < 0) then set r to listLength + r + 1
    if (l > r) then set {l, r} to {r, l}

    script o
        property lst : theList
    end script

    set highestSoFar to o's lst's item l
    set rv to o's lst's item (l + 1)
    if (highestSoFar > rv) then
        set o's lst's item l to rv
    else
        set highestSoFar to rv
    end if
    repeat with j from (l + 2) to r
        set rv to o's lst's item j
        if (highestSoFar > rv) then
            repeat with i from (j - 2) to l by -1
                set lv to o's lst's item i
                if (lv > rv) then
                    set o's lst's item (i + 1) to lv
                else
                    set i to i + 1
                    exit repeat
                end if
            end repeat
            set o's lst's item i to rv
        else
            set o's lst's item (j - 1) to highestSoFar
            set highestSoFar to rv
        end if
    end repeat
    set o's lst's item r to highestSoFar

    return -- nothing.
end insertionSort

-- Demo:
local aList
set aList to {7, 56, 70, 22, 94, 42, 5, 25, 54, 90, 29, 65, 87, 27, 4, 5, 86, 8, 2, 30, 87, 12, 85, 86, 7}
combSort(aList, 1, -1) -- Sort items 1 thru -1 of aList.
aList


def
  sort( [] )          =  []
  sort( [x] )         =  [x]
  sort( xs )          =
    val (l, r) = xs.splitAt( xs.length()\2 )
    merge( sort(l), sort(r) )

  merge( [], xs )     =  xs
  merge( xs, [] )     =  xs
  merge( x:xs, y:ys )
    | x <= y          =  x : merge( xs, y:ys )
    | otherwise       =  y : merge( x:xs, ys )

println( sort([94, 37, 16, 56, 72, 48, 17, 27, 58, 67]) )
println( sort(['Sofía', 'Alysha', 'Sophia', 'Maya', 'Emma', 'Olivia', 'Emily']) )


package main

import "fmt"

var a = []int{170, 45, 75, -90, -802, 24, 2, 66}
var s = make([]int, len(a)/2+1) // scratch space for merge step

func main() {
    fmt.Println("before:", a)
    mergeSort(a)
    fmt.Println("after: ", a)
}

func mergeSort(a []int) {
    if len(a) < 2 {
        return
    }
    mid := len(a) / 2
    mergeSort(a[:mid])
    mergeSort(a[mid:])
    if a[mid-1] <= a[mid] {
        return
    }
    // merge step, with the copy-half optimization
    copy(s, a[:mid])
    l, r := 0, mid
    for i := 0; ; i++ {
        if s[l] <= a[r] {
            a[i] = s[l]
            l++
            if l == mid {
                break
            }
        } else {
            a[i] = a[r]
            r++
            if r == len(a) {
                copy(a[i+1:], s[l:mid])
                break
            }
        }
    }
    return
}


/* ARM assembly Raspberry PI  */
/*  program countSort.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"

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

.align 4
#Caution : number stritcly positive and not too big
#TableNumber:      .int   1,3,6,2,5,9,10,8,5,7       @ for test 2 sames values
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,#NBELEMENTS                             @ number of élements
    bl searchMinMax                                @ r1=min r2=max
    mov r3,#NBELEMENTS                             @ number of élements
    bl countSort
    ldr r0,iAdrTableNumber                         @ address number table
    bl displayTable

    ldr r0,iAdrTableNumber                         @ address number table
    mov r1,#NBELEMENTS                             @ number of élements
    bl isSorted                                    @ control sort
    cmp r0,#1                                      @ sorted ?
    beq 2f
    ldr r0,iAdrszMessSortNok                       @ no !! error sort
    bl affichageMess
    b 100f
2:                                                 @ 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
/******************************************************************/
/*     control sorted table                                   */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the éléments number  */
/* r0 return address r1 return min  r2 return max */
searchMinMax:
    push {r3-r5,lr}                @ save registers
    mov r3,r1                      @ save size
    mov r1,#1<<30                  @ min
    mov r2,#0                      @ max
    mov r4,#0                      @ index
1:
    ldr r5,[r0,r4, lsl #2]         @ load value
    cmp r5,r1                      @ if < min
    movlt r1,r5
    cmp r5,r2                      @ if > max
    movgt r2,r5
    add r4,r4,#1                   @ increment index
    cmp r4,r3                      @ end ?
    blt 1b                         @ no -> loop
100:
    pop {r3-r5,lr}
    bx lr                                              @ return
/******************************************************************/
/*     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
/******************************************************************/
/*         count Sort                                          */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the minimum    */
/* r2 contains the maximun */
/* r3 contains elements number */
/* caution : the count area is in the stack. if max is very large, risk of error */
countSort:
    push {r1-r9,lr}           @ save registers
    sub r3,r3,#1              @ compute end index
    sub r5,r2,r1              @ compute max - min
    add r5,r5,#1              @ + 1
    lsl r9,r5,#2              @ 4 bytes by number
    sub sp,sp,r9              @ reserve area on stack
    mov fp,sp                 @ frame pointer = stack address
    mov r6,#0
    mov r4,#0
1:                            @ loop init stack area
    str r6,[fp,r4, lsl #2]
    add r4,r4,#1
    cmp r4,r5
    blt 1b
    mov r4,#0                 @ indice
2:                            @ start loop 2
    ldr r5,[r0,r4,lsl #2]     @ load value A[j]
    sub r5,r5,r1              @ - min
    ldr r6,[fp,r5,lsl #2]     @ load count of value
    add r6,r6,#1              @ increment counter
    str r6,[fp,r5,lsl #2]     @ and store
    add r4,#1                 @ increment indice
    cmp r4,r3                 @ end ?
    ble 2b                    @ no -> loop 2

    mov r7,#0                 @ z
    mov r4,r1                 @ indice = min
    //bl displayTable
3:                            @ loop 3
    sub r6,r4,r1              @ compute index - min
    ldr r5,[fp,r6,lsl #2]     @ load count
4:                            @ loop 4
    cmp r5,#0                 @ cont <> zero
    beq 5f
    str r4,[r0,r7,lsl #2]     @ store value
    add r7,r7,#1              @ increment z
    sub r5,r5,#1              @ decrement count
    b 4b
5:
    add r4,r4,#1              @ decrement indice
    cmp r4,r2                 @ max ?
    ble 3b                    @ no -> loop 3

    add sp,sp,r9              @ stack alignement
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"


/*REXX program sorts an array using the   cocktail─sort   method  with shifting bounds. */
call gen                                         /*generate some array elements.        */
call show  'before sort'                         /*show  unsorted  array elements.      */
     say copies('█', 101)                        /*show a separator line  (a fence).    */
call cocktailSort  #                             /*invoke the cocktail sort subroutine. */
call show  ' after sort'                         /*show    sorted  array elements.      */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
cocktailSort: procedure expose @.;    parse arg N             /*N:  is number of items. */
                                      end$= N - 1;     beg$= 1
                     do while beg$ <= end$
                     beg$$= end$;               end$$= beg$
                        do j=beg$ to end$;                   jp= j + 1
                        if @.j>@.jp  then do;  [email protected].j;  @.[email protected].jp;  @.jp=_;  end$$=j;  end
                        end   /*j*/
                     end$= end$$ - 1
                        do k=end$  to beg$  by -1;           kp= k + 1
                        if @.k>@.kp  then do;  [email protected].k;  @.[email protected].kp;  @.kp=_;  beg$$=k;  end
                        end   /*k*/
                     beg$= beg$$ + 1
                     end      /*while*/
              return
/*──────────────────────────────────────────────────────────────────────────────────────*/
gen: @.=                                        /*assign a default value for the stem. */
     @.1 = '---the 22 card tarot deck (larger deck has 56 additional cards in 4 suits)---'
     @.2 = '==========symbol====================pip======================================'
     @.3 = 'the juggler                  ◄───     I'
     @.4 = 'the high priestess  [Popess] ◄───    II'
     @.5 = 'the empress                  ◄───   III'
     @.6 = 'the emperor                  ◄───    IV'
     @.7 = 'the hierophant  [Pope]       ◄───     V'
     @.8 = 'the lovers                   ◄───    VI'
     @.9 = 'the chariot                  ◄───   VII'
     @.10= 'justice                      ◄───  VIII'
     @.11= 'the hermit                   ◄───    IX'
     @.12= 'fortune  [the wheel of]      ◄───     X'
     @.13= 'strength                     ◄───    XI'
     @.14= 'the hanging man              ◄───   XII'
     @.15= 'death  [often unlabeled]     ◄───  XIII'
     @.16= 'temperance                   ◄───   XIV'
     @.17= 'the devil                    ◄───    XV'
     @.18= 'lightning  [the tower]       ◄───   XVI'
     @.18= 'the stars                    ◄───  XVII'
     @.20= 'the moon                     ◄─── XVIII'
     @.21= 'the sun                      ◄───   XIX'
     @.22= 'judgment                     ◄───    XX'
     @.23= 'the world                    ◄───   XXI'
     @.24= 'the fool  [often unnumbered] ◄───  XXII'

            do #= 1  until @.#==''; end;  #= #-1 /*find how many entries in the array.  */
     return                                      /* [↑]  adjust for DO loop advancement.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
show: w= length(#);               do j=1  for #      /*#:  is the number of items in @. */
                                  say 'element'    right(j, w)     arg(1)":"    @.j
                                  end   /*j*/        /*     ↑                           */
      return                                         /*     └─────max width of any line.*/


fn cocktail_shaker_sort<T: PartialOrd>(a: &mut [T]) {
    let mut begin = 0;
    let mut end = a.len();
    if end == 0 {
        return;
    }
    end -= 1;
    while begin < end {
        let mut new_begin = end;
        let mut new_end = begin;
        for i in begin..end {
            if a[i + 1] < a[i] {
                a.swap(i, i + 1);
                new_end = i;
            }
        }
        end = new_end;
        let mut i = end;
        while i > begin {
            if a[i] < a[i - 1] {
                a.swap(i, i - 1);
                new_begin = i;
            }
            i -= 1;
        }
        begin = new_begin;
    }
}

fn main() {
    let mut v = vec![5, 1, -6, 12, 3, 13, 2, 4, 0, 15];
    println!("before: {:?}", v);
    cocktail_shaker_sort(&mut v);
    println!("after:  {:?}", v);
}


func cocktailShakerSort<T: Comparable>(_ a: inout [T]) {
    var begin = 0
    var end = a.count
    if end == 0 {
        return
    }
    end -= 1
    while begin < end {
        var new_begin = end
        var new_end = begin
        var i = begin
        while i < end {
            if a[i + 1] < a[i] {
                a.swapAt(i, i + 1)
                new_end = i
            }
            i += 1
        }
        end = new_end
        i = end
        while i > begin {
            if a[i] < a[i - 1] {
                a.swapAt(i, i - 1)
                new_begin = i
            }
            i -= 1
        }
        begin = new_begin
    }
}

var array = [5, 1, -6, 12, 3, 13, 2, 4, 0, 15]
print("before: \(array)")
cocktailShakerSort(&array)
print(" after: \(array)")

var array2 = ["one", "two", "three", "four", "five", "six", "seven", "eight"]
print("before: \(array2)")
cocktailShakerSort(&array2)
print(" after: \(array2)")


#lang racket
(define (quicksort < l)
  (match l
    ['() '()]
    [(cons x xs)
     (let-values ([(xs-gte xs-lt) (partition (curry < x) xs)])
       (append (quicksort < xs-lt)
               (list x)
               (quicksort < xs-gte)))]))


/* ARM assembly Raspberry PI  */
/*  program combSort.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"
szCarriageReturn:   .asciz "\n"

.align 4
#TableNumber:      .int   1,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

1:
    ldr r0,iAdrTableNumber                         @ address number table
    mov r1,#0
    mov r2,#NBELEMENTS                             @ number of élements
    bl combSort
    ldr r0,iAdrTableNumber                         @ address number table
    bl displayTable

    ldr r0,iAdrTableNumber                         @ address number table
    mov r1,#NBELEMENTS                             @ number of élements
    bl isSorted                                    @ control sort
    cmp r0,#1                                      @ sorted ?
    beq 2f
    ldr r0,iAdrszMessSortNok                       @ no !! error sort
    bl affichageMess
    b 100f
2:                                                 @ 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
/******************************************************************/
/*     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
/******************************************************************/
/*         comb Sort                                          */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the first element    */
/* r2 contains the number of element */
/* this routine use à factor to 1.28  see wikipedia for best factor */
combSort:
    push {r1-r9,lr}           @ save registers
    sub r9,r2,r1              @ compute gap
    sub r2,r2,#1              @ compute end index = n - 1
    mov r7,#100
1:                            @ start loop 1
    mul r9,r7,r9              @ gap multiply by 100
    lsrs r9,#7                @ divide by 128   equi * 0,78125 equi divide by 1,28
    moveq r9,#1               @ if gap = 0 -> gap = 1
    mov r8,#0                 @ swaps
    mov r3,r1                 @ indice
2:                            @ start loop 2
    add r4,r3,r9
    cmp r4,r2                 @ end ?
    bgt 3f
    ldr r5,[r0,r3,lsl #2]     @ load value A[j]
    ldr r6,[r0,r4,lsl #2]     @ load value A[j+1]
    cmp r6,r5                 @ compare value
    strlt r6,[r0,r3,lsl #2]   @ if smaller inversion
    strlt r5,[r0,r4,lsl #2]
    movlt r8,#1               @ swaps = 1
    add r3,#1                 @ increment indice
    b 2b                      @ loop 2

3:
    @ bl displayTable
    cmp r9,#1                 @ gap = 1 ?
    bne 1b
    cmp r8,#1                 @ swaps ?
    beq 1b                    @ yes -> loop 1

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
100:
    pop {r0-r3,lr}
    bx lr
iAdrsZoneConv:           .int sZoneConv
/***************************************************/
/*      ROUTINES INCLUDE                           */
/***************************************************/
.include "../affichage.inc"


def merge = { List left, List right ->
    List mergeList = []
    while (left && right) {
        print "."
        mergeList << ((left[-1] > right[-1]) ? left.pop() : right.pop())
    }
    mergeList = mergeList.reverse()
    mergeList = left + right + mergeList
}

def mergeSort;
mergeSort = { List list ->

    def n = list.size()
    if (n < 2) return list

    def middle = n.intdiv(2)
    def left = [] + list[0..<middle]
    def right = [] + list[middle..<n]
    left = mergeSort(left)
    right = mergeSort(right)

    if (left[-1] <= right[0]) return left + right

    merge(left, right)
}


countingSort: function [items, minimum, maximum][
    a: new items
    rng: inc maximum - minimum
    cnt: array.of: rng 0
    z: 0

    loop 0..dec size a 'i [
        mm: a\[i]-minimum
        cnt\[mm]: cnt\[mm] + 1
    ]

    loop minimum..maximum 'i [
        loop 0..dec cnt\[i-minimum] 'j [
            a\[z]: i
            z: z + 1
        ]
    ]
    return a
]

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


MsgBox % CountingSort("-1,1,1,0,-1",-1,1)

CountingSort(ints,min,max) {
   Loop % max-min+1
      i := A_Index-1, a%i% := 0
   Loop Parse, ints, `, %A_Space%%A_Tab%
      i := A_LoopField-min, a%i%++
   Loop % max-min+1 {
      i := A_Index-1, v := i+min
      Loop % a%i%
         t .= "," v
   }
   Return SubStr(t,2)
}


' Sorting algorithms/Cocktail sort with shifting bounds - VBA

Function cocktailShakerSort(ByVal A As Variant) As Variant
    beginIdx = LBound(A)
    endIdx = UBound(A) - 1
    Do While beginIdx <= endIdx
        newBeginIdx = endIdx
        newEndIdx = beginIdx
        For ii = beginIdx To endIdx
            If A(ii) > A(ii + 1) Then
                tmp = A(ii): A(ii) = A(ii + 1): A(ii + 1) = tmp
                newEndIdx = ii
            End If
        Next ii
        endIdx = newEndIdx - 1
        For ii = endIdx To beginIdx Step -1
            If A(ii) > A(ii + 1) Then
                tmp = A(ii): A(ii) = A(ii + 1): A(ii + 1) = tmp
                newBeginIdx = ii
            End If
        Next ii
        beginIdx = newBeginIdx + 1
    Loop
    cocktailShakerSort = A
End Function 'cocktailShakerSort

Public Sub main()
    Dim B(20) As Variant
    For i = LBound(B) To UBound(B)
        B(i) = Int(Rnd() * 100)
    Next i
    Debug.Print Join(B, ", ")
    Debug.Print Join(cocktailShakerSort(B), ", ")
End Sub


' Sorting algorithms/Cocktail sort with shifting bounds - VBScript

Function cocktailShakerSort(ByVal A)
    beginIdx = Lbound(A)
    endIdx = Ubound(A)-1
    Do While beginIdx <= endIdx
        newBeginIdx = endIdx
        newEndIdx = beginIdx
        For ii = beginIdx To endIdx
            If A(ii) > A(ii+1) Then
                tmp=A(ii) : A(ii)=A(ii+1) : A(ii+1)=tmp
                newEndIdx = ii
            End If
        Next
        endIdx = newEndIdx - 1
        For ii = endIdx To beginIdx Step -1
            If A(ii) > A(ii+1) Then
                tmp=A(ii) : A(ii)=A(ii+1) : A(ii+1)=tmp
                newBeginIdx = ii
            End If
        Next
        beginIdx = newBeginIdx+1
    Loop
    cocktailShakerSort=A
End Function 'cocktailShakerSort

Dim B(20)
For i=Lbound(B) To Ubound(B)
    B(i)=Int(Rnd()*100)
Next
Wscript.Echo Join(cocktailShakerSort(B)," ")


' Sorting algorithms/Cocktail sort with shifting bounds - VB.Net
    Private Sub Cocktail_Shaker_Sort()
        Dim A(20), tmp As Long  'or Integer Long Single Double String
        Dim i, beginIdx, endIdx, newBeginIdx, newEndIdx As Integer
        'Generate the list
        For i = LBound(A) To UBound(A)
            A(i) = Int(Rnd() * 100)
        Next i
        'Sort the list
        beginIdx = LBound(A)
        endIdx = UBound(A) - 1
        Do While beginIdx <= endIdx
            newBeginIdx = endIdx
            newEndIdx = beginIdx
            For ii = beginIdx To endIdx
                If A(ii) > A(ii + 1) Then
                    tmp = A(ii) : A(ii) = A(ii + 1) : A(ii + 1) = tmp
                    newEndIdx = ii
                End If
            Next ii
            endIdx = newEndIdx - 1
            For ii = endIdx To beginIdx Step -1
                If A(ii) > A(ii + 1) Then
                    tmp = A(ii) : A(ii) = A(ii + 1) : A(ii + 1) = tmp
                    newBeginIdx = ii
                End If
            Next ii
            beginIdx = newBeginIdx + 1
        Loop
        'Display the sorted list
        Debug.Print(String.Join(", ", A))
    End Sub 'Cocktail_Shaker_Sort


# Empty list sorts to the empty list
 multi quicksort([]) { () }

 # Otherwise, extract first item as pivot...
 multi quicksort([$pivot, *@rest]) {
     # Partition.
     my $before := @rest.grep(* before $pivot);
     my $after  := @rest.grep(* !before $pivot);

     # Sort the partitions.
     flat quicksort($before), $pivot, quicksort($after)
 }


combSort: function [items][
    a: new items
    gap: size a
    swapped: true

    while [or? gap > 1 swapped][
        gap: (gap * 10) / 13
        if or? gap=9 gap=10 -> gap: 11
        if gap<1 -> gap: 1
        swapped: false
        i: 0
        loop gap..dec size items 'j [
            if a\[i] > a\[j] [
                tmp: a\[i]
                a\[i]: a\[j]
                a\[j]: tmp
                swapped: true
            ]
            i: i + 1
        ]
    ]
    return a
]

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


merge []         ys                   = ys
merge xs         []                   = xs
merge xs@(x:xt) ys@(y:yt) | x <= y    = x : merge xt ys
                          | otherwise = y : merge xs yt

split (x:y:zs) = let (xs,ys) = split zs in (x:xs,y:ys)
split [x]      = ([x],[])
split []       = ([],[])

mergeSort []  = []
mergeSort [x] = [x]
mergeSort xs  = let (as,bs) = split xs
                in merge (mergeSort as) (mergeSort bs)


procedure main()                                                         #: demonstrate various ways to sort a list and string
   demosort(mergesort,[3, 14, 1, 5, 9, 2, 6, 3],"qwerty")
end

procedure mergesort(X,op,lower,upper)                                    #: return sorted list ascending(or descending)
local middle

   if /lower := 1 then {                                                 # top level call setup
      upper := *X
      op := sortop(op,X)                                                 # select how and what we sort
      }

   if upper ~= lower then {                                              # sort all sections with 2 or more elements
      X := mergesort(X,op,lower,middle := lower + (upper - lower) / 2)
      X := mergesort(X,op,middle+1,upper)

      if op(X[middle+1],X[middle]) then                                  # @middle+1 < @middle merge if halves reversed
         X := merge(X,op,lower,middle,upper)
   }
   return X
end

procedure merge(X,op,lower,middle,upper)                                 # merge two list sections within a larger list
local p1,p2,add

   p1 := lower
   p2 := middle + 1
   add := if type(X) ~== "string" then put else "||"                     # extend X, strings require X := add (until ||:= is invocable)

   while p1 <= middle & p2 <= upper do
      if op(X[p1],X[p2]) then {                                          # @p1 < @p2
         X := add(X,X[p1])                                               # extend X temporarily (rather than use a separate temporary list)
         p1 +:= 1
         }
      else {
         X := add(X,X[p2])                                               # extend X temporarily
         p2 +:= 1
         }

   while X := add(X,X[middle >= p1]) do p1 +:= 1                         # and rest of lower or ...
   while X := add(X,X[upper  >= p2]) do p2 +:= 1                         # ... upper trailers if any

   if type(X) ~== "string" then                                          # pull section's sorted elements from extension
      every X[upper to lower by -1] := pull(X)
   else
      (X[lower+:(upper-lower+1)] := X[0-:(upper-lower+1)])[0-:(upper-lower+1)] := ""

   return X
end


# counting sort

n = 10

dim test(n)
test = {4, 65, 2, -31, 0, 99, 2, 83, 782, 1}

mn = -31
mx = 782

dim cnt(mx - mn + 1)  # count is a reserved string function name

# seems initialized as 0
# for i = 1 to n
#   print cnt[i]
# next i

# sort
for i = 0 to n-1
  cnt[test[i] - mn] = cnt[test[i] - mn] + 1
next i

# output
print "original"
for i = 0 to n-1
  print test[i] + " ";
next i
print
print "ordered"
for i = 0 to mx - mn
  if 0 < cnt[i] then  # for i = k to 0  causes error
    for k = 1 to cnt[i]
      print i + mn + " ";
    next k
  endif
next i
print


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

      DEF PROCcountingsort(a%(), l%, h%)
      LOCAL i%, z%, c%()
      DIM c%(h% - l%)
      FOR i% = 0 TO DIM(a%(),1)
        c%(a%(i%) - l%) += 1
      NEXT
      FOR i% = l% TO h%
        WHILE c%(i% - l%)
          a%(z%) = i%
          z% += 1
          c%(i% - l%) -= 1
        ENDWHILE
      NEXT
      ENDPROC


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

void counting_sort_mm(int *array, int n, int min, int max)
{
  int i, j, z;

  int range = max - min + 1;
  int *count = malloc(range * sizeof(*array));

  for(i = 0; i < range; i++) count[i] = 0;
  for(i = 0; i < n; i++) count[ array[i] - min ]++;

  for(i = min, z = 0; i <= max; i++) {
    for(j = 0; j < count[i - min]; j++) {
      array[z++] = i;
    }
  }

  free(count);
}

void min_max(int *array, int n, int *min, int *max)
{
  int i;

  *min = *max = array[0];
  for(i=1; i < n; i++) {
    if ( array[i] < *min ) {
      *min = array[i];
    } else if ( array[i] > *max ) {
      *max = array[i];
    }
  }
}


import "/fmt" for Fmt
import "random" for Random

// translation of pseudo-code
var cocktailShakerSort = Fn.new { |a|
    var begin = 0
    var end = a.count - 2
    while (begin <= end) {
        var newBegin = end
        var newEnd = begin
        for (i in begin..end) {
            if (a[i] > a[i+1]) {
                var t = a[i+1]
                a[i+1] = a[i]
                a[i] = t
                newEnd = i
            }
        }
        end = newEnd - 1
        if (end >= begin) {
            for (i in end..begin) {
                if (a[i] > a[i+1]) {
                    var t = a[i+1]
                    a[i+1] = a[i]
                    a[i] = t
                    newBegin = i
                }
            }
        }
        begin = newBegin + 1
    }
}

// from the RC Cocktail sort task (no optimizations)
var cocktailSort = Fn.new { |a|
    var last = a.count - 1
    while (true) {
        var swapped = false
        for (i in 0...last) {
            if (a[i] > a[i+1]) {
                var t = a[i]
                a[i] = a[i+1]
                a[i+1] = t
                swapped = true
            }
        }
        if (!swapped) return
        swapped = false
        if (last >= 1) {
            for (i in last-1..0) {
                if (a[i] > a[i+1]) {
                    var t = a[i]
                    a[i] = a[i+1]
                    a[i+1] = t
                    swapped = true
                }
            }
        }
        if (!swapped) return
    }
}

// First make sure the routines are working correctly.
var a = [21, 4, -9, 62, -7, 107, -62, 4, 0, -170]
System.print("Original array: %(a)")
var b = a.toList // make copy as sorts mutate array in place
cocktailSort.call(a)
System.print("Cocktail sort : %(a)")
cocktailShakerSort.call(b)
System.print("C/Shaker sort : %(b)")

// timing comparison code
var rand = Random.new()
System.print("\nRelative speed of the two sorts")
System.print("  N    x faster (CSS v CS)")
System.print("-----  -------------------")
var runs = 5 // average over 5 runs say
for (n in [1000, 2000, 4000, 8000, 10000, 20000]) {
    var sum = 0
    for (i in 1..runs) {
        // get 'n' random numbers in range [0, 100,000]
        // with every other number being negated
        var nums = List.filled(n, 0)
        for (i in 0...n) {
            var rn = rand.int(100000)
            if (i%2 == 1) rn = -rn
            nums[i] = rn
        }
        // copy the array
        var nums2 = nums.toList

        var start = System.clock
        cocktailSort.call(nums)
        var elapsed = System.clock - start
        var start2 = System.clock
        cocktailShakerSort.call(nums2)
        var elapsed2 = System.clock - start2
        sum = sum + elapsed/elapsed2
    }
    System.print(" %(Fmt.d(2, (n/1000).floor))k      %(Fmt.f(0, sum/runs, 3))")
}


Red []

;;-------------------------------
;; we have to use function not func here, otherwise we'd have to define all "vars" as local...
qsort: function [list][
;;-------------------------------
  if 1 >= length? list [  return list ]
  left: copy []
  right: copy []
  eq:   copy []  ;; "equal"
  pivot: list/2 ;; simply choose second element as pivot element
  foreach ele list [
      case [
       ele < pivot [ append left ele ]
       ele > pivot [ append right ele ]
       true       [append eq ele ]
      ]
  ]
  ;; this is the last expression of the function, so coding "return" here is not necessary
  reduce [qsort left eq qsort right]
]

;; lets test the function with an array of 100k integers, range 1..1000
list: []
loop 100000 [append list random 1000]
t0: now/time/precise  ;; start timestamp
qsort list ;; the return value (block) contains the sorted list, original list has not changed
print ["time1: "  now/time/precise   - t0]  ;; about 1.1 sec on my machine
t0: now/time/precise
sort list  ;; just for fun time the builtin function also ( also implementation of quicksort )
print ["time2: " now/time/precise   - t0]


function combsort( a, len,    gap, igap, swap, swaps, i )
{
	gap = len
	swaps = 1

	while( gap > 1 || swaps )
	{
		gap /= 1.2473;
		if ( gap < 1 ) gap = 1
		i = swaps = 0
		while( i + gap < len )
		{
			igap = i + int(gap)
			if ( a[i] > a[igap] )
			{
				swap = a[i]
				a[i] = a[igap]
				a[igap] = swap
				swaps = 1
			}
			i++;
		}
	}
}

BEGIN {
	a[0] = 5
	a[1] = 2
	a[2] = 7
	a[3] = -11
	a[4] = 6
	a[5] = 1

	combsort( a, length(a) )

	for( i=0; i<length(a); i++ )
		print a[i]
}


DEF PROC_CombSort11(Size%)

gap%=Size%
REPEAT
  IF gap% > 1 THEN
     gap%=gap% / 1.3
     IF gap%=9 OR gap%=10 gap%=11
  ENDIF
  I% = 1
  Finished%=TRUE
  REPEAT
    IF data%(I%) > data%(I%+gap%) THEN
       SWAP data%(I%),data%(I%+gap%)
       Finished% = FALSE
    ENDIF
    I%+=1
  UNTIL I%+gap% > Size%
UNTIL gap%=1 AND Finished%

ENDPROC


void Combsort11(double a[], int nElements)
{
  int i, j, gap, swapped = 1;
  double temp;

  gap = nElements;
  while (gap > 1 || swapped == 1)
  {
    gap = gap * 10 / 13;
    if (gap == 9 || gap == 10) gap = 11;
    if (gap < 1) gap = 1;
    swapped = 0;
    for (i = 0, j = gap; j < nElements; i++, j++)
    {
      if (a[i] > a[j])
      {
        temp = a[i];
        a[i] = a[j];
        a[j] = temp;
        swapped = 1;
      }
    }
  }
}


List do (
    merge := method(lst1, lst2,
        result := list()
        while(lst1 isNotEmpty or lst2 isNotEmpty,
            if(lst1 first <= lst2 first) then(
                result append(lst1 removeFirst)
            ) else (
                result append(lst2 removeFirst)
            )
        )
    result)

    mergeSort := method(
        if (size > 1) then(
            half_size := (size / 2) ceil
            return merge(slice(0, half_size) mergeSort,
                         slice(half_size, size) mergeSort)
        ) else (return self)
    )

    mergeSortInPlace := method(
        copy(mergeSort)
    )
)

lst := list(9, 5, 3, -1, 15, -2)
lst mergeSort println # ==> list(-2, -1, 3, 5, 9, 15)
lst mergeSortInPlace println # ==> list(-2, -1, 3, 5, 9, 15)


theory Mergesort
  imports Main
begin

fun merge :: "int list ⇒ int list ⇒ int list" where
  "merge [] ys = ys"
| "merge xs [] = xs"
| "merge (x#xs) (y#ys) = (if x ≤ y
                          then x # merge xs (y#ys)
                          else y # merge (x # xs) ys)"

text‹example:›
lemma "merge [1,3,6] [1,2,5,8] = [1,1,2,3,5,6,8]" by simp

lemma merge_set: "set (merge xs ys) = set xs ∪ set ys"
  by(induction xs ys rule: merge.induct) auto

lemma merge_sorted:
  "sorted xs ⟹ sorted ys ⟹ sorted (merge xs ys)"
proof(induction xs ys rule: merge.induct)
  case (1 ys)
  then show "sorted (merge [] ys)" by simp
next
  case (2 x xs)
  then show "sorted (merge (x # xs) [])" by simp
next
  case (3 x xs y ys)
  assume premx: "sorted (x # xs)"
     and premy: "sorted (y # ys)"
     and IHx: "x ≤ y ⟹ sorted xs ⟹ sorted (y # ys) ⟹
                 sorted (merge xs (y # ys))"
     and IHy: "¬ x ≤ y ⟹ sorted (x # xs) ⟹ sorted ys ⟹
                 sorted (merge (x # xs) ys)"
  then show "sorted (merge (x # xs) (y # ys))"
  proof(cases "x ≤ y")
    case True
    with premx IHx premy have IH: "sorted (merge xs (y # ys))" by simp
    from ‹x ≤ y› premx premy merge_set have
      "∀z ∈ set (merge xs (y # ys)). x ≤ z" by fastforce
    with ‹x ≤ y› IH show "sorted (merge (x # xs) (y # ys))" by(simp)
  next
    case False
    with premy IHy premx have IH: "sorted (merge (x # xs) ys)" by simp
    from ‹¬x ≤ y› premx premy merge_set have
      "∀z ∈ set (merge (x # xs) ys). y ≤ z" by fastforce
    with ‹¬x ≤ y› IH show "sorted (merge (x # xs) (y # ys))" by(simp)
  qed
qed

fun mergesort :: "int list ⇒ int list" where
  "mergesort [] = []"
| "mergesort [x] = [x]"
| "mergesort xs = merge (mergesort (take (length xs div 2) xs))
                        (mergesort (drop (length xs div 2) xs))"

theorem mergesort_set: "set xs = set (mergesort xs)"
proof(induction xs rule: mergesort.induct)
  case 1
  show "set [] = set (mergesort [])" by simp
next
  case (2 x)
  show "set [x] = set (mergesort [x])" by simp
next
  case (3 x1 x2 xs)
  from 3 have IH_simplified_take:
    "set (mergesort (x1 # take (length xs div 2) (x2 # xs))) =
     insert x1 (set (take (length xs div 2) (x2 # xs)))"
  and IH_simplified_drop:
    "set (mergesort (drop (length xs div 2) (x2 # xs))) =
     set (drop (length xs div 2) (x2 # xs))" by simp+

  have "(set (take n as) ∪ set (drop n as)) = set as"
    for n and as::"int list"
  proof -
    from set_append[of "take n as" "drop n as"] have
      "(set (take n as) ∪ set (drop n as)) =
       set (take n as @ drop n as)" by simp
    moreover have
      "set (take n as @ drop n as) =
       set as" using append_take_drop_id by simp
    ultimately show ?thesis by simp
  qed
  hence "(set (take (length xs div 2) (x2 # xs)) ∪
        set (drop (length xs div 2) (x2 # xs))) =
        set (x2 # xs)"by(simp)
  with IH_simplified_take IH_simplified_drop show
    "set (x1 # x2 # xs) = set (mergesort (x1 # x2 # xs))"
    by(simp add: merge_set)
qed

theorem mergesort_sorted: "sorted (mergesort xs)"
  by(induction xs rule: mergesort.induct) (simp add: merge_sorted)+

text‹example:›
lemma "mergesort [42, 5, 1, 3, 67, 3, 9, 0, 33, 32] =
                 [0, 1, 3, 3, 5, 9, 32, 33, 42, 67]" by simp
end


using System;
using System.Linq;

namespace CountingSort
{
    class Program
    {
        static void Main(string[] args)
        {
            Random rand = new Random();                                   // Just for creating a test array
            int[] arr = new int[100];                                     // of random numbers
            for (int i = 0; i < 100; i++) { arr[i] = rand.Next(0, 100); } // ...

            int[] newarr = countingSort(arr, arr.Min(), arr.Max());
        }

        private static int[] countingSort(int[] arr, int min, int max)
        {
            int[] count = new int[max - min + 1];
            int z = 0;

            for (int i = 0; i < count.Length; i++) { count[i] = 0; }
            for (int i = 0; i < arr.Length; i++) { count[arr[i] - min]++; }

            for (int i = min; i <= max; i++)
            {
                while (count[i - min]-- > 0)
                {
                    arr[z] = i;
                    z++;
                }
            }
            return arr;
        }
    }
}


/*REXX program  sorts  a  stemmed array  using the   quicksort  algorithm.              */
call [email protected]                                        /*generate the elements for the array. */
call [email protected]   'before sort'                       /*show  the  before   array elements.  */
call qSort       #                               /*invoke the  quicksort  subroutine.   */
call [email protected]   ' after sort'                       /*show  the   after   array elements.  */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
inOrder: parse arg n; do j=1  for n-1;  k= j+1;  if @.j>@.k  then return 0; end;  return 1
/*──────────────────────────────────────────────────────────────────────────────────────*/
qSort: procedure expose @.; a.1=1; parse arg b.1;  $= 1 /*access @.; get @. size; pivot.*/
       if inOrder(b.1)  then return                     /*Array already in order? Return*/
             do  while  $\==0;   L= a.$;    t= b.$;    $= $ - 1;    if t<2  then iterate
                  H= L + t - 1;    ?= L  +  t % 2
             if @.H<@.L  then if @.?<@.H  then do;  p= @.H;  @.H= @.L;  end
                                          else if @.?>@.L  then     p= @.L
                                                           else do; p= @.?; @.?= @.L;  end
                         else if @.?<@.L  then [email protected].L
                                          else if @.?>@.H  then do; p= @.H; @.H= @.L;  end
                                                           else do; p= @.?; @.?= @.L;  end
             j= L+1;                            k= h
                    do forever
                        do j=j         while j<=k & @.j<=p;  end    /*a teeny─tiny loop.*/
                        do k=k  by -1  while j< k & @.k>=p;  end    /*another   "    "  */
                    if j>=k  then leave                             /*segment finished? */
                    _= @.j;   @.j= @.k;   @.k= _                    /*swap J&K elements.*/
                    end   /*forever*/
             $= $ + 1
             k= j - 1;   @.L= @.k;   @.k= p
             if j<=?  then do;  a.$= j;  b.$= H-j+1;  $= $+1;   a.$= L;   b.$= k-L;    end
                      else do;  a.$= L;  b.$= k-L;    $= $+1;   a.$= j;   b.$= H-j+1;  end
             end          /*while $¬==0*/
       return
/*──────────────────────────────────────────────────────────────────────────────────────*/
[email protected]: w= length(#);       do j=1  for #;  say 'element'  right(j,w)  arg(1)":"  @.j;  end
       say copies('▒', maxL + w + 22)            /*display a separator (between outputs)*/
       return
/*──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
[email protected]:  @.=;   maxL=0                                    /*assign a default value for the array.*/
       @.1  = " Rivers that form part of a (USA) state's border "                                   /*this value is adjusted later to include a prefix & suffix.*/
       @.2  = '='                                                                                /*this value is expanded later.  */
       @.3  = "Perdido River                       Alabama, Florida"
       @.4  = "Chattahoochee River                 Alabama, Georgia"
       @.5  = "Tennessee River                     Alabama, Kentucky, Mississippi, Tennessee"
       @.6  = "Colorado River                      Arizona, California, Nevada, Baja California (Mexico)"
       @.7  = "Mississippi River                   Arkansas, Illinois, Iowa, Kentucky, Minnesota, Mississippi, Missouri, Tennessee, Louisiana, Wisconsin"
       @.8  = "St. Francis River                   Arkansas, Missouri"
       @.9  = "Poteau River                        Arkansas, Oklahoma"
       @.10 = "Arkansas River                      Arkansas, Oklahoma"
       @.11 = "Red River (Mississippi watershed)   Arkansas, Oklahoma, Texas"
       @.12 = "Byram River                         Connecticut, New York"
       @.13 = "Pawcatuck River                     Connecticut, Rhode Island and Providence Plantations"
       @.14 = "Delaware River                      Delaware, New Jersey, New York, Pennsylvania"
       @.15 = "Potomac River                       District of Columbia, Maryland, Virginia, West Virginia"
       @.16 = "St. Marys River                     Florida, Georgia"
       @.17 = "Chattooga River                     Georgia, South Carolina"
       @.18 = "Tugaloo River                       Georgia, South Carolina"
       @.19 = "Savannah River                      Georgia, South Carolina"
       @.20 = "Snake River                         Idaho, Oregon, Washington"
       @.21 = "Wabash River                        Illinois, Indiana"
       @.22 = "Ohio River                          Illinois, Indiana, Kentucky, Ohio, West Virginia"
       @.23 = "Great Miami River (mouth only)      Indiana, Ohio"
       @.24 = "Des Moines River                    Iowa, Missouri"
       @.25 = "Big Sioux River                     Iowa, South Dakota"
       @.26 = "Missouri River                      Kansas, Iowa, Missouri, Nebraska, South Dakota"
       @.27 = "Tug Fork River                      Kentucky, Virginia, West Virginia"
       @.28 = "Big Sandy River                     Kentucky, West Virginia"
       @.29 = "Pearl River                         Louisiana, Mississippi"
       @.30 = "Sabine River                        Louisiana, Texas"
       @.31 = "Monument Creek                      Maine, New Brunswick (Canada)"
       @.32 = "St. Croix River                     Maine, New Brunswick (Canada)"
       @.33 = "Piscataqua River                    Maine, New Hampshire"
       @.34 = "St. Francis River                   Maine, Quebec (Canada)"
       @.35 = "St. John River                      Maine, Quebec (Canada)"
       @.36 = "Pocomoke River                      Maryland, Virginia"
       @.37 = "Palmer River                        Massachusetts, Rhode Island and Providence Plantations"
       @.38 = "Runnins River                       Massachusetts, Rhode Island and Providence Plantations"
       @.39 = "Montreal River                      Michigan (upper peninsula), Wisconsin"
       @.40 = "Detroit River                       Michigan, Ontario (Canada)"
       @.41 = "St. Clair River                     Michigan, Ontario (Canada)"
       @.42 = "St. Marys River                     Michigan, Ontario (Canada)"
       @.43 = "Brule River                         Michigan, Wisconsin"
       @.44 = "Menominee River                     Michigan, Wisconsin"
       @.45 = "Red River of the North              Minnesota, North Dakota"
       @.46 = "Bois de Sioux River                 Minnesota, North Dakota, South Dakota"
       @.47 = "Pigeon River                        Minnesota, Ontario (Canada)"
       @.48 = "Rainy River                         Minnesota, Ontario (Canada)"
       @.49 = "St. Croix River                     Minnesota, Wisconsin"
       @.50 = "St. Louis River                     Minnesota, Wisconsin"
       @.51 = "Halls Stream                        New Hampshire, Canada"
       @.52 = "Salmon Falls River                  New Hampshire, Maine"
       @.53 = "Connecticut River                   New Hampshire, Vermont"
       @.54 = "Arthur Kill                         New Jersey, New York (tidal strait)"
       @.55 = "Kill Van Kull                       New Jersey, New York (tidal strait)"
       @.56 = "Hudson River (lower part only)      New Jersey, New York"
       @.57 = "Rio Grande                          New Mexico, Texas, Tamaulipas (Mexico), Nuevo Leon (Mexico), Coahuila de Zaragoza (Mexico), Chihuahua (Mexico)"
       @.58 = "Niagara River                       New York, Ontario (Canada)"
       @.59 = "St. Lawrence River                  New York, Ontario (Canada)"
       @.60 = "Poultney River                      New York, Vermont"
       @.61 = "Catawba River                       North Carolina, South Carolina"
       @.62 = "Blackwater River                    North Carolina, Virginia"
       @.63 = "Columbia River                      Oregon, Washington"
                       do #=1  until  @.#==''           /*find how many entries in array,  and */
                       maxL=max(maxL, length(@.#))      /*   also find the maximum width entry.*/
                       end   /*#*/;   #= #-1            /*adjust the highest element number.   */
       @.1= center(@.1, maxL, '-')                      /*   "    "  header information.       */
       @.2= copies(@.2, maxL)                           /*   "    "     "   separator.         */
       return


using System;

namespace CombSort
{
    class Program
    {
        static void Main(string[] args)
        {
            int[] unsorted = new int[] { 3, 5, 1, 9, 7, 6, 8, 2, 4 };
            Console.WriteLine(string.Join(",", combSort(unsorted)));
        }
        public static int[] combSort(int[] input)
        {
            double gap = input.Length;
            bool swaps = true;
            while (gap > 1 || swaps)
            {
                gap /= 1.247330950103979;
                if (gap < 1) { gap = 1; }
                int i = 0;
                swaps = false;
                while (i + gap < input.Length)
                {
                    int igap = i + (int)gap;
                    if (input[i] > input[igap])
                    {
                        int swap = input[i];
                        input[i] = input[igap];
                        input[igap] = swap;
                        swaps = true;
                    }
                    i++;
                }
            }
            return input;
        }
    }
}


template<class ForwardIterator>
void combsort ( ForwardIterator first, ForwardIterator last )
{
    static const double shrink_factor = 1.247330950103979;
    typedef typename std::iterator_traits<ForwardIterator>::difference_type difference_type;
    difference_type gap = std::distance(first, last);
    bool swaps = true;

    while ( (gap > 1) || (swaps == true) ){
        if (gap > 1)
            gap = static_cast<difference_type>(gap/shrink_factor);

        swaps = false;
        ForwardIterator itLeft(first);
        ForwardIterator itRight(first); std::advance(itRight, gap);

        for ( ; itRight!=last; ++itLeft, ++itRight ){
            if ( (*itRight) < (*itLeft) ){
                std::iter_swap(itLeft, itRight);
                swaps = true;
            }
        }
    }
}


mergesort=: {{
  if. 2>#y do. y return.end.
  middle=. <.-:#y
  X=. mergesort middle{.y
  Y=. mergesort middle}.y
  X merge Y
}}

merge=: {{ r=. y#~ i=. j=. 0
  while. (i<#x)*(j<#y) do. a=. i{x [b=. j{y
    if. a<b do. r=. r,a [i=. i+1
       else.    r=. r,b [j=. j+1 end.
  end.
  if. i<#x do. r=. r, i}.x end.
  if. j<#y do. r=. r, j}.y end.
}}