Initial data commit

Task/Sort-using-a-custom-comparator/00-META.yaml

@@ -0,0 +1,5 @@
+---
+category:
+- Sorting
+from: http://rosettacode.org/wiki/Sort_using_a_custom_comparator
+note: Sorting Algorithms

Task/Sort-using-a-custom-comparator/00-TASK.txt

@@ -0,0 +1,11 @@
+{{Sorting Algorithm}}
+{{omit from|BBC BASIC}}
+
+;Task:
+Sort an array (or list) of strings in order of descending length, and in ascending lexicographic order for strings of equal length. 
+
+Use a sorting facility provided by the language/library, combined with your own callback comparison function.
+
+
+'''Note:'''   Lexicographic order is case-insensitive.
+<br><br>

Task/Sort-using-a-custom-comparator/11l/sort-using-a-custom-comparator.11l

@@ -0,0 +1,3 @@
+V strings = ‘here are Some sample strings to be sorted’.split(‘ ’)
+
+print(sorted(strings, key' x -> (-x.len, x.uppercase())))

Task/Sort-using-a-custom-comparator/AArch64-Assembly/sort-using-a-custom-comparator.aarch64

@@ -0,0 +1,357 @@
+/* ARM assembly AARCH64 Raspberry PI 3B */
+/*  program customSort64.s   */
+
+ /* use merge sort iteratif and pointer table  */
+ /* but use a extra table on stack for the merge */
+/*******************************************/
+/* Constantes file                         */
+/*******************************************/
+/* for this file see task include a file in language AArch64 assembly*/
+.include "../includeConstantesARM64.inc"
+
+/*******************************************/
+/* Structures                               */
+/********************************************/
+/* city structure      */
+    .struct  0
+city_name:                             //
+    .struct  city_name + 8             // string pointer
+city_country:                          //
+    .struct  city_country + 8          // string pointer
+city_end:
+
+/*********************************/
+/* Initialized data              */
+/*********************************/
+.data
+sMessResult:           .asciz "Name : @  country : @ \n"
+szMessSortName:        .asciz "Ascending sort table for name of city :\n"
+szMessSortCitiesDesc:  .asciz "Descending sort table for name of city : \n"
+szCarriageReturn:      .asciz "\n"
+
+// cities name
+szLondon:           .asciz "London"
+szNewyork:          .asciz "New York"
+szBirmin:           .asciz "Birmingham"
+szParis:            .asciz "Paris"
+// country name
+szUK:               .asciz "UK"
+szUS:               .asciz "US"
+szFR:               .asciz "FR"
+.align 4
+TableCities:
+e1:              .quad szLondon         // address name string
+                 .quad szUK             // address country string
+e2:              .quad szParis
+                 .quad szFR
+e3:              .quad szNewyork
+                 .quad szUS
+e4:              .quad szBirmin
+                 .quad szUK
+e5:              .quad szParis
+                 .quad szUS
+e6:              .quad szBirmin
+                 .quad szUS
+/* pointers table */
+ptrTableCities:   .quad e1
+                  .quad e2
+                  .quad e3
+                  .quad e4
+                  .quad e5
+                  .quad e6
+.equ NBELEMENTS,  (. - ptrTableCities) / 8
+
+/*********************************/
+/* UnInitialized data            */
+/*********************************/
+.bss
+sZoneConv:              .skip 24
+/*********************************/
+/*  code section                 */
+/*********************************/
+.text
+.global main
+main:                             // entry of program
+    ldr x0,qAdrptrTableCities     // address pointers table
+    bl displayTable
+
+    ldr x0,qAdrszMessSortName
+    bl affichageMess
+
+    ldr x0,qAdrptrTableCities     // address pointers table
+    mov x1,0                      // first element
+    mov x2,NBELEMENTS             // number of élements
+    adr x3,comparAreaAlphaCrois   // address custom comparator ascending
+    bl mergeSortIter
+    ldr x0,qAdrptrTableCities     // address table
+    bl displayTable
+
+    ldr x0,qAdrszMessSortCitiesDesc
+    bl affichageMess
+
+    ldr x0,qAdrptrTableCities     // address table
+    mov x1,0                      // first element
+    mov x2,NBELEMENTS             // number of élements
+    adr x3,comparAreaAlphaDecrois // address custom comparator descending
+    bl mergeSortIter
+    ldr x0,qAdrptrTableCities     // address table
+    bl displayTable
+
+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
+qAdrTableCities:          .quad TableCities
+qAdrszMessSortName:        .quad szMessSortName
+qAdrszMessSortCitiesDesc:  .quad szMessSortCitiesDesc
+qAdrptrTableCities:        .quad ptrTableCities
+
+/******************************************************************/
+/*      merge sort  iteratif                                      */
+/* use an extra table on stack                                    */
+/******************************************************************/
+/* x0 contains the address of table */
+/* x1 contains the index of first element */
+/* x2 contains the number of element */
+/* x3 contains the address of custom comparator */
+mergeSortIter:
+    stp fp,lr,[sp,-16]!     // save  registers
+    stp x1,x2,[sp,-16]!     // save  registers
+    stp x4,x5,[sp,-16]!     // save  registers
+    stp x6,x7,[sp,-16]!     // save  registers
+    stp x8,x9,[sp,-16]!     // save  registers
+    stp x10,x11,[sp,-16]!   // save  registers
+    stp x12,x13,[sp,-16]!   // save  registers
+    stp x14,x15,[sp,-16]!   // save  registers
+    mov x15,x0              // save address
+    mov x4,x1               // save N0 first element
+    sub x5,x2,1             // save N° last  element
+    tst x2,1                // number of  element odd ?
+    add x13,x2,1            // yes then add 1
+    csel x13,x13,x2,ne      // to have a multiple to 16 bytes
+    lsl x13,x13,3           // for reserve the extra table to the stack
+    sub sp,sp,x13
+    mov fp,sp               // frame register = address extra table on stack
+
+    mov x10,1               // subset size
+1:
+    mov x6,x4               // first element
+2:
+    lsl x8,x10,1            // compute end subset
+    add x8,x8,x6
+    sub x8,x8,1
+    add x7,x6,x8            // compute median
+    lsr x7,x7,1
+    cmp x8,x5               // maxi ?
+    ble 21f                 // no
+    mov x8,x5               // yes -> end subset = maxi
+    cmp x6,0                // subset final ?
+    beq 21f                 // no
+    cmp x7,x8               // compare median end subset
+    blt 21f
+    mov x7,x8               // maxi -> median
+
+21:
+    add x9,x7,1
+    mov x0,x15
+3:                          // copy first subset on extra table
+    sub x1,x9,1
+    ldr x2,[x0,x1,lsl 3]
+    str x2,[fp,x1,lsl 3]
+    sub x9,x9,1
+    cmp x9,x6
+    bgt 3b
+    mov x9,x7
+    cmp x7,x8
+    beq 41f
+4:                          // and copy inverse second subset on extra table
+    add x1,x9,1
+    add x12,x7,x8
+    sub x12,x12,x9
+    ldr x2,[x0,x1,lsl 3]
+    str x2,[fp,x12,lsl 3]
+    add x9,x9,1
+    cmp x9,x8
+    blt 4b
+41:
+    mov x11,x6  //k
+    mov x1,x6  // i
+    mov x2,x8  // j
+5:                          // and now merge the two subset on final table
+    mov x0,fp
+    blr x3
+    cmp x0,0
+    bgt 7f
+    blt 6f
+    // si egalité et si i < pivot
+    cmp x1,x7
+    ble 6f
+    b 7f
+6:
+    ldr x12,[fp,x1, lsl 3]
+    str x12,[x15,x11, lsl 3]
+    add x1,x1,1
+    b 8f
+7:
+    ldr x12,[fp,x2, lsl 3]
+    str x12,[x15,x11, lsl 3]
+    sub x2,x2,1
+8:
+    add x11,x11,1
+    cmp x11,x8
+    ble 5b
+
+9:
+    mov x0,x15
+    lsl x2,x10,1
+    add x6,x6,x2         // compute new subset
+    cmp x6,x5            // end ?
+    ble 2b
+    lsl x10,x10,1        // size of subset * 2
+    cmp x10,x5           // end ?
+    ble 1b
+
+100:
+    add sp,sp,x13           // stack alignement
+    ldp x14,x15,[sp],16     // restaur  2 registers
+    ldp x12,x13,[sp],16     // restaur  2 registers
+    ldp x10,x11,[sp],16     // restaur  2 registers
+    ldp x8,x9,[sp],16       // restaur  2 registers
+    ldp x6,x7,[sp],16       // restaur  2 registers
+    ldp x4,x5,[sp],16       // restaur  2 registers
+    ldp x1,x2,[sp],16       // restaur  2 registers
+    ldp fp,lr,[sp],16       // restaur  2 registers
+    ret                     // return to address lr x30
+
+/******************************************************************/
+/*      ascending comparison sort area                                */
+/******************************************************************/
+/* x0 contains the address of table */
+/* x1 indice area sort 1 */
+/* x2 indice area sort 2 */
+comparAreaAlphaCrois:
+    stp x1,lr,[sp,-16]!          // save  registers
+    stp x2,x3,[sp,-16]!          // save  registers
+    stp x4,x5,[sp,-16]!          // save  registers
+    stp x6,x7,[sp,-16]!          // save  registers
+    stp x8,x9,[sp,-16]!          // save  registers
+
+    ldr x1,[x0,x1,lsl 3]         // load pointer element 1
+    ldr x6,[x1,city_name]        // load area sort element 1
+    ldr x2,[x0,x2,lsl 3]         // load pointer element 2
+    ldr x7,[x2,city_name]        // load area sort element 2
+
+    mov x8,#0                    // compar alpha string
+1:
+    ldrb w9,[x6,x8]              // byte string 1
+    ldrb w5,[x7,x8]              // byte string 2
+    cmp w9,w5
+    bgt 11f                      // croissant
+    blt 10f
+
+    cmp w9,#0                    //  end string 1
+    beq 12f                      // end comparaison
+    add x8,x8,#1                 // else add 1 in counter
+    b 1b                         // and loop
+
+10:                              // lower
+    mov x0,-1
+    b 100f
+11:                              // highter
+    mov x0,1
+    b 100f
+12:                              // equal
+    mov x0,0
+100:
+    ldp x8,x9,[sp],16            // restaur  2 registers
+    ldp x6,x7,[sp],16            // restaur  2 registers
+    ldp x4,x5,[sp],16            // restaur  2 registers
+    ldp x2,x3,[sp],16            // restaur  2 registers
+    ldp x1,lr,[sp],16            // restaur  2 registers
+    ret                          // return to address lr x30
+/******************************************************************/
+/*      descending comparison sort area                                */
+/******************************************************************/
+/* x0 contains the address of table */
+/* x1 indice area sort 1 */
+/* x2 indice area sort 2 */
+comparAreaAlphaDecrois:
+    stp x1,lr,[sp,-16]!          // save  registers
+    stp x2,x3,[sp,-16]!          // save  registers
+    stp x4,x5,[sp,-16]!          // save  registers
+    stp x6,x7,[sp,-16]!          // save  registers
+    stp x8,x9,[sp,-16]!          // save  registers
+
+    ldr x1,[x0,x1,lsl 3]         // load pointer element 1
+    ldr x6,[x1,city_name]        // load area sort element 1
+    ldr x2,[x0,x2,lsl 3]         // load pointer element 2
+    ldr x7,[x2,city_name]        // load area sort element 2
+
+    mov x8,#0                    // compar alpha string
+1:
+    ldrb w9,[x6,x8]              // byte string 1
+    ldrb w5,[x7,x8]              // byte string 2
+    cmp w9,w5
+    blt 11f                      // descending
+    bgt 10f
+
+    cmp w9,#0                    //  end string 1
+    beq 12f                      // end comparaison
+    add x8,x8,#1                 // else add 1 in counter
+    b 1b                         // and loop
+
+10:                              // lower
+    mov x0,-1
+    b 100f
+11:                              // highter
+    mov x0,1
+    b 100f
+12:                              // equal
+    mov x0,0
+100:
+    ldp x8,x9,[sp],16            // restaur  2 registers
+    ldp x6,x7,[sp],16            // restaur  2 registers
+    ldp x4,x5,[sp],16            // restaur  2 registers
+    ldp x2,x3,[sp],16            // restaur  2 registers
+    ldp x1,lr,[sp],16            // restaur  2 registers
+    ret                          // return to address lr x30
+/******************************************************************/
+/*      Display table elements                                */
+/******************************************************************/
+/* x0 contains the address of table */
+displayTable:
+    stp x1,lr,[sp,-16]!          // save  registers
+    stp x2,x3,[sp,-16]!          // save  registers
+    stp x4,x5,[sp,-16]!          // save  registers
+    stp x6,x7,[sp,-16]!          // save  registers
+    mov x2,x0                    // table address
+    mov x3,0
+1:                               // loop display table
+    lsl x4,x3,#3                 // offset element
+    ldr x6,[x2,x4]               // load pointer
+    ldr x1,[x6,city_name]
+    ldr x0,qAdrsMessResult
+    bl strInsertAtCharInc        // put name in message
+    ldr x1,[x6,city_country]     // and put country in the message
+    bl strInsertAtCharInc        // insert result at @ character
+    bl affichageMess             // display message
+    add x3,x3,1
+    cmp x3,#NBELEMENTS
+    blt 1b
+    ldr x0,qAdrszCarriageReturn
+    bl affichageMess
+100:
+    ldp x6,x7,[sp],16            // restaur  2 registers
+    ldp x4,x5,[sp],16            // restaur  2 registers
+    ldp x2,x3,[sp],16            // restaur  2 registers
+    ldp x1,lr,[sp],16            // restaur  2 registers
+    ret                          // return to address lr x30
+/********************************************************/
+/*        File Include fonctions                        */
+/********************************************************/
+/* for this file see task include a file in language AArch64 assembly */
+.include "../includeARM64.inc"

Task/Sort-using-a-custom-comparator/ALGOL-68/sort-using-a-custom-comparator.alg

@@ -0,0 +1,94 @@
+# define the MODE that will be sorted #
+MODE SITEM = STRING;
+#--- Swap function ---#
+PROC swap = (REF[]SITEM array, INT first, INT second) VOID:
+(
+    SITEM temp := array[first];
+    array[first] := array[second];
+    array[second]:= temp
+);
+#--- Quick sort partition arg function with custom comparision function ---#
+PROC quick = (REF[]SITEM array, INT first, INT last, PROC(SITEM,SITEM)INT compare) VOID:
+(
+    INT   smaller := first + 1,
+          larger  := last;
+    SITEM pivot   := array[first];
+    WHILE smaller <= larger DO
+        WHILE compare(array[smaller], pivot) < 0 AND smaller < last DO
+            smaller +:= 1
+        OD;
+        WHILE compare( array[larger], pivot) > 0 AND larger > first DO
+            larger  -:= 1
+        OD;
+        IF smaller < larger THEN
+            swap(array, smaller, larger);
+            smaller +:= 1;
+            larger  -:= 1
+        ELSE
+            smaller +:= 1
+        FI
+    OD;
+    swap(array, first, larger);
+    IF first < larger-1 THEN
+        quick(array, first, larger-1, compare)
+    FI;
+    IF last > larger +1 THEN
+        quick(array, larger+1, last, compare)
+    FI
+);
+#--- Quick sort array function with custom comparison function ---#
+PROC quicksort = (REF[]SITEM array, PROC(SITEM,SITEM)INT compare) VOID:
+(
+  IF UPB array > LWB array THEN
+    quick(array, LWB array, UPB array, compare)
+  FI
+);
+#***************************************************************#
+main:
+(
+    OP LENGTH  = (STRING a)INT: ( UPB a + 1 ) - LWB a;
+    OP TOLOWER = (STRING a)STRING:
+       BEGIN
+           STRING result := a;
+           FOR i FROM LWB result TO UPB result DO
+               CHAR c = a[i];
+               IF c >= "A" AND c <= "Z" THEN result[i] := REPR ( ( ABS c - ABS "A" ) + ABS "a" ) FI
+           OD;
+           result
+       END # TOLOWER # ;
+    # custom comparison, descending sort on length #
+    # if lengths are equal, sort lexicographically #
+    PROC compare = (SITEM a, b)INT:
+         IF   INT a length = LENGTH a;
+              INT b length = LENGTH b;
+              a length < b length
+         THEN
+             # a is shorter than b #  1
+         ELIF a length > b length
+         THEN
+             # a is longer than b  # -1
+         ELIF STRING lower a = TOLOWER a;
+              STRING lower b = TOLOWER b;
+              lower a < lower b
+         THEN
+              # lowercase a is before lowercase b # -1
+         ELIF lower a > lower b
+         THEN
+              # lowercase a is after lowercase b  #  1
+         ELIF a > b
+         THEN
+             # a and b are equal ignoring case,        #
+             # but a is after b considering case       #  1
+         ELIF a < b
+         THEN
+             # a and b are equal ignoring case,        #
+             # but a is before b considering case      # -1
+         ELSE
+             # the strings are equal                   #  0
+         FI # compare # ;
+    []SITEM orig = ("Here", "are", "some", "sample", "strings", "to", "be", "sorted");
+    [LWB orig : UPB orig]SITEM a := orig;
+    print(("Before:"));FOR i FROM LWB a TO UPB a DO print((" ",a[i])) OD; print((newline));
+    quicksort(a, compare);
+    print(("After :"));FOR i FROM LWB a TO UPB a DO print((" ",a[i])) OD; print((newline))
+)

Task/Sort-using-a-custom-comparator/ATS/sort-using-a-custom-comparator.ats

@@ -0,0 +1,169 @@
+(* The following demonstrates a few ways to customize the
+   comparator. *)
+
+#include "share/atspre_staload.hats"
+staload UN = "prelude/SATS/unsafe.sats"
+
+%{^
+#include <strings.h>
+%}
+
+extern fn
+strcasecmp : (string, string) -<> int = "mac#strcasecmp"
+
+fn
+sort_strings_1 (lst : List string,
+                cmp : (string, string) -<> int)
+    :<!wrt> List string =
+  list_vt2t (list_mergesort_fun<string> (lst, cmp))
+
+fn
+sort_strings_2 (lst : List string,
+                cmp : (string, string) -<cloref> int)
+    :<!wrt> List string =
+  list_vt2t (list_mergesort_cloref<string> (lst, cmp))
+
+fn
+sort_using_a_template_function (lst : List string)
+    :<!wrt> List string =
+  (* There is no actual callback here. The comparison code is expanded
+     directly into the sort code. *)
+  let
+    implement
+    list_mergesort$cmp<string> (x, y) =
+      let
+        val m = length x
+        and n = length y
+      in
+        if m < n then
+          1
+        else if n < m then
+          ~1
+        else
+          strcasecmp (x, y)
+      end
+  in
+    (* The list mergesort template functions in the ATS prelude return
+       _linear_ lists.  Thus the call to list_vt2t to cast that result
+       to an ordinary list. *)
+    list_vt2t (list_mergesort<string> lst)
+  end
+
+fn
+sort_using_an_ordinary_function (lst : List string)
+    :<!wrt> List string =
+  (* Rather than expand the comparison code, incorporate a function
+     call into the sort implementation. *)
+  let
+    fn
+    cmp (x : string,
+         y : string)
+        :<> int =
+      let
+        val m = length x
+        and n = length y
+      in
+        if m < n then
+          1
+        else if n < m then
+          ~1
+        else
+          strcasecmp (x, y)
+      end
+  in
+    list_vt2t (list_mergesort_fun<string> (lst, cmp))
+  end
+
+fn
+sort_the_way_it_works_for_qsort_in_C (lst : List string)
+    :<!wrt> List string =
+  (* Here we have a true callback to an ordinary function. *)
+  let
+    fn
+    cmp (x : string,
+         y : string)
+        :<> int =
+      let
+        val m = length x
+        and n = length y
+      in
+        if m < n then
+          1
+        else if n < m then
+          ~1
+        else
+          strcasecmp (x, y)
+      end
+  in
+    sort_strings_1 (lst, cmp)
+  end
+
+fn
+sort_using_a_closure (lst : List string)
+    :<!wrt> List string =
+  (* Incorporate a closure into the sort implementation. (Standard C
+     does not have closures.) *)
+  let
+    fn
+    cmp (x : string,
+         y : string)
+        :<cloref> int =
+      let
+        val m = length x
+        and n = length y
+      in
+        if m < n then
+          1
+        else if n < m then
+          ~1
+        else
+          strcasecmp (x, y)
+      end
+  in
+    list_vt2t (list_mergesort_cloref<string> (lst, cmp))
+  end
+
+fn
+sort_by_calling_back_to_a_closure (lst : List string)
+    :<!wrt> List string =
+  let
+    fn
+    cmp (x : string,
+         y : string)
+        :<cloref> int =
+      let
+        val m = length x
+        and n = length y
+      in
+        if m < n then
+          1
+        else if n < m then
+          ~1
+        else
+          strcasecmp (x, y)
+      end
+  in
+    sort_strings_2 (lst, cmp)
+  end
+
+implement
+main0 () =
+  let
+    val unsorted =
+      $list{string}
+        ("Here", "are", "some", "sample", "strings",
+         "to", "be", "sorted")
+
+    val sorted1 = sort_using_a_template_function unsorted
+    val sorted2 = sort_using_an_ordinary_function unsorted
+    val sorted3 = sort_the_way_it_works_for_qsort_in_C unsorted
+    val sorted4 = sort_using_a_closure unsorted
+    val sorted5 = sort_by_calling_back_to_a_closure unsorted
+  in
+    println! unsorted;
+    println! sorted1;
+    println! sorted2;
+    println! sorted3;
+    println! sorted4;
+    println! sorted5
+  end

Task/Sort-using-a-custom-comparator/AWK/sort-using-a-custom-comparator.awk

@@ -0,0 +1,33 @@
+# syntax: GAWK -f SORT_USING_A_CUSTOM_COMPARATOR.AWK
+#
+# sorting:
+#   PROCINFO["sorted_in"] is used by GAWK
+#   SORTTYPE is used by Thompson Automation's TAWK
+#
+BEGIN {
+    words = "This Is A Set Of Strings To Sort duplicated"
+    n = split(words " " tolower(words),tmp_arr," ")
+    print("unsorted:")
+    for (i=1; i<=n; i++) {
+      word = tmp_arr[i]
+      arr[length(word)][word]++
+      print(word)
+    }
+    print("\nsorted:")
+    PROCINFO["sorted_in"] = "@ind_num_desc" ; SORTTYPE = 9
+    for (i in arr) {
+      PROCINFO["sorted_in"] = "caselessCompare" ; SORTTYPE = 2 # possibly 14?
+      for (j in arr[i]) {
+        for (k=1; k<=arr[i][j]; k++) {
+          print(j)
+        }
+      }
+    }
+    exit(0)
+}
+function caselessCompare( i1, v1, i2, v2,        l1, l2, result )
+{
+    l1 = tolower( i1 );
+    l2 = tolower( i2 );
+return ( ( l1 < l2 ) ? -1 : ( ( l1 == l2 ) ? 0 : 1 ) );
+} # caselessCompare

Task/Sort-using-a-custom-comparator/Action-/sort-using-a-custom-comparator.action

@@ -0,0 +1,78 @@
+DEFINE PTR="CARD"
+
+PROC PrintArray(PTR ARRAY a INT size)
+  INT i
+
+  Put('[)
+  FOR i=0 TO size-1
+  DO
+    IF i>0 THEN Put(' ) FI
+    Print(a(i))
+  OD
+  Put(']) PutE()
+RETURN
+
+INT FUNC CustomComparator(CHAR ARRAY s1,s2)
+  INT res
+
+  res=s2(0) res==-s1(0)
+  IF res=0 THEN
+    res=SCompare(s1,s2)
+  FI
+RETURN (res)
+
+INT FUNC Comparator=*(CHAR ARRAY s1,s2)
+DEFINE JSR="$20"
+DEFINE RTS="$60"
+  [JSR $00 $00 ;JSR to address set by SetComparator
+   RTS]
+
+PROC SetComparator(PTR p)
+  PTR addr
+
+  addr=Comparator+1 ;location of address of JSR
+  PokeC(addr,p)
+RETURN
+
+PROC InsertionSort(PTR ARRAY a INT size PTR compareFun)
+  INT i,j
+  CHAR ARRAY s
+
+  SetComparator(compareFun)
+  FOR i=1 TO size-1
+  DO
+    s=a(i)
+    j=i-1
+    WHILE j>=0 AND Comparator(s,a(j))<0
+    DO
+      a(j+1)=a(j)
+      j==-1
+    OD
+    a(j+1)=s
+  OD
+RETURN
+
+PROC Test(PTR ARRAY a INT size PTR compareFun)
+  PrintE("Array before sort:")
+  PrintArray(a,size)
+  PutE()
+
+  InsertionSort(a,size,compareFun)
+  PrintE("Array after sort:")
+  PrintArray(a,size)
+  PutE()
+RETURN
+
+PROC Main()
+  PTR ARRAY a(24)
+
+  a(0)="lorem" a(1)="ipsum" a(2)="dolor" a(3)="sit"
+  a(4)="amet" a(5)="consectetur" a(6)="adipiscing"
+  a(7)="elit" a(8)="maecenas" a(9)="varius"
+  a(10)="sapien" a(11)="vel" a(12)="purus"
+  a(13)="hendrerit" a(14)="vehicula" a(15)="integer"
+  a(16)="hendrerit" a(17)="viverra" a(18)="turpis" a(19)="ac"
+  a(20)="sagittis" a(21)="arcu" a(22)="pharetra" a(23)="id"
+
+  Test(a,24,CustomComparator)
+RETURN

Task/Sort-using-a-custom-comparator/Ada/sort-using-a-custom-comparator.ada

@@ -0,0 +1,108 @@
+with Ada.Text_Io; use Ada.Text_Io;
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+with Gnat.Heap_Sort_G;
+
+procedure Custom_Compare is
+
+   type StringArrayType is array (Natural range <>) of Unbounded_String;
+
+   Strings : StringArrayType := (Null_Unbounded_String,
+                                 To_Unbounded_String("this"),
+                                 To_Unbounded_String("is"),
+                                 To_Unbounded_String("a"),
+                                 To_Unbounded_String("set"),
+                                 To_Unbounded_String("of"),
+                                 To_Unbounded_String("strings"),
+                                 To_Unbounded_String("to"),
+                                 To_Unbounded_String("sort"),
+                                 To_Unbounded_String("This"),
+                                 To_Unbounded_String("Is"),
+                                 To_Unbounded_String("A"),
+                                 To_Unbounded_String("Set"),
+                                 To_Unbounded_String("Of"),
+                                 To_Unbounded_String("Strings"),
+                                 To_Unbounded_String("To"),
+                                 To_Unbounded_String("Sort"));
+
+   procedure Move (From, To : in Natural) is
+
+   begin
+      Strings(To) := Strings(From);
+   end Move;
+
+   function UpCase (Char : in Character) return Character is
+      Temp : Character;
+   begin
+      if Char >= 'a' and Char <= 'z' then
+         Temp := Character'Val(Character'Pos(Char)
+                                 - Character'Pos('a')
+                                 + Character'Pos('A'));
+      else
+         Temp := Char;
+      end if;
+      return Temp;
+   end UpCase;
+
+   function Lt (Op1, Op2 : Natural)
+               return Boolean is
+      Temp, Len : Natural;
+   begin
+      Len := Length(Strings(Op1));
+      Temp := Length(Strings(Op2));
+      if Len < Temp then
+         return False;
+      elsif Len > Temp then
+         return True;
+      end if;
+
+      declare
+         S1, S2 : String(1..Len);
+      begin
+         S1 := To_String(Strings(Op1));
+         S2 := To_String(Strings(Op2));
+      Put("Same size:  ");
+      Put(S1);
+      Put(" ");
+      Put(S2);
+      Put(" ");
+      for I in S1'Range loop
+         Put(UpCase(S1(I)));
+         Put(UpCase(S2(I)));
+         if UpCase(S1(I)) = UpCase(S2(I)) then
+           null;
+         elsif UpCase(S1(I)) < UpCase(S2(I)) then
+            Put(" LT");
+            New_Line;
+            return True;
+         else
+            return False;
+         end if;
+      end loop;
+      Put(" GTE");
+      New_Line;
+      return False;
+      end;
+   end Lt;
+
+   procedure Put (Arr : in StringArrayType) is
+   begin
+      for I in 1..Arr'Length-1 loop
+         Put(To_String(Arr(I)));
+         New_Line;
+      end loop;
+   end Put;
+
+   package Heap is new Gnat.Heap_Sort_G(Move,
+                                        Lt);
+   use Heap;
+
+
+begin
+   Put_Line("Unsorted list:");
+   Put(Strings);
+   New_Line;
+   Sort(16);
+   New_Line;
+   Put_Line("Sorted list:");
+   Put(Strings);
+end Custom_Compare;

Task/Sort-using-a-custom-comparator/AppleScript/sort-using-a-custom-comparator-1.applescript

@@ -0,0 +1,97 @@
+use framework "Foundation"
+
+-- SORTING LISTS OF ATOMIC (NON-RECORD) DATA WITH A CUSTOM SORT FUNCTION
+
+-- In sortBy, f is a function from () to a tuple of two parts:
+-- 1. a function from any value to a record derived from (and containing) that value
+--  The base value should be present in the record under the key 'value'
+--  additional derivative keys (and optionally the 'value' key) should be included in 2:
+-- 2. a list of (record key, boolean) tuples, in the order of sort comparison,
+--    where the value *true* selects ascending order for the paired key
+--    and the value *false* selects descending order for that key
+
+-- sortBy :: (() -> ((a -> Record), [(String, Bool)])) -> [a] -> [a]
+on sortBy(f, xs)
+    set {fn, keyBools} to mReturn(f)'s |λ|()
+    script unWrap
+        on |λ|(x)
+            value of x
+        end |λ|
+    end script
+    map(unWrap, sortByComparing(keyBools, map(fn, xs)))
+end sortBy
+
+-- SORTING APPLESCRIPT RECORDS BY PRIMARY AND N-ARY SORT KEYS
+
+-- sortByComparing :: [(String, Bool)] -> [Records] -> [Records]
+on sortByComparing(keyDirections, xs)
+    set ca to current application
+
+    script recDict
+        on |λ|(x)
+            ca's NSDictionary's dictionaryWithDictionary:x
+        end |λ|
+    end script
+    set dcts to map(recDict, xs)
+
+    script asDescriptor
+        on |λ|(kd)
+            set {k, d} to kd
+            ca's NSSortDescriptor's sortDescriptorWithKey:k ascending:d selector:dcts
+        end |λ|
+    end script
+
+    ((ca's NSArray's arrayWithArray:dcts)'s ¬
+        sortedArrayUsingDescriptors:map(asDescriptor, keyDirections)) as list
+end sortByComparing
+
+
+-- GENERIC FUNCTIONS ---------------------------------------------------------
+-- 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
+
+-- Lift 2nd class handler function into 1st class script wrapper
+-- mReturn :: Handler -> Script
+on mReturn(f)
+    if class of f is script then
+        f
+    else
+        script
+            property |λ| : f
+        end script
+    end if
+end mReturn
+
+
+-- TEST ----------------------------------------------------------------------
+on run
+    set xs to ["Shanghai", "Karachi", "Beijing", "Sao Paulo", "Dhaka", "Delhi", "Lagos"]
+
+    -- Custom comparator:
+
+    -- Returns a lifting function and a sequence of {key, bool} pairs
+
+    -- Strings in order of descending length,
+    -- and ascending lexicographic order
+    script lengthDownAZup
+        on |λ|()
+            script
+                on |λ|(x)
+                    {value:x, n:length of x}
+                end |λ|
+            end script
+            {result, {{"n", false}, {"value", true}}}
+        end |λ|
+    end script
+
+    sortBy(lengthDownAZup, xs)
+end run

Task/Sort-using-a-custom-comparator/AppleScript/sort-using-a-custom-comparator-2.applescript

@@ -0,0 +1,11 @@
+use AppleScript version "2.4" -- OS X 10.10 (Yosemite) or later
+use framework "Foundation"
+
+set listOfText to words of "now is the time for all good men to come to the aid of the party"
+
+set arrayOfStrings to current application's class "NSMutableArray"'s arrayWithArray:(listOfText)
+set descendingByLength to current application's class "NSSortDescriptor"'s sortDescriptorWithKey:("length") ascending:(false)
+set ascendingLexicographically to current application's class "NSSortDescriptor"'s sortDescriptorWithKey:("self") ascending:(true) selector:("localizedStandardCompare:")
+tell arrayOfStrings to sortUsingDescriptors:({descendingByLength, ascendingLexicographically})
+
+return arrayOfStrings as list

Task/Sort-using-a-custom-comparator/AppleScript/sort-using-a-custom-comparator-3.applescript

@@ -0,0 +1,18 @@
+use AppleScript version "2.3.1" -- OS X 10.9 (Mavericks) or later
+use sorter : script ¬
+    "Custom Iterative Ternary Merge Sort" --<www.macscripter.net/t/timsort-and-nigsort/71383/3>
+
+-- Sort customiser.
+script descendingByLengthThenAscendingLexicographically
+    on isGreater(a, b)
+        set lenA to a's length
+        set lenB to b's length
+        if (lenA = lenB) then return (a > b)
+        return (lenB > lenA)
+    end isGreater
+end script
+
+set listOfText to words of "now is the time for all good men to come to the aid of the party"
+tell sorter to ¬
+    sort(listOfText, 1, -1, {comparer:descendingByLengthThenAscendingLexicographically})
+return listOfText

Task/Sort-using-a-custom-comparator/AutoHotkey/sort-using-a-custom-comparator.ahk

@@ -0,0 +1,14 @@
+numbers = 5,3,7,9,1,13,999,-4
+strings = Here,are,some,sample,strings,to,be,sorted
+Sort, numbers, F IntegerSort D,
+Sort, strings, F StringLengthSort D,
+msgbox % numbers
+msgbox % strings
+
+IntegerSort(a1, a2) {
+return a2 - a1
+}
+
+StringLengthSort(a1, a2){
+return strlen(a1) - strlen(a2)
+}

Task/Sort-using-a-custom-comparator/Babel/sort-using-a-custom-comparator-1.pb

@@ -0,0 +1,4 @@
+babel> ("Here" "are" "some" "sample" "strings" "to" "be" "sorted") strsort ! lsstr !
+( "Here" "are" "be" "sample" "some" "sorted" "strings" "to" )
+babel> ("Here" "are" "some" "sample" "strings" "to" "be" "sorted") lexsort ! lsstr !
+( "be" "to" "are" "Here" "some" "sample" "sorted" "strings" )

Task/Sort-using-a-custom-comparator/Babel/sort-using-a-custom-comparator-2.pb

@@ -0,0 +1,4 @@
+babel> ("Here" "are" "some" "sample" "strings" "to" "be" "sorted") {str2ar} over ! {strcmp 0 lt?} lssort ! {ar2str} over ! lsstr !
+( "Here" "are" "be" "some" "sample" "sorted" "strings" "to" )
+babel>  ("Here" "are" "some" "sample" "strings" "to" "be" "sorted") {str2ar} over ! {arcmp 0 lt?} lssort ! {ar2str} over ! lsstr !
+( "be" "to" "are" "Here" "some" "sample" "sorted" "strings" )

Task/Sort-using-a-custom-comparator/Babel/sort-using-a-custom-comparator-3.pb

@@ -0,0 +1,2 @@
+babel> ( 5 6 8 4 5 3 9 9 4 9 ) {lt?} lssort ! lsnum !
+( 3 4 4 5 5 6 8 9 9 9 )

Task/Sort-using-a-custom-comparator/Babel/sort-using-a-custom-comparator-4.pb

@@ -0,0 +1,2 @@
+babel> (1 2 3 4 5 6 7 8 9) {1 randlf 2 rem} lssort ! lsnum !
+( 7 5 9 6 2 4 3 1 8 )

Task/Sort-using-a-custom-comparator/Babel/sort-using-a-custom-comparator-5.pb

@@ -0,0 +1,24 @@
+babel> 20 lsrange ! {1 randlf 2 rem} lssort ! 2 group ! --> this creates a shuffled list of pairs
+babel> dup {lsnum !} ... --> display the shuffled list, pair-by-pair
+( 11 10 )
+( 15 13 )
+( 12 16 )
+( 17 3 )
+( 14 5 )
+( 4 19 )
+( 18 9 )
+( 1 7 )
+( 8 6 )
+( 0 2 )
+babel> {<- car -> car lt? } lssort ! --> sort the list by first element of each pair
+babel> dup {lsnum !} ... --> display the sorted list, pair-by-pair
+( 0 2 )
+( 1 7 )
+( 4 19 )
+( 8 6 )
+( 11 10 )
+( 12 16 )
+( 14 5 )
+( 15 13 )
+( 17 3 )
+( 18 9 )

Task/Sort-using-a-custom-comparator/Burlesque/sort-using-a-custom-comparator.blq

@@ -0,0 +1,4 @@
+blsq ) {"acb"  "Abc" "Acb" "acc" "ADD"}><
+{"ADD" "Abc" "Acb" "acb" "acc"}
+blsq ) {"acb"  "Abc" "Acb" "acc" "ADD"}(zz)CMsb
+{"Abc" "acb" "Acb" "acc" "ADD"}

Task/Sort-using-a-custom-comparator/C++/sort-using-a-custom-comparator.cpp

@@ -0,0 +1,29 @@
+#include <algorithm>
+#include <string>
+#include <cctype>
+
+// compare character case-insensitive
+struct icompare_char {
+  bool operator()(char c1, char c2) {
+    return std::toupper(c1) < std::toupper(c2);
+  }
+};
+
+// return true if s1 comes before s2
+struct compare {
+  bool operator()(std::string const& s1, std::string const& s2) {
+    if (s1.length() > s2.length())
+      return true;
+    if (s1.length() < s2.length())
+      return false;
+    return std::lexicographical_compare(s1.begin(), s1.end(),
+                                        s2.begin(), s2.end(),
+                                        icompare_char());
+  }
+};
+
+int main() {
+  std::string strings[8] = {"Here", "are", "some", "sample", "strings", "to", "be", "sorted"};
+  std::sort(strings, strings+8, compare());
+  return 0;
+}

Task/Sort-using-a-custom-comparator/C-sharp/sort-using-a-custom-comparator-1.cs

@@ -0,0 +1,40 @@
+using System;
+using System.Collections.Generic;
+
+namespace RosettaCode {
+    class SortCustomComparator {
+        // Driver program
+        public void CustomSort() {
+            String[] items = { "Here", "are", "some", "sample", "strings", "to", "be", "sorted" };
+            List<String> list = new List<string>(items);
+
+            DisplayList("Unsorted", list);
+
+            list.Sort(CustomCompare);
+            DisplayList("Descending Length", list);
+
+            list.Sort();
+            DisplayList("Ascending order", list);
+        }
+
+        // Custom compare
+        public int CustomCompare(String x, String y) {
+            int result = -x.Length.CompareTo(y.Length);
+            if (result == 0) {
+                result = x.ToLower().CompareTo(y.ToLower());
+            }
+
+            return result;
+        }
+
+        // Output routine
+        public void DisplayList(String header, List<String> theList) {
+            Console.WriteLine(header);
+            Console.WriteLine("".PadLeft(header.Length, '*'));
+            foreach (String str in theList) {
+                Console.WriteLine(str);
+            }
+            Console.WriteLine();
+        }
+    }
+}

Task/Sort-using-a-custom-comparator/C-sharp/sort-using-a-custom-comparator-2.cs

@@ -0,0 +1,39 @@
+using System;
+using System.Collections.Generic;
+using System.Linq;
+
+namespace RosettaCode
+{
+	class SortCustomComparator
+	{
+		// Driver program
+		public void CustomSort()
+		{
+			List<string> list = new List<string> { "Here", "are", "some", "sample", "strings", "to", "be", "sorted" };
+
+			DisplayList("Unsorted", list);
+
+			var descOrdered = from l in list
+					  orderby l.Length descending
+					  select l;
+			DisplayList("Descending Length", descOrdered);
+
+			var ascOrdered = from l in list
+					 orderby l
+					 select l;
+			DisplayList("Ascending order", ascOrdered);
+		}
+
+		// Output routine
+		public void DisplayList(String header, IEnumerable<string> theList)
+		{
+			Console.WriteLine(header);
+			Console.WriteLine("".PadLeft(header.Length, '*'));
+			foreach (String str in theList)
+			{
+				Console.WriteLine(str);
+			}
+			Console.WriteLine();
+		}
+	}
+}

Task/Sort-using-a-custom-comparator/C/sort-using-a-custom-comparator.c

@@ -0,0 +1,22 @@
+#include <stdlib.h>  /* for qsort */
+#include <string.h>  /* for strlen */
+#include <strings.h> /* for strcasecmp */
+
+int mycmp(const void *s1, const void *s2)
+{
+    const char *l = *(const char **)s1, *r = *(const char **)s2;
+    size_t ll = strlen(l), lr = strlen(r);
+
+    if (ll > lr) return -1;
+    if (ll < lr) return 1;
+    return strcasecmp(l, r);
+}
+
+int main()
+{
+    const char *strings[] = {
+      "Here", "are", "some", "sample", "strings", "to", "be", "sorted" };
+
+    qsort(strings, sizeof(strings)/sizeof(*strings), sizeof(*strings), mycmp);
+    return 0;
+}

Task/Sort-using-a-custom-comparator/Ceylon/sort-using-a-custom-comparator.ceylon

@@ -0,0 +1,14 @@
+shared void run() {
+
+	value strings = [
+		"Cat", "apple", "Adam", "zero", "Xmas", "quit",
+		"Level", "add", "Actor", "base", "butter"
+	];
+
+	value sorted = strings.sort((String x, String y) =>
+			if(x.size == y.size)
+			then increasing(x.lowercased, y.lowercased)
+			else decreasing(x.size, y.size));
+	
+	sorted.each(print);
+}

Task/Sort-using-a-custom-comparator/Clean/sort-using-a-custom-comparator.clean

@@ -0,0 +1,11 @@
+import StdEnv
+
+less s1 s2
+    | size s1 > size s2 = True
+    | size s1 < size s2 = False
+    | otherwise = lower s1 < lower s2
+where
+    lower :: String -> String
+    lower s = {toLower c \\ c <-: s}
+
+Start = sortBy less ["This", "is", "a", "set", "of", "strings", "to", "sort"]

Task/Sort-using-a-custom-comparator/Clojure/sort-using-a-custom-comparator-1.clj

@@ -0,0 +1,9 @@
+(defn rosetta-compare [s1 s2]
+  (let [len1 (count s1), len2 (count s2)]
+    (if (= len1 len2)
+      (compare (.toLowerCase s1) (.toLowerCase s2))
+      (- len2 len1))))
+
+(println
+ (sort rosetta-compare
+       ["Here" "are" "some" "sample" "strings" "to" "be" "sorted"]))

Task/Sort-using-a-custom-comparator/Clojure/sort-using-a-custom-comparator-2.clj

@@ -0,0 +1,2 @@
+(sort-by (juxt (comp - count) #(.toLowerCase %))
+         ["Here" "are" "some" "sample" "strings" "to" "be" "sorted"])

Task/Sort-using-a-custom-comparator/Common-Lisp/sort-using-a-custom-comparator-1.lisp

@@ -0,0 +1,6 @@
+CL-USER> (defvar *strings*
+                 (list "Cat" "apple" "Adam" "zero" "Xmas" "quit" "Level" "add" "Actor" "base" "butter"))
+*STRINGS*
+CL-USER> (sort *strings* #'string-lessp)
+("Actor" "Adam" "add" "apple" "base" "butter" "Cat" "Level" "quit" "Xmas"
+"zero")

Task/Sort-using-a-custom-comparator/Common-Lisp/sort-using-a-custom-comparator-2.lisp

@@ -0,0 +1,6 @@
+CL-USER> (defvar *strings*
+                 (list "Cat" "apple" "Adam" "zero" "Xmas" "quit" "Level" "add" "Actor" "base" "butter"))
+*STRINGS*
+CL-USER> (sort *strings* #'> :key #'length)
+("butter" "apple" "Level" "Actor" "Adam" "zero" "Xmas" "quit" "base"
+ "Cat" "add")

Task/Sort-using-a-custom-comparator/D/sort-using-a-custom-comparator-1.d

@@ -0,0 +1,8 @@
+import std.stdio, std.string, std.algorithm, std.typecons;
+
+void main() {
+    "here are Some sample strings to be sorted"
+    .split
+    .schwartzSort!q{ tuple(-a.length, a.toUpper) }
+    .writeln;
+}

Task/Sort-using-a-custom-comparator/D/sort-using-a-custom-comparator-2.d

@@ -0,0 +1,7 @@
+void main() {
+    import std.stdio, std.string, std.algorithm;
+
+    auto parts = "here are Some sample strings to be sorted".split;
+    parts.multiSort!(q{a.length > b.length}, q{a.toUpper < b.toUpper});
+    parts.writeln;
+}

Task/Sort-using-a-custom-comparator/Delphi/sort-using-a-custom-comparator.delphi

@@ -0,0 +1,21 @@
+program SortWithCustomComparator;
+
+{$APPTYPE CONSOLE}
+
+uses SysUtils, Types, Generics.Collections, Generics.Defaults;
+
+var
+  lArray: TStringDynArray;
+begin
+  lArray := TStringDynArray.Create('Here', 'are', 'some', 'sample', 'strings', 'to', 'be', 'sorted');
+
+  TArray.Sort<string>(lArray , TDelegatedComparer<string>.Construct(
+  function(const Left, Right: string): Integer
+  begin
+    //Returns ('Here', 'are', 'be', 'sample', 'some', 'sorted', 'strings', 'to')
+    //Result := CompareStr(Left, Right);
+
+    //Returns ('are', 'be', 'Here', 'sample', 'some', 'sorted', 'strings', 'to')
+    Result := CompareText(Left, Right);
+  end));
+end.

Task/Sort-using-a-custom-comparator/E/sort-using-a-custom-comparator.e

@@ -0,0 +1,8 @@
+/** returns a if it is nonzero, otherwise b() */
+def nonzeroOr(a, b) { return if (a.isZero()) { b() } else { a } }
+
+["Here", "are", "some", "sample", "strings", "to", "be", "sorted"] \
+    .sort(fn a, b {
+              nonzeroOr(b.size().op__cmp(a.size()),
+                        fn { a.compareToIgnoreCase(b) })
+          })

Task/Sort-using-a-custom-comparator/EGL/sort-using-a-custom-comparator.egl

@@ -0,0 +1,37 @@
+program SortExample
+	
+    function main()
+       	test1 string[] = ["Here", "are", "some", "sample", "strings", "to", "be", "sorted"];
+	test1.sort(sortFunction);
+
+	SysLib.writeStdout("Test 1:");
+	for(i int from 1 to test1.getSize())
+      	    SysLib.writeStdout(test1[i]);
+	end
+
+	test2 string[] = ["Cat", "apple", "Adam", "zero", "Xmas", "quit", "Level", "add", "Actor", "base", "butter"];
+	test2.sort(sortFunction);
+		
+	SysLib.writeStdout("Test 2:");
+	for(i int from 1 to test2.getSize())
+	    SysLib.writeStdout(test2[i]);
+	end
+    end
+
+    function sortFunction(a any in, b any in) returns (int)
+	result int = (b as string).length() - (a as string).length();
+	if (result == 0)
+  	    case
+		when ((a as string).toLowerCase() > (b as string).toLowerCase())
+	  	    result = 1;
+		when ((a as string).toLowerCase() < (b as string).toLowerCase())
+		    result = -1;
+		otherwise
+		    result = 0;
+	    end
+	end
+    	
+    	return result;
+    end
+	
+end

Task/Sort-using-a-custom-comparator/Elena/sort-using-a-custom-comparator.elena

@@ -0,0 +1,16 @@
+import extensions;
+import system'routines;
+import system'culture;
+
+public program()
+{
+    var items := new string[]{ "Here", "are", "some", "sample", "strings", "to", "be", "sorted" };
+
+    console.printLine("Unsorted:          ", items.asEnumerable());
+
+    console.printLine("Descending length: ", items.clone()
+        .sort:(p,n => p.Length > n.Length).asEnumerable());
+
+    console.printLine("Ascending order:   ", items.clone()
+        .sort:(p,n => p.toUpper(invariantLocale) < n.toUpper(invariantLocale)).asEnumerable())
+}

Task/Sort-using-a-custom-comparator/Elixir/sort-using-a-custom-comparator.elixir

@@ -0,0 +1,9 @@
+strs = ~w[this is a set of strings to sort This Is A Set Of Strings To Sort]
+
+comparator = fn s1,s2 -> if String.length(s1)==String.length(s2),
+                           do:   String.downcase(s1) <= String.downcase(s2),
+                           else: String.length(s1) >= String.length(s2) end
+IO.inspect Enum.sort(strs, comparator)
+
+# or
+IO.inspect Enum.sort_by(strs, fn str -> {-String.length(str), String.downcase(str)} end)

Task/Sort-using-a-custom-comparator/Erlang/sort-using-a-custom-comparator.erl

@@ -0,0 +1,12 @@
+-module( sort_using_custom_comparator ).
+
+-export( [task/0] ).
+
+task() ->
+	lists:sort( fun longest_first_case_insensitive/2, ["this", "is", "a", "set", "of", "strings", "to", "sort", "This", "Is", "A", "Set", "Of", "Strings", "To", "Sort"] ).
+
+
+
+longest_first_case_insensitive( String1, String2 ) when erlang:length(String1) =:= erlang:length(String2) -> string:to_lower(String1) < string:to_lower(String2);
+longest_first_case_insensitive( String1, String2 ) when erlang:length(String1) =< erlang:length(String2) -> false;
+longest_first_case_insensitive( _String1, _String2 ) -> true.

Task/Sort-using-a-custom-comparator/Euphoria/sort-using-a-custom-comparator.euphoria

@@ -0,0 +1,20 @@
+include sort.e
+include wildcard.e
+include misc.e
+
+function my_compare(sequence a, sequence b)
+    if length(a)!=length(b) then
+        return -compare(length(a),length(b))
+    else
+        return compare(lower(a),lower(b))
+    end if
+end function
+
+sequence strings
+strings = reverse({ "Here", "are", "some", "sample", "strings", "to", "be", "sorted" })
+
+puts(1,"Unsorted:\n")
+pretty_print(1,strings,{2})
+
+puts(1,"\n\nSorted:\n")
+pretty_print(1,custom_sort(routine_id("my_compare"),strings),{2})

Task/Sort-using-a-custom-comparator/F-Sharp/sort-using-a-custom-comparator.fs

@@ -0,0 +1,10 @@
+let myCompare (s1:string) (s2:string) =
+  match compare s2.Length s1.Length with
+    | 0 -> compare (s1.ToLower()) (s2.ToLower())
+    | X -> X
+
+let strings = ["Here"; "are"; "some"; "sample"; "strings"; "to"; "be"; "sorted"]
+
+let sortedStrings = List.sortWith myCompare strings
+
+printfn "%A" sortedStrings

Task/Sort-using-a-custom-comparator/Factor/sort-using-a-custom-comparator.factor

@@ -0,0 +1,5 @@
+: my-compare ( s1 s2 -- <=> )
+    2dup [ length ] compare invert-comparison
+    dup +eq+ = [ drop [ >lower ] compare ] [ 2nip ] if ;
+
+{ "this" "is" "a" "set" "of" "strings" "to" "sort" } [ my-compare ] sort

Task/Sort-using-a-custom-comparator/Fantom/sort-using-a-custom-comparator.fantom

@@ -0,0 +1,20 @@
+class Main
+{
+  public static Void main ()
+  {
+    // sample strings from Lisp example
+    strs := ["Cat", "apple", "Adam", "zero", "Xmas", "quit",
+             "Level", "add", "Actor", "base", "butter"]
+
+    sorted := strs.dup // make a copy of original list
+    sorted.sort |Str a, Str b -> Int|  // sort using custom comparator
+    {
+      if (b.size == a.size)           // if size is same
+        return a.compareIgnoreCase(b) // then sort in ascending lexicographic order, ignoring case
+      else
+        return b.size <=> a.size      // else sort in descending size order
+    }
+    echo ("Started with : " + strs.join(" "))
+    echo ("Finished with: " + sorted.join(" "))
+  }
+}

Task/Sort-using-a-custom-comparator/Fortran/sort-using-a-custom-comparator-1.f

@@ -0,0 +1,33 @@
+module sorts_with_custom_comparator
+  implicit none
+contains
+  subroutine a_sort(a, cc)
+    character(len=*), dimension(:), intent(inout) :: a
+    interface
+       integer function cc(a, b)
+         character(len=*), intent(in) :: a, b
+       end function cc
+    end interface
+
+    integer :: i, j, increment
+    character(len=max(len(a), 10)) :: temp
+
+    increment = size(a) / 2
+    do while ( increment > 0 )
+       do i = increment+1, size(a)
+          j = i
+          temp = a(i)
+          do while ( j >= increment+1 .and. cc(a(j-increment), temp) > 0)
+             a(j) = a(j-increment)
+             j = j - increment
+          end do
+          a(j) = temp
+       end do
+       if ( increment == 2 ) then
+          increment = 1
+       else
+          increment = increment * 5 / 11
+       end if
+    end do
+  end subroutine a_sort
+end module sorts_with_custom_comparator

Task/Sort-using-a-custom-comparator/Fortran/sort-using-a-custom-comparator-2.f

@@ -0,0 +1,26 @@
+module comparators
+  implicit none
+contains
+  integer function my_compare(a, b)
+    character(len=*), intent(in) :: a, b
+
+    character(len=max(len(a),len(b))) :: a1, b1
+
+    a1 = a
+    b1 = b
+    call to_lower(b1)
+    call to_lower(a1)
+
+    if ( len(trim(a)) > len(trim(b)) ) then
+       my_compare = -1
+    elseif ( len(trim(a)) == len(trim(b)) ) then
+       if ( a1 > b1 ) then
+          my_compare = 1
+       else
+          my_compare = -1
+       end if
+    else
+       my_compare = 1
+    end if
+  end function my_compare
+end module comparators

Task/Sort-using-a-custom-comparator/Fortran/sort-using-a-custom-comparator-3.f

@@ -0,0 +1,15 @@
+program CustomComparator
+  use comparators
+  use sorts_with_custom_comparator
+  implicit none
+
+  character(len=100), dimension(8) :: str
+  integer :: i
+
+  str = (/ "this", "is", "an", "array", "of", "strings", "to", "sort" /)
+  call a_sort(str, my_compare)
+
+  do i = 1, size(str)
+     print *, trim(str(i))
+  end do
+end program CustomComparator

Task/Sort-using-a-custom-comparator/FreeBASIC/sort-using-a-custom-comparator.basic

@@ -0,0 +1,48 @@
+' version 23-10-2016
+' compile with: fbc -s console
+
+#Include Once "crt/stdlib.bi" ' for qsort
+
+Function mycmp Cdecl (s1 As Any Pointer, s2 As Any Pointer) As Long
+
+    ' -1 no swap first element before second element
+    '  0 no swap needed, don't care
+    '  1 swap first element after second element
+
+    Dim As String str1 = *Cast(String Ptr, s1)
+    Dim As String str2 = *Cast(String Ptr, s2)
+
+    Dim As Long l1 = Len(str1), l2 = Len(str2)
+    If (l1 > l2) Then Return -1 ' descending
+    If (l1 < l2) Then Return  1 '
+
+    ' there equal length, sort ascending
+    If UCase(str1) = UCase(str2) Then
+        If str1 > str2 Then Return 1
+    Else
+        If UCase(str1) > UCase(str2) Then Return 1
+    End If
+
+    Return 0
+
+End Function
+
+' ------=< MAIN >=------
+
+Dim As String words(0 To ...) = {"Here", "are", "some", "sample", _
+                                 "strings", "to", "be", "sorted" }
+
+Dim As ULong array_size = UBound(words) - LBound(words) + 1
+
+qsort(@words(0), array_size, SizeOf(String), @mycmp)
+
+For i As Integer = 0 To UBound(words)
+    Print words(i)
+Next
+Print
+
+' empty keyboard buffer
+While InKey <> "" : Wend
+Print : Print "hit any key to end program"
+Sleep
+End

Task/Sort-using-a-custom-comparator/Frink/sort-using-a-custom-comparator-1.frink

@@ -0,0 +1,10 @@
+f = {|a,b|
+     len = length[b] <=> length[a]
+     if len != 0
+        return len
+     else
+        return lexicalCompare[a,b]
+    }
+
+words = split[%r/\s+/, "Here are some sample strings to be sorted"]
+println[sort[words, f]]

Task/Sort-using-a-custom-comparator/Frink/sort-using-a-custom-comparator-2.frink

@@ -0,0 +1,4 @@
+f = {|a,b,lang| lexicalCompare[a,b,lang] }
+
+words = ["Ærø", "Aalborg", "Tårnby", "Vejen", "Thisted", "Stevns", "Sønderborg", "Eliasen"]
+println[sort[words, f, "da"]]

Task/Sort-using-a-custom-comparator/FunL/sort-using-a-custom-comparator.funl

@@ -0,0 +1,3 @@
+def preceeds( a, b ) = b.length() < a.length() or b.length() == a.length() and a.compareToIgnoreCase( b ) < 0
+
+println( ["here", "are", "Some", "sample", "strings", "to", "be", "sorted"].sortWith(preceeds) )

Task/Sort-using-a-custom-comparator/FutureBasic/sort-using-a-custom-comparator.basic

@@ -0,0 +1,15 @@
+include "NSLog.incl"
+
+local fn CustomComparator( obj1 as CFTypeRef, obj2 as CFTypeRef, context as ptr ) as NSComparisonResult
+  NSComparisonResult result = fn StringCaseInsensitiveCompare( obj1, obj2 )
+end fn = result
+
+local fn ComparatorStringSort( wordString as CFStringRef ) as CFStringRef
+  CFArrayRef   stringArray = fn StringComponentsSeparatedByString( wordString, @" " )
+  CFArrayRef   sortedArray = fn ArraySortedArrayUsingFunction( stringArray, @fn CustomComparator, NULL )
+  CFStringRef    sortedStr = fn ArrayComponentsJoinedByString( sortedArray, @"\n" )
+end fn = sortedStr
+
+NSLog( @"%@", fn ComparatorStringSort( @"The quick brown fox jumped over the lazy dog's back" ) )
+
+HandleEvents

Task/Sort-using-a-custom-comparator/Go/sort-using-a-custom-comparator.go

@@ -0,0 +1,27 @@
+package main
+
+import (
+    "fmt"
+    "sort"
+    "strings"
+)
+
+type sortable []string
+
+func (s sortable) Len() int      { return len(s) }
+func (s sortable) Swap(i, j int) { s[i], s[j] = s[j], s[i] }
+func (s sortable) Less(i, j int) bool {
+    a, b := s[i], s[j]
+    if len(a) != len(b) {
+        return len(a) > len(b)
+    }
+    return strings.ToLower(a) < strings.ToLower(b)
+}
+
+func main() {
+    var s sortable = strings.Fields("To tell your name the livelong day To an admiring bog")
+    fmt.Println(s, "(original)")
+
+    sort.Sort(s)
+    fmt.Println(s, "(sorted)")
+}

Task/Sort-using-a-custom-comparator/Groovy/sort-using-a-custom-comparator.groovy

@@ -0,0 +1,5 @@
+def strings = "Here are some sample strings to be sorted".split()
+strings.sort { x, y ->
+    y.length() <=> x.length() ?: x.compareToIgnoreCase(y)
+}
+println strings

Task/Sort-using-a-custom-comparator/Haskell/sort-using-a-custom-comparator.hs

@@ -0,0 +1,34 @@
+import Data.Char (toLower)
+import Data.List (sortBy)
+import Data.Ord (comparing)
+
+-------------------- CUSTOM COMPARATORS ------------------
+
+lengthThenAZ :: String -> String -> Ordering
+lengthThenAZ = comparing length <> comparing (fmap toLower)
+
+descLengthThenAZ :: String -> String -> Ordering
+descLengthThenAZ =
+  flip (comparing length)
+    <> comparing (fmap toLower)
+
+--------------------------- TEST -------------------------
+main :: IO ()
+main =
+  mapM_
+    putStrLn
+    ( fmap
+        unlines
+        ( [sortBy] <*> [lengthThenAZ, descLengthThenAZ]
+            <*> [ [ "Here",
+                    "are",
+                    "some",
+                    "sample",
+                    "strings",
+                    "to",
+                    "be",
+                    "sorted"
+                  ]
+                ]
+        )
+    )

Task/Sort-using-a-custom-comparator/Icon/sort-using-a-custom-comparator.icon

@@ -0,0 +1,13 @@
+procedure main()                     #: demonstrate various ways to sort a list and string
+   write("Sorting Demo for custom comparator")
+   L := ["Here", "are", "some", "sample", "strings", "to", "be", "sorted"]
+   write("  Unsorted Input : ")
+   every write("    ",image(!L))
+   shellsort(L,cmptask)                # most of the RC sorts will work here
+   write("  Sorted Output : ")
+   every write("    ",image(!L))
+end
+
+procedure cmptask(a,b)   # sort by descending length and ascending lexicographic order for strings of equal length
+if (*a > *b) | ((*a = *b) & (map(a) << map(b))) then return b
+end

Task/Sort-using-a-custom-comparator/J/sort-using-a-custom-comparator.j

@@ -0,0 +1,7 @@
+   mycmp=: 1 :'/:u'
+   length_and_lex =: (-@:# ; lower)&>
+   strings=: 'Here';'are';'some';'sample';'strings';'to';'be';'sorted'
+   length_and_lex mycmp strings
++-------+------+------+----+----+---+--+--+
+|strings|sample|sorted|Here|some|are|be|to|
++-------+------+------+----+----+---+--+--+

Task/Sort-using-a-custom-comparator/Java/sort-using-a-custom-comparator-1.java

@@ -0,0 +1,20 @@
+import java.util.Comparator;
+import java.util.Arrays;
+
+public class Test {
+  public static void main(String[] args) {
+    String[] strings = {"Here", "are", "some", "sample", "strings", "to", "be", "sorted"};
+
+    Arrays.sort(strings, new Comparator<String>() {
+      public int compare(String s1, String s2) {
+        int c = s2.length() - s1.length();
+        if (c == 0)
+          c = s1.compareToIgnoreCase(s2);
+        return c;
+      }
+    });
+
+    for (String s: strings)
+      System.out.print(s + " ");
+  }
+}

Task/Sort-using-a-custom-comparator/Java/sort-using-a-custom-comparator-2.java

@@ -0,0 +1,18 @@
+import java.util.Comparator;
+import java.util.Arrays;
+
+public class ComparatorTest {
+  public static void main(String[] args) {
+    String[] strings = {"Here", "are", "some", "sample", "strings", "to", "be", "sorted"};
+
+    Arrays.sort(strings, (s1, s2) -> {
+      int c = s2.length() - s1.length();
+      if (c == 0)
+        c = s1.compareToIgnoreCase(s2);
+      return c;
+    });
+
+    for (String s: strings)
+      System.out.print(s + " ");
+  }
+}

Task/Sort-using-a-custom-comparator/JavaScript/sort-using-a-custom-comparator-1.js

@@ -0,0 +1,10 @@
+function lengthSorter(a, b) {
+  var result = b.length - a.length;
+  if (result == 0)
+    result = a.localeCompare(b);
+  return result;
+}
+
+var test = ["Here", "are", "some", "sample", "strings", "to", "be", "sorted"];
+test.sort(lengthSorter);
+alert( test.join(' ') );                      // strings sample sorted Here some are be to

Task/Sort-using-a-custom-comparator/JavaScript/sort-using-a-custom-comparator-2.js

@@ -0,0 +1,121 @@
+(function () {
+    'use strict';
+
+    // GENERIC FUNCTIONS FOR COMPARISONS
+
+    // Ordering :: ( LT | EQ | GT ) | ( -1 | 0 | 1 )
+
+    // compare :: a -> a -> Ordering
+    var compare = function (a, b) {
+        return a < b ? -1 : a > b ? 1 : 0;
+    };
+
+    // mappendOrdering :: Ordering -> Ordering -> Ordering
+    var mappendOrdering = function (a, b) {
+        return a !== 0 ? a : b;
+    };
+
+    // on :: (b -> b -> c) -> (a -> b) -> a -> a -> c
+    var on = function (f, g) {
+        return function (a, b) {
+            return f(g(a), g(b));
+        };
+    };
+
+    // flip :: (a -> b -> c) -> b -> a -> c
+    var flip = function (f) {
+        return function (a, b) {
+            return f.apply(null, [b, a]);
+        };
+    };
+
+    // arrayCopy :: [a] -> [a]
+    var arrayCopy = function (xs) {
+        return xs.slice(0);
+    };
+
+    // show :: a -> String
+    var show = function (x) {
+        return JSON.stringify(x, null, 2);
+    };
+
+    // TEST
+    var xs = ['Shanghai', 'Karachi', 'Beijing', 'Sao Paulo', 'Dhaka', 'Delhi', 'Lagos'];
+
+    var rs = [{
+        name: 'Shanghai',
+        pop: 24.2
+    }, {
+        name: 'Karachi',
+        pop: 23.5
+    }, {
+        name: 'Beijing',
+        pop: 21.5
+    }, {
+        name: 'Sao Paulo',
+        pop: 24.2
+    }, {
+        name: 'Dhaka',
+        pop: 17.0
+    }, {
+        name: 'Delhi',
+        pop: 16.8
+    }, {
+        name: 'Lagos',
+        pop: 16.1
+    }];
+
+    // population :: Dictionary -> Num
+    var population = function (x) {
+        return x.pop;
+    };
+
+    // length :: [a] -> Int
+    var length = function (xs) {
+        return xs.length;
+    };
+
+    // toLower :: String -> String
+    var toLower = function (s) {
+        return s.toLowerCase();
+    };
+
+    // lengthThenAZ :: String -> String -> ( -1 | 0 | 1)
+    var lengthThenAZ = function (a, b) {
+        return mappendOrdering(
+            on(compare, length)(a, b),
+            on(compare, toLower)(a, b)
+        );
+    };
+
+    // descLengthThenAZ :: String -> String -> ( -1 | 0 | 1)
+    var descLengthThenAZ = function (a, b) {
+        return mappendOrdering(
+            on(flip(compare), length)(a, b),
+            on(compare, toLower)(a, b)
+        );
+    };
+
+    return show({
+        default: arrayCopy(xs)
+            .sort(compare),
+
+        descendingDefault: arrayCopy(xs)
+            .sort(flip(compare)),
+
+        byLengthThenAZ: arrayCopy(xs)
+            .sort(lengthThenAZ),
+
+        byDescendingLengthThenZA: arrayCopy(xs)
+            .sort(flip(lengthThenAZ)),
+
+        byDescendingLengthThenAZ: arrayCopy(xs)
+            .sort(descLengthThenAZ),
+
+        byPopulation: arrayCopy(rs)
+            .sort(on(compare, population)),
+
+        byDescendingPopulation: arrayCopy(rs)
+            .sort(on(flip(compare), population))
+    });
+})();

Task/Sort-using-a-custom-comparator/JavaScript/sort-using-a-custom-comparator-3.js

@@ -0,0 +1,76 @@
+(() => {
+    'use strict';
+
+    // main :: IO ()
+    const main = () => {
+        const
+            lengthThenAZ = mappendOrd(
+                comparing(length),
+                comparing(toLower)
+            ),
+            descLengthThenAZ = mappendOrd(
+                flip(comparing(length)),
+                comparing(toLower)
+            );
+
+        console.log(
+            apList(apList([sortBy])([
+                lengthThenAZ,
+                descLengthThenAZ
+            ]))([
+                [
+                    "Here", "are", "some", "sample",
+                    "strings", "to", "be", "sorted"
+                ]
+            ]).map(unlines).join('\n\n')
+        );
+    };
+
+    // GENERIC FUNCTIONS ----------------------------------
+
+    // apList (<*>) :: [a -> b] -> [a] -> [b]
+    const apList = fs => xs =>
+        // The application of each of a list of functions,
+        // to each of a list of values.
+        fs.flatMap(
+            f => xs.flatMap(x => [f(x)])
+        );
+
+    // comparing :: (a -> b) -> (a -> a -> Ordering)
+    const comparing = f =>
+        (x, y) => {
+            const
+                a = f(x),
+                b = f(y);
+            return a < b ? -1 : (a > b ? 1 : 0);
+        };
+
+    // flip :: (a -> b -> c) -> b -> a -> c
+    const flip = f =>
+        1 < f.length ? (
+            (a, b) => f(b, a)
+        ) : (x => y => f(y)(x));
+
+    // length :: [a] -> Int
+    const length = xs =>
+        (Array.isArray(xs) || 'string' === typeof xs) ? (
+            xs.length
+        ) : Infinity;
+
+    // mappendOrd (<>) :: Ordering -> Ordering -> Ordering
+    const mappendOrd = (a, b) => a !== 0 ? a : b;
+
+    // sortBy :: (a -> a -> Ordering) -> [a] -> [a]
+    const sortBy = f => xs =>
+        xs.slice()
+        .sort(f);
+
+    // toLower :: String -> String
+    const toLower = s => s.toLocaleLowerCase();
+
+    // unlines :: [String] -> String
+    const unlines = xs => xs.join('\n');
+
+    // MAIN ---
+    return main();
+})();

Task/Sort-using-a-custom-comparator/Jq/sort-using-a-custom-comparator-1.jq

@@ -0,0 +1,22 @@
+def quicksort(cmp):
+  if length < 2 then .                                     # it is already sorted
+  else .[0] as $pivot
+    | reduce .[] as $x
+      # state: [less, equal, greater]
+      ( [ [], [], [] ];                                    # three empty arrays:
+        if   $x == $pivot then    .[1] += [$x]             # add x to equal
+        else ([$x,$pivot]|cmp) as $order
+          | if   $order == 0 then .[1] += [$x]             # ditto
+            elif ($order|type) == "number" then
+              if $order < 0 then  .[0] += [$x]             # add x to less
+              else .[2] += [$x]                            # add x to greater
+              end
+            else ([$pivot,$x]|cmp) as $order2
+              | if $order and $order2 then   .[1] += [$x]  # add x to equal
+                elif $order then   .[0] += [$x]            # add x to less
+                else .[2] += [$x]                          # add x to greater
+                end
+            end
+        end )
+    | (.[0] | quicksort(cmp) ) + .[1] + (.[2] | quicksort(cmp) )
+  end ;

Task/Sort-using-a-custom-comparator/Jq/sort-using-a-custom-comparator-2.jq

@@ -0,0 +1,3 @@
+# Sort by string length, breaking ties using ordinary string comparison.
+["z", "yz", "ab", "c"]
+  | quicksort( (.[0]|length) > (.[1]|length) or ( (.[0]|length) == (.[1]|length) and .[0] < .[1] ) )

Task/Sort-using-a-custom-comparator/Jq/sort-using-a-custom-comparator-3.jq

@@ -0,0 +1,6 @@
+[
+  "ab",
+  "yz",
+  "c",
+  "z"
+]

Task/Sort-using-a-custom-comparator/Julia/sort-using-a-custom-comparator.julia

@@ -0,0 +1,7 @@
+wl = filter(!isempty, split("""You will rejoice to hear that no disaster has accompanied the
+    commencement of an enterprise which you have regarded with such evil
+    forebodings.""", r"\W+"))
+
+println("Original list:\n - ", join(wl, "\n - "))
+sort!(wl; by=x -> (-length(x), lowercase(x)))
+println("\nSorted list:\n - ", join(wl, "\n - "))

Task/Sort-using-a-custom-comparator/Kotlin/sort-using-a-custom-comparator-1.kotlin

@@ -0,0 +1,22 @@
+import java.util.Arrays
+
+fun main(args: Array<String>) {
+    val strings = arrayOf("Here", "are", "some", "sample", "strings", "to", "be", "sorted")
+
+    fun printArray(message: String, array: Array<String>) = with(array) {
+        print("$message [")
+        forEachIndexed { index, string ->
+            print(if (index == lastIndex) string else "$string, ")
+        }
+        println("]")
+    }
+
+    printArray("Unsorted:", strings)
+
+    Arrays.sort(strings) { first, second ->
+        val lengthDifference = second.length - first.length
+        if (lengthDifference == 0) first.lowercase().compareTo(second.lowercase(), true) else lengthDifference
+    }
+
+    printArray("Sorted:", strings)
+}

Task/Sort-using-a-custom-comparator/Kotlin/sort-using-a-custom-comparator-2.kotlin

@@ -0,0 +1,9 @@
+fun main(args: Array<String>) {
+    val strings = listOf("Here", "are", "some", "sample", "strings", "to", "be", "sorted")
+    println("Unsorted: $strings")
+
+    // sort by content first then by length => no need for a custom comparator since sortedByDescending is stable
+    val sorted = strings.sortedBy { it.lowercase() }.sortedByDescending { it.length }
+
+    println("Sorted: $sorted")
+}

Task/Sort-using-a-custom-comparator/Kotlin/sort-using-a-custom-comparator-3.kotlin

@@ -0,0 +1,13 @@
+fun main(args: Array<String>) {
+    val strings = listOf("Here", "are", "some", "sample", "strings", "to", "be", "sorted")
+    println("Unsorted: $strings")
+
+    val sorted = strings.sortedWith { a, b ->
+            compareValues(b.length, a.length).let {
+                if (it == 0) compareValues(a.lowercase(), b.lowercase())
+                else it
+            }
+        }
+
+    println("Sorted: $sorted")
+}

Task/Sort-using-a-custom-comparator/Kotlin/sort-using-a-custom-comparator-4.kotlin

@@ -0,0 +1,13 @@
+fun main(args: Array<String>) {
+    val strings = listOf("Here", "are", "some", "sample", "strings", "to", "be", "sorted")
+    println("Unsorted: $strings")
+
+    val sorted = strings.map { Triple(it, it.length, it.lowercase()) }.sortedWith { a, b ->
+            compareValues(b.second, a.second).let {
+                    if (it == 0) compareValues(a.third, b.third)
+                    else it
+                }
+        }.map { it.first }
+
+    println("Sorted: $sorted")
+}

Task/Sort-using-a-custom-comparator/Lambdatalk/sort-using-a-custom-comparator.lambdatalk

@@ -0,0 +1,26 @@
+{def sortbylength
+
+ {def sortbylength.i
+  {lambda {:x :a}
+   {if {A.empty? :a}
+    then {A.new :x}
+    else {if {> {W.length :x} {W.length {A.first :a}}}
+    then {A.addfirst! :x :a}
+    else {A.addfirst! {A.first :a}
+                      {sortbylength.i :x {A.rest :a}}} }}}}
+
+ {def sortbylength.r
+  {lambda {:a1 :a2}
+   {if {A.empty? :a1}
+    then :a2
+    else {sortbylength.r {A.rest :a1}
+                         {sortbylength.i {A.first :a1} :a2}} }}}
+
+ {lambda {:s}
+  {S.replace (\[|\]) by in
+   {S.replace , by space in
+    {A.disp {sortbylength.r {A.new :s} {A.new}} }}}}}
+-> sortbylength
+
+{sortbylength here are Some sample strings to be sorted}
+-> strings sample sorted here Some are to be

Task/Sort-using-a-custom-comparator/Lua/sort-using-a-custom-comparator.lua

@@ -0,0 +1,12 @@
+test = { "Here", "we", "have", "some", "sample", "strings", "to", "be", "sorted" }
+
+function stringSorter(a, b)
+	if string.len(a) == string.len(b) then
+		return string.lower(a) < string.lower(b)
+	end
+	return string.len(a) > string.len(b)
+end
+table.sort(test, stringSorter)
+
+-- print sorted table
+for k,v in pairs(test) do print(v) end

Task/Sort-using-a-custom-comparator/M2000-Interpreter/sort-using-a-custom-comparator-1.m2000

@@ -0,0 +1,79 @@
+Module Checkit {
+      Class Quick {
+            Private:
+         partition=lambda-> {
+               Read &A(), p, r : i = p-1 : x=A(r)
+               For j=p to r-1 {If .LE(A(j), x) Then i++:Swap A(i),A(j)
+               } : Swap A(i+1), A(r) :  Push  i+2, i
+         }
+            Public:
+         LE=Lambda->Number<=Number
+         Module ForStrings {
+               .partition<=lambda-> {
+                     Read &a$(), p, r : i = p-1 : x$=a$(r)
+                     For j=p to r-1 {If a$(j)<= x$ Then i++:Swap a$(i),a$(j)
+                     } : Swap a$(i+1), a$(r) : Push i+2, i
+               }
+         }
+         Function quicksort {
+              Read ref$
+              {
+                      loop : If Stackitem() >= Stackitem(2) Then Drop 2 : if  empty then {Break} else continue
+                      over 2,2 : call .partition(ref$) :shift 3
+              }
+         }
+      }
+      Quick=Quick()
+
+      ToSort$="this is a set of strings to sort This Is A Set Of Strings To Sort"
+      Dim a$()
+      a$()=Piece$(ToSort$, " ")
+      \\ we can redim to any range
+      Dim a$(100 to len(a$())+99)  ' from 100 to 115 (16 items)
+      Group Quick {
+            Module ForStringsSpecial {
+               .partition<=lambda-> {
+                        Read &a$(), p, r : i = p-1 : x$=a$(r) :lx$=lcase$(x$) : k=len(x$)
+                        For j=p to r-1 {
+                              m=len(a$(j))
+                              select case compare(m, k)
+                              case 0
+                              {
+                                   aj$=lcase$(a$(j))
+                                   if aj$>lx$ then exit
+                                   if aj$=lx$ then if a$(j)<=x$ then exit
+                                   i++
+                                   Swap a$(i),a$(j)
+                              }
+                              case 1
+                              {
+                                    i++:Swap a$(i),a$(j)
+                              }
+                              End Select
+                     } : Swap a$(i+1), a$(r) : Push i+2, i
+               }
+         }
+      }
+      Document doc$={Unsorted List:
+      }
+      k=each(a$())
+      While k {
+            doc$="   "+array$(k)+{
+            }
+      }
+      Quick.ForStringsSpecial
+      \\ Dimension(a$(), 0, 1) is Lbound a$() first dimension
+      \\ Dimension(a$(), 0, 1) is Ubound a$() first dimension
+      Call Quick.quicksort(&a$(), Dimension(a$(), 0, 1), Dimension(a$(), 1,1))
+      k=each(a$())
+      Doc$={
+            Sorted List:
+            }
+      While k {
+            doc$="   "+array$(k)+{
+            }
+      }
+      Report doc$
+      Clipboard doc$
+}
+Checkit

Task/Sort-using-a-custom-comparator/M2000-Interpreter/sort-using-a-custom-comparator-2.m2000

@@ -0,0 +1,28 @@
+Group Quick {
+      Module ForStringsSpecial {
+         .partition<=lambda-> {
+                  Read &a$(), p, r : i = p-1 : x$=a$(r) :lx$=lcase$(x$) : k=len(x$)
+                  For j=p to r-1 {
+                        m=len(a$(j))
+                        select case compare(m, k)
+                        case 0
+                        {
+                              aj$=lcase$(a$(j))
+                              \\ in Case the Break statement execute all cases until a case has a Continue
+                              select case compare(aj$, lx$)
+                              case 0
+                                   if a$(j)>x$ then break
+                              Case 1
+                                   swapit()
+                             End Select
+                        }
+                        case 1
+                             swapit()
+                        End Select
+               } : Swap a$(i+1), a$(r) : Push i+2, i
+               Sub swapit()
+                     i++:Swap a$(i),a$(j)
+               End Sub
+         }
+   }
+}

Task/Sort-using-a-custom-comparator/MAXScript/sort-using-a-custom-comparator.max

@@ -0,0 +1,23 @@
+fn myCmp str1 str2 =
+(
+    case of
+    (
+        (str1.count < str2.count):  1
+        (str1.count > str2.count): -1
+        default:(
+                -- String compare is case sensitive, name compare isn't. Hence...
+                str1 = str1 as name
+                str2 = str2 as name
+                case of
+                (
+                    (str1 > str2):  1
+                    (str1 < str2): -1
+                    default:        0
+                )
+                )
+    )
+)	
+
+strList = #("Here", "are", "some", "sample", "strings", "to", "be", "sorted")
+qSort strList myCmp
+print strList

Task/Sort-using-a-custom-comparator/Maple/sort-using-a-custom-comparator.maple

@@ -0,0 +1,15 @@
+Compare_fn:= proc(s1, s2)
+	local len1, len2;
+	len1 := StringTools:-Length(s1);
+	len2 := StringTools:-Length(s2);
+	if (len1 > len2) then
+		return true;
+	elif (len1 < len2) then
+		return false;
+	else # ascending lexicographic order for strings of equal length / case insensitive
+		StringTools:-CompareCI(s1, s2);
+	end if;
+end proc:
+
+L := ["Here", "are", "some", "sample", "strings", "to", "be", "sorted", "Tooo"];
+sort(L, Compare_fn);

Task/Sort-using-a-custom-comparator/Mathematica/sort-using-a-custom-comparator.math

@@ -0,0 +1,7 @@
+StringOrderQ[x_String, y_String] :=
+ If[StringLength[x] == StringLength[y],
+       OrderedQ[{x, y}],
+       StringLength[x] >StringLength[y]
+   ]
+words={"on","sunday","sander","sifted","and","sorted","sambaa","for","a","second"};
+Sort[words,StringOrderQ]

Task/Sort-using-a-custom-comparator/Maxima/sort-using-a-custom-comparator.maxima

@@ -0,0 +1,8 @@
+strangeorderp(a, b) := slength(a) > slength(b) or (slength(a) = slength(b) and orderlessp(a, b))$
+s: tokens("Lorem ipsum dolor sit amet consectetur adipiscing elit Sed non risus Suspendisse\
+ lectus tortor dignissim sit amet adipiscing nec ultricies sed dolor")$
+
+sort(s, strangeorderp);
+["Suspendisse", "consectetur", "adipiscing", "adipiscing", "dignissim", "ultricies",
+"lectus", "tortor", "Lorem", "dolor", "dolor", "ipsum", "risus", "amet", "amet",
+"elit", "Sed", "nec", "non", "sed", "sit", "sit"]

Task/Sort-using-a-custom-comparator/Min/sort-using-a-custom-comparator.min

@@ -0,0 +1,2 @@
+("Here" "are" "some" "sample" "strings" "to" "be" "sorted")
+(((length) (length)) spread <) sort print

Task/Sort-using-a-custom-comparator/Nemerle/sort-using-a-custom-comparator.nemerle

@@ -0,0 +1,13 @@
+using System.Console;
+
+module CustomSort
+{
+    Main() : void
+    {
+        def strings1 = ["these", "are", "strings", "of", "different", "length"];
+        def strings2 = ["apple", "House", "chewy", "Salty", "rises", "Later"];
+
+        WriteLine(strings1.Sort((x, y) => y.Length.CompareTo(x.Length)));
+        WriteLine(strings2.Sort((x, y) => x.CompareTo(y)))
+    }
+}

Task/Sort-using-a-custom-comparator/NetRexx/sort-using-a-custom-comparator.netrexx

@@ -0,0 +1,32 @@
+/* NetRexx */
+options replace format comments java crossref symbols nobinary
+
+-- =============================================================================
+class RSortCustomComparator public
+
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+method main(args = String[]) public static
+  sample = [String 'Here', 'are', 'some', 'sample', 'strings', 'to', 'be', 'sorted']
+  say displayArray(sample)
+  Arrays.sort(sample, LengthComparator())
+  say displayArray(sample)
+  return
+
+method displayArray(harry = String[]) constant
+  disp = ''
+  loop elmt over harry
+    disp = disp','elmt
+    end elmt
+  return '['disp.substr(2)']' -- trim leading comma
+
+-- =============================================================================
+class RSortCustomComparator.LengthComparator implements Comparator
+
+method compare(lft = Object, rgt = Object) public binary returns int
+  cRes = int
+  if lft <= String, rgt <= String then do
+    cRes = (String rgt).length - (String lft).length
+    if cRes == 0 then cRes = (String lft).compareToIgnoreCase(String rgt)
+    end
+  else signal IllegalArgumentException('Arguments must be Strings')
+  return cRes

Task/Sort-using-a-custom-comparator/Nial/sort-using-a-custom-comparator.nial

@@ -0,0 +1,4 @@
+sort fork [=[tally first,tally last],up, >= [tally first,tally last]] ['Here', 'are', 'some', 'sample', 'strings', 'to', 'be', 'sorted']
+=+-------+------+------+----+----+---+--+--+
+=|strings|sample|sorted|Here|some|are|be|to|
+=+-------+------+------+----+----+---+--+--+

Task/Sort-using-a-custom-comparator/Nim/sort-using-a-custom-comparator.nim

@@ -0,0 +1,11 @@
+import strutils, algorithm
+
+var strings = "here are Some sample strings to be sorted".split(' ')
+
+strings.sort(proc (x, y: string): int =
+  result = cmp(y.len, x.len)
+  if result == 0:
+    result = cmpIgnoreCase(x, y)
+)
+
+echo strings

Task/Sort-using-a-custom-comparator/OCaml/sort-using-a-custom-comparator-1.ocaml

@@ -0,0 +1,5 @@
+let mycmp s1 s2 =
+  if String.length s1 <> String.length s2 then
+    compare (String.length s2) (String.length s1)
+  else
+    String.compare (String.lowercase s1) (String.lowercase s2)

Task/Sort-using-a-custom-comparator/OCaml/sort-using-a-custom-comparator-2.ocaml

@@ -0,0 +1,6 @@
+# let strings = ["Here"; "are"; "some"; "sample"; "strings"; "to"; "be"; "sorted"];;
+val strings : string list =
+  ["Here"; "are"; "some"; "sample"; "strings"; "to"; "be"; "sorted"]
+# List.sort mycmp strings;;
+- : string list =
+["strings"; "sample"; "sorted"; "Here"; "some"; "are"; "be"; "to"]

Task/Sort-using-a-custom-comparator/OCaml/sort-using-a-custom-comparator-3.ocaml

@@ -0,0 +1,8 @@
+# let strings = [|"Here"; "are"; "some"; "sample"; "strings"; "to"; "be"; "sorted"|];;
+val strings : string array =
+  [|"Here"; "are"; "some"; "sample"; "strings"; "to"; "be"; "sorted"|]
+# Array.sort mycmp strings;;
+- : unit = ()
+# strings;;
+- : string array =
+[|"strings"; "sample"; "sorted"; "Here"; "some"; "are"; "be"; "to"|]

Task/Sort-using-a-custom-comparator/Objeck/sort-using-a-custom-comparator.objeck

@@ -0,0 +1,57 @@
+use Collection;
+
+class Test {
+  function : Main(args : String[]) ~ Nil {
+    v := CreateHolders(["Here", "are", "some", "sample", "strings", "to", "be", "sorted"]);
+    "unsorted: "->Print(); Show(v);
+    v->Sort();
+    "sorted: "->Print(); Show(v);
+  }
+
+  function : CreateHolders(strings : String[]) ~ CompareVector {
+    vector := CompareVector->New();
+    each(i : strings) {
+      vector->AddBack(StringHolder->New(strings[i]));
+    };
+
+    return vector;
+  }
+
+  function : Show(v : CompareVector) ~ Nil {
+    each(i : v) {
+      s := v->Get(i)->As(StringHolder);
+      s->ToString()->Print();
+      if(i + 1 < v->Size()) {
+        ','->Print();
+      };
+    };
+    '\n'->Print();
+  }
+}
+
+class StringHolder implements Compare {
+  @s : String;
+
+  New(s : String) {
+    @s := s;
+  }
+
+  method : public : Compare(c : Compare) ~ Int {
+    h := c->As(StringHolder);
+    r := h->ToString();
+    size := r->Size() - @s->Size();
+    if(size = 0) {
+      size := @s->ToUpper()->Compare(r->ToUpper());
+    };
+
+    return size;
+  }
+
+  method : public : HashID() ~ Int {
+    return @s->HashID();
+  }
+
+  method : public : ToString() ~ String {
+    return @s;
+  }
+}

Task/Sort-using-a-custom-comparator/Objective-C/sort-using-a-custom-comparator-1.m

@@ -0,0 +1,28 @@
+#import <Foundation/Foundation.h>
+
+#define esign(X) (((X)>0)?1:(((X)<0)?-1:0))
+
+int main()
+{
+  @autoreleasepool {
+
+    NSMutableArray *arr =
+    [NSMutableArray
+      arrayWithArray: [@"this is a set of strings to sort"
+                       componentsSeparatedByString: @" "]
+     ];
+
+    [arr sortUsingComparator: ^NSComparisonResult(id obj1, id obj2){
+      NSComparisonResult l = esign((int)([obj1 length] - [obj2 length]));
+      return l ? -l // reverse the ordering
+               : [obj1 caseInsensitiveCompare: obj2];
+     }];
+
+    for( NSString *str in arr )
+    {
+      NSLog(@"%@", str);
+    }
+
+  }
+  return EXIT_SUCCESS;
+}

Task/Sort-using-a-custom-comparator/Objective-C/sort-using-a-custom-comparator-2.m

@@ -0,0 +1,36 @@
+#import <Foundation/Foundation.h>
+
+@interface NSString (CustomComp)
+- (NSComparisonResult)my_compare: (id)obj;
+@end
+
+#define esign(X) (((X)>0)?1:(((X)<0)?-1:0))
+@implementation NSString (CustomComp)
+- (NSComparisonResult)my_compare: (id)obj
+{
+  NSComparisonResult l = esign((int)([self length] - [obj length]));
+  return l ? -l // reverse the ordering
+           : [self caseInsensitiveCompare: obj];
+}
+@end
+
+int main()
+{
+  @autoreleasepool {
+
+    NSMutableArray *arr =
+       [NSMutableArray
+         arrayWithArray: [@"this is a set of strings to sort"
+                           componentsSeparatedByString: @" "]
+       ];
+
+    [arr sortUsingSelector: @selector(my_compare:)];
+
+    for ( NSString *str in arr )
+    {
+      NSLog(@"%@", str);
+    }
+
+  }
+  return EXIT_SUCCESS;
+}

Task/Sort-using-a-custom-comparator/Objective-C/sort-using-a-custom-comparator-3.m

@@ -0,0 +1,18 @@
+#import <Foundation/Foundation.h>
+
+int main()
+{
+  @autoreleasepool {
+
+    NSArray *strings = [@"Here are some sample strings to be sorted" componentsSeparatedByString:@" "];
+
+    NSSortDescriptor *sd1 = [[NSSortDescriptor alloc] initWithKey:@"length" ascending:NO];
+    NSSortDescriptor *sd2 = [[NSSortDescriptor alloc] initWithKey:@"lowercaseString" ascending:YES];
+
+    NSArray *sorted = [strings sortedArrayUsingDescriptors:@[sd1, sd2]];
+    NSLog(@"%@", sorted);
+
+  }
+
+  return 0;
+}

Task/Sort-using-a-custom-comparator/Oforth/sort-using-a-custom-comparator.fth

@@ -0,0 +1,7 @@
+String method: customCmp(s)
+   s size self size > ifTrue: [ true return ]
+   s size self size < ifTrue: [ false return ]
+   s toUpper self toUpper <= ;
+
+["this", "is", "a", "set", "of", "strings", "to", "sort", "This", "Is", "A", "Set", "Of", "Strings", "To", "Sort"]
+sortWith(#customCmp) println

Task/Sort-using-a-custom-comparator/Ol/sort-using-a-custom-comparator.ol

@@ -0,0 +1,16 @@
+(import (scheme char))
+
+(define (comp a b)
+   (let ((la (string-length a))
+         (lb (string-length b)))
+      (or
+         (> la lb)
+         (and (= la lb) (string-ci<? a b)))))
+
+(print
+   (sort comp '(
+      "lorem" "ipsum" "dolor" "sit" "amet" "consectetur"
+      "adipiscing" "elit" "maecenas" "varius" "sapien"
+      "vel" "purus" "hendrerit" "vehicula" "integer"
+      "hendrerit" "viverra" "turpis" "ac" "sagittis"
+      "arcu" "pharetra" "id")))

Task/Sort-using-a-custom-comparator/OoRexx/sort-using-a-custom-comparator.rexx

@@ -0,0 +1,10 @@
+A=.array~of('The seven deadly sins','Pride','avarice','Wrath','envy','gluttony','sloth','Lust')
+say 'Sorted in order of descending length, and in ascending lexicographic order'
+say A~sortWith(.DescLengthAscLexical~new)~makeString
+
+::class DescLengthAscLexical mixinclass Comparator
+::method compare
+use strict arg left, right
+if left~length==right~length
+  then return left~caselessCompareTo(right)
+  else return right~length-left~length

Task/Sort-using-a-custom-comparator/OxygenBasic/sort-using-a-custom-comparator.basic

@@ -0,0 +1,34 @@
+uses generics 'containing sort macros
+uses console
+string sdata={"CC","Aa","aAa","bb","bbB","b","B","c","A"}
+'
+int count = countof sdata
+'
+macro filter(f,a)
+=================
+  'sdata[a]
+  f=1 'allow all
+end macro
+'
+macro compare(f,a,b)
+====================
+  int la=len sdata[a]
+  int lb=len sdata[b]
+  if la<lb
+    f=1 'descending length
+  elseif la>lb
+    '
+  elseif ucase(sdata[a])>ucase(sdata[b])
+    f=1 'ascending but case insensitive
+  endif
+end macro
+'
+NewSortIndex(index,count,rcount,filter,compare)
+NewSortedData(sorted,sdata,index,rcount)
+'
+print "Count: " rcount cr cr
+int i
+for i=1 to rcount
+  print sorted[i] cr
+next
+pause

Task/Sort-using-a-custom-comparator/Oz/sort-using-a-custom-comparator.oz

@@ -0,0 +1,21 @@
+declare
+  fun {LexicographicLessThan Xs Ys}
+     for
+        X in {Map Xs Char.toLower}
+        Y in {Map Ys Char.toLower}
+        return:Return
+        default:{Length Xs}<{Length Ys}
+     do
+        if X < Y then {Return true} end
+     end
+  end
+
+  fun {LessThan Xs Ys}
+     {Length Xs} > {Length Ys}
+     orelse
+     {Length Xs} == {Length Ys} andthen {LexicographicLessThan Xs Ys}
+  end
+
+  Strings = ["Here" "are" "some" "sample" "strings" "to" "be" "sorted"]
+in
+  {ForAll {Sort Strings LessThan} System.showInfo}

Task/Sort-using-a-custom-comparator/PARI-GP/sort-using-a-custom-comparator.parigp

@@ -0,0 +1,2 @@
+cmp(a,b)=if(#a<#b,1,if(#a>#b,-1,lex(a,b)));
+vecsort(v,cmp)

Task/Sort-using-a-custom-comparator/PHP/sort-using-a-custom-comparator.php

@@ -0,0 +1,11 @@
+<?php
+function mycmp($s1, $s2)
+{
+    if ($d = strlen($s2) - strlen($s1))
+        return $d;
+    return strcasecmp($s1, $s2);
+}
+
+$strings = array("Here", "are", "some", "sample", "strings", "to", "be", "sorted");
+usort($strings, "mycmp");
+?>

Task/Sort-using-a-custom-comparator/PL-I/sort-using-a-custom-comparator.pli

@@ -0,0 +1,70 @@
+MRGEPKG: package exports(MERGESORT,MERGE,RMERGE);
+
+DCL (T(4)) CHAR(20) VAR; /* scratch space of length N/2 */
+
+MERGE: PROCEDURE (A,LA,B,LB,C,CMPFN);
+   DECLARE (A(*),B(*),C(*)) CHAR(*) VAR;
+   DECLARE (LA,LB) FIXED BIN(31) NONASGN;
+   DECLARE (I,J,K) FIXED BIN(31);
+   DECLARE CMPFN ENTRY(
+          NONASGN CHAR(*) VAR,
+          NONASGN CHAR(*) VAR)
+          RETURNS (FIXED bin(31));
+
+   I=1; J=1; K=1;
+   DO WHILE ((I <= LA) & (J <= LB));
+      IF CMPFN(A(I),B(J)) <= 0 THEN
+         DO; C(K)=A(I); K=K+1; I=I+1; END;
+      ELSE
+         DO; C(K)=B(J); K=K+1; J=J+1; END;
+   END;
+   DO WHILE (I <= LA);
+      C(K)=A(I); I=I+1; K=K+1;
+   END;
+   return;
+END MERGE;
+
+MERGESORT: PROCEDURE (A,N,CMPFN) RECURSIVE ;
+     DECLARE (A(*))               CHAR(*) VAR;
+     DECLARE N                    FIXED BINARY(31) NONASGN;
+     DECLARE CMPFN                ENTRY(
+          NONASGN CHAR(*) VAR,
+          NONASGN CHAR(*) VAR)
+                                  RETURNS (FIXED bin(31));
+     DECLARE (M,I)                FIXED BINARY;
+     DECLARE AMP1(N)              CHAR(20) VAR BASED(P);
+     DECLARE P POINTER;
+
+   IF (N=1) THEN RETURN;
+   M = trunc((N+1)/2);
+   IF M > 1 THEN CALL MERGESORT(A,M,CMPFN);
+   P=ADDR(A(M+1));
+   IF (N-M > 1) THEN CALL MERGESORT(AMP1,N-M,CMPFN);
+   IF CMPFN(A(M),AMP1(1)) <= 0 THEN RETURN;
+   DO I=1 to M; T(I)=A(I); END;
+   CALL MERGE(T,M,AMP1,N-M,A,CMPFN);
+END MERGESORT;
+
+RMERGE: PROC OPTIONS(MAIN);
+DCL I FIXED BIN(31);
+DCL A(8) CHAR(20) VAR INIT("this","is","a","set","of","strings","to","sort");
+
+MyCMP: PROCEDURE(A,B) RETURNS (FIXED BIN(31));
+   DCL (A,B) CHAR(*) VAR NONASGN;
+   DCL (I,J) FIXED BIN(31);
+
+   I = length(trim(A)); J = length(trim(B));
+   IF I < J THEN RETURN(+1);
+   IF I > J THEN RETURN(-1);
+   IF lowercase(A) < lowercase(B) THEN RETURN(-1);
+   IF lowercase(A) > lowercase(B) THEN RETURN(+1);
+   RETURN (0);
+END MyCMP;
+
+CALL MERGESORT(A,8,MyCMP);
+DO I=1 TO 8;
+   put edit (I,A(I)) (F(5),X(2),A(10)) skip;
+END;
+
+put skip;
+END RMERGE;

Task/Sort-using-a-custom-comparator/Pascal/sort-using-a-custom-comparator.pas

@@ -0,0 +1,26 @@
+program CustomComparator;
+{$mode objfpc}{$h+}
+uses
+  Classes, SysUtils, Math;
+
+function Compare(List: TStringList; Index1, Index2: Integer): Integer;
+begin
+  Result := CompareValue(Length(List[Index2]), Length(List[Index1]));
+  if Result = 0 then
+    Result := CompareText(List[Index1], List[Index2]);
+end;
+
+const
+  Sample = 'Here are some sample strings to be sorted';
+
+begin
+  with TStringList.Create do
+    try
+      AddStrings(Sample.Split([' '], TStringSplitOptions.ExcludeEmpty));
+      CustomSort(@Compare);
+      WriteLn(string.Join(', ', ToStringArray));
+    finally
+      Free;
+    end;
+  Readln;
+end.

Task/Sort-using-a-custom-comparator/Perl/sort-using-a-custom-comparator.pl

@@ -0,0 +1,16 @@
+use feature 'say';
+
+@strings = qw/Here are some sample strings to be sorted/;
+
+# with a subroutine:
+sub mycmp { length $b <=> length $a || lc $a cmp lc $b }
+say join ' ', sort mycmp @strings;
+
+# inline:
+say join ' ', sort {length $b <=> length $a || lc $a cmp lc $b} @strings
+
+# for large inputs, can be faster with a 'Schwartzian' transform:
+say join ' ', map  { $_->[0] }
+             sort { $b->[1] <=> $a->[1] || $a->[2] cmp $b->[2] }
+             map  { [ $_, length, lc ] }
+             @strings;

Task/Sort-using-a-custom-comparator/Phix/sort-using-a-custom-comparator.phix

@@ -0,0 +1,10 @@
+-->
+ <span style="color: #008080;">function</span> <span style="color: #000000;">my_compare</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">)</span>
+     <span style="color: #004080;">integer</span> <span style="color: #000000;">c</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">-</span><span style="color: #7060A8;">compare</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">),</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">b</span><span style="color: #0000FF;">))</span>  <span style="color: #000080;font-style:italic;">-- descending length</span>
+     <span style="color: #008080;">if</span> <span style="color: #000000;">c</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
+         <span style="color: #000000;">c</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">compare</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">lower</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">),</span><span style="color: #7060A8;">lower</span><span style="color: #0000FF;">(</span><span style="color: #000000;">b</span><span style="color: #0000FF;">))</span>         <span style="color: #000080;font-style:italic;">-- ascending lexical within same length</span>
+     <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
+     <span style="color: #008080;">return</span> <span style="color: #000000;">c</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+ <span style="color: #0000FF;">?</span><span style="color: #7060A8;">custom_sort</span><span style="color: #0000FF;">(</span><span style="color: #000000;">my_compare</span><span style="color: #0000FF;">,{</span><span style="color: #008000;">"Here"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"are"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"some"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"sample"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"strings"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"to"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"be"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"sorted"</span><span style="color: #0000FF;">})</span>
+<!--

Task/Sort-using-a-custom-comparator/PicoLisp/sort-using-a-custom-comparator-1.l

@@ -0,0 +1,2 @@
+: (sort '("def" "abc" "ghi") >)
+-> ("ghi" "def" "abc")

Task/Sort-using-a-custom-comparator/PicoLisp/sort-using-a-custom-comparator-2.l

@@ -0,0 +1,2 @@
+: (flip (sort '("def" "abc" "ghi")))
+-> ("ghi" "def" "abc")