Sort using a custom comparator

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

Compiler:GNAT GPL 2006

Comparator_Package.ads

package Comparator_Package is
   procedure Move_String(From : Natural; To : Natural);
   function Len (Left, Right : Natural) return Boolean;
   function Lt (Left, Right : Natural) return Boolean;
   procedure Print_Array;
end Comparator_Package;

Comparator_Package.adb

with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Text_Io; use Ada.Text_Io;
with Ada.Characters.Handling; use Ada.Characters.Handling;

package body Comparator_Package is
   type Data is array(Natural range <>) of Unbounded_String;
  
   Strings : Data := (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"));
     
   procedure Move_String(From : Natural; To : Natural) is
   begin
      Strings(To) := Strings(From);
   end Move_String;
   
   function Len (Left, Right : Natural) return Boolean is
   begin
      return Length(Strings(Left)) > Length(Strings(Right));
   end Len;
  
   function Lt (Left, Right : Natural) return Boolean is
   begin
      return To_Lower(To_String(Strings(Left))) < To_Lower(To_String(Strings(Right)));
   end Lt;
   
   procedure Print_Array is
   begin
      for I in 1..Strings'Last loop
         Put_Line(To_String(Strings(I)));
      end loop;
   end Print_Array;
end Comparator_Package;

Custom_Comparator.adb

with Gnat.Heap_Sort_A; use Gnat.Heap_Sort_A;
with Ada.Text_Io; use Ada.Text_Io;
with Comparator_Package; use Comparator_Package;

procedure Custom_Comparator is
begin
   Put_Line("  Unsorted Array:");
   Print_Array;
   New_Line;
   Put_Line("  Sorted in descending length:");
   Sort(8, Move_String'access, Len'access);
   Print_Array;
   New_Line;
   Put_Line("  Sorted in Ascending order:");
   Sort(8, Move_String'access, Lt'access);
   Print_Array;
end Custom_Comparator;

Output File

  Unsorted Array:
this
is
a
set
of
strings
to
sort

  Sorted in descending length:
strings
sort
this
set
to
is
of
a

  Sorted in Ascending order:
a
is
of
set
sort
strings
this
to

C

Compiler: GCC 4.0.1

Platform: BSD

#include <stdlib.h>
#include <strings.h>

int mycmp(const void *s1, const void *s2)
{
    int d;
    const char *l = *(const char **)s1, *r = *(const char **)s2;
    if (d = strlen(r) - strlen(l))
        return d;
    return strcasecmp(l, r);
}

int main()
{
    char *strings[8] = {"Here", "are", "some", "sample", "strings", "to", "be", "sorted"};
    qsort(strings, 8, sizeof(char *), mycmp);
}

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"]

E

/** returns a if it is nonzero, otherwise b() */
def nonzeroOr(a, b) { return a.isZero().pick(b(), a) }

["Here", "are", "some", "sample", "strings", "to", "be", "sorted"] \
    .sort(fn a, b { 
              nonzeroOr(b.size().op__cmp(a.size()),
                        fn { a.compareToIgnoreCase(b) }) 
          })

Haskell

Interpreter: GHCi

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

Alternate definition of mycmp using the Monoid instance for Ordering:

import Data.Monoid
mycmp s1 s2 = mappend (compare (length s2) (length s1))
                      (compare (map toLower s1) (map toLower s2))

Perl

Interpreter: perl 5.8.6

sub mycmp { length $b <=> length $a or lc $a cmp lc $b }

@strings = ("Here", "are", "some", "sample", "strings", "to", "be", "sorted");
@sorted = sort mycmp @strings;

PHP

Interpreter: PHP 4.4.4 CLI

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

Python

Interpreter: 2.5

def mycmp(s1, s2):
    d = len(s2) - len(s1)
    return d if d else cmp(s1, s2)

strings = ["Here", "are", "some", "sample", "strings", "to", "be", "sorted"]
print sorted(strings, cmp=mycmp)

# Alternative with decoration, unfit for very long lists:
print sorted(strings, key=lambda s: (-len(s), s))

Ruby

The sort methods for Arrays can accept a block to be used as comparator.

strings = ["Here", "are", "some", "sample", "strings", "to", "be", "sorted"]
strings.sort{|x,y|((lencomp=(y.length<=>x.length))==0 ? x<=>y : lencomp)}