*        Heap sort                     22/06/2016
HEAPS    CSECT
         USING  HEAPS,R13              base register
         B      72(R15)                skip savearea
         DC     17F'0'                 savearea
         STM    R14,R12,12(R13)        prolog
         ST     R13,4(R15)             "
         ST     R15,8(R13)             "
         LR     R13,R15                "
         L      R1,N                   n
         BAL    R14,HEAPSORT           call heapsort(n)
         LA     R3,PG                  pgi=0
         LA     R6,1                   i=1
         DO WHILE=(C,R6,LE,N)          for i=1 to n
         LR     R1,R6                    i
         SLA    R1,2                     .
         L      R2,A-4(R1)               a(i)
         XDECO  R2,XDEC                  edit a(i)
         MVC    0(4,R3),XDEC+8           output a(i)
         LA     R3,4(R3)                 pgi=pgi+4
         LA     R6,1(R6)                 i=i+1
         ENDDO  ,                      end for
         XPRNT  PG,80                  print buffer
         L      R13,4(0,R13)           epilog
         LM     R14,R12,12(R13)        "
         XR     R15,R15                "
         BR     R14                    exit
PG       DC     CL80' '                local data
XDEC     DS     CL12                   "
*------- heapsort(icount)----------------------------------------------
HEAPSORT ST     R14,SAVEHPSR           save return addr
         ST     R1,ICOUNT              icount
         BAL    R14,HEAPIFY            call heapify(icount)
         MVC    IEND,ICOUNT            iend=icount
         DO WHILE=(CLC,IEND,GT,=F'1')  while iend>1
         L      R1,IEND                  iend
         LA     R2,1                     1
         BAL    R14,SWAP                 call swap(iend,1)
         LA     R1,1                     1
         L      R2,IEND                  iend
         BCTR   R2,0                     -1
         ST     R2,IEND                  iend=iend-1
         BAL    R14,SIFTDOWN             call siftdown(1,iend)
         ENDDO  ,                      end while
         L      R14,SAVEHPSR           restore return addr
         BR     R14                    return to caller
SAVEHPSR DS     A                      local data
ICOUNT   DS     F                      "
IEND     DS     F                      "
*------- heapify(count)------------------------------------------------
HEAPIFY  ST     R14,SAVEHPFY           save return addr
         ST     R1,COUNT               count
         SRA    R1,1                   /2
         ST     R1,ISTART              istart=count/2
         DO WHILE=(C,R1,GE,=F'1')      while istart>=1
         L      R1,ISTART                istart
         L      R2,COUNT                 count
         BAL    R14,SIFTDOWN             call siftdown(istart,count)
         L      R1,ISTART                istart
         BCTR   R1,0                     -1
         ST     R1,ISTART                istart=istart-1
         ENDDO  ,                      end while
         L      R14,SAVEHPFY           restore return addr
         BR     R14                    return to caller
SAVEHPFY DS     A                      local data
COUNT    DS     F                      "
ISTART   DS     F                      "
*------- siftdown(jstart,jend)-----------------------------------------
SIFTDOWN ST     R14,SAVESFDW           save return addr
         ST     R1,JSTART              jstart
         ST     R2,JEND                jend
         ST     R1,ROOT                root=jstart
         LR     R3,R1                  root
         SLA    R3,1                   root*2
         DO WHILE=(C,R3,LE,JEND)       while root*2<=jend
         ST     R3,CHILD                 child=root*2
         MVC    SW,ROOT                  sw=root
         L      R1,SW                    sw
         SLA    R1,2                     .
         L      R2,A-4(R1)               a(sw)
         L      R1,CHILD                 child
         SLA    R1,2                     .
         L      R3,A-4(R1)               a(child)
         IF     CR,R2,LT,R3 THEN         if a(sw)<a(child) then
         MVC    SW,CHILD                   sw=child
         ENDIF  ,                        end if
         L      R2,CHILD                 child
         LA     R2,1(R2)                 +1
         L      R1,SW                    sw
         SLA    R1,2                     .
         L      R3,A-4(R1)               a(sw)
         L      R1,CHILD                 child
         LA     R1,1(R1)                 +1
         SLA    R1,2                     .
         L      R4,A-4(R1)               a(child+1)
         IF    C,R2,LE,JEND,AND,         if child+1<=jend and          X
               CR,R3,LT,R4 THEN             a(sw)<a(child+1) then
         L      R2,CHILD                   child
         LA     R2,1(R2)                   +1
         ST     R2,SW                      sw=child+1
         ENDIF  ,                        end if
         IF     CLC,SW,NE,ROOT THEN      if sw^=root then
         L      R1,ROOT                    root
         L      R2,SW                      sw
         BAL    R14,SWAP                   call swap(root,sw)
         MVC    ROOT,SW                    root=sw
         ELSE   ,                        else
         B      RETSFDW                    return
         ENDIF  ,                        end if
         L      R3,ROOT                  root
         SLA    R3,1                     root*2
         ENDDO  ,                      end while
RETSFDW  L      R14,SAVESFDW           restore return addr
         BR     R14                    return to caller
SAVESFDW DS     A                      local data
JSTART   DS     F                      "
ROOT     DS     F                      "
JEND     DS     F                      "
CHILD    DS     F                      "
SW       DS     F                      "
*------- swap(x,y)-----------------------------------------------------
SWAP     SLA    R1,2                   x
         LA     R1,A-4(R1)             @a(x)
         SLA    R2,2                   y
         LA     R2,A-4(R2)             @a(y)
         L      R3,0(R1)               temp=a(x)
         MVC    0(4,R1),0(R2)          a(x)=a(y)
         ST     R3,0(R2)               a(y)=temp
         BR     R14                    return to caller
*------- ------ -------------------------------------------------------
A     DC F'4',F'65',F'2',F'-31',F'0',F'99',F'2',F'83',F'782',F'1'
      DC F'45',F'82',F'69',F'82',F'104',F'58',F'88',F'112',F'89',F'74'
