(de alt (List)
   (if List (cons (car List) (alt (cddr List))) ()) )

(de merge (L1 L2)
   (cond
      ((not L2) L1)
      ((< (car L1) (car L2))
         (cons (car L1) (merge L2 (cdr L1))))
      (T (cons (car L2) (merge L1 (cdr L2)))) ) )

(de mergesort (List)
   (if (cdr List)
      (merge (mergesort (alt List)) (mergesort (alt (cdr List))))
      List) )

(mergesort (8 1 5 3 9 0 2 7 6 4))


counting_sort <- function(arr, minval, maxval) {
  r <- arr
  z <- 1
  for(i in minval:maxval) {
    cnt = sum(arr == i)
    while(cnt > 0) {
      r[z] = i
      z <- z + 1
      cnt <- cnt - 1
    }
  }
  r
}

# 140+1 instead of 140, since random numbers generated
# by runif are always less than the given maximum;
# floor(a number at most 140.9999...) is 140
ages <- floor(runif(100, 0, 140+1))
sorted <- counting_sort(ages, 0, 140)
print(sorted)


#lang racket

(define (counting-sort xs min max)
  (define ns (make-vector (+ max (- min) 1) 0))
  (for ([x xs])  (vector-set! ns (- x min) (+ (vector-ref ns (- x min)) 1)))
  (for/fold ([i 0]) ([n ns] [x (in-naturals)])
    (for ([j (in-range i (+ i n ))])
      (vector-set! xs j (+ x min)))
    (+ i n))
  xs)

(counting-sort (vector 0 9 3 8 1 -1 1 2 3 7 4) -1 10)


