The object of the Challenge is to solve a few programming tasks using the shortest programs you can think off
All programs must work on perl 5.6.1. (most likely programs you write on another version will be just fine, so don't directly go downloading a different perl)
All programs are filters. They must read input from STDIN, and send output to STDOUT. All input lines are properly newline terminated, and do not contain binary 0. All input files have a total size so that they will fit comfortably in memory and still allow you ample memory to play with.
All output lines must likewise be properly newline terminated. Nothing must appear on STDERR. The average runtime of the program must be finite, but may be arbitrarily long.
You must assume total memory is < 2**32 bytes (this e.g. implies sizes of arbitrary datastructures can be represented in a plain integer, and that you must not try to generate arbitrarily big datastructures).
The program must be written as one or more lines. The score for each hole is the total number of characters you need (smaller is better). If your program is more than one line, you must count the newlines inbetween as one character each. The #! line is not counted. If you use options on the #! line, the options themselves are counted, including the leading space and -
The program may only use the perl executable, no other executables on the system are allowed (in particular, you must not use the programs implementing the other holes. The program may use itself though). You may use any of the perl 5.6.1 standard core modules. Your solution must be portable in the sense that it should work on all versions of 5.6.1 everywhere (however, it's perfectly fine to abuse perl 5.6.1 bugs). You may assume ASCII as character set and must not use any of the unicode specific semantics
Current holes:
Sort a set of lines, but with a twist.
When sorting a set of lines, humans like to see the numeric parts of
a line sorted numerically and the alphabetical parts case
insensitive. For the numeric parts you may ignore the possibility of
negative numbers, floating point numbers and leading zeros, the
numbers however are almost unconstrained in length. In other words,
a sequence of one or more digits plays the same sort of role as some
kind of single character, and such a sequence sorts before all
normal letters, but among themselves they are ordered by numerical
value. Example:
1 < A < amstelveen < Amsterdam < Amsterdam5 < Amsterdam40 < Amsterdamned
Notes:
"a865314457646576532325988watte" =~ /(\d+)/; 0 x $1;
Outputs some random permutation of the input lines. Each permutation must be equally likely over many runs.
print 2 lines each randomly chosen from the input, however the two must not come from the same line in the input. You may assume the input is 2 lines or more. each pair of outputlines must be equally likely, and their order itself also random
Here is a program to pre-screen your entries. Name your programs human.pl, shuffle.pl and select.pl respectively. The checking program may get new interesting cases added over time.
Clarifications may be added during the tournament, so don't forget to recheck this page ever so often
The deadline is now fixed at English newyear, 2002/01/01 00:00:00 UT
Please submit your solutions even if you haven't solved all holes yet or you think your entries are bad. Part of the fun of this kind of contest is to see how people and solutions evolve over time. (Solutions will be made public after the tournament).
If you are on Ircnet, /msg your solutions to ton-. Make sure he confirms that he saw it.
Or mail to perl-golf-0@ton.iguana.be (We'll assume mail doesn't fail unnoticed)
State if you consider yourself newbie or experienced. (If enough newbies enter, we'll have a separate pool for them)
Please don't publish your scores on individual holes. You are only supposed to know the best totals.
Final standing (people with valid entries for each hole):
About 6 beginners tried, but only one succeeded in surviving hole 1, and that person is therefore the clear winner:
|
Winners per hole were:
|
|
Andrew Savige was particularly unlucky because I recognized a problem in his solution on the last day when he was already out of time to play, and he got dropped back to his last working entry.
Winners per hole were:
|
Bob is an artificial player, combining the best ideas of everyone.
As you can see, Spiff was (among) the best on every hole.
And the winner is: Spiff, even though there were some last minute attempts to dislodge him, especially from Autrijus Tang who went from last place to third in the last few hours.
In retrospect I made three big mistakes when setting up this challenge:
Playing "Bob" was particularly enjoyable. I got to see all solutions, so I could take the best elements from any of them, combine them and add my own ideas and come up with some stuff none of the players saw (having to toil in isolation). In the beginning BoB did best on all holes, but in the end only kept the lead on hole 1.
So, here is a hole by hole account.
Most players decided to go for a method of encoding the length in the string in such a way that you can use "cmp" and do a normal sort with the transformed key in a sort function. There were a few exceptions however:
Llasse started with a regex apprach and remained true to it for the whole tournament. I however kept finding counterexamples to his attempts until finally he got one that looks fine. I thought he would be the only one to get this one working until Rick Klement came up with the same thing, "correct" at the first attempt.
Llasse 82
print sort{"$a$b"=~/^(.*)(\d+).*\n\1(\d+)/i&&length$2<=>length$3||lc$a cmp lc$b}<>
Rick Klement 81
print sort{($a.$b)=~/(.*)(\d+).*\n\1(\d+)/i&&length$2<=>length$3||uc$a cmp uc$b}<>
Lasse missed the fact that he could use a hard newline instead of \n,
Rick didn't (from here on, \n will always mean a hard newline. Almost all
others did not miss this trick). Rick however used ($a.$b)
to combine the strings, while Lasse did better with
"$a$b"
. However, Rick gained back a character by
leaving out the ^
, which strictly speaking ought to be
incorrect, but seems to work (I think that's a perl bug).
Both missed some further optimisations (using @+
and
@-
instead of length
and using -
instead of <=>
). However, I don't think the regex
method can be made into a winner.
Suo is the only one who mangled his input lines, then did the sort and
next recoverd the original values as follows:
Suo 69
print/(.*\n)$/for sort map{($x=lc)=~s#\d+|\n#pack'xN/a*',$&#eg;$x.$_}<>
Again this entry could have been improved a bit, but not to a winner I
think. Using inspiration from Spiff and a few small transforms, Bob can
write:
Bob 65
print/.*\n$/gfor sort map{$x=$_;s#\d+|\n#9x9+$+[0].$&#eg;lc().$x}<>
In Suo's solution you see the pack "N/a*"
which was
the most comman approach to set up a string on which you can do a normal
sort. The tricky thing however is that you need to put something in front
so it sorts roughly like a number, because what you get from a pack N can
start with just any byte. Another thing many people missed (including me
when judging the entries until Eugene pointed it out to me) is that
applying uc/lc
to the result of such a pack invalidates the
solution because the pack "N"
can give you letters
among the four bytes it produces, and these will get converted. Here's a
fairly typical working example of this approach:
Eugene van der Pijll 71
sub a{$_=lc pop;s#\d+#0 .pack'N/A*',$&#ge;$_}print sort{a($a)cmp a$b}<>
Another way to encode the string length is to use something like
A x length$&
, but you have to watch out, since comparing
such a thing to a normal strings with A's makes the order depend on how
many A's are in the normal string, and the challenge stated that a
digit-string had to sort as "some kind of single character". So
it needs either something like a 0 put in front:
Andrew Savige 71
sub Z{s/\d+/0 .(A x length$&).$&/eg;uc}print sort{Z($_=$a)cmp Z$_=$b}<>
lc()
and only
then set up the string of capital letters, but noone had an accepted entry
based on this idea.
Next people turned their attention to getting rid of that long
"length
", and several came up with using
@+
(the end offset of the match string)
There were several attempts to use things like 'A'x$+[0]
,
which on a string like 'a0'x100000 would lead to enormous long temporary
strings (it's quadratic in memory usage), which I decided to reject. The
rules state that inputfiles can be big enough to fill memory with
"ample" play room left for tempory data, but this is a rather
intense demand for temporary space. Still, it's one of these
points where the rules were probably not precise enough. Fortunately this
point did not decide the contest, so I stuck to my guns (if Andrew Savige
had however written '0:'x$+[0]
instead of
':0'x$+[0]
in that rejected 64-stroke entry, this point
would have decided if he would become shared winner or not).
Ian Phillipps was the first one to realise that what he really wants is a
fixed n-digit length in front of the digit string, and that you can get
this with an addition if you can cap the maximum string-length. And you
can, since the rules say memory usage is <2**32 (otherwise even
pack"N"
would fail), and 2**32 is about 4e9. So for
example 1e9+length is guaranteed to be a ten-digit string (and perl
will use doubles to calculate it and not loose precission). A day later
Spiff was the only other person to realize this. His first attempt was:
Spiff 65
sub f{$_=pop;s;\d+;~0/3+$+[0].$&;eg;lc}print+sort{f($a)cmp+f$b}<> (rejected)
~0/3
is so big that
the addition will loose precission and you are unable to distinguish
"short" digit strings. However, he quickly recovered with
Spiff 65
sub f{$_=pop;s;\d+;9 x9+$+[0].$&;eg;lc}print+sort{f($a)cmp+f$b}<>
Spiff 64
sub f{$_=pop;s|\d+|9x9+$+[0].$&|eg;lc}print+sort{f($a)cmp+f$b}<>
Several of the players would however directly recognize that this is not
optimal. All of them had been thinking about how to get the argument to
the sub into $_
and several realized that $_=pop
can be improved.
The first one to see that was Autrijus Tang in one of her rejected entries:
Autrijus Tang 73
sub _{s|\d+|0 x(2**07-length$&).$&|eg;lc}print+sort{_($_=$a)cmp _$_=$b}<> (rejected)
However, Marcus Holland-Moritz was the one who did it best:
Marcus Holland-Moritz 65
print sort{s!\d+!pack'AN/A*',0,$&!egfor$"=uc$a,$;=uc$b;$"cmp$;}<>
Bob 61
print sort{s!\d+!1e9+$+[0].$&!egfor$"=uc$a,$;=uc$b;$"cmp$;}<>
And then one of the most interesting entries of the tournament arrived.
Autrijus Tang came up with this conceptual blockbuster:
Autrijus Tang 62
-pa s!|\d+!pack'AN/Z*',0,$&!eg;$;{lc,}.="@F\n"}for(@;{sort%;}){ (rejected)
Autrijus Tang 66
-p ($*=lc)=~s!|\d+!pack'AN/A*',0,$&!eg;$;{$*}.=$_}for(@;{sort%;}){
@F
is one unit and get:
BoB 59
-paF s!|\d+!1e9+$+[0].$&!eg;$;{+uc}.="@F\n"}for(@;{sort%;}){
BoB 58
-paF s!|\d+!$^T+$+[0].$&!eg;$;{+uc}.="@F\n"}for(@;{sort%;}){
Interesting enough one other person tried for a somewhat simular solution
having at least the great hash concept, making sure values can't be keys
(in a way that is one stroke worse, but wastes a lot less memory):
Richard Proctor 65
-n $a=$_;s/\d+/sprintf"%99s",$&/ge;$b{$:.uc}.=$a}{print@b{sort%b}
Another interesting set of solutions depends on the unicode semantics
of perl 5.6.1, like this one:
Piers Cawley 72
print map/\n(.+)/s,sort map{($a=lc)=~s/\d+/0${\chr length$&}$&/g;$a.$_}<>
PS: As pointed out by Ian Phillipps, some solutions would also have
worked for digit-strings with leading zeros if you replace
\d+
with 0*(\d+)
and use $1
instead
of $&
.
The standard solution here is like this entry:
Suo 37
x=<>;print splice@x,rand@x,1 while@x
Ronald J Kimball 36
@a=<>;print splice@a,rand@a,1while@a
Then Autrijus Tang came up with an utterly original method again:
Autrijus Tang 35
@_=<>;print+delete$_[rand@_]while@_
The word "while" is pretty long and that
@_=<>;
in front is pretty yucky, so people really
wanted to use something like "for
". The first to
succeed in this was Llasse, using
llasse 35
print splice@a,rand@a,1 for@b=@a=<>
@b
is to avoid that the splice modifies the list
being walked by the for
. A number of other people also
discovered essentially the same code.
However, if you can do "for
", quite often you can
also use "map
", and here it turns out not to need
the dummy array:
Suo 33
print map{splice@x,rand@x,1}@x=<>
There it stayed for a bit of time, until Eugene realise that instead of
extracting the list randomly, you can build it randomly, and then use the
free loop you get from -n/-p:
Eugene van der Pijll 32
-p splice@a,rand$.,0,$_}for(@a){
for(@a)
at the end, which is a general way you can use to
print a list, especially if the list cannot be put directly behind a print
(where use of this trick saves one character). However, that is not the
case here, so I also got solutions like:
Spiff 32
-p splice@F,rand$.,0,$_}{print@F
Andrew Savige 32
-n splice@x,rand$.,0,$_}{print@x
A few more people almost found this solution, but failed on a small detail:
Piers Cawley 32
-p splice@a,rand@a,0,$_}for(@a){ (rejected)
@a
is one too low compared to $.
the
array built in this way is not random (consider a two line input).
There were however a number of interesting rejected entries.
Very popular was using a sort where the sort function is random. I rejected
these because in most sorts this does in fact not lead to a random result,
and some versions of quicksort will even coredump on using a non-consistent
sort function. But it would give a number of very short
entries and on most perls they do in fact give permutations that tend to
change from run to run:
Autrijus Tang 28
print+sort{int(rand(3))-1}<> (rejected)
Gimbo 20
print sort{rand 2}<> (rejected)
A very interesting entry came from a beginner:
Jonathan E. Paton 33
-n $a{$..rand}=$_}{print values%a (rejected)
#! /usr/bin/perl -w
use Data::Dumper;
my $n=3;
for (1..100000) {
my %a;
$a{+rand} = $_ for 1..$n;
$count{(values%a)[-1]}++;
}
print Dumper(\%count);
$VAR1 = {
'1' => 39950,
'3' => 27336,
'2' => 32714
};
BoB 30
-n $a{$..rand}=$_}for(@a{%a}){ (rejected)
Richard Proctor 28
-n $_{+rand}=$_}{print@_{%_} (rejected)
Even though it has been known since the Santa challenge that the next
character in a -n expansion is ";", nobody found this 31:
-n splice@;,rand$.,0,$_}{print@
For this hole most people quickly converged around this concept:
Suo 37
@x=<>;print splice@x,rand@x,1 for 1,1
Ronald J Kimball 36
@a=<>;print splice@a,rand@a,1for 1,2
Suo unfortunately never realised the space was pointless in his solutions
(if he had, he would have ended up before the slavering pack in fourth
place). He did find a very clever trick to shave off another stroke though:
Suo 36
print splice@x,rand@x,1 for[@x=<>],1
Spiff 35
print+splice@,,rand@,,1for[@,=<>],f
For a long time this was the lone leader of the hole, until both Eugene and
Andrew came up with this funky entry:
Eugene van der Pijll 35
-p splice@a,rand$.,0,$_}{($_,$\)=@a
The rejected entries by Jonathan E. Paton and Richard Proctor were hash
based again, and lead to the same kind of things as for Shuffle:
Jonathan E. Paton 34
-n $a{$..rand}=$_}{print+(%a)[1,3] (rejected)
BoB 33
-p $a{$..rand}=$_}for((%a)[1,3]){ (rejected)
Richard Proctor 32
-n $_{+rand}=$_}{print+(%_)[1,3] (rejected)
BoB 31
-p $a{+rand}=$_}for((%a)[1,3]){ (rejected)
for
" trick gains a stroke here)
And again, the following 34 is possible:
-p splice@;,rand$.,0,$_}{($_,$\)=@
And finally, for your consideration, here are most entries: (non-rejected entries with the same score are in the order they arrived)
Assignment 1: human sort | ||
---|---|---|
J.Robert Suckling | 137 | sub x{$_=shift;$v="";while($_){if(/^(\D*)/){$v.=$&;$_=$'}if(/^(\d+)/){$v.=sprintf("%09d",$&),$_=$'}};$v}map{print}sort{x($a)cmp x($b)}<>; (rejected) |
Autrijus Tang | 125 | sub K($$){@a=@_;$*=ord((sort+map{chr(length)}"@_"=~/\d+/g)[-1]);s/\d+/sprintf"%0$*s",$&/eg for@a;$a[0]cmp$a[1]}print+sort K<> (rejected) |
Kye Leslie | 110 | -n $c++;$e=$_;s/(\d+)/$a=length $1;''x(9999-$a).$1/ge;$a{lc($_.$c)}=$e;}foreach $b(sort keys %a){print $a{$b}; (rejected) |
Jonathan E. Paton | 108 | print/([^\0]*)$/for sort map{$b=$_;lc;$_=$`.0 x(length@b-length$&)."$&\0$'"while/\d+(?!.*\0)/;"$_\0$b"}@b=<> (rejected) |
Kye Leslie | 105 | $c++;$e=$_;s/(\d+)/$a=length $1;' 'x(99-$a).$1/ge;$a{lc($_.$c)}=$e;}foreach$b(sort keys %a){print $a{$b}; (rejected) |
Autrijus Tang | 91 | sub K($$){@a=@_;$*=length"@_";s/\d+/sprintf"%0$*s",$&/eg for@a;$a[0]cmp$a[1]}print+sort K<> (rejected) |
Spifff | 90 | $;|=y===cfor@f=<>;sub f{$_=lc$_[0];s/\d+/sprintf"%$;s",$&/eg;$_}print+sort{f($a)cmp f$b}@f (rejected) |
BoB | 85 | sub f{$_=pop;s/\d+/$a=$&+0;pack("N",length$a)."-$a"/eg;$_}print sort{f($a)cmp f $b}<> (rejected) |
Autrijus Tang | 85 | print+sort{@_=($a,$b);$*=length"@_";s/\d+/sprintf"%0$*s",$&/eg for@_;$_[0]cmp$_[1]}<> (rejected) |
Autrijus Tang | 81 | print+sort{s|\d+|0 x(length($a.$b)-length$&).$&|eg,for@_=($a,$b);$_[0]cmp$_[1]}<> (rejected) |
Ronald J Kimball | 79 | print sort{($$_=lc${lc$_})=~s/\d+|$/$"x(1e4-length$&).$&/ge for A,B;$A cmp$B}<> (rejected) |
Rick Klement | 79 | ($a=uc)=~s/\d+/$|x($=-length$&).$&/eg,s/^/$a/for@l=<>;s/.*\n//,print for sort@l (rejected) |
Autrijus Tang | 78 | print+sort{s|\d+|0 x(2**07-length$&).$&|eg,for@_=map{lc}$a,$b;$_[0]cmp$_[1]}<> (rejected) |
Ronald J Kimball | 78 | print sort{($$_=lc${lc$_})=~s/\d+|$/$"x(99-length$&).$&/ge for A,B;$A cmp$B}<> (rejected) |
Suo | 77 | print/(.*\n)$/for sort map{$x=$_;s#\d+#'0'.pack'w/a*',$&+0#eg;"\U$_\E\n$x"}<> (rejected) |
Piers Cawley | 74 | print map/\n(.+)/s,sort map{($a=lc)=~s/\d+/$[.chr(length$&).$&/eg;"$a$_"}<> (rejected) |
Andrew Savige | 74 | sub Z{$_=pop;s/\d+/0 .pack(N,length$&).$&/eg;uc}print sort{Z($a)cmp Z$b}<> (rejected) |
Richard Proctor | 74 | -n $a=$_;s/\d+/sprintf"%099s",$&/ge;$b{$:.uc}.=$a}{print map{$b{$_}}sort%b (rejected) |
Llasse | 73 | print sort{"$a$b"=~/^(.*\D)?(\d+).*\n\1(\d+)/i&&$2<=>$3||lc$a cmp lc$b}<> (rejected) |
Suo | 73 | print/(.*\n)$/for sort map{$x=$_;s#\d+|\n#pack'xN/a*',$&#eg;"\U$_\E$x"}<> (rejected) |
Autrijus Tang | 73 | print+sort{s|\d+|0 x(2**07-length$&).$&|eg,for@_=($a,$b);$_[0]cmp$_[1]}<> (rejected) |
Andrew Savige | 73 | sub Z{s/\d+/0 .pack(N,length$&).$&/eg;uc}print sort{Z($_=$a)cmp Z$_=$b}<> (rejected) |
Autrijus Tang | 73 | sub _{s|\d+|0 x(2**07-length$&).$&|eg;lc}print+sort{_($_=$a)cmp _$_=$b}<> (rejected) |
Llasse | 72 | print sort{"$a$b"=~/^(.*\D)?(\d+).*\n\1(\d+)/i;$2<=>$3||lc$a cmp lc$b}<> (rejected) |
Suo | 72 | print/(.*\n)$/for sort map{$x=$_;s#\d+|\n#pack'N/a*',$&#eg;"\U$_\E$x"}<> (rejected) |
Piers Cawley | 72 | print map/\n(.+)/s,sort map{($a=lc)=~s/\d+/0${\chr length$&}$&/g;$a.$_}<> (rejected) |
Andrew Savige | 71 | sub Z{$_=pop;s/(\d+)/sprintf"%.99d",$1/eg;uc}print sort{Z($a)cmp Z$b}<> (rejected) |
Eugene van der Pijll | 70 | sub a{$_=pop;s#\d+#0 .pack'N/A*',$&#ge;lc$_}print sort{a($a)cmp a$b}<> (rejected) |
Llasse | 70 | print sort{"$a$b"=~/^(.*)(\d+).*\n\1(\d+)/i&&$2<=>$3||lc$a cmp lc$b}<> (rejected) |
Andrew Savige | 70 | sub Z{s/\d+/0 .pack(N,$+[0]).$&/eg;uc}print sort{Z($_=$a)cmp Z$_=$b}<> (rejected) |
Llasse | 69 | print sort{"$a$b"=~/^(.*)(\d+).*\n\1(\d+)/?$2<=>$3:$a cmp$b}map lc,<> (rejected) |
Andrew Savige | 69 | sub Z{s/\d+/(':'x length$&).$&/eg;uc}print sort{Z($_=$a)cmp Z$_=$b}<> (rejected) |
BoB | 68 | print sort{"$a$b"=~/^(.*)(\d+).*\n\1(\d+)/i&&$2-$3||lc$a cmp lc$b}<> (rejected) |
lasse | 68 | print sort{"$a$b"=~/^(.*)(\d+)(.*)\n\1(\d+)\3$/i?$2<=>$4:$a cmp$b}<> (rejected) |
Eugene van der Pijll | 68 | sub a{$_=pop;s#\d+#0 .pack'N/A*',$&#ge;lc}print sort{a($a)cmp a$b}<> (rejected) |
Eugene van der Pijll | 68 | sub a{$_=pop;s#\d+#_ x(length$&).$&#ge;lc}print sort{a($a)cmp a$b}<> (rejected) |
BoB | 67 | print/.*\n$/gfor sort map{$x=$_;s#\d+|\n#pack'xN/a*',$&#eg;lc().$x}<> (rejected) |
Andrew Savige | 67 | sub Z{s/\d+/0 .(A x$+[0]).$&/eg;uc}print sort{Z($_=$a)cmp Z$_=$b}<> (rejected) |
Eugene van der Pijll | 66 | sub a{$_=lc pop;s#\d+#A x$+[0].$&#ge;$_}print sort{a($a)cmp a$b}<> (rejected) |
Spiff | 65 | sub f{$_=pop;s;\d+;~0/3+$+[0].$&;eg;lc}print+sort{f($a)cmp+f$b}<> (rejected) |
Eugene van der Pijll | 65 | sub a{$_=pop;s#\d+#8x$+[0].$/.$&#ge;lc}print sort{a($a)cmp a$b}<> (rejected) |
Andrew Savige | 65 | sub Z{s/\d+/0 .A x$+[0].$&/eg;uc}print sort{Z($_=$a)cmp Z$_=$b}<> (rejected) |
Andrew Savige | 65 | sub Z{$_=pop;s/\d+/length($&).$&/eg;uc}print sort{Z($a)cmp Z$b}<> (rejected) |
Richard Proctor | 65 | -n $a=$_;s/\d+/sprintf"%99s",$&/ge;$b{$:.uc}.=$a}{print@b{sort%b} (rejected) |
Autrijus Tang | 64 | -p $k=$_;s!|\d+!pack'AN/Z*',0,$&!eg;$;{lc,}.=$k}for(@;{sort%;}){ (rejected) |
Andrew Savige | 64 | sub Z{s/\d+/': 'x$+[0].$&/eg;uc}print sort{Z($_=$a)cmp Z$_=$b}<> (rejected) |
Andrew Savige | 64 | sub Z{s/\d+/':0'x$+[0].$&/eg;uc}print sort{Z($_=$a)cmp Z$_=$b}<> (rejected) |
Eugene van der Pijll | 63 | sub a{$_=lc pop;s#\d+#0 x$&.$/#ge;$_}print sort{a($a)cmp a$b}<> (rejected) |
Andrew Savige | 63 | sub Z{s/\d+/':'x$+[0].$&/eg;uc}print sort{Z($_=$a)cmp Z$_=$b}<> (rejected) |
Autrijus Tang | 62 | -pa s!|\d+!pack'AN/Z*',0,$&!eg;$;{lc,}.="@F\n"}for(@;{sort%;}){ (rejected) |
Autrijus Tang | 59 | sub _{$_=shift;s/\d+/chr$&/g;$_}print+sort{_($a)cmp _ $b}<> (rejected) |
Ronald J Kimball | 58 | print sort{"$a$b"=~('(\D+)(\d*)\n'x 2);$1cmp$3||$2<=>$4}<> (rejected) |
Dave Hoover | 357 | print sort{$r=0;$j=$a;$k=$b;$d=$j=~/\d/?1:0;until($r){$u=$v=1;$e=$d?'\d':'[a-z]';($p,$q)=map{s/^($e+)//i?lc$1:''}$j,$k;($x,$y)=map/\w/?0:1,$j,$k;if($p&&$q){if($d){($h,$i)=map{length}$p,$q;;if(!($r=($h<=>$i))){($u,$v)=map{s/(.)//?$1:''}$p,$q until($u==''||($r=$u<=>$v))}}$r=($p cmp$q)if!$d}else{$r=$p?1:-1;$r=!$r if$d}$r||($y&&$r++)||$x&&$r--;$d=$d?0:1}$r}<> |
Dave Hoover | 301 | print sort{chop($j=$a);chop($k=$b);do{$e=($d=$j=~/^\d/)?'\d':'[a-z]';($p,$q)=map{s/^($e+)//i?lc$1:''}$j,$k;if($p&&$q){if($d&&!($r=length$p<=>length$q)){do{($u,$v)=map{s/(.)//?$1:''}$p,$q}until($u==''||($r=$u<=>$v))}$r=($p cmp$q)if!$d}else{$r=$p?1:-1;$r=!$r if$d}$r||(!$k&&$r++)||!$j&&$r--}until($r)}<> |
Dave Hoover | 277 | $w='[a-z]';print sort{g($a,$b)}<>;sub g{my($j,$k,$z,$x)=@_;for($j,$k){my@c;{$e=/^\d/?'\d':$w;$p=$z?'':'+';s/($e$p)//i;push@c,lc$1;$1ne''&&redo}$_=+\@c}for(@$j){$v=$$k[$x++];last if$r=/\d/?$z?$_<=>$v:g($_,$v,1):$_ cmp$v}if($z){$r=($s=@$j<=>@$k)?$s:$r;$r=(grep/$w/,@$k)?-1:$r}$r} |
Dave Hoover | 276 | $w='[a-z]';print sort{g($a,$b)}<>;sub g{my($j,$k,$z,$x)=@_;for($j,$k){my@c;{$e=/^\d/?'\d':$w;$p=$z?'':'+';s/($e$p)//i;push@c,lc$1;$1ne''&&redo}$_=\@c}for(@$j){$v=$$k[$x++];last if$r=/\d/?$z?$_<=>$v:g($_,$v,1):$_ cmp$v}if($z){$r=($s=@$j<=>@$k)?$s:$r;$r=(grep/$w/,@$k)?-1:$r}$r} |
Andrew Savige | 250 | print sort{$u=uc$a;$v=uc$b;@x=$u=~/\d+|\D+/g;@y=$v=~/\d+|\D+/g;return$u cmp$v if@x<2||@y<2or$x[0]=~/\d/^$y[0]=~/\d/;for(0..(@x<@y?@x:@y)){$c=$x[$_];$d=$y[$_];$i=length$c;$j=length$d;return$i<=>$j if$c=~/\d/&&$i!=$j;return$c cmp$d if$c ne$d}@x<=>@y}<> |
Autrijus Tang | 117 | print+sort{my@z;($;=$a)=~s/\d+/push@z,$&;1/eg;$_=$b;s/\d+/1-(length($*=shift@z)<=>length$&||$*cmp$&)/eg;lc$;cmp+lc}<> |
Llasse | 87 | print sort{"$a$b"=~/^((.*\D)?)(\d+).*\n\1(\d+)/i&&length$3<=>length$4||lc$a cmp lc$b}<> |
Llasse | 82 | print sort{"$a$b"=~/^(.*)(\d+).*\n\1(\d+)/i&&length$2<=>length$3||lc$a cmp lc$b}<> |
Rick Klement | 81 | print sort{($a.$b)=~/(.*)(\d+).*\n\1(\d+)/i&&length$2<=>length$3||uc$a cmp uc$b}<> |
Andrew Savige | 80 | sub Z{$_=pop;s/\d+/sprintf("%010d",length$&).$&/eg;uc}print sort{Z($a)cmp Z$b}<> |
BoB | 79 | print+sort{s|\d+|sprintf"%".length("@_")."s",$&|egfor@_=($a,$b);$_[0]cmp$_[1]}<> |
Eugene van der Pijll | 77 | sub a{$_=lc pop;s#\d+#0 .pack(N,length$&).$&#ge;$_}print sort{a($a)cmp a$b}<> |
Marcus Holland-Moritz | 76 | print sort{s/\d+/sprintf"%9d$&",length$&/egfor($",$;)=(uc$a,uc$b);$"cmp$;}<> |
BoB | 73 | print+sort{s|\d+|0 x length("$@").$&|egfor@_=($a,lc$b);lc$_[0]cmp$_[1]}<> |
Piers Cawley | 73 | print map/\n(.+)/s,sort map{($a=lc)=~s|\d+|0${\pack'N/a*',$&}$&|g;$a.$_}<> |
Andrew Savige | 72 | sub Z{s/\d+/0 .(':'x length$&).$&/eg;uc}print sort{Z($_=$a)cmp Z$_=$b}<> |
Eugene van der Pijll | 71 | sub a{$_=lc pop;s#\d+#0 .pack'N/A*',$&#ge;$_}print sort{a($a)cmp a$b}<> |
Andrew Savige | 71 | sub Z{s/\d+/0 .(A x length$&).$&/eg;uc}print sort{Z($_=$a)cmp Z$_=$b}<> |
Suo | 69 | print/(.*\n)$/for sort map{($x=lc)=~s#\d+|\n#pack'xN/a*',$&#eg;$x.$_}<> |
Ian Phillips | 69 | sub t{$_=pop;s/\d+/(1e9+length$&).$&/ge;lc}print sort{t($a)cmp t$b}<> |
Autrijus Tang | 69 | -p $k=$_;$_=lc;s!|\d+!pack'AN/Z*',0,$&!eg;$;{$_}.=$k}for(@;{sort%;}){ |
Marcus Holland-Moritz | 69 | print sort{s!\d+!pack'AN/A*',0,$&!egfor($",$;)=(uc$a,uc$b);$"cmp$;}<> |
Autrijus Tang | 66 | -p ($*=lc)=~s!|\d+!pack'AN/A*',0,$&!eg;$;{$*}.=$_}for(@;{sort%;}){ |
Spiff | 65 | sub f{$_=pop;s;\d+;9 x9+$+[0].$&;eg;lc}print+sort{f($a)cmp+f$b}<> |
Marcus Holland-Moritz | 65 | print sort{s!\d+!pack'AN/A*',0,$&!egfor$"=uc$a,$;=uc$b;$"cmp$;}<> |
BoB | 64 | sub f{$_=pop;s;\d+;1e9+$+[0].$&;eg;uc}print+sort{f($a)cmp+f$b}<> |
Spiff | 64 | sub f{$_=pop;s|\d+|9x9+$+[0].$&|eg;lc}print+sort{f($a)cmp+f$b}<> |
BoB | 63 | sub f{s;\d+;1e9+$+[0].$&;eg;uc}print+sort{f($_=$a)cmp+f$_=$b}<> |
BoB | 62 | sub f{s;\d+;$^T+$+[0].$&;eg;uc}print+sort{f($_=$a)cmp+f$_=$b}<> |
BoB | 61 | print sort{s!\d+!1e9+$+[0].$&!egfor$"=uc$a,$;=uc$b;$"cmp$;}<> |
BoB | 60 | print sort{s!\d+!$^T+$+[0].$&!egfor$"=uc$a,$;=uc$b;$"cmp$;}<> |
BoB | 60 | -p $k=$_;s!|\d+!1e9+$+[0].$&!eg;$;{+uc}.=$k}for(@;{sort%;}){ |
BoB | 59 | -p $k=$_;s!|\d+!$^T+$+[0].$&!eg;$;{+uc}.=$k}for(@;{sort%;}){ |
BoB | 59 | -paF s!|\d+!1e9+$+[0].$&!eg;$;{+uc}.="@F\n"}for(@;{sort%;}){ |
BoB | 58 | -paF s!|\d+!$^T+$+[0].$&!eg;$;{+uc}.="@F\n"}for(@;{sort%;}){ |
Assignment 2: fair shuffle | ||
Jonathan E. Paton | 121 | -w @a=<>;for(@INC){open F,$_."/pod/perlfaq4.pod"or next;undef$/;$_=<F>;($_)=/(my\$arr.*?\})/s;s'shift'\@a's;eval;print@a} (rejected, doesn't seem to pick up the right code in my perl) |
Jonathan E. Paton | 118 | @a=<>;for(@INC){open F,$_."/pod/perlfaq4.pod"or next;undef$/;$_=<F>;($_)=/(my\$arr.*?\})/s;s'shift'\@a's;eval;print@a} (rejected, doesn't seem to pick up the right code in my perl) |
Jonathan E. Paton | 33 | -n $a{$..rand}=$_}{print values%a (rejected) |
Autrijus Tang | 32 | -n splice@_,rand@_,0,$_}{print@_ (rejected) |
Piers Cawley | 32 | -p splice@a,rand@a,0,$_}for(@a){ (rejected) |
Andrew Savige | 32 | %C=map{rand,$_}<>;print values%C (rejected) |
Richard Proctor | 31 | -n $_{+rand}=$_}{print values%_ (rejected) |
BoB | 30 | -n $a{+rand}=$_}for(values%a){ (rejected) |
BoB | 30 | -n $a{$..rand}=$_}for(@a{%a}){ (rejected) |
Autrijus Tang | 28 | print+sort{int(rand(3))-1}<> (rejected) |
BoB | 28 | -n $a{+rand}=$_}for(@a{%a}){ (rejected) |
Richard Proctor | 28 | -n $_{+rand}=$_}{print@_{%_} (rejected) |
Yen-Ming Lee | 27 | print sort{rand 2>1?-1:1}<> (rejected) |
BoB | 23 | print+sort{rand(2)-1}<> (rejected) |
Gimbo | 20 | print sort{rand 2}<> (rejected) |
J.Robert Suckling | 46 | @A=<>;while(@A){print splice @A,int rand @A,1} |
Patrick Gaskill | 44 | @a=<>;print splice@a,int rand$#a+1,1 while@a |
BoB | 40 | @f=<>;print splice(@f,rand(@f),1)while@f |
Kye Leslie | 40 | @a=<>;while(@a){print splice@a,rand@a,1} |
Dave Hoover | 40 | @a=<>;print splice@a,int rand@a,1while@a |
Suo | 37 | @x=<>;print splice@x,rand@x,1 while@x |
Ian Phillips | 37 | @x=<>;print splice @x,rand@x,1while@x |
Ion | 36 | @a=<>;print splice@a,rand@a,1while@a |
Andrew Savige | 36 | @a=<>;print splice@a,rand@a,1while@a |
Ronald J Kimball | 36 | @a=<>;print splice@a,rand@a,1while@a |
Ian Phillips | 36 | @x=<>;print splice@x,rand@x,1while@x |
Dave Hoover | 36 | @a=<>;print splice@a,rand@a,1while@a |
Autrijus Tang | 35 | @_=<>;print+delete$_[rand@_]while@_ |
Llasse | 35 | print splice@a,rand@a,1 for@b=@a=<> |
Autrijus Tang | 34 | -n splice@_,rand@_+1,0,$_}{print@_ |
Spiff | 34 | print+splice@,,rand@,,1for@==@,=<> |
Jonathan E. Paton | 34 | print splice@a,rand@a,1for@b=@a=<> |
Piers Cawley | 34 | -p splice@a,rand@a+1,0,$_}for(@a){ |
Autrijus Tang | 34 | -p splice@F,rand@F+1,0,$_}for(@F){ |
Suo | 33 | print map{splice@x,rand@x,1}@x=<> |
Andrew Savige | 33 | print map{splice@x,rand@x,1}@x=<> |
Spiff | 33 | -n splice@,,rand$.,0,$_}print@,;{ |
Eugene van der Pijll | 32 | -p splice@a,rand$.,0,$_}for(@a){ |
Spiff | 32 | -p splice@F,rand$.,0,$_}{print@F |
Andrew Savige | 32 | -n splice@x,rand$.,0,$_}{print@x |
Marcus Holland-Moritz | 32 | -n splice@_,rand$.,0,$_}{print@_ |
Rick Klement | 32 | -n splice@a,rand$.,0,$_}{print@a |
Autrijus Tang | 32 | -p splice@.,rand$.,0,$_}for(@.){ |
Assignment 3: select 2 | ||
Jonathan E. Paton | 40 | @a=<>;splice@a,rand@a,1while@a>2;print@a (rejected) |
Autrijus Tang | 37 | -n splice@_,rand@_,0,$_}{print@_[0,1] (rejected) |
Piers Cawley | 37 | -p splice@a,rand@a,0,$_}for(@a[0,1]){ (rejected) |
Autrijus Tang | 37 | -nla0 print+splice@F,rand@F,1,for$,,1 (rejected) |
Yen-Ming Lee | 37 | print((sort{rand 2>1?-1:1}(<>))[0,1]) (rejected) |
Jonathan E. Paton | 34 | -n $a{$..rand}=$_}{print+(%a)[1,3] (rejected) |
BoB | 33 | -p $a{$..rand}=$_}for((%a)[1,3]){ (rejected) |
Richard Proctor | 32 | -n $_{+rand}=$_}{print+(%_)[1,3] (rejected) |
BoB | 31 | -p $a{+rand}=$_}for((%a)[1,3]){ (rejected) |
Kye Leslie | 47 | @a=<>;$a=2;while($a--){print splice@a,rand@a,1} |
J.Robert Suckling | 45 | @A=<>;for(1,2){print splice @A,int rand @A,1} |
Patrick Gaskill | 44 | @a=<>;print splice@a,int rand$#a+1,1 for+1,2 |
Eugene van der Pijll | 41 | print splice(@a,rand(@a=<>),1),$a[rand@a] |
Dave Hoover | 41 | @a=<>;map{print splice@a,int rand@a,1}0,0 |
Piers Cawley | 39 | -p splice@a,rand@a+1,0,$_}for(@a[0,1]){ |
Andrew Savige | 38 | @x=<>;eval'print splice@x,rand@x,1;'x2 |
Autrijus Tang | 37 | @_=<>;map{print+splice@_,rand@_,1}1,2 |
Suo | 37 | @x=<>;print splice@x,rand@x,1 for 1,1 |
Llasse | 37 | @a=<>;print splice@a,rand@a,1 for 1,2 |
Andrew Savige | 37 | @a=<>;print splice@a,rand@a,1for 1..2 |
Ian Phillips | 37 | @x=<>;print splice@x,rand@x,1for 1..2 |
Autrijus Tang | 37 | @F=<>;print+splice@F,rand@F,1,for$,,1 |
Rick Klement | 37 | -n splice@a,rand$.,0,$_}{print@a[0,1] |
Dave Hoover | 37 | @a=<>;map{print splice@a,rand@a,1}1,1 |
Ronald J Kimball | 36 | @a=<>;print splice@a,rand@a,1for 1,2 |
Ion | 36 | @_=<>;print+splice@_,rand@_,1for+1,2 |
Suo | 36 | print splice@x,rand@x,1 for[@x=<>],1 |
Eugene van der Pijll | 36 | @a=<>;print splice@a,rand@a,1for a,b |
Ian Phillips | 36 | @x=<>;print splice@x,rand@x,1for 1,2 |
Andrew Savige | 36 | @a=<>;print splice@a,rand@a,1for 1,2 |
Marcus Holland-Moritz | 36 | @_=<>;print splice@_,rand@_,1for 0,0 |
Spiff | 35 | print+splice@,,rand@,,1for[@,=<>],f |
Eugene van der Pijll | 35 | -p splice@a,rand$.,0,$_}{($_,$\)=@a |
Andrew Savige | 35 | -p splice@x,rand$.,0,$_}{($_,$\)=@x |
Ton Hospel |