Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling

Re (tilly) 1: Golf: Arbitrary Alphabetical Sorting

by tilly (Archbishop)
on May 09, 2001 at 21:30 UTC ( #79177=note: print w/replies, xml ) Need Help??

in reply to Golf: Arbitrary Alphabetical Sorting

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.

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

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 }

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 }

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 }

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

Replies are listed 'Best First'.
Re: Re (tilly) 1: Golf: Arbitrary Alphabetical Sorting
by MeowChow (Vicar) on May 09, 2001 at 22:03 UTC
    Wow. I don't think this will work on a 99 character alphabet, but I'm too lazy to verify this :)

    UPDATE 6: It just never ends:

    sub o{ $c=join'',shift;sub t{$_=pop;s/./~0+index$c,$&/ges;$_}sort{t($a)cmp t$ +b}@{+pop} }
    79 chars...
                   s aamecha.s a..a\u$&owag.print
      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 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.)

      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.)
        You can save a single character by using a glob, such as:
        sub o { ($l,*w,$")=@_;sub g{$_=pop;s/./chr index"@$l",$&/ges;$_}sort{g($a)cmp +g+$b}@w }
        So *w ... @w instead of $w ... @$w.

        '1e9' or 'chr' vary only in that '1e9' would support an alphabet of length > 255, but if you're using UNICODE, then chr would likely return two characters anyway.
        TMTOWTDI, as they say, and this one appears to be 70 characters:
        sub o { ($c,*w,$")=@_;sub t{eval"y/@$c/\0-\377/";$_}sort{t($_=$a)cmp t$_=$b}@w }

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://79177]
[choroba]: Good morning!

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (6)
As of 2018-06-21 07:36 GMT
Find Nodes?
    Voting Booth?
    Should cpanminus be part of the standard Perl release?

    Results (117 votes). Check out past polls.