F stoogesort(&l, i, j) -> N
   I l[j] < l[i]
      swap(&l[i], &l[j])
   I j - i > 1
      V t = (j - i + 1) I/ 3
      stoogesort(&l, i, j - t)
      stoogesort(&l, i + t, j)
      stoogesort(&l, i, j - t)

F stooge(&l)
   R stoogesort(&l, 0, l.len - 1)

V data = [1, 4, 5, 3, -6, 3, 7, 10, -2, -5, 7, 5, 9, -3, 7]
stooge(&data)
print(data)


object SMP extends App {
    private def checkMarriages(): Unit =
        if (check)
            println("Marriages are stable")
        else
            println("Marriages are unstable")

    private def swap() {
        val girl1 = girls.head
        val girl2 = girls(1)
        val tmp = girl2 -> matches(girl1)
        matches += girl1 -> matches(girl2)
        matches += tmp
        println(girl1 + " and " + girl2 + " have switched partners")
    }

    private type TM = scala.collection.mutable.TreeMap[String, String]

    private def check: Boolean = {
        if (!girls.toSet.subsetOf(matches.keySet) || !guys.toSet.subsetOf(matches.values.toSet))
            return false

        val invertedMatches = new TM
        matches foreach { invertedMatches += _.swap }

        for ((k, v) <- matches) {
            val shePrefers = girlPrefers(k)
            val sheLikesBetter = shePrefers.slice(0, shePrefers.indexOf(v))
            val hePrefers = guyPrefers(v)
            val heLikesBetter = hePrefers.slice(0, hePrefers.indexOf(k))

            for (guy <- sheLikesBetter) {
                val fiance = invertedMatches(guy)
                val guy_p = guyPrefers(guy)
                if (guy_p.indexOf(fiance) > guy_p.indexOf(k)) {
                    println(s"$k likes $guy better than $v and $guy likes $k better than their current partner")
                    return false
                }
            }

            for (girl <- heLikesBetter) {
                val fiance = matches(girl)
                val girl_p = girlPrefers(girl)
                if (girl_p.indexOf(fiance) > girl_p.indexOf(v)) {
                    println(s"$v likes $girl better than $k and $girl likes $v better than their current partner")
                    return false
                }
            }
        }
        true
    }

    private val guys = "abe" :: "bob" :: "col" :: "dan" :: "ed" :: "fred" :: "gav" :: "hal" :: "ian" :: "jon" :: Nil
    private val girls = "abi" :: "bea" :: "cath" :: "dee" :: "eve" :: "fay" :: "gay" :: "hope" :: "ivy" :: "jan" :: Nil
    private val guyPrefers = Map("abe" -> List("abi", "eve", "cath", "ivy", "jan", "dee", "fay", "bea", "hope", "gay"),
        "bob" -> List("cath", "hope", "abi", "dee", "eve", "fay", "bea", "jan", "ivy", "gay"),
        "col" -> List("hope", "eve", "abi", "dee", "bea", "fay", "ivy", "gay", "cath", "jan"),
        "dan" -> List("ivy", "fay", "dee", "gay", "hope", "eve", "jan", "bea", "cath", "abi"),
        "ed" -> List("jan", "dee", "bea", "cath", "fay", "eve", "abi", "ivy", "hope", "gay"),
        "fred" -> List("bea", "abi", "dee", "gay", "eve", "ivy", "cath", "jan", "hope", "fay"),
        "gav" -> List("gay", "eve", "ivy", "bea", "cath", "abi", "dee", "hope", "jan", "fay"),
        "hal" -> List("abi", "eve", "hope", "fay", "ivy", "cath", "jan", "bea", "gay", "dee"),
        "ian" -> List("hope", "cath", "dee", "gay", "bea", "abi", "fay", "ivy", "jan", "eve"),
        "jon" -> List("abi", "fay", "jan", "gay", "eve", "bea", "dee", "cath", "ivy", "hope"))
    private val girlPrefers = Map("abi" -> List("bob", "fred", "jon", "gav", "ian", "abe", "dan", "ed", "col", "hal"),
        "bea" -> List("bob", "abe", "col", "fred", "gav", "dan", "ian", "ed", "jon", "hal"),
        "cath" -> List("fred", "bob", "ed", "gav", "hal", "col", "ian", "abe", "dan", "jon"),
        "dee" -> List("fred", "jon", "col", "abe", "ian", "hal", "gav", "dan", "bob", "ed"),
        "eve" -> List("jon", "hal", "fred", "dan", "abe", "gav", "col", "ed", "ian", "bob"),
        "fay" -> List("bob", "abe", "ed", "ian", "jon", "dan", "fred", "gav", "col", "hal"),
        "gay" -> List("jon", "gav", "hal", "fred", "bob", "abe", "col", "ed", "dan", "ian"),
        "hope" -> List("gav", "jon", "bob", "abe", "ian", "dan", "hal", "ed", "col", "fred"),
        "ivy" -> List("ian", "col", "hal", "gav", "fred", "bob", "abe", "ed", "jon", "dan"),
        "jan" -> List("ed", "hal", "gav", "abe", "bob", "jon", "col", "ian", "fred", "dan"))

    private lazy val matches = {
        val engagements = new TM
        val freeGuys = scala.collection.mutable.Queue.empty ++ guys
        while (freeGuys.nonEmpty) {
            val guy = freeGuys.dequeue()
            val guy_p = guyPrefers(guy)
            var break = false
            for (girl <- guy_p)
                if (!break)
                    if (!engagements.contains(girl)) {
                        engagements(girl) = guy
                        break = true
                    }
                    else {
                        val other_guy = engagements(girl)
                        val girl_p = girlPrefers(girl)
                        if (girl_p.indexOf(guy) < girl_p.indexOf(other_guy)) {
                            engagements(girl) = guy
                            freeGuys += other_guy
                            break = true
                        }
                    }
        }

        engagements foreach { e => println(s"${e._1} is engaged to ${e._2}") }
        engagements
    }

    checkMarriages()
    swap()
    checkMarriages()
}