sub counting-sort (@ints) {
    my $off = @ints.min;
    (my @counts)[$_ - $off]++ for @ints;
    flat @counts.kv.map: { ($^k + $off) xx ($^v // 0) }
}

# Testing:
constant @age-range = 2 .. 102;
my @ages = @age-range.roll(50);
say @ages.&counting-sort;
say @ages.sort;

say @ages.&counting-sort.join eq @ages.sort.join ?? 'ok' !! 'not ok';


/* From the pseudocode. */
comb_sort: procedure (A);
   declare A(*) fixed;
   declare t fixed;
   declare (i, gap) fixed binary (31);
   declare swaps bit (1) aligned;

   gap = hbound(A,1) - lbound(A,1);  /* initialize the gap size. */
   do until (gap <= 1 & swaps);
      /* update the gap value for a next comb. */
      put skip data (gap);
      gap = gap / 1.25e0;
      put skip data (gap);
      swaps = '1'b;
      /* a single "comb" over the array. */
      do i = lbound(A,1) by 1 until (i + gap >= hbound(A,1));
         if A(i) > A(i+gap) then
            do;
               t = A(i); A(i) = A(i+gap); A(i+gap) = t;
               swaps = '0'b; /* Flag a swap has occurred, so */
                             /* the list is not guaranteed sorted. */
            end;
       end;
   end;
end comb_sort;


function CombSort ($a) {
    $l = $a.Length
	$gap = 11
	while( $gap -lt $l )
	{
		$gap = [Math]::Floor( $gap*1.3 )
	}
	if( $l -gt 1 )
	{
		$hasChanged = $true
		:outer while ($hasChanged -or ( $gap -gt 1 ) ) {
			$count = 0
			$hasChanged = $false
			if( $gap -gt 1 ) {
				$gap = [Math]::Floor( $gap/1.3 )
			} else {
				$l--
			}
			for ($i = 0; $i -lt ( $l - $gap ); $i++) {
				if ($a[$i] -gt $a[$i+$gap]) {
					$a[$i], $a[$i+$gap] = $a[$i+$gap], $a[$i]
					$hasChanged = $true
					$count++
				}
			}
		}
	}
	$a
}

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


MERGE: PROCEDURE (A,LA,B,LB,C);

/* Merge A(1:LA) with B(1:LB), putting the result in C
   B and C may share the same memory, but not with A.
*/
   DECLARE (A(*),B(*),C(*)) BYADDR POINTER;
   DECLARE (LA,LB) BYVALUE NONASGN FIXED BIN(31);
   DECLARE (I,J,K) FIXED BIN(31);
   DECLARE (SX) CHAR(58) VAR BASED (PX);
   DECLARE (SY) CHAR(58) VAR BASED (PY);
   DECLARE (PX,PY) POINTER;

   I=1; J=1; K=1;
   DO WHILE ((I <= LA) & (J <= LB));
      PX=A(I); PY=B(J);
      IF(SX <= SY) THEN
         DO; C(K)=A(I); K=K+1; I=I+1; END;
      ELSE
         DO; C(K)=B(J); K=K+1; J=J+1; END;
   END;
   DO WHILE (I <= LA);
      C(K)=A(I); I=I+1; K=K+1;
   END;
   RETURN;
END MERGE;

MERGESORT: PROCEDURE (AP,N) RECURSIVE ;

/* Sort the array AP containing N pointers to strings */

     DECLARE (AP(*))              BYADDR POINTER;
     DECLARE (N)                  BYVALUE NONASGN FIXED BINARY(31);
     DECLARE (M,I)                FIXED BINARY;
     DECLARE AMP1(1)              POINTER BASED(PAM);
     DECLARE (pX,pY,PAM) POINTER;
     DECLARE SX CHAR(58) VAR BASED(pX);
     DECLARE SY CHAR(58) VAR BASED(pY);

   IF (N=1) THEN RETURN;
   M = trunc((N+1)/2);
   IF (M>1) THEN CALL MERGESORT(AP,M);
   PAM=ADDR(AP(M+1));
   IF (N-M > 1) THEN CALL MERGESORT(AMP1,N-M);
   pX=AP(M); pY=AP(M+1);
   IF SX <= SY then return;     /* Skip Merge */
   DO I=1 to M; TP(I)=AP(I); END;
   CALL MERGE(TP,M,AMP1,N-M,AP);
   RETURN;
END MERGESORT;


/*REXX pgm sorts an array of integers (can be negative) using the  count─sort algorithm.*/
$= '1 3 6 2 7 13 20 12 21 11 22 10 23 9 24 8 25 43 62 42 63 41 18 42 17 43 16 44 15 45 14 46 79 113 78 114 77 39 78 38'
#= words($);          w= length(#);     !.= 0    /* [↑]  a list of some Recaman numbers.*/
m= 1;                 LO= word($, #);   HI= LO   /*M: max width of any integer in $ list*/
      do j=1  for #;  z= word($, j)+0;  @.j= z;  m= max(m, length(z) ) /*get from $ list*/
      !.z= !.z + 1;   LO= min(LO, z);   HI= max(HI, z)                 /*find LO and HI.*/
      end   /*j*/
                                                 /*W:  max index width for the @. array.*/
call show 'before sort: ';   say copies('▓', 55) /*show the   before   array elements.  */
call countSort   #                               /*sort a number of entries of @. array.*/
call show ' after sort: '                        /*show the    after   array elements.  */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
countSort: parse arg N;  x= 1;    do k=LO  to  HI;   do x=x  for !.k;  @.x= k;  end  /*x*/
                                  end   /*k*/
           return
/*──────────────────────────────────────────────────────────────────────────────────────*/
show: do s=1  for #;  say right("element",20) right(s,w) arg(1) right(@.s,m); end;  return


aList = [4, 65, 2, 99, 83, 782, 1]
see countingSort(aList, 1, 782)

func countingSort f, min, max
     count = list(max-min+1)
     for i = min to max
         count[i] = 0
     next

     for i = 1 to len(f)
         count[ f[i] ] = count[ f[i] ] + 1
     next

     z = 1
     for i = min to max
         while count[i] > 0
               f[z] = i
               z = z + 1
               count[i] = count[i] - 1
         end
     next
     return f


[qsort
  [joinparts [p [*l1] [*l2] : [*l1 p *l2]] view].
  [split_on_first uncons [>] split].
  [small?]
    []
    [split_on_first [l1 l2 : [l1 qsort l2 qsort joinparts]] view i]
  ifte].


;sorts an array of integers
Procedure combSort11(Array a(1))
  Protected i, gap, swaps = 1
  Protected nElements = ArraySize(a())

  gap = nElements
  While (gap > 1) Or (swapped = 1)
    gap * 10 / 13
    If gap = 9 Or gap = 10: gap = 11:  EndIf
    If gap < 1: gap = 1: EndIf

    i = 0
    swaps = 0
    While (i + gap) <= nElements
      If a(i) > a(i + gap)
        Swap a(i), a(i + gap)
        swaps = 1
      EndIf
      i + 1
    Wend
  Wend
EndProcedure


function MergeSort([object[]] $SortInput)
{
	# The base case exits for minimal lists that are sorted by definition
	if ($SortInput.Length -le 1) {return $SortInput}

	# Divide and conquer
	[int] $midPoint = $SortInput.Length/2
	# The @() operators ensure a single result remains typed as an array
	[object[]] $left = @(MergeSort @($SortInput[0..($midPoint-1)]))
	[object[]] $right = @(MergeSort @($SortInput[$midPoint..($SortInput.Length-1)]))

	# Merge
	[object[]] $result = @()
	while (($left.Length -gt 0) -and ($right.Length -gt 0))
	{
		if ($left[0] -lt $right[0])
		{
			$result += $left[0]
			# Use an if/else rather than accessing the array range as $array[1..0]
			if ($left.Length -gt 1){$left = $left[1..$($left.Length-1)]}
			else {$left = @()}
		}
		else
		{
			$result += $right[0]
			# Without the if/else, $array[1..0] would return the whole array when $array.Length == 1
			if ($right.Length -gt 1){$right = $right[1..$($right.Length-1)]}
			else {$right = @()}
		}
	}

	# If we get here, either $left or $right is an empty array (or both are empty!).  Since the
	# rest of the unmerged array is already sorted, we can simply string together what we have.
	# This line outputs the concatenated result.  An explicit 'return' statement is not needed.
	$result + $left + $right
}


fn counting_sort(
    mut data: Vec<usize>,
    min: usize,
    max: usize,
) -> Vec<usize> {
    // create and fill counting bucket with 0
    let mut count: Vec<usize> = Vec::with_capacity(data.len());
    count.resize(data.len(), 0);

    for num in &data {
        count[num - min] = count[num - min] + 1;
    }
    let mut z: usize = 0;
    for i in min..max+1 {
        while count[i - min] > 0 {
            data[z] = i;
            z += 1;
            count[i - min] = count[i - min] - 1;
        }
    }

    data
}

fn main() {
    let arr1 = vec![1, 0, 2, 9, 3, 8, 4, 7, 5, 6];
    println!("{:?}", counting_sort(arr1, 0, 9));

    let arr2 = vec![0, 1, 2, 3, 4, 5, 6, 7, 8, 9];
    println!("{:?}", counting_sort(arr2, 0, 9));

    let arr3 = vec![10, 9, 8, 7, 6, 5, 4, 3, 2, 1, 0];
    println!("{:?}", counting_sort(arr3, 0, 10));
}


def countSort(input: List[Int], min: Int, max: Int): List[Int] =
  input.foldLeft(Array.fill(max - min + 1)(0)) { (arr, n) =>
    arr(n - min) += 1
    arr
  }.zipWithIndex.foldLeft(List[Int]()) {
    case (lst, (cnt, ndx)) => List.fill(cnt)(ndx + min) ::: lst
  }.reverse


func counting_sort(a, min, max) {
    var cnt = ([0] * (max - min + 1))
    a.each {|i| cnt[i-min]++ }
    cnt.map {|i| [min++] * i }.flat
}

var a = 100.of { 100.irand }
say counting_sort(a, 0, 100)


[email protected](Sequence traits) countingSort &min: min &max: max
[| counts index |
  min `defaultsTo: (s reduce: #min: `er).
  max `defaultsTo: (s reduce: #max: `er).
  counts: ((0 to: max - min) project: [| :_ | 0]).
  s do: [| :value | counts at: value - min infect: [| :count | count + 1]].
  index: 0.
  min to: max do: [| :value |
    [(counts at: value - min) isPositive]
      whileTrue:
        [s at: index put: value.
         index: index + 1.
         counts at: value - min infect: [| :val | val - 1]]
  ].
  s
].


Public Sub Quick(a() As Variant, last As Integer)
' quicksort a Variant array (1-based, numbers or strings)
Dim aLess() As Variant
Dim aEq() As Variant
Dim aGreater() As Variant
Dim pivot As Variant
Dim naLess As Integer
Dim naEq As Integer
Dim naGreater As Integer

If last > 1 Then
    'choose pivot in the middle of the array
    pivot = a(Int((last + 1) / 2))
    'construct arrays
    naLess = 0
    naEq = 0
    naGreater = 0
    For Each el In a()
      If el > pivot Then
        naGreater = naGreater + 1
        ReDim Preserve aGreater(1 To naGreater)
        aGreater(naGreater) = el
      ElseIf el < pivot Then
        naLess = naLess + 1
        ReDim Preserve aLess(1 To naLess)
        aLess(naLess) = el
      Else
        naEq = naEq + 1
        ReDim Preserve aEq(1 To naEq)
        aEq(naEq) = el
      End If
    Next
    'sort arrays "less" and "greater"
    Quick aLess(), naLess
    Quick aGreater(), naGreater
    'concatenate
    P = 1
    For i = 1 To naLess
      a(P) = aLess(i): P = P + 1
    Next
    For i = 1 To naEq
      a(P) = aEq(i): P = P + 1
    Next
    For i = 1 To naGreater
      a(P) = aGreater(i): P = P + 1
    Next
End If
End Sub

Public Sub QuicksortTest()
Dim a(1 To 26) As Variant

 'populate a with numbers in descending order, then sort
 For i = 1 To 26: a(i) = 26 - i: Next
 Quick a(), 26
 For i = 1 To 26: Debug.Print a(i);: Next
 Debug.Print
 'now populate a with strings in descending order, then sort
 For i = 1 To 26: a(i) = Chr$(Asc("z") + 1 - i) & "-stuff": Next
 Quick a(), 26
 For i = 1 To 26: Debug.Print a(i); " ";: Next
 Debug.Print
End Sub


comb.sort<-function(a){
  gap<-length(a)
  swaps<-1
  while(gap>1 & swaps==1){
    gap=floor(gap/1.3)
    if(gap<1){
      gap=1
      }
    swaps=0
    i=1
    while(i+gap<=length(a)){
        if(a[i]>a[i+gap]){
        a[c(i,i+gap)] <- a[c(i+gap,i)]
        swaps=1
        }
        i<-i+1
      }
  }
  return(a)
}


#lang racket
(require (only-in srfi/43 vector-swap!))

(define (comb-sort xs)
  (define (ref i) (vector-ref xs i))
  (define (swap i j) (vector-swap! xs i j))
  (define (new gap) (max 1 (exact-floor (/ gap 1.25))))
  (define size (vector-length xs))
  (let loop ([gap size] [swaps 0])
    (unless (and (= gap 1) (= swaps 0))
      (loop (new gap)
            (for/fold ([swaps 0]) ([i (in-range 0 (- size gap))])
              (cond
                [(> (ref i) (ref (+ i gap)))
                 (swap i (+ i gap))
                 (+ swaps 1)]
                [swaps])))))
  xs)


sub comb_sort ( @a is copy ) {
    my $gap = +@a;
    my $swaps = 1;
    while $gap > 1 or $swaps {
        $gap = ( ($gap * 4) div 5 ) || 1 if $gap > 1;

        $swaps = 0;
        for ^(+@a - $gap) -> $i {
            my $j = $i + $gap;
            if @a[$i] > @a[$j] {
                @a[$i, $j] .= reverse;
                $swaps = 1;
            }
        }
    }
    return @a;
}

my @weights = (^50).map: { 100 + ( 1000.rand.Int / 10 ) };
say @weights.sort.Str eq @weights.&comb_sort.Str ?? 'ok' !! 'not ok';


% msort( L, S )
% True if S is a sorted copy of L, using merge sort
msort( [], [] ).
msort( [X], [X] ).
msort( U, S ) :- split(U, L, R), msort(L, SL), msort(R, SR), merge(SL, SR, S).

% split( LIST, L, R )
% Alternate elements of LIST in L and R
split( [], [], [] ).
split( [X], [X], [] ).
split( [L,R|T], [L|LT], [R|RT] ) :- split( T, LT, RT ).

% merge( LS, RS, M )
% Assuming LS and RS are sorted, True if M is the sorted merge of the two
merge( [], RS, RS ).
merge( LS, [], LS ).
merge( [L|LS], [R|RS], [L|T] ) :- L =< R, merge(    LS, [R|RS], T).
merge( [L|LS], [R|RS], [R|T] ) :- L > R,  merge( [L|LS],   RS,  T).


OrderedCollection extend [
    countingSortWithMin: min andMax: max [
	|oc z|
	oc := OrderedCollection new.
	1 to: (max - min + 1) do: [ :n| oc add: 0 ].
	self do: [ :v |
	    oc at: (v - min + 1) put: ( (oc at: (v - min + 1)) + 1)
	].
	z := 1.
	min to: max do: [ :i |
	    1 to: (oc at: (i - min + 1)) do: [ :k |
		self at: z put: i.
		z := z + 1.
	    ]
	]
    ]
].


proc countingsort {a {min ""} {max ""}} {
    # If either of min or max weren't given, compute them now
    if {$min eq ""} {
        set min [::tcl::mathfunc::min $a]
    }
    if {$max eq ""} {
        set max [::tcl::mathfunc::max $a]
    }

    # Make the "array" of counters
    set count [lrepeat [expr {$max - $min + 1}] 0]

    # Count the values in the input list
    foreach n $a {
        set idx [expr {$n - $min}]
        lincr count $idx
    }

    # Build the output list
    set z 0
    for {set i $min} {$i <= $max} {incr i} {
        set idx [expr {$i - $min}]
        while {[lindex $count $idx] > 0} {
            lset a $z $i
            incr z
            lincr count $idx -1
        }
    }
    return $a
}

# Helper that will increment an existing element of a list
proc lincr {listname idx {value 1}} {
    upvar 1 $listname list
    lset list $idx [expr {[lindex $list $idx] + $value}]
}

# Demo code
for {set i 0} {$i < 50} {incr i} {lappend a [expr {1+ int(rand()*10)}]}
puts $a
puts [countingsort $a]


Function quicksort(arr,s,n)
	l = s
	r = s + n - 1
	p = arr(Int((l + r)/2))
	Do Until l > r
		Do While arr(l) < p
			l = l + 1
		Loop
		Do While arr(r) > p
			r = r -1
		Loop
		If l <= r Then
			tmp = arr(l)
			arr(l) = arr(r)
			arr(r) = tmp
			l = l + 1
			r = r - 1
		End If
	Loop
	If s < r Then
		Call quicksort(arr,s,r-s+1)
	End If
	If l < t Then
		Call quicksort(arr,l,t-l+1)
	End If
	quicksort = arr
End Function

myarray=Array(9,8,7,6,5,5,4,3,2,1,0,-1)
m = quicksort(myarray,0,12)
WScript.Echo Join(m,",")


/*REXX program  sorts  and displays  a  stemmed array  using the  comb sort  algorithm. */
call gen                                         /*generate the   @   array elements.   */
call show    'before sort'                       /*display the  before  array elements. */
                            say  copies('▒', 60) /*display a separator line  (a fence). */
call combSort    #                               /*invoke the comb sort (with # entries)*/
call show    ' after sort'                       /*display the   after  array elements. */
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
combSort: procedure expose @.;   parse arg N     /*N:  is the number of  @  elements.   */
          g= N-1                                 /*G:  is the gap between the sort COMBs*/
                 do  until g<=1 & done;  done= 1 /*assume sort is done  (so far).       */
                 g= g * 0.8  % 1                 /*equivalent to:   g= trunc( g / 1.25) */
                 if g==0  then g= 1              /*handle case of the gap is too small. */
                    do j=1  until $>=N;  $= j+g  /*$:     a temporary index  (pointer). */
                    if @.j>@.$  then do;   _= @.j;    @.j= @.$;   @.$= _;   done= 0;   end
                    end   /*j*/
                 end     /*until*/               /* [↑]  swap two elements in the array.*/
          return
/*──────────────────────────────────────────────────────────────────────────────────────*/
gen: @.=;     @.1  = '----polygon---  sides'  ;              @.12 = "dodecagon         12"
              @.2  = '============== =======' ;              @.13 = "tridecagon        13"
              @.3  = 'triangle           3'   ;              @.14 = "tetradecagon      14"
              @.4  = 'quadrilateral      4'   ;              @.15 = "pentadecagon      15"
              @.5  = 'pentagon           5'   ;              @.16 = "hexadecagon       16"
              @.6  = 'hexagon            6'   ;              @.17 = "heptadecagon      17"
              @.7  = 'heptagon           7'   ;              @.18 = "octadecagon       18"
              @.8  = 'octagon            8'   ;              @.19 = "enneadecagon      19"
              @.9  = 'nonagon            9'   ;              @.20 = "icosagon          20"
              @.10 = 'decagon           10'   ;              @.21 = "hectogon         100"
              @.11 = 'hendecagon        11'   ;              @.22 = "chiliagon       1000"
                                                             @.23 = "myriagon       10000"
                         do #=1  while  @.#\=='';  end    /*find how many elements in @ */
      #= #-1;     w= length(#);           return          /*adjust # because of DO loop.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
show:     do k=1  for #; say right('element',15) right(k,w)  arg(1)":"  @.k;  end;  return


aList = [3,5,1,2,7,4,8,3,6,4,1]
see combsort(aList)

func combsort t
     gapd = 1.2473
     gap =  len(t)
     swaps = 0
     while gap + swaps > 1
           k = 0
           swaps = 0
           if gap > 1 gap = floor(gap / gapd) ok
           for k = 1 to len(t) - gap
               if t[k] > t[k + gap]
                  temp = t[k]
                  t[k] = t[k + gap]
                  t[k + gap] = temp
                  swaps = swaps + 1 ok
           next
     end
        return t


Procedure display(List m())
  ForEach m()
    Print(LSet(Str(m()), 3," "))
  Next
  PrintN("")
EndProcedure

;overwrites list m() with the merger of lists ma() and mb()
Procedure merge(List m(), List ma(), List mb())
  FirstElement(m())
  Protected ma_elementExists = FirstElement(ma())
  Protected mb_elementExists = FirstElement(mb())
  Repeat
    If ma() <= mb()
      m() = ma(): NextElement(m())
      ma_elementExists = NextElement(ma())
    Else
      m() = mb(): NextElement(m())
      mb_elementExists = NextElement(mb())
    EndIf
  Until Not (ma_elementExists And mb_elementExists)

  If ma_elementExists
    Repeat
      m() = ma(): NextElement(m())
    Until Not NextElement(ma())
  ElseIf mb_elementExists
    Repeat
      m() = mb(): NextElement(m())
    Until Not NextElement(mb())
  EndIf
EndProcedure

Procedure mergesort(List m())
  Protected NewList ma()
  Protected NewList mb()

  If ListSize(m()) > 1
    Protected current, middle = (ListSize(m()) / 2 ) - 1

    FirstElement(m())
    While current <= middle
      AddElement(ma())
      ma() = m()
      NextElement(m()): current + 1
    Wend

    PreviousElement(m())
    While NextElement(m())
      AddElement(mb())
      mb() = m()
    Wend

    mergesort(ma())
    mergesort(mb())
    LastElement(ma()): FirstElement(mb())
    If ma() <= mb()
      FirstElement(m())
      FirstElement(ma())
      Repeat
        m() = ma(): NextElement(m())
      Until Not NextElement(ma())
      Repeat
        m() = mb(): NextElement(m())
      Until Not NextElement(mb())
    Else
      merge(m(), ma(), mb())
    EndIf
  EndIf
EndProcedure

If OpenConsole()
  Define i
  NewList x()

  For i = 1 To 21: AddElement(x()): x() = Random(60): Next
  display(x())
  mergesort(x())
  display(x())

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


Option Base 1
Private Function countingSort(array_ As Variant, mina As Long, maxa As Long) As Variant
    Dim count() As Integer
    ReDim count(maxa - mina + 1)
    For i = 1 To UBound(array_)
        count(array_(i) - mina + 1) = count(array_(i) - mina + 1) + 1
    Next i
    Dim z As Integer: z = 1
    For i = mina To maxa
        For j = 1 To count(i - mina + 1)
            array_(z) = i
            z = z + 1
        Next j
    Next i
    countingSort = array_
End Function

Public Sub main()
    s = [{5, 3, 1, 7, 4, 1, 1, 20}]
    Debug.Print Join(countingSort(s, WorksheetFunction.Min(s), WorksheetFunction.Max(s)), ", ")
End Sub


function findMax( a )
	dim num
	dim max
	max = 0
	for each num in a
		if num > max then max = num
	next
	findMax = max
end function

function findMin( a )
	dim num
	dim min
	min = 0
	for each num in a
		if num < min then min = num
	next
	findMin = min
end function

'the function returns the sorted array, but the fact is that VBScript passes the array by reference anyway
function countingSort( a )
	dim count()
	dim min, max
	min = findMin(a)
	max = findMax(a)
	redim count( max - min + 1 )
	dim i
	dim z
	for i = 0 to ubound( a )
		count( a(i) - min ) = count( a( i ) - min ) + 1
	next
	z = 0
	for i = min to max
		while count( i - min) > 0
			a(z) = i
			z = z + 1
			count( i - min ) = count( i - min ) - 1
		wend
	next
	countingSort = a
end function


fn counting_sort(mut arr []int, min int, max int) {
	println('Input: ' + arr.str())
	mut count := [0].repeat(max - min + 1)
	for i in 0 .. arr.len {
		nbr := arr[i]
		ndx1 := nbr - min
		count[ndx1] = count[ndx1] + 1
	}
	mut z := 0
	for i in min .. max {
		curr := i - min
		for count[curr] > 0 {
			arr[z] = i
			z++
			count[curr]--
		}
	}
	println('Output: ' + arr.str())
}

fn main() {
	mut arr := [6, 2, 1, 7, 6, 8]
	counting_sort(mut arr, 1, 8)
}


Sub QuickSort(arr() As Integer, ByVal f As Integer, ByVal l As Integer)
    i = f 'First
    j = l 'Last
    Key = arr(i) 'Pivot
    Do While i < j
        Do While i < j And Key < arr(j)
            j = j - 1
        Loop
        If i < j Then arr(i) = arr(j): i = i + 1
        Do While i < j And Key > arr(i)
            i = i + 1
        Loop
        If i < j Then arr(j) = arr(i): j = j - 1
    Loop
    arr(i) = Key
    If i - 1 > f Then QuickSort arr(), f, i - 1
    If j + 1 < l Then QuickSort arr(), j + 1, l
End Sub


class Array
  def combsort!
    gap = size
    swaps = true
    while gap > 1 or swaps
      gap = [1, (gap / 1.25).to_i].max
      swaps = false
      0.upto(size - gap - 1) do |i|
        if self[i] > self[i+gap]
          self[i], self[i+gap] = self[i+gap], self[i]
          swaps = true
        end
      end
    end
    self
  end
end

p [23, 76, 99, 58, 97, 57, 35, 89, 51, 38, 95, 92, 24, 46, 31, 24, 14, 12, 57, 78].combsort!


fn comb_sort<T: PartialOrd>(a: &mut [T]) {
    let len = a.len();
    let mut gap = len;
    let mut swapped = true;
    while gap > 1 || swapped {
        gap = (4 * gap) / 5;
        if gap < 1 {
            gap = 1;
        }
        let mut i = 0;
        swapped = false;
        while i + gap < len {
            if a[i] > a[i + gap] {
                a.swap(i, i + gap);
                swapped = true;
            }
            i += 1;
        }
    }
}

fn main() {
    let mut v = vec![10, 8, 4, 3, 1, 9, 0, 2, 7, 5, 6];
    println!("before: {:?}", v);
    comb_sort(&mut v);
    println!("after:  {:?}", v);
}


from heapq import merge

def merge_sort(m):
    if len(m) <= 1:
        return m

    middle = len(m) // 2
    left = m[:middle]
    right = m[middle:]

    left = merge_sort(left)
    right = merge_sort(right)
    return list(merge(left, right))


[ [] temp put
  [ dup  [] != while
    over [] != while
    over 0 peek
    over 0 peek
    > not if dip
      [ 1 split
        temp take
        rot join
        temp put ]
      again ]
    join
    temp take swap join ] is merge     ( [ [ --> [ )

[ dup size 2 < if done
  dup size 2 / split
  swap recurse
  swap recurse
  merge ]                 is mergesort (   [ --> [ )


var countingSort = Fn.new { |a, min, max|
    var count = List.filled(max - min + 1, 0)
    for (n in a) count[n - min] = count[n - min] + 1
    var z = 0
    for (i in min..max) {
        while (count[i - min] > 0) {
            a[z] = i
            z = z + 1
            count[i - min] = count[i - min] - 1
        }
    }
}

var a = [4, 65, 2, -31, 0, 99, 2, 83, 782, 1]
System.print("Unsorted: %(a)")
var min = a.reduce { |min, i| (i < min) ? i : min }
var max = a.reduce { |max, i| (i > max) ? i : max }
countingSort.call(a, min, max)
System.print("Sorted  : %(a)")


include c:\cxpl\codes;

proc CountingSort(Array, Min, Max, Size); \Sort Array
int  Array, Min, Max, Size;     \minimum, maximum values, number of elements
int  Count, I, Z;
[Count:= Reserve((Max-Min+1)*4);         \Reserve Count with 4 bytes per integer
for I:= 0 to Max-Min do Count(I):= 0;    \initialize Count with 0
for I:= 0 to Size-1 do                   \for each number count its occurrences
    Count(Array(I)-Min):= Count(Array(I)-Min) + 1;
Z:= 0;
for I:= Min to Max do
    while Count(I-Min) > 0 do
        [Array(Z):= I;
        Z:= Z+1;
        Count(I-Min):= Count(I-Min) - 1;
        ];
];

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


fn partition(mut arr []int, low int, high int) int {
	pivot := arr[high]
	mut i := (low - 1)
	for j in low .. high {
		if arr[j] < pivot {
			i++
			temp := arr[i]
			arr[i] = arr[j]
			arr[j] = temp
		}
	}
	temp := arr[i + 1]
	arr[i + 1] = arr[high]
	arr[high] = temp
	return i + 1
}

fn quick_sort(mut arr []int, low int, high int) {
	if low < high {
		pi := partition(mut arr, low, high)
		quick_sort(mut arr, low, pi - 1)
		quick_sort(mut arr, pi + 1, high)
	}
}

fn main() {
	mut arr := [4, 65, 2, -31, 0, 99, 2, 83, 782, 1]
	n := arr.len - 1
	println('Input: ' + arr.str())
	quick_sort(mut arr, 0, n)
	println('Output: ' + arr.str())
}


class SORT{T < $IS_LT{T}} is

  private swap(inout a, inout b:T) is
    temp ::= a;
    a := b;
    b := temp;
  end;

-- ---------------------------------------------------------------------------------
  comb_sort(inout a:ARRAY{T}) is
    gap ::= a.size;
    swapped ::= true;
    loop until!(gap <= 1 and ~swapped);
      if gap > 1 then
        gap := (gap.flt / 1.25).int;
      end;
      i ::= 0;
      swapped := false;
      loop until! ( (i + gap) >= a.size );
        if (a[i] > a[i+gap]) then
	  swap(inout a[i], inout a[i+gap]);
	  swapped := true;
	end;
        i := i + 1;
      end;
    end;
  end;
end;

class MAIN is
  main is
    a:ARRAY{INT} := |88, 18, 31, 44, 4, 0, 8, 81, 14, 78, 20, 76, 84, 33, 73, 75, 82, 5, 62, 70|;
    b ::= a.copy;
    SORT{INT}::comb_sort(inout b);
    #OUT + b + "\n";
  end;
end;


object CombSort extends App {
  val ia = Array(28, 44, 46, 24, 19, 2, 17, 11, 25, 4)
  val ca = Array('X', 'B', 'E', 'A', 'Z', 'M', 'S', 'L', 'Y', 'C')

  def sorted[E](input: Array[E])(implicit ord: Ordering[E]): Array[E] = {
    import ord._
    var gap = input.length
    var swapped = true
    while (gap > 1 || swapped) {
      if (gap > 1) gap = (gap / 1.3).toInt
      swapped = false
      for (i <- 0 until input.length - gap)
        if (input(i) >= input(i + gap)) {
          val t = input(i)
          input(i) = input(i + gap)
          input(i + gap) = t
          swapped = true
        }
    }
    input
  }

  println(s"Unsorted : ${ia.mkString("[", ", ", "]")}")
  println(s"Sorted   : ${sorted(ia).mkString("[", ", ", "]")}\n")

  println(s"Unsorted : ${ca.mkString("[", ", ", "]")}")
  println(s"Sorted   : ${sorted(ca).mkString("[", ", ", "]")}")

}


mergesort <- function(m)
{
   merge_ <- function(left, right)
   {
      result <- c()
      while(length(left) > 0 && length(right) > 0)
      {
         if(left[1] <= right[1])
         {
            result <- c(result, left[1])
            left <- left[-1]
         } else
         {
            result <- c(result, right[1])
            right <- right[-1]
         }
      }
      if(length(left) > 0) result <- c(result, left)
      if(length(right) > 0) result <- c(result, right)
      result
   }

   len <- length(m)
   if(len <= 1) m else
   {
      middle <- length(m) / 2
      left <- m[1:floor(middle)]
      right <- m[floor(middle+1):len]
      left <- mergesort(left)
      right <- mergesort(right)
      if(left[length(left)] <= right[1])
      {
         c(left, right)
      } else
      {
         merge_(left, right)
      }
   }
}
mergesort(c(4, 65, 2, -31, 0, 99, 83, 782, 1)) # -31   0   1   2   4  65  83  99 782


#lang racket

(define (merge xs ys)
  (cond [(empty? xs) ys]
        [(empty? ys) xs]
        [(match* (xs ys)
           [((list* a as) (list* b bs))
            (cond [(<= a b) (cons a (merge as ys))]
                  [         (cons b (merge xs bs))])])]))

(define (merge-sort xs)
  (match xs
    [(or (list) (list _)) xs]
    [_ (define-values (ys zs) (split-at xs (quotient (length xs) 2)))
       (merge (merge-sort ys) (merge-sort zs))]))


fcn countingSort(array, min, max){  // modifies array
   count:=(max - min + 1).pump(List().write,0); // array of (max - min + 1) zeros
   foreach number in (array){
      count[number - min] += 1;
   }
   z:=-1;
   foreach i in ([min .. max]){
      do(count[i - min]){ array[z += 1] = i }
   }
   array
}


def (qsort (pivot ... ns))
  (+ (qsort+keep (fn(_) (_ < pivot)) ns)
     list.pivot
     (qsort+keep (fn(_) (_ > pivot)) ns))

def (qsort x) :case x=nil
  nil


func comb_sort(arr) {
    var gap = arr.len;
    var swaps = true;
    while (gap > 1 || swaps) {
        gap.div!(1.25).int! if (gap > 1);
        swaps = false;
        for i in ^(arr.len - gap) {
            if (arr[i] > arr[i+gap]) {
                arr[i, i+gap] = arr[i+gap, i];
                swaps = true;
            }
        }
    }
    return arr;
}


func combSort(inout list:[Int]) {
    var swapped = true
    var gap = list.count

    while gap > 1 || swapped {
        gap = gap * 10 / 13

        if gap == 9 || gap == 10 {
            gap = 11
        } else if gap < 1 {
            gap = 1
        }

        swapped = false

        for var i = 0, j = gap; j < list.count; i++, j++ {
            if list[i] > list[j] {
                (list[i], list[j]) = (list[j], list[i])
                swapped = true
            }
        }
    }
}


proc combsort {input} {
    set gap [llength $input]
    while 1 {
	set gap [expr {int(floor($gap / 1.3))}]
	set swaps 0
	for {set i 0} {$i+$gap < [llength $input]} {incr i} {
	    set j [expr {$i+$gap}]
	    if {[lindex $input $i] > [lindex $input $j]} {
		set tmp [lindex $input $i]
		lset input $i [lindex $input $j]
		lset input $j $tmp
		incr swaps
	    }
	}
	if {$gap <= 1 && !$swaps} break
    }
    return $input
}

set data {23 76 99 58 97 57 35 89 51 38 95 92 24 46 31 24 14 12 57 78}
puts [combsort $data]


sub merge_sort ( @a ) {
    return @a if @a <= 1;

    my $m = @a.elems div 2;
    my @l = flat merge_sort @a[  0 ..^ $m ];
    my @r = flat merge_sort @a[ $m ..^ @a ];

    return flat @l, @r if @l[*-1] !after @r[0];
    return flat gather {
        take @l[0] before @r[0] ?? @l.shift !! @r.shift
            while @l and @r;
        take @l, @r;
    }
}
my @data = 6, 7, 2, 1, 8, 9, 5, 3, 4;
say 'input  = ' ~ @data;
say 'output = ' ~ @data.&merge_sort;


import "/sort" for Sort

var as = [
    [4, 65, 2, -31, 0, 99, 2, 83, 782, 1],
    [7, 5, 2, 6, 1, 4, 2, 6, 3],
    ["echo", "lima", "charlie", "whiskey", "golf", "papa", "alfa", "india", "foxtrot", "kilo"]
]
for (a in as) {
    System.print("Before: %(a)")
    Sort.quick(a)
    System.print("After : %(a)")
    System.print()
}


:L1→L2
:dim(L2)→A
:While A>5 and B=0
:int(A/1.3)→A
:1→C
:0→B
:While (C+A)≥dim(L2)
:If L2(C)>L2(C+A)
:Then
:L2(C)→D
:L2(C+A)→L2(C)
:D→L2(C+A)
:1→B
:End
:C+1→C
:End
:DelVar A
:DelVar B
:DelVar C
:DelVar D
:L1→L3
:L2→L1
:prgmSORTINS
:L3→L1
:DelVar L3
:Return


PRINT "Comb sort:"
  n = FUNC (_InitArray)
  PROC _ShowArray (n)
  PROC _Combsort (n)
  PROC _ShowArray (n)
PRINT

END

_Combsort PARAM (1)                    ' Combsort subroutine
  LOCAL(4)
  [email protected] = [email protected]
  [email protected] = 1

  DO WHILE ([email protected] > 1) + [email protected]

    [email protected] = ([email protected] * 10) / 13

    IF ([email protected] = 9) + ([email protected] = 10) THEN [email protected] = 11
    IF [email protected] < 1 THEN [email protected] = 1

    [email protected] = 0
    [email protected] = 0
    [email protected] = [email protected]

    DO WHILE [email protected] < [email protected]
      IF @([email protected]) > @([email protected]) THEN PROC _Swap ([email protected], [email protected]) : [email protected] = 1
      [email protected] = [email protected] + 1
      [email protected] = [email protected] + 1
    LOOP
  LOOP
RETURN

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

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

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

RETURN (i)

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

  PRINT
RETURN


Function comb_sort(ByVal s As Variant) As Variant
    Dim gap As Integer: gap = UBound(s)
    Dim swapped As Integer
    Do While True
        gap = WorksheetFunction.Max(WorksheetFunction.Floor_Precise(gap / 1.3), 1)
        swapped = False
        For i = 0 To UBound(s) - gap
            si = Val(s(i))
            If si > Val(s(i + gap)) Then
                s(i) = s(i + gap)
                s(i + gap) = CStr(si)
                swapped = True
            End If
        Next i
        If gap = 1 And Not swapped Then Exit Do
    Loop
    comb_sort = s
End Function

Public Sub main()
    Dim s(9) As Variant
    For i = 0 To 9
        s(i) = CStr(Int(1000 * Rnd))
    Next i
    Debug.Print Join(s, ", ")
    Debug.Print Join(comb_sort(s), ", ")
End Sub


msort: function [a compare] [msort-do merge] [
    if (length? a) < 2 [return a]
    ; define a recursive Msort-do function
    msort-do: function [a b l] [mid] [
        either l < 4 [
            if l = 3 [msort-do next b next a 2]
            merge a b 1 next b l - 1
        ] [
            mid: make integer! l / 2
            msort-do b a mid
            msort-do skip b mid skip a mid l - mid
            merge a b mid skip b mid l - mid
        ]
    ]
    ; function Merge is the key part of the algorithm
    merge: func [a b lb c lc] [
        until [
            either (compare first b first c) [
                change/only a first b
                b: next b
                a: next a
                zero? lb: lb - 1
            ] [
                change/only a first c
                c: next c
                a: next a
                zero? lc: lc - 1
            ]
        ]
        loop lb [
            change/only a first b
            b: next b
            a: next a
        ]
        loop lc [
            change/only a first c
            c: next c
            a: next a
        ]
    ]
    msort-do a copy a length? a
    a
]


/*REXX pgm sorts a stemmed array (numbers and/or chars) using the  merge─sort algorithm.*/
call init                                        /*sinfully initialize the   @   array. */
call show      'before sort'                     /*show the   "before"  array elements. */
                            say copies('▒', 75)  /*display a separator line to the term.*/
call merge          #                            /*invoke the  merge sort  for the array*/
call show      ' after sort'                     /*show the    "after"  array elements. */
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
init: @.=;    @.1= '---The seven deadly sins---'  ;    @.4= "avarice"  ;   @.7= 'gluttony'
              @.2= '==========================='  ;    @.5= "wrath"    ;   @.8= 'sloth'
              @.3= 'pride'                        ;    @.6= "envy"     ;   @.9= 'lust'
      do #=1  until @.#==''; end;   #= #-1;   return      /*#:  # of entries in @ array.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
show: do j=1  for #; say right('element',20) right(j,length(#)) arg(1)":" @.j; end; return
/*──────────────────────────────────────────────────────────────────────────────────────*/
merge: procedure expose @. !.;   parse arg n, L;   if L==''  then do;  !.=;  L= 1;  end
          if n==1  then return;     h= L + 1
          if n==2  then do; if @.L>@.h  then do; [email protected].h; @.[email protected].L; @.L=_; end; return;  end
          m= n % 2                                     /* [↑]  handle case of two items.*/
          call merge  n-m, L+m                         /*divide items  to the left   ···*/
          call merger m,   L,   1                      /*   "     "     "  "  right  ···*/
          i= 1;                     j= L + m
                     do k=L  while k<j                 /*whilst items on right exist ···*/
                     if j==L+n  |  !.i<[email protected].j  then do;     @.k= !.i;     i= i + 1;      end
                                             else do;     @.k= @.j;     j= j + 1;      end
                     end   /*k*/
          return
/*──────────────────────────────────────────────────────────────────────────────────────*/
merger: procedure expose @. !.;  parse arg n,L,T
           if n==1  then do;  !.T= @.L;                                       return;  end
           if n==2  then do;  h= L + 1;   q= T + 1;  !.q= @.L;    !.T= @.h;   return;  end
           m= n % 2                                    /* [↑]  handle case of two items.*/
           call merge  m,   L                          /*divide items  to the left   ···*/
           call merger n-m, L+m, m+T                   /*   "     "     "  "  right  ···*/
           i= L;                     j= m + T
                     do k=T  while k<j                 /*whilst items on left exist  ···*/
                     if j==T+n  |  @.i<=!.j  then do;     !.k= @.i;     i= i + 1;      end
                                             else do;     !.k= !.j;     j= j + 1;      end
                     end   /*k*/
           return


include c:\cxpl\codes;          \intrinsic 'code' declarations
string 0;                       \use zero-terminated strings

proc    QSort(Array, Num);      \Quicksort Array into ascending order
char    Array;                  \address of array to sort
int     Num;                    \number of elements in the array
int     I, J, Mid, Temp;
[I:= 0;
J:= Num-1;
Mid:= Array(J>>1);
while I <= J do
       [while Array(I) < Mid do I:= I+1;
        while Array(J) > Mid do J:= J-1;
        if I <= J then
                [Temp:= Array(I);  Array(I):= Array(J);  Array(J):= Temp;
                I:= I+1;
                J:= J-1;
                ];
        ];
if I < Num-1 then QSort(@Array(I), Num-I);
if J > 0 then QSort(Array, J+1);
];      \QSort

func    StrLen(Str);            \Return number of characters in an ASCIIZ string
char    Str;
int     I;
for I:= 0 to -1>>1-1 do
        if Str(I) = 0 then return I;

char    Str;
[Str:= "Pack my box with five dozen liquor jugs.";
QSort(Str, StrLen(Str), 1);
Text(0, Str);  CrLf(0);
]


fn main() {
    mut a := [170, 45, 75, -90, -802, 24, 2, 66]
    println("before: $a")
    comb_sort(mut a)
    println("after: $a")
}

fn comb_sort(mut a []int) {
    if a.len < 2 {
        return
    }
    for gap := a.len; ; {
        if gap > 1 {
            gap = gap * 4 / 5
        }
        mut swapped := false
        for i := 0; ; {
            if a[i] > a[i+gap] {
                a[i], a[i+gap] = a[i+gap], a[i]
                swapped = true
            }
            i++
            if i+gap >= a.len {
                break
            }
        }
        if gap == 1 && !swapped {
            break
        }
    }
}


var combSort = Fn.new { |a|
    var gap = a.count
    while (true) {
        gap = (gap/1.25).floor
        if (gap < 1) gap = 1
        var i = 0
        var swaps = false
        while (true) {
            if (a[i] > a[i+gap]) {
                var t = a[i]
                a[i] = a[i+gap]
                a[i+gap] = t
                swaps = true
            }
            i = i + 1
            if (i + gap >= a.count) break
        }
        if (gap == 1 && !swaps) return
    }
}

var as = [ [4, 65, 2, -31, 0, 99, 2, 83, 782, 1], [7, 5, 2, 6, 1, 4, 2, 6, 3] ]
for (a in as) {
    System.print("Before: %(a)")
    combSort.call(a)
    System.print("After : %(a)")
    System.print()
}


fcn combSort(list){
   len,gap,swaps:=list.len(),len,True;
   while(gap>1 or swaps){
      gap,swaps=(1).max(gap.toFloat()/1.2473), False;
      foreach i in (len - gap){
         if(list[i]>list[i + gap]){
	    list.swap(i,i + gap);
	    swaps=True;
	 }
      }
   }
   list
}


def merge_sort(m)
  return m if m.length <= 1

  middle = m.length / 2
  left = merge_sort(m[0...middle])
  right = merge_sort(m[middle..-1])
  merge(left, right)
end

def merge(left, right)
  result = []
  until left.empty? || right.empty?
    result << (left.first<=right.first ? left.shift : right.shift)
  end
  result + left + right
end

ary = [7,6,5,9,8,4,3,1,2,0]
p merge_sort(ary)                  # => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]


fn merge<T: Copy + PartialOrd>(x1: &[T], x2: &[T], y: &mut [T]) {
	assert_eq!(x1.len() + x2.len(), y.len());
	let mut i = 0;
	let mut j = 0;
	let mut k = 0;
	while i < x1.len() && j < x2.len() {
		if x1[i] < x2[j] {
			y[k] = x1[i];
			k += 1;
			i += 1;
		} else {
			y[k] = x2[j];
			k += 1;
			j += 1;
		}
	}
	if i < x1.len() {
		y[k..].copy_from_slice(&x1[i..]);
	}
	if j < x2.len() {
		y[k..].copy_from_slice(&x2[j..]);
	}
}


;--------------------------------------------------------------------------------------------------------------------
; Quicksort, inputs (__sdcccall(1) calling convention):
; HL = uint16_t* A (pointer to beginning of array)
; DE = uint16_t len (number of word elements in array)
; modifies: AF, A'F', BC, DE, HL
; WARNING: array can't be aligned to start/end of 64ki address space, like HL == 0x0000, or having last value at 0xFFFE
; WARNING: stack space required is on average about 6*log(len) (depending on the data, in extreme case it may be more)
quicksort_a:
    ; convert arguments to HL=A.begin(), DE=A.end() and continue with quicksort_a_impl
    ex      de,hl
    add     hl,hl
    add     hl,de
    ex      de,hl
    ;  |
    ; fallthrough into implementation
    ;  |
    ;  v
;--------------------------------------------------------------------------------------------------------------------
; Quicksort implementation, inputs:
; HL = uint16_t* A.begin() (pointer to beginning of array)
; DE = uint16_t* A.end() (pointer beyond array)
; modifies: AF, A'F', BC, HL (DE is preserved)
quicksort_a_impl:
    ; array must be located within 0x0002..0xFFFD
    ld      c,l
    ld      b,h         ; BC = A.begin()
    ; if (len < 2) return; -> if (end <= begin+2) return;
    inc     hl
    inc     hl
    or      a
    sbc     hl,de       ; HL = -(2*len-2), len = (2-HL)/2
    ret     nc          ; case: begin+2 >= end <=> (len < 2)

    push    de          ; preserve A.end() for recursion
    push    bc          ; preserve A.begin() for recursion

    ; uint16_t pivot = A[len / 2];
    rr      h
    rr      l
    dec     hl
    res     0,l
    add     hl,de
    ld      a,(hl)
    inc     hl
    ld      l,(hl)
    ld      h,b
    ld      b,l
    ld      l,c
    ld      c,a         ; HL = A.begin(), DE = A.end(), BC = pivot

    ; flip HL/DE meaning, it makes simpler the recursive tail and (A[j] > pivot) test
    ex      de,hl       ; DE = A.begin(), HL = A.end(), BC = pivot
    dec     de          ; but keep "from" address (related to A[i]) at -1 as "default" state

    ; for (i = 0, j = len - 1; ; i++, j--) { ; DE = (A+i-1).hi, HL = A+j+1
.find_next_swap:

    ; while (A[j] > pivot) j--;
.find_j:
    dec     hl
    ld      a,b
    sub     (hl)
    dec     hl          ; HL = A+j (finally)
    jr      c,.find_j   ; if cf=1, A[j].hi > pivot.hi
    jr      nz,.j_found ; if zf=0, A[j].hi < pivot.hi
    ld      a,c         ; if (A[j].hi == pivot.hi) then A[j].lo vs pivot.lo is checked
    sub     (hl)
    jr      c,.find_j
.j_found:

    ; while (A[i] < pivot) i++;
.find_i:
    inc     de
    ld      a,(de)
    inc     de          ; DE = (A+i).hi (ahead +0.5 for swap)
    sub     c
    ld      a,(de)
    sbc     a,b
    jr      c,.find_i   ; cf=1 -> A[i] < pivot

    ; if (i >= j) break; // DE = (A+i).hi, HL = A+j, BC=pivot
    sbc     hl,de       ; cf=0 since `jr c,.find_i`
    jr      c,.swaps_done
    add     hl,de       ; DE = (A+i).hi, HL = A+j

    ; swap(A[i], A[j]);
    inc     hl
    ld      a,(de)
    ldd
    ex      af,af
    ld      a,(de)
    ldi
    ex      af,af
    ld      (hl),a      ; Swap(A[i].hi, A[j].hi) done
    dec     hl
    ex      af,af
    ld      (hl),a      ; Swap(A[i].lo, A[j].lo) done

    inc     bc
    inc     bc          ; pivot value restored (was -=2 by ldd+ldi)
    ; --j; HL = A+j is A+j+1 for next loop (ready)
    ; ++i; DE = (A+i).hi is (A+i-1).hi for next loop (ready)
    jp      .find_next_swap

.swaps_done:
    ; i >= j, all elements were already swapped WRT pivot, call recursively for the two sub-parts
    dec     de          ; DE = A+i

    ; quicksort_c(A, i);
    pop     hl          ; HL = A
    call    quicksort_a_impl

    ; quicksort_c(A + i, len - i);
    ex      de,hl       ; HL = A+i
    pop     de          ; DE = end() (and return it preserved)
    jp      quicksort_a_impl


import scala.language.implicitConversions

object MergeSort extends App {

  def mergeSort(input: List[Int]): List[Int] = {
    def merge(left: List[Int], right: List[Int]): LazyList[Int] = (left, right) match {
      case (x :: xs, y :: ys) if x <= y => x #:: merge(xs, right)
      case (x :: xs, y :: ys) => y #:: merge(left, ys)
      case _ => if (left.isEmpty) right.to(LazyList) else left.to(LazyList)
    }

    def sort(input: List[Int], length: Int): List[Int] = input match {
      case Nil | List(_) => input
      case _ =>
        val middle = length / 2
        val (left, right) = input splitAt middle
        merge(sort(left, middle), sort(right, middle + length % 2)).toList
    }

    sort(input, input.length)
  }

}


(define (merge-sort l gt?)
  (define (merge left right)
    (cond
     ((null? left)
      right)
     ((null? right)
      left)
     ((gt? (car left) (car right))
      (cons (car right)
            (merge left (cdr right))))
     (else
      (cons (car left)
            (merge (cdr left) right)))))
  (define (take l n)
    (if (zero? n)
      (list)
      (cons (car l)
            (take (cdr l) (- n 1)))))
  (let ((half (quotient (length l) 2)))
    (if (zero? half)
      l
      (merge (merge-sort (take      l half) gt?)
             (merge-sort (list-tail l half) gt?)))))


fcn qtSort(list,cmp=Op("<")){	// sort immutable lists
   fcn(list,cmp,N){	// spendy to keep recreating cmp
      reg pivot=list[0], rest=list[1,*];
      left,right:=rest.filter22(cmp,pivot);
      N+=1;
      T.extend(self.fcn(left,cmp,N),T(pivot),self.fcn(right,cmp,N));
   }(list,cmp,0);
}


const proc: mergeSort2 (inout array elemType: arr, in integer: lo, in integer: hi, inout array elemType: scratch) is func
  local
    var integer: mid is 0;
    var integer: k is 0;
    var integer: t_lo is 0;
    var integer: t_hi is 0;
  begin
    if lo < hi then
      mid := (lo + hi) div 2;
      mergeSort2(arr, lo, mid, scratch);
      mergeSort2(arr, succ(mid), hi, scratch);
      t_lo := lo;
      t_hi := succ(mid);
      for k range lo to hi do
        if t_lo <= mid and (t_hi > hi or arr[t_lo] <= arr[t_hi]) then
          scratch[k] := arr[t_lo];
          incr(t_lo);
        else
          scratch[k] := arr[t_hi];
          incr(t_hi);
        end if;
      end for;
      for k range lo to hi do
        arr[k] := scratch[k];
      end for;
    end if;
  end func;

const proc: mergeSort2 (inout array elemType: arr) is func
  local
    var array elemType: scratch is 0 times elemType.value;
  begin
    scratch := length(arr) times elemType.value;
    mergeSort2(arr, 1, length(arr), scratch);
  end func;


func merge(left, right) {
    var result = []
    while (left && right) {
        result << [right,left].min_by{.first}.shift
    }
    result + left + right
}

func mergesort(array) {
    var len = array.len
    len < 2 && return array

    var (left, right) = array.part(len//2)

    left  = __FUNC__(left)
    right = __FUNC__(right)

    merge(left, right)
}

# Numeric sort
var nums = rand(1..100, 10)
say mergesort(nums)

# String sort
var strings = rand('a'..'z', 10)
say mergesort(strings)


fun merge cmp ([], ys) = ys
  | merge cmp (xs, []) = xs
  | merge cmp (xs as x::xs', ys as y::ys') =
      case cmp (x, y) of GREATER => y :: merge cmp (xs, ys')
                       | _       => x :: merge cmp (xs', ys)
;
fun merge_sort cmp [] = []
  | merge_sort cmp [x] = [x]
  | merge_sort cmp xs = let
      val ys = List.take (xs, length xs div 2)
      val zs = List.drop (xs, length xs div 2)
    in
      merge cmp (merge_sort cmp ys, merge_sort cmp zs)
    end
;
merge_sort Int.compare [8,6,4,2,1,3,5,7,9]


// Merge Sort in Swift 4.2
// Source: https://github.com/raywenderlich/swift-algorithm-club/tree/master/Merge%20Sort
// NOTE: by use of generics you can make it sort arrays of any type that conforms to
//       Comparable protocol, however this is not always optimal

import Foundation

func mergeSort(_ array: [Int]) -> [Int] {
  guard array.count > 1 else { return array }

  let middleIndex = array.count / 2

  let leftPart = mergeSort(Array(array[0..<middleIndex]))
  let rightPart = mergeSort(Array(array[middleIndex..<array.count]))

  func merge(left: [Int], right: [Int]) -> [Int] {
    var leftIndex = 0
    var rightIndex = 0

    var merged = [Int]()
    merged.reserveCapacity(left.count + right.count)

    while leftIndex < left.count && rightIndex < right.count {
      if left[leftIndex] < right[rightIndex] {
        merged.append(left[leftIndex])
        leftIndex += 1
      } else if left[leftIndex] > right[rightIndex] {
        merged.append(right[rightIndex])
        rightIndex += 1
      } else {
        merged.append(left[leftIndex])
        leftIndex += 1
        merged.append(right[rightIndex])
        rightIndex += 1
      }
    }

    while leftIndex < left.count {
      merged.append(left[leftIndex])
      leftIndex += 1
    }

    while rightIndex < right.count {
      merged.append(right[rightIndex])
      rightIndex += 1
    }

    return merged
  }

  return merge(left: leftPart, right: rightPart)
}


templates mergesort
  templates merge
    @: $(2);
    [ $(1)... -> \(
      when <?([email protected]<[](0)>)
      | [email protected](1)> do
        $ !
      otherwise
        ^@merge(1) !
        $ -> #
     \),
     [email protected]] !
  end merge
  $ -> #

  when <[](0..1)> do $!
  otherwise
    def half: $::length ~/ 2;
    [$(1..$half) -> mergesort, $($half+1..last) -> mergesort] -> merge !
end mergesort

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


package require Tcl 8.5

proc mergesort m {
    set len [llength $m]
    if {$len <= 1} {
        return $m
    }
    set middle [expr {$len / 2}]
    set left [lrange $m 0 [expr {$middle - 1}]]
    set right [lrange $m $middle end]
    return [merge [mergesort $left] [mergesort $right]]
}

proc merge {left right} {
    set result [list]
    while {[set lleft [llength $left]] > 0 && [set lright [llength $right]] > 0} {
        if {[lindex $left 0] <= [lindex $right 0]} {
            set left [lassign $left value]
        } else {
            set right [lassign $right value]
        }
        lappend result $value
    }
    if {$lleft > 0} {
        lappend result {*}$left
    }
    if {$lright > 0} {
        set result [concat $result $right] ;# another way append elements
    }
    return $result
}

puts [mergesort {8 6 4 2 1 3 5 7 9}] ;# => 1 2 3 4 5 6 7 8 9


mergeSortBy : (i ->{𝕖} i ->{𝕖} Boolean) ->{𝕖} [i] ->{𝕖} [i]
mergeSortBy cmp =
  merge l1 l2 =
    match (l1, l2) with
      (xs, [])           -> xs
      ([], ys)           -> ys
      (x +: xs, y +: ys) -> if cmp x y then x +: merge xs l2 else y +: merge l1 ys
      ([], [])           -> []
  cases
    []  -> []
    [x] -> [x]
    lst ->
      match halve lst with
        (left, right) -> merge (mergeSortBy cmp left) (mergeSortBy cmp right)


split() {
   (while read a b ; do
       echo $a > $1 ; echo $b > $2
   done)
}

mergesort() {
 xargs -n 2 | (read a b; test -n "$b" && (
     lc="1.$1" ; gc="2.$1"
     (echo $a $b;cat)|split >(mergesort $lc >$lc) >( mergesort $gc >$gc)
     sort -m $lc $gc
     rm -f $lc $gc;
 ) || echo $a)
}

cat to.sort | mergesort


#import std

mergesort "p" = @iNCS :-0 ~&B^?a\~&YaO "p"?abh/~&alh2faltPrXPRC ~&arh2falrtPXPRC

#show+

example = mergesort(lleq) <'zoh','zpb','hhh','egi','bff','cii','yid'>


[merge
   [mergei
       uncons [swap [>] split] dip
       [[*m] e2 [*a1] b1 a2 : [*m *a1 e2] b1 a2] view].

   [a b : [] a b] view
   [size zero?] [pop concat]
       [mergei]
   tailrec].

[msort
  [splitat [arr a : [arr a take arr a drop]] view i].
  [splitarr dup size 2 / >int splitat].

  [small?] []
    [splitarr]
    [merge]
  binrec].


fn main() {
    mut a := [170, 45, 75, -90, -802, 24, 2, 66]
    println("before: $a")
    a = merge_sort(a)
    println("after: $a")
}

fn merge_sort(m []int) []int {
    if m.len <= 1{
        return m
    } else {
        mid := m.len / 2
        mut left := merge_sort(m[..mid])
        mut right := merge_sort(m[mid..])
        if m[mid-1] <= m[mid] {
            left << right
            return left
        }
        return merge(mut left, mut right)
    }
}

fn merge(mut left []int,mut right []int) []int {
    mut result := []int{}
    for left.len > 0 && right.len > 0 {
        if left[0] <= right[0]{
            result << left[0]
            left = left[1..]
        } else {
            result << right[0]
            right = right[1..]
        }
    }
    if left.len > 0  {
        result << left
    }
    if right.len > 0 {
        result << right
    }
    return result
}


var merge = Fn.new { |left, right|
    var result = []
    while (left.count > 0 && right.count > 0) {
        if (left[0] <= right[0]) {
            result.add(left[0])
            left = left[1..-1]
        } else {
            result.add(right[0])
            right = right[1..-1]
        }
    }
    if (left.count > 0) result.addAll(left)
    if (right.count > 0) result.addAll(right)
    return result
}

var mergeSort // recursive
mergeSort = Fn.new { |m|
    var len = m.count
    if (len <= 1) return m
    var middle = (len/2).floor
    var left = m[0...middle]
    var right = m[middle..-1]
    left = mergeSort.call(left)
    right = mergeSort.call(right)
    if (left[-1] <= right[0]) {
        left.addAll(right)
        return left
    }
    return merge.call(left, right)
}

var as = [ [4, 65, 2, -31, 0, 99, 2, 83, 782, 1], [7, 5, 2, 6, 1, 4, 2, 6, 3] ]
for (a in as) {
    System.print("Before: %(a)")
    a = mergeSort.call(a)
    System.print("After : %(a)")
    System.print()
}


code Reserve=3, ChOut=8, IntOut=11;

proc MergeSort(A, Low, High);   \Sort array A from Low to High
int  A, Low, High;
int  B, Mid, H, I, J, K;
[if Low >= High then return;
Mid:= (Low+High) >> 1;          \split array in half (roughly)
MergeSort(A, Low, Mid);         \sort left half
MergeSort(A, Mid+1, High);      \sort right half
\Merge the two halves in to sorted order
B:= Reserve((High-Low+1)*4);    \reserve space for working array (4 bytes/int)
H:= Low;  I:= Low;  J:= Mid+1;
while H<=Mid & J<=High do       \merge while both halves have items
    if A(H) <= A(J) then [B(I):= A(H);  I:= I+1;  H:= H+1]
                    else [B(I):= A(J);  I:= I+1;  J:= J+1];
if H > Mid then                 \copy any remaining elements
     for K:= J to High do [B(I):= A(K);  I:= I+1]
else for K:= H to Mid  do [B(I):= A(K);  I:= I+1];
for K:= Low to High do A(K):= B(K);
];

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


dim b(9)

sub copyArray(a(), inicio, final, b())
    dim b(final - 1)
    for k = inicio to final - 1
        b(k) = a(k)
    next
end sub

// La mitad izquierda es  a(inicio to mitad-1).
// La mitad derecha es    a(mitad  to final-1).
// El resultado es        b(inicio to final-1).
sub topDownMerge(a(), inicio, mitad, final, b())
    i = inicio
    j = mitad

    // Si bien hay elementos en los recorridos izquierdo o derecho ...
    for k = inicio to final - 1
        // Si existe un inicio de recorrido izquierdo y es <= inicio de recorrido derecho existente.
        if (i < mitad) and (j >= final or a(i) <= a(j)) then
            b(k) = a(i)
            i = i + 1
        else
            b(k) = a(j)
            j = j + 1
        end if
    next
end sub

// Ordenar la matriz a() usando la matriz b() como fuente.
// inicio es inclusivo; final es exclusivo (a(final) no está en el conjunto).
sub topDownSplitMerge(b(), inicio, final, a())
    if (final - inicio) < 2 then return : fi // Si la diferencia = 1, considérelo ordenado
    // dividir la ejecución de más de 1 elemento en mitades
    mitad = int((final + inicio) / 2)  // mitad = punto medio
    // recursively sort both runs from array a() into b()
    topDownSplitMerge(a(), inicio,  mitad, b())  // ordenar la parte izquierda
    topDownSplitMerge(a(), mitad, final, b())    // ordenar la parte derecha
    // fusionar las ejecuciones resultantes de la matriz b() en a()
    topDownMerge(b(), inicio, mitad, final, a())
end sub

// El array a() tiene los elementos para ordenar; array b() es una matriz de trabajo (inicialmente vacía).
sub topDownMergeSort(a(), b(), n)
    copyArray(a(), 0, n, b())          // duplicar la matriz a() en b()
    topDownSplitMerge(b(), 0, n, a())  // ordenar los datos de b() en a()
end sub

sub printArray(a())
    for i = 1 to arraysize(a(),1)
        print a(i) using "####";
    next
    print
end sub

//--------------------------
label a1
data 4, 65, 2, -31, 0, 99, 2, 83, 782, 1
label a2
data 7, 5, 2, 6, 1, 4, 2, 6, 3

dim a(9)
restore a1
for i = 0 to 9
    read p
    a(i) = p
next i

dim a2(8)
restore a2
for i = 0 to 8
    read p
    a2(i) = p
next i

print "unsort ";
printArray(a())
topDownMergeSort (a(), b(), 10)
print "  sort ";
printArray(a())
print
print "unsort ";
printArray(a2())
topDownMergeSort (a2(), b(), 9)
print "  sort ";
printArray(a2())
end


(append) list1 list2
comment:
#true
(003) "append" list1 list2

(car) pair
comment:
#true
(002) "car" pair

(cdr) pair
comment:
#true
(002) "cdr" pair

(cons) one two
comment:
#true
(003) "cons" one two

(map) function list
comment:
#true
(003) "map" function list

(merge) comparator list1 list2
comment:
#true
(merge1) comparator list1 list2 nil

(merge1) comparator list1 list2 collect
comment:
(null?) list2
(append) (reverse) collect list1

(merge1) comparator list1 list2 collect
comment:
(null?) list1
(append) (reverse) collect list2

(merge1) comparator list1 list2 collect
comment:
(003) comparator (car) list2 (car) list1
(merge1) comparator list1 (cdr) list2 (cons) (car) list2 collect

(merge1) comparator list1 list2 collect
comment:
#true
(merge1) comparator (cdr) list1 list2 (cons) (car) list1 collect

(null?) value
comment:
#true
(002) "null?" value

(reverse) list
comment:
#true
(002) "reverse" list

(sort) comparator jumble
comment:
#true
(car) (sort11) comparator (sort1) jumble

(sort1) jumble
comment:
#true
(map) "list" jumble

(sort11) comparator jumble
comment:
(null?) jumble
nil

(sort11) comparator jumble
comment:
(null?) (cdr) jumble
jumble

(sort11) comparator jumble
comment:
#true
(sort11) comparator
         (cons) (merge) comparator (car) jumble (002) "cadr" jumble
                (sort11) comparator (002) "cddr" jumble


fcn _merge(left,right){
   if (not left)  return(right);
   if (not right) return(left);
   l:=left[0]; r:=right[0];
   if (l<=r) return(L(l).extend(self.fcn(left[1,*],right)));
   else      return(L(r).extend(self.fcn(left,right[1,*])));
}

fcn merge_sort(L){
   if (L.len()<2) return(L);
   n:=L.len()/2;
   return(_merge(self.fcn(L[0,n]), self.fcn(L[n,*])));
}


F circle_sort_backend(&A, Int l, r)
   V n = r - l
   I n < 2
      R 0
   V swaps = 0
   V m = n I/ 2
   L(i) 0 .< m
      I A[r - (i + 1)] < A[l + i]
         swap(&A[r - (i + 1)], &A[l + i])
         swaps++
   I (n [&] 1) != 0 & (A[l + m] < A[l + m - 1])
      swap(&A[l + m - 1], &A[l + m])
      swaps++
   R swaps + circle_sort_backend(&A, l, l + m) + circle_sort_backend(&A, l + m, r)

F circle_sort(&l)
   V swaps = 0
   V s = 1
   L s != 0
      s = circle_sort_backend(&l, 0, l.len)
      swaps += s
   R swaps

L(i) 309
   V l = Array(0 .< i)
   V m = copy(l)
   random:shuffle(&l)
   V n = copy(l)
   circle_sort(&l)
   I l != m
      print(l.len)
      print(n)
      print(l)


/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program circleSort64.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"
szMessSortBefore:   .asciz "Display table before sort.\n"
sMessResult:        .asciz "Value  : @ \n"
szCarriageReturn:   .asciz "\n"

.align 4
#TableNumber:      .quad   1,3,6,2,5,9,10,8,4,7
#TableNumber:       .quad   1,2,3,4,5,6,7,8,9,10
#TableNumber:       .quad   9,5,12,8,2,12,6
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,qAdrszMessSortBefore
    bl affichageMess
    ldr x0,qAdrTableNumber          // address number table
    bl displayTable
1:
    ldr x0,qAdrTableNumber          // address number table
    mov x1,#0
    mov x2,#NBELEMENTS -1           // number of élements
    mov x3,#0
    bl circleSort
    cmp x0,#0
    bne 1b
    ldr x0,qAdrTableNumber          // address number table
    mov x1,#NBELEMENTS              // number of élements
    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
qAdrszMessSortBefore:     .quad szMessSortBefore
/******************************************************************/
/*     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                      // smaller -> error
    mov x4,x3                    // A[i-1] = A[i]
    b 1b                         // else loop
98:
    mov x0,#0                    // error
    b 100f
99:
    mov x0,#1                    // ok -> return
100:
    ldp x2,x3,[sp],16            // restaur  2 registers
    ldp x1,lr,[sp],16            // restaur  2 registers
    ret                          // return to address lr x30
/******************************************************************/
/*         circle sort                                              */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the first index */
/* x2 contains the last index */
/* x3 contains number of swaps */
circleSort:
    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
    stp x10,x11,[sp,-16]!        // save  registers
    cmp x1,x2
    beq 99f
    mov x7,x0                    // save address
    mov x8,x1                    // low
    mov x9,x2                    // high
    sub x4,x2,x1
    lsr x4,x4,#1
    mov x10,x4                   // mid
1:                               // start loop
    cmp x1,x2
    bge 3f
    ldr x5,[x0,x1,lsl #3]
    ldr x6,[x0,x2,lsl #3]
    cmp x5,x6
    ble 2f
    str x6,[x0,x1,lsl #3]        // swap values
    str x5,[x0,x2,lsl #3]
    add x3,x3,#1
2:
    add x1,x1,#1                 // increment lo
    sub x2,x2,#1                 // decrement hi
    b 1b                         // and loop
3:
    cmp x1,x2                    // compare lo hi
    bne 4f                       // not egal
    ldr x5,[x0,x1,lsl #3]
    add x2,x2,#1
    ldr x6,[x0,x2,lsl #3]
    cmp x5,x6
    ble 4f
    str x6,[x0,x1,lsl #3]        //  swap
    str x5,[x0,x2,lsl #3]
    add x3,x3,#1
4:
    mov x1,x8                    // low
    mov x2,x10                   // mid
    add x2,x2,x1
    bl circleSort
    mov x3,x0                    // swaps
    mov x0,x7                    // table address
    mov x1,x8                    // low
    mov x2,x10                   // mid
    add x1,x2,x1
    add x1,x1,#1
    mov x2,x9                    // high
    bl circleSort
    mov x3,x0                    // swaps
99:
    mov x0,x3                    // return number swaps
100:
    ldp x10,x11,[sp],16          // restaur  2 registers
    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 conversion10              // décimal conversion
    ldr x0,qAdrsMessResult
    ldr x1,qAdrsZoneConv         // insert conversion
    bl strInsertAtCharInc
    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
qAdrsZoneConv:           .quad sZoneConv
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


DEFINE MAX_COUNT="100"
INT ARRAY stack(MAX_COUNT)
INT stackSize

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 InitStack()
  stackSize=0
RETURN

BYTE FUNC IsEmpty()
  IF stackSize=0 THEN
    RETURN (1)
  FI
RETURN (0)

PROC Push(INT low,high)
  stack(stackSize)=low  stackSize==+1
  stack(stackSize)=high stackSize==+1
RETURN

PROC Pop(INT POINTER low,high)
  stackSize==-1 high^=stack(stackSize)
  stackSize==-1 low^=stack(stackSize)
RETURN

INT FUNC Partition(INT ARRAY a INT low,high)
  INT part,v,i,tmp

  v=a(high)
  part=low-1

  FOR i=low TO high-1
  DO
    IF a(i)<=v THEN
      part==+1
      tmp=a(part) a(part)=a(i) a(i)=tmp
    FI
  OD

  part==+1
  tmp=a(part) a(part)=a(high) a(high)=tmp
RETURN (part)

PROC CircleSort(INT ARRAY a INT size)
  INT swaps,low,high,lo,hi,tmp,mid

  InitStack()
  DO
    swaps=0
    Push(0,size-1)
    WHILE IsEmpty()=0
    DO
      Pop(@low,@high)
      IF low<high THEN
        lo=low hi=high
        WHILE lo<hi
        DO
          IF a(hi)<a(lo) THEN
            tmp=a(lo) a(lo)=a(hi) a(hi)=tmp
            swaps==+1
          FI
          lo==+1 hi==-1
        OD
        IF lo=hi AND a(lo+1)<a(lo) THEN
          tmp=a(lo) a(lo)=a(lo+1) a(lo+1)=tmp
          swaps==+1
        FI
        mid=(lo+hi)/2
        Push(low,mid)
        Push(mid+1,high)
      FI
    OD
  UNTIL swaps=0
  OD
RETURN

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


/* ARM assembly Raspberry PI  */
/*  program circleSort.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"
szMessSortBefore:   .asciz "Display table before sort.\n"
sMessResult:        .asciz "Value  : @ \n"
szCarriageReturn:   .asciz "\n"

.align 4
#TableNumber:      .int   1,3,6,2,5,9,10,8,4,7
#TableNumber:       .int   1,2,3,4,5,6,7,8,9,10
TableNumber:       .int   9,5,12,8,2,12,6
#TableNumber:       .int   10,9,8,7,6,5,4,3,2,1
                   .equ NBELEMENTS, (. - TableNumber) / 4
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
sZoneConv:            .skip 24
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                               @ entry of program
    ldr r0,iAdrszMessSortBefore
    bl affichageMess
    ldr r0,iAdrTableNumber          @ address number table
    bl displayTable
1:
    ldr r0,iAdrTableNumber          @ address number table
    mov r1,#0
    mov r2,#NBELEMENTS -1           @ number of élements
    mov r3,#0
    bl circleSort
    cmp r0,#0
    bne 1b
    ldr r0,iAdrTableNumber          @ address number table
    mov r1,#NBELEMENTS              @ number of élements
    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
iAdrszMessSortBefore:     .int szMessSortBefore
/******************************************************************/
/*     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
/******************************************************************/
/*         circle sort                                              */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the first index */
/* r2 contains the last index */
/* r3 contains number of swaps */
circleSort:
    push {r1-r10,lr}           @ save registers
    cmp r1,r2
    beq 99f
    mov r7,r0                  @ save address
    mov r8,r1                  @ low
    mov r9,r2                  @ high
    sub r4,r2,r1
    lsr r4,#1
    mov r10,r4                 @ mid
1:                             @ start loop
    cmp r1,r2
    bge 3f
    ldr r5,[r0,r1,lsl #2]
    ldr r6,[r0,r2,lsl #2]
    cmp r5,r6
    ble 2f
    str r6,[r0,r1,lsl #2]      @ swap values
    str r5,[r0,r2,lsl #2]
    add r3,r3,#1
2:
    add r1,r1,#1               @ increment lo
    sub r2,r2,#1               @ decrement hi
    b 1b                       @ and loop
3:
    cmp r1,r2                  @ compare lo hi
    bne 4f                     @ not egal
    ldr r5,[r0,r1,lsl #2]
    add r2,r2,#1
    ldr r6,[r0,r2,lsl #2]
    cmp r5,r6
    ble 4f
    str r6,[r0,r1,lsl #2]      @  swap
    str r5,[r0,r2,lsl #2]
    add r3,r3,#1
4:
    mov r1,r8                  @ low
    mov r2,r10                 @ mid
    add r2,r2,r1
    bl circleSort
    mov r3,r0                 @ swaps
    mov r0,r7                 @ table address
    mov r1,r8                 @ low
    mov r2,r10                @ mid
    add r1,r2,r1
    add r1,r1,#1
    mov r2,r9                 @ high
    bl circleSort
    mov r3,r0                 @ swaps
99:
    mov r0,r3                 @ return number swaps
100:
    pop {r1-r10,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 conversion10                   @ décimal conversion
    ldr r0,iAdrsMessResult
    ldr r1,iAdrsZoneConv              @ insert conversion
    bl strInsertAtCharInc
    bl affichageMess                  @ display message
    add r3,#1
    cmp r3,#NBELEMENTS - 1
    ble 1b
    ldr r0,iAdrszCarriageReturn
    bl affichageMess
100:
    pop {r0-r3,lr}
    bx lr
iAdrsZoneConv:           .int sZoneConv
/***************************************************/
/*      ROUTINES INCLUDE                           */
/***************************************************/
.include "../affichage.inc"


nums := [6, 7, 8, 9, 2, 5, 3, 4, 1]
while circlesort(nums, 1, nums.Count(), 0)		; 1-based
    continue
for i, v in nums
    output .= v ", "
MsgBox % "[" Trim(output, ", ") "]"
return

circlesort(Arr, lo, hi, swaps){
    if (lo = hi)
        return swaps
    high:= hi
    low := lo
    mid := Floor((hi - lo) / 2)
    while (lo < hi) {
        if (Arr[lo] > Arr[hi]){
            tempVal := Arr[lo], Arr[lo] := Arr[hi], Arr[hi] := tempVal
            swaps++
        }
        lo++
        hi--
    }
    if (lo = hi)
        if (Arr[lo] > Arr[hi+1]){
            tempVal := Arr[lo], Arr[lo] := Arr[hi+1], Arr[hi+1] := tempVal
            swaps++
        }
    swaps := circlesort(Arr, low, low+mid, swaps)
    swaps := circlesort(Arr, low+mid+1, high, swaps)
    return swaps
}


#include <stdio.h>

int circle_sort_inner(int *start, int *end)
{
	int *p, *q, t, swapped;

	if (start == end) return 0;

	// funny "||" on next line is for the center element of odd-lengthed array
	for (swapped = 0, p = start, q = end; p<q || (p==q && ++q); p++, q--)
		if (*p > *q)
			t = *p, *p = *q, *q = t, swapped = 1;

	// q == p-1 at this point
	return swapped | circle_sort_inner(start, q) | circle_sort_inner(p, end);
}

//helper function to show arrays before each call
void circle_sort(int *x, int n)
{
	do {
		int i;
		for (i = 0; i < n; i++) printf("%d ", x[i]);
		putchar('\n');
	} while (circle_sort_inner(x, x + (n - 1)));
}

int main(void)
{
	int x[] = {5, -1, 101, -4, 0, 1, 8, 6, 2, 3};
	circle_sort(x, sizeof(x) / sizeof(*x));

	return 0;
}


using System;
using System.Linq;

namespace CircleSort
{
    internal class Program
    {
        public static int[] CircleSort(int[] array)
        {
            if (array.Length > 0)
                while (CircleSortR(array, 0, array.Length - 1, 0) != 0)
                    continue;
            return array;
        }

        private static int CircleSortR(int[] arr, int lo, int hi, int numSwaps)
        {
            if (lo == hi)
                return numSwaps;

            var high = hi;
            var low = lo;
            var mid = (hi - lo) / 2;

            while (lo < hi)
            {
                if (arr[lo] > arr[hi])
                {
                    (arr[lo], arr[hi]) = (arr[hi], arr[lo]);
                    numSwaps++;
                }
                lo++;
                hi--;
            }

            if (lo == hi && arr[lo] > arr[hi + 1])
            {
                (arr[lo], arr[hi + 1]) = (arr[hi + 1], arr[lo]);
                numSwaps++;
            }

            numSwaps = CircleSortR(arr, low, low + mid, numSwaps);
            numSwaps = CircleSortR(arr, low + mid + 1, high, numSwaps);

            return numSwaps;
        }

        private static void Main(string[] args)
        {
            var sortedArray = CircleSort(new int[] { 6, 7, 8, 9, 2, 5, 3, 4, 1 });
            sortedArray.ToList().ForEach(i => Console.Write(i.ToString() + " "));
            Console.WriteLine();
            var sortedArray2 = CircleSort(new int[] { 2, 14, 4, 6, 8, 1, 3, 5, 7, 11, 0, 13, 12, -1 });
            sortedArray2.ToList().ForEach(i => Console.Write(i.ToString() + " "));
            Console.WriteLine();
            var sortedArray3 = CircleSort(new int[] { 2, 3, 3, 5, 5, 1, 1, 7, 7, 6, 6, 4, 4, 0, 0 });
            sortedArray3.ToList().ForEach(i => Console.Write(i.ToString() + " "));
            Console.ReadKey();
        }
    }
}


#include <iostream>

int circlesort(int* arr, int lo, int hi, int swaps) {
    if(lo == hi) {
        return swaps;
    }
    int high = hi;
    int low = lo;
    int mid = (high - low) / 2;
    while(lo < hi) {
        if(arr[lo] > arr[hi]) {
            int temp = arr[lo];
            arr[lo] = arr[hi];
            arr[hi] = temp;
            swaps++;
        }
        lo++;
        hi--;
    }

    if(lo == hi) {
        if(arr[lo] > arr[hi+1]) {
            int temp = arr[lo];
            arr[lo] = arr[hi+1];
            arr[hi+1] = temp;
            swaps++;
        }
    }
    swaps = circlesort(arr, low, low+mid, swaps);
    swaps = circlesort(arr, low+mid+1, high, swaps);
    return swaps;
}

void circlesortDriver(int* arr, int n) {
    do {
        for(int i = 0; i < n; i++) {
            std::cout << arr[i] << ' ';
        }
        std::cout << std::endl;
    } while(circlesort(arr, 0, n-1, 0));
}

int main() {
    int arr[] = { 6, 7, 8, 9, 2, 5, 3, 4, 1 };
    circlesortDriver(arr, sizeof(arr)/sizeof(int));
    return 0;
}


circlesort = (arr, lo, hi, swaps) ->
  if lo == hi
     return (swaps)

  high = hi
  low  = lo
  mid = Math.floor((hi-lo)/2)

  while lo < hi
    if arr[lo] > arr[hi]
       t = arr[lo]
       arr[lo] = arr[hi]
       arr[hi] = t
       swaps++
    lo++
    hi--

  if lo == hi
     if arr[lo] > arr[hi+1]
        t = arr[lo]
        arr[lo] = arr[hi+1]
        arr[hi+1] = t
        swaps++

  swaps = circlesort(arr,low,low+mid,swaps)
  swaps = circlesort(arr,low+mid+1,high,swaps)

  return(swaps)

VA = [2,14,4,6,8,1,3,5,7,9,10,11,0,13,12,-1]

while circlesort(VA,0,VA.length-1,0)
   console.log VA


import std.stdio, std.algorithm, std.array, std.traits;

void circlesort(T)(T[] items) if (isMutable!T) {
    uint inner(size_t lo, size_t hi, uint swaps) {
        if (lo == hi)
            return swaps;
        auto high = hi;
        auto low = lo;
        immutable mid = (hi - lo) / 2;

        while (lo < hi) {
            if (items[lo] > items[hi]) {
                swap(items[lo], items[hi]);
                swaps++;
            }
            lo++;
            hi--;
        }

        if (lo == hi && items[lo] > items[hi + 1]) {
            swap(items[lo], items[hi + 1]);
            swaps++;
        }
        swaps = inner(low, low + mid, swaps);
        swaps = inner(low + mid + 1, high, swaps);
        return swaps;
    }

    if (!items.empty)
        while (inner(0, items.length - 1, 0)) {}
}

void main() {
    import std.random, std.conv;

    auto a = [5, -1, 101, -4, 0, 1, 8, 6, 2, 3];
    a.circlesort;
    a.writeln;
    assert(a.isSorted);

    // Fuzzy test.
    int[30] items;
    foreach (immutable _; 0 .. 100_000) {
        auto data = items[0 .. uniform(0, items.length)];
        foreach (ref x; data)
            x = uniform(-items.length.signed * 3, items.length.signed * 3);
        data.circlesort;
        assert(data.isSorted);
    }
}


program Sorting_Algorithms;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

function CircleSort(a: TArray<Integer>; lo, hi, swaps: Integer): Integer;
begin
  if lo = hi then
    exit(swaps);

  var high := hi;
  var low := lo;
  var mid := (hi - lo) div 2;

  while lo < hi do
  begin
    if a[lo] > a[hi] then
    begin
      var tmp := a[lo];
      a[lo] := a[hi];
      a[hi] := tmp;
      inc(swaps);
    end;
    inc(lo);
    dec(hi);
  end;

  if lo = hi then
  begin
    if a[lo] > a[hi + 1] then
    begin
      var tmp := a[lo];
      a[lo] := a[hi + 1];
      a[hi + 1] := tmp;
      inc(swaps);
    end;
  end;
  swaps := CircleSort(a, low, low + mid, swaps);
  swaps := CircleSort(a, low + mid + 1, high, swaps);
  result := swaps;
end;

function ToString(a: TArray<Integer>): string;
begin
  Result := '[';
  for var e in a do
    Result := Result + e.ToString + ',';
  Result := Result + ']';
end;

const
  aa: TArray<TArray<Integer>> = [[6, 7, 8, 9, 2, 5, 3, 4, 1], [2, 14, 4, 6, 8, 1,
    3, 5, 7, 11, 0, 13, 12, -1]];

begin
  for var a in aa do
  begin
    write('Original: ');
    write(ToString(a));
    while CircleSort(a, 0, high(a), 0) <> 0 do
      ;
    writeln;
    write('Sorted  : ');
    write(ToString(a));
    writeln(#10#10);
  end;
  readln;
end.


defmodule Sort do
  def circle_sort(data) do
    List.to_tuple(data)
    |> circle_sort(0, length(data)-1)
    |> Tuple.to_list
  end

  defp circle_sort(data, lo, hi) do
    case circle_sort(data, lo, hi, 0) do
      {result, 0} -> result
      {result, _} -> circle_sort(result, lo, hi)
    end
  end

  defp circle_sort(data, lo, lo, swaps), do: {data, swaps}
  defp circle_sort(data, lo, hi, swaps) do
    mid = div(lo + hi, 2)
    {data, swaps} = do_circle_sort(data, lo, hi, swaps)
    {data, swaps} = circle_sort(data, lo, mid, swaps)
    circle_sort(data, mid+1, hi, swaps)
  end

  def do_circle_sort(data, lo, hi, swaps) when lo>=hi do
    if lo==hi and elem(data, lo) > elem(data, hi+1),
      do:   {swap(data, lo, hi+1), swaps+1},
      else: {data, swaps}
  end
  def do_circle_sort(data, lo, hi, swaps) do
    if elem(data, lo) > elem(data, hi),
      do:   do_circle_sort(swap(data, lo, hi), lo+1, hi-1, swaps+1),
      else: do_circle_sort(data, lo+1, hi-1, swaps)
  end

  defp swap(data, i, j) do
    vi = elem(data, i)
    vj = elem(data, j)
    data |> put_elem(i, vj) |> put_elem(j, vi)
  end
end

data = [6, 7, 8, 9, 2, 5, 3, 4, 1]
IO.puts "before sort: #{inspect data}"
IO.puts " after sort: #{inspect Sort.circle_sort(data)}"


[UNDEFINED] cell- [IF] : cell- 1 cells - ; [THEN]

defer precedes                         ( addr addr -- flag )
variable (sorted?)                     \ is the array sorted?

: (compare)                            ( a1 a2 -- a1 a2)
  over @ over @ precedes               \ flag if swapped
  if over over over @ over @ swap rot ! swap ! false (sorted?) ! then
;

: (circlesort)                         ( a1 a2 --)
  over over = if drop drop exit then   \ quit if indexes are equal
  over over swap                       \ swap indexes (end begin)
  begin
    over over >                        \ as long as middle isn't passed
  while
    (compare) swap cell- swap cell+    \ check and swap opposite elements
  repeat rot recurse recurse           \ split array and recurse
;

: sort                                 ( a n --)
  1- cells over +                      \ calculate addresses
  begin true (sorted?) ! over over (circlesort) (sorted?) @ until drop drop
;

:noname < ; is precedes

10 constant /sample
create sample 5 , -1 , 101 , -4 , 0 , 1 , 8 , 6 , 2 , 3 ,

: .sample sample /sample cells bounds do i ? 1 cells +loop ;

sample /sample sort .sample


!
module circlesort
! I have commented the code that was here and also 'tightened up' various pieces such as how swap detection was done as well
! as fixing an error where the code would exceed array bounds for odd number sized arrays.
! Also, giving some some attribution to the author. - Pete
! This code is a Fortran adaptation of a Forth algorithm laid out by "thebeez" at this URL;
! https://sourceforge.net/p/forth-4th/wiki/Circle%20sort/
!
  implicit none
  logical, private :: csr
  public :: circle_sort

contains

  recursive logical function csr(a, left, right,n) result(swapped)
    implicit none
    integer, intent(in) :: left, right,n
    integer, intent(inout) :: a(n)
    integer :: lo, hi, mid
    integer :: temp
    logical :: lefthalf,righthalf
!
    swapped = .FALSE.
    if (right <= left) return
    lo = left   !Store the upper and lower bounds of list for
    hi = right  !Recursion later
!
    do while (lo < hi)
!   Swap the pair of elements if hi < lo
       if (a(hi) < a(lo)) then
          swapped = .TRUE.
          temp = a(lo)
          a(lo) = a(hi)
          a(hi) = temp
       endif
       lo = lo + 1
       hi = hi - 1
    end do
!   Special case if array is an odd size (not even)
    if (lo == hi)then
       if(a(hi+1) .lt. a(lo))then
           swapped = .TRUE.
           temp = a(hi+1)
           a(hi+1) = a(lo)
           a(lo) = temp
       endif
    endif
    mid = (left + right) / 2 ! Bisection point
    lefthalf = csr(a, left, mid,n)
    righthalf = csr(a, mid + 1, right,n)
    swapped = swapped .or. lefthalf .or. righthalf
  end function csr
!
  subroutine circle_sort(a, n)
    use iso_c_binding, only: c_ptr, c_loc
    implicit none
    integer, intent(in) :: n
    integer, target,intent(inout) :: a(n)

    do while ( csr(a, 1, n,n))
! This is the canonical algorithm. However, if you want to
! speed it up, count the iterations and when you have approached
! 0.5*ln(n) iterations, perform a binary insertion sort then exit the loop.
    end do
  end subroutine circle_sort

end module circlesort
program sort
  use circlesort
  implicit none
  integer :: a(9)
  data a/6,7,8,9,2,5,3,4,1/
  call circle_sort(a, size(a))
  print *, a
end program sort


' version 21-10-2016
' compile with: fbc -s console
' for boundry checks on array's compile with: fbc -s console -exx
' converted pseudo code into FreeBASIC code

' shared variables need to be declared before first use
Dim Shared As Long cs(-7 To 7)

Function circlesort(lo As Long, hi As Long, swaps As ULong) As ULong

    ' array is declared shared
    ' sort from lower bound to the highter bound
    ' array's can have subscript range from -2147483648 to +2147483647

    If lo = hi Then Return swaps

    Dim As Long high = hi
    Dim As Long low = lo
    Dim As Long mid_ = (hi - lo) \ 2

    While lo < hi
        If cs(lo) > cs(hi) Then
            Swap cs(lo), cs(hi)
            swaps += 1
        End If
        lo += 1
        hi -= 1
    Wend
    If lo = hi Then
        If cs(lo) > cs(hi +1) Then
            Swap cs(lo), cs(hi +1)
            swaps += 1
        End If
    End If
    swaps = circlesort(low          , low + mid_, swaps)
    swaps = circlesort(low + mid_ +1,       high, swaps)

    Return swaps

End Function

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

Dim As Long i, a = LBound(cs), b = UBound(cs)

Randomize Timer
For i = a To b : cs(i) = i  : Next
For i = a To b ' little shuffle
    Swap cs(i), cs(Int(Rnd * (b - a +1)) + a)
Next

Print "unsorted ";
For i = a To b : Print Using "####"; cs(i); : Next : Print

' sort the array, loop until sorted
While circlesort(a, b, 0) : Wend

Print "  sorted ";
For i = a To b : Print Using "####"; cs(i); : Next : Print

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


package main

import "fmt"

func circleSort(a []int, lo, hi, swaps int) int {
    if lo == hi {
        return swaps
    }
    high, low := hi, lo
    mid := (hi - lo) / 2
    for lo < hi {
        if a[lo] > a[hi] {
            a[lo], a[hi] = a[hi], a[lo]
            swaps++
        }
        lo++
        hi--
    }
    if lo == hi {
        if a[lo] > a[hi+1] {
            a[lo], a[hi+1] = a[hi+1], a[lo]
            swaps++
        }
    }
    swaps = circleSort(a, low, low+mid, swaps)
    swaps = circleSort(a, low+mid+1, high, swaps)
    return swaps
}

func main() {
    aa := [][]int{
        {6, 7, 8, 9, 2, 5, 3, 4, 1},
        {2, 14, 4, 6, 8, 1, 3, 5, 7, 11, 0, 13, 12, -1},
    }
    for _, a := range aa {
        fmt.Printf("Original: %v\n", a)
        for circleSort(a, 0, len(a)-1, 0) != 0 {
            // empty block
        }
        fmt.Printf("Sorted  : %v\n\n", a)
    }
}


import Data.Bool (bool)

circleSort :: Ord a => [a] -> [a]
circleSort xs = if swapped then circleSort ks else ks
  where
    (swapped,ks) = go False xs (False,[])

    go d []  sks = sks
    go d [x] (s,ks) = (s,x:ks)
    go d xs  (s,ks) =
      let (st,_,ls,rs) = halve d s xs xs
      in go False ls (go True rs (st,ks))

    halve d s (y:ys) (_:_:zs) = swap d y (halve d s ys zs)
    halve d s ys     []       = (s,ys,[],[])
    halve d s (y:ys) [_]      = (s,ys,[y | e],[y | not e])
      where e = y <= head ys

    swap d x (s,y:ys,ls,rs)
      | bool (<=) (<) d x y = (    d || s,ys,x:ls,y:rs)
      | otherwise           = (not d || s,ys,y:ls,x:rs)


circle_sort =: post  [email protected]    NB. the main sorting verb
power_of_2_length =: even_length_iteration^:_ NB. repeat while the answer changes
even_length_iteration =: (<./ (,&$: |.) >./)@(-:@# ({. ,: |[email protected]}.) ])^:(1<#)
pre =: ,   (-~ >.&.(2&^.))@# # >./            NB. extend data to next power of 2 length
post =: ({.~ #)~                              NB. remove the extra data


import java.util.Arrays;

public class CircleSort {

    public static void main(String[] args) {
        circleSort(new int[]{2, 14, 4, 6, 8, 1, 3, 5, 7, 11, 0, 13, 12, -1});
    }

    public static void circleSort(int[] arr) {
        if (arr.length > 0)
            do {
                System.out.println(Arrays.toString(arr));
            } while (circleSortR(arr, 0, arr.length - 1, 0) != 0);
    }

    private static int circleSortR(int[] arr, int lo, int hi, int numSwaps) {
        if (lo == hi)
            return numSwaps;

        int high = hi;
        int low = lo;
        int mid = (hi - lo) / 2;

        while (lo < hi) {
            if (arr[lo] > arr[hi]) {
                swap(arr, lo, hi);
                numSwaps++;
            }
            lo++;
            hi--;
        }

        if (lo == hi && arr[lo] > arr[hi + 1]) {
            swap(arr, lo, hi + 1);
            numSwaps++;
        }

        numSwaps = circleSortR(arr, low, low + mid, numSwaps);
        numSwaps = circleSortR(arr, low + mid + 1, high, numSwaps);

        return numSwaps;
    }

    private static void swap(int[] arr, int idx1, int idx2) {
        int tmp = arr[idx1];
        arr[idx1] = arr[idx2];
        arr[idx2] = tmp;
    }
}


def until(cond; next):
     def _until: if cond then . else (next|_until) end;
     _until;


function _ciclesort!(arr::Vector, lo::Int, hi::Int, swaps::Int)
    lo == hi && return swaps
    high = hi
    low  = lo
    mid  = (hi - lo) ÷ 2
    while lo < hi
        if arr[lo] > arr[hi]
            arr[lo], arr[hi] = arr[hi], arr[lo]
            swaps += 1
        end
        lo += 1
        hi -= 1
    end
    if lo == hi
        if arr[lo] > arr[hi+1]
            arr[lo], arr[hi+1] = arr[hi+1], arr[lo]
            swaps += 1
        end
    end
    swaps = _ciclesort!(arr, low, low + mid, swaps)
    swaps = _ciclesort!(arr, low + mid + 1, high, swaps)
    return swaps
end

function ciclesort!(arr::Vector)
    while !iszero(_ciclesort!(arr, 1, endof(arr), 0)) end
    return arr
end

v = rand(10)
println("# $v\n -> ", ciclesort!(v))


// version 1.1.0

fun<T: Comparable<T>> circleSort(array: Array<T>, lo: Int, hi: Int, nSwaps: Int): Int {
    if (lo == hi) return nSwaps

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

    var high  = hi
    var low   = lo
    val mid   = (hi - lo) / 2
    var swaps = nSwaps
    while (low < high) {
        if (array[low] > array[high]) {
            swap(array, low, high)
            swaps++
        }
        low++
        high--
    }
    if (low == high)
        if (array[low] > array[high + 1]) {
            swap(array, low, high + 1)
            swaps++
        }
    swaps = circleSort(array, lo, lo + mid, swaps)
    swaps = circleSort(array, lo + mid + 1, hi, swaps)
    return swaps
}

fun main(args: Array<String>) {
    val array = arrayOf(6, 7, 8, 9, 2, 5, 3, 4, 1)
    println("Original: ${array.asList()}")
    while (circleSort(array, 0, array.size - 1, 0) != 0) ; // empty statement
    println("Sorted  : ${array.asList()}")
    println()
    val array2 = arrayOf("the", "quick", "brown", "fox", "jumps", "over", "the", "lazy", "dog")
    println("Original: ${array2.asList()}")
    while (circleSort(array2, 0, array2.size - 1, 0) != 0) ;
    println("Sorted  : ${array2.asList()}")
}


-- Perform one iteration of a circle sort
function innerCircle (t, lo, hi, swaps)
  if lo == hi then return swaps end
  local high, low, mid = hi, lo, math.floor((hi - lo) / 2)
  while lo < hi do
    if t[lo] > t[hi] then
      t[lo], t[hi] = t[hi], t[lo]
      swaps = swaps + 1
    end
    lo = lo + 1
    hi = hi - 1
  end
  if lo == hi then
    if t[lo] > t[hi + 1] then
      t[lo], t[hi + 1] = t[hi + 1], t[lo]
      swaps = swaps + 1
    end
  end
  swaps = innerCircle(t, low, low + mid, swaps)
  swaps = innerCircle(t, low + mid + 1, high, swaps)
  return swaps
end

-- Keep sorting the table until an iteration makes no swaps
function circleSort (t)
  while innerCircle(t, 1, #t, 0) > 0 do end
end

-- Main procedure
local array = {6, 7, 8, 9, 2, 5, 3, 4, 1}
circleSort(array)
print(table.concat(array, " "))


ClearAll[CircleSort, NestedCircleSort]
CircleSort[d_List, l_, h_] :=
 Module[{high, low, mid, lo = l, hi = h, data = d},
  If[lo == hi, Return[data]];
  high = hi;
  low = lo;
  mid = Floor[(hi - lo)/2];
  While[lo < hi,
   If[data[[lo]] > data[[hi]],
    data[[{lo, hi}]] //= Reverse;
    ];
   lo++;
   hi--
   ];
  If[lo == hi,
   If[data[[lo]] > data[[hi + 1]],
    data[[{lo, hi + 1}]] //= Reverse;
    ]
   ];
  data = CircleSort[data, low, low + mid];
  data = CircleSort[data, low + mid + 1, high];
  data
 ]
NestedCircleSort[{}] := {}
NestedCircleSort[d_List] := FixedPoint[CircleSort[#, 1, Length[#]] &, d]
NestedCircleSort[[email protected]{6, 7, 8, 9, 2, 5, 3, 4, 1}]
NestedCircleSort[[email protected]{6, 7, 8, 2, 5, 3, 4, 1}]
NestedCircleSort[[email protected]{6, 2, 5, 7, 3, 4, 1}]
NestedCircleSort[[email protected]{4, 6, 3, 5, 2, 1}]
NestedCircleSort[[email protected]{1, 2, 3, 4, 5}]
NestedCircleSort[[email protected]{2, 4, 3, 1}]
NestedCircleSort[[email protected]{2, 3, 1}]
NestedCircleSort[[email protected]{2, 1}]
NestedCircleSort[[email protected]{1}]
NestedCircleSort[[email protected]{}]