_NOW_ I know why I have a mobile phone. Silly me for not seeing this one...
#!perl -ap056
sub p{(()=/[aeiouy]/ig)."/".s/\w/$&/g}$l=p.": ";$_=join$"x3,@F;s/(...) +/$1 /g;$l.=sprintf'%-*s ',length,p for@F;s/(.{57}).{4,}/$1.../&&$l=~s/( .{56}\S*).*/$1/;$_=@F.": $_
$l
"if@F;s/ +$//
|
Unbeliveable. My second eye is rapidly going down the drain... ... I'm still waiting for the magic idea to race past \'anick
#!perl -ap056
sub p{(()=/[aeiouy]/ig)."/".s/\w/$&/g}$l=p.": ";$_=join$"x3,@F;s/(...) +/$1 /g;$l.=sprintf'%-*s ',length,p for@F;$l=~s/( .{56}\S*).*/$1/ if s/(.{57}).{4,}/$1.../;$_=@F.": $_
$l
"if@F;s/ +$//;
|
Completely new approach, My first eye pop()d half an hour ago. :)
#!perl -ap056
sub p{(()=/[aeiouy]/ig)."/".s/\w/$&/g}$_=join$"x3,@F;s/(...\S*) +/$1 /g;$s=p;$l="@{[map{sprintf'%-*s',length,p}@F]}";$l=~s/(.{56}\S*).*/$1/ if s/(.{57}).{4,}/$1.../;$_=@F.": $_
$s: $l
"if@F;s/ +$//;
|
Rework trunctating the second string. Thanks to pos, this seems more promising.
#!perl -ap056
$_=$x=$b='';if(@r=map{$_.=$"x(3*!/\./-length);$-=length;$b+=@D=/\w/g;$x+=@C=/[aeiouy]/ig;sprintf"%-$-s",@C."/".@D}@F){$_="@F";s/(.{57})....+/$1.../;/ *\../g;substr($q="@r",pos()-3)=~s/\s.*//;$_=@F.": $_
$x/$b: $q
";s/ +$//}
|
I'm not sure if this file survives submitting, but it is correct (i.e. passes the test script with perl5.6.1) It is the result of my feeble attempt to shorten my script by golfing a compression routine. It (mis)uses UUen/decode for that. As uuencoding bloats a file by 33%, the inverse (uudecoding) can be used for compresstion. You have to restrict yourself to the character set of uuencode (!-` = \x21 - \x60) which is plenty of space to fit a perl program with the use of tr///; The encoder is this: # Slurp in the whole file $/=\0777; $_=<>; # Save the shebang-line s/^#!.*?\n//; $perl=$&;$perl=~s!/.*/perl!perl!; # Insert necessary line-length markers s/.{0,60}/M$&/gs; # what to translate $a=' a{-}e-i\n\tl n-yFm'; $b=q{'A-Z`}; # actually compress eval "y/$a/$b/"; $_=unpack("u*",$_); # Fix the generated string s/\000+$//; s/.$//; # Output the compressed program print $perl.q<($_=pack u,q{>.$_.q<})=~y/>."$b/$a/;eval"
#!perl -ap056
($_=pack u,q{DtNDЂn'@D(8lj8HgXHg@f!d
gl[lMu5 -$t7>v`ZoןOv*n`4Cs#8#: $b<fР& |
Compression take two - without ^Ms this time.
#!perl -ap056
($_=pack u,q{DtNDЂn'@D(8lj8HgXHg@f vnJ xGMb[lMuA -$t7>v`ZoןOv*n`4D3#8#: $b<fР& |
Compress in golfish-one-line-style. This change is courtesy of perltidy --mangle|perl -pe 's/;}/}/g;s/;\n/;/; Automating this step allows me to continue working on the more-sane-looking version.
#!perl -ap056
$_=$v=$:=$x=$m=$p="";if(@r=map{$_.=$"x(3*!/\./-length);$:||=$p-($v>56)-($v>60)if(60-$v<($-=length));$p++;$v+=1+$-;$m+=@D=/\w/g;$x+=@C=/[aeiouy]/ig;sprintf"%-$-s",@C."/".@D}@F){$#r=$:if$:;$_="@F";s/(.{57})....+/$1.../;$_="$p: $_
$x/$m: @r
";s/ +$//}
|
Traded the print for a -p switch for a small gain. Renamed a few variables (see artistic solution for the reason)
#!perl -ap056
$_=$v=$:=$x=$m=$p="";
if(@r=map{
$_.=$"x(3*!/\./-length);
$:||=$p-($v>56)-($v>60)if(60-$v<($-=length));
$p++;
$v+=1+$-;
$m+=@D=/\w/g;
$x+=@C=/[aeiouy]/ig;
sprintf"%-$-s",@C."/".@D;
}@F){
$#r=$:if$:;
$_="@F";s/(.{57})....+/$1.../;
$_="$p: $_
$x/$m: @r
";
s/ +$//;
};
|
Optimize the next if ... Optimize the cutting off, and a few assignments. I still think I'm missing somthing as I'm shaving off single chars while still over 100 behind the lead...
#!perl -an056
$v=$p=$x=$b=$z=0;
$r[$#r=$p||$#F]=~s/ +$//,
($_="@F")=~s/(.{57})....+/$1.../,
print "$z: $_
$x/$b: @r
"if@r=map{
$_.=$"x(3*!/\./-length);
$p||=$z-($v>56)-($v>60)if(60-$v<($-=length));
$z++;
$v+=1+$-;
$b+=@D=/\w/g;
$x+=@C=/[aeiouy]/ig;
sprintf"%-$-s",@C."/".@D;
}@F;
|
Wow. I hate perl5.6.1, it breaks in so many interesting places... Anyway, found an even shorter workaround, so I now can hand the "red lantern" off to someone else... "
#!perl -an056
next if/^\s+$/;
$v=$p=$x=$b=$z=0;
@r=map{
$_.=$"x(3-length)if!/\./;
$-=length;
$p||=$z-($v>56)-($v>60)if($v+$->60);
$z++;
$v+=1+$-;
$b+=@D=/\w/g;
$x+=@C=/[aeiouy]/ig;
sprintf"%-$-s",@C."/".@D;
}@F;
$r[$#r=$p||$z-1]=~s/ +$//;
print "$z: ","@F"=~/(.{57})..../?"$1...":"@F","
$x/$b: @r
";
|
Finally a solution to get out of that shamefull last place. *sigh* I want to be demoted to beginners again :-) Use new temporary variables so m// can yet be shorter than y/// The cutting to 60 chars can be optimized a bit more. oops actually $c wasn't needed
#!perl
for("@{[<>]}"=~/.*?\./sg){
$v=$p=$x=$b=$z=0;
@r=map{
$_.=$"x(3-length)if!/\./;
$-=length;
$p||=$z-($v>56)-($v>60)if($v+$->60);
$z++;
$v+=1+$-;
$b+=@D=/\w/g;
$x+=@C=/[aeiouy]/ig;
sprintf"%-$-s",@C."/".@D;
}@l=split;
$r[$#r=$p||$z-1]=~s/ +$//;
print "$z: ","@l"=~/(.{57})..../?"$1...":"@l","
$x/$b: @r
";
};
|
Remove some debugging Loose the sub, and play with sprintf Use the map array-return in a more clever way Play with sprintf Replace @{[/..../g]} with y/// where fit. And some standard golf-style shortening.
#!perl
for("@{[<>]}"=~/.*?\./sg){
$v=$p=$x=$b=$z=0;
$c=@r=map{
$_.=$"x(3-length)if!/\./;
$-=length;
$p||=$z-($v>56)-($v>60)if($v+$->60);
$z++;
$v+=1+$-;
$b+=$d=@{[/\w/g]};
$x+=$c=y/aeiouyAEIOUY//;
sprintf"%-$-s","$c/$d";
}@l=split;
$r[$#r=$p||$c-1]=~s/ +$//;
"@l"=~/(.{0,57})(....)?/;
print "$c: $1".($2?"...":$')."
$x/$b: @r
";
};
|
Damn cut&paste ruined the tabs, sorry
#!perl -l
#$M=1 if ("@a"=~/dots/);
@a=<>;
($_="@a")=~s/\s+/ /sg;
for(/.*?\./g){
$p=$a=$b=$i=0;
$v=-1;
$c=@l=map {
$z=length;
$a+=$q[$i]=@{[/[aeiouy]/gi]};
$q[$i].="/".($c=@{[/\w/g]});
$q[$i].=" "x($z-length($q[$i]));
$i++;
$b+=$c;
$_.=" "x(3-$z)if(!/\./);
print "v=$v, len=",length," together:",$v+1+length if $M;
if($v+1+length($_)>60){
$p=$i-1;
print "Line too long" if $M;
if($v+1+3+1>60){
print "No chars will be printed" if $M;
$p--;
$p-- if ($sixty);
};
$v=-999;
};
$sixty=($v+1+length($_)==60);
$v+=1+length;
$_;
} split;
$p||=$c-1;
$q[$p]=~s/ +$//;
print "$c: ",c(@l);
print "$a/$b: @q[0..$p]";
};
sub c{
length($_="@_")>60 && s/(?<=.{57}).*/.../;
$_;
};
|
I think this hole is to hard for golf. It is no fun golfing if it takes me more than thre hours to correctly handle all the obscure cases on this hole. Furthermore the test script batch-testing too many different cases at once makes it really hard to see what you forgot... I just submit this for reference, as I'm not sure I will find the energy to continue with this.
#!perl -l
#$M=1 if ("@a"=~/dots/);
@a=<>;
($_="@a")=~s/\s+/ /sg;
for(/.*?\./g){
$p=$a=$b=$i=0;
$v=-1;
$c=@l=map {
$z=length;
$a+=$q[$i]=@{[/[aeiouy]/gi]};
$q[$i].="/".($c=@{[/\w/g]});
$q[$i].=" "x($z-length($q[$i]));
$i++;
$b+=$c;
$_.=" "x(3-$z)if(!/\./);
print "v=$v, len=",length," together:",$v+1+length if $M;
if($v+1+length($_)>60){
$p=$i-1;
print "Line too long" if $M;
if($v+1+3+1>60){
print "No chars will be printed" if $M;
$p--;
$p-- if ($sixty);
};
$v=-999;
};
$sixty=($v+1+length($_)==60);
$v+=1+length;
$_;
} split;
$p||=$c-1;
$q[$p]=~s/ +$//;
print "$c: ",c(@l);
print "$a/$b: @q[0..$p]";
};
sub c{
length($_="@_")>60 && s/(?<=.{57}).*/.../;
$_;
};
|