Just a tiebreak change. What sort of silly programming language accepts $" as a valid variable name anyway? :)
#!perl -lp
$"='\w+';s/b/1e9/;s/m/1e6/;s/il$"//g;s/tho$"/1e3/;s/(($" hu$" )?$"( $")?) (1e.)/($1)*$4+/g;s/hu$"/*100/g;s/ty/*10/g;s/tee?n/+10/;s/twel$"/+12/g;s/tw$"/+2/g;s/el$"/+11/;s/ni$"/+9/g;s/ei$"/+8/;s/six/+6/g;s/s$"/+7/;s/fi$"/+5/g;s/f$"/+4/g;s/th$"/+3/g;s/one/+1/g;s/(z.+|\+)$/+0/;$_=eval;1while
s/^(\d+)(\d{3})/$1,$2/
|
Lunchtime inspiration strikes and I manage to get rid of a few more strokes with some variable substitution, and the elimination of a spurious pair of parentheses.
300 isn't far now. Keep it up!
#!perl -lp
$a='\w+';s/b/1e9/;s/m/1e6/;s/il$a//g;s/tho$a/1e3/;s/(($a hu$a )?$a( $a)?) (1e.)/($1)*$4+/g;s/hu$a/*100/g;s/ty/*10/g;s/tee?n/+10/;s/twel$a/+12/g;s/tw$a/+2/g;s/el$a/+11/;s/ni$a/+9/g;s/ei$a/+8/;s/six/+6/g;s/s$a/+7/;s/fi$a/+5/g;s/f$a/+4/g;s/th$a/+3/g;s/one/+1/g;s/(z.+|\+)$/+0/;$_=eval;1while
s/^(\d+)(\d{3})/$1,$2/
|
Discovered the -p switch! Quite like this solution, with the exception of the single 'eval' statement the program now consists entirely of s/// regular expressions.
-p is good
#!perl -lp
s/b/1e9/;s/m/1e6/;s/il\w+//g;s/tho\w+/1e3/;s/((\w+ hu\w+ )?\w+( \w+)?) (1e.)/(($1)*$4)+/g;s/hu\w+/*100/g;s/ty/*10/g;s/tee?n/+10/;s/twelve/+12/g;s/tw\w+/+2/g;s/el\w+/+11/;s/nine/+9/g;s/ei\w+/+8/;s/six/+6/g;s/s\w+/+7/;s/fi\w+/+5/g;s/f\w+/+4/g;s/th\w+/+3/g;s/one/+1/g;s/(z.+|\+)$/+0/;$_=eval;1while
s/^(\d+)(\d{3})/$1,$2/
|
Shaving off strokes here & there ... the order of the s/// expressions is important, now.
#!perl -ln
s/b/1e9/;s/m/1e6/;s/il\w+//g;s/tho\w+/1e3/;
s/((\w+ hu\w+ )?\w+( \w+)?) (1e.)/(($1)*$4)+/g;
s/hu\w+/*100/g;
s/ty/*10/g;
s/teen/+10/;
s/twelve/+12/g;
s/tw\w+/+2/g;
s/el\w+/+11/;
s/ten/+10/;
s/nine/+9/g;
s/ei\w+/+8/;
s/six/+6/g;
s/s\w+/+7/;
s/fi\w+/+5/g;
s/f\w+/+4/g;
s/th\w+/+3/g;
s/one/+1/g;
s/(z.+|\+)$/+0/;
$_=eval;1while s/^(\d+)(\d{3})/$1,$2/;print
|
Now we're getting somewhere ... :)
#!perl -ln
s/billion/1e9/;s/million/1e6/;s/thousand/1e3/;
s/((\w+ hundred )?\w+( \w+)?) (1e.)/(($1)*$4)+/g;
s/hundred/*100/g;
s/ty/*10/g;
s/teen/+10/;
s/twelve/+12/g;
s/eleven/+11/;
s/ten/+10/;
s/nine/+9/g;
s/eight?/+8/;
s/seven/+7/;
s/six/+6/g;
s/fi(ve|f)/+5/g;
s/fou?r/+4/g;
s/th(ree|ir)/+3/g;
s/tw(o|en)/+2/g;
s/one/+1/g;
s/(zero|\+)$/+0/;
$_=eval;1while s/^(\d+)(\d{3})/$1,$2/;print
|
New algorithm (look ma! it's all done with regexes!), already started reducing it but we'll see how better I can get it.
#!perl -ln
s/((\w+ hundred )?\w+( \w+)?) billion/(($1)*1e9)+/;
s/((\w+ hundred )?\w+( \w+)?) million/(($1)*1e6)+/;
s/((\w+ hundred )?\w+( \w+)?) thousand/(($1)*1e3)+/;
s/hundred/*100/g;
s/ty/*10/g;
s/teen/+10/;
s/twelve/+12/g;
s/eleven/+11/;
s/ten/+10/;
s/nine/+9/g;
s/eight?/+8/;
s/seven/+7/;
s/six/+6/g;
s/fi(ve|f)/+5/g;
s/fou?r/+4/g;
s/th(ree|ir)/+3/g;
s/tw(o|en)/+2/g;
s/one/+1/g;
s/(zero|\+)$/+0/;
$_=eval;1while s/^(\d+)(\d{3})/$1,$2/;print
|
Hmm, shaving off the odd stroke here & there, but that's all. Need a new algorithm if I'm going to halve my score (or better).
#!perl -ln
map{$n{$_}=++$i}one,two,three,four,five,six,seven,eight,nine,ten,eleven,twelve;
$i=2;map{$n{$_.ty}=10*$i;$n{$_.teen}=10+$i++}twen,thir,'for',fif,six,seven,eigh,nine;
$n{fourteen}=14;print(0),exit
if/z/;$a=1e9*p($1)if s/^(.*) b/A/;$a+=1e6*p($1)if s/^(.*)m/A/;
$a+=1e3*p($1)if s/^(.*) tho/A/;$a+=100*p($1)if s/^(.*)hu/A/;
$a+=p($_);1while$a=~s/^(\d+)(\d{3})/$1,$2/;print$a;sub
p{my$n=shift;my$t=0;$n=~s/A\S+//;return 0if!$n;
$n=~s/^ *//;return$n{$n}if$n{$n};$n=~s/^(.*)hundred//;$t+=100*p($1);
if($n){$n=~/ ?(\S+)( (\S+))?/;$t+=p($1)+p($3)}$t}
|
Managed to cut down regexes quite a bit, also found a shorter "printing numbers with commas" algorithm (thanks, Google!) *phew* perhaps I'll give it a rest for today now. Perhaps ... :)
#!perl -ln
$n{$_}=++$i for one,two,three,four,five,six,seven,eight,nine,ten,eleven,twelve;
$i=3;for(thir,'for',fif,six,seven,eigh,nine){$n{$_.ty}=10*$i;$n{$_.teen}=10+$i++}
@n{fourteen,twenty}=(14,20);print(0),exit if/z/;
$a=1e9*p($1)if s/^(.*) b/A/;$a+=1e6*p($1)if s/^(.*)m/A/;
$a+=1e3*p($1)if s/^(.*) tho/A/;$a+=100*p($1)if s/^(.*)hu/A/;
$a+=p($_);1while$a=~s/^(\d+)(\d{3})/$1,$2/;print$a;
sub p{my$n=shift;my$t=0;$n=~s/A\S+//;return 0if!$n;
$n=~s/^ *//;return$n{$n}if$n{$n};$n=~s/^(.*)hundred//;$t+=100*p($1);
if($n){$n=~/ ?(\S+)( (\S+))?/;$t+=p($1)+p($3)}$t}
|
Hmmm down to around 600-ish after realising I had an extraneous loop in the code (and some other small optimisations). Looking for a way to avoid having to code for the special cases on line 5.
catching Ross
#!perl -l
$_=<>;
$n{$_}=++$i for one,two,three,four,five,six,seven,eight,nine,ten,eleven,twelve;
$i=3;for(thir,'for',fif,six,seven,eigh,nine){$n{$_.ty}=10*$i;$n{$_.teen}=10+$i++}
@n{fourteen,twenty}=(14,20);print(0),exit if/z/;
$a=1e9*p($1)if s/^(.*) billion//;$a+=1e6*p($1)if s/^(.*)million//;
$a+=1e3*p($1)if s/^(.*) thousand//;$a+=100*p($1)if s/^(.*)hundred//;
$a+=p($_);$a=~s/(^\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g;print$a;
sub p{my$n=shift;my$t=0;return 0if!$n;
$n=~s/^\s*//;return$n{$n}if$n{$n};$n=~s/^(.*)hundred//;$t+=100*p($1);
return$t if!$n;$n=~/\s?(\S+)(\s(\S+))?/;$t+=p($1)+p($3);$t}
|
Slowly reducing the size, still got lots of work to do though!
#!perl -l
$_=<>;chomp;
$n{$_}=++$i for(one,two,three,four,five,six,seven,eight,nine,ten,eleven,twelve);
$i=3;for(thir,'for',fif,six,seven,eigh,nine){$n{$_.'ty'}=10*$i;$n{$_.'teen'}=10+$i++}
@n{fourteen,twenty}=(14,20);if(/zero/){print"0";exit}D:{
if(s/^(.*) billion//){$a=1e9*p($1);last D if!$_}if(s/^(.*) million//){$a+=1e6*p($1);last D if!$_}
if(s/^(.*) thousand//){$a+=1e3*p($1);last D if!$_}if(s/^(.*) hundred//){$a+=100*p($1)}
$a+=p($_)}$a=~s/(^\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g;
print"$a";sub p{my$n=shift;my$t=0;return 0if!$n;
$n=~s/^\s*//;return$n{$n}if$n{$n};$n=~s/^(.*) hundred//;$t+=100*p($1);
return$t if!$n;$n=~/\s?(\S+)(\s(\S+))?/;$t+=p($1)+p($3);return$t;}
|
Got rid of most of extraneous spaces etc. Can't get much smaller than this ... need new algorithm :)
#!perl
$_=<>;chomp;
%n=(one,1,two,2,three,3,four,4,five,5,six,6,seven,7,eight,8,nine,9,ten,10,eleven,11,twelve,12,thirteen,13,fourteen,14,fifteen,15,sixteen,16,seventeen,17,eighteen,18,nineteen,19,twenty,20,thirty,30,forty,40,fifty,50,sixty,60,seventy,70,eighty,80,ninety,90);
if(/zero/){print"0\n";exit}D:{
if(s/^(.*) billion//){$a=1e9*p($1);last D unless$_}if(s/^(.*) million//){$a+=1e6*p($1);last D unless$_}
if(s/^(.*) thousand//){$a+=1e3*p($1);last D unless$_}if(s/^(.*) hundred//){$a+=100*p($1)}
$a+=p($_)}$a=~s/(^\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g;
print"$a\n";
sub p{my$n=shift;my$t=0;return 0 unless$n;
$n=~s/^\s*//;return$n{$n}if$n{$n};$n=~s/^(.*) hundred//;$t+=100*p($1);
return$t unless$n;$n=~/\s?(\S+)(?:\s(\S+))?/;$t+=p($1)+p($2);return$t;}
|
first try (ever!), full of debugging crap and spaces and long varnames & all sorts. time to start playing...
good to see new faces
#!perl
$_ = <>; chomp;
$debug = 0;
%num=(one,1,two,2,three,3,four,4,five,5,six,6,seven,7,eight,8,nine,9,ten,10,eleven,11,twelve,12,thirteen,13,
fourteen,14,fifteen,15,sixteen,16,seventeen,17,eighteen,18,nineteen,19,
twenty,20,thirty,30,forty,40,fifty,50,sixty,60,seventy,70,eighty,80,ninety,90);
if(/zero/){print"0\n";exit}
DECODE:{
if (s/^(.*) billion//){
print "$1 is billion part, string left is $_\n"if$debug;
$total = 1000000000 * procIt($1);last DECODE unless$_;
print "running total is $total\n"if$debug;
}
if(s/^(.*) million//){
print "$1 is million part, string left is $_\n"if$debug;
$total += 1000000 * procIt($1); last DECODE unless$_;
print "running total is $total\n"if$debug;
}
if(s/^(.*) thousand//){
print "$1 is thousand part, string left is $_\n"if$debug;
$total += 1000 * procIt($1); last DECODE unless$_;
print "running total is $total\n"if$debug;
}
if(s/^(.*) hundred//){
print "$1 is hundred part, string left is $_\n"if$debug;
$total +=100 * procIt($1);
print "running total is $total\n"if$debug;
}
print "$_ is the rest\n"if$debug;
$total +=procIt($_);
print "running total is $total\n"if$debug;
}
print "\n\n"if$debug;
$total=~s/(^\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g;
print "$total\n";
sub procIt() {
my$n=shift;my$t=0;
return 0 unless $n;
$n=~s/^\s*//;
print " converted $n into $num{$n}\n"if$debug&&$num{$n};
return $num{$n} if $num{$n};
print "received $n\n"if$debug;
$n=~s/^(.*) hundred//;
print " hundred part is $1\n"if$debug;
$t+=100*procIt($1);
print " running subtotal is $t\n"if$debug;
print " remainder is :$n:\n"if$debug;
return $t unless$n;
$n=~/\s?(\S+)(?:\s(\S+))?/;
print " broke remainder into $1 and $2\n"if$debug;
$t+=procIt($1)+procIt($2);
return $t;
}
__END__
$debug =1;
%num=(one,1,two,2,three,3,four,4,five,5,six,6,seven,7,eight,8,nine,9,ten,10,eleven,11,twelve,12,thirteen,13,
fourteen,14,fifteen,15,sixteen,16,seventeen,17,eighteen,18,nineteen,19,
twenty,20,thirty,30,forty,40,fifty,50,sixty,60,seventy,70,eighty,80,ninety,90);
%mult=(hundred,100,thousand,1000,million,1000000,billion,1000000000);
$total =0;
$prev=0;
$prev_was_mult=0;
for(split/ /,<>){ chomp;$n = $_;
print "Processing $n:\n"if$debug;
if ($mult{$n}) {
print " Found a multiplier term $n\n"if$debug;
$total-=$prev;
print " Deducted erroneous prev val $prev\n"if$debug;
if ($prev_was_mult) {
} else{
$total+=$prev unless$prev_was_mult;
}
$total+=($mult{$n} * $prev);
print " Added multiplier $mult{$n} * prev val $prev\n"if$debug;
print " Storing new prev val $mult{$n} * $prev\n"if$debug;
$prev = $mult{$n} * $prev;
$prev_was_mult=1;
}
else
{
print " Found a standard term $n\n"if $debug;
$total+=$prev unless $prev_was_mult;
print " Added prev val $prev\n"if$debug&&!$prev_was_mult;
$prev = $num{$n};
$prev_was_mult=0;
print " Storing new prev val $num{$n}\n"if$debug;
}
print " Current running total is $total\n"if$debug;
}
$total+=$prev unless $prev_was_mult;
print "\n\n"if$debug;
#push @foo,$1 while $total =~ /(\d{3})/g;
#$total =~ /\G(\d*)/; $i = $1; print "left off = $i\n";push @foo,$i;
#$newtotal = join'',@foo;
$total=~s/(^\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g;
print "$total\n";
|