Sort using a custom comparator

Sort using a custom comparator
You are encouraged to solve this task according to the task description, using any language you may know.

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.

Ada

Works with: GNAT

<lang ada> 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;</lang>

Output

The output file looks like this: <lang txt>Unsorted list: this is a set of strings to sort This Is A Set Of Strings To Sort

Sorted list: strings Strings sort Sort this This Set set is Is Of of to To a A</lang>

AutoHotkey

<lang AutoHotkey>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) }</lang>

C

Works with: POSIX version .1-2001

<lang c>#include <stdlib.h> /* for qsort */

1. include <string.h> /* for strlen */
2. 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;

}</lang>

C++

Works with: g++ version 4.1.2

<lang cpp>#include <algorithm>

1. include <string>
2. include <cctype>

// compare character case-insensitive bool icompare_char(char c1, char c2) {

 return std::toupper(c1) < std::toupper(c2);

}

// return true if s1 comes before s2 bool compare(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;

}</lang>

C#

C# allows you to specify a custom compare to the built in sort method on a list

<lang csharp>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();
       }
   }

}</lang>

Output File

Unsorted
********
Here
are
some
sample
strings
to
be
sorted

Descending Length
*****************
strings
sample
sorted
Here
some
are
be
to

Ascending order
***************
are
be
Here
sample
some
sorted
strings
to

Alternative using Linq (.NET 3.5)

<lang csharp>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(); } } } </lang>

Clean

<lang clean>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"]</lang>

Clojure

Clojure's sort function has a 2-argument version where the first argument is a java.util.Comparator, and the second is the collection to be sorted. Thus the heart of this version is a comparator function that satisfies the problem spec. What makes this work is that all Clojure functions (thus rosetta-code defined here) implement the java.util.Comparator interface. <lang clojure>(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"]))</lang>

Output:

(strings sample sorted Here some are be to)