N        DC     A((N-A)/L'A)           number of items
         YREGS
         END    HEAPS


/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program heapSort64.s   */
/* look Pseudocode begin this task  */

/*******************************************/
/* 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

1:
    ldr x0,qAdrTableNumber                      // address number table
    mov x1,#NBELEMENTS                          // number of élements
    bl heapSort
    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 2f
    ldr x0,qAdrszMessSortNok                    // no !! error sort
    bl affichageMess
    b 100f
2:                                              // 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

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
/******************************************************************/
/*         heap sort                                              */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the number of element */
heapSort:
    stp x1,lr,[sp,-16]!            // save  registers
    stp x2,x3,[sp,-16]!            // save  registers
    bl heapify                     // first place table in max-heap order
    sub x3,x1,1
1:
    cmp x3,0
    ble 100f
    mov x1,0                       // swap the root(maximum value) of the heap with the last element of the heap)
    mov x2,x3
    bl swapElement
    sub x3,x3,1
    mov x1,0
    mov x2,x3                      // put the heap back in max-heap order
    bl siftDown
    b 1b

100:
    ldp x2,x3,[sp],16              // restaur  2 registers
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/******************************************************************/
/*      place table in max-heap order                             */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the number of element */
heapify:
    stp x1,lr,[sp,-16]!            // save  registers
    stp x2,x3,[sp,-16]!            // save  registers
    str x4,[sp,-16]!               // save  registers
    mov x4,x1
    sub x3,x1,2
    lsr x3,x3,1
1:
    cmp x3,0
    blt 100f
    mov x1,x3
    sub x2,x4,1
    bl siftDown
    sub x3,x3,1
    b 1b
100:
    ldr x4,[sp],16                 // restaur  1 registers
    ldp x2,x3,[sp],16              // restaur  2 registers
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/******************************************************************/
/*     swap two elements of table                                  */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the first index */
/* x2 contains the second index */
swapElement:
    stp x2,lr,[sp,-16]!            // save  registers
    stp x3,x4,[sp,-16]!            // save  registers
    ldr x3,[x0,x1,lsl #3]          // swap number on the table
    ldr x4,[x0,x2,lsl #3]
    str x4,[x0,x1,lsl #3]
    str x3,[x0,x2,lsl #3]
100:
    ldp x3,x4,[sp],16              // restaur  2 registers
    ldp x2,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30

/******************************************************************/
/*     put the heap back in max-heap order                        */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the first index */
/* x2 contains the last index */
siftDown:
    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
                                   // x1 = root = start
    mov x3,x2                      // save last index
1:
    lsl x4,x1,1
    add x4,x4,1
    cmp x4,x3
    bgt 100f
    add x5,x4,1
    cmp x5,x3
    bgt 2f
    ldr x6,[x0,x4,lsl 3]           // compare elements on the table
    ldr x7,[x0,x5,lsl 3]
    cmp x6,x7
    csel x4,x5,x4,lt
    //movlt x4,x5
2:
    ldr x7,[x0,x4,lsl 3]           // compare elements on the table
    ldr x6,[x0,x1,lsl 3]           // root
    cmp x6,x7
    bge 100f
    mov x2,x4                      // and x1 is root
    bl swapElement
    mov x1,x4                      // root = child
    b 1b

100:
    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
qAdrsZoneConv:            .quad sZoneConv
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


bogosort(v)={
  while(1,
    my(u=vecextract(v,numtoperm(#v,random((#v)!))));
    for(i=2,#v,if(u[i]<u[i-1], next(2)));
    return(u)
  );
};


program bogosort;

const
  max = 5;
type
  list = array [1..max] of integer;

{ Print a list }
procedure printa(a: list);
var
  i: integer;
begin
  for i := 1 to max do
    write(a[i], ' ');
  writeln
end;

{ Knuth shuffle }
procedure shuffle(var a: list);
var
  i,k,tmp: integer;
begin
  for i := max downto 2 do begin
     k := random(i) + 1;
     if (a[i] <> a[k]) then begin
       tmp := a[i]; a[i] := a[k]; a[k] := tmp
     end
  end
end;

{ Check for sorted list }
function sorted(a: list): boolean;
var
  i: integer;
begin
  sorted := True;
  for i := 2 to max do
    if (a[i - 1] > a[i]) then begin
      sorted := False; exit
    end
end;

{ Bogosort }
procedure bogo(var a: list);
var
  i: integer;
begin
  i := 1; randomize;
  write(i,': '); printa(a);
  while not sorted(a) do begin
    shuffle(a);
    i := i + 1; write(i,': '); printa(a)
  end
end;

{ Test and display }
var
  a: list;
  i: integer;

begin
  for i := 1 to max do
    a[i] := (max + 1) - i;
  bogo(a);
end.


// version 1.1.2

inline fun <reified T : Comparable<T>> sortThree(x: T, y: T, z: T): Triple<T, T, T> {
    val a = arrayOf(x, y, z)
    a.sort()
    return Triple(a[0], a[1], a[2])
}

fun <T> printThree(x: T, y: T, z: T) = println("x = $x\ny = $y\nz = $z\n")

fun main(args: Array<String>) {
    var x = "lions, tigers, and"
    var y = "bears, oh my!"
    var z = """(from the "Wizard of OZ")"""
    val t = sortThree(x, y, z)
    x = t.first
    y = t.second
    z = t.third
    printThree(x, y, z)

    var x2 = 77444
    var y2 = -12
    var z2 = 0
    val t2 = sortThree(x2, y2, z2)
    x2 = t2.first
    y2 = t2.second
    z2 = t2.third
    printThree(x2, y2, z2)

    var x3 = 174.5
    var y3 = -62.5
    var z3 = 41.7
    val t3 = sortThree(x3, y3, z3)
    x3 = t3.first
    y3 = t3.second
    z3 = t3.third
    printThree(x3, y3, z3)
}


#!/bin/ksh

# Sort three variables that may contain any value (numbers and/or literals)

#	# Variables:
#
xl='lions, tigers, and'
yl='bears, oh my!'
zl='(from the "Wizard of OZ")'

typeset -i xn=77444
typeset -F yn=-12.0
typeset -i zn=0

#	# Functions:
#

#	# Function _intoarray(x, y, z, arr) - put 3 variables into arr[]
#
function _intoarray {
	typeset _x ; nameref _x="$1"
	typeset _y ; nameref _y="$2"
	typeset _z ; nameref _z="$3"
	typeset _arr ; nameref _arr="$4"

	_arr=( "${_x}" "${_y}" "${_z}" )
}

#	# Function _arraysort(arr) - return sorted array (any type of elements)
#
function _arraysort {
	typeset _arr ; nameref _arr="$1"
	typeset _i _j ; integer _i _j

	_sorttype _arr
	case $? in
		0)	# Literal sort
			for (( _i=1; _i<${#_arr[*]}; _i++ )); do
				_val="${_arr[_i]}"
				(( _j = _i - 1 ))
				while (( _j>=0 )) && [[ "${_arr[_j]}" > "${_val}" ]]; do
					_arr[_j+1]="${_arr[_j]}"
					(( _j-- ))
				done
				_arr[_j+1]="${_val}"
			done
		;;

		1)	# Numeric sort
			for (( _i=1; _i<${#_arr[*]}; _i++ )); do
				_val=${_arr[_i]}
				(( _j = _i - 1 ))
				while (( _j>=0 && _arr[_j]>_val )); do
					_arr[_j+1]=${_arr[_j]}
					(( _j-- ))
				done
				_arr[_j+1]=${_val}
			done
		;;
	esac
}

#	# Function _sorttype(_arr) - return 0 = Literal sort; 1 = Numeric sort
#
function _sorttype {
	typeset _arr ; nameref _arr="$1"
	typeset _i ; integer _i

	for ((_i=0; _i<${#_arr[*]}; _i++)); do
		[[ ${_arr[_i]} != *(\-)+(\d)*(\.)*(\d) ]] && return 0
	done
	return 1
}

#	# Function _outofarray(x, y, z, arr) - Put array elements into x, y, z
#
function _outofarray {
	typeset _x ; nameref _x="$1"
	typeset _y ; nameref _y="$2"
	typeset _z ; nameref _z="$3"
	typeset _arr ; nameref _arr="$4"

	_x="${_arr[0]}"
	_y="${_arr[1]}"
	_z="${_arr[2]}"
}

 ######
# main #
 ######

unset x y z
printf "Numeric Variables:\n%s\n%s\n%s\n\n" "${xn}" "${yn}" "${zn}"
typeset -a arrayn
_intoarray xn yn zn arrayn
_arraysort arrayn
_outofarray x y z arrayn
printf "Sorted Variables:\n%s\n%s\n%s\n\n" "${x}" "${y}" "${z}"

unset x y z
printf "Literal Variables:\n%s\n%s\n%s\n\n" "${xl}" "${yl}" "${zl}"
typeset -a arrayl
_intoarray xl yl zl arrayl
_arraysort arrayl
_outofarray x y z arrayl
printf "Sorted Variables:\n%s\n%s\n%s\n\n" "${x}" "${y}" "${z}"


function heapSort(data:Vector.<int>):Vector.<int> {
	for (var start:int = (data.length-2)/2; start >= 0; start--) {
		siftDown(data, start, data.length);
	}
	for (var end:int = data.length - 1; end > 0; end--) {
		var tmp:int=data[0];
		data[0]=data[end];
		data[end]=tmp;
		siftDown(data, 0, end);
	}
	return data;
}
function siftDown(data:Vector.<int>, start:int, end:int):void {
	var heapRoot:int=start;
	while (heapRoot * 2+1 < end) {
		var child:int=heapRoot*2+1;
		if (child+1<end&&data[child]<data[child+1]) {
			child++;
		}
		if (data[heapRoot]<data[child]) {
			var tmp:int=data[heapRoot];
			data[heapRoot]=data[child];
			data[child]=tmp;
			heapRoot=child;
		} else {
			return;
		}
	}
}


use List::Util qw(shuffle);

sub bogosort
 {my @l = @_;
  @l = shuffle(@l) until in_order(@l);
  return @l;}

sub in_order
 {my $last = shift;
  foreach (@_)
     {$_ >= $last or return 0;
      $last = $_;}
  return 1;}


with javascript_semantics

function inOrder(sequence s)
    return s==sort(deep_copy(s))    -- <snigger>
end function

function bogosort(sequence s)
    while not inOrder(s) do
        ? s
        s = shuffle(s)
    end while
    return s
end function

? bogosort(shuffle({1,2,3,4,5,6}))


// Little Man Computer
// Sort x, y, z, in ascending order
// Based on a sorting network:
//   if x > z then swap( x, z)
//   if x > y then swap( x, y)
//   if y > z then swap( y, z)
// with the addition that if the 2nd swap is executed
// then the 3rd comparison is not needed.

// Read numbers x, y, z, and display in their original order
        INP
        STA x
        OUT
        INP
        STA y
        OUT
        INP
        STA z
        OUT
// Sort so that x <= y <= z, and display in new order
        LDA z
        SUB x
        BRP label1
        LDA x
        STA t
        LDA z
        STA x
        LDA t
        STA z
label1  LDA y
        SUB x
        BRP label2
        LDA x
        STA t
        LDA y
        STA x
        LDA t
        STA y
        BRA sorted // added to the sorting network
label2  LDA z
        SUB y
        BRP sorted
        LDA y
        STA t
        LDA z
        STA y
        LDA t
        STA z
sorted  LDA x
        OUT
        LDA y
        OUT
        LDA z
        OUT
        HLT
x       DAT
y       DAT
z       DAT
t       DAT
// end


function variadicSort (...)
  local t = {}
  for _, x in pairs{...} do
    table.insert(t, x)
  end
  table.sort(t)
  return unpack(t)
end

local testCases = {
  { x = 'lions, tigers, and',
    y = 'bears, oh my!',
    z = '(from the "Wizard of OZ")'
  },
  { x = 77444,
    y = -12,
    z = 0
  }
}
for i, case in ipairs(testCases) do
  x, y, z = variadicSort(case.x, case.y, case.z)
  print("\nCase " .. i)
  print("\tx = " .. x)
  print("\ty = " .. y)
  print("\tz = " .. z)
end


Module Sort3 {
      Let X=77744, Y=-12, Z=0
      Let X$ =  "lions, tigers, and",  Y$ =  "bears, oh my!",  Z$ =  {(from the "Wizard of OZ")}
      \\ & use for by reference pass
      Module SortSome (&X$, &Y$, &Z$){
            If Type$(X$)<>"String" Then {
                  Link X$,Y$, Z$ to X,Y,Z
                  Print3()
                  If Y>Z then Swap Y, Z  ' both numeric in Swap
                  If X>Z then Swap X, Z
                  If X>Y then Swap X, Y
                  Print3()
            } Else {
                  Print3Str()
                  If Y$>Z$ then Swap Y$, Z$ ' both strings in Swap
                  If X$>Z$ then Swap X$, Z$
                  If X$>Y$ then Swap X$, Y$
                  Print3Str()
            }
      }
      SortSome &X, &Y, &Z
      SortSome &X$, &Y$, &Z$
      Sub Print3()
            \\ double ,, used to insert a New Line
            Print "X=",X,,"Y=",Y,,"Z=",Z
      End Sub
      Sub Print3Str()
            Print "X$=",X$,,"Y$=",Y$,,"Z$=",Z$
      End Sub
}
Sort3


generic
   type Element_Type is private;
   type Index_Type is (<>);
   type Collection is array(Index_Type range <>) of Element_Type;
   with function "<" (Left, right : element_type) return boolean is <>;
procedure Generic_Heapsort(Item : in out Collection);


#--- Swap function ---#
PROC swap = (REF []INT array, INT first, INT second) VOID:
(
    INT temp := array[first];
    array[first] := array[second];
    array[second]:= temp
);

#--- Heap sort Move Down ---#
PROC heapmove = (REF []INT array, INT i, INT last) VOID:
(
    INT index := i;
    INT larger := (index*2);

    WHILE larger <= last DO
        IF larger < last THEN IF array[larger] < array[larger+1] THEN
            larger +:= 1
        FI FI;
        IF array[index] < array[larger] THEN
            swap(array, index, larger)
        FI;
        index := larger;
        larger := (index*2)
    OD
);

#--- Heap sort ---#
PROC heapsort = (REF []INT array) VOID:
(
    FOR i FROM ENTIER((UPB array) / 2) BY -1 WHILE
        heapmove(array, i, UPB array);
    i > 1 DO SKIP OD;

    FOR i FROM UPB array BY -1 WHILE
        swap(array, 1, i);
        heapmove(array, 1, i-1);
    i > 1 DO SKIP OD
);
#***************************************************************#
main:
(
    [10]INT a;
    FOR i FROM 1 TO UPB a DO
        a[i] := ROUND(random*100)
    OD;

    print(("Before:", a));
    print((newline, newline));
    heapsort(a);
    print(("After: ", a))

)


function bogosort($l) {
    while (!in_order($l))
        shuffle($l);
    return $l;
}

function in_order($l) {
    for ($i = 1; $i < count($l); $i++)
        if ($l[$i] < $l[$i-1])
            return FALSE;
    return TRUE;
}


(de bogosort (Lst)
   (loop
      (map
         '((L) (rot L (rand 1 (length L))))
         Lst )
      (T (apply <= Lst) Lst) ) )


(=c =b =a (a -> b -> c ->) => '> sort -> c @ b @ a @) :sort3

"lions, tigers, and" :x
"bears, oh my!" :y
"(from the \"Wizard of OZ\")" :z

'x 'y 'z sort3
x puts!
y puts!
z puts!

77444 :x
-12 :y
0 :z

'x 'y 'z sort3
x puts!
y puts!
z puts!


MODULE SortThreeVariables;
FROM FormatString IMPORT FormatString;
FROM Terminal IMPORT WriteString,WriteLn,ReadChar;

PROCEDURE SwapInt(VAR a,b : INTEGER);
VAR t : INTEGER;
BEGIN
    t := a;
    a := b;
    b := t;
END SwapInt;

PROCEDURE Sort3Int(VAR x,y,z : INTEGER);
BEGIN
    IF x<y THEN
        IF z<x THEN
            SwapInt(x,z);
        END;
    ELSIF y<z THEN
        SwapInt(x,y);
    ELSE
        SwapInt(x,z);
    END;
    IF z<y THEN
        SwapInt(y,z);
    END;
END Sort3Int;

VAR
    buf : ARRAY[0..63] OF CHAR;
    a,b,c : INTEGER;
BEGIN
    a := 77444;
    b := -12;
    c := 0;
    FormatString("Before a=[%i]; b=[%i]; c=[%i]\n", buf, a, b, c);
    WriteString(buf);

    Sort3Int(a,b,c);
    FormatString("Before a=[%i]; b=[%i]; c=[%i]\n", buf, a, b, c);
    WriteString(buf);

    ReadChar;
END SortThreeVariables.


-- In-place binary heap sort.
-- Heap sort algorithm: J.W.J. Williams.
on heapSort(theList, l, r) -- Sort items l thru r of theList.
    set listLen to (count theList)
    if (listLen < 2) then return
    -- Convert 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
        -- The list as a script property to allow faster references to its items.
        property lst : theList
        -- In a binary heap, the list index of each node's first child is (node index * 2) - (l - 1). Preset the constant part.
        property const : l - 1

        -- Private subhandler: sift a value down into the heap from a given node.
        on siftDown(siftV, node, endOfHeap)
            set child to node * 2 - const
            repeat until (child comes after endOfHeap)
                set childV to my lst's item child
                if (child comes before endOfHeap) then
                    set child2 to child + 1
                    set child2V to my lst's item child2
                    if (child2V > childV) then
                        set child to child2
                        set childV to child2V
                    end if
                end if
                if (childV > siftV) then
                    set my lst's item node to childV
                    set node to child
                    set child to node * 2 - const
                else
                    exit repeat
                end if
            end repeat

            -- Insert the sifted-down value at the node reached.
            set my lst's item node to siftV
        end siftDown
    end script

    -- Arrange the sort range into a "heap" with its "top" at the leftmost position.
    repeat with i from (l + r) div 2 to l by -1
        tell o to siftDown(its lst's item i, i, r)
    end repeat
    -- Unpick the heap.
    repeat with endOfHeap from r to (l + 1) by -1
        set endV to o's lst's item endOfHeap
        set o's lst's item endOfHeap to o's lst's item l
        tell o to siftDown(endV, l, endOfHeap - 1)
    end repeat

    return -- nothing
end heapSort
property sort : heapSort

-- Demo:
local aList
set aList to {74, 95, 9, 56, 76, 33, 51, 27, 62, 55, 86, 60, 65, 32, 10, 62, 72, 87, 86, 85, 36, 20, 44, 17, 60}
sort(aList, 1, -1) -- Sort items 1 thru -1 of aList.
return aList


*process source xref;
 bogosort: Proc Options(main);
 Dcl SYSPRINT Print;
 Dcl (HBOUND,RANDOM,TIME) Builtin;
 Dcl tim Pic'(9)9';
 Dcl timms Pic'(3)9' def tim pos(7);
 tim=time();
 x=random(timms);
 Dcl a(5)       Dec Fixed(5,1) Init(-21,333,0,444.4,1);
 Dcl (x,y,temp) Dec Fixed(5,1);
 Dcl (n,bogo,j,u,v) Bin Fixed(31);
 n=hbound(a);
 Call tell('un-bogoed');
 loop:
 Do bogo=1 By 1;
   Do j=1 To n-1;
     jp=j+1;
     x=a(j);
     y=a(jp);
     if y>=x Then
       Iterate;
     u=rand(1,n);
     Do Until v^=u
       v=rand(1,n);
       End;
     Temp=a(u);
     a(u)=a(v);
     a(v)=temp;
     Iterate loop;
     End;
   Leave;
   End;

 Put Edit('number of bogo sorts performed =',bogo)(Skip,a,f(4));
 call tell('   bogoed');
 Return;

 tell: Proc(txt);
 Dcl txt Char(*);
 Dcl t Bin Fixed(31);
 Put Edit(txt)(skip,a);
 Do t=1 to n;
   Put Edit(a(t))(Skip,f(6,1));
   End;
 End;

 rand: Proc(lo,hi) Returns(Bin Fixed(31));
 Dcl (lo,hi,res) Bin Fixed(31);
 Dcl r Bin Float(31);
 r=random();
 res=r*(hi-lo+1)+lo;
 Return(res);
 End;
 End;


import sort

// sorting string literals
x = "lion, tigers, and"
y = "bears, oh my!"
z = "(from the \"Wizard of OZ\")"

varlist = sort({x,y,z})

x = varlist[0]
y = varlist[1]
z = varlist[2]
println x; println y; println z

// sorting integers
x = 77444
y = -12
z = 0

varlist = sort({x, y, z})

x = varlist[0]
y = varlist[1]
z = varlist[2]
println x; println y; println z


proc sortThree[T](a, b, c: var T) =
  # Bubble sort, why not?
  while not (a <= b and b <= c):
    if a > b: swap a, b
    if b > c: swap b, c

proc testWith[T](a, b, c: T) =
  var (x, y, z) = (a, b, c)
  echo "Before: ", x, ", ", y, ", ", z
  sortThree(x, y, z)
  echo "After: ", x, ", ", y, ", ", z

testWith(6, 4, 2)
testWith(0.9, -37.1, 4.0)
testWith("lions", "tigers", "bears")


let sortrefs list =
  let sorted = List.map ( ! ) list
               |> List.sort (fun a b ->
                   if a < b then -1 else
                   if a > b then  1 else
                     0) in
  List.iter2 (fun v x -> v := x) list sorted

open Printf

let test () =
  let x = ref "lions, tigers, and" in
  let y = ref "bears, oh my!" in
  let z = ref "(from the \"Wizard of OZ\")" in
  sortrefs [x; y; z];
  print_endline "case 1:";
  printf "\tx: %s\n" !x;
  printf "\ty: %s\n" !y;
  printf "\tz: %s\n" !z;

  let x = ref 77444 in
  let y = ref (-12) in
  let z = ref 0 in
  sortrefs [x; y; z];
  print_endline "case 1:";
  printf "\tx: %d\n" !x;
  printf "\ty: %d\n" !y;
  printf "\tz: %d\n" !z


F cocktailSort(&A)
   L
      L(indices) ((0 .< A.len-1).step(1), (A.len-2 .. 0).step(-1))
         V swapped = 0B
         L(i) indices
            I A[i] > A[i + 1]
               swap(&A[i], &A[i + 1])
               swapped = 1B
         I !swapped
            R

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


/* ARM assembly Raspberry PI  */
/*  program heapSort.s   */
/* look Pseudocode begin this task  */

/************************************/
/* Constantes                       */
/************************************/
.equ STDOUT, 1     @ Linux output console
.equ EXIT,   1     @ Linux syscall
.equ WRITE,  4     @ Linux syscall
/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessSortOk:       .asciz "Table sorted.\n"
szMessSortNok:      .asciz "Table not sorted !!!!!.\n"
sMessResult:        .ascii "Value  : "
sMessValeur:        .fill 11, 1, ' '            @ size => 11
szCarriageReturn:  .asciz "\n"

.align 4
iGraine:  .int 123456
.equ NBELEMENTS,      10
TableNumber:	     .int   1,3,6,2,5,9,10,8,4,7
#TableNumber:	     .int   10,9,8,7,6,5,4,3,2,1
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                             @ entry of program

1:
    ldr r0,iAdrTableNumber                      @ address number table
    mov r1,#NBELEMENTS                           @ number of élements
    bl heapSort
    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

iAdrsMessValeur:          .int sMessValeur
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
/******************************************************************/
/*         heap sort                                              */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the number of element */
heapSort:
    push {r2,r3,r4,lr}                                    @ save registers
    bl heapify                                          @ first place table in max-heap order
    sub r3,r1,#1
1:
    cmp r3,#0
    ble 100f
    mov r1,#0                                             @ swap the root(maximum value) of the heap with the last element of the heap)
    mov r2,r3
    bl swapElement
    sub r3,#1
    mov r1,#0
    mov r2,r3                                             @ put the heap back in max-heap order
    bl siftDown
    b 1b

100:
    pop {r2,r3,r4,lr}
    bx lr                                              @ return
/******************************************************************/
/*      place table in max-heap order                             */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the number of element */
heapify:
    push {r1,r2,r3,r4,lr}                                    @ save registers
    mov r4,r1
    sub r3,r1,#2
    lsr r3,#1
1:
    cmp r3,#0
    blt 100f
    mov r1,r3
    sub r2,r4,#1
    bl siftDown
    sub r3,#1
    b 1b
100:
    pop {r1,r2,r3,r4,lr}
    bx lr                                              @ return
/******************************************************************/
/*     swap two elements of table                                  */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the first index */
/* r2 contains the second index */
swapElement:
    push {r3,r4,lr}                                    @ save registers
    ldr r3,[r0,r1,lsl #2]                              @ swap number on the table
    ldr r4,[r0,r2,lsl #2]
    str r4,[r0,r1,lsl #2]
    str r3,[r0,r2,lsl #2]

100:
    pop {r3,r4,lr}
    bx lr                                              @ return

/******************************************************************/
/*     put the heap back in max-heap order                        */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the first index */
/* r2 contains the last index */
siftDown:
    push {r1-r7,lr}                                    @ save registers
                                                       @ r1 = root = start
    mov r3,r2                                          @ save last index
1:
    lsl r4,r1,#1
    add r4,#1
    cmp r4,r3
    bgt 100f
    add r5,r4,#1
    cmp r5,r3
    bgt 2f
    ldr r6,[r0,r4,lsl #2]                              @ compare elements on the table
    ldr r7,[r0,r5,lsl #2]
    cmp r6,r7
    movlt r4,r5
2:
    ldr r7,[r0,r4,lsl #2]                              @ compare elements on the table
    ldr r6,[r0,r1,lsl #2]                              @ root
    cmp r6,r7
    bge 100f
    mov r2,r4                                          @ and r1 is root
    bl swapElement
    mov r1,r4                                          @ root = child
    b 1b

100:
    pop {r1-r7,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,iAdrsMessValeur                             @ display value
    bl conversion10                                    @ call function
    ldr r0,iAdrsMessResult
    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
/******************************************************************/
/*     display text with size calculation                         */
/******************************************************************/
/* r0 contains the address of the message */
affichageMess:
    push {r0,r1,r2,r7,lr}                          @ save  registres
    mov r2,#0                                      @ counter length
1:                                                 @ loop length calculation
    ldrb r1,[r0,r2]                                @ read octet start position + index
    cmp r1,#0                                      @ if 0 its over
    addne r2,r2,#1                                 @ else add 1 in the length
    bne 1b                                         @ and loop
                                                   @ so here r2 contains the length of the message
    mov r1,r0                                      @ address message in r1
    mov r0,#STDOUT                                 @ code to write to the standard output Linux
    mov r7, #WRITE                                 @ code call system "write"
    svc #0                                         @ call systeme
    pop {r0,r1,r2,r7,lr}                           @ restaur des  2 registres */
    bx lr                                          @ return
/******************************************************************/
/*     Converting a register to a decimal unsigned                */
/******************************************************************/
/* r0 contains value and r1 address area   */
/* r0 return size of result (no zero final in area) */
/* area size => 11 bytes          */
.equ LGZONECAL,   10
conversion10:
    push {r1-r4,lr}                                 @ save registers
    mov r3,r1
    mov r2,#LGZONECAL

1:	                                            @ start loop
    bl divisionpar10U                               @ unsigned  r0 <- dividende. quotient ->r0 reste -> r1
    add r1,#48                                      @ digit
    strb r1,[r3,r2]                                 @ store digit on area
    cmp r0,#0                                       @ stop if quotient = 0
    subne r2,#1                                     @ else previous position
    bne 1b	                                    @ and loop
                                                    @ and move digit from left of area
    mov r4,#0
2:
    ldrb r1,[r3,r2]
    strb r1,[r3,r4]
    add r2,#1
    add r4,#1
    cmp r2,#LGZONECAL
    ble 2b
                                                      @ and move spaces in end on area
    mov r0,r4                                         @ result length
    mov r1,#' '                                       @ space
3:
    strb r1,[r3,r4]                                   @ store space in area
    add r4,#1                                         @ next position
    cmp r4,#LGZONECAL
    ble 3b                                            @ loop if r4 <= area size

100:
    pop {r1-r4,lr}                                    @ restaur registres
    bx lr                                             @return

/***************************************************/
/*   division par 10   unsigned                    */
/***************************************************/
/* r0 dividende   */
/* r0 quotient */
/* r1 remainder  */
divisionpar10U:
    push {r2,r3,r4, lr}
    mov r4,r0                                          @ save value
    //mov r3,#0xCCCD                                   @ r3 <- magic_number lower  raspberry 3
    //movt r3,#0xCCCC                                  @ r3 <- magic_number higter raspberry 3
    ldr r3,iMagicNumber                                @ r3 <- magic_number    raspberry 1 2
    umull r1, r2, r3, r0                               @ r1<- Lower32Bits(r1*r0) r2<- Upper32Bits(r1*r0)
    mov r0, r2, LSR #3                                 @ r2 <- r2 >> shift 3
    add r2,r0,r0, lsl #2                               @ r2 <- r0 * 5
    sub r1,r4,r2, lsl #1                               @ r1 <- r4 - (r2 * 2)  = r4 - (r0 * 10)
    pop {r2,r3,r4,lr}
    bx lr                                              @ leave function
iMagicNumber:  	.int 0xCCCCCCCD


function shuffle ($a) {
    $c = $a.Clone()  # make copy to avoid clobbering $a
    1..($c.Length - 1) | ForEach-Object {
        $i = Get-Random -Minimum $_ -Maximum $c.Length
        $c[$_-1],$c[$i] = $c[$i],$c[$_-1]
        $c[$_-1]  # return newly-shuffled value
    }
    $c[-1]  # last value
}

function isSorted( [Array] $data )
{
	$sorted = $true
	for( $i = 1; ( $i -lt $data.length ) -and $sorted; $i++ )
	{
		$sorted = $data[ $i - 1 ] -le $data[ $i ]
	}
	$sorted
}

function BogoSort ( [Array] $indata ) {
	$data = $indata.Clone()
	while( -not ( isSorted $data ) ) {
		$data = shuffle $indata
	}
	$data
}

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


program sortThreeVariables(output);

type
	{ this Extended Pascal data type may hold up to 25 `char` values }
	line = string(25);

{ this procedure sorts two lines }
procedure sortLines(var X, Y: line);
	{ nested procedure allocates space for Z only if needed }
	procedure swap;
	var
		Z: line;
	begin
		Z := X;
		X := Y;
		Y := Z
	end;
begin
	{ for lexical sorting write `if GT(X, Y) then` }
	if X > Y then
	begin
		swap
	end
end;

{ sorts three line variables’s values }
procedure sortThreeLines(var X, Y, Z: line);
begin
	{ `var` parameters can be modified at the calling site }
	sortLines(X, Y);
	sortLines(X, Z);
	sortLines(Y, Z)
end;

{ writes given lines on output preceded by `X = `, `Y = ` and `Z = ` }
procedure printThreeLines(protected X, Y, Z: line);
begin
	{ `protected` paremeters cannot be overwritten }
	writeLn('X = ', X);
	writeLn('Y = ', Y);
	writeLn('Z = ', Z)
end;

{ === MAIN ============================================================= }
var
	A, B: line;
	{ for demonstration purposes: alternative method to initialize }
	C: line value '(from the "Wizard of OZ")';
begin
	A := 'lions, tigers, and';
	B := 'bears, oh my!';

	sortThreeLines(A, B, C);
	printThreeLines(A, B, C)
end.


#!/usr/bin/env perl
use 5.010_000;

# Sort strings

my $x = 'lions, tigers, and';
my $y = 'bears, oh my!';
my $z = '(from the "Wizard of OZ")';

# When assigning a list to list, the values are mapped
( $x, $y, $z ) = sort ( $x, $y, $z );

say 'Case 1:';
say "  x = $x";
say "  y = $y";
say "  z = $z";

# Sort numbers

$x = 77444;
$y = -12;
$z = 0;

# The sort function can take a customizing block parameter.
# The spaceship operator creates a by-value numeric sort
( $x, $y, $z ) = sort { $a <=> $b } ( $x, $y, $z );

say 'Case 2:';
say "  x = $x";
say "  y = $y";
say "  z = $z";


*        Cocktail sort             25/06/2016
COCKTSRT CSECT
         USING  COCKTSRT,R13       base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    prolog
         ST     R13,4(R15)         "
         ST     R15,8(R13)         "
         LR     R13,R15            "
         L      R2,N               n
         BCTR   R2,0               n-1
         ST     R2,NM1             nm1=n-1
    DO UNTIL=(CLI,STABLE,EQ,X'01') repeat
         MVI    STABLE,X'01'         stable=true
         LA     RI,1                 i=1
         DO WHILE=(C,RI,LE,NM1)      do i=1 to n-1
         LR     R1,RI                  i
         SLA    R1,2                   .
         LA     R2,A-4(R1)             @a(i)
         LA     R3,A(R1)               @a(i+1)
         L      R4,0(R2)               r4=a(i)
         L      R5,0(R3)               r5=a(i+1)
         IF     CR,R4,GT,R5 THEN       if a(i)>a(i+1) then
         MVI    STABLE,X'00'             stable=false
         ST     R5,0(R2)                 a(i)=r5
         ST     R4,0(R3)                 a(i+1)=r4
         ENDIF  ,                      end if
         LA     RI,1(RI)               i=i+1
         ENDDO  ,                    end do
         L      RI,NM1               i=n-1
         DO WHILE=(C,RI,GE,=F'1')    do i=n-1 to 1 by -1
         LR     R1,RI                  i
         SLA    R1,2                   .
         LA     R2,A-4(R1)             @a(i)
         LA     R3,A(R1)               @a(i+1)
         L      R4,0(R2)               r4=a(i)
         L      R5,0(R3)               r5=a(i+1)
         IF     CR,R4,GT,R5 THEN       if a(i)>a(i+1) then
         MVI    STABLE,X'00'             stable=false
         ST     R5,0(R2)                 a(i)=r5
         ST     R4,0(R3)                 a(i+1)=r4
         ENDIF  ,                      end if
         BCTR   RI,0                   i=i-1
         ENDDO  ,                    end do
    ENDDO       ,                  until stable
         LA     R3,PG              pgi=0
         LA     RI,1               i=1
         DO     WHILE=(C,RI,LE,N)  do i=1 to n
         LR     R1,RI                i
         SLA    R1,2                 .
         L      R2,A-4(R1)           a(i)
         XDECO  R2,XDEC              edit a(i)
         MVC    0(4,R3),XDEC+8       output a(i)
         LA     R3,4(R3)             pgi=pgi+4
         LA     RI,1(RI)             i=i+1
         ENDDO  ,                  end do
         XPRNT  PG,L'PG            print buffer
         L      R13,4(0,R13)       epilog
         LM     R14,R12,12(R13)    "
         XR     R15,R15            "
         BR     R14                exit
A     DC F'4',F'65',F'2',F'-31',F'0',F'99',F'2',F'83',F'782',F'1'
      DC F'45',F'82',F'69',F'82',F'104',F'58',F'88',F'112',F'89',F'74'
N        DC     A((N-A)/L'A)       number of items of a
NM1      DS     F                  n-1
PG       DC     CL80' '            buffer
XDEC     DS     CL12               temp for xdeco
STABLE   DS     X                  stable
         YREGS
RI       EQU    6                  i
         END    COCKTSRT


define z_HL $00
define z_L  $00
define z_H  $01
define temp $02
define temp2 $03

define yINC $04
define yDEC $05

set_table:
dex
txa
sta $1200,y
iny
bne set_table	;stores $ff at $1200, $fe at $1201, etc.

lda #$12
sta z_H
lda #$00
sta z_L         ;get the base address of the data table

lda #0
tax
tay		;clear regs
sty yINC        ;yINC = 0
dey             ;LDY #255
sty yDEC        ;yDEC = 255
iny             ;LDY #0

JSR COCKTAILSORT
BRK

COCKTAILSORT:
;yINC starts at the beginning and goes forward, yDEC starts at the end and goes back.
LDY yINC
LDA (z_HL),y      ;get item Y
STA temp
INY
LDA (z_HL),y      ;get item Y+1
DEY
STA temp2
CMP temp
bcs doNothing_Up  ;if Y<=Y+1, do nothing. Otherwise swap them.

    ;we had to re-arrange an item.
    lda temp
    iny
    sta (z_HL),y   ;store the higher value at base+y+1
    inx ;sort count. If zero at the end, we're done.
    dey
    lda temp2
    sta (z_HL),y   ;store the lower value at base+y

doNothing_Up:
LDY yDEC
LDA (z_HL),y
STA temp
DEY
LDA (z_HL),y
INY
STA temp2
CMP temp
bcc doNothing_Down ;if Y<=Y+1, do nothing. Otherwise swap them.

    ;we had to re-arrange an item.
    lda temp
    dey
    sta (z_HL),y   ;store the higher value at base+y+1
    inx ;sort count. If zero at the end, we're done.
    iny
    lda temp2
    sta (z_HL),y   ;store the lower value at base+y

doNothing_Down:
INC yINC
DEC yDEC
LDA yINC
BPL COCKTAILSORT

CPX #0
BEQ doneSorting
LDX #0          ;reset the counter
LDY #0
STY yINC
DEY             ;LDY #$FF
STY yDEC
INY		;LDY #0
JMP COCKTAILSORT
doneSorting:
RTS


siftDown: function [items, start, ending][
    root: start
    a: new items
    while [ending > 1 + 2 * root][
        child: 1 + 2 * root
        if and? ending > child + 1
                a\[child+1] > a\[child] -> child: child + 1

        if? a\[root] < a\[child][
            tmp: a\[child]
            a\[child]: a\[root]
            a\[root]: tmp
            root: child
        ]
        else -> return a
    ]
    return a
]

heapSort: function [items][
    b: new items
    count: size b
    loop ((count-2)/2) .. 0 'start -> b: siftDown b start count
    loop (count-1) .. 1 'ending [
        tmp: b\[ending]
        b\[ending]: b\0
        b\0: tmp
        b: siftDown b 0 ending
    ]
    return b
]

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


bogo_sort(L,Rl) :-
	min_list(L,Min),
	repeat,
	random_permutation(L,Rl),
	is_sorted(Rl,Min),
	!.

is_sorted([],_).
is_sorted([N|T],P) :-
	N >= P,
	is_sorted(T,N).


Procedure KnuthShuffle (Array a(1))
  Protected i, Size = ArraySize(a())
  For i = 0 To Size
    Swap a(i), a(Random(Size))
  Next
EndProcedure

Procedure isSorted(Array a(1))
  Protected i, Size = ArraySize(a())
  For i = 1 To Size
    If a(i) < a(i - 1)
      ProcedureReturn #False
    EndIf
  Next
  ProcedureReturn #True
EndProcedure

Procedure BogoSort(Array a(1))
  Protected Size = ArraySize(a()) + 1, iter

  While Not isSorted(a())
    iter + 1
    KnuthShuffle(a())
  Wend
  MessageRequester("Results","Array of " + Str(Size) + " integers required " + Str(iter) + " shuffles To SORT.")
EndProcedure

Dim b(10)
For i = 0 To 10
  b(i) = Random(100)
Next

BogoSort(b())


with javascript_semantics
object {x,y,z} = {"lions, tigers, and","bears, oh my","(from the \"Wizard of OZ\")"}
                         ?{x,y,z}
{x,y,z} = sort({x,y,z})  ?{x,y,z}

{x,y,z} = {77444,-12,0}  ?{x,y,z}
{x,y,z} = sort({x,y,z})  ?{x,y,z}


<?php
//Sort strings
$x = 'lions, tigers, and';
$y = 'bears, oh my!';
$z = '(from the "Wizard of OZ")';
$items = [$x, $y, $z];
sort($items);

list($x, $y, $z) = $items;

echo <<<EOT
Case 1:
  x = $x
  y = $y
  z = $z

EOT;

//Sort numbers
$x = 77444;
$y = -12;
$z = 0;
$items = [$x, $y, $z];
sort($items);

list($x, $y, $z) = $items;

echo <<<EOT
Case 2:
  x = $x
  y = $y
  z = $z

EOT;


/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program cocktailSort64.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 cocktailSort
    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
/******************************************************************/
/*         cocktail sort                                              */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the first element    */
/* x2 contains the number of element */
cocktailSort:
    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 x2,x2,1                // compute i = n - 1
1:                             // start loop 1
    mov x3,x1                  // start index
    mov x9,0
    sub x7,x2,1
2:                             // start loop 2
    add x4,x3,1
    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 x9,1                   // top table not sorted
3:
    add x3,x3,1                // increment index j
    cmp x3,x7                  // end ?
    ble 2b                     // no -> loop 2
    cmp x9,0                   // table sorted ?
    beq 100f                   // yes -> end
    mov x9,0
    mov x3,x7
4:
    add x4,x3,1
    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 5f
    str x6,[x0,x3,lsl 3]       // if smaller inversion
    str x5,[x0,x4,lsl 3]
    mov x9,1                   // top table not sorted
5:
    sub x3,x3,1                // decrement index j
    cmp x3,x1                  // end ?
    bge 4b                     // no -> loop 2

    cmp x9,0                   // table sorted ?
    bne 1b                     // no -> 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
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 CoctailSort(INT ARRAY a INT size)
  INT i,tmp
  BYTE swapped

  DO
    swapped=0
    i=0
    WHILE i<size-1
    DO
      IF a(i)>a(i+1) THEN
        tmp=a(i) a(i)=a(i+1) a(i+1)=tmp
        swapped=1
      FI
      i==+1
    OD

    IF swapped=0 THEN EXIT FI

    swapped=0
    i=size-1
    WHILE i>=0
    DO
      IF a(i)>a(i+1) THEN
        tmp=a(i) a(i)=a(i+1) a(i+1)=tmp
        swapped=1
      FI
      i==-1
    OD

  UNTIL swapped=0
  OD
RETURN

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


heapSort(a) {
    Local end
    end := %a%0
    heapify(a,end)
    While end > 1
        %a%%end% := (%a%1 "", %a%1 := %a%%end%)
       ,siftDown(a, 1, --end)
}

heapify(a, count) {
    Local start
    start := count // 2
    While start
       siftDown(a, start--, count)
}

siftDown(a, start, end) {
    Local child, c1
    While start*2 <= end {
        c1 := 1 + child := start*2
        If (c1 <= end && %a%%child% < %a%%c1%)
            child := c1
        If (%a%%start% < %a%%child%)
            %a%%start% := (%a%%child% "", %a%%child% := %a%%start%)
           ,start := child
        Else Return
    }
}

a = 1,5,2,7,3,4,6,8,1 ; ----- test -----
StringSplit a, a, `,
heapSort("a")
ListVars
MsgBox


import random

def bogosort(l):
    while not in_order(l):
        random.shuffle(l)
    return l

def in_order(l):
    if not l:
        return True
    last = l[0]
    for x in l[1:]:
        if x < last:
            return False
        last = x
    return True


(define remove-element
  0   [_ | R] -> R
  Pos [A | R] -> [A | (remove-element (1- Pos) R)])

(define get-element
  Pos R -> (nth (1+ Pos) R))

(define shuffle-0
  Pos R -> [(get-element Pos R) | (shuffle (remove-element Pos R))])

(define shuffle
  [] -> []
  R  -> (shuffle-0 (RANDOM (length R)) R))

(define in-order?
  []        -> true
  [A]       -> true
  [A B | R] -> (in-order? [B | R]) where (<= A B)
  _         -> false)

(define bogosort
  Suggestion -> Suggestion where (in-order? Suggestion)
  Suggestion -> (bogosort (shuffle Suggestion)))


[ true swap
  dup [] != if
    [ behead swap witheach
        [ tuck > if
          [ dip not
            conclude ] ] ]
  drop ]                                is inorder  ( [ --> b )

[ dup inorder not while shuffle again ] is bogosort ( [ --> [ )


(let (X 77444  Y -12  Z 0)
   (println X Y Z)
   (mapc set '(X Y Z) (sort (list X Y Z)))
   (println X Y Z) )


To run:
Start up.
Sort three numbers.
Wait for the escape key.
Shut down.

To sort three numbers:
Put 77444 into an x number.
Put -12 into a y number.
Put 0 into a z number.
Write "===Before sorting===" on the console.
Write "x: " then the x on the console.
Write "y: " then the y on the console.
Write "z: " then the z on the console.
Sort the x and the y and the z.
Write "===After sorting===" on the console.
Write "x: " then the x on the console.
Write "y: " then the y on the console.
Write "z: " then the z on the console.

To sort a first number and a second number and a third number:
If the first number is greater than the second number, swap the first number with the second number.
If the second number is greater than the third number, swap the second number with the third number.
If the first number is greater than the second number, swap the first number with the second number.


;sort three variables: x, y, z

;Macro handles any of the native types, including integers, floating point, and strings
;because the variable types are not declared but substituted during each instance of the macro.
;The sorting is in ascending order, i.e. x < y < z.
Macro sort3vars(x, y, z)
  If x > y: Swap x, y: EndIf
  If x > z: Swap x, z: EndIf
  If y > z: Swap y, z: EndIf
EndMacro

;Macro to perform the sorting test for each variable type, again by substitution.
Macro test_sort(x, y, z)
  PrintN("Variables before sorting: " + #CRLF$ + x + #CRLF$ + y + #CRLF$ + z + #CRLF$)
  sort3vars(x, y, z)

  PrintN("Variables after sorting: " + #CRLF$ + x + #CRLF$ + y + #CRLF$ + z + #CRLF$)
EndMacro

;Define three sets of variables each with a different type for testing
Define.s x, y, z ;string
x = "lions, tigers, and"
y = "bears, oh my!"
z = ~"(from the \"Wizard of OZ\")" ;uses an escaped string as one way to include quotation marks

Define x1 = 77444, y1 = -12, z1 = 0 ;integer

Define.f x2= 5.2, y2 = -1133.9, z2 = 0 ;floating point
If OpenConsole()
  PrintN("Sort three variables" + #CRLF$)
  test_sort(x, y, z) ;strings

  test_sort(x1, y1, z1) ;integers

  test_sort(x2, y2, z2) ;floating point

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


function cocktailSort(input:Array):Array {
   do {
        var swapped:Boolean=false;
	for (var i:uint = 0; i < input.length-1; i++) {
	    if (input[i]>input[i+1]) {
	    var tmp=input[i];
	    input[i]=input[i+1];
	    input[i+1]=tmp;
	    swapped=true;
	    }
	}
	if (! swapped) {
            break;
	}
	for (i = input.length -2; i >= 0; i--) {
	    if (input[i]>input[i+1]) {
	    tmp=input[i];
	    input[i]=input[i+1];
	    input[i+1]=tmp;
	    swapped=true;
	    }
        }
    } while (swapped);
   return input;
}


with Ada.Text_Io; use Ada.Text_Io;

procedure Cocktail_Sort_Test is
   procedure Cocktail_Sort (Item : in out String) is
      procedure Swap(Left, Right : in out Character) is
         Temp : Character := Left;
      begin
         Left := Right;
         Right := Temp;
      end Swap;
      Swapped : Boolean := False;
   begin
      loop
         for I in 1..Item'Last - 1 loop
            if Item(I) > Item(I + 1) then
               Swap(Item(I), Item(I + 1));
               Swapped := True;
            end if;
         end loop;
         if not Swapped then
            for I in reverse 1..Item'Last - 1 loop
               if Item(I) > Item(I + 1) then
                  Swap(Item(I), Item(I + 1));
                  Swapped := True;
               end if;
            end loop;
         end if;
         exit when not Swapped;
         Swapped := False;
      end loop;
   end Cocktail_Sort;
   Data : String := "big fjords vex quick waltz nymph";
begin
   Put_Line(Data);
   Cocktail_Sort(Data);
   Put_Line(Data);
end Cocktail_Sort_Test;


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

      DEF PROCheapsort(a())
      LOCAL e%
      PROCheapify(a())
      FOR e% = DIM(a(),1) TO 1 STEP -1
        SWAP a(e%), a(0)
        PROCsiftdown(a(), 0, e%-1)
      NEXT
      ENDPROC

      DEF PROCheapify(a())
      LOCAL s%, m%
      m% = DIM(a(),1)
      FOR s% = (m% - 1) / 2 TO 0 STEP -1
        PROCsiftdown(a(), s%, m%)
      NEXT
      ENDPROC

      DEF PROCsiftdown(a(), s%, e%)
      LOCAL c%, r%
      r% = s%
      WHILE r% * 2 + 1 <= e%
        c% = r% * 2 + 1
        IF c% + 1 <= e% IF a(c%) < a(c% + 1) c% += 1
        IF a(r%) < a(c%) SWAP a(r%), a(c%) : r% = c% ELSE ENDPROC
      ENDWHILE
      ENDPROC


// This can be run using Cintcode BCPL freely available from www.cl.cam.ac.uk/users/mr10.

GET "libhdr.h"

LET heapify(v, k, i, last) BE
{ LET j = i+i  // If there is a son (or two), j = subscript of first.
  AND x = k    // x will hold the larger of the sons if any.

  IF j<=last DO x := v!j      // j, x = subscript and key of first son.
  IF j< last DO
  { LET y = v!(j+1)           // y = key of the other son.
    IF x<y DO x,j := y, j+1   // j, x = subscript and key of larger son.
  }

  IF k>=x DO
  { v!i := k                  // k is not lower than larger son if any.
    RETURN
  }
  v!i := x
  i := j
} REPEAT

AND heapsort(v, upb) BE
{ FOR i = upb/2 TO 1 BY -1 DO heapify(v, v!i, i, upb)

  FOR i = upb TO 2 BY -1 DO
  { LET k = v!i
    v!i := v!1
    heapify(v, k, 1, i-1)
  }
}

LET start() = VALOF {
  LET v = VEC 1000
  FOR i = 1 TO 1000 DO v!i := randno(1_000_000)
  heapsort(v, 1000)
  FOR i = 1 TO 1000 DO
  { IF i MOD 10 = 0 DO newline()
    writef(" %i6", v!i)
  }
  newline()
}


bogosort <- function(x) {
   while(is.unsorted(x)) x <- sample(x)
   x
}

n <- c(1, 10, 9, 7, 3, 0)
bogosort(n)


#lang racket
(define (bogo-sort l) (if (apply <= l) l (bogo-sort (shuffle l))))

(require rackunit)
(check-equal? (bogo-sort '(6 5 4 3 2 1)) '(1 2 3 4 5 6))
(check-equal? (bogo-sort (shuffle '(1 1 1 2 2 2))) '(1 1 1 2 2 2))

(let ((unsorted (for/list ((i 10)) (random 1000))))
  (displayln unsorted)
  (displayln (bogo-sort unsorted)))


sub bogosort (@list is copy) {
    @list .= pick(*) until [<=] @list;
    return @list;
}

my @nums = (^5).map: { rand };
say @nums.sort.Str eq @nums.&bogosort.Str ?? 'ok' !! 'not ok';


#python2 Code for Sorting 3 values
a= raw_input("Enter values one by one ..\n1.").strip()
b=raw_input("2.").strip()
c=raw_input("3.").strip()
if a>b :
   a,b = b,a
if a>c:
   a,c = c,a
if b>c:
   b,c = c,b
print(str(a)+" "+str(b)+" "+str(c))


  [ stack ] is x
  [ stack ] is y
  [ stack ] is z

  $ 'lions, tigers, and'        x put
  $ 'bears, oh my!'             y put
  $ '(from the "Wizard of OZ")' z put

  x take y take z take
  3 pack sortwith $> unpack
  z put y put x put

  say " x = " x take echo$ cr
  say " y = " y take echo$ cr
  say " z = " z take echo$ cr

  cr

   77444 x put
  -12    y put
   0     z put

  x take y take z take
  3 pack sortwith > unpack
  z put y put x put

  say " x = " x take echo cr
  say " y = " y take echo cr
  say " z = " z take echo cr


#lang R

assignVec <- Vectorize("assign", c("x", "value"))
`%<<-%` <- function(x, value) invisible(assignVec(x, value, envir = .GlobalEnv)) # define multiple global assignments operator


#lang racket

(define-syntax-rule (sort-3! x y z <?)
  (begin
    (define-syntax-rule (swap! x y) (let ((tmp x)) (set! x y) (set! y tmp)))
    (define-syntax-rule (sort-2! x y) (when (<? y x) (swap! x y)))
    (sort-2! x y)
    (sort-2! x z)
    (sort-2! y z)))

(module+ test
  (require rackunit
           data/order)

  (define (test-permutations l <?)
    (test-case
     (format "test-permutations ~a" (object-name <?))
     (for ((p (in-permutations l)))
       (match-define (list a b c) p)
       (sort-3! a b c <?)
       (check-equal? (list a b c) l))))

  (test-permutations '(1 2 3) <)

  ;; string sorting
  (let ((x  "lions, tigers, and")
        (y  "bears, oh my!")
        (z  "(from the \"Wizard of OZ\")"))
    (sort-3! x y z string<?)
    (for-each displayln (list x y z)))

  (newline)

  ;; general data sorting
  (define datum<? (order-<? datum-order))
  (let ((x  "lions, tigers, and")
        (y  "bears, oh my!")
        (z  '(from the "Wizard of OZ")))
    (sort-3! x y z datum<?)
    (for-each displayln (list x y z))))


begin
    comment Sorting algorithms/Cocktail sort - Algol 60;
    integer nA;
    nA:=20;

    begin
        integer array A[1:nA];

        procedure cocktailsort(lb,ub);
        value lb,ub; integer lb,ub;
        begin
            integer i,lbx,ubx;
            boolean swapped;
            lbx:=lb; ubx:=ub-1; swapped :=true;
            for i:=1 while swapped do begin

                procedure swap(i); value i; integer i;
                begin
                    integer temp;
                    temp  :=A[i];
                    A[i]  :=A[i+1];
                    A[i+1]:=temp;
                    swapped:=true
                end swap;

                swapped:=false;
                    for i:=lbx step  1 until ubx do if A[i]>A[i+1] then swap(i);
                if swapped
                then begin
                    for i:=ubx step -1 until lbx do if A[i]>A[i+1] then swap(i);
                    ubx:=ubx-1; lbx:=lbx+1
                end
            end
        end cocktailsort;

        procedure inittable(lb,ub);
        value lb,ub; integer lb,ub;
        begin
            integer i;
            for i:=lb step 1 until ub do A[i]:=entier(rand*100)
        end inittable;

        procedure writetable(lb,ub);
        value lb,ub; integer lb,ub;
        begin
            integer i;
            for i:=lb step 1 until ub do outinteger(1,A[i]);
            outstring(1,"\n")
        end writetable;

        nA:=20;
        inittable(1,nA);
        writetable(1,nA);
        cocktailsort(1,nA);
        writetable(1,nA)
    end
end


MODE DATA = CHAR;
PROC swap = (REF DATA a,b)VOID:(
  DATA tmp:=a; a:=b; b:=tmp
);

PROC cocktail sort = (REF[]DATA a)VOID: (
  WHILE
    BOOL swapped := FALSE;
    FOR i FROM LWB a TO UPB a - 1 DO
      IF a[ i ] > a[ i + 1 ] THEN # test whether the two elements are in the wrong order #
        swap( a[ i ], a[ i + 1 ] ); # let the two elements change places #
        swapped := TRUE
      FI
    OD;
    IF NOT swapped THEN
      # we can exit the outer loop here if no swaps occurred. #
      break do while loop
    FI;
    swapped := FALSE;
    FOR i FROM UPB a - 1 TO LWB a DO
      IF a[ i ] > a[ i + 1 ] THEN
        swap( a[ i ], a[ i + 1 ] );
        swapped := TRUE
      FI
    OD;
# WHILE # swapped # if no elements have been swapped, then the list is sorted #
  DO SKIP OD;
  break do while loop: SKIP
);

[32]CHAR data := "big fjords vex quick waltz nymph";
cocktail sort(data);
print(data)


#include <stdio.h>

int max (int *a, int n, int i, int j, int k) {
    int m = i;
    if (j < n && a[j] > a[m]) {
        m = j;
    }
    if (k < n && a[k] > a[m]) {
        m = k;
    }
    return m;
}

void downheap (int *a, int n, int i) {
    while (1) {
        int j = max(a, n, i, 2 * i + 1, 2 * i + 2);
        if (j == i) {
            break;
        }
        int t = a[i];
        a[i] = a[j];
        a[j] = t;
        i = j;
    }
}

void heapsort (int *a, int n) {
    int i;
    for (i = (n - 2) / 2; i >= 0; i--) {
        downheap(a, n, i);
    }
    for (i = 0; i < n; i++) {
        int t = a[n - i - 1];
        a[n - i - 1] = a[0];
        a[0] = t;
        downheap(a, n - i - 1, 0);
    }
}

int main () {
    int a[] = {4, 65, 2, -31, 0, 99, 2, 83, 782, 1};
    int n = sizeof a / sizeof a[0];
    int i;
    for (i = 0; i < n; i++)
        printf("%d%s", a[i], i == n - 1 ? "\n" : " ");
    heapsort(a, n);
    for (i = 0; i < n; i++)
        printf("%d%s", a[i], i == n - 1 ? "\n" : " ");
    return 0;
}


/*REXX program performs a type of  bogo sort  on  numbers in an array.  */
parse arg list                         /*obtain optional list from C.L. */
if list=''  then list=-21 333 0 444.4  /*Not defined?  Then use default.*/
#=words(list)                          /*the number of numbers in list. */
   do i=1  for words(list);  @.i=word(list,i);  end   /*create an array.*/
call tell 'before bogo sort'

  do bogo=1

    do j=1  for #-1;   jp=j+1          /* [↓]  compare a # with the next*/
    if @.jp>[email protected].j  then iterate         /*so far, so good;  keep looking.*/
                                       /*get 2 unique random #s for swap*/
       do  until a\==b;  a=random(1, #);     b=random(1, #);    end

    parse value @.a @.b  with  @.b @.a /*swap 2 random numbers in array.*/
    iterate bogo                       /*go and try another bogo sort.  */
    end     /*j*/

  leave                                /*we're finished with bogo sort. */
  end       /*bogo*/                   /* [↓]  show the # of bogo sorts.*/

say 'number of bogo sorts performed =' bogo
call tell ' after bogo sort'
exit                                   /*stick a fork in it, we're done.*/
/*──────────────────────────────────TELL subroutine─────────────────────*/
tell:  say;  say center(arg(1), 50, '─')
                 do t=1  for #
                 say arg(1)  'element'right(t, length(#))'='right(@.t, 18)
                 end   /*t*/
say
return


# Sorting strings. Added a vertical bar between strings to make them discernable
my ($a, $b, $c) = 'lions, tigers, and', 'bears,  oh my!', '(from "The Wizard of Oz")';
say "sorting: {($a, $b, $c).join('|')}";
say ($a, $b, $c).sort.join('|'), ' - standard lexical string sort';

# Sorting numeric things
my ($x, $y, $z) = 7.7444e4, -12, 18/2;
say "\nsorting: $x $y $z";
say ($x, $y, $z).sort, ' - standard numeric sort, low to high';

# Or, with a modified comparitor:
for  -*,       ' - numeric sort high to low',
     ~*,       ' - lexical "string" sort',
     *.chars,  ' - sort by string length short to long',
     -*.chars, ' - or long to short'
  -> $comparitor, $type {
    my ($x, $y, $z) = 7.7444e4, -12, 18/2;
    say ($x, $y, $z).sort( &$comparitor ), $type;
}
say '';

# sort ALL THE THINGS
# sorts by lexical order with numeric values by magnitude.
.say for ($a, $b, $c, $x, $y, $z).sort;


foreach [x y z] [
	"lions, tigers, and"
	"bears, oh my!"
	{(from the "Wizard of OZ")}
	77444 -12 0
	3.1416 3.1415926 3.141592654
	#"z" #"0" #"A"
	216.239.36.21 172.67.134.114 127.0.0.1
	[email protected] [email protected] [email protected]
	potato carrot cabbage
][
	set [x y z] sort reduce [x y z]
	print ["x:" mold x "y:" mold y "z:" mold z]
]


begin
    % As algol W does not allow overloading, we have to have type-specific   %
    % sorting procedures - this coctail sorts an integer array               %
    % as there is no way for the procedure to determine the array bounds, we %
    % pass the lower and upper bounds in lb and ub                           %
    procedure coctailSortIntegers( integer array item( * )
                                 ; integer value lb
                                 ; integer value ub
                                 ) ;
    begin
        integer lower, upper;

        lower := lb;
        upper := ub - 1;

        while
            begin
                logical swapped;

                procedure swap( integer value i ) ;
                begin
                    integer val;
                    val           := item( i );
                    item( i )     := item( i + 1 );
                    item( i + 1 ) := val;
                    swapped       := true;
                end swap ;

                swapped := false;
                for i := lower until upper do if item( i ) > item( i + 1 ) then swap( i );
                if swapped
                then begin
                    % there was at least one unordered element so try a 2nd sort pass %
                    for i := upper step -1 until lower do if item( i ) > item( i + 1 ) then swap( i );
                    upper := upper - 1; lower := lower + 1;
                end if_swapped ;
                swapped
            end
        do  begin end;
    end coctailSortIntegers ;

    begin % test the sort                                                    %
        integer array data( 1 :: 10 );

        procedure writeData ;
        begin
            write( data( 1 ) );
            for i := 2 until 10 do writeon( data( i ) );
        end writeData ;

        % initialise data to unsorted values                                 %
        integer dPos;
        dPos  := 1;
        for i := 16, 2, -6, 9, 90, 14, 0, 23, 8, 9
        do begin
            data( dPos ) := i;
            dPos         := dPos + 1;
        end for_i ;

        i_w := 3; s_w := 1; % set output format %
        writeData;
        coctailSortIntegers( data, 1, 10 );
        writeData;
    end test ;
end.


/* ARM assembly Raspberry PI  */
/*  program cocktailSort.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 cocktailSort
    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
/******************************************************************/
/*         cocktail Sort                                          */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the first element    */
/* r2 contains the number of element */
cocktailSort:
    push {r1-r9,lr}           @ save registers
    sub r2,r2,#1              @ compute i = n - 1
    add r8,r1,#1
1:                            @ start loop 1
    mov r3,r1                 @ start index
    mov r9,#0
    sub r7,r2,#1              @ max
2:                            @ start loop 2
    add r4,r3,#1
    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 r9,#1               @ top table not sorted
    add r3,#1                 @ increment index j
    cmp r3,r7                 @ end ?
    ble 2b                    @ no -> loop 2
    cmp r9,#0                 @ table sorted ?
    beq 100f                  @ yes -> end
    @ bl displayTable
    mov r9,#0
    mov r3,r7
3:
    add r4,r3,#1
    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 r9,#1               @ top table not sorted
    sub r3,#1                 @ decrement index j
    cmp r3,r1                 @ end ?
    bge 3b                    @ no -> loop 2

    @ bl displayTable
    cmp r9,#0                 @ table sorted ?
    bne 1b                    @ no -> 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 signed
    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"


using System;
using System.Collections.Generic;
using System.Text;

public class HeapSortClass
{
    public static void HeapSort<T>(T[] array)
    {
        HeapSort<T>(array, 0, array.Length, Comparer<T>.Default);
    }

    public static void HeapSort<T>(T[] array, int offset, int length, IComparer<T> comparer)
    {
        HeapSort<T>(array, offset, length, comparer.Compare);
    }

    public static void HeapSort<T>(T[] array, int offset, int length, Comparison<T> comparison)
    {
        // build binary heap from all items
        for (int i = 0; i < length; i++)
        {
            int index = i;
            T item = array[offset + i]; // use next item

            // and move it on top, if greater than parent
            while (index > 0 &&
                comparison(array[offset + (index - 1) / 2], item) < 0)
            {
                int top = (index - 1) / 2;
                array[offset + index] = array[offset + top];
                index = top;
            }
            array[offset + index] = item;
        }

        for (int i = length - 1; i > 0; i--)
        {
            // delete max and place it as last
            T last = array[offset + i];
            array[offset + i] = array[offset];

            int index = 0;
            // the last one positioned in the heap
            while (index * 2 + 1 < i)
            {
                int left = index * 2 + 1, right = left + 1;

                if (right < i && comparison(array[offset + left], array[offset + right]) < 0)
                {
                    if (comparison(last, array[offset + right]) > 0) break;

                    array[offset + index] = array[offset + right];
                    index = right;
                }
                else
                {
                    if (comparison(last, array[offset + left]) > 0) break;

                    array[offset + index] = array[offset + left];
                    index = left;
                }
            }
            array[offset + index] = last;
        }
    }

    static void Main()
    {
        // usage
        byte[] r = {5, 4, 1, 2};
        HeapSort(r);

        string[] s = { "-", "D", "a", "33" };
        HeapSort(s, 0, s.Length, StringComparer.CurrentCultureIgnoreCase);
    }
}


# Project : Sorting algorithms/Bogosort

test = [4, 65, 2, 31, 0, 99, 2, 83, 782, 1]
shuffles = 0
while ! sorted(test)
        shuffles = shuffles + 1
        shuffle(test)
end
see "" + shuffles + " shuffles required to sort " + len(test)  + " items:" + nl
showarray(test)

func shuffle(d)
        for i = len(d) to 2 step -1
             item = random(i) + 1
             if item <= len(d)
                temp = d[i-1]
                d[i-1] = d[item]
                d[item] = temp
             else
                i = i -1
             ok
next

func sorted(d)
        for j = 2 to len(d)
             if d[j] < d[j-1]
                return false
             ok
        next
        return true

func showarray(vect)
        see "["
        svect = ""
        for n = 1 to len(vect)
              svect = svect + vect[n] + ", "
        next
        svect = left(svect, len(svect) - 2)
        see svect
        see "]" + nl


def shuffle(l)
    l.sort_by { rand }
end

def bogosort(l)
    l = shuffle(l) until in_order(l)
    l
end

def in_order(l)
    (0..l.length-2).all? {|i| l[i] <= l[i+1] }
end


/*REXX program sorts three (any value)  variables  (X, Y, and  Z)  into ascending order.*/
parse arg x y z .                                /*obtain the three variables from C.L. */
if x=='' | x==","  then x= 'lions, tigers, and'        /*Not specified?  Use the default*/
if y=='' | y==","  then y= 'bears,  oh my!'            /* "      "        "   "     "   */
if z=='' | z==","  then z= '(from "The Wizard of Oz")' /* "      "        "   "     "   */
say '───── original value of X: '   x
say '───── original value of Y: '   y
say '───── original value of Z: '   z
if x>y  then do;   _= x;   x= y;   y= _;   end   /*swap the values of   X   and   Y.    */      /* ◄─── sorting.*/
if y>z  then do;   _= y;   y= z;   z= _;   end   /*  "   "     "    "   Y    "    Z.    */      /* ◄─── sorting.*/
if x>y  then do;   _= x;   x= y;   y= _;   end   /*  "   "     "    "   X    "    Y.    */      /* ◄─── sorting */
say                                              /*stick a fork in it,  we're all done. */
say '═════  sorted  value of X: '   x
say '═════  sorted  value of Y: '   y
say '═════  sorted  value of Z: '   z


# Project : Sort three variables

x = 'lions, tigers, and'
y = 'bears, oh my!'
z = '(from the "Wizard of OZ")'
sortthree(x,y,z)
x = 77444
y = -12
z = 0
sortthree(x,y,z)

func sortthree(x,y,z)
        str = []
        add(str,x)
        add(str,y)
        add(str,z)
        str = sort(str)
        see "x = " + str[1] + nl
        see "y = " + str[2] + nl
        see "z = " + str[3] + nl
        see nl


x =  'lions, tigers, and'
y =  'bears, oh my!'
z =  '(from the "Wizard of OZ")'
x, y, z = [x, y, z].sort
puts x, y, z

x, y, z = 7.7444e4, -12, 18/2r # Float, Integer, Rational; taken from Perl 6
x, y, z = [x, y, z].sort
puts x, y, z


trySwap: function [arr,i][
    if arr\[i] < arr\[i-1] [
        tmp: arr\[i]
        arr\[i]: arr\[i-1]
        arr\[i-1]: tmp
        return null
    ]
    return true
]
cocktailSort: function [items][
    t: false
    l: size items
    while [not? t][
        t: true
        loop 1..dec l 'i [
            if null? trySwap items i ->
                t: false
        ]
        if t -> break
        loop (l-1)..1 'i [
            if null? trySwap items i ->
                t: false
        ]
    ]
    return items
]

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


MsgBox % CocktailSort("")
MsgBox % CocktailSort("xxx")
MsgBox % CocktailSort("3,2,1")
MsgBox % CocktailSort("dog,000000,xx,cat,pile,abcde,1,cat,zz,xx,z")

CocktailSort(var) {                      ; SORT COMMA SEPARATED LIST
   StringSplit array, var, `,            ; make array
   i0 := 1, i1 := array0                 ; start, end

   Loop {                                ; break when sorted
     Changed =
     Loop % i1-- -i0 {                   ; last entry will be in place
       j := i0+A_Index, i := j-1
       If (array%j% < array%i%)          ; swap?
         t := array%i%, array%i% := array%j%, array%j% := t
        ,Changed = 1                     ; change has happened
     }
     IfEqual Changed,, Break

     Loop % i1-i0++ {                    ; first entry will be in place
       i := i1-A_Index, j := i+1
       If (array%j% < array%i%)          ; swap?
         t := array%i%, array%i% := array%j%, array%j% := t
        ,Changed = 1                     ; change has happened
     }
     IfEqual Changed,, Break
   }

   Loop % array0                         ; construct string from sorted array
     sorted .= "," . array%A_Index%
   Return SubStr(sorted,2)               ; drop leading comma
}


(defn- swap [a i j]
  (assoc a i (nth a j) j (nth a i)))

(defn- sift [a pred k l]
  (loop [a a x k y (inc (* 2 k))]
    (if (< (inc (* 2 x)) l)
      (let [ch (if (and (< y (dec l)) (pred (nth a y) (nth a (inc y))))
                 (inc y)
                 y)]
        (if (pred (nth a x) (nth a ch))
          (recur (swap a x ch) ch (inc (* 2 ch)))
          a))
      a)))

(defn- heapify[pred a len]
  (reduce (fn [c term] (sift (swap c term 0) pred 0 term))
          (reduce (fn [c i] (sift c pred i len))
                  (vec a)
                  (range (dec (int (/ len 2))) -1 -1))
          (range (dec len) 0 -1)))

(defn heap-sort
  ([a pred]
   (let [len (count a)]
     (heapify pred a len)))
  ([a]
     (heap-sort a <)))


extern crate rand;
use rand::Rng;

fn bogosort_by<T,F>(order: F, coll: &mut [T])
    where F: Fn(&T, &T) -> bool
{
    let mut rng = rand::thread_rng();
    while !is_sorted_by(&order, coll) {
        rng.shuffle(coll);
    }
}

#[inline]
fn is_sorted_by<T,F>(order: F, coll: &[T]) -> bool
    where F: Fn(&T,&T) -> bool,
{
    coll[..].iter().zip(&coll[1..]).all(|(x,y)| order(x,y))
}

fn main() {
    let mut testlist = [1,55,88,24,990876,312,67,0,854,13,4,7];
    bogosort_by(|x,y| x < y, &mut testlist);
    println!("{:?}", testlist);
    bogosort_by(|x,y| x > y, &mut testlist);
    println!("{:?}", testlist);
}


def isSorted(l: List[Int]) = l.iterator sliding 2 forall (s => s.head <= s.last)
def bogosort(l: List[Int]): List[Int] = if (isSorted(l)) l else bogosort(scala.util.Random.shuffle(l))


func in_order(a) {
    return true if (a.len <= 1);
    var first = a[0];
    a.ft(1).all { |elem| first <= elem  ? do { first = elem; true } : false }
}

func bogosort(a) {
    a.shuffle! while !in_order(a);
    return a;
}

var arr = 5.of{ 100.rand.int };
say "Before: #{arr}";
say "After:  #{bogosort(arr)}";


fn main() {
    let mut array = [5, 1, 3];
    array.sort();
    println!("Sorted: {:?}", array);
    array.sort_by(|a, b| b.cmp(a));
    println!("Reverse sorted: {:?}", array);
}


$ include "seed7_05.s7i";

const proc: genSort3 (in type: elemType) is func
  begin
    global

    const proc: doSort3 (in var elemType: x, in var elemType: y, in var elemType: z) is func
      local
        var array elemType: sorted is 0 times elemType.value;
      begin
        writeln("BEFORE: x=[" <& x <& "]; y=[" <& y <& "]; z=[" <& z <& "]");
        sorted := sort([](x, y, z));
        x := sorted[1];
        y := sorted[2];
        z := sorted[3];
        writeln("AFTER: x=[" <& x <& "]; y=[" <& y <& "]; z=[" <& z <& "]");
      end func;

    end global;
  end func;

genSort3(integer);
genSort3(string);

const proc: main is func
  begin
    doSort3(77444, -12, 0);
    doSort3("lions, tigers, and", "bears, oh my!", "(from the \"Wizard of OZ\")");
  end func;


Set x to "lions, tigers and"
Set y to "bears, oh my!"
Set z to "(from the Wizard of Oz)"
log x
log y
log z

set RosettaListAlpha to (x,y,z)
log RosettaListAlpha
sort RosettaListAlpha alphabetically
log RosettaListAlpha

LogSuccess "Alphabetical Sort Successful"

set (x,y,z) to RosettaListAlpha
log x
log y
log z

LogSuccess "Sorted Items back into Original Variables"

Set a to "77444"
set b to "-12"
set c to "0"
set d to "62224"

set RosettaListNum to (a,b,c,d)
log RosettaListNum
sort RosettaListNum numerically
log RosettaListNum

LogSuccess "Numerical Sort Successful"

set (a,b,c,d) to RosettaListNum
log a
log b
log c
log d

LogSuccess "Sorted Numbers back into Original Variables"


func sort_refs(*arr) {
    arr.map{ *_ }.sort ~Z arr -> each { *_[1] = _[0] }
}

var x = 77444
var y =   -12
var z =     0

sort_refs(\x, \y, \z)

say x
say y
say z


{
  line[NR] = $0
}
END { # sort it with cocktail sort
  swapped = 0
  do {
    for(i=1; i < NR; i++) {
      if ( line[i] > line[i+1] ) {
	t = line[i]
	line[i] = line[i+1]
	line[i+1] = t
	swapped = 1
      }
    }
    if ( swapped == 0 ) break
    swapped = 0
    for(i=NR-1; i >= 1; i--) {
      if ( line[i] > line[i+1] ) {
	t = line[i]
	line[i] = line[i+1]
	line[i+1] = t
	swapped = 1
      }
    }
  } while ( swapped == 1 )
  #print it
  for(i=1; i <= NR; i++) {
    print line[i]
  }
}


DEF PROC_ShakerSort(Size%)

Start%=2
End%=Size%
Direction%=1
LastChange%=1
REPEAT
  FOR J% = Start% TO End% STEP Direction%
    IF data%(J%-1) > data%(J%) THEN
       SWAP data%(J%-1),data%(J%)
       LastChange% = J%
    ENDIF
  NEXT J%
  End% = Start%
  Start% = LastChange% - Direction%
  Direction% = Direction% * -1
UNTIL ( ( End% * Direction% ) < ( Start% * Direction% ) )

ENDPROC


% Sort an array in place using heap-sort. The contained type
% may be any type that can be compared.
heapsort = cluster [T: type] is sort
           where T has lt: proctype (T,T) returns (bool)
    rep = null
    aT = array[T]

    sort = proc (a: aT)
        % CLU arrays may start at any index.
        % For simplicity, we will store the old index,
        % reindex the array at zero, do the heap-sort,
        % then undo the reindexing.
        % This should be a constant-time operation.
        old_low: int := aT$low(a)
        aT$set_low(a, 0)
        heapsort_(a)
        aT$set_low(a, old_low)
    end sort

    % Heap-sort a zero-indexed array
    heapsort_ = proc (a: aT)
        heapify(a)
        end_: int := aT$high(a)
        while end_ > 0 do
            swap(a, end_, 0)
            end_ := end_ - 1
            siftDown(a, 0, end_)
        end
    end heapsort_

    heapify = proc (a: aT)
        start: int := (aT$high(a) - 1) / 2
        while start >= 0 do
            siftDown(a, start, aT$high(a))
            start := start - 1
        end
    end heapify

    siftDown = proc (a: aT, start, end_: int)
        root: int := start
        while root*2 + 1 <= end_ do
            child: int := root * 2 + 1
            if child + 1 <= end_ cand a[child] < a[child + 1] then
                child := child + 1
            end
            if a[root] < a[child] then
                swap(a, root, child)
                root := child
            else
                break
            end
        end
    end siftDown

    swap = proc (a: aT, i, j: int)
        temp: T := a[i]
        a[i] := a[j]
        a[j] := temp
    end swap
end heapsort

% Print an array
print_arr = proc [T: type] (s: stream, a: array[T], w: int)
            where T has unparse: proctype (T) returns (string)
    for e: T in array[T]$elements(a) do
        stream$putright(s, T$unparse(e), w)
    end
    stream$putl(s, "")
end print_arr

% Test the heapsort
start_up = proc ()
    po: stream := stream$primary_output()
    arr: array[int] := array[int]$[9, -5, 3, 3, 24, -16, 3, -120, 250, 17]

    stream$puts(po, "Before sorting: ")
    print_arr[int](po,arr,5)

    heapsort[int]$sort(arr)
    stream$puts(po, "After sorting:  ")
    print_arr[int](po,arr,5)
end start_up