Thanks to Chris Sarnowski!
#!perl -pa056
sub g{y/aeiouyAEIOUY//."/".s/\w/$&/g}$t=g;@r=map{$_=sprintf"%-3s",$_;pack A.y///c,g}@F;s/ +$//,s/(.{57})....+/$1.../,$_=@F.": $_
$t: @r[0..s/ +[^.]//g]
",s/ +$// if$_="@F"
|
5 characters, and I only move up one space in the rankings?!
#!perl -pa056
sub g{y/aeiouyAEIOUY//."/".s/\w/$&/g}$t=g;@r=map{$_=sprintf"%-3s",$_;pack A.y///c,g}@F;$_="@F"||exit;s/ +$//;s/(.{57})....+/$1.../;$_=@F.": $_
$t: @r[0..s/ +[^.]//g]
";s/ +$//
|
Thanks to Chris Sarnowski!
#!perl -pa056
sub g{y/aeiouyAEIOUY//."/".s/\w/$&/g}$t=g;@r=map{$_=sprintf"%-3s",$_;pack A.y///c,g}@F;$_="@F"||exit;s/ +$//;s/(.{57})....+/$1.../;$_=@F.": $_
$t: @r[0..s/ +[^.]//g]
";s/ +$//
|
Aha! I *knew* storing ideas from previous contests would come in useful!
#!perl -pa056
sub g{y/aeiouyAEIOUY//."/".s/\w//g}$t=g;map{$_=sprintf"%-3s",$_}@F;$_="@F"||exit;s/ +$//;s/(.{57})....+/$1.../;map{$_=pack A.y///c,g}@F;$_=@F.": $_
$t: @F[0..s/ +[^.]//g]
";s/ +$//
|
Ha! (OK, it's only *really* two characters less than my 198.)
#!perl -pa056
sub g{y/aeiouyAEIOUY//."/".s/\w//g}$t=g;map{$_=sprintf"%-3s",$_}@F;$_="@F"||exit;s/ +$//;s/(.{57})....+/$1.../;map{$_=pack"A".y///c,g}@F;$_=@F.": $_
$t: @F[0..s/ +[^.]//g]
";s/ +$//
|
We have algorithmage! Sub-200 and I should be able to get a good bit farther (famous last words)...
#!perl -pa056
sub g{y/aeiouyAEIOUY//."/".s/\w/$&/g}
$t=g;map{$_=sprintf"%-3s",$_}@F;$_="@F"||exit;s/ +$//;s/(.{57})....+/$1.../;
map{$_=pack"A".y///c,g}@F;
$_=@F.":\t$_\n$t:\t@F[0..s/ +[^.]//g]\n";
s/ +$//
|
Sigh. My exciting new algorithm doesn't work. Back to the drawing board...
#!perl -pa056
sub g{y/aeiouyAEIOUY//."/".s/\w/$&/g}sub l{formline"`$f
",@_}(@r=map{$f.="@"."<"x length($_|$:);g}@F)?l@F:exit;$f=~/.{57}<*/,$f=$&if$=~s/(.{58})....+/$1.../;$=@F.$.g;l@r;$_=$;s/`/: /g;$f=$=""
|
Algorithmic breakthrough? With formline?! Stay tuned. I'm not sure the paste worked, by the way. I'm seeing boxes on my IE screen that are supposed to be ctrl-A's, as in $ACCUMULATOR. And the thing before "/gm" at the end is a tab.
#!perl -pa056
sub g{y/aeiouyAEIOUY//."/".s/\w/$&/g}sub l{formline"`$f
",@_}(@r=map{$f.="@"."<"x length($_|$:);g}@F)?l@F:exit;$f=~/.{57}<*/,$f=$&if$=~s/(.{58})....+/$1.../;$=@F.$.g;l@r;$_=$;s/`/: /gm;$f=$=""
|
I guess it's cheating that I've held back my s/\n/ /g etc. but it made my program much easier to develop, and I knew most of those changes weren't going to get me too far in the long run.
#!perl -pa056
sub g{y/aeiouyAEIOUY//."/".s/\w/$&/g}sub p{sprintf"%-*s",(1+length($_|$:))*!/\./,@_}$x=$"="";(map{$x.=p$_;$_=p g}@F)?$x=~s/(.{57})....+/$1.../:exit;$_=@F.": $x
".g.": @F[0..$x=~s/ +[^.]//g]
";s/ +$//
|
Argh! Figured out I could edit the first line to get the second line, and I was sure that it would get me ten characters. But it's stuck at 237 now. Which puts me in eye-popping single-character territory.
#!perl -pa056
sub g{y/aeiouyAEIOUY//."/".s/\w/$&/g}
sub p{sprintf"%-*s",(1+length($_|$:))*!/\./,@_}
$x=$"="";
(map{$x.=p$_;$_=p g}@F)?$x=~s/(.{57})....+/$1.../:exit;
$_=@F.":\t$x\n".g.":\t@F[0..$x=~s/ +[^.]//g]\n";
s/ +$//
|
Hooray for string bit or!
#!perl -pa056
sub g{y/aeiouyAEIOUY//."/".s/\w/$&/g}
sub p{sprintf"%-*s",(1+length($_|$:))*!/\.$/,pop}
$x=$"="";
(map{$x.=p$_;$_=p g}@F)?$x=~s/(.{57})....+/$1.../:exit;
$_=@F.":\t$x\n".g.":\t@F[0..$x=~s/ +[^.]//g]\n";
s/ +$//
|
Who the &$#! uses formline?! (I thought this one was definitely going to be more reducible...)
#!perl -pa056
sub g{y/aeiouyAEIOUY//."/".s/\w/$&/g}
sub l{formline":$f\n",@_}
(@r=map{$f.="@"."<"x length($_|$:);g}@F)?l@F:exit;
substr($f,57)=~y/ @/
|
Duh! -a switch! Also, I never knew you could interpolate such complicated expressions in quotes.
#!perl -pa056
sub g{y/aeiouyAEIOUY//."/".s/\w/$&/g}
sub p{sprintf"%-*s",$m*!/\.$/,pop}
$x=$"="";
(map{$m=($l=length)>3?$l+1:4;$x.=p$_;$_=p g}@F)?$x=~s/(.{57})....+/$1.../:exit;
$_=@F.":\t$x\n".g.":\t@F[0..$x=~s/ +[^.]//g]\n";
s/ +$//
|
Mostly excess parens & things. I'm starting to use $_ for a LOT of things here!
#!perl -p056
sub g{y/aeiouyAEIOUY//."/".s/\w/$&/g}
sub p{sprintf"%-*s",$m*!/\.$/,pop}
split||exit;
$x=$w=$"="";
map{$m=($l=length)>3?$l+1:4;$x.=p$_;$_=p g}@_;
$x=~s/(.{57})....+/$1.../;
$w=$x=~s/ +[^.]/$&/g;
$_=g.":\t@_[0..$w]";
s/ +$//;
$_=@_.":\t$x\n$_\n"
|
I'm starting to feel a bit less embarrassed about my score. I fear we're going to need an algorithm change soon, though.
#!perl -p056
sub g{y/aeiouyAEIOUY//."/".s/\w/$&/g}
sub p{sprintf("%-*s",$m*!/\.$/,$_[0])}
split||exit;
$x=$w=$"="";
map{$m=($l=length)>3?$l+1:4;$x.=p$_;$_=p g}(@_);
$x=~s/(.{57})....+/$1.../;
$w=$x=~s/ +(?!\.+$)/$&/g;
$w="@_[0..$w]";
$w=~s/ +$//;
$_=@_.":\t$x\n".g.":\t$w\n"
|
We've broken the 300 barrier (with a slight change in algorithm). Only 150 more characters to go!
#!perl -p056
sub g{y/aeiouyAEIOUY//."/".s/\w/$&/g}
sub p{sprintf("%-*s",$m*!/\.$/,$_[0])}
split||exit;
$x=$w="";
map{$m=($l=length)>3?$l+1:4;$x.=p$_;$_=p g}(@_);
$x=~s/(.{57})....+/$1.../;
while($x=~/\b\S+(([^.]?)\.+$)?/g){$w++if$1||!$2}
$w=join("",@_[0..$w-1]);
$w=~s/\s+$//;
$_=@_.":\t$x\n".g.":\t$w\n"
|
split's default is very convenient! At this rate, I should be down to 200 by Friday...June 28.
#!perl -p056
sub g{y/aeiouyAEIOUY//."/".s/\w/$&/g}
sub p{sprintf"%-*s",$m+1,pop}
split||exit;
$x=$w="";
map{$m=($l=length)>3?$l:3;$x.=p$_;$w.=p g}@_;
map{s/\s+$//}$x,$w;
$q=$w;
if($x=~s/(.{57})....+/$1.../){
$q="";while($x=~/\b\S+(([^.]?)\.+$)?/g){if($2||!$1){$w=~s#\s*[\d/]+##;$q.=$&}}}
$_=@_.":\t$x\n".g.":\t$q\n"
|
Mostly a shortened version of the algorithm from the LONG one. It doesn't improve my ranking by much, but it'll look great on the scoring graph.
#!perl -p056
sub g{y/aeiouyAEIOUY//."/".s/\w/$&/g}
sub p{sprintf"%-*s",$m+1,pop}
s/^\s+//;
next if /^\s*$/;
split/\s+/;
$x=$w="";
map{$m=($l=length)>3?$l:3;$x.=p$_;$w.=p g}@_;
map{s/\s+$//}$x,$w;
$q=$w;
if($x=~s/(.{57})....+/$1.../){
$q="";while($x=~/\b\S+(([^.]?)\.+$)?/g){if($2||!$1){$w=~s#\s*[\d/]+##;$q.=$&}}}
$_=@_.":\t$x\n".g.":\t$q\n";
|
This assignment is hard! I spent so much time just getting a working solution that I decided to submit it. I'll pretend it's so that newbies can look at it for learning purposes later on. It's really just there because I spent so much freaking time on it.
#!perl -w
use strict;
$/ = ".";
my ($s1,$s2, $l1, $l2, $q, $max);
while (<>) {
s/^\s+//;
next if /^\s*$/;
my ($totv, $totl) = count($_);
my @word = split/\s+/;
$s1 = $s2 = "";
foreach my $w (@word) {
$max = ($l1= length $s1)> ($l2 = length $s2)? $l1 : $l2;
&space($s1); # noop at start; don't add spaces after period
&space($s2);
my ($v, $l) = count($w);
my $try1 = "$w";
my $try2 = "$v/$l";
$s1 .= $try1;
$s2 .= $try2;
}
if ($s1 =~ s/(.{57})....+/$1.../) { # need to modify
$q="";
while ($s1 =~ /\b\S+(([^.]?)\.+$)?/g) {
unless ($1 && !$2) { # unless last string is just dots
$s2 =~ s#\s*[\d/]+##;
$q.=$&;
}
}
} else {
$q = $s2;
}
print scalar @word . ":\t$s1\n$totv/$totl:\t$q\n";
}
sub space {
$_[0] &&= sprintf("%-*s", $max+1, $_[0]);
}
sub count {
my $s = shift;
my $vowels = $s =~ y/aeiouyAEIOUY//;
my $letters = $s =~ y/A-Za-z0-9//;
return ($vowels, $letters);
}
|