Shrink the first loop by one, and the ?: construct goes away, improving 10 scores and one decile. I still need to merge the two construction loops into one, but I'm having trouble getting my mind around it.
#!perl
sub d{$_=lc join'',@_;$p=y/a-z0-9/a-z0-9/;$q=y/aeiouy//;return"$q/$p"}undef$/;for(<>=~/([^.]*\.)/g){$j=d@x=split;$b=$c=$w=$t="";$s=$x[0];map{$s.=' 'x(3-length$x[$_-1]).' '.$x[$_]}1..$#x;length$s>60?substr($s,57)='.'x3:1;while($c<60&&$b<@x){$z=d$x[$b];$f=length$x[$b++];if(substr($s,$c,1)ne'.'){$t.=$w.$z;$c+=$f=++$f<4?4:$f;$w=' 'x($f-length$z)}}print$#x+1,": $s
$j: $t
"}
|
347 looks a long way away right now, but "I think I can, I think I can..." I shaved some strokes turning another if into a ?:1... I wish I could leave that second value a null...
#!perl
sub d{$_=lc join'',@_;$p=y/a-z0-9/a-z0-9/;$q=y/aeiouy//;return"$q/$p"}undef$/;for(<>=~/([^.]*\.)/g){$j=d@x=split;$b=$c=$w=$t="";$s=$x[0];map{$x[$_+1]?$s.=' 'x(3-length$x[$_]).' '.$x[$_+1]:1}0..@x;length$s>60?substr($s,57)='.'x3:1;while($c<60&&$b<@x){$z=d$x[$b];$f=length$x[$b++];if(substr($s,$c,1)ne'.'){$t.=$w.$z;$c+=$f=++$f<4?4:$f;$w=' 'x($f-length$z)}}print$#x+1,": $s
$j: $t
"}
|
A bunch of little tweaks this morning. My lvalue question on perl-beginners that was asked just for understanding, gave me the final tweak to the substr that put me two rungs up the ladder.
#!perl
sub d{$_=lc join'',@_;$p=y/a-z0-9/a-z0-9/;$q=y/aeiouy//;return"$q/$p"}undef$/;for(<>=~/([^.]*\.)/g){$j=d@x=split;$b=$c=$w=$t="";$s=$x[0];map{$x[$_+1]?$s.=' 'x(3-length$x[$_]).' '.$x[$_+1]:1}0..@x;if(length$s>60){substr($s,57)='.'x3;}while($c<60&&$b<@x){$z=d$x[$b];$f=length$x[$b++];if(substr($s,$c,1)ne'.'){$t.=$w.$z;$c+=$f=++$f<4?4:$f;$w=' 'x($f-length$z)}}print$#x+1,": $s
$j: $t
"}
|
As I was getting ready to shut the computer down, I came across a perldoc window, and one thing led to another, and I found that if I moved the sub to the beginning, I could shave my score under 400... now to aim for 387, the next rung on the ladder... I have some ideas already...
#!perl -l
sub d{$_=lc join'',@_;$p=y/a-z0-9/a-z0-9/;$q=y/aeiouy//;return"$q/$p"}undef$/;for(<>=~/([^.]*?\.)/g){@x=split;$c=$w=$t="";$s=$x[$b=0];map{$x[$b+1]?$s.=' 'x(3-length$x[$b]).' '.$x[++$b]:d}0..@x;if(length$s>60){substr($s,57,999,'.'x3);}$b=0;while($c<60&&$b<@x){$z=d$x[$b];$f=length$x[$b++];if(substr($s,$c,1)ne'.'){$t.=$w.$z;$c+=$f=++$f<4?4:$f;$w=' 'x($f-length$z)}}print$#x+1,": $s
",d(@x),": $t"}
|
I got up, had a drink of water, scratched down my idea on a post-it note so I'd remember this morning, but 30 minutes later, my stomach was growling and I still didn't know how the ballgame had turned out so I got myself a bowl of cereal, turned on the tube, and went ahead and typed up my prior improvement, then I still had cereal and didn't know the score so I golfed some more and worked down to this, which I saved off as a good checkpoint before I tried more radical surgery. This is where I'd finally gotten the two print statements combined into one.
#!perl -l
undef$/;for(<>=~/([^.]*?\.)/g){@x=split;$w="";$s=$x[$b=0];$t=d(@x).": ";map{$x[$b+1]?$s.=' 'x(3-length$x[$b]).' '.$x[++$b]:d}0..@x;if(length$s>60){substr($s,57,200,'.'x3);}$b=$c=0;while($c<60&&$b<@x){$z=d($x[$b]);$f=length$x[$b++];if(substr($s,$c,1)ne'.'){$t.=$w.$z;$c+=$f=++$f<4?4:$f;$w=' 'x($f-length$z)}}print$#x+1 .": $s
$t"}sub d{$_=lc join'',@_;$p=y/a-z0-9/a-z0-9/;$q=y/aeiouy//;return"$q/$p"}
|
I was trying to get to sleep last night (I swear it was too much caffeine in Reno, not this golfing), and thought of an improvement... I could eliminate that funky regex in the <> slurp by just accepting everything but a . until the period, and then I realized that I could just loop on the slurp's regex instead of storing to an array...
#!perl
undef$/;for(<>=~/([^.]*?\.)/g){@x=split;$w="";$s=$x[$b=0];map{$x[$b+1]?$s.=' 'x(3-length$x[$b]).' '.$x[++$b]:t}0..@x;if(length$s>60){$s=substr($s,0,57).'...'}print$#x+1 .": $s\n";$b=$c=0;$z=t(@x);print"$z: ";while($c<60&&$b<@x){$z=t($x[$b]);$f=length$x[$b++];if(substr($s,$c,1)ne'.'){print$w.$z;$c+=$f=++$f<4?4:$f;$w=' 'x($f-length$z)}}print"
"}sub t{$_=lc join'',@_;$p=y/a-z0-9/a-z0-9/;$q=y/aeiouy//;return"$q/$p"}
|
Here's my first submission this morning. This is what I was able to accomplish on the plane coming home yesterday. I was able to combine statements in a couple of places, still nothing fancy.
#!perl
undef$/;@d=(<>=~/([-a-zA-Z0-9.,;:'"()&\/
]*?\.)/g);for(@d){@x=split;$w="";$s=$x[$b=0];map{$x[$b+1]?$s.=' 'x(3-length$x[$b]).' '.$x[++$b]:t}0..@x;if(length$s>60){$s=substr($s,0,57).'...'}print$#x+1 .": $s\n";$b=$c=0;$z=t(@x);print"$z: ";while($c<60&&$b<@x){$z=t($x[$b]);$f=length$x[$b++];if(substr($s,$c,1)ne'.'){print$w.$z;$c+=$f=++$f<4?4:$f;$w=' 'x($f-length$z)}}print"
"}sub t{$_=lc join'',@_;$p=y/a-z0-9/a-z0-9/;$q=y/aeiouy//;return"$q/$p"}
|
A few more strokes before I have to leave for the airport. I'll probably golf some on the plane this evening.
#!perl
undef$/;@d=(<>=~/([-a-zA-Z0-9.,;:'"()&\/
]*?\.)/g);for(@d){@x=split;$w="";$s=$x[$b=0];map{if($x[$b+1]){$s.=' 'x(3-length$x[$b]);$s.=' '.$x[++$b]}}0..$#x+1;if(length$s>60){$s=substr($s,0,57).'...'}print$#x+1 .": $s\n";$b=$c=0;$z=t(@x);print"$z: ";$z="";while($c<60&&$b<=$#x){$z=t($x[$b]);$f=length$x[$b++];if(substr($s,$c,1)ne'.'){print$w.$z;$c+=$f=++$f<4?4:$f;$w=' 'x($f-length$z)}}print"
"}sub t{$_=lc join'',@_;$p=y/a-z0-9/a-z0-9/;$q=y/aeiouy//;return"$q/$p"}
|
eliminated 3 strokes by deleting the 4 parens in my lc/join statement in the sub, pulling myself out of last place...
#!perl
undef$/;@d=(<>=~/([-a-zA-Z0-9.,;:'"()&\/
]*?\.)/g);foreach(@d){@x=split;$w="";for($s=$x[$b=0];$b<$#x;){if($x[$b+1]){$s.=' 'x(3-length$x[$b]);$s.=' '.$x[++$b]}}if(length$s>60){$s=substr($s,0,57).'...'}print$#x+1 .": $s\n";$b=$c=0;$z=t(@x);print"$z: ";$z="";while($c<60&&$b<=$#x){$z=t($x[$b]);$f=length$x[$b++];if(substr($s,$c,1)ne'.'){print$w.$z;$c+=$f=++$f<4?4:$f;$w=' 'x($f-length$z)}}print"
"}sub t{$_=lc join'',@_;$p=y/a-z0-9/a-z0-9/;$q=y/aeiouy//;return"$q/$p"}
|
Finally figured out how to eliminate my $c+=$f, piddly stuff for a y-index of 33, but my current goal is to crawl out of last place in the beginners.
#!perl
undef$/;@d=(<>=~/([-a-zA-Z0-9.,;:'"()&\/
]*?\.)/g);foreach(@d){@x=split;$w="";for($s=$x[$b=0];$b<$#x;){if($x[$b+1]){$s.=' 'x(3-length$x[$b]);$s.=' '.$x[++$b]}}if(length$s>60){$s=substr($s,0,57).'...'}print$#x+1 .": $s\n";$b=$c=0;$z=t(@x);print"$z: ";$z="";while($c<60&&$b<=$#x){$z=t($x[$b]);$f=length$x[$b++];if(substr($s,$c,1)ne'.'){print$w.$z;$c+=$f=++$f<4?4:$f;$w=' 'x($f-length$z)}}print"
"}sub t{$_=lc(join('',@_));$p=y/a-z0-9/a-z0-9/;$q=y/aeiouy//;return"$q/$p"}
|
$str -> $s sub sb -> sub t I hate that ugly -a-zA-Z1-9... regex, but .* doesn't work with the stupid paren/" test script.
#!perl
undef$/;@d=(<>=~/([-a-zA-Z0-9.,;:'"()&\/
]*?\.)/gm);foreach(@d){@x=split;$w="";for($s=$x[$b=0];$b<$#x;){if($x[$b+1]){$s.=' 'x(3-length$x[$b]);$s.=' '.$x[++$b]}}if(length$s>60){$s=substr($s,0,57).'...'}print$#x+1 .": $s\n";$b=$c=0;$z=t(@x);print"$z: ";$z="";while($c<60&&$b<=$#x){$z=t($x[$b]);$f=length$x[$b++];if(substr($s,$c,1)!~/\./){print$w.$z;$f=++$f<4?4:$f;$c+=$f;$f-=length$z;$w=' 'x$f}}print"
"}sub t{$_=lc(join('',@_));$p=y/a-z0-9/a-z0-9/;$q=y/aeiouy//;return"$q/$p"}
|
977->497 isn't quite half, but compared to my early 1000+, I've cut out half my code without changing anything except deleting comments, whitespace, and parens. There probably are still extras, but I want to get this in before I start playing with combining statements.
#!perl
undef$/;@d=(<>=~/([-a-zA-Z1-90.,;:'"()&\/
]*?\.)/gm);foreach(@d){@x=split;$w="";for($str=$x[$b=0];$b<$#x;){if($x[$b+1]){$str.=' 'x(3-length$x[$b]);$str.=' '.$x[++$b]}}if(length$str>60){$str=substr($str,0,57).'...'}print$#x+1 .": $str\n";$b=$c=0;$z=sb(@x);print"$z: ";$z="";while($c<60&&$b<=$#x){$z=sb($x[$b]);$f=length$x[$b++];if(substr($str,$c,1)!~/\./){print$w.$z;$f=++$f<4?4:$f;$c+=$f;$f-=length$z;$w=' 'x$f}}print"
"}sub sb{$_=lc(join('',@_));$p=y/a-z0-9/a-z0-9/;$q=y/aeiouy//;return"$q/$p"}
|
I stayed at work on Friday long enough to pull down the problem, then headed home and wrote this without a computer around. I typed it in and debugged it today, but it doesn't seem to see the EOF on my machine, but I'm submitting anyway.
#!perl $/="."; while( |
Argh! Found the trick in the postmortem from the anagrams competition, and so it now works for some input, but not for all, and I don't understand this new construct or why it doesn't work, and I'm feeling very frustrated. :(
#!perl
$/=".";
while(){
@x=split;
if(length(@x)){
for($str = $x[$b=0];$b<$#x;){
if ($x[$b+1]){
$str.=' 'x (3-length($x[$b]));
$str.=' '.$x[++$b]
}}if(length($str)>60){
$str=substr($str,0,57).'...'
}print $#x+1 .": $str\n";
$b=$c=0;$z=sb(@x);
print "$z: ";$z="";
while($c<60&&$b<=$#x){
$z=sb($x[$b]);
$f=length($x[$b++]);
$f=++$f<4?4:$f;$c+=$f;
$f-=length($z);
$z.=' 'x$f;
print substr($z,0,60)}
print "\n"}}
sub sb{
$_=lc(join(' ',@_));
$p=y/a-z/a-z/;
$q=y/aeiouy//;
return"$q/$p"
}
|
This won't get me out of the sandtrap, but I wanted to let the judges and everyone in the postmortem know that I'm still pounding away and making progress. I figure that this competition, even the last place beginner may finish in the money. I spent my hour on the plane this morning working through multiple bugs. I should be able to cut my score significantly by removing spaces and comments if I get it working.
#!perl
undef $/;
#while ($in =~ /(.*?\.)(.*)/m) {
#$_=$1;$in=$2;
#print "new in: $in\n";
@d=(<>=~/(.*?\.)/gm);
foreach(@d){
@x=split;
if(length(@x)){
for($str = $x[$b=0];$b<$#x;){
if ($x[$b+1]){
$str.=' 'x (3-length($x[$b]));
$str.=' '.$x[++$b]
}}if(length($str)>60){
$str=substr($str,0,57).'...'
}print $#x+1 .": $str\n";
$b=$c=0;$z=sb(@x);
print "$z: ";$z="";
while($c<60&&$b<=$#x){
$z=sb($x[$b]);
$f=length($x[$b++]);
if ($c+$f<=60) {
$f=++$f<4?4:$f;$c+=$f;
$f-=length($z);
# 57 doesn't space on tpr04c.pl where it should, 58 does where it shouldn't... have to put the spaces in later somehow, yeuch!
if ($c<57&&$b<=$#x) {
$z.=' 'x$f}
print $z}}
print "\"\n"}}
sub sb{
$_=lc(join(' ',@_));
$p=y/a-z/a-z/;
$q=y/aeiouy//;
return"$q/$p"
}
|
I wish I had a diff on this machine. I hadn't understood that digits counted as letters in the "v/l" constructs. This code passes the test script, if it passes the judges, I'll quickly strip off some of the 977 characters (spaces, comments, etc.), and then I get to start actually golfing!
#!perl
undef $/;
#$_=$1;$in=$2;
#print "new in: $in\n";
#$_=<>;
#print;
#print "\n";
#s/\"/\\\"/g;
#print;
#print "\n";
@d=(<>=~/([-a-zA-Z1-90.,;:'"()&\/
]*?\.)/gm);
#for($i=0;$i<=$#d;$i++){print"d$i: $d[$i]\n"}
foreach(@d){
@x=split;
$w="";
#for($i=0;$i<=$#x;$i++){print"x$i: $x[$i]\n"}
#do i need this if anymore?
for($str = $x[$b=0];$b<$#x;){
if ($x[$b+1]){
$str.=' 'x (3-length($x[$b]));
$str.=' '.$x[++$b]
}}if(length($str)>60){
$str=substr($str,0,57).'...'
}print $#x+1 .": $str\n";
$b=$c=0;$z=sb(@x);
print "$z: ";$z="";
while($c<60&&$b<=$#x){
$z=sb($x[$b]);
$f=length($x[$b++]);
if (substr($str,$c,1)!~/\./) {
print $w.$z;
$f=++$f<4?4:$f;$c+=$f;
$f-=length($z);
$w=' 'x$f}
## elsif ($c<60) {
# print $w.substr($str,$c,1)}
}
print "\n"}
sub sb{
$_=lc(join(' ',@_));
$p=y/a-z0-9/a-z0-9/;
$q=y/aeiouy//;
return"$q/$p"
}
|
Another day of work delays in Reno *scowl*, more time for golf *grin*. I don't understand what the difference between expected output and my output on the "Mind the gap; (59-61)" testcase, if the judges could explain, I'd appreciate it.
#!perl
undef $/;
#$_=$1;$in=$2;
#print "new in: $in\n";
#$_=<>;
#print;
#print "\n";
#s/\"/\\\"/g;
#print;
#print "\n";
@d=(<>=~/([-a-zA-Z1-90.,;:'"()&\/
]*?\.)/gm);
#for($i=0;$i<=$#d;$i++){print"d$i: $d[$i]\n"}
foreach(@d){
@x=split;
$w="";
#for($i=0;$i<=$#x;$i++){print"x$i: $x[$i]\n"}
#do i need this if anymore?
if(length(@x)){
for($str = $x[$b=0];$b<$#x;){
if ($x[$b+1]){
$str.=' 'x (3-length($x[$b]));
$str.=' '.$x[++$b]
}}if(length($str)>60){
$str=substr($str,0,57).'...'
}print $#x+1 .": $str\n";
$b=$c=0;$z=sb(@x);
print "$z: ";$z="";
while($c<60&&$b<=$#x){
# if ($c<60&&$b<=$#x) {print $w.$z}
$z=sb($x[$b]);
$f=length($x[$b++]);
if ($c+$f<=60) {
print $w.$z;
$f=++$f<4?4:$f;$c+=$f;
$f-=length($z);
$w=' 'x$f}
}
print "\n"}}
sub sb{
$_=lc(join(' ',@_));
$p=y/a-z/a-z/;
$q=y/aeiouy//;
return"$q/$p"
}
|