Sort using a custom comparator

From Rosetta Code
Jump to: navigation, search
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.

Contents

[edit] Ada

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

[edit] Output

The output file looks like this:

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

[edit] 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)
}

[edit] AWK

 
# 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"] = "@ind_str_asc" ; SORTTYPE = 2
for (j in arr[i]) {
for (k=1; k<=arr[i][j]; k++) {
print(j)
}
}
}
exit(0)
}
 

output:

unsorted:
This
Is
A
Set
Of
Strings
To
Sort
duplicated
this
is
a
set
of
strings
to
sort
duplicated

sorted:
duplicated
duplicated
Strings
strings
Sort
This
sort
this
Set
set
Is
Of
To
is
of
to
A
a

[edit] Burlesque

 
blsq ) {"acb" "Abc" "Acb" "acc" "ADD"}><
{"ADD" "Abc" "Acb" "acb" "acc"}
blsq ) {"acb" "Abc" "Acb" "acc" "ADD"}(zz)CMsb
{"Abc" "acb" "Acb" "acc" "ADD"}
 

[edit] C

Works with: POSIX version .1-2001
#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;
}

[edit] C++

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

[edit] C#

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

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

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

[edit] Alternative using Linq (.NET 3.5)

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

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

[edit] 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.

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

Output:

(strings sample sorted Here some are be to)

An alternative, using sort-by:

(sort-by (juxt (comp - count) #(.toLowerCase %))
["Here" "are" "some" "sample" "strings" "to" "be" "sorted"])

[edit] 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:

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

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:

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

[edit] D

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;
}
Output:
["strings", "sample", "sorted", "here", "Some", "are", "be", "to"]

[edit] Alternative Version

The more natural and efficient way to solve this problem is to use std.algorith.multiSort. But currently it's less convenient because it can't be used with the UFCSyntax (same output):

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

[edit] 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.

[edit] 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) })
})

[edit] Erlang

 
-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.
 
Output:
9> sort_using_custom_comparator:task().
["Strings","strings","Sort","sort","This","this","Set",
 "set","Is","is","Of","of","To","to","A","a"]

[edit] 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})

Output:

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

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

[edit] EGL

Works with: EDT
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
Output:
Test 1:
strings
sample
sorted
Here
some
are
be
to

Test 2:
butter
Actor
apple
Level
Adam
base
quit
Xmas
zero
add
Cat

[edit] F#

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

Output:

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

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

[edit] 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.

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

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

[edit] 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.

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

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

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

At the end, we can test these:

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

[edit] FunL

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) )
Output:
["strings", "sample", "sorted", "here", "Some", "are", "be", "to"]

[edit] 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)")
}

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)

[edit] Groovy

The "custom comparator" is just a closure attached to the sort method invocation.

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

Output:

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

[edit] 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))

[edit] Icon and Unicon

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

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"

[edit] J

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

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

[edit] Java

Works with: Java version 1.5+
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 + " ");
}
}

Same thing as above

Works with: Java version 8+
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 + " ");
}
}

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

[edit] jq

The comparator, cmp, must have 0 arity, and may either be boolean or follow the negative/zero/positive convention.

If "o" is an ordering, and if x and y are two entities for which "x o y" is defined, then "[x,y] | cmp" should return a number, or a boolean value.

As illustrated in the example, the comparator may be any jq filter, whether or not it is defined as a function.

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 ;

Example:

# 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] ) )
 
Output:
[
"ab",
"yz",
"c",
"z"
]

[edit] Lua

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

Output:

strings sample sorted have Here some be to we

[edit] 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:

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]

gives back:

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

[edit] Maxima

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

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

[edit] Nemerle

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

Output:

[different, strings, length, these, are, of]
[apple, chewy, House, Later, rises, Salty]

[edit] NetRexx

Translation of: Java
/* 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
 

Output:

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

[edit] 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|
=+-------+------+------+----+----+---+--+--+

[edit] Nimrod

import strutils, algorithm
 
var strings = "here are Some sample strings to be sorted".split(' ')
 
strings.sort(proc (x,y: string): int =
cmp(y.len, x.len))
 
echo strings

[edit] Objective-C

Works with: Cocoa version Mac OS X 10.6+

Using blocks:

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


Works with: GNUstep
Works with: Cocoa
#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;
}

This example can also be written using sort descriptors:

Works with: GNUstep
Works with: Cocoa
#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;
}

[edit] 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)

List:

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

Array:

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

[edit] ooRexx

/* REXX ***************************************************************
* Using the powerful methods of ooRexx
* Sample data taken from REXX
* 28.07.2013 Walter Pachl
**********************************************************************/

myArray = .array~of('---The seven deadly sins---',,
'===========================',,
'pride','avarice','wrath','envy','gluttony','sloth','lust');
Call show 'before sort'
myArray~sort
Call show 'after sort'
myArray~sortWith(.mycmp~new)
Call show 'after custom sort'
Exit
 