(de strandSort (Lst)
   (let Res NIL  # Result list
      (while Lst
         (let Sub (circ (car Lst))  # Build sublist as fifo
            (setq
               Lst (filter
                  '((X)
                     (or
                        (> (car Sub) X)
                        (nil (fifo 'Sub X)) ) )
                  (cdr Lst) )
               Res (make
                  (while (or Res Sub)  # Merge
                     (link
                        (if2 Res Sub
                           (if (>= (car Res) (cadr Sub))
                              (fifo 'Sub)
                              (pop 'Res) )
                           (pop 'Res)
                           (fifo 'Sub) ) ) ) ) ) ) )
      Res ) )


strand: procedure options (main); /* 27 Oct. 2012 */
   declare A(100) fixed, used(100) bit (1), sorted fixed controlled;
   declare (temp, work) fixed controlled;
   declare (i, j, k, n) fixed binary;

   n = hbound(A, 1);
   used = '1'b;
   A = random()*99;

   put edit (A) (f(3));

   do while (allocation(sorted) < n);
      call fetch (A, work);
      call move  (temp, work);

      call merge(sorted, temp);
         /* Merges elements in SORTED with elements in TEMP. */
   end;
   /* Transfer the sorted elements to A. */
   do i = 1 to allocation(sorted);
      A(i) = sorted; free sorted;
   end;
   /* Print the sorted values. */
   put skip list ('The sorted values are:');
   put skip edit (A) (f(3));

/* Merges elements of SORTED with elements of TEMP and places  */
/* the result in SORTED. */
/* Elements in SORTED and TEMP are in forward order. */
merge: procedure (sorted, temp);
   declare (sorted, temp) fixed controlled;
   declare work fixed controlled;
   declare (j_ok, k_ok) bit (1);

   do until ((k_ok | j_ok) = '0'b);
      k_ok = allocation(sorted) > 0;
      j_ok = allocation(temp)   > 0;
      if k_ok & j_ok then
         do;
            if sorted <= temp then
               do; allocate work; work = sorted; free sorted; end;
            else
               do; allocate work; work = temp; free temp; end;
         end;
      else
         if allocation(temp) = 0 then
             /* temp is empty; copy remainder of sorted into work */
            do while (allocation(sorted) > 0);
               allocate work; work = sorted; free sorted;
            end;
         else
            /* sorted is empty; copy remainder of temp onto work */
            do while (allocation(temp) > 0);
               allocate work; work = temp; free temp;
            end;
   end;

   call move (sorted, work); /* Move the values to SORTED. */

end merge;

/* Collect a thread of ascending values from aray A, and stack them in temp. */
/* Note: the values in temp are in reverse order. */
fetch: procedure (A, temp);
   declare A(*) fixed, temp controlled fixed;
   declare i fixed binary;

   do i = 1 to hbound(A,1);
      if used(i) then
         do; allocate temp; temp = A(i); used(i) = '0'b; go to found; end;
   end;
found:
   do i = i+1 to hbound(A,1);
      if (temp <= A(i)) & used(i) then
         do; allocate temp; temp = A(i); used(i) = '0'b; end;
   end;
end fetch;

/* Copy the stack at TEMP to the stack at SORTED. */
/* In TEMP, elements are in reverse order;   */
/* in SORTED, elements are in forward order. */
move: procedure (sorted, temp);
   declare (sorted, temp) fixed controlled;

   do while (allocation(sorted) > 0); free sorted; end;
   do while (allocation (temp) > 0);
      allocate sorted; sorted = temp; free temp;
   end;
end move;

end strand;


Procedure strandSort(List a())
  Protected NewList subList()
  Protected NewList results()

  While ListSize(a()) > 0
    ClearList(subList())
    AddElement(subList())
    FirstElement(a())
    subList() = a()
    DeleteElement(a())
    ForEach a()
      If a() >= subList()
        AddElement(subList())
        subList() = a()
        DeleteElement(a())
      EndIf
    Next

    ;merge lists
    FirstElement(subList())
    If Not FirstElement(results())
      ;copy all of sublist() to results()
      MergeLists(subList(), results(), #PB_List_Last)
    Else
      Repeat
        If subList() < results()
          InsertElement(results())
          results() = subList()
          DeleteElement(subList())
          If Not NextElement(subList())
            Break
          EndIf
        ElseIf Not NextElement(results())
          ;add remainder of sublist() to end of results()
          MergeLists(subList(), results(), #PB_List_Last)
          Break
        EndIf
      ForEver
    EndIf

  Wend
  CopyList(results(), a())
EndProcedure

Procedure.s listContents(List a())
  Protected output.s
  PushListPosition(a())
  ForEach a()
    output + Str(a()) + ","
  Next
  PopListPosition(a())
  ProcedureReturn Left(output, Len(output) - 1)
EndProcedure

Procedure setupList(List a())
  ClearList(a())
  Protected elementCount, i

  elementCount = Random(5) + 10
  For i = 1 To elementCount
    AddElement(a())
    a() = Random(10) - 5
  Next
EndProcedure

If OpenConsole()
  NewList sample()
  Define i

  For i = 1 To 3
    setupList(sample())
    PrintN("List " + Str(i) + ":")
    PrintN("  Before:  " + listContents(sample()))
    strandSort(sample())
    PrintN("  After :  " + listContents(sample()))
    PrintN("")
  Next

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


package main

import (
	"fmt"
	"log"
	"os"
	"strconv"
	"time"
)

func main() {
	out := make(chan uint64)
	for _, a := range os.Args[1:] {
		i, err := strconv.ParseUint(a, 10, 64)
		if err != nil {
			log.Fatal(err)
		}
		go func(n uint64) {
			time.Sleep(time.Duration(n) * time.Millisecond)
			out <- n
		}(i)
	}
	for _ = range os.Args[1:] {
		fmt.Println(<-out)
	}
}


@Grab(group = 'org.codehaus.gpars', module = 'gpars', version = '1.2.1')
import groovyx.gpars.GParsPool

GParsPool.withPool args.size(), {
    args.eachParallel {
        sleep(it.toInteger() * 10)
        println it
    }
}


import System.Environment
import Control.Concurrent
import Control.Monad

sleepSort :: [Int] -> IO ()
sleepSort values = do
        chan <- newChan
        forM_ values (\time -> forkIO (threadDelay (50000 * time) >> writeChan chan time))
        forM_ values (\_ -> readChan chan >>= print)

main :: IO ()
main = getArgs >>= sleepSort . map read


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

PROC StoogeSort(INT ARRAY a INT size)
  INT l,h,t,tmp

  InitStack()
  Push(0,size-1)
  WHILE IsEmpty()=0
  DO
    Pop(@l,@h)
    IF a(l)>a(h) THEN
      tmp=a(l) a(l)=a(h) a(h)=tmp
    FI
    IF h-l>1 THEN
      t=(h-l+1)/3
      Push(l,h-t)
      Push(l+t,h)
      Push(l,h-t)
    FI
  OD
RETURN

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

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

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


with Ada.Text_IO;
procedure Stooge is
   type Integer_Array is array (Positive range <>) of Integer;
   procedure Swap (Left, Right : in out Integer) is
      Temp : Integer := Left;
   begin
      Left  := Right;
      Right := Temp;
   end Swap;
   procedure Stooge_Sort (List : in out Integer_Array) is
      T : Natural := List'Length / 3;
   begin
      if List (List'Last) < List (List'First) then
         Swap (List (List'Last), List (List'First));
      end if;
      if List'Length > 2 then
         Stooge_Sort (List (List'First     .. List'Last - T));
         Stooge_Sort (List (List'First + T .. List'Last));
         Stooge_Sort (List (List'First     .. List'Last - T));
      end if;
   end Stooge_Sort;
   Test_Array : Integer_Array := (1, 4, 5, 3, -6, 3, 7, 10, -2, -5, 7, 5, 9, -3, 7);
begin
   Stooge_Sort (Test_Array);
   for I in Test_Array'Range loop
      Ada.Text_IO.Put (Integer'Image (Test_Array (I)));
      if I /= Test_Array'Last then
         Ada.Text_IO.Put (", ");
      end if;
   end loop;
   Ada.Text_IO.New_Line;
end Stooge;


# swaps the values of the two REF INTs #
PRIO =:= = 1;
OP   =:= = ( REF INT a, b )VOID: ( INT t := a; a := b; b := t );

# returns the array of INTs sorted via the stooge sort algorithm #
PROC stooge sort = ( []INT array )[]INT:
     BEGIN
         PROC stooge sort segment = ( REF[]INT l, INT i, j )VOID:
             BEGIN
                 IF l[j] < l[i] THEN l[ i ] =:= l[ j ] FI;
                 IF j - i > 1
                 THEN
                     INT t := (j - i + 1) OVER 3;
                     stooge sort segment( l, i,     j - t );
                     stooge sort segment( l, i + t, j     );
                     stooge sort segment( l, i,     j - t )
                 FI
             END # stooge sort segment # ;

         [ LWB array : UPB array ]INT result := array;
         stooge sort segment( result, LWB result, UPB result );
         result
     END # stooge sort # ;

# test the stooge sort #
[]INT data = ( 67, -201, 0, 9, 9, 231, 4 );
print( ( "before: ", data, newline, "after:  ", stooge sort( data ), newline ) )


$ include "seed7_05.s7i";

const type: preferences is hash [string] array string;
const type: engaged is hash [string] string;

const func integer: pos (in array string: area, in string: searched) is func
  result
    var integer: pos is 1;
  begin
    while pos <= length(area) and area[pos] <> searched do
      incr(pos);
    end while;
    if pos > length(area) then
      pos := 0;
    end if;
  end func;

const func engaged: matchmaker (in preferences: guyPrefers, in preferences: girlPrefers) is func
  result
    var engaged: engagedTo is engaged.value;
  local
    var array string: freeGuys is 0 times "";
    var string: guy is "";
    var string: girl is "";
    var string: fiance is "";
    var array string: guyPreferencList is 0 times "";
    var array string: girlPreferenceList is 0 times "";
    var boolean: searching is TRUE;
  begin
    freeGuys := sort(keys(guyPrefers));
    while length(freeGuys) <> 0 do
      guy := freeGuys[1];
      freeGuys := freeGuys[2 ..];
      guyPreferencList := guyPrefers[guy];
      searching := TRUE;
      while searching and length(guyPreferencList) <> 0 do
        girl := guyPreferencList[1];
        guyPreferencList := guyPreferencList[2 ..];
        if girl not in engagedTo then
          engagedTo @:= [girl] guy;
          writeln("  " <& girl <& " and " <& guy);
          searching := FALSE;
        else
          fiance := engagedTo[girl];
          girlPreferenceList := girlPrefers[girl];
          if pos(girlPreferenceList, guy) < pos(girlPreferenceList, fiance) then
            # She prefers new guy
            engagedTo @:= [girl] guy;
            freeGuys &:= fiance;
            writeln("  " <& girl <& " dumped " <& fiance <& " for " <& guy);
            searching := FALSE;
          end if;
        end if;
      end while;
    end while;
  end func;

const func boolean: check (in engaged: engagedTo,
    in preferences: guyPrefers, in preferences: girlPrefers) is func
  result
    var boolean: stable is TRUE;
  local
    var string: he is "";
    var string: she is "";
    var string: guy is "";
    var string: girl is "";
    var engaged: inverseEngaged is engaged.value;
    var array string: sheLikes is 0 times "";
    var array string: sheLikesBetter is 0 times "";
    var array string: heLikes is 0 times "";
    var array string: heLikesBetter is 0 times "";
    var string: guysGirl is "";
    var array string: guyLikes is 0 times "";
    var string: girlsGuy is "";
    var array string: girlLikes is 0 times "";
  begin
    for he key she range engagedTo do
      inverseEngaged @:= [he] she;
    end for;
    for he key she range engagedTo do
      sheLikes := girlPrefers[she];
      sheLikesBetter := sheLikes[.. pred(pos(sheLikes, he))];
      heLikes := guyPrefers[he];
      heLikesBetter := heLikes[.. pred(pos(heLikes, she))];
      for guy range sheLikesBetter do
        guysGirl := inverseEngaged[guy];
        guyLikes := guyPrefers[guy];
        if pos(guyLikes, guysGirl) > pos(guyLikes, she) and stable then
          writeln(she <& " likes " <& guy <& " better than " <& he <& " and " <&
                  guy <& " likes " <& she <& " better than their current partner");
          stable := FALSE;
        end if;
      end for;
      for girl range heLikesBetter do
        girlsGuy := engagedTo[girl];
        girlLikes := girlPrefers[girl];
        if pos(girlLikes, girlsGuy) > pos(girlLikes, he) and stable then
          writeln(he <& " likes " <& girl <& " better than " <& she <& " and " <&
                  girl <& " likes " <& he <& " better than their current partner");
          stable := FALSE;
        end if;
      end for;
    end for;
  end func;

var preferences: guyPrefers is preferences.value;
var preferences: girlPrefers is preferences.value;
guyPrefers @:= ["abe"]  [] ("abi", "eve", "cath", "ivy", "jan", "dee", "fay", "bea", "hope", "gay");
guyPrefers @:= ["bob"]  [] ("cath", "hope", "abi", "dee", "eve", "fay", "bea", "jan", "ivy", "gay");
guyPrefers @:= ["col"]  [] ("hope", "eve", "abi", "dee", "bea", "fay", "ivy", "gay", "cath", "jan");
guyPrefers @:= ["dan"]  [] ("ivy", "fay", "dee", "gay", "hope", "eve", "jan", "bea", "cath", "abi");
guyPrefers @:= ["ed"]   [] ("jan", "dee", "bea", "cath", "fay", "eve", "abi", "ivy", "hope", "gay");
guyPrefers @:= ["fred"] [] ("bea", "abi", "dee", "gay", "eve", "ivy", "cath", "jan", "hope", "fay");
guyPrefers @:= ["gav"]  [] ("gay", "eve", "ivy", "bea", "cath", "abi", "dee", "hope", "jan", "fay");
guyPrefers @:= ["hal"]  [] ("abi", "eve", "hope", "fay", "ivy", "cath", "jan", "bea", "gay", "dee");
guyPrefers @:= ["ian"]  [] ("hope", "cath", "dee", "gay", "bea", "abi", "fay", "ivy", "jan", "eve");
guyPrefers @:= ["jon"]  [] ("abi", "fay", "jan", "gay", "eve", "bea", "dee", "cath", "ivy", "hope");
girlPrefers @:= ["abi"]  [] ("bob", "fred", "jon", "gav", "ian", "abe", "dan", "ed", "col", "hal");
girlPrefers @:= ["bea"]  [] ("bob", "abe", "col", "fred", "gav", "dan", "ian", "ed", "jon", "hal");
girlPrefers @:= ["cath"] [] ("fred", "bob", "ed", "gav", "hal", "col", "ian", "abe", "dan", "jon");
girlPrefers @:= ["dee"]  [] ("fred", "jon", "col", "abe", "ian", "hal", "gav", "dan", "bob", "ed");
girlPrefers @:= ["eve"]  [] ("jon", "hal", "fred", "dan", "abe", "gav", "col", "ed", "ian", "bob");
girlPrefers @:= ["fay"]  [] ("bob", "abe", "ed", "ian", "jon", "dan", "fred", "gav", "col", "hal");
girlPrefers @:= ["gay"]  [] ("jon", "gav", "hal", "fred", "bob", "abe", "col", "ed", "dan", "ian");
girlPrefers @:= ["hope"] [] ("gav", "jon", "bob", "abe", "ian", "dan", "hal", "ed", "col", "fred");
girlPrefers @:= ["ivy"]  [] ("ian", "col", "hal", "gav", "fred", "bob", "abe", "ed", "jon", "dan");
girlPrefers @:= ["jan"]  [] ("ed", "hal", "gav", "abe", "bob", "jon", "col", "ian", "fred", "dan");

const proc: main is func
  local
    var engaged: engagedTo is engaged.value;
    var string: girl is "";
  begin
    writeln("Matchmaking:");
    engagedTo := matchmaker(guyPrefers, girlPrefers);
    writeln;
    writeln("Engagements:");
    for girl range sort(keys(engagedTo)) do
      writeln("  " <& girl <& " and " <& engagedTo[girl]);
    end for;
    writeln;
    writeln("Marriages are " <& [] ("unstable", "stable") [succ(ord(check(engagedTo, guyPrefers, girlPrefers)))]);
    writeln;
    writeln("Perturb:");
    engagedTo @:= ["abi"] "fred";
    engagedTo @:= ["bea"] "jon";
    writeln("engage abi with fred and bea with jon");
    writeln;
    writeln("Marriages are " <& [] ("unstable", "stable") [succ(ord(check(engagedTo, guyPrefers, girlPrefers)))]);
  end func;


var he_likes = Hash(
    abe  => < abi eve cath ivy jan dee fay bea hope gay >,
    bob  => < cath hope abi dee eve fay bea jan ivy gay >,
    col  => < hope eve abi dee bea fay ivy gay cath jan >,
    dan  => < ivy fay dee gay hope eve jan bea cath abi >,
    ed   => < jan dee bea cath fay eve abi ivy hope gay >,
    fred => < bea abi dee gay eve ivy cath jan hope fay >,
    gav  => < gay eve ivy bea cath abi dee hope jan fay >,
    hal  => < abi eve hope fay ivy cath jan bea gay dee >,
    ian  => < hope cath dee gay bea abi fay ivy jan eve >,
    jon  => < abi fay jan gay eve bea dee cath ivy hope >,
);

var she_likes = Hash(
    abi  => < bob fred jon gav ian abe dan ed col hal >,
    bea  => < bob abe col fred gav dan ian ed jon hal >,
    cath => < fred bob ed gav hal col ian abe dan jon >,
    dee  => < fred jon col abe ian hal gav dan bob ed >,
    eve  => < jon hal fred dan abe gav col ed ian bob >,
    fay  => < bob abe ed ian jon dan fred gav col hal >,
    gay  => < jon gav hal fred bob abe col ed dan ian >,
    hope => < gav jon bob abe ian dan hal ed col fred >,
    ivy  => < ian col hal gav fred bob abe ed jon dan >,
    jan  => < ed hal gav abe bob jon col ian fred dan >,
);

var guys = he_likes.keys;
var gals = she_likes.keys;

var (:fiancé, :fiancée, :proposed);

func she_prefers (her, hottie) { var a = she_likes{her}; a.index(hottie) < a.index(fiancé{her}) }
func he_prefers  (him, hottie) { var a =  he_likes{him}; a.index(hottie) < a.index(fiancée{him}) }

func unmatched_guy { guys.first {|k| !defined fiancée{k} } }
func preferred_choice(guy) { he_likes{guy}.first {|k| !defined proposed{guy}{k} } }

func engage(guy, gal) {
    fiancé{gal} = guy;
    fiancée{guy} = gal;
}

func match_em {
    say 'Matchmaking:';
    while (defined(var guy = unmatched_guy())) {
        var gal = preferred_choice(guy);
        proposed{guy}{gal} = '❤';
        if (!defined fiancé{gal}) {
            engage(guy, gal);
            say "\t#{gal} and #{guy}";
        }
        elsif (she_prefers(gal, guy)) {
            var engaged_guy = fiancé{gal};
            engage(guy, gal);
            fiancée{engaged_guy} = nil;
            say "\t#{gal} dumped #{engaged_guy} for #{guy}";
        }
    }
}

func check_stability {
    var instabilities = gather {
        guys.each { |m|
            gals.each { |w|
                if (he_prefers(m, w) && she_prefers(w, m)) {
                    take "\t#{w} prefers #{m} to #{fiancé{w}} and #{m} prefers #{w} to #{fiancée{m}}";
                }
            }
        }
    }

    say 'Stablility:';
    instabilities.is_empty
        ? say "\t(all marriages stable)"
        : instabilities.each { |i| say i };
}

func perturb_em {
    say 'Perturb:';
    say "\tengage abi with fred and bea with jon";
    engage('fred', 'abi');
    engage('jon', 'bea');
}

match_em();
check_stability();

perturb_em();
check_stability();


def merge_list(a, b):
	out = []
	while len(a) and len(b):
		if a[0] < b[0]:
			out.append(a.pop(0))
		else:
			out.append(b.pop(0))
	out += a
	out += b
	return out

def strand(a):
	i, s = 0, [a.pop(0)]
	while i < len(a):
		if a[i] > s[-1]:
			s.append(a.pop(i))
		else:
			i += 1
	return s

def strand_sort(a):
	out = strand(a)
	while len(a):
		out = merge_list(out, strand(a))
	return out

print strand_sort([1, 6, 3, 2, 1, 7, 5, 3])


#lang racket
(require mzlib/list)
(define (merge xs ys) (merge-sorted-lists xs ys <=))

(define (strand-sort xs)
  (let loop ([xs xs] [ys '[]])
    (cond [(empty? xs) ys]
          [else (define-values (sorted unsorted) (extract-strand xs))
                (loop unsorted (merge sorted ys))])))

(define (extract-strand xs)
  (for/fold ([strand '()] [unsorted '[]]) ([x xs])
    (if (or (empty? strand) (< x (first strand)))
        (values (cons x strand) unsorted)
        (values strand (cons x unsorted)))))

(strand-sort (build-list 10 (λ(_) (random 15))))


sub infix:<M> (@x-in, @y-in) {
    my @x = | @x-in;
    my @y = | @y-in;
    flat @x, @y,
        reverse gather while @x and @y {
            take do given @x[*-1] cmp @y[*-1] {
                when More { pop @x }
                when Less { pop @y }
                when Same { pop(@x), pop(@y) }
            }
        }
}

sub strand (@x) {
    my $i = 0;
    my $prev = -Inf;
    gather while $i < @x {
        @x[$i] before $prev ?? $i++ !! take $prev = splice(@x, $i, 1)[0];
    }
}

sub strand_sort (@x is copy) {
    my @out;
    @out M= strand(@x) while @x;
    @out;
}

my @a = (^100).roll(10);
say "Before {@a}";
@a = strand_sort(@a);
say "After  {@a}";

@a = <The quick brown fox jumps over the lazy dog>;
say "Before {@a}";
@a = strand_sort(@a);
say "After  {@a}";


procedure main(A)
    every insert(t:=set(),mkThread(t,!A))
    every spawn(!t)    # start threads as closely grouped as possible
    while (*t > 0) do write(<<@)
end

procedure mkThread(t,n)    # 10ms delay scale factor
    return create (delay(n*10),delete(t,&current),n@>&main)
end


scheduledumb=: {{
  id=:'dumb',":x:6!:9''
  wd 'pc ',id
  (t)=: u {{u y[erase n}} t=. id,'_timer'
  wd 'ptimer ',":n p.y
}}

ssort=: {{
  R=: ''
  poly=. 1,>./ y
  poly{{ y{{R=:R,m[y}}scheduledumb m y}}"0 y
  {{echo R}} scheduledumb poly"0 >:>./ y
  EMPTY
}}


import java.util.concurrent.CountDownLatch;

public class SleepSort {
	public static void sleepSortAndPrint(int[] nums) {
		final CountDownLatch doneSignal = new CountDownLatch(nums.length);
		for (final int num : nums) {
			new Thread(new Runnable() {
				public void run() {
					doneSignal.countDown();
					try {
						doneSignal.await();

						//using straight milliseconds produces unpredictable
						//results with small numbers
						//using 1000 here gives a nifty demonstration
						Thread.sleep(num * 1000);
						System.out.println(num);
					} catch (InterruptedException e) {
						e.printStackTrace();
					}
				}
			}).start();
		}
	}
	public static void main(String[] args) {
		int[] nums = new int[args.length];
		for (int i = 0; i < args.length; i++)
			nums[i] = Integer.parseInt(args[i]);
		sleepSortAndPrint(nums);
	}
}


StoogeSort(L, i:=1, j:=""){
	if !j
		j := L.MaxIndex()
	if (L[j] < L[i]){
		temp := L[i]
		L[i] := L[j]
		L[j] := temp
	}
	if (j - i > 1){
		t := floor((j - i + 1)/3)
		StoogeSort(L, i, j-t)
		StoogeSort(L, i+t, j)
		StoogeSort(L, i, j-t)
	}
	return L
}


DECLARE SUB stoogesort (L() AS LONG, i AS LONG, j AS LONG)

RANDOMIZE TIMER

CONST arraysize = 10

DIM x(arraysize) AS LONG
DIM i AS LONG

PRINT "Before: ";
FOR i = 0 TO arraysize
    x(i) = INT(RND * 100)
    PRINT x(i); " ";
NEXT
PRINT

stoogesort x(), 0, arraysize

PRINT "After: ";
FOR i = 0 TO arraysize
    PRINT x(i); " ";
NEXT
PRINT

SUB stoogesort (L() AS LONG, i AS LONG, j AS LONG)
    IF L(j) < L(i) THEN SWAP L(i), L(j)
    IF (j - i) > 1 THEN
        DIM t AS LONG
        t = (j - i + 1) / 3
        stoogesort L(), i, j - t
        stoogesort L(), i + t, j
        stoogesort L(), i, j - t
    END IF
END SUB


package Preferences
is

   type Guy_X is (no_guy, abe, bob, col, dan, ed, fred, gav, hal, ian, jon);
   subtype Guy is Guy_X range Guy_X'Succ(Guy_X'First) .. Guy_X'Last;

   type Girl_X is (no_girl, abi, bea, cath, dee, eve, fay, gay, hope, ivy, jan);
   subtype Girl is Girl_X range Girl_X'Succ(Girl_X'First) .. Girl_X'Last;

   type Extended_Rank is range 0 .. 10;
   subtype Rank is Extended_Rank range 1 .. Extended_Rank'Last;

   type His_Rank is array (Rank) of Girl;
   type He_Prefers is array (Guy) of His_Rank;

   Guys_Like : constant He_Prefers := He_Prefers'(
     abe  => His_Rank'(abi, eve, cath, ivy, jan, dee, fay, bea, hope, gay),
     bob  => His_Rank'(cath, hope, abi, dee, eve, fay, bea, jan, ivy, gay),
     col  => His_Rank'(hope, eve, abi, dee, bea, fay, ivy, gay, cath, jan),
     dan  => His_Rank'(ivy, fay, dee, gay, hope, eve, jan, bea, cath, abi),
     ed   => His_Rank'(jan, dee, bea, cath, fay, eve, abi, ivy, hope, gay),
     fred => His_Rank'(bea, abi, dee, gay, eve, ivy, cath, jan, hope, fay),
     gav  => His_Rank'(gay, eve, ivy, bea, cath, abi, dee, hope, jan, fay),
     hal  => His_Rank'(abi, eve, hope, fay, ivy, cath, jan, bea, gay, dee),
     ian  => His_Rank'(hope, cath, dee, gay, bea, abi, fay, ivy, jan, eve),
     jon  => His_Rank'(abi, fay, jan, gay, eve, bea, dee, cath, ivy, hope));

   type Her_Rank is array(Rank) of Guy;
   type She_Prefers is array (Girl) of Her_Rank;

   Girls_Like : constant She_Prefers := She_Prefers'(
     abi  => Her_Rank'(bob, fred, jon, gav, ian, abe, dan, ed, col, hal),
     bea  => Her_Rank'(bob, abe, col, fred, gav, dan, ian, ed, jon, hal),
     cath => Her_Rank'(fred, bob, ed, gav, hal, col, ian, abe, dan, jon),
     dee  => Her_Rank'(fred, jon, col, abe, ian, hal, gav, dan, bob, ed),
     eve  => Her_Rank'(jon, hal, fred, dan, abe, gav, col, ed, ian, bob),
     fay  => Her_Rank'(bob, abe, ed, ian, jon, dan, fred, gav, col, hal),
     gay  => Her_Rank'(jon, gav, hal, fred, bob, abe, col, ed, dan, ian),
     hope => Her_Rank'(gav, jon, bob, abe, ian, dan, hal, ed, col, fred),
     ivy  => Her_Rank'(ian, col, hal, gav, fred, bob, abe, ed, jon, dan),
     jan  => Her_Rank'(ed, hal, gav, abe, bob, jon, col, ian, fred, dan));

end Preferences;


/*REXX program sorts a random list of words (or numbers) using the strand sort algorithm*/
parse arg size minv maxv old                     /*obtain optional arguments from the CL*/
if size=='' | size==","  then size=20            /*Not specified?  Then use the default.*/
if minv=='' | minv==","  then minv= 0            /*Not specified?  Then use the default.*/
if maxv=='' | maxv==","  then maxv=size          /*Not specified?  Then use the default.*/
               do i=1  for size                  /*generate a list of random numbers.   */
               old=old  random(0,maxv-minv)+minv /*append a random number to a list.    */
               end  /*i*/
old=space(old)                                   /*elide extraneous blanks from the list*/
          say center('unsorted list', length(old), "─");         say old
new=strand_sort(old)                             /*sort the list of the random numbers. */
say;      say center('sorted list'  , length(new), "─");         say new
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
strand_sort: procedure; parse arg x;                       y=
                          do  while words(x)\==0;          w=words(x)
                                 do j=1  for w-1                /*anything out of order?*/
                                 if word(x,j)>word(x,j+1)  then do;  w=j;  leave;  end
                                 end   /*j*/
                          y=merge(y,subword(x,1,w));       x=subword(x,w+1)
                          end            /*while*/
             return y
/*──────────────────────────────────────────────────────────────────────────────────────*/
merge:       procedure; parse arg a.1,a.2;    p=
                   do forever;  w1=words(a.1);  w2=words(a.2)   /*do while 2 lists exist*/
                   if w1==0 | if w2==0              then leave  /*Any list empty?  Stop.*/
                   if word(a.1,w1)  <= word(a.2,1)  then leave  /*lists are now sorted? */
                   if word(a.2,w2)  <= word(a.1,1)  then return space(p a.2 a.1)
                   #=1+(word(a.1,1) >= word(a.2,1));  p=p word(a.#,1);  a.#=subword(a.#,2)
                   end   /*forever*/
             return space(p a.1 a.2)


# Project : Sorting algorithms/Strand sort

test = [-2,0,-2,5,5,3,-1,-3,5,5,0,2,-4,4,2]
results = []
resultsend = []
see "before sort:" + nl
showarray(test)
test = strandsort(test)
see "after sort:" + nl
showarray(test)

func strandsort(a)
        while len(a) > 0
                 sublist = []
                 add(sublist,a[1])
                 del(a,1)
                 for i = 1 to len(a)
                     if a[i] > sublist[len(sublist)]
                       add(sublist,a[i])
                       del(a,i)
                     ok
                next
                for n = 1 to len(sublist)
                     add(results,sublist[n])
                next
                for n = 1 to len(results)
                     for m = n + 1 to len(results)
                          if results[m] < results[n]
                             temp = results[m]
                             results[m] = results[n]
                             results[n] = temp
                          ok
                     next
                next
        end
        return results

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


Array.prototype.timeoutSort = function (f) {
	this.forEach(function (n) {
		setTimeout(function () { f(n) }, 5 * n)
	});
}


echo '[5, 1, 3, 2, 11, 6, 4]' | jq '
def f:
  if .unsorted == [] then
    .sorted
  else
    { unsorted: [.unsorted[] | .t = .t - 1 | select(.t != 0)]
    , sorted: (.sorted + [.unsorted[] | .t = .t - 1 | select(.t == 0) | .v]) }
    | f
  end;
{unsorted: [.[] | {v: ., t: .}], sorted: []} | f | .[]
'


function sleepsort(V::Vector{T}) where {T <: Real}
    U = Vector{T}()
    sizehint!(U, length(V))
    @sync for v in V
        @async begin
            sleep(abs(v))
            (v < 0 ? pushfirst! : push!)(U, v)
        end
    end
    return U
end

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


// version 1.1.51

import kotlin.concurrent.thread

fun sleepSort(list: List<Int>, interval: Long) {
    print("Sorted  : ")
    for (i in list) {
        thread {
            Thread.sleep(i * interval)
            print("$i ")
        }
    }
    thread { // print a new line after displaying sorted list
        Thread.sleep ((1 + list.max()!!) * interval)
        println()
    }
}

fun main(args: Array<String>) {
   val list = args.map { it.toInt() }.filter { it >= 0 } // ignore negative integers
   println("Unsorted: ${list.joinToString(" ")}")
   sleepSort(list, 50)
}


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

      DEF PROCstoogesort(l%(), i%, j%)
      LOCAL t%
      IF l%(j%) < l%(i%) SWAP l%(i%), l%(j%)
      IF j% - i% > 1 THEN
        t% = (j% - i% + 1)/3
        PROCstoogesort(l%(), i%, j%-t%)
        PROCstoogesort(l%(), i%+t%, j%)
        PROCstoogesort(l%(), i%, j%-t%)
      ENDIF
      ENDPROC


get "libhdr"

let stoogesort(L, i, j) be
$(  if L!j < L!i then
    $(  let x = L!i
        L!i := L!j
        L!j := x
    $)
    if j-i>1 then
    $(  let t = (j - i + 1)/3
        stoogesort(L, i, j-t)
        stoogesort(L, i+t, j)
        stoogesort(L, i, j-t)
    $)
$)

let write(s, A, len) be
$(  writes(s)
    for i=0 to len-1 do writed(A!i, 4)
    wrch('*N')
$)

let start() be
$(  let array = table 4,65,2,-31,0,99,2,83,782,1
    let length = 10
    write("Before: ", array, length)
    stoogesort(array, 0, length-1)
    write("After:  ", array, length)
$)


#include <stdio.h>

#define SWAP(r,s)  do{ t=r; r=s; s=t; } while(0)

void StoogeSort(int a[], int i, int j)
{
   int t;

   if (a[j] < a[i]) SWAP(a[i], a[j]);
   if (j - i > 1)
   {
       t = (j - i + 1) / 3;
       StoogeSort(a, i, j - t);
       StoogeSort(a, i + t, j);
       StoogeSort(a, i, j - t);
   }
}

int main(int argc, char *argv[])
{
   int nums[] = {1, 4, 5, 3, -6, 3, 7, 10, -2, -5, 7, 5, 9, -3, 7};
   int i, n;

   n = sizeof(nums)/sizeof(int);
   StoogeSort(nums, 0, n-1);

   for(i = 0; i <= n-1; i++)
      printf("%5d", nums[i]);

   return 0;
}


class Person {
    let name:String
    var candidateIndex = 0
    var fiance:Person?
    var candidates = [Person]()

    init(name:String) {
        self.name = name
    }

    func rank(p:Person) -> Int {
        for (i, candidate) in enumerate(self.candidates) {
            if candidate === p {
                return i
            }
        }
        return self.candidates.count + 1
    }

    func prefers(p:Person) -> Bool {
        if let fiance = self.fiance {
            return self.rank(p) < self.rank(fiance)
        }
        return false
    }

    func nextCandidate() -> Person? {
        if self.candidateIndex >= self.candidates.count {
            return nil
        }
        return self.candidates[candidateIndex++]
    }

    func engageTo(p:Person) {
        p.fiance?.fiance = nil
        p.fiance = self
        self.fiance?.fiance = nil
        self.fiance = p
    }

    func swapWith(p:Person) {
        let thisFiance = self.fiance
        let pFiance = p.fiance
        println("\(self.name) swapped partners with \(p.name)")
        if pFiance != nil && thisFiance != nil {
            self.engageTo(pFiance!)
            p.engageTo(thisFiance!)
        }
    }
}

func isStable(guys:[Person], gals:[Person]) -> Bool {
    for guy in guys {
        for gal in gals {
            if guy.prefers(gal) && gal.prefers(guy) {
                return false
            }
        }
    }
    return true
}

func engageEveryone(guys:[Person]) {
    var done = false
    while !done {
        done = true
        for guy in guys {
            if guy.fiance == nil {
                done = false
                if let gal = guy.nextCandidate() {
                    if gal.fiance == nil || gal.prefers(guy) {
                        guy.engageTo(gal)
                    }
                }
            }
        }
    }
}

func doMarriage() {
    let abe  = Person(name: "Abe")
    let bob  = Person(name: "Bob")
    let col  = Person(name: "Col")
    let dan  = Person(name: "Dan")
    let ed   = Person(name: "Ed")
    let fred = Person(name: "Fred")
    let gav  = Person(name: "Gav")
    let hal  = Person(name: "Hal")
    let ian  = Person(name: "Ian")
    let jon  = Person(name: "Jon")
    let abi  = Person(name: "Abi")
    let bea  = Person(name: "Bea")
    let cath = Person(name: "Cath")
    let dee  = Person(name: "Dee")
    let eve  = Person(name: "Eve")
    let fay  = Person(name: "Fay")
    let gay  = Person(name: "Gay")
    let hope = Person(name: "Hope")
    let ivy  = Person(name: "Ivy")
    let jan  = Person(name: "Jan")

    abe.candidates  = [abi, eve, cath, ivy, jan, dee, fay, bea, hope, gay]
    bob.candidates  = [cath, hope, abi, dee, eve, fay, bea, jan, ivy, gay]
    col.candidates  = [hope, eve, abi, dee, bea, fay, ivy, gay, cath, jan]
    dan.candidates  = [ivy, fay, dee, gay, hope, eve, jan, bea, cath, abi]
    ed.candidates   = [jan, dee, bea, cath, fay, eve, abi, ivy, hope, gay]
    fred.candidates = [bea, abi, dee, gay, eve, ivy, cath, jan, hope, fay]
    gav.candidates  = [gay, eve, ivy, bea, cath, abi, dee, hope, jan, fay]
    hal.candidates  = [abi, eve, hope, fay, ivy, cath, jan, bea, gay, dee]
    ian.candidates  = [hope, cath, dee, gay, bea, abi, fay, ivy, jan, eve]
    jon.candidates  = [abi, fay, jan, gay, eve, bea, dee, cath, ivy, hope]
    abi.candidates  = [bob, fred, jon, gav, ian, abe, dan, ed, col, hal]
    bea.candidates  = [bob, abe, col, fred, gav, dan, ian, ed, jon, hal]
    cath.candidates = [fred, bob, ed, gav, hal, col, ian, abe, dan, jon]
    dee.candidates  = [fred, jon, col, abe, ian, hal, gav, dan, bob, ed]
    eve.candidates  = [jon, hal, fred, dan, abe, gav, col, ed, ian, bob]
    fay.candidates  = [bob, abe, ed, ian, jon, dan, fred, gav, col, hal]
    gay.candidates  = [jon, gav, hal, fred, bob, abe, col, ed, dan, ian]
    hope.candidates = [gav, jon, bob, abe, ian, dan, hal, ed, col, fred]
    ivy.candidates  = [ian, col, hal, gav, fred, bob, abe, ed, jon, dan]
    jan.candidates  = [ed, hal, gav, abe, bob, jon, col, ian, fred, dan]

    let guys = [abe, bob, col, dan, ed, fred, gav, hal, ian, jon]
    let gals = [abi, bea, cath, dee, eve, fay, gay, hope, ivy, jan]

    engageEveryone(guys)

    for guy in guys {
        println("\(guy.name) is engaged to \(guy.fiance!.name)")
    }

    println("Stable = \(isStable(guys, gals))")
    jon.swapWith(fred)
    println("Stable = \(isStable(guys, gals))")

}

doMarriage()


package require Tcl 8.5

# Functions as aliases to standard commands
interp alias {} tcl::mathfunc::pos {} ::lsearch -exact
interp alias {} tcl::mathfunc::nonempty {} ::llength

# The stability check
proc check engaged {
    global preferences
    set inverse [lreverse $engaged]
    set errmsg "%s and %s like each other better than their present partners,\
	    %s and %s respectively"
    dict for {she he} $engaged {
	set shelikes [dict get $preferences $she]
	set shelikesbetter [lrange $shelikes 0 [expr {pos($shelikes,$he)}]]
	set helikes [dict get $preferences $he]
	set helikesbetter [lrange $helikes 0 [expr {pos($helikes,$she)}]]
	foreach guy $shelikesbetter {
	    set guysgirl [dict get $inverse $guy]
	    set guylikes [dict get $preferences $guy]
	    if {pos($guylikes,$guysgirl) > pos($guylikes,$she)} {
		puts [format $errmsg $she $guy $he $guysgirl]
		return 0
	    }
	}
	foreach gal $helikesbetter {
	    set galsguy [dict get $engaged $gal]
	    set gallikes [dict get $preferences $gal]
	    if {pos($gallikes,$galsguy) > pos($gallikes,$he)} {
		puts [format $errmsg $he $gal $she $galsguy]
		return 0
	    }
	}
    }
    return 1
}

# The match-making algorithm
proc matchmaker {} {
    global guys gals preferences
    set guysfree $guys
    set engaged {}
    array set p $preferences
    while {nonempty($guysfree)} {
	set guysfree [lassign $guysfree guy]
	set p($guy) [set guyslist [lassign $p($guy) gal]]
	if {![dict exists $engaged $gal]} {
	    # She's free
	    dict set engaged $gal $guy
	    puts "  $guy and $gal"
	    continue
	}
	# The bounder proposes to an engaged lass!
	set fiance [dict get $engaged $gal]
	if {pos($p($gal), $fiance) > pos($p($gal), $guy)} {
	    # She prefers the new guy
	    dict set engaged $gal $guy
	    puts "  $gal dumped $fiance for $guy"
	    set guy $fiance
	}
	if {nonempty($p($guy))} {
	    lappend guysfree $guy
	}
    }
    return $engaged
}

# Problem dataset; preferences unified since all names distinct
set guys {abe bob col  dan ed  fred gav hal  ian jon}
set gals {abi bea cath dee eve fay  gay hope ivy jan}
set preferences {
    abe  {abi  eve  cath ivy  jan  dee  fay  bea  hope gay}
    bob  {cath hope abi  dee  eve  fay  bea  jan  ivy  gay}
    col  {hope eve  abi  dee  bea  fay  ivy  gay  cath jan}
    dan  {ivy  fay  dee  gay  hope eve  jan  bea  cath abi}
    ed   {jan  dee  bea  cath fay  eve  abi  ivy  hope gay}
    fred {bea  abi  dee  gay  eve  ivy  cath jan  hope fay}
    gav  {gay  eve  ivy  bea  cath abi  dee  hope jan  fay}
    hal  {abi  eve  hope fay  ivy  cath jan  bea  gay  dee}
    ian  {hope cath dee  gay  bea  abi  fay  ivy  jan  eve}
    jon  {abi  fay  jan  gay  eve  bea  dee  cath ivy  hope}

    abi  {bob  fred jon  gav  ian  abe dan  ed  col  hal}
    bea  {bob  abe  col  fred gav  dan ian  ed  jon  hal}
    cath {fred bob  ed   gav  hal  col ian  abe dan  jon}
    dee  {fred jon  col  abe  ian  hal gav  dan bob  ed}
    eve  {jon  hal  fred dan  abe  gav col  ed  ian  bob}
    fay  {bob  abe  ed   ian  jon  dan fred gav col  hal}
    gay  {jon  gav  hal  fred bob  abe col  ed  dan  ian}
    hope {gav  jon  bob  abe  ian  dan hal  ed  col  fred}
    ivy  {ian  col  hal  gav  fred bob abe  ed  jon  dan}
    jan  {ed   hal  gav  abe  bob  jon col  ian fred dan}
}

# The demonstration code
puts "Engagements:"
set engaged [matchmaker]

puts "\nCouples:"
set pfx ""
foreach gal $gals {
    puts -nonewline "$pfx  $gal is engaged to [dict get $engaged $gal]"
    set pfx ",\n"
}
puts "\n"
puts "Engagement stability check [lindex {FAILED PASSED} [check $engaged]]"

puts "\n\nSwapping two fiances to introduce an error"
set tmp [dict get $engaged [lindex $gals 0]]
dict set engaged [lindex $gals 0] [dict get $engaged [lindex $gals 1]]
dict set engaged [lindex $gals 1] $tmp
foreach gal [lrange $gals 0 1] {
    puts "  $gal is now engaged to [dict get $engaged $gal]"
}
puts ""
puts "Engagement stability check [lindex {FAILED PASSED} [check $engaged]]"


class Array
  def strandsort
    a = dup
    result = []
    until a.empty?
      v = a.first
      sublist, a = a.partition{|val| v=val if v<=val}   # In case of v>val, it becomes nil.

      result.each_index do |idx|
        break if sublist.empty?
        result.insert(idx, sublist.shift) if sublist.first < result[idx]
      end
      result += sublist
    end
    result
  end

  def strandsort!
    replace(strandsort)
  end
end

p [1, 6, 3, 2, 1, 7, 5, 3].strandsort


func merge(x, y) {
    var out = [];
    while (x && y) {
        given (x[-1] <=> y[-1]) {
            when ( 1) { out.prepend(x.pop) }
            when (-1) { out.prepend(y.pop) }
            default   { out.prepend(x.pop, y.pop) }
        }
    }
    x + y + out;
}

func strand(x) {
    x || return [];
    var out = [x.shift];
    if (x.len) {
        for i in (-x.len .. -1) {
            if (x[i] >= out[-1]) {
                out.append(x.pop_at(i));
            }
        }
    }
    return out;
}

func strand_sort(x) {
    var out = [];
    while (var strd = strand(x)) {
        out = merge(out, strd);
    }
    return out;
}

var a = 10.of { 100.irand };
say "Before: #{a}";
say "After: #{strand_sort(a)}";


function sleeprint(n)
  local t0 = os.time()
  while os.time() - t0 <= n do
    coroutine.yield(false)
  end
  print(n)
  return true
end

coroutines = {}
for i=1, #arg do
  wrapped = coroutine.wrap(sleeprint)
  table.insert(coroutines, wrapped)
  wrapped(tonumber(arg[i]))
end

done = false
while not done do
  done = true
  for i=#coroutines,1,-1 do
    if coroutines[i]() then
      table.remove(coroutines, i)
    else
      done = false
    end
  end
end


SleepSort = RunScheduledTask[[email protected]#, {#, 1}] & /@ # &;
[email protected]{1, 9, 8, 7, 6, 5, 3, 4, 5, 2, 0};


/* NetRexx */
options replace format comments java crossref symbols nobinary
import java.util.concurrent.CountDownLatch

-- =============================================================================
class RSortingSleepsort
  properties constant private
    dflt = '-6 3 1 4 5 2 3 -7 1 6 001 3 -9 2 5 -009 -8 4 6 1 9 8 7 6 5 -7 3 4 5 2 0 -2 -1 -5 -4 -3 -0 000 0'
  properties indirect
    startLatch = CountDownLatch
    doneLatch  = CountDownLatch
    floor      = 0
    sorted     = ''
  -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  method main(args = String[]) public static
    arg = Rexx(args)
    if arg = '' then arg = dflt
    say ' unsorted:' arg
    say '   sorted:' (RSortingSleepsort()).sleepSort(arg)
    return
  -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  method sleepSort(iArg) public
    setStartLatch(CountDownLatch(1))           -- used to put all threads on hold until we're ready to run
    setDoneLatch(CountDownLatch(iArg.words())) -- used to indicate all work is done
    loop mn = 1 to iArg.words()
      setFloor(getFloor().min(iArg.word(mn)))   -- save smallest -ve number so we can use it as a scale for sleep
      Thread(SortThread(iArg.word(mn))).start() -- loop through input and create a thread for each element
      end mn
    getStartLatch().countDown() -- cry 'Havoc', and let slip the dogs of war.
    do
      getDoneLatch().await() -- wait for worker threads to complete
    catch ix = InterruptedException
      ix.printStackTrace()
    end
    return getSorted()

-- =============================================================================
class RSortingSleepsort.SortThread dependent implements Runnable
  properties indirect
    num
  -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  method SortThread(nm)
    setNum(nm)
    return
  -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  method run() public
    do
      parent.getStartLatch().await()                 -- wait until all threads are constructed
      sleepTime = getNum() + parent.getFloor().abs() -- shifted by value of smallest number (permits numbers < 0)
      sleepTime = sleepTime * 250                    -- scale up; milliseconds are not granular enough
      Thread.sleep(sleepTime)                        -- wait for this number's turn to run
    catch ie = InterruptedException
      ie.printStackTrace()
    end
    do protect parent -- lock the parent to prevent collisions
      parent.setSorted((parent.getSorted() num).strip()) -- stow the number in the results List
    end
    parent.getDoneLatch().countDown() -- this one's done; decrement the latch
    return


    public static void Sort<T>(List<T> list) where T : IComparable {
        if (list.Count > 1) {
            StoogeSort(list, 0, list.Count - 1);
        }
    }
    private static void StoogeSort<T>(List<T> L, int i, int j) where T : IComparable {
        if (L[j].CompareTo(L[i])<0) {
            T tmp = L[i];
            L[i] = L[j];
            L[j] = tmp;
        }
        if (j - i > 1) {
            int t = (j - i + 1) / 3;
            StoogeSort(L, i, j - t);
            StoogeSort(L, i + t, j);
            StoogeSort(L, i, j - t);
        }
    }


#!/usr/bin/env bash
main() {
  # Our ten males:
  local males=(abe bob col dan ed fred gav hal ian jon)

  # And ten females:
  local females=(abi bea cath dee eve fay gay hope ivy jan)

  # Everyone's preferences, ranked most to least desirable:
  local  abe=( abi  eve  cath ivy  jan  dee  fay  bea  hope gay )
  local  abi=( bob  fred jon  gav  ian  abe  dan  ed   col  hal )
  local  bea=( bob  abe  col  fred gav  dan  ian  ed   jon  hal )
  local  bob=(cath  hope abi  dee  eve  fay  bea  jan  ivy  gay )
  local cath=(fred  bob  ed   gav  hal  col  ian  abe  dan  jon )
  local  col=(hope  eve  abi  dee  bea  fay  ivy  gay  cath jan )
  local  dan=( ivy  fay  dee  gay  hope eve  jan  bea  cath abi )
  local  dee=(fred  jon  col  abe  ian  hal  gav  dan  bob  ed  )
  local   ed=( jan  dee  bea  cath fay  eve  abi  ivy  hope gay )
  local  eve=( jon  hal  fred dan  abe  gav  col  ed   ian  bob )
  local  fay=( bob  abe  ed   ian  jon  dan  fred gav  col  hal )
  local fred=( bea  abi  dee  gay  eve  ivy  cath jan  hope fay )
  local  gav=( gay  eve  ivy  bea  cath abi  dee  hope jan  fay )
  local  gay=( jon  gav  hal  fred bob  abe  col  ed   dan  ian )
  local  hal=( abi  eve  hope fay  ivy  cath jan  bea  gay  dee )
  local hope=( gav  jon  bob  abe  ian  dan  hal  ed   col  fred)
  local  ian=(hope  cath dee  gay  bea  abi  fay  ivy  jan  eve )
  local  ivy=( ian  col  hal  gav  fred bob  abe  ed   jon  dan )
  local  jan=( ed   hal  gav  abe  bob  jon  col  ian  fred dan )
  local  jon=( abi  fay  jan  gay  eve  bea  dee  cath ivy  hope)

  # A place to store the engagements:
  local -A engagements=()

  # Our list of free males, initially comprised of all of them:
  local freemales=( "${males[@]}" )

  # Now we use the Gale-Shapley algorithm to find a stable set of engagements

  # Loop over the free males. Note that we can't use for..in because the body
  # of the loop may modify the array we're looping over
  local -i m=0
  while (( m < ${#freemales[@]} )); do
    local male=${freemales[m]}
    let m+=1

    # This guy's preferences
    eval 'local his=("${'"$male"'[@]}")'

    # Starting with his favorite
    local -i f=0
    local female=${his[f]}

    # Find her preferences
    eval 'local hers=("${'"$female"'[@]}")'

    # And her current fiancé, if any
    local fiance=${engagements[$female]}

    # If she has a fiancé and prefers him to this guy, look for this guy's next
    # best choice
    while [[ -n $fiance ]] &&
      (( $(index "$male" "${hers[@]}") > $(index "$fiance" "${hers[@]}") )); do
      let f+=1
      female=${his[f]}
      eval 'hers=("${'"$female"'[@]}")'
      fiance=${engagements[$female]}
    done

    # If we're still on someone who's engaged, it means she prefers this guy
    # to her current fiancé. Dump him and put him at the end of the free list.
    if [[ -n $fiance ]]; then
      freemales+=("$fiance")
      printf '%-4s rejected %-4s\n' "$female" "$fiance"
    fi

    # We found a match! Record it
    engagements[$female]=$male
    printf '%-4s accepted %-4s\n' "$female" "$male"
  done

  # Display the final result, which should be stable
  print_couples engagements

  # Verify its stability
  print_stable engagements "${females[@]}"

  # Try a swap
  printf '\nWhat if cath and ivy swap partners?\n'
  local temp=${engagements[cath]}
  engagements[cath]=${engagements[ivy]}
  engagements[ivy]=$temp

  # Display the new result, which should be unstable
  print_couples engagements

  # Verify its instability
  print_stable engagements "${females[@]}"
}

# utility function - get index of an item in an array
index() {
  local needle=$1
  shift
  local haystack=("[email protected]")
  local -i i
  for i in "${!haystack[@]}"; do
    if [[ ${haystack[i]} == $needle ]]; then
      printf '%d\n' "$i"
      return 0
    fi
  done
  return 1
}

# print the couples from the engagement array; takes name of array as argument
print_couples() {
  printf '\nCouples:\n'
  local keys
  mapfile -t keys < <(eval 'printf '\''%s\n'\'' "${!'"$1"'[@]}"' | sort)
  local female
  for female in "${keys[@]}"; do
    eval 'local male=${'"$1"'["'"$female"'"]}'
    printf '%-4s is engaged to %-4s\n' "$female" "$male"
  done
  printf '\n'
}

# print whether a set of engagements is stable; takes name of engagement array
# followed by the list of females
print_stable() {
  if stable "[email protected]"; then
    printf 'These couples are stable.\n'
  else
    printf 'These couples are not stable.\n'
  fi
}

# determine if a set of engagements is stable; takes name of engagement array
# followed by the list of females
stable() {
  local dict=$1
  shift
  eval 'local shes=("${!'"$dict"'[@]}")'
  eval 'local hes=("${'"$dict"'[@]}")'
  local -i i
  local -i result=0
  for (( i=0; i<${#shes[@]}; ++i )); do
    local she=${shes[i]} he=${hes[i]}
    eval 'local his=("${'"$he"'[@]}")'
    local alt
    for alt in "[email protected]"; do
      eval 'local fiance=${'"$dict"'["'"$alt"'"]}'
      eval 'local hers=("${'"$alt"'[@]}")'
      if (( $(index "$she" "${his[@]}") > $(index "$alt" "${his[@]}")
         && $(index "$fiance" "${hers[@]}") > $(index "$he" "${hers[@]}") ))
       then
        printf '%-4s is engaged to %-4s but prefers %4s, ' "$he" "$she" "$alt"
        printf 'while %-4s is engaged to %-4s but prefers %4s.\n' "$alt" "$fiance" "$he"
        result=1
      fi
    done
  done
  if (( result )); then printf '\n'; fi
  return $result
}

main "[email protected]"


men =

{
   'abe': <'abi','eve','cath','ivy','jan','dee','fay','bea','hope','gay'>,
   'bob': <'cath','hope','abi','dee','eve','fay','bea','jan','ivy','gay'>,
   'col': <'hope','eve','abi','dee','bea','fay','ivy','gay','cath','jan'>,
   'dan': <'ivy','fay','dee','gay','hope','eve','jan','bea','cath','abi'>,
   'ed': <'jan','dee','bea','cath','fay','eve','abi','ivy','hope','gay'>,
   'fred': <'bea','abi','dee','gay','eve','ivy','cath','jan','hope','fay'>,
   'gav': <'gay','eve','ivy','bea','cath','abi','dee','hope','jan','fay'>,
   'hal': <'abi','eve','hope','fay','ivy','cath','jan','bea','gay','dee'>,
   'ian': <'hope','cath','dee','gay','bea','abi','fay','ivy','jan','eve'>,
   'jon': <'abi','fay','jan','gay','eve','bea','dee','cath','ivy','hope'>}

women =

{
   'abi': <'bob','fred','jon','gav','ian','abe','dan','ed','col','hal'>,
   'bea': <'bob','abe','col','fred','gav','dan','ian','ed','jon','hal'>,
   'cath': <'fred','bob','ed','gav','hal','col','ian','abe','dan','jon'>,
   'dee': <'fred','jon','col','abe','ian','hal','gav','dan','bob','ed'>,
   'eve': <'jon','hal','fred','dan','abe','gav','col','ed','ian','bob'>,
   'fay': <'bob','abe','ed','ian','jon','dan','fred','gav','col','hal'>,
   'gay': <'jon','gav','hal','fred','bob','abe','col','ed','dan','ian'>,
   'hope': <'gav','jon','bob','abe','ian','dan','hal','ed','col','fred'>,
   'ivy': <'ian','col','hal','gav','fred','bob','abe','ed','jon','dan'>,
   'jan': <'ed','hal','gav','abe','bob','jon','col','ian','fred','dan'>}

match = # finds a stable list of engagements from data as given above

-+
   ^=rrmhPnXS ^/~&l ^/~&rl ^|DlrHSs/~& ^TlK2hlPrSLPAS\~&r -+
      ~&lK2hlPrSXS,
      *=rnmihBPK12D ~&mmhPnXNCB^rnPrmPllSPcA\~&r ~&[email protected]+-,
   ^|rrPlrlPXX/~& ^/~&nNAS ^/~&l+ ^|H\~&+ -:+ * ^|/~& -<+ \/-=+ ~&[email protected]+-

preferred = # finds non-couples that would prefer each other to their betrothed

~&lSLPrSLrlXS2c^|DlrHS\~& ~~irlXX+ ^D/~&l+ ^|H\~&+ -:+ *T ^|/~& //~=;+ -~l;+ \/~&H

#cast %sWLm

main = # stable, perturbed, and preferred alternatives to the perturbed

<
   'stable': match/men women,
   'perturbed': ~&lSrSxPp match/men women,
   'preferred': preferred/(men,women) ~&lSrSxPp match/men women>


proc merge {listVar toMerge} {
    upvar 1 $listVar v
    set i [set j 0]
    set out {}
    while {$i<[llength $v] && $j<[llength $toMerge]} {
	if {[set a [lindex $v $i]] < [set b [lindex $toMerge $j]]} {
	    lappend out $a
	    incr i
	} else {
	    lappend out $b
	    incr j
	}
    }
    # Done the merge, but will be one source with something left
    # This will handle all that by doing a merge of the remnants onto the end
    set v [concat $out [lrange $v $i end] [lrange $toMerge $j end]]
    return
}

proc strandSort A {
    set results {}
    while {[llength $A]} {
	set sublist [lrange $A 0 0]
	# We build a list of items that weren't filtered rather than removing "in place"
	# because this fits better with the way Tcl values work (the underlying data
	# structure is an array, not a linked list).
	set newA {}
	foreach a [lrange $A 1 end] {
	    if {$a > [lindex $sublist end]} {
		lappend sublist $a
	    } else {
		lappend newA $a
	    }
	}
	set A $newA
	merge results $sublist
    }
    return $results
}

puts [strandSort {3 1 5 4 2}]


strand_sort "r" =  # parameterized by a relational predicate "r"

@NiX -+
   :-0 ~&B^?a\~&[email protected] "r"?abh/~&alh2faltPrXPRC ~&arh2falrtPXPRC,
   ~&r->l ^|rlPlCrrPX/~& @hNCNXtX ~&r->lbx "r"?rllPXh/~&llPrhPlrPCXrtPX ~&rhPllPClrPXrtPX+-


import os, strutils

proc single(n: int) =
  sleep n
  echo n

proc main =
  var thr = newSeq[TThread[int]](paramCount())
  for i,c in commandLineParams():
    thr[i].createThread(single, c.parseInt)
  thr.joinThreads

main()


use System.Concurrency;
use Collection;

bundle Default {
  class Item from Thread {
    @value : Int;

    New(value : Int) {
      Parent();
      @value := value;
    }

    method : public : Run(param : System.Base) ~ Nil {
      Sleep(1000 * @value);
      @value->PrintLine();
    }
  }

  class SleepSort {
    function : Main(args : String[]) ~ Nil {
      items := Vector->New();
      each(i : args) {
        items->AddBack(Item->New(args[i]->ToInt()));
      };

      each(i : items) {
        items->Get(i)->As(Item)->Execute(Nil);
      };
    }
  }
}


#import <Foundation/Foundation.h>

int main(int argc, char **argv)
{
    NSOperationQueue *queue = [[NSOperationQueue alloc] init];
    while (--argc) {
        int i = atoi(argv[argc]);
        [queue addOperationWithBlock: ^{
            sleep(i);
            NSLog(@"%d\n", i);
        }];
    }
    [queue waitUntilAllOperationsAreFinished];
}


(defn swap [v x y]
   (assoc! v y (v x) x (v y)))

(defn stooge-sort
  ([v] (persistent! (stooge-sort (transient v) 0 (dec (count v)))))
  ([v i j]
    (if (> (v i) (v j)) (swap v i j) v)
    (if (> (- j i) 1)
      (let [t (int (Math/floor (/ (inc (- j i)) 3)))]
        (stooge-sort v i (- j t))
        (stooge-sort v (+ i t) j)
        (stooge-sort v i (- j t))))
    v))


       >>SOURCE FREE
IDENTIFICATION DIVISION.
PROGRAM-ID. stooge-sort-test.

DATA DIVISION.
WORKING-STORAGE SECTION.
01  Arr-Len                             CONSTANT 7.

01  arr-area                            VALUE "00004001000020000005000230000000000".
    03  arr-elt                         PIC 9(5) OCCURS Arr-Len TIMES
                                        INDEXED BY arr-idx.

PROCEDURE DIVISION.
    DISPLAY "Unsorted: " NO ADVANCING
    PERFORM VARYING arr-idx FROM 1 BY 1 UNTIL Arr-Len < arr-idx
        DISPLAY arr-elt (arr-idx) " " NO ADVANCING
    END-PERFORM
    DISPLAY SPACE

    CALL "stooge-sort" USING arr-area, OMITTED, OMITTED

    DISPLAY "Sorted:   " NO ADVANCING
    PERFORM VARYING arr-idx FROM 1 BY 1 UNTIL Arr-Len < arr-idx
        DISPLAY arr-elt (arr-idx) " " NO ADVANCING
    END-PERFORM
    DISPLAY SPACE
    .
END PROGRAM stooge-sort-test.

IDENTIFICATION DIVISION.
PROGRAM-ID. stooge-sort RECURSIVE.

DATA DIVISION.
LOCAL-STORAGE SECTION.
01  Arr-Len                             CONSTANT 7.

01  i                                   PIC 99 COMP.
01  j                                   PIC 99 COMP.

01  temp                                PIC 9(5).

01  t                                   PIC 99 COMP.

LINKAGE SECTION.
01  arr-area.
    03  arr-elt                         PIC 9(5) OCCURS Arr-Len TIMES.

01  i-val                               PIC 99 COMP.
01  j-val                               PIC 99 COMP.

PROCEDURE DIVISION USING arr-area, OPTIONAL i-val, OPTIONAL j-val.
    IF i-val IS OMITTED
        MOVE 1 TO i
    ELSE
        MOVE i-val TO i
    END-IF
    IF j-val IS OMITTED
        MOVE Arr-Len TO j
    ELSE
        MOVE j-val TO j
    END-IF

    IF arr-elt (j) < arr-elt (i)
        MOVE arr-elt (i) TO temp
        MOVE arr-elt (j) TO arr-elt (i)
        MOVE temp TO arr-elt (j)
    END-IF

    IF j - i + 1 >= 3
        COMPUTE t = (j - i + 1) / 3
        SUBTRACT t FROM j
        CALL "stooge-sort" USING arr-area, CONTENT i, j
        ADD t TO i, j
        CALL "stooge-sort" USING arr-area, CONTENT i, j
        SUBTRACT t FROM i, j
        CALL "stooge-sort" USING arr-area, CONTENT i, j
    END-IF
    .
END PROGRAM stooge-sort.


2 methods will be shown here:
1 - using basic VBA-features for strings
2 - using the scripting.dictionary library


var merge = Fn.new { |left, right|
    var res = []
    while (!left.isEmpty && !right.isEmpty) {
        if (left[0] <= right[0]) {
            res.add(left[0])
            left.removeAt(0)
        } else {
            res.add(right[0])
            right.removeAt(0)
        }
    }
    res.addAll(left)
    res.addAll(right)
    return res
}

var strandSort = Fn.new { |a|
    var list = a.toList
    var res = []
    while (!list.isEmpty) {
        var sorted = [list[0]]
        list.removeAt(0)
        var leftover = []
        for (item in list) {
            if (sorted[-1] <= item) {
                sorted.add(item)
            } else {
                leftover.add(item)
            }
        }
        res = merge.call(sorted, res)
        list = leftover
    }
    return res
}

var a = [-2, 0, -2, 5, 5, 3, -1, -3, 5, 5, 0, 2, -4, 4, 2]
System.print("Unsorted: %(a)")
a = strandSort.call(a)
System.print("Sorted  : %(a)")


fcn strandSort(A){ //--> new list, A is cleared, should add A=A.copy()
   sublist:=List.createLong(A.len()); results:=List.createLong(A.len());
   while(A){
      sublist.clear(A.pop(0));
      foreach i in (A.len() - 1){
	 if(A[i]>sublist[-1]) sublist.append(A.pop(i));
      }
      results.merge(sublist);
   }
   results
}


import: parallel

: sleepSort(l)
| ch n |
   Channel new ->ch
   l forEach: n [ #[ n dup 20 * sleep ch send drop ] & ]
   ListBuffer newSize(l size) #[ ch receive over add ] times(l size) ;


(define (sleep-sort lst)
   (for-each (lambda (timeout)
         (async (lambda ()
            (sleep timeout)
            (print timeout))))
      lst))

(sleep-sort '(5 8 2 7 9 10 5))


program sleepsort;
{$IFDEF FPC}
  {$MODE DELPHI} {$Optimization ON,ALL}
{$ElSE}
  {$APPTYPE CONSOLE}
{$ENDIF}
uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  SysUtils;

const
  HiLimit = 40;
type
  tCombineForOneThread = record
    cft_count : Uint64;
    cft_ThreadID: NativeUint;
    cft_ThreadHandle: NativeUint;
  end;
  pThreadBlock = ^tCombineForOneThread;
var
  SortIdx : array of INteger;
  ThreadBlocks : array of tCombineForOneThread;
  gblThreadCount,
  Finished: Uint32;

  procedure PrepareThreads(thdCount:NativeInt);
  var
    i : NativeInt;
  Begin
    For i := 0 to thdCount-1 do
      ThreadBlocks[i].cft_count:= random(2*HiLimit);
  end;

  procedure TestRunThd(parameter: pointer);
  var
     pThdBlk: pThreadBlock;
     fi: NativeInt;
  begin
    pThdBlk := @ThreadBlocks[NativeUint(parameter)];
    with pThdBlk^ do
    begin
      sleep(40*cft_count+1);
      fi := Finished-1;
      //write(fi:5,cft_count:8,#13);
      InterLockedDecrement(Finished);
      SortIdx[fi]:= NativeUint(parameter);
    end;
    EndThread(0);
  end;

  procedure Test;
  var
    j,UsedThreads: NativeInt;
  begin
    randomize;
    UsedThreads:= GblThreadCount;
    Finished :=UsedThreads;
    PrepareThreads(UsedThreads);
    j := 0;
    while (j < UsedThreads) do
    begin
      with ThreadBlocks[j] do
        begin
          cft_ThreadHandle :=
          BeginThread(@TestRunThd, Pointer(j), cft_ThreadID,16384 {stacksize} );
          If cft_ThreadHandle = 0 then break;
        end;
      Inc(j);
    end;
    writeln(j);
    UsedThreads := j;
    Finished :=UsedThreads;
    repeat
      sleep(1);
    until finished = 0;
    For j := 0 to  UsedThreads-1 do
      CloseThread(ThreadBlocks[j].cft_ThreadID);

    //output of sleep-sorted data
    For j := UsedThreads-1 downto 1 do
      write(ThreadBlocks[SortIdx[j]].cft_count,',');
    writeln(ThreadBlocks[SortIdx[0]].cft_count);
  end;

begin
  randomize;
  gblThreadCount := Hilimit;
  Writeln('Testthreads : ',gblThreadCount);
  setlength(ThreadBlocks,gblThreadCount);
  setlength(SortIdx,gblThreadCount);
  Test;

  setlength(ThreadBlocks, 0);
  {$IFDEF WINDOWS}
  readln;
  {$ENDIF}
end.


(defun stooge-sort (vector &optional (i 0) (j (1- (length vector))))
  (when (> (aref vector i) (aref vector j))
    (rotatef (aref vector i) (aref vector j)))
  (when (> (- j i) 1)
    (let ((third (floor (1+ (- j i)) 3)))
      (stooge-sort vector i (- j third))
      (stooge-sort vector (+ i third) j)
      (stooge-sort vector i (- j third))))
  vector)


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

void stoogeSort(T)(T[] seq) pure nothrow {
    if (seq.back < seq.front)
        swap(seq.front, seq.back);

    if (seq.length > 2) {
        immutable m = seq.length / 3;
        seq[0 .. $ - m].stoogeSort();
        seq[m .. $].stoogeSort();
        seq[0 .. $ - m].stoogeSort();
    }
}

void main() {
    auto data = [1, 4, 5, 3, -6, 3, 7, 10, -2, -5];
    data.stoogeSort();
    writeln(data);
}


F shell_sort(&seq)
   V inc = seq.len I/ 2
   L inc != 0
      L(el) seq[inc..]
         V i = L.index + inc
         L i >= inc & seq[i - inc] > el
            seq[i] = seq[i - inc]
            i -= inc
         seq[i] = el
      inc = I inc == 2 {1} E inc * 5 I/ 11

V data = [22, 7, 2, -5, 8, 4]
shell_sort(&data)
print(data)


<xsl:stylesheet version="2.0"
  xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
  xmlns:fn="http://www.w3.org/2005/xpath-functions"
  xmlns:xs="http://www.w3.org/2001/XMLSchema"
  xmlns:m="http://rosettacode.org/wiki/Stable_marriage_problem"
  xmlns:t="http://rosettacode.org/wiki/Stable_marriage_problem/temp"
  exclude-result-prefixes="xsl xs fn t m">
<xsl:output indent="yes" encoding="UTF-8" omit-xml-declaration="yes" />
<xsl:strip-space elements="*" />

<xsl:template match="*">
  <xsl:copy>
    <xsl:apply-templates select="@*,node()" />
  </xsl:copy>
</xsl:template>

<xsl:template match="@*|comment()|processing-instruction()">
  <xsl:copy />
</xsl:template>

<xsl:template match="m:interest" mode="match-making">
  <m:engagement>
    <m:dude name="{../@name}" /><m:maid name="{.}" />
  </m:engagement>
</xsl:template>

<xsl:template match="m:dude" mode="match-making">
  <!-- 3. Reject suitors cross-off the maids that spurned them. -->
  <xsl:param name="eliminations" select="()" />
  <m:dude name="{@name}">
	<xsl:copy-of select="for $b in @name return
	  m:interest[not(. = $eliminations[m:dude/@name=$b]/m:maid/@name)]" />
  </m:dude>
</xsl:template>

<xsl:template match="*" mode="perturbation">
  <xsl:copy>
    <xsl:apply-templates select="@*,node()" mode="perturbation"/>
  </xsl:copy>
</xsl:template>

<xsl:template match="@*" mode="perturbation">
  <xsl:copy />
</xsl:template>

<xsl:template match="m:engagement[position() lt 3]/m:maid/@name" mode="perturbation">
  <!-- Swap maids 1 and 2. -->
  <xsl:copy-of select="for $c in count(../../preceding-sibling::m:engagement)
       return ../../../m:engagement[2 - $c]/m:maid/@name" />
</xsl:template>

<xsl:template match="m:stable-marriage-problem">
  <xsl:variable name="population" select="m:dude|m:maid" />
  <xsl:variable name="solution">
    <xsl:call-template name="solve-it">
      <xsl:with-param name="dudes" select="m:dude" />
      <xsl:with-param name="maids" select="m:maid" tunnel="yes" />
    </xsl:call-template>
  </xsl:variable>
  <xsl:variable name="perturbed">
   <xsl:apply-templates select="$solution/*" mode="perturbation" />
  </xsl:variable>
  <m:stable-marriage-problem-result>
    <m:solution is-stable="{t:is-stable( $population, $solution/*)}">
	  <xsl:copy-of select="$solution/*" />
    </m:solution>
	<m:message>Perturbing the matches! Swapping <xsl:value-of select="$solution/*[1]/m:maid/@name" /> for <xsl:value-of select="$solution/*[2]/m:maid/@name" /></m:message>
	<m:message><xsl:choose>
	  <xsl:when test="t:is-stable( $population, $perturbed/*)">
	    <xsl:text>The perturbed configuration is stable.</xsl:text>
	  </xsl:when>
	    <xsl:otherwise>The perturbed configuration is unstable.</xsl:otherwise>
	</xsl:choose></m:message>
  </m:stable-marriage-problem-result>
</xsl:template>

<xsl:template name="solve-it">
  <xsl:param name="dudes" as="element()*" /> <!-- Sequence of m:dude -->
  <xsl:param name="maids" as="element()*" tunnel="yes" />  <!-- Sequence of m:maid -->
  <xsl:param name="engagements" as="element()*" select="()" /> <!-- Sequence of m:engagement -->

  <!-- 1. For each dude not yet engaged, and has a preference, propose to his top preference. -->
  <xsl:variable name="fresh-proposals">
    <xsl:apply-templates select="$dudes[not(@name = $engagements/m:dude/@name)]/m:interest[1]" mode="match-making" />
  </xsl:variable>
  <xsl:variable name="proposals" select="$engagements | $fresh-proposals/m:engagement" />

  <!-- 2. For each maid with conflicting suitors, reject all but the most attractive (for her) proposal. -->
  <xsl:variable name="acceptable" select="$proposals[
    for $g in m:maid/@name, $b in m:dude/@name, $this-interest in $maids[@name=$g]/m:interest[.=$b]
	  return every
	      $interest
		in
		  for $other-b in $proposals[m:maid[@name=$g]]/m:dude/@name[. ne $b]
		    return $maids[@name=$g]/m:interest[.=$other-b]
		satisfies
		  $interest >> $this-interest
    ]" />

  <!-- 3. Reject suitors cross-off the maids that spurned them. -->
  <xsl:variable name="new-dudes">
    <xsl:apply-templates select="$dudes" mode="match-making">
      <xsl:with-param name="eliminations" select="$fresh-proposals/m:engagement" />
    </xsl:apply-templates>
  </xsl:variable>

  <!-- 4. Test for finish. If not, loop back for another round of proposals. -->
  <xsl:choose>
    <xsl:when test="$dudes[not(for $b in @name return $acceptable[m:dude/@name=$b])]">
  	  <xsl:call-template name="solve-it">
        <xsl:with-param name="dudes" select="$new-dudes/m:dude" />
        <xsl:with-param name="engagements" select="$acceptable" />
	  </xsl:call-template>
    </xsl:when>
	<xsl:otherwise>
      <xsl:copy-of select="$acceptable" />
	</xsl:otherwise>
  </xsl:choose>
</xsl:template>

<xsl:function name="t:is-stable" as="xs:boolean">
  <xsl:param name="population" as="element()*" />
  <xsl:param name="engagements" as="element()*" />
  <xsl:sequence select="
    every $e in $engagements,
	      $b in string($e/m:dude/@name), $g in string($e/m:maid/@name),
		  $desired-g in $population/self::m:dude[@name=$b]/m:interest[$g=following-sibling::m:interest],
		  $desired-maid in $population/self::m:maid[@name=$desired-g]
	  satisfies
          not(
		    $desired-maid/m:interest[.=$b] <<
		    $desired-maid/m:interest[.=$engagements[m:maid[@name=$desired-g]]/m:dude/@name])
  " />
</xsl:function>

</xsl:stylesheet>


var
   Boys=Dictionary(
      "abe", "abi eve cath ivy jan dee fay bea hope gay".split(),
      "bob", "cath hope abi dee eve fay bea jan ivy gay".split(),
      "col", "hope eve abi dee bea fay ivy gay cath jan".split(),
      "dan", "ivy fay dee gay hope eve jan bea cath abi".split(),
      "ed",  "jan dee bea cath fay eve abi ivy hope gay".split(),
      "fred","bea abi dee gay eve ivy cath jan hope fay".split(),
      "gav", "gay eve ivy bea cath abi dee hope jan fay".split(),
      "hal", "abi eve hope fay ivy cath jan bea gay dee".split(),
      "ian", "hope cath dee gay bea abi fay ivy jan eve".split(),
      "jon", "abi fay jan gay eve bea dee cath ivy hope".split(), ),
   Girls=Dictionary(
      "abi", "bob fred jon gav ian abe dan ed col hal".split(),
      "bea", "bob abe col fred gav dan ian ed jon hal".split(),
      "cath","fred bob ed gav hal col ian abe dan jon".split(),
      "dee", "fred jon col abe ian hal gav dan bob ed".split(),
      "eve", "jon hal fred dan abe gav col ed ian bob".split(),
      "fay", "bob abe ed ian jon dan fred gav col hal".split(),
      "gay", "jon gav hal fred bob abe col ed dan ian".split(),
      "hope","gav jon bob abe ian dan hal ed col fred".split(),
      "ivy", "ian col hal gav fred bob abe ed jon dan".split(),
      "jan", "ed hal gav abe bob jon col ian fred dan".split(), ),
   Couples=List();  // ( (boy,girl),(boy,girl),...)

Boyz:=Boys.pump(Dictionary(),fcn([(b,gs)]){ return(b,gs.copy()) }); // make writable copy
while( bgs:=Boyz.filter1( 'wrap([(Boy,gs)]){ // while unattached boy
             gs and (not Couples.filter1("holds",Boy))
     }) )
{
   Boy,Girl:=bgs; Girl=Girl.pop(0);
   Pair:=Couples.filter1("holds",Girl);  // is Girl part of a couple?
   if(not Pair) Couples.append(List(Boy,Girl));	# no, Girl was free
   else{			  // yes, Girl is engaged to Pair[0]
      bsf,nBoy,nB:=Girls[Girl].index, bsf(Boy),bsf(Pair[0]);
      if(nBoy<nB) Pair[0]=Boy;		# Girl prefers Boy, change Couples
   }
}
foreach Boy,Girl in (Couples){ println(Girl," is engaged to ",Boy) }

fcn checkCouples(Couples){
   Couples.filter(fcn([(Boy,Girl)]){
      Girls[Girl].filter1('wrap(B){
         // is B before Boy in Girls preferences?
         bsf,nBoy,nB:=Girls[Girl].index, bsf(Boy),bsf(B);
	 // Does B prefer Girl (over his partner)?
	 _,G:=Couples.filter1("holds",B); // (B,G)
	 gsf,nGirl,nG:=Boys[B].index, gsf(Girl),gsf(G);
	 ( nB<nBoy and nGirl<nG and
	    println(Girl," likes ",B," better than ",Boy," and ",
                    B," likes ",Girl," better than ",G) )
      })
   }) or println("All marriages are stable");
}

checkCouples(Couples);
println();

println("Engage fred with abi and jon with bea");
Couples.filter1("holds","fred")[1]="abi";
Couples.filter1("holds","jon") [1]="bea";
checkCouples(Couples);


1 while ($_ = shift and @ARGV and !fork);
sleep $_;
print "$_\n";
wait;


without js -- (multitasking)
integer count

procedure sleeper(integer key)
    ? key -- (or maybe res &= key)
    count -= 1
end procedure

--sequence s = command_line()[3..$]
sequence s = split("3 1 4 1 5 9 2 6 5")
if length(s)=0 then
    puts(1,"Nothing to sort.\n")
else
    count = 0
    for i=1 to length(s) do
        object si = to_number(s[i])
        if integer(si) then
            atom task = task_create(sleeper,{si})
            task_schedule(task,{si/10,si/10})
            count += 1
        end if
    end for

    while count do
        task_yield()
    end while
end if


(de sleepSort (Lst)
   (make
      (for (I . N) Lst
         (task (- I) (* N 100)  N N  I I
            (link N)
            (pop 'Lst)
            (task (- I)) ) )
      (wait NIL (not Lst)) ) )


#!/usr/bin/env pike

int main(int argc, array(string) argv)
{
        foreach(argv[1..], string value)
        {
                int v = (int)value;
                if(v<0)
                        continue;
                call_out(print, v, value);
        }
        return -1;
}

void print(string value)
{
        write("%s\n", value);
        if(find_call_out(print)==-1)
                exit(0);
        return;
}


use AppleScript version "2.4"
use framework "Foundation"
use scripting additions

on run
    unlines(map(¬
        compose(compose(unlines, sparkLine), readFloats), ¬
        {"0, 1, 19, 20", "0, 999, 4000, 4999, 7000, 7999", ¬
            "0, 1000, 4000, 5000, 7000, 8000", ¬
            "1 2 3 4 5 6 7 8 7 6 5 4 3 2 1", ¬
            "1.5, 0.5 3.5, 2.5 5.5, 4.5 7.5, 6.5"}))
end run

-- sparkLine :: [Float] -> [String]
on sparkLine(xs)
    set ys to sort(xs)
    set mn to item 1 of ys
    set mx to item -1 of ys
    set n to length of xs
    set mid to (n div 2)
    set w to (mx - mn) / 8

    script bound
        on |λ|(x)
            mn + (w * x)
        end |λ|
    end script
    set lbounds to map(bound, enumFromTo(1, 7))

    script spark
        on |λ|(x)
            script flipGT
                on |λ|(b)
                    b > x
                end |λ|
            end script
            script indexedBlock
                on |λ|(i)
                    item i of "▁▂▃▄▅▆▇"
                end |λ|
            end script
            maybe("█", indexedBlock, findIndex(flipGT, lbounds))
        end |λ|
    end script

    script str
        on |λ|(x)
            x as string
        end |λ|
    end script

    {concat(map(spark, xs)), ¬
        unwords(map(str, xs)), ¬
        "Min " & mn as string, ¬
        "Mean " & roundTo(mean(xs), 2) as string, ¬
        "Median " & bool(item mid of xs, ((item mid of xs) + ¬
        (item (mid + 1) of xs)) / 2, even(n)), ¬
        "Max " & mx as string, ""}
end sparkLine

-- GENERIC -------------------------------------------------

-- Just :: a -> Maybe a
on Just(x)
    {type:"Maybe", Nothing:false, Just:x}
end Just

-- Nothing :: Maybe a
on Nothing()
    {type:"Maybe", Nothing:true}
end Nothing

-- bool :: a -> a -> Bool -> a
on bool(f, t, p)
    if p then
        t
    else
        f
    end if
end bool

-- compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
on compose(f, g)
    script
        property mf : mReturn(f)
        property mg : mReturn(g)
        on |λ|(x)
            mf's |λ|(mg's |λ|(x))
        end |λ|
    end script
end compose

-- concat :: [[a]] -> [a]
-- concat :: [String] -> String
on concat(xs)
    set lng to length of xs
    if 0 < lng and string is class of (item 1 of xs) then
        set acc to ""
    else
        set acc to {}
    end if
    repeat with i from 1 to lng
        set acc to acc & item i of xs
    end repeat
    acc
end concat

-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
    if m ≤ n then
        set lst to {}
        repeat with i from m to n
            set end of lst to i
        end repeat
        return lst
    else
        return {}
    end if
end enumFromTo

-- even :: Int -> Bool
on even(x)
    0 = x mod 2
end even

-- Takes a predicate function and a list and
-- returns Just( the 1-based index of the first
-- element ) in the list satisfying the predicate
-- or Nothing if there is no such element.
-- findIndex(isSpace, "hello world")
--> {type:"Maybe", Nothing:false, Just:6}

-- findIndex(even, [3, 5, 7, 8, 9])
--> {type:"Maybe", Nothing:false, Just:4}

-- findIndex(isUpper, "all lower case")
--> {type:"Maybe", Nothing:true}
-- findIndex :: (a -> Bool) -> [a] -> Maybe Int
on findIndex(p, xs)
    tell mReturn(p)
        set lng to length of xs
        repeat with i from 1 to lng
            if |λ|(item i of xs) then return Just(i)
        end repeat
        return Nothing()
    end tell
end findIndex

-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldl

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map

-- mean :: [Num] -> Num
on mean(xs)
    script
        on |λ|(a, x)
            a + x
        end |λ|
    end script
    foldl(result, 0, xs) / (length of xs)
end mean

-- | The 'maybe' function takes a default value, a function, and a 'Maybe'
-- value.  If the 'Maybe' value is 'Nothing', the function returns the
-- default value.  Otherwise, it applies the function to the value inside
-- the 'Just' and returns the result.
-- maybe :: b -> (a -> b) -> Maybe a -> b
on maybe(v, f, mb)
    if Nothing of mb then
        v
    else
        tell mReturn(f) to |λ|(Just of mb)
    end if
end maybe

-- Lift 2nd class handler function into 1s class script wrapper
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    if script is class of f then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- readFloats :: String -> [Float]
on readFloats(s)
    script asReal
        on |λ|(n)
            n as real
        end |λ|
    end script
    map(asReal, splitRegex("[\\s,]+", s))
end readFloats

-- regexMatches :: String -> String -> [[String]]
on regexMatches(strRegex, strHay)
    set ca to current application
    -- NSNotFound handling and and High Sierra workaround due to @sl1974
    set NSNotFound to a reference to 9.22337203685477E+18 + 5807
    set oRgx to ca's NSRegularExpression's regularExpressionWithPattern:strRegex ¬
        options:((ca's NSRegularExpressionAnchorsMatchLines as integer)) ¬
        |error|:(missing value)
    set oString to ca's NSString's stringWithString:strHay

    script matchString
        on |λ|(m)
            script rangeMatched
                on |λ|(i)
                    tell (m's rangeAtIndex:i)
                        set intFrom to its location
                        if NSNotFound ≠ intFrom then
                            text (intFrom + 1) thru (intFrom + (its |length|)) of strHay
                        else
                            missing value
                        end if
                    end tell
                end |λ|
            end script
        end |λ|
    end script

    script asRange
        on |λ|(x)
            range() of x
        end |λ|
    end script
    map(asRange, (oRgx's matchesInString:oString ¬
        options:0 range:{location:0, |length|:oString's |length|()}) as list)
end regexMatches

-- roundTo :: Float -> Int -> Float
on roundTo(x, n)
    set d to 10 ^ n
    (round (x * d)) / d
end roundTo

-- sort :: Ord a => [a] -> [a]
on sort(xs)
    ((current application's NSArray's arrayWithArray:xs)'s ¬
        sortedArrayUsingSelector:"compare:") as list
end sort

-- splitRegex :: Regex -> String -> [String]
on splitRegex(strRegex, str)
    set lstMatches to regexMatches(strRegex, str)
    if length of lstMatches > 0 then
        script preceding
            on |λ|(a, x)
                set iFrom to start of a
                set iLocn to (location of x)

                if iLocn > iFrom then
                    set strPart to text (iFrom + 1) thru iLocn of str
                else
                    set strPart to ""
                end if
                {parts:parts of a & strPart, start:iLocn + (length of x) - 1}
            end |λ|
        end script

        set recLast to foldl(preceding, {parts:[], start:0}, lstMatches)

        set iFinal to start of recLast
        if iFinal < length of str then
            parts of recLast & text (iFinal + 1) thru -1 of str
        else
            parts of recLast & ""
        end if
    else
        {str}
    end if
end splitRegex

-- unlines :: [String] -> String
on unlines(xs)
    set {dlm, my text item delimiters} to ¬
        {my text item delimiters, linefeed}
    set str to xs as text
    set my text item delimiters to dlm
    str
end unlines

-- unwords :: [String] -> String
on unwords(xs)
    set {dlm, my text item delimiters} to ¬
        {my text item delimiters, space}
    set s to xs as text
    set my text item delimiters to dlm
    return s
end unwords


class
	STOOGE_SORT
feature
	stoogesort (ar: ARRAY[INTEGER]; i,j: INTEGER)
                -- Sorted array in ascending order.
	require
		ar_not_empty: ar.count >= 0
		i_in_range: i>=1
		j_in_range: j <= ar.count
		boundary_set: i<=j
	local
		t: REAL_64
		third: INTEGER
		swap: INTEGER
	do
		if ar[j]< ar[i] then
			swap:= ar[i]
			ar[i]:=ar[j]
			ar[j]:= swap
		end
		if j-i >1 then
			t:= (j-i+1)/3
			third:= t.floor
			stoogesort(ar, i, j-third)
			stoogesort(ar, i+third, j)
			stoogesort(ar, i, j-third)
		end
	end
end


import extensions;
import system'routines;

extension op
{
    stoogeSort()
        = self.stoogeSort(0, self.Length - 1);

    stoogeSort(IntNumber i, IntNumber j)
    {
        if(self[j]<self[i])
        {
            self.exchange(i,j)
        };
        if (j - i > 1)
        {
            int t := (j - i + 1) / 3;
            self.stoogeSort(i,j-t);
            self.stoogeSort(i+t,j);
            self.stoogeSort(i,j-t)
        }
    }
}

public program()
{
    var list := new Range(0, 15).selectBy:(n => randomGenerator.eval(20)).toArray();

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


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

  defp stooge_sort(tuple, i, j) do
    if (vj = elem(tuple, j)) < (vi = elem(tuple, i)) do
      tuple = put_elem(tuple,i,vj) |> put_elem(j,vi)
    end
    if j - i > 1 do
      t = div(j - i + 1, 3)
      tuple
      |> stooge_sort(i, j-t)
      |> stooge_sort(i+t, j)
      |> stooge_sort(i, j-t)
    else
      tuple
    end
  end
end

(for _ <- 1..20, do: :rand.uniform(20)) |> IO.inspect
|> Sort.stooge_sort |> IO.inspect


*        Shell sort                24/06/2016
SHELLSRT CSECT
         USING  SHELLSRT,R13       base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    prolog
         ST     R13,4(R15)         "
         ST     R15,8(R13)         "
         LR     R13,R15            "
         L      RK,N               incr=n
         SRA    RK,1               incr=n/2
         DO WHILE=(LTR,RK,P,RK)    do while(incr>0)
         LA     RI,1(RK)             i=1+incr
         DO WHILE=(C,RI,LE,N)        do i=1+incr to n
         LR     RJ,RI                  j=i
         LR     R1,RI                  i
         SLA    R1,2                   .
         L      RT,A-4(R1)             temp=a(i)
         LR     R2,RK                  incr
         LA     R2,1(R2)               r2=incr+1
         LR     R3,RJ                  j
         SR     R3,RK                  j-incr
         SLA    R3,2                   *.
         LA     R3,A-4(R3)             [email protected](j-incr)
         LR     R4,RK                  incr
         SLA    R4,2                   r4=incr*4
         LR     R5,RJ                  j
         SLA    R5,2                   .
         LA     R5,A-4(R5)             @a(j)
*        do while j-incr>=1 and a(j-incr)>temp
         DO WHILE=(CR,RJ,GE,R2,AND,C,RT,LT,0(R3))
         L      R0,0(R3)                 a(j-incr)
         ST     R0,0(R5)                 a(j)=a(j-incr)
         SR     RJ,RK                    j=j-incr
         LR     R5,R3                    @a(j)
         SR     R3,R4                    @a(j-incr)[email protected](j-incr)-incr*4
         ENDDO  ,                      end do
         ST     RT,0(R5)               a(j)=temp
         LA     RI,1(RI)               i=i+1
         ENDDO  ,                    end do
         IF     C,RK,EQ,=F'2'        if incr=2
         LA     RK,1                   incr=1
         ELSE   ,                    else
         LR     R5,RK                  incr
         M      R4,=F'5'               *5
         D      R4,=F'11'              /11
         LR     RK,R5                  incr=incr*5/11
         ENDIF  ,                    end if
         ENDDO  ,                  end do
         LA     R3,PG              pgi=0
         LA     RI,1               i=1
         DO     WHILE=(C,RI,LE,N)  do i=1 to n
         LR     R1,RI                i
         SLA    R1,2                 .
         L      R2,A-4(R1)           a(i)
         XDECO  R2,XDEC              edit a(i)
         MVC    0(4,R3),XDEC+8       output a(i)
         LA     R3,4(R3)             pgi=pgi+4
         LA     RI,1(RI)             i=i+1
         ENDDO  ,                  end do
         XPRNT  PG,L'PG            print buffer
         L      R13,4(0,R13)       epilog
         LM     R14,R12,12(R13)    "
         XR     R15,R15            "
         BR     R14                exit
A     DC F'4',F'65',F'2',F'-31',F'0',F'99',F'2',F'83',F'782',F'1'
      DC F'45',F'82',F'69',F'82',F'104',F'58',F'88',F'112',F'89',F'74'
N        DC     A((N-A)/L'A)       number of items of a
PG       DC     CL80' '            buffer
XDEC     DS     CL12               temp for xdeco
         YREGS
RI       EQU    6                  i
RJ       EQU    7                  j
RK       EQU    8                  incr
RT       EQU    9                  temp
         END    SHELLSRT


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

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

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

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

1:
    ldr x0,qAdrTableNumber                        // address number table
    mov x1,0                                      // not use in routine
    mov x2,NBELEMENTS                             // number of élements
    bl shellSort
    ldr x0,qAdrTableNumber                        // address number table
    bl displayTable

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

qAdrsZoneConv:            .quad sZoneConv
qAdrszCarriageReturn:     .quad szCarriageReturn
qAdrsMessResult:          .quad sMessResult
qAdrTableNumber:          .quad TableNumber
qAdrszMessSortOk:         .quad szMessSortOk
qAdrszMessSortNok:        .quad szMessSortNok
/******************************************************************/
/*     control sorted table                                   */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the number of elements  > 0  */
/* x0 return 0  if not sorted   1  if sorted */
isSorted:
    stp x1,lr,[sp,-16]!            // save  registers
    stp x2,x3,[sp,-16]!            // save  registers
    stp x4,x5,[sp,-16]!            // save  registers
    mov x2,0
    ldr x4,[x0,x2,lsl 3]
1:
    add x2,x2,1
    cmp x2,x1
    bge 99f
    ldr x3,[x0,x2, lsl 3]
    cmp x3,x4
    blt 98f
    mov x4,x3
    b 1b
98:
   mov x0,0                        // error not sorted
   b 100f
99:
    mov x0,1                       // sorted
100:
    ldp x4,x5,[sp],16              // restaur  2 registers
    ldp x2,x3,[sp],16              // restaur  2 registers
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/***************************************************/
/*   shell Sort                                    */
/***************************************************/

/* x0 contains the address of table */
/* x1 contains the first element but not use !!   */
/*   this routine use first element at index zero !!!  */
/* x2 contains the number of element */
shellSort:
    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
    sub x2,x2,1                  // index last item
    mov x1,x2                    // init gap = last item
1:                               // start loop 1
    lsr x1,x1,1                     // gap = gap / 2
    cbz x1,100f                  // if gap = 0 -> end
    mov x3,x1                    // init loop indice 1
2:                               // start loop 2
    ldr x4,[x0,x3,lsl 3]        // load first value
    mov x5,x3                    // init loop indice 2
3:                               // start loop 3
    cmp x5,x1                    // indice < gap
    blt 4f                       // yes -> end loop 2
    sub x6,x5,x1                 // index = indice - gap
    ldr x7,[x0,x6,lsl 3]         // load second value
    cmp x4,x7                    // compare values
    bge 4f
    str x7,[x0,x5,lsl 3]         // store if <
    sub x5,x5,x1                    // indice = indice - gap
    b 3b                         // and loop
4:                               // end loop 3
    str x4,[x0,x5,lsl 3]         // store value 1 at indice 2
    add x3,x3,1                  // increment indice 1
    cmp x3,x2                    // end ?
    ble 2b                       // no -> loop 2
    b 1b                         // yes loop for new gap

100:                             // end function
    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         // display value
    bl conversion10              // call function
    ldr x0,qAdrsMessResult
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc        // insert result at @ character
    bl affichageMess             // display message
    add x3,x3,1
    cmp x3,#NBELEMENTS - 1
    ble 1b
    ldr x0,qAdrszCarriageReturn
    bl affichageMess
100:
    ldp x2,x3,[sp],16            // restaur  2 registers
    ldp x1,lr,[sp],16            // restaur  2 registers
    ret                          // return to address lr x30
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


PROC PrintArray(INT ARRAY a INT size)
  INT i

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

PROC ShellSort(INT ARRAY a INT size)
  INT stp,i,j,tmp,v

  stp=size/2
  WHILE stp>0
  DO
    FOR i=stp TO size-1
    DO
      tmp=a(i)
      j=i

      WHILE j>=stp
      DO
        v=a(j-stp)
        IF v<=tmp THEN EXIT FI

        a(j-stp)=a(j)
        a(j)=v
        j==-stp
      OD

      a(j)=tmp
    OD

    stp=stp/2
  OD
RETURN

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


function shellSort(data:Array):Array
{
	var inc:uint = data.length/2;
	while(inc > 0)
	{
		for(var i:uint = inc; i< data.length; i++)
		{
			var tmp:Object = data[i];
			for(var j:uint = i; j >= inc && data[j-inc] > tmp; j -=inc)
			{
				data[j] = data[j-inc];
			}
			data[j] = tmp;
		}
		inc = Math.round(inc/2.2);
	}
	return data;
}