|
Re (tilly) 1: Golf: Arbitrary Alphabetical Sorting
by tilly (Archbishop) on May 09, 2001 at 21:30 UTC
|
The body is 93 characters. Can handle anything Perl's RE engine can call a character (including null and return), but like chipmunk horribly non-strict and assumes you will not see characters that are not listed in the alphabet.
sub o{
($c,$s)=@_;@m{@$c}=map{10*@$c+$_}0..@$c;sub t{$_=pop;s/./$m{$&}/gs;$_}
+sort{t($a)cmp t($b)}@$s
}
Two subtle details. The /s is needed if returns are in the alphabet. And you cannot save a character by replacing string with numerical comparison without breaking on fairly small words.
UPDATE
MeowChow is right. :-( But the following 91 character
version will handle alphabets of up to 90,000 characters.
Given that this is bigger than Unicode's space, that is sufficient for any alphabet that any version of Perl will accept:
sub o{
($c,$s)=@_;@m{@$c}=map{$_+9999}1..@$c;sub t{$_=pop;s/./$m{$&}/gs;$_}so
+rt{t($a)cmp t($b)}@$s
}
(And so we create more legacy code with a stupid hard-coded limit that is bound to come back to bite us...)
UPDATE 2
MeowChow told me to lose parens gaining 2, and to make the range several hundred million by rewriting the number. Also I commified a map. This falls to 88. Or change to "99" to make it 86 if you are willing to accept one-byte alphabets.
sub o{
($c,$s)=@_;@m{@$c}=map$_+9**9,1..@$c;sub t{$_=pop;s/./$m{$&}/gs;$_}sor
+t{t($a)cmp t$b}@$s
}
UPDATE 3
ChemBoy dropped to 87 by rewriting the number again:
sub o{
($c,$s)=@_;@m{@$c}=map$_+1e9,1..@$c;sub t{$_=pop;s/./$m{$&}/gs;$_}sort
+{t($a)cmp t$b}@$s
}
UPDATE 4
tye made it 86 with:
sub o{
($c,$s)=@_;@m{@$c}=map$_+~0,1..@$c;sub t{$_=pop;s/./$m{$&}/gs;$_}sort{
+t($a)cmp t$b}@$s
}
UPDATE 5
And I finish the round of golf by making it 83 with:
sub o{
($c,$s)=@_;@m{@$c}=1e8..@$c+1e8;sub t{$_=pop;s/./$m{$&}/gs;$_}sort{t($
+a)cmp t$b}@$s
}
(The ~0 trick doesn't work with ranges.) | [reply]
[d/l]
[select] |
|
|
sub o{
$c=join'',shift;sub t{$_=pop;s/./~0+index$c,$&/ges;$_}sort{t($a)cmp t$
+b}@{+pop}
}
79 chars...
MeowChow
s aamecha.s a..a\u$&owag.print | [reply]
[d/l] |
|
|
First of all that doesn't work because shift returns a
reference. You need it to dereference the first element into an array. Secondly you know I love a challenge..like 76 characters:
sub o{
($c,$s,$")=@_;sub t{$_=pop;s/./~0+index"@$c",$&/ges;$_}sort{t($a)cmp t
+$b}@$s
}
(I have to waste 3 on removing spaces, dang.)
UPDATE
In 5.6.x it appears you need to spend another character:
sub o{
($c,$s,$")=@_;sub t{$_=pop;s/./1e9+index"@$c",$&/ges;$_}sort{t($a)cmp
+t$b}@$s
}
UPDATE 2
Saving another character..back to 76.
sub o{
($c,$s,$")=@_;sub t{s/./1e9+index"@$c",$&/ges;$_}sort{t($_=$a)cmp t$_=
+$b}@$s
}
UPDATE 3
Throwing in tadman's improvement, 75:
sub o{
($c,*w,$")=@_;sub t{s/./1e9+index"@$c",$&/ges;$_}sort{t($_=$a)cmp t$_=
+$b}@w
}
(Note that chr returning 2 chars wouldn't make Unicode come out right. Hence I am keeping the 1e9 trick.) | [reply]
[d/l]
[select] |
|
|
|
|
|
|
|
Re: Golf: Arbitrary Alphabetical Sorting
by merlyn (Sage) on May 09, 2001 at 20:01 UTC
|
Well, here's a cut at it, even though it's not golfed yet:
sub o {
my ($a, $w) = @_;
my %m; @m{@$a} = (a..z);
my $k = join "", keys %m;
my $v = join "", values %m;
map { eval "tr/$v/$k/"; $_ } sort map { eval "tr/$k/$v/"; $_ } @$w;
}
-- Randal L. Schwartz, Perl hacker
update:
and of course, it's doggy slow. That eval needs to be saved, like in a coderef or something.
update2:
Bleh. RIght. 'a'..'z' was being presumptive that "letter" meant "letter" like I knew it.
Here's the patch to make it work for larger sets, for reasonable values of work:
sub o {
my ($a, $w) = @_;
my %m; @m{@$a} = 1..@$a;
my $k = join "", map {sprintf "\\%03o", ord $_} keys %m;
my $v = join "", map {sprintf "\\%03o", $_ } values %m;
map { eval "tr/$v/$k/"; $_ } sort map { eval "tr/$k/$v/"; $_ } @$w;
}
| [reply]
[d/l]
[select] |
|
|
While your $v/$k order is right, the one gotcha that I put in there was that the alphabet size was arbitrary, and not necessarily 26 characters.. it could be as many as 100, 1000, or more (Well, anything in non-Unicode above 255 makes no sense). So this trick doesn't work here.
Dr. Michael K. Neylon - mneylon-pm@masemware.com
||
"You've left the lens cap of your mind on again, Pinky" - The Brain
| [reply] |
|
|
Well, if it's a single "character", tr likes it. What's the problem? About the only thing that's messy is the use of a slash and dash, and I could probably hork that somehow by always mapping to an octal-ish escape.
I've reread the question three times now, and I don't see how you are defining
"character" in any way other than something that tr can wrangle. If so, what's
the structure of a "word" then? It's no longer a string, which would be a sequence
of "characters" that tr can handle!
-- Randal L. Schwartz, Perl hacker
| [reply] |
|
|
|
|
|
|
Re: Golf: Arbitrary Alphabetical Sorting
by chipmunk (Parson) on May 09, 2001 at 20:49 UTC
|
This solution uses the same approach as merlyn's, translating the words so they can be compared directly. It assumes that the words will not contain the null character.
96 characters.
sub o {
@k{@$A}=map chr,1..@{$A=$_[0]};
map{s/.*\0//s;$_}sort map{($x=$_)=~s/./$k{$&}/gs;"$x\0$_"}@{+pop}
}
BTW, although %k is not lexicalized to the sub, I don't think it matters, since any leftover contents which are not overwritten won't be used.
(Also assume that no other characters are present in the words.)
Update: I added /s to both substitutions, to avoid problems with \n. Thanks tilly!
| [reply]
[d/l] |
|
|
Note that in addition to not allowing \0 as a character you don't allow \n.
| [reply] |
Re: Golf: Arbitrary Alphabetical Sorting
by tadman (Prior) on May 10, 2001 at 03:09 UTC
|
Taking a few tricks from tilly, and influences from
merlyn, this one appears to be 74 characters:
sub o {
($c,*w,$")=@_;sub t{eval"y/\Q@$c\E/\0-\377/";$_}sort{t($_=$a)cmp t$_=$
+b}@w
}
This will only work on single character 'alphabets', or
those that y// can handle as UNICODE.
Update:
I forgot to include the "\Q" and "\E" escapes to prevent
it from going south if the "alphabet" contained characters
such as '/' or '\n'. 4 character penalty.
Update 2:
If you want to cheat, you can always insert the
literal character ASCII 255 into the string instead of
the comparatively verbose '\377', which saves 3 characters,
yielding a length of 71, though some editors show that
single "character" as 2 on screen. | [reply]
[d/l] |
|
|
| [reply] |
Re: Golf: Arbitrary Alphabetical Sorting
by ChemBoy (Priest) on May 09, 2001 at 20:42 UTC
|
I got a head start on this one, since I gave a recursive solution in the original thread. But I've never golfed before, so this is likely to go down in flames quickly... I believe it scores 110 as is (somewhat golfed, but probably not optimally).
sub o {
$q=join'',@{$_[0]};
sort {$i=0;
{index($q,substr($a,$i,1))<=>index($q,substr($b,$i,1))or($i++,redo)}}@
+{$_[1]}
}
Update: Oof... difficulties is a nice way of putting it. A conditional statement fixes that, probably more cleanly than checking the string length repeatedly. Up to 125, I think--but then, I've already been clobbered.
sub o {
$q=join'',@{$_[0]};
sort {$a cmp$b?do{$i=0;{index($q,substr($a,$i,1))<=>index($q,substr($b
+,$i,1))or($i++,redo)}}:0
}@{$_[1]}
}
If God had meant us to fly, he would *never* have give us the railroads.
--Michael Flanders | [reply]
[d/l]
[select] |
|
|
This is nice, but it has ahhh... difficulties with repeated words in the list to be sorted.
MeowChow
s aamecha.s a..a\u$&owag.print | [reply] |