show:
Parse Arg txt
Say txt
do name over myArray
say name
end
Return
 
::CLASS mycmp MIXINCLASS Comparator
::METHOD compare
/**********************************************************************
* shorter string considered higher
* when lengths are equal: caseless 'Z' considered higher than 'X' etc.
* Result: 1 B consider higher than A
* -1 A consider higher than B
* 0 A==B (caseless)
**********************************************************************/

Parse Upper Arg A,B
A=strip(A)
B=strip(B)
I = length(A)
J = length(B)
Select
When I << J THEN res=1
When I >> J THEN res=-1
When A >> B THEN res=1
When A << B THEN res=-1
Otherwise res=0
End
RETURN res

Output:

before sort
---The seven deadly sins---
===========================
pride
avarice
wrath
envy
gluttony
sloth
lust
after sort
---The seven deadly sins---
===========================
avarice
envy
gluttony
lust
pride
sloth
wrath
after custom sort
---The seven deadly sins---
===========================
gluttony
avarice
pride
sloth
wrath
envy
lust  

[edit] 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}

[edit] PARI/GP

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

[edit] Perl

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

Or inline:

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

Faster with a Schwartzian transform:

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;

[edit] Perl 6

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;

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:

my @sorted_strings = sort -> $x { [ $x.chars, $x.lc ] }, @strings;

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

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

