aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Update all new Tasks

Browse source
This commit is contained in:
Ingy döt Net 2015-02-20 09:02:09 -05:00
parent 00a190b0a6
commit 91df62d461
5697 changed files with 93386 additions and 804 deletions
Download patch file Download diff file Expand all files Collapse all files

22
Task/Natural-sorting/Perl/natural-sorting-1.pl Normal file
View file

@ -0,0 +1,22 @@
use feature 'fc';
use Unicode::Normalize;
sub natural_sort {
my @items = map {
my $str = fc(NFKD($_));
$str =~ s/\s+/ /;
$str =~ s/|^(?:the|a|an) \b|\p{Nonspacing_Mark}| $//g;
my @fields = $str =~ /(?!\z) ([^0-9]*+) ([0-9]*+)/gx;
[$_, \@fields]
} @_;
return map { $_->[0] } sort {
my @x = @{$a->[1]};
my @y = @{$b->[1]};
my $numeric;
while (@x && @y) {
my ($x, $y) = (shift @x, shift @y);
return (($numeric = !$numeric) ? $x cmp $y : $x <=> $y or next);
}
return @x <=> @y;
} @items;
}

30
Task/Natural-sorting/Perl/natural-sorting-2.pl Normal file
View file

@ -0,0 +1,30 @@
use utf8; # interpret this script's source code as UTF8
use Test::More; # for plan(), is_deeply()
use Data::Dump; # for dd()
my @testcases = (
['Leading spaces', '%sleading spaces: %i', map {' ' x $_} 2, 3, 1, 0 ],
['Adjacent spaces', 'adjacent%s spaces: %i', map {' ' x $_} 2, 3, 1, 0 ],
['Different spaces', 'equiv.%sspaces: %i', split //, "\x0b\n\t\x0c\r " ],
['Case differences', '%s INDEPENENT: %i', 'casE', 'case', 'caSE', 'cASE' ],
['Numeric fields', 'foo%ibar%ibaz%i.txt', [100, 10, 0], [100, 99, 0],
[1000,99,9], [1000,99,10] ],
['Title case', '%s', 'The 39 steps', 'The 40th step more',
'Wanda', 'The Wind in the Willows' ],
['Accents', 'Equiv. %s accents: %i', 'y', 'Y', "\x{dd}", "\x{fd}" ],
['Ligatures', '%s', "IJ ligatured ij", 'no ligature' ],
['Alternate forms', 'Start with an %s: %i', 's', 'ſ', 'ß' ],
);
plan tests => scalar @testcases;
foreach (@testcases) {
my ($name, $pattern, @args) = @$_;
my $i = 0;
my @strings = map { sprintf $pattern, ref $_ ? @$_ : $_, $i++ } @args;
is_deeply( [natural_sort(reverse sort @strings)], \@strings, $name );
dd @strings;
print "\n";
}