Sort using a custom comparator

From Rosetta Code
Revision as of 03:10, 9 February 2008 by rosettacode>TBH (→‎{{header|J}}: Added example.)
Task
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

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

C++

Compiler: g++ 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> 


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

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

J2SE 5.0:

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

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

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

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

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