: (sort '("def" "abc" "ghi") >)    
-> ("ghi" "def" "abc")

or simply the result reversed (which is, btw, the most efficient way)

: (flip (sort '("def" "abc" "ghi")))
-> ("ghi" "def" "abc")

[edit] PL/I

Works with: IBM PL/I version 7.5

Platform: WIN

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;

[edit] 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;

[edit] PowerBASIC

Works with: PB/Win version 9
Works with: PB/CC version 4
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

[edit] PowerShell

The Sort-Object cmdlet accepts script blocks as arguments as well as multiple criteria after which to sort.

$list = "Here", "are", "some", "sample", "strings", "to", "be", "sorted"
$list | Sort-Object {-$_.Length},{$_}

The negated string length is the first sort criterion, the second is the string itself, resulting in descending length and ascending lexicographic order.

[edit] Prolog

Works with SWI-Prolog.

rosetta_sort :-
L = ["Here", "are", "some", "sample", "strings", "to", "be", "sorted" ],
predsort(my_comp, L, L1),
writeln('Input list :'),
maplist(my_write, L), nl,nl,
writeln('Sorted list :'),
maplist(my_write, L1).
 
 
my_comp(Comp, W1, W2) :-
length(W1,L1),
length(W2, L2),
( L1 < L2 -> Comp = '>'
; L1 > L2 -> Comp = '<'
; compare(Comp, W1, W2)).
 
my_write(W) :-
format('~s ', [W]).
 

Output :

 ?- rosetta_sort.
Input list :
Here are some sample strings to be sorted 

Sorted list :
strings sample sorted Here some are be to 
true.

[edit] 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.

strings = "here are Some sample strings to be sorted".split()
 
def mykey(x):
return -len(x), x.upper()
 
print sorted(strings, key=mykey)

Sample output:

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

[edit] 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.

def mycmp(s1, s2):
return cmp(len(s2), len(s1)) or cmp(s1.upper(), s2.upper())
 
print sorted(strings, cmp=mycmp)

[edit] R

v = c("Here", "are", "some", "sample", "strings", "to", "be", "sorted")
print(v[order(-nchar(v), tolower(v))])

[edit] Racket

 
#lang racket
 
;; Using a combination of the two comparisons
(define (sort1 words)
(sort words (λ(x y)
(define xl (string-length x)) (define yl (string-length y))
(or (> xl yl) (and (= xl yl) (string-ci<? x y))))))
(sort1 '("Some" "pile" "of" "words"))
;; -> '("words" "pile" "Some" "of")
 
;; Doing two sorts, relying on `sort's stability
(define (sort2 words)
(sort (sort words string-ci<?) > #:key string-length))
(sort2 '("Some" "pile" "of" "words"))
;; -> '("words" "pile" "Some" "of")
 

[edit] REXX

/*REXX program sorts a (stemmed) array using the  merge-sort method. */
/* using mycmp function for the sort order */
/**********************************************************************
* mergesort taken from REXX (adapted for ooRexx (and all other REXXes))
* 28.07.2013 Walter Pachl
**********************************************************************/

Call gena /* generate the array elements. */
Call showa 'before sort' /* show the before array elements.*/
Call mergeSort highitem /* invoke the merge sort for array*/
Call showa ' after sort' /* show the after array elements.*/
Exit /* stick a fork in it, we're done.*/
/*---------------------------------GENa subroutine-------------------*/
gena:
a.='' /* assign default value for a stem*/
a.1='---The seven deadly sins---'/* everybody: pick your favorite.*/
a.2='==========================='
a.3='pride'
a.4='avarice'
a.5='wrath'
a.6='envy'
a.7='gluttony'
a.8='sloth'
a.9='lust'
Do highitem=1 While a.highitem\=='' /*find number of entries */
End
highitem=highitem-1 /* adjust highitem by -1. */
Return
/*---------------------------------MERGETOa subroutine---------------*/
mergetoa: Procedure Expose a. !.
Parse Arg l,n
Select
When n==1 Then
Nop
When n==2 Then Do
h=l+1
If mycmp(a.l,a.h)=1 Then Do
_=a.h
a.h=a.l
a.l=_
End
End
Otherwise Do
m=n%2
Call mergeToa l+m,n-m
Call mergeTo! l,m,1
i=1
j=l+m
Do k=l While k<j
If j==l+n|mycmp(!.i,a.j)<>1 Then Do
a.k=!.i
i=i+1
End
Else Do
a.k=a.j
j=j+1
End
End
End
End
Return
/*---------------------------------MERGESORT subroutine--------------*/
mergesort: Procedure Expose a.
Call mergeToa 1,arg(1)
Return
/*---------------------------------MERGETO! subroutine---------------*/
mergeto!: Procedure Expose a. !.
Parse Arg l,n,_
Select
When n==1 Then
 !._=a.l
When n==2 Then Do
h=l+1
q=1+_
If mycmp(a.l,a.h)=1 Then Do
q=_
_=q+1
End
 !._=a.l
 !.q=a.h
Return
End
Otherwise Do
m=n%2
Call mergeToa l,m
Call mergeTo! l+m,n-m,m+_
i=l
j=m+_
Do k=_ While k<j
If j==n+_|mycmp(a.i,!.j)<>1 Then Do
 !.k=a.i
i=i+1
End
Else Do
 !.k=!.j
j=j+1
End
End
End
End
Return
/*---------------------------------SHOWa subroutine------------------*/
showa:
widthh=length(highitem) /* maximum the width of any line.*/
Do j=1 For highitem
Say 'element' right(j,widthh) arg(1)':' a.j
End
Say copies('-',60) /* show a separator line (fence).*/
Return
 
mycmp: Procedure
/**********************************************************************
* shorter string considered higher
* when lengths are equal: caseless 'Z' considered higher than 'X' etc.
* Result: 1 B consider higher than A
* -1 A consider higher than B
* 0 A==B (caseless)
**********************************************************************/

Parse Upper Arg A,B
A=strip(A)
B=strip(B)
I = length(A)
J = length(B)
Select
When I << J THEN res=1
When I >> J THEN res=-1
When A >> B THEN res=1
When A << B THEN res=-1
Otherwise res=0
End
RETURN res

Output:

element 1 before sort: ---The seven deadly sins---
element 2 before sort: ===========================
element 3 before sort: pride
element 4 before sort: avarice
element 5 before sort: wrath
element 6 before sort: envy
element 7 before sort: gluttony
element 8 before sort: sloth
element 9 before sort: lust
------------------------------------------------------------
element 1  after sort: ---The seven deadly sins---
element 2  after sort: ===========================
element 3  after sort: gluttony
element 4  after sort: avarice
element 5  after sort: pride
element 6  after sort: sloth
element 7  after sort: wrath
element 8  after sort: envy
element 9  after sort: lust
------------------------------------------------------------


[edit] 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.

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

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.

p words.sort {|a, b| d = b.size <=> a.size
d != 0 ? d : a.upcase <=> b.upcase}

[edit] 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;

[edit] Scala

List("Here", "are", "some", "sample", "strings", "to", "be", "sorted").sortWith{(a,b) => 
val cmp=a.size-b.size
(if (cmp==0) -a.compareTo(b) else cmp) > 0
}
Output:
List(strings, sample, sorted, Here, some, are, be, to)

[edit] 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?)

Sample output:

("strings" "sample" "sorted" "here" "Some" "are" "be" "to")

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

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

[edit] Standard ML

List:

Works with: SML/NJ
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
- 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

Array:

Works with: SML/NJ
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)
- 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

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

[edit] 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}
 

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 

[edit] 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.

#import std
#show+
 
data = <'this','is','a','list','of','strings','to','be','sorted'>
 
example = psort<not leql,lleq+ ~* ~&K31K30piK26 letters> data

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

[edit] Visual Basic .NET

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

[edit] zkl

s:=T("Cat","apple","Adam","zero","Xmas","quit","Level","add","Actor","base","butter");
r:=s.sort(fcn(a,b){ an:=a.len();bn:=b.len();
if(an==bn)(a.toLower() < b.toLower()) else (an > bn)});
r.apply2(Console.println);
Output:
butter
Actor
apple
Level
Adam
base
quit
Xmas
zero
add
Cat

Personal tools
Namespaces

Variants
Actions
Community
Explore
Misc
Toolbox