Almost missed the super obvious transformation from $^F to 2
#!perl -lpa /[a-dm]/?$;=3*$+[amb!~$&]||$;+2:($,+=/te|l/.$+[/../,ontwthfofisiseeini!~$&]/2+/le/.$?x(/y/+$;))while$_=pop@F;$_=$,;s/\B(?=(...)+$)/,/g |
Shortening the 'zeon' string even more.
#!perl -lpa /[a-dm]/?$;=3*$+[amb!~$&]||$;+2:($,+=/te|l/.$+[/../,ontwthfofisiseeini!~$&]/$+/le/.$?x(/y/+$;))while$_=pop@F;$_=$,;s/\B(?=(...)+$)/,/g |
A couple more strokes by ditching \d{3} in favor of ...
#!perl -lpa /[a-dm]/?$;=3*$+[amb!~$&]||$;+2:($,+=/.te|lv/.$+[/../,ontwthfofisiseeiniteel!~$&]/$.$?x(/y/+$;))while$_=pop@F;$_=$,;s/\B(?=(...)+$)/,/g |
Another tiebreak improvement. That last substitution looks like it should be able to be reduced somehow...
#!perl -lpa
/[a-dm]/?$;=3*$+[amb!~$&]||$;+2:($,+=/.te|lv/.$+[/../,ontwthfofisiseeiniteel!~$&]/$.$?x(/y/+$;))while$_=pop@F;$_=$,;s/\B(?=(\d{3})+$)/,/g
|
I've been thinking too iteratively. Thinking more recursively yields four strokes.
#!perl -pa /[a-dm]/?$;=3*$+[amb!~$&]||$;+2:($\+=/.te|lv/.$+[/../,ontwthfofisiseeiniteel!~$&]/$.$?x(/y/+$;))while$_=pop@F;s/\B..\d\b/,$&/for($\.=$/)x$ |
The latest in a series of infinitessimal improvements. Sorry, refs! :-)
see comment for previous solution :)
#!perl -pa /[a-dm]/?$;=amb=~$&?3*$+[0]:$;+2:($\+=/.te|lv/.(/../,ontwthfofisiseeiniteel=~$&*$+[0]/2).$?x(/y/+$;))while$_=pop@F;s/\B..\d\b/,$&/for($\.=$/)x$ |
One more stroke gone, and -finally- the 'zeon' string is a little bit shorter.
you are allowed to leave more time for improvements between submissions you know :)
#!perl -pa /[a-dm]/?$;=amb=~$&?3*$+[0]:$;+2:($\+=/.te|lv/.(/../,ontwthfofisiseeiniteel=~$&&&$+[0]/2).$?x(/y/+$;))while$_=pop@F;s/\B..\d\b/,$&/for($\.=$/)x$ |
Another stroke shaved, yay!
#!perl -pa /[a-dm]/?$;=amb=~$&?3*$+[0]:$;+2:($\+=/.te|lv/.(/../,zeontwthfofisiseeiniteel=~$&,$-[0]/2).$?x(/y/+$;))while$_=pop@F;s/\B..\d\b/,$&/for($\.=$/)x$ |
Finally, an actual stroke shaved!
#!perl -pa /[a-dm]/?$;=-amb=~$&?3*$-[0]:$;+2:($\+=/.te|lv/.(/../,zeontwthfofisiseeiniteel=~$&,$-[0]/2).$?x(/y/+$;))while$_=pop@F;s/\B..\d\b/,$&/for($\.=$/)x$ |
And another tiebreak improvement. I only wish these were whole strokes instead of partial strokes.
#!perl -pa /[a-dm]/?$;=-amb=~$&*3*$-[0]||$;+2:($\+=/.te|lv/.(/../,zeontwthfofisiseeiniteel=~$&,$-[0]/2).$?x(/y/+$;))while$_=pop@F;s/\B..\d\b/,$&/for($\.=$/)x$ |
Yet Another Tiebreak Improvement.
#!perl -pa /[a-dm]/?$;=damb=~$&*3*$-[0]||$;+2:($\+=/.te|lv/.(/../,zeontwthfofisiseeiniteel=~$&,$-[0]/2).$?x(/y/+$;))while$_=pop@F;s/\B..\d\b/,$&/for($\.=$/)x$ |
I still hate tweaking the tiebreaker, but that seems to be all I'm able to do tonight...
#!perl -pa /[a-dm]/?$;=3*index(damb,$&)||$;+2:($\+=/.te|lv/.(/../,zeontwthfofisiseeiniteel=~$&,$-[0]/2).$?x(/y/+$;))while$_=pop@F;s/\B..\d\b/,$&/for($\.=$/)x$ |
Man, I hate just tweaking the tiebreaker.
#!perl -pa /[a-dm]/?$;=3*index(damb,$&)||$;+2:($\+=/.te|lv/.index(zeontwthfofisiseeiniteel,/../&&$&)/$.$?x(/y/+$;))while$_=pop@F;s/\B..\d\b/,$&/for($\.=$/)x$ |
Ever so slight tiebreaker improvement.
#!perl -pa /[damb]/?$;=3*index(damb,$&)||$;+2:($\+=/.te|lv/.index(zeontwthfofisiseeiniteel,/../&&$&)/2 .$?x(/y/+$;))while$_=pop@F;s/\B..\d\b/,$&/for($\.=$/)x3 |
Been stuck here for a while, hoping for another breakthrough...
#!perl -lpa /[damb]/?$;=3*index(damb,$&)||$;+2:($,+=/.te|lv/.index(zeontwthfofisiseeiniteel,/../&&$&)/2 .$?x(/y/+$;))while$_=pop@F;s/\B..\d\b/,$&/for($_=$,)x3 |
A few more improvements, and that weird for(...)x$n construction that I first saw in Cantor and somehow managed to remember just now.
#!perl -lpa /[damb]/?$;=3*index(damb,$&)||$;+2:(/../,$,+=index(zeontwthfofisiseeiniteel,$&)/2+10*/.te|lv/.$?x(/y/+$;))while$_=pop@F;s/\B..\d\b/,$&/for($_=$,)x3 |
Oh yeah, 'd' occurs in 'hundred' before it occurs in 'thousand'.
#!perl -lpa
/[damb]/?$s=3*index(damb,$&)||$s+2:(/../,$t+=index(zeontwthfofisiseeiniteel,$&)/2+10*/tee|lv/.0 x(/y/+$s))while$_=pop@F;$_=$t;1until!s/\d+(?=\d{3})/$&,/
|
-a and @F is one of those obvious impovements I was talking about.
#!perl -lpa
/^h|[mba]/?$s=3*index(hamb,$&)||$s+2:(s/..//,$t+=index(zeontwthfofisiseeiniteel,$&)/2+10*/te|lv/.0 x(/y/+$s))while$_=pop@F;$_=$t;1until!s/\d+(?=\d{3})/$&,/
|
Oops, missed an obvious, no-brainer improvement. I bet there are still a few more in there. :-)
#!perl -lp
/^h|[mba]/?$s=3*index(hamb,$&)||$s+2:(s/..//,$t+=index(zeontwthfofisiseeiniteel,$&)/2+10*/te|lv/.0 x(/y/+$s))for reverse/\S+/g;$_=$t;1until!s/\d+(?=\d{3})/$&,/
|
Hmm, a minor breakthrough. This looks much more reducible than my previous approach.
#!perl -lp
/^h|[mba]/?$s=3*index(hamb,$&)||$s+2:(s/..//,$t+=index(zeontwthfofisiseeiniteel,$&)/2+10*/te|lv/.0 x/y/.0 x$s)for reverse/\S+/g;$_=$t;1until!s/\d+(?=\d{3})/$&,/
|
Trying to shake things up a bit by creating expressions to be evaluated rather than just doing string manipulation. This seems somewhat promising for some reason...
#!perl -lp
s/hu/00/g;s!\b[^ 0bm].!'+'.index(zeontwthfofisiseeiniteel,$&)/2!eg;/m/||s/b/bm/;s/.3o/,/||s/m/,,/;s/\w+(te|el)/1$&/g;y/ybma-z /0,,/d;s/[^,]+/$&/eeg;1until!s/,(?!\d{3})/,0/
|
Combining, reducing, etc. etc.
#!perl -lp
s!\b[^\Wbm].!index(zeontwthfofisiseeiniteel,$&)/2!eg;/m/||s/b/bm/;s/3o/,/||s/m/,,/;s/\.5|y(?! \d)/0/g;s/\w+(te|el)/1$&/g;y/bma-z -/,,/d;s/0(?=\d\d)//g;1while s/,(?!\d{3})/,0/
|
Starting to make a dent in the comma problem.
#!perl -lp
s!\b[^\Wbm].!index(zeontwthfofisiseeiniteel,$&)/2!eg;/m/||s/b/bm/;s/3o/,/||s/m/m,/;y/bm/,/;s/\.5|y(?! \w)/0/g;s/\w+(te|el)/1$&/g;y/-a-z //d;s/0(?=\d\d)//g;1while s/,(?!\d{3})/,0/
|
Getting rid of more of those annoying substitutions. I need to get rid of all but one!
#!perl -lp
s/\b[^\Wbm]./.5*index zeontwthfofisiseeiniteel,$&/eg;s/b/,/;s/.*m|,/$&,/g;s/3o/,/g||s/.*,/$&,/;s/\.5|y(?! \w)/0/g;s/\w+(te|el)/1$&/g;y/-a-z //d;s/0(?=\d\d)//g;1while s/,(?!\d{3})/,0/
|
Rolling the 'twelve' special case together with the 'teen' cases for a six stroke gain.
#!perl -lp
s/\b[^\Wbm]./.5*index zeontwthfofisiseeiniteelhu,$&/eg;s/b/,/;s/.*m|,/$&,/g;s/3o/,/g||s/.*,/$&,/;s/y(?! \w)/0/g;s/12/00/g;s/\w+(te|el)/1$&/g;y/a-z //d;s/0(?=\d\d)//g;1while s/,(?!\d{3})/,0/
|
Yay! Under 200!
#!perl -lp
s/\b[^\Wbm]./.5*index zeontwthfofisiseeiniteelhu,$&/eg;s/b/,/;s/.*m|,/$&,/g;s/3o/,/g||s/.*,/$&,/;s/y(?! \w)/0/g;s/12/00/g;s/\w+te/1$&/g;s/2el/12/g;y/a-z //d;s/0(?=\d\d)//g;1while s/,(?!\d{3})/,0/
|
The first step in a new line of questioning.
#!perl -lp
for(reverse split){/^h|a|m|b/?$s=(3*index'hamb',$&)||$s+2:${$a=/^../&&index(zeontwthfofisiseeiniteel,$&)/2;/tee|lv/&&($a+=10);/y/&&($a.=0);($a>=0)&&($t+=($a.(0 x$s)));}}$_=$t;1until!s/\d+(?=\d{3})/$&,/
|
Settling in for a nice evening of golfing. Here's a one-stroke improvement to start.
#!perl -lp s/b/,/;s/.*m|,/$&,/;s/.*(?=tho|,)/$&,/;s/y(?! \w)/0/g;s/hu/H/g;s/wel/12/g;s/(? |
Got rid of sprintf (in other words, finally got around to reevaluating the first idea I got off the top of my head yesterday)
#!perl -lp s/b/,/;s/.*m|,/$&,/;s/.*(?=tho|,)/$&,/;s/y(?! \w)/0/g;s/hu/H/g;s/wel/12/g;s~(? |
Incorporating a few ideas I had in my sleep last night. Toooo many substitutions... must get rid of some...
#!perl -lp s/b/,/;s/.*m|,/$&,/;s/.*(?=tho|,)/$&,/;s/y(?! \w)/0/g;s/hu/H/g;s/wel/12/g;s~(? |
Okay, I'm not in last place anymore. Now I can go to bed.
#!perl -lp
sub f{.5*index'zeontwthfofisiseeiniteel',pop}s/wel/12/g;s/b/,/;s/m/,/||s/,/,,/;s/tho/,/||s/,/,,/;s/ty( ,|$)/0$1/g;s/ h/H/g;s/(\S\S)\S+een/10+f$1/eg;s/(?
|
Just a quick fix, now I really am going to sleep (well, going to bed anyway).
#!perl -lp
sub f{.5*index'zeontwthfofisiseeiniteel',pop}s/wel/12/g;s/b/,/;s/m/,/||s/,/,,/;s/tho/,/||s/(.*),/$1,,/;s/ty( ,|$)/0$1/g;s/ h/H/g;s/(\S\S)\S+een/10+f$1/eg;s/(?
|
58 strokes improvement, that's not too bad.
"one billion one million one" gives 1,000,001,001. I will update the test script.
#!perl -lp
%t=(on,1,tw,2,th,3,fo,4,fi,5,si,6,se,7,ei,8,ni,9);s/zero/0/;s/twel/12/g;s/el/11/g;s/ten/10/g;s/b/,/;s/m/,/||s/,/,,/;s/tho/,/||s/,/,,/;s/ty( ,|$)/0$1/g;s/ h/H/g;s/(\S\S)\S+een/1$t{$1}/g;s/\b[a-z]{2}/$t{$&}/g;y/a-z //d;s/H(\d)?\b/'0'.(0|$1)/eg;s/H//g;s/(?<=,)\d*/sprintf"%03d",$&/eg
|
Here for your enjoyment is a terribly long solution, my very first program that passes all tests (but that doesn't necessarily mean it's correct).
#!perl -ln
%t=(on,1,tw,2,th,3,fo,4,fi,5,si,6,se,7,ei,8,ni,9);s/zero/0/;s/twel\S+/12/g;s/el\S+/11/g;s/ten/10/g;s/b\S+/,/;s/m\S+/,/||s/,/,,/;s/tho\S+/,/||s/,/,,/;s/ty/ T/g;s/ h\S+/ H/g;s/(\w\w)\S+een\b/1$t{$1}/g;s/(\w\w)\S+\sh\S+/$t{$1}/g;s/(\w\w)\S+/$t{$1}/g;s/ //g;s/T\b/0/g;s/H\b/00/g;s/H(\d)\b/0$1/g;s/[TH]//g;s/(?<=,)\d*/sprintf"%03d",$&/eg;print
|