An alternative, using sort-by: <lang clojure>(sort-by (juxt (comp - count) #(.toLowerCase %))

        ["Here" "are" "some" "sample" "strings" "to" "be" "sorted"])</lang>

Common Lisp

In Common Lisp, the sort function takes a "less than" predicate that is used as the comparator. This parameter can be any two-argument function. Note: Common Lisp's sort function is destructive; for lists you should not use the original list afterwards, you should only use the return value.

For example, to sort strings case-insensitively in ascending order:

<lang lisp>CL-USER> (defvar *strings*

                '("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")</lang>

You can also provide an optional key function which maps each element to a key. The keys are then compared using the comparator. For example, to sort strings by length in descending order:

<lang lisp>CL-USER> (defvar *strings*

                '("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")</lang>

D

<lang d>import std.stdio, std.string, std.algorithm, std.typecons;

void main() {

 auto data = "here are Some sample strings to be sorted".split();
 schwartzSort!((s){ return tuple(-s.length, s.toupper()); })(data);
 writeln(data);

}</lang> Output:

[strings, sample, sorted, here, Some, are, be, to]

Delphi

<lang Delphi>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
   Result := Length(Right) - Length(Left);
 end));

end.</lang>

E

<lang e>/** 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) }) 
         })</lang>

Euphoria

<lang euphoria>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})</lang>

Output:

Unsorted:
{
  "sorted",
  "be",
  "to",
  "strings",
  "sample",
  "some",
  "are",
  "Here"
}

Sorted:
{
  "strings",
  "sample",
  "sorted",
  "Here",
  "some",
  "are",
  "be",
  "to"
}

F#

<lang fsharp>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</lang>

Output:

["strings"; "sample"; "sorted"; "Here"; "some"; "are"; "be"; "to"]

Factor

<lang factor>: 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</lang>

Fantom

The List's sort method can be customised using a custom comparator. This is a method which returns an Int: -1 for less than, 0 for equal, +1 for greater than.

<lang fantom> 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(" "))
 }

} </lang>

Output:

$ fan comparator-sort.fan 
Started with : Cat apple Adam zero Xmas quit Level add Actor base butter
Finished with: butter Actor apple Level Adam base quit Xmas zero add Cat

Fortran

Fortran does not have builtin to sort arrays (of numbers or strings), with or without custom comparator; so we need modifying e.g. this code in order to handle strings and to accept a custom comparator.

<lang fortran>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</lang>

Then we have to put our custom comparator in a module (to_lower is defined here):

<lang fortran>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</lang>

At the end, we can test these:

<lang fortran>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</lang>

Go

<lang go>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)")

}</lang> Output:

[To tell your name the livelong day To an admiring bog] (original)
[admiring livelong name tell your bog day the an To To] (sorted)

Groovy

The "custom comparator" is just a closure attached to the sort method invocation. <lang groovy>def strings = "Here are some sample strings to be sorted".split() strings.sort { x, y ->

   x.length() == y.length() \
       ? x.compareToIgnoreCase(y) \
       : y.length() <=> x.length()

} println strings</lang>

Output:

[strings, sample, sorted, Here, some, are, be, to]

Haskell

Works with: GHC

<lang haskell>import List import Char

mycmp s1 s2 = case compare (length s2) (length s1) of

                EQ -> compare (map toLower s1) (map toLower s2)
                x  -> x

strings = ["Here", "are", "some", "sample", "strings", "to", "be", "sorted"] sorted = sortBy mycmp strings</lang>

Alternate definition of mycmp using the Monoid instance for Ordering:

<lang haskell>import Data.Monoid mycmp s1 s2 = mappend (compare (length s2) (length s1))

                      (compare (map toLower s1) (map toLower s2))</lang>

Icon and Unicon

<lang Icon>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</lang>

Note(1): This example relies on the supporting procedures 'sortop', and 'demosort' in Bubble Sort.
Note(2): This example can utilize any of the sorting algorithms that share the same base code including: Bubble, Cocktail, Comb, Gnome, and Shell.
Note(3): Using 'map' in the 'cmptask' procedure would not be efficient on large lists.

Sample Output:

Sorting Demo for custom comparator
  Unsorted Input : 
    "Here"
    "are"
    "some"
    "sample"
    "strings"
    "to"
    "be"
    "sorted"
  Sorted Output : 
    "strings"
    "sample"
    "sorted"
    "Here"
    "some"
    "are"
    "be"
    "to"

J

Case-insensitivity is obtained using lower, a verb taken from Change string case. Standard utilities tolower or toupper may be substituted.

<lang j> 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| +-------+------+------+----+----+---+--+--+</lang>

Java

Works with: Java version 1.5+

<lang java5>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 + " ");
 }

}</lang>

JavaScript

<lang javascript>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</lang>

Lua

<lang lua>function pair(a, b) return a[1] < b[1] end

t = { {2, 5}, {1, 6}, {4, 8}, {3, 2} } table.sort(t, pair) for i, v in ipairs(t) do print(unpack(v)) end</lang>

Mathematica

We define a new function to give true or false if two elements are in order. After that we can simply use the built-in Sort with an ordering function: <lang Mathematica>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]</lang> gives back:

{sambaa,sander,second,sifted,sorted,sunday,and,for,on,a}

MAXScript

<lang maxscript>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</lang>

Nial

<lang nial>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| =+-------+------+------+----+----+---+--+--+</lang>

Objective-C

Works with: Cocoa version Mac OS X 10.6+

Using blocks: <lang objc>#import <Foundation/Foundation.h>

1. define esign(X) (((X)>0)?1:(((X)<0)?-1:0))

int main() {

 NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init];

 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);
 }

 [pool release];
 return EXIT_SUCCESS;

}</lang>

Works with: GNUstep

Works with: Cocoa

<lang objc>#import <Foundation/Foundation.h>

@interface NSString (CustomComp) - (NSComparisonResult)my_compare: (id)obj; @end

1. 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() {

 NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init];

 NSMutableArray *arr =
    [NSMutableArray
      arrayWithArray: [@"this is a set of strings to sort"
                        componentsSeparatedByString: @" "]
    ];

 [arr sortUsingSelector: @selector(my_compare:)];

 NSEnumerator *iter = [arr objectEnumerator];
 NSString *str;
 while( (str = [iter nextObject]) != nil )
 {
   NSLog(@"%@", str);
 }

 [pool release];
 return EXIT_SUCCESS;

}</lang>

This example can also be written using sort descriptors:

Works with: GNUstep

Works with: Cocoa

<lang objc>#import <Foundation/Foundation.h>

int main() {

 NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init];

 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 *sortDescriptors = [NSArray arrayWithObjects:sd1, sd2, nil];
 [sd1 release];
 [sd2 release];

 NSArray *sorted = [strings sortedArrayUsingDescriptors:sortDescriptors];
 NSLog(@"%@", sorted);

 [pool release];

 return 0;

}</lang>

OCaml

<lang ocaml>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)</lang>

List: <lang ocaml># let strings = ["Here"; "are"; "some"; "sample"; "strings"; "to"; "be"; "sorted"];; val strings : string list =

 ["Here"; "are"; "some"; "sample"; "strings"; "to"; "be"; "sorted"]

1. List.sort mycmp strings;;

- : string list = ["strings"; "sample"; "sorted"; "Here"; "some"; "are"; "be"; "to"]</lang>

Array: <lang ocaml># let strings = [|"Here"; "are"; "some"; "sample"; "strings"; "to"; "be"; "sorted"|];; val strings : string array =

 [|"Here"; "are"; "some"; "sample"; "strings"; "to"; "be"; "sorted"|]

1. Array.sort mycmp strings;;

- : unit = ()

1. strings;;

- : string array = [|"strings"; "sample"; "sorted"; "Here"; "some"; "are"; "be"; "to"|]</lang>

Oz

<lang oz>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}</lang>

PARI/GP

<lang parigp>cmp(a,b)=if(#a<#b,1,if(#a>#b,-1,lex(a,b))); vecsort(v,cmp)</lang>

Perl

Works with: Perl version 5.8.6

<lang perl>sub mycmp { length $b <=> length $a || lc $a cmp lc $b }

my @strings = ("Here", "are", "some", "sample", "strings", "to", "be", "sorted"); my @sorted = sort mycmp @strings;</lang>

Or inline: <lang perl>my @strings = qw/here are some sample strings to be sorted/; my @sorted = sort {length $b <=> length $a || lc $a cmp lc $b} @strings</lang>

Faster with a Schwartzian transform: <lang perl>my @strings = qw/here are some sample strings to be sorted/; my @sorted = map { $_->[0] }

            sort { $a->[1] <=> $b->[1] || $a->[2] cmp $b->[2] }
            map  { [ $_, length, lc ] }
            @strings;</lang>

Perl 6

<lang perl6>my @strings = <Here are some sample strings to be sorted>; my @sorted_strings = sort { $^a.chars <=> $^b.chars or $^a.lc cmp $^b.lc }, @strings; .say for @sorted_strings;</lang> This behavior is triggered by use of an arity 2 sort routine.

If instead the function you feed to sort is of arity 1, it will do the Schwartzian transform for you, automatically sorting numeric fields numerically, and strings fields stringily: <lang perl6>my @sorted_strings = sort -> $x { [ $x.chars, $x.lc ] }, @strings;</lang>

PHP

Works with: PHP version 4.4.4 CLI

<lang php><?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"); ?></lang>

PicoLisp

By default, the sort function in PicoLisp returns an ascending list (of any type). To get a result in descending order, the "greater than" function can be supplied <lang PicoLisp>: (sort '("def" "abc" "ghi") >) -> ("ghi" "def" "abc")</lang> or simply the result reversed (which is, btw, the most efficient way) <lang PicoLisp>: (flip (sort '("def" "abc" "ghi"))) -> ("ghi" "def" "abc")</lang>

PL/I

Works with: IBM PL/I version 7.5

Platform: WIN <lang pli>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;</lang>

Pop11

<lang pop11>lvars ls = ['Here' 'are' 'some' 'sample' 'strings' 'to' 'be' 'sorted']; define compare(s1, s2); lvars k = length(s2) - length(s1); if k < 0 then

   return(true);

elseif k > 0 then

   return(false);

else

   return (alphabefore(uppertolower(s1), uppertolower(s2)));

endif; enddefine;

syssort(ls, compare) -> ls;

NOTE: The definition of compare can also be written thus: define compare(s1, s2);

lvars
    l1 = length(s1),
    l2 = length(s2);
l1 > l2 or (l1 == l2 and alphabefore(uppertolower(s1), uppertolower(s2)))

enddefine;</lang>

PowerBASIC

Works with: PB/Win version 9

Works with: PB/CC version 4

<lang powerbasic>FUNCTION Sorter(p1 AS STRING, p2 AS STRING) AS LONG

   'if p1 should be first, returns -1
   'if p2 should be first, returns 1
   '     if they're equal, returns 0
   IF LEN(p1) > LEN(p2) THEN
       FUNCTION = -1
   ELSEIF LEN(p2) > LEN(p1) THEN
       FUNCTION = 1
   ELSEIF UCASE$(p1) > UCASE$(p2) THEN
       'if we get here, they're of equal length,
       'so now we're doing a "normal" string comparison
       FUNCTION = -1
   ELSEIF UCASE$(p2) > UCASE$(p1) THEN
       FUNCTION = 1
   ELSE
       FUNCTION = 0
   END IF

END FUNCTION

FUNCTION PBMAIN()

   DIM x(7) AS STRING
   ARRAY ASSIGN x() = "Here", "are", "some", "sample", "strings", "to", "be", "sorted"

   'pb's built-in sorting; "USING" tells it to use our custom comparator
   ARRAY SORT x(), USING Sorter()

END FUNCTION</lang>

PowerShell

The Sort-Object cmdlet accepts script blocks as arguments as well as multiple criteria after which to sort. <lang powershell>$list = "Here", "are", "some", "sample", "strings", "to", "be", "sorted" $list | Sort-Object {-$_.Length},{$_}</lang> The negated string length is the first sort criterion, the second is the string itself, resulting in descending length and ascending lexicographic order.

Python

Using a key function is usually more efficient than a comparator. We can take advantage of the fact that tuples are ordered first by the first element, then by the second, etc., to perform a sort on multiple criteria. <lang python>strings = "here are Some sample strings to be sorted".split()

def mykey(x):

   return -len(x), x.upper()

print sorted(strings, key=mykey)</lang>

Sample output: <lang python>['strings', 'sample', 'sorted', 'here', 'Some', 'are', 'be', 'to']</lang>

Alternative method using cmp

To technically comply with this task, we can also use an actual comparator (cmp) function which will be called every time members of the original list are to be compared. Note that this feature is worse than using the key argument and has been removed from Python 3, so should no longer be used in new code. <lang python>def mycmp(s1, s2):

   return cmp(len(s2), len(s1)) or cmp(s1.upper(), s2.upper())

print sorted(strings, cmp=mycmp)</lang>

Ruby

Since Ruby 1.8.6 Enumerables have a "sort_by" method, taking a key block, which is more efficient than a comparator. We can take advantage of the fact that Arrays are ordered first by the first element, then by the second, etc., to perform a sort on multiple criteria.

<lang ruby>words = %w(Here are some sample strings to be sorted) p words.sort_by {|word| [-word.size, word.downcase]}</lang>

To technically comply with this task, we can also use an actual comparator block which will be called every time members of the original list are to be compared. <lang ruby>p words.sort {|a, b| d = b.size <=> a.size

                    d != 0 ? d : a.upcase <=> b.upcase}</lang>

Sather

<lang sather>class MAIN is

 custom_comp(a, b:STR):BOOL is
   l ::= a.length - b.length;
   if l = 0 then return a.lower < b.lower; end;
   return l > 0;
 end;

 main is
   s:ARRAY{STR} := |"this", "is", "an", "array", "of", "strings", "to", "sort"|;
   
   s.insertion_sort_by(bind(custom_comp(_,_)));
   loop #OUT + s.elt! + "\n"; end;
 end;

end;</lang>

Scheme

<lang scheme>(use srfi-13);;Syntax for module inclusion depends on implementation,

as does the presence of a sort function.

(define (mypred? a b)

 (let ((len-a (string-length a))

(len-b (string-length b)))

   (if (= len-a len-b)

(string>? (string-downcase b) (string-downcase a))

       (> len-a len-b))))

(sort '("sorted" "here" "strings" "sample" "Some" "are" "be" "to") mypred?) </lang> Sample output: <lang scheme>("strings" "sample" "sorted" "here" "Some" "are" "be" "to")</lang>

Slate

<lang slate>define: #words -> #('here' 'are' 'some' 'sample' 'strings' 'to' 'sort' 'since' 'this' 'exercise' 'is' 'not' 'really' 'all' 'that' 'dumb' '(sorry)'). words sortBy: [| :first :second | (first lexicographicallyCompare: second) isNegative]</lang>

Smalltalk

<lang smalltalk>#('here' 'are' 'some' 'sample' 'strings' 'to' 'sort' 'since' 'this' 'exercise' 'is' 'not' 'really' 'all' 'that' 'dumb' '(sorry)' ) asSortedCollection

         sortBlock:
                    [:first :second | (second size = first size)
                                           ifFalse: [second size < first size]
                                           ifTrue: [first < second]]</lang>

Standard ML

List:

Works with: SML/NJ

<lang sml>fun mygt (s1, s2) =

 if size s1 <> size s2 then
   size s2 > size s1
 else
   String.map Char.toLower s1 > String.map Char.toLower s2</lang>

<lang sml>- val strings = ["Here", "are", "some", "sample", "strings", "to", "be", "sorted"]; val strings = ["Here","are","some","sample","strings","to","be","sorted"]

 : string list

- ListMergeSort.sort mygt strings; val it = ["strings","sample","sorted","Here","some","are","be","to"]

 : string list</lang>

Array:

Works with: SML/NJ

<lang sml>fun mycmp (s1, s2) =

 if size s1 <> size s2 then
   Int.compare (size s2, size s1)
 else
   String.compare (String.map Char.toLower s1, String.map Char.toLower s2)</lang>

<lang sml>- val strings = Array.fromList ["Here", "are", "some", "sample", "strings", "to", "be", "sorted"]; val strings = [|"Here","are","some","sample","strings","to","be","sorted"|]

 : string array

- ArrayQSort.sort mycmp strings; val it = () : unit - strings; val it = [|"strings","sample","sorted","Here","some","are","be","to"|]

 : string array</lang>

Tcl

<lang tcl>proc sorter {a b} {

   set la [string length $a]
   set lb [string length $b]
   if {$la < $lb} {
       return 1
   } elseif {$la > $lb} {
       return -1
   }
   return [string compare [string tolower $a] [string tolower $b]]

}

set strings {here are Some sample strings to be sorted} lsort -command sorter $strings ;# ==> strings sample sorted here Some are be to</lang>

TUSCRIPT

<lang tuscript> $$ MODE TUSCRIPT setofstrings="this is a set of strings to sort This Is A Set Of Strings To Sort" unsorted=SPLIT (setofstrings,": :") PRINT "1. setofstrings unsorted" index="" LOOP l=unsorted PRINT l length=LENGTH (l),index=APPEND(index,length) ENDLOOP index =DIGIT_INDEX (index) sorted=INDEX_SORT (unsorted,index) PRINT "2. setofstrings sorted"

• {sorted}

</lang> Output:

1. setofstrings unsorted
this
is
a
set
of
strings
to
sort
This
Is
A
Set
Of
Strings
To
Sort
2. setofstrings sorted
a
A
is
of
to
Is
Of
To
set
Set
this
sort
This
Sort
strings
Strings 

Ursala

A standard library function, psort, takes a list of binary relational predicates and returns a function that uses them in order of decreasing priority to perform a sort. The less or equal length predicate (leql) and lexically less or equal predicate (lleq) are also standard library functions. This task is therefore easily dispatched as shown.

<lang Ursala>#import std

1. show+

data = <'this','is','a','list','of','strings','to','be','sorted'>

example = psort<not leql,lleq+ ~* ~&K31K30piK26 letters> data</lang> The lleq library function is case sensitive, so it is composed with a function to convert the words to lower case on the fly (without destructively modifying them) in order to meet the task requirement of case insensitivity.

output:

strings
sorted
list
this
be
is
of
to
a

Visual Basic .NET

<lang vbnet>Imports System

Module Sorting_Using_a_Custom_Comparator

   Function CustomComparator(ByVal x As String, ByVal y As String) As Integer
       Dim result As Integer
       result = y.Length - x.Length
       If result = 0 Then
           result = String.Compare(x, y, True)
       End If
       Return result
   End Function

   Sub Main()
       Dim strings As String() = {"test", "Zoom", "strings", "a"}

       Array.Sort(strings, New Comparison(Of String)(AddressOf CustomComparator))
   End Sub

End Module</lang>