Sort using a custom comparator

Revision as of 18:57, 19 February 2008 by rosettacode>Mwn3d (Changed over to works with template)

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.

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

Note: Lexicographic order is case-insensitive.

Ada

Works with: GNAT version 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

Works with: gcc version 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);
}

C++

Works with: g++ version 4.1.2
#include <algorithm>
#include <string>
#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 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);
}

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


Common Lisp

In Common Lisp, the sort function takes a predicate that is used as the comparator. This parameter can be any two-argument function. Common Lisp defines a case-insensitive predicate called string-lessp:

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")
CL-USER> 

D

Works with: D version DMD 1.026
Library: Tango
module customsort ;
import tango.io.Stdout ;
import tango.text.Ascii ; // for lexi compare

// csort need the following 2 modules 
import tango.util.collection.ArraySeq ;
import tango.util.collection.model.Comparator ;
T[] csort(T)(inout T[] arr, int function(T, T) fn_cmp) {
    ArraySeq!(T).quickSort(arr, 0, arr.length - 1, new class() 
        Comparator!(T){
            int compare(T a, T b) {
                return fn_cmp(a,b) ;
            }
        }) ;
    return arr ;
}
int cmpLen(char[] a, char[] b) { 
    if (a.length < b.length)
        return 1 ; // longer string come first 
    else if (a.length > b.length)
        return -1 ; 
    return 0 ; 
}
int cmpLex(char[] a, char[] b) {
    return icompare(a,b) ; // case-insensitive compare
} 
int cmpLenThenLex(char[] a, char[] b) { // in case misunderstood the task
    return cmpLen(a,b) == 0 ? cmpLex(a,b) : cmpLen(a,b) ;
}
void main() {
 char[][] d = ["This", "is", "a", "set", "of", "strings", "to", "sort"]; 
 Stdout(d.csort(&cmpLen)).newline ; // descending length
 char[][] a = ["BbCC","4321","cBBA","Abbc","1234","bBac","baCA","BAcC"] ;
 Stdout(a.csort(&cmpLex)).newline ; // ascending lexi order
 char[][] m = ["Bab","abbcc","baacc","Abbc","aAcc","abBac","bba","BAC"] ;
 Stdout(m.csort(&cmpLenThenLex)).newline ; // descending length then ascending lexi order
}

Output:

[ strings, This, sort, set, of, is, to, a ]
[ 1234, 4321, Abbc, baCA, BAcC, bBac, BbCC, cBBA ]
[ abBac, abbcc, baacc, aAcc, Abbc, Bab, BAC, bba ]

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

Haskell

Works with: GHC
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))

J

Input is to be a list of boxed character lists. The output will be in the same structure.
Case-insensitivity is obtained using lower, a verb taken from Change string case. Standard utilities tolower or toupper may be substituted.

mycmp=: 3 : 0
wt=. ;#&.> y
;(/:&.> lower L: 0) (\: ~. wt) { wt </. y
)

Example:

   ]strings=: ;: 'Sed quae tandem est in hac urbe tanta domus ab ista suspicione religionis tam vacua atque pura'
+---+----+------+---+--+---+----+-----+-----+--+----+----------+----------+---+-----+-----+----+
|Sed|quae|tandem|est|in|hac|urbe|tanta|domus|ab|ista|suspicione|religionis|tam|vacua|atque|pura|
+---+----+------+---+--+---+----+-----+-----+--+----+----------+----------+---+-----+-----+----+
   mycmp strings
+----------+----------+------+-----+-----+-----+-----+----+----+----+----+---+---+---+---+--+--+
|religionis|suspicione|tandem|atque|domus|tanta|vacua|ista|pura|quae|urbe|est|hac|Sed|tam|ab|in|
+----------+----------+------+-----+-----+-----+-----+----+----+----+----+---+---+---+---+--+--+

Java

Works with: Java version 1.5+
import java.util.Comparator;
import java.util.Arrays;

class MyComparator implements Comparator<String>
{
     // returns -, 0, or +, for less than, equals, greater than, respectively
     public int compare(String s1, String s2) {
         if (s1.length() != s2.length())
             return s2 - s1;
         else
             return s1.compareToIgnoreCase(s2);
     }
}

public class Test
{
    public static void main(String[] args)
    {
        String[] strings = {"Here", "are", "some", "sample", "strings", "to", "be", "sorted"};
        Arrays.sort(strings, new MyComparator());
    }
}

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

OCaml

let mycmp s1 s2 =
  if String.length s1 <> String.length s2 then
    String.length s2 - String.length s1
  else
    String.compare (String.lowercase s1) (String.lowercase s2)

let strings = ["Here"; "are"; "some"; "sample"; "strings"; "to"; "be"; "sorted"]
let sorted = List.sort mycmp strings

Perl

Works with: Perl version 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

Works with: PHP version 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");
?>

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;

Python

Works with: Python version 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)}

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