Roman Numeral Calculator Post Mortem

Home | Rules | Leaderboard / Submit | Post-Mortem | Careers

Roman Numeral Calculator Post Mortem

Accepted | Artistic/Unorthodox | Rejected

Referee comments are in italics. Blue rows denote golfer's best solution. Red text denotes special characters.

Accepted

Score Golfer Submit Time Code

99.56 ton Mon Jan 1 08:56:17 2007
-pl s!.!y$IVCXL426(-:$XLMCDIVX$dfor$$_.=5x$&*8%29628;$$$_=$_!egfor-4e3..y/iul-}/-$+ /%s''$';*_=eval

Just improving the tie a bit

99.57 ton Fri Dec 29 00:38:04 2006
-pl s!.!y$IVCXL426(-:$XLMCDIVX$dfor$$_.=5x$&*8%29628;$$$_=$_!egfor-4e3..y/iul-s/-$+ /%s''$';*_=eval

(-:
beautiful

100.55 ton Tue Dec 26 13:41:04 2006
-pl s!.!y$IVCXL426.-[$XLMCDIVX$dfor$$_.=5x$&*8%29628;$$$_=$_!egfor-4e3..s'^| '+$'g<s/n../-/g;*_=eval

Again a trivial tiebreak variation

100.57 ton Tue Dec 26 13:31:15 2006
-pl s!.!y$IVCXL426.-[$XLMCDIVX$dfor$$_.=5x$&*8%29628;$$$_=$_!egfor-4e3..s'^| '+$'g<s/nus/-/g;*_=eval

Playing with the tiebreaker

100.58 ton Tue Dec 26 13:09:11 2006
-pl s!.!y$IVCXL426.-X$XLMCDIVX$dfor$$_.=5x$&*8%29628;$$$_=$_!egfor-4e3..s'^| '+$'g<s/nus/-/g;*_=eval

Handle plus/minus a bit different

102.54 Juho Snellman Mon Jan 1 06:27:53 2007
-pl $_=${s!.!y$XLIVC246,-:$CDXLMVIX$dfor$$_.=8x$&*5%29628;$$$_=$_!gefor-4e3..s''$'/y/isl-~/-$+/d;eval}

102.57 ton Tue Dec 26 01:51:21 2006
-pl s!.!y$IVCXL426.-X$XLMCDIVX$dfor$$_.=5x$&*8%29628;$$$_=$_!egfor-4e3..y/i-z/-/d<s'^| \b'+$'g;*_=eval

More fun with globs

103.54 Juho Snellman Mon Jan 1 05:36:47 2007
-pl $_=${s!.!y$XLIVC246,-:$CDXLMVIX$dfor$$_.=8x$&*5%29628;$$$_=$_!gefor-4e3..s''$'/y/isl-~ /-$+/d;eval}

Whee, $$$_=$_

105.55 ton Tue Dec 26 01:50:01 2006
-pl $_=${s!.!y$IVCXL426.-X$XLMCDIVX$dfor$$_.=5x$&*8%29628;$$$_=$_!egfor-4e3..y/i-z/-/d<s'^| \b'+$'g;eval}

and another character gone

106.55 ton Tue Dec 26 01:25:25 2006
-pl s!.!y$IVCXL426.-X$XLMCDIVX$dfor$$_.=5x$&*8%29628;$$$_=$_!egfor-4e3..!y/i-z/-/d;$_=${s'^| \b'+$'g,eval}

goodbye, $&

107.52 TedYoung Tue Jan 2 05:04:19 2007
-lp y,iul-~,-$+,d,$_=eval,${$@}=1..!s/./y@IVCXL91-:0@XLMCDXVIII@dfor$@.=4x$&%1859^7/egfor$...4e3,u.$_;$_=$@

The original formula in the s/// was conceived by the amazing Ton Hospel (see the Perl Golf History book).

107.53 ton Tue Dec 26 01:12:32 2006
-pl s!.!y$IVCXL426.-X$XLMCDIVX$dfor$$_.=5x$&*8%29628;$$$_=$_!egfor-4e3..!y/i-z/-/d;$_=${s/\w+/+\$$&/g,eval}

delegate more work to the eval. The $& is now starting to look silly

107.54 TedYoung Tue Jan 2 04:57:17 2007
-lp y,iul-z,-$+,d,$_=eval,${$@}=1..!s/./y@IVCXL91-:0@XLMCDXVIII@dfor$@.=4x$&%1859^7/egfor+1..4e3,u.$_;$_=$@

The formula in the s/// was created by the amazing Ton Hospel (see Perl Golf History).

108.52 TedYoung Mon Jan 1 19:43:43 2007
-lp y=si-{=$\-+=s,$_=eval,${$@}=1..!s/./y@IVCXL91-:0@XLMCDXVIII@dfor$@.=4x$&%1859^7/egfor+1..4e3,"s$_";$_=$@

The formula in the s/// was created by the amazing Ton Hospel (see Perl Golf History).

109.50 Juho Snellman Sun Dec 31 21:34:28 2006
-pl s!.!y$XLIVC246,-:$CDXLMVIX$d,$$_=$`.$&for$:[$_].=8x$&*5%29628!gefor+s''$'..4e3;y/isl-~ /-$+/d;$_=$:[eval]

Tiebreak tweaking

109.50 TedYoung Mon Jan 1 00:07:02 2007
-lp $#&=$_=eval,${$#}=1..!s/./y$IVCXL426.-[$XLMCDIVX$dfor$#.=5x$&*8%29628/egfor+s..s...4e3-y=si-{=$\-+=s,$_++

The formula in the s/// was created by the amazing Ton Hospel (see Perl Golf History).

109.51 TedYoung Sun Dec 31 20:03:56 2006
-lp $_=eval,${$@}=1..!s/./y@IVCXL91-:0@XLMCDXVIII@dfor$@.=4x$&%1859^7/egfor+s..s...4e3-y=si-{=$\-+=s,$_;$_=$@

The formula in the s/// was created by the amazing Ton Hospel (see Perl Golf History).

109.52 Juho Snellman Sun Dec 31 15:52:41 2006
-pl s!.!y$XLIVC91-80$CDXLMXVIII$d,$$_=$`.$&for$:[$_].=4x$&%1859^7!gefor+s''$'..4e3;y/isl-~ /-$+/d;$_=$:[eval]

109.52 TedYoung Sun Dec 31 19:59:45 2006
-lp $_=eval,${$@}=1..!s/./y@IVCXL91-I0@XLMCDXVIII@dfor$@.=4x$&%1859^7/egfor+s..s...4e3-y=si-{=$\-+=s,$_;$_=$@

The formula in the s/// was created by the amazing Ton Hospel (see Perl Golf History).

109.53 ton Tue Dec 26 00:59:48 2006
-pl s!.!y$IVCXL426.-X$XLMCDIVX$dfor$$_.=5x$&*8%29628;$$$_=$_!egfor-4e3..!y/il-z/-+/d;$_=${s/\w+/${$&}/g,eval}

micro optimizations.

109.53 TedYoung Sun Dec 31 16:40:44 2006
-lp $_=eval,${$@}=1..!s/./y@IVCXL91-I0@XLMCDXVIII@dfor$@.=4x$&%1859^7/egfor+s..s...4e3-y=si-z=$\-+=s,$_;$_=$@

109.53 TedYoung Sun Dec 31 17:03:56 2006
-lp $_=eval,${$@}=1..!s/./y@IVCXL91-I0@XLMCDXVIII@dfor$@.=4x$&%1859^7/egfor+s..s...4e3-y=si-z=$\-+=s,$_;$_=$@

The formula in the s/// was created by the amazing Ton Hospel (see Perl Golf History).

109.54 TedYoung Sun Dec 31 16:24:45 2006
-lp $_=eval,${$@}=1..!s/./y@IVCXL91-I0@XLMCDXVIII@dfor$@.=4x$&%1859^7/egfor s..s...4e3-y=si-z=$\-+=s,$_;$_=$@

110.55 TedYoung Sun Dec 31 13:11:35 2006
-lp $_=eval,s/./y@IVCXL91-I0@XLMCDXVIII@dfor$@.=4x$&%1859^7/eg,${$@}=1..0for s..s...4e3-y=si-z=$\-+=s,$_;$_=$@

111.49 jojo Mon Jan 1 01:35:48 2007
-pl s|.|y;CLXVI624.-=;MDCLXXVI;dfor$$_.=5x$&*8%29628;$&|ge,$$$_=$_^Kfor-4e3..o;s;\w+;${$&}|$&&'-';ge;$_=${+eval}

111.49 jojo Tue Jan 2 02:23:16 2007
-pl s,.,y;CLXVI624+-=;MDCLXXVI;dfor$$_.=5x$&*8%29628;$&,ge,$$$_=$_^Kfor-4e3..o;s;\w+;${$&}|$&&'-';ge;$_=${+eval}

111.51 Juho Snellman Sun Dec 31 15:08:53 2006
-pl s!.!y$XLIVC91-80$CDXLMXVIII$d,$$_=$`.$&for$:[$_].=4x$&%1859^7!gefor//..4e3;y/isl-~ /-$+/d;s''$';$_=$:[eval]

112.48 jojo Sun Dec 31 17:16:02 2006
-pl s|.|y!CLXVI624.-;!MDCLXXVI!dfor$$_.=5x$&*8%29628;$&|ge,$$$_=$_^Kfor-4e3..0;s!\w+!${$&}||$&&"-"!ge;$_=${+eval}

113.49 ton Mon Dec 25 21:07:32 2006
-pl s!.!y$IVCXL426.-X$XLMCDIVX$dfor$$_.=5x$&*8%29628;$$$_=$_!egfor-4e3..0;s/\w+/${$&}||$&&"="||"+"/eg;$_=${+eval}

Ah, - maps to nothing with my roman formula. so the \d can become . again

113.52 TedYoung Sun Dec 31 11:52:56 2006
-lp $Q=s/./y$IVCXL91-I0$XLMCDXVIII$dfor$Q.=4x$&%1859^7/eg&($![$$Q=@!]=$Q)for!s..s...4e3-y=si-z=$\-+=s;$_=$![eval]

114.49 ton Mon Dec 25 21:00:55 2006
-pl s!\d!y$IVCXL426.-X$XLMCDIVX$dfor$$_.=5x$&*8%29628;$$$_=$_!egfor-4e3..0;s/\w+/${$&}||$&&"="||"+"/eg;$_=${+eval}

The wrong mapping for 4000 will be corrected now that I count backwards

114.52 szeryf Mon Jan 1 19:55:54 2007
-pl @;=map{$a=0;($a.=4x$_%1859^7)=~y!IVCXL91-80!XLMCDXVIII!dfor/./g;$$a=$_;$a}s''$'>y/isl-{/-$+ /..4e3;$_=$;[eval]

114.53 szeryf Sun Dec 31 11:38:20 2006
-pl @;=map{$a=0;($a.=4x$_%1859^7)=~y!IVCXL91-80!XLMCDXVIII!dfor/./g;$$a=$_;$a}s''$'>y/sli-u/$+-/d..4e3;$_=$;[eval]

115.50 ton Mon Dec 25 20:55:21 2006
-pl s!\d!y$IVCXL426.-X$XLMCDIVX$dfor$$_.=5x$&*8%29628;$$$_=$_!egfor-3999..0;s/\w+/${$&}||$&&"="||"+"/eg;$_=${+eval}

Use more globals

115.50 Juho Snellman Sun Dec 31 01:31:04 2006
-pl s!.!y$XLIVC91-80$CDXLMXVIII$d,$$_=$`.$&for$:[$_].=4x$&%1859^7!gefor//..4e3;y/il-~/-+/d;s!\w+!\$$&!g;$_=$:[eval]

115.50 jojo Sun Dec 31 04:18:10 2006
-pl for$p(-3999..0){$p=~s|.|y!CLXVI624.-;!MDCLXXVI!dfor$$p.=5x$&*8%29628;$&|ge;s|\b$$p|-^K$p|g}y!i-|!-^K!;$_=${-eval}

115.55 szeryf Sat Dec 30 21:10:08 2006
-pl @;=map{$a=0;map{y!IVCXL91-80!XLMCDXVIII!dfor$a.=4x$_%1859^7}/./g;$$a=$_;$a}s''$'>y/sli-u/$+-/d..4e3;$_=$;[eval]

115.56 TedYoung Sun Dec 31 09:42:22 2006
-lp map{my$Q;s/./y$IVCXL91-I0$XLMCDXVIII$dfor$Q.=4x$&%1859^7/eg,$_[$$Q=@_]=$Q}!s..s...4e3-y=si-z=$\-+=s;$_=$_[eval]

116.50 TedYoung Sat Dec 30 20:25:28 2006
-lp sub _{/\d/&&_(y,IVXLC,XLCDM,,s,,$&-9?$&-4?I x$&:IV:IX,e,s,I{5},V,)}map$$_=1.._,s..s...4E3;y=si-z=$\-+=s;_$_=eval

116.54 szeryf Sat Dec 30 19:35:01 2006
-pl @;=map{$a=0;map{y!IVCXL91-80!XLMCDXVIII!dfor$a.=4x$_%1859^7}/./g;$$a=$_;$a}!y/sli-u/$+-/d..4e3;$_=$;[eval"\$$_"]

118.42 jojo Sun Dec 31 01:46:45 2006
-pl for(y!i-|!-^K!;5>$.=~s|.|y!CLXVI624.-;!MDCLXXVI!dfor$^K[$.].=5x$&*8%29628;$&|ge;$.++){s|\b$^K[$.]\b|+$.|g}$_=$^K[eval]

118.53 pijll Mon Jan 1 19:14:26 2007
-pl y/i-z/-+/s;for$a(1..4e3){$a=~s#.#($n[$a].=4x$&%1859^7)=~y$IVCXL91-I0$XLMCDXVIII$d;s/\b$n[$a]\b/$a/g#ge}$_=$n[eval]

118.55 szeryf Fri Dec 29 20:56:50 2006
-pl @==map{$a=0;map{y!IVCXL91-80!XLMCDXVIII!dfor$a.=4x$_%1859^7}/./g;$$a=$_;$a}0..4e3;y/mpui-s/-+$/d;$_=$=[eval"\$$_"]

119.50 Sec Mon Jan 1 02:13:14 2007
-lp @%=map{my$a;s/./y!IVCXL91-80!XLMCDXVIII!dfor$a.=4x$&%1859^7/eg;$$a=$/--;$a}0..4e3;y/i/-/;s/\w+/${$&}/g;$_=$%[-eval]

Optimize Tiebreak before giving up and going to bed.

119.53 Sec Mon Jan 1 00:09:52 2007
-lp @r=map{my$a;s/./y!IVCXL91-80!XLMCDXVIII!dfor$a.=4x$&%1859^7/eg;$$a=$v--;$a}0..4e3;y/i/-/;s/\w+/${$&}/g;$_=$r[-eval]

Whoops. Totally forgot that eval defaults to $_. Gain 2 chars. Happy new year from germany

120.45 jojo Sat Dec 30 21:08:21 2006
-pl for(y!i-|!-^K!;++$*<4e3;s!\b$^K[$*]\b!+$*!g){$*=~s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$^K[$*].=4x$&%1859^7;$&!ge}$_=$^K[eval]

120.47 TedYoung Fri Dec 29 14:22:59 2006
-lp sub _{/\d/&&_(y/IVXLC/XLCDM/,s//$&-9?$&-4?I x$&:IV:IX/e,s/I{5}/V/)}map$$_=1.._,1..4E3;y/i/-/;s/\w+/+${$&}/g;_$_=eval

121.51 TedYoung Fri Dec 29 02:16:39 2006
-lp sub _{y/IVXLC/XLCDM/,s//$&-9?$&-4?I x$&:IV:IX/e,s/I{5}/V/while/\d/}map$$_=1.._,1..4E3;y/pm/+-/;s/\w+/${$&}/g;_$_=eval

121.53 Sec Sun Dec 31 23:58:22 2006
-lp @r=map{my$a;s/./y!IVCXL91-80!XLMCDXVIII!dfor$a.=4x$&%1859^7/eg;$$a=$v--;$a}0..4e3;y/i/-/;s/\w+/${$&}/g;$_=$r[-eval$_]

Some $$creativity for a few more chars.

122.54 Juho Snellman Sat Dec 30 21:25:09 2006
-pl sub T{$_=0;$_.=4x$&%1859^7,y$MDXLIVC91-80$A-DXLMXVIII$dwhile$?=~/./g}y/il-~/-+/d;s!\w+!T++$?until/^$&$/;$?!ge;T$?=eval

The clever parts in the arabic -> roman conversion are from an earlier golf solution by Ton.

122.54 eyepopslikeamosquito Tue Jan 2 05:02:57 2007
-lp sub'_{$;=0;($;.=5x$_*8%29628)=~y$IVCXL426.-X$XLMCDIVX$dfor/./g;$;}y;mp;-+;;s>\w+>(grep$&eq&_,1..1e4)[0]>eg;$_=_$_=eval

Standard golfing technique: Can't possibly work. Try it anyway!

122.56 pijll Mon Jan 1 18:31:53 2007
-pl y/il-z/-+/d;for$a(1..4e3){for($a=~/./g){y$IVCXL91-I0$XLMCDXVIII$dfor$n[$a].=4x$_%1859^7};s/\b$n[$a]\b/$a/g}$_=$n[eval]

Obviously, I've found Ton's solution to the earlier golf...

124.48 ton Mon Dec 25 20:24:04 2006
-pl map${s!.!y$IVCXL426.-X$XLMCDIVX$dfor$f[$n].=5x$&*8%29628!eg,$f[$n]}=++$n,1..3999;s/\w+/${$&}||$&&"="||"+"/eg;$_=$f[eval]

Still not thinking :-)

124.50 Sec Sun Dec 31 22:39:49 2006
-lp %%=map{my$a;s/./y!IVCXL91-80!XLMCDXVIII!dfor$a.=4x$&%1859^7/eg;$a,--$/,$/,$a}1..4e3;y/m/-/;s/\w+/$%{$&}/ge;$_=$%{eval$_}

swap minus and plus, and gain 2 chars :)

124.55 szeryf Fri Dec 29 18:47:41 2006
-pl @a=map{$a=0;map{y!IVCXL91-80!XLMCDXVIII!dfor$a.=4x$_%1859^7}/./g;$$a=$_;$a}0..4e3;y/mpa-z/-+/d;s/\w+/${$&}/g;$_=$a[eval]

125.45 eyepopslikeamosquito Tue Jan 2 06:12:25 2007
-lp @}{@]=map{$;=0;($;.=5x$_*8%29628)=~y$IVCXL426.-X$XLMCDIVX$dfor/./g;$;}@>}=@>=0..3999;y;mp;-+;;s>\w+>$}{$&}>eg;$_=$][eval]

Insurance just in case a lower one gets disqualified. Also, this one is 0.01 lower than Jasper. :-)

125.46 Jasper Sun Dec 31 20:16:51 2006
-lp map{y/IVXLC/XLCDM/,s!\d!$&^4?$&^9?V x($&>3).I x($&%5):IX:IV!ewhile//;$$_=$n++}@d=0..4e3;y/m/-/;s/\w+/+${$&}/g;$_=$d[eval]

126.48 ton Mon Dec 25 19:57:03 2006
-pl map${!s!.!y$IVCXL426.-X$XLMCDIVX$dfor$f[$n].=5x$&*8%29628!eg.$f[$n]}=$n=$_,1..3999;s/\w+/${$&}||$&&"="||"+"/eg;$_=$f[eval]

Some trivial reaarrangement

126.50 Sec Sun Dec 31 21:55:08 2006
-lp %%=map{my$a;s/./y!IVCXL91-80!XLMCDXVIII!dfor$a.=4x$&%1859^7/eg;$a,++$/,$/,$a}1..4e3;y/pm/+-/;s/\w+/$%{$&}/ge;$_=$%{eval$_}

Opitmize tiebreak.

126.53 eyepopslikeamosquito Sun Dec 31 11:56:06 2006
-lp sub'_{$;=0;($;.=5x$_*8%29628)=~y$IVCXL426.-X$XLMCDIVX$dfor/./g;$;}y;mp`-{;-+;d;s>\w+>(grep$&eq&_,1..1e4)[0]>eg;$_=_$_=eval

Going round in circles. Need to find a new breakthrough idea but I'm lacking inspiration. :-(

126.54 Sec Sun Dec 31 21:49:00 2006
-lp %r=map{my$a;s/./y!IVCXL91-80!XLMCDXVIII!dfor$a.=4x$&%1859^7/eg;$a,++$b,$b,$a}1..4e3;y/pm/+-/;s/\w+/$r{$&}/ge;$_=$r{eval$_}

One more char shaved. On a related note: The leaderboard shows more than one day remaining, yet on the rules page today is the final day?

127.45 Sec Sun Dec 31 21:13:05 2006
-pl %%=map{$"="";s/./y!IVCXL91-80!XLMCDXVIII!dfor$".=4x$&%1859^7/eg;$",++$/,$/,$"}1..4e3;y/pm/+-/;s/\w+/$%{$&}/ge;$_=$%{eval$_}

Wait... optimize tiebreak :)

127.47 jojo Fri Dec 29 13:34:00 2006
-pl for$*(1..4e3){$#=0;$*=~s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;$&!ge;s!\b$#\b!+$*!g;$_[$*]=$#}y!i-u!- !;$_=$_[eval]

127.47 pijll Sun Dec 31 01:49:33 2006
-pl y/i-z/-+/s;for$a(1..4e3){($n[$a].=/4|9/?17+$_:($_>3).2x($_%5))=~y/VXLC1-I/LCDMVIX/for$a=~/./g;s/\b$n[$a]\b/$a/g}$_=$n[eval]

127.52 Sec Sun Dec 31 21:08:19 2006
-pl %r=map{$a="";s/./y!IVCXL91-80!XLMCDXVIII!dfor$a.=4x$&%1859^7/eg;$a,++$b,$b,$a}1..4e3;y/pm/+-/;s/\w+/$r{$&}/ge;$_=$r{eval$_}

Squeeze a few more bytes...

128.45 Jasper Sat Dec 30 16:20:12 2006
-lp @d=map{y/IVXLC/XLCDM/,s!\d!$&^4?$&^9?V x($&>3).I x($&%5):IX:IV!ewhile//;$$_=$n++;$_}0..4e3;y/m/-/;s/\w+/+${$&}/g;$_=$d[eval]

Finally fits in one of my screen widths!

128.48 pijll Sun Dec 31 01:27:38 2006
-pl y/il-z/-+/d;for$a(1..4e3){($n[$a].=/4|9/?17+$_:($_>3).2x($_%5))=~y/VXLC1-I/LCDMVIX/for$a=~/./g;s/\b$n[$a]\b/$a/g}$_=$n[eval]

YES!!!

128.51 Juho Snellman Fri Dec 29 11:24:28 2006
-pl sub T{$_=pop;y!IVXLCDM!XLCDM~!,s!!$&-9?$&-4?I x$&:IV:IX!e,s!I{5}!V!while/\d/}y/il-~/-+/d;s!\w+!T++$?until/^$&$/;$?!ge;T+eval

128.52 eyepopslikeamosquito Sat Dec 30 12:29:13 2006
-lp sub'_{$#=0;s!.!y$IVCXL426.-X$XLMCDIVX$dfor$#.=5x$&*8%29628;5!eg;$#}y;mp`-{;-+;d;s>\w+>$-=0;$_=++$-while$&ne&_;$->eg;_$_=eval

I'm hanging onto Juho like a leech! I feel ashamed and dirty stealing this bizarre and grotesque $# hack from the greatest golfer of all time (and I'm not talking about Jack Nicklaus or Tiger Woods here). The mind boggles contemplating exactly how ton uncovered such depracated depravity in the bowels of perl. :-)

129.44 eyepopslikeamosquito Mon Jan 1 06:22:50 2007
-lp @}{@]=map{$;=0;($;.=5x$_*8%29628)=~y$IVCXL426.-X$XLMCDIVX$dfor/./g;$;}@>}=@>=0..3999;y;mp`-{;-+;d;s>\w+>$}{$&}>eg;$_=$][eval]

Golf is the only game I know where you wake up, peer at the leaderboard ... then find yourself cursing and swearing at total strangers for passing you on the leaderboard while you slept. :-) Though not my shortest, I thought I'd submit it in case it's of interest during the post mortem. I expect Jasper and (-ugene are using this approach, based on thier tiebreakers. Curiously, I tried this approach a few days ago and decided it was a dud, then came back to it in desperation today and promptly knocked 10 strokes off it. Still not the new approach I need, however.

129.49 ton Mon Dec 25 19:47:33 2006
-pl $n=$_,s!.!y$IVCXL426.-X$XLMCDIVX$dfor$f[$n].=5x$&*8%29628!eg,${$f[$n]}=$n for 1..3999;s/\w+/${$&}||$&&"="||"+"/eg;$_=$f[eval]

A quick placeholder before actually starting to think

129.50 eyepopslikeamosquito Sun Dec 31 00:44:24 2006
-lp sub'_{$#=0;s!.!y$IVCXL426.-X$XLMCDIVX$dfor$#.=5x$&*8%29628;5!eg}y;mp`-{;-+;d;s>\w+>$-=0;{_$_=++$-;$&ne$#&&redo}$->eg;_$_=eval

I've had to drop back from 128.52 to 129.50 because I just discovered my last entry fails the new test program I sent you (test case: II plus V).

129.50 Util Tue Jan 2 03:31:19 2007
-lp $==$_,s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$_[$=].=4x$&%1859^7;5!egfor+0..3999;@&{@_}=0..@_;y/il-z/-+/d;s/\w+/$&{$&}/g;$_=$_[eval]

Part of the code is taken from the Perl Golf book, section 9.3.2, Ton Hospel's post-mortem solution

129.52 eyepopslikeamosquito Fri Dec 29 10:18:08 2006
-lp sub'_{$;=0;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$;.=4x$&%1859^7!eg;$;}y;mp`-{;-+;d;s>\w+>$-=0;$_=++$-while$&ne&_;$->eg;$_=_$_=eval

Ooops, forgot to delete a new line.

129.53 Juho Snellman Wed Dec 27 09:31:22 2006
-pl sub T{$_=pop;y!IVXLCDM!XLCDM_!,s!!$&-9?$&-4?I x$&:IV:IX!e,s!I{5}!V!while/\d/}y/mpa-z/-+/d;s!\w+!T++$?until/^$&$/;$?!ge;T eval

Sorry, not any faster than the previous one. ;-)
romancalc.pl: Running test 131 ... Ok (12 seconds)

129.53 eyepopslikeamosquito Fri Dec 29 06:37:14 2006
-lp sub'_{$;=0;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$;.=4x$&%1859^7!eg;$;}y;mpa-z;-+;d;s>\w+>$-=0;$_=++$-while$&ne&_;$->eg;$_=_$_=eval

Desperate, I know, to submit just to improve the tiebreaker. I do find it a bit spooky that Juho and I now have identical tie-breaker. Surely we could not have independently found identical solutions? The odds against it must be astronomical.

129.54 Util Tue Jan 2 03:10:09 2007
-lp $i=$_,s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$_[$i].=4x$&%1859^7;5!egfor 0..3999;@_{@_}=0..@_;y/il-z/-+/d;s/\w+/$_{$&}/g;$_=$_[eval]

Part of the code is taken from the Perl Golf book, section 9.3.2, Ton Hospel's post-mortem solution

129.55 eyepopslikeamosquito Fri Dec 29 05:41:04 2006
-lp sub _{$;=0;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$;.=4x$&%1859^7!eg;$;}y;mpa-z;-+;d;s>\w+>$-=0;$_=++$-while$&ne _;$->eg;$_=_$_=eval

I love that good ol' y/// operator.

130.46 jchsw Tue Jan 2 00:53:34 2007
map{y/IVXLC/XLCDM/,s//$&-9?$&-4?I x$&:IV:IX/e,s/I{5}/V/while/\d/;$$_=$i++}@n=0..4E3;$_=<>;y/pm/+-/;s/\w+/${$&}/g;print"$n[eval]\n"

My code that scored 143.49 was entirely my own work. Subsequent code is partly based on sources found on the web, including the "Perlgolf history". In all submissions, I've restricted myself only to using code that I would be able to reproduce on my own.

130.47 Jasper Sat Dec 30 00:29:21 2006
-lp @d=map{my$a;$a=~y/IVXLC/XLCDM/,$a.=/4/?IV:/9/?IX:V x($_>3).I x($_%5)for/./g;$$a=$_;$a}0..4e3;y/m/-/;s/\w+/+${$&}/g;$_=$d[eval]

130.49 pijll Sun Dec 31 00:50:59 2006
-pl y/il-z/-+/d;for$a(1..4e3){($n[$a].=/4|9/?8+$_:2x($_>3).1x($_%5))=~y/12VXLC7I/IVLCDMX/for$a=~/./g;s/\b$n[$a]\b/$a/g}$_=$n[eval]

Getting closer... I want to catch Andrew at least!

130.52 eyepopslikeamosquito Fri Dec 29 10:16:47 2006
-lp sub'_{$;=0;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$;.=4x$&%1859^7!eg;$;} y;mp`-{;-+;d;s>\w+>$-=0;$_=++$-while$&ne&_;$->eg;$_=_$_=eval

Just another tie breaker hack (desperate to get ahead of Juno by 0.01).

131.53 Util Tue Jan 2 01:27:38 2007
-lp @_=map{$i=0;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$i.=4x$&%1859^7;5!eg;$i}0..3999;@_{@_}=0..@_;y/il-z/-+/d;s/\w+/$_{$&}/g;$_=$_[eval]

Part of the code is taken from the Perl Golf book, section 9.3.2, Ton Hospel's post-mortem solution

131.56 eyepopslikeamosquito Fri Dec 29 02:01:43 2006
-lp sub _{$;=0;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$;.=4x$&%1859^7!eg;$;}y;mpislun;-+;d;s>\w+>$-=0;$_=++$-while$&ne _;$->eg;$_=_$_=eval

132.54 Util Tue Jan 2 01:07:43 2007
-lp @_=map{$i=0;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$i.=4x$&%1859^7;5!eg;$i}0..3999;@_{@_}=0..@_;y/mpa-z/-+/d;s/\w+/$_{$&}/g;$_=$_[eval]

Part of the code is taken from the Perl Golf book, section 9.3.2, Ton Hospel's post-mortem solution

132.56 eyepopslikeamosquito Fri Dec 29 00:08:49 2006
-lp sub _{$;=!_;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$;.=4x$&%1859^7!eg;$;}y;mpislun;-+;d;s>\w+>$-=0;$_=++$-while$&ne _;$->eg;$_=_$_=eval

Crikey, I'm within 40 strokes of ton! Out of my comfort zone now. :-)

133.52 Sec Sun Dec 31 20:41:20 2006
-pl %r=map{$a="";s/./y!IVCXL91-80!XLMCDXVIII!dfor$a.=4x$&%1859^7/eg;($a,++$b,$b,$a)}1..4e3; y/pm/+-/; s/\w+/$r{$&}/ge; $_=$r{eval$_};

Whoops. Forgot to remove some whitespace and comments in the last version

134.49 Jasper Fri Dec 29 23:33:37 2006
-lp @d=map{my$a;$a=~y/IVXLC/XLCDM/,$a.=('',I,II,III,IV,V,VI,VII,VIII,IX)[$_]for/./g;$$a=$_;$a}0..4e3;y/m/-/;s/\w+/+${$&}/g;$_=$d[eval]

134.49 pijll Sat Dec 30 19:53:21 2006
-pl y/il-z/-+/d;for$a(1..4e3){$n[$a]=~y/IVXLC/XLCDM/,$s=$n[$a].=/9/?IX:/4/?IV:V x($_>3).I x($_%5)for$a=~/./g;s/\b$s\b/$a/g}$_=$n[eval]

135.51 Daniel Tuijnman Tue Jan 2 02:05:18 2007
-pl s#\d#$@+=$.*$&*(2gt$'^$`=~/m[^p]*$/||-1),""#ge,$..=0while y/MDCLXVI/CLXVI51/;$@=~s!.! $_.=4x$&%1859^7;y$IVCXL91-z 0$XLMCDXVIII$d!eg

136.49 jchsw Mon Jan 1 04:34:05 2007
map{y/IVXLC/XLCDM/,s//("",I,II,III,IV,V,VI,VII,VIII,IX)[$&]/ewhile/\d/;$$_=$i++}@n=0..4E3;$_=<>;y/pm/+-/;s/\w+/${$&}/g;print"$n[eval]\n"

136.52 Daniel Tuijnman Tue Jan 2 02:03:22 2007
-pl s#\d#$@+=$.*$&*(2gt$'^$`=~/m[^p]*$/||-1),""#ge,$..=0while y/MDCLXVI/CLXVI51/;$@=~s!.!y$IVCXL91-z 0$XLMCDXVIII$dfor$_.=4x$&%1859^7!eg

136.53 szeryf Fri Dec 29 16:06:58 2006
-pl @r{plus,minus,@r=map{$a='';s/./y!IVCXL91-80!XLMCDXVIII!dfor$a.=4x$&%1859^7/eg;$a}0..4e3}=('+','-',0..4e3);s/\S+/$r{$&}/g;$_=@r[eval]

137.47 Jasper Fri Dec 29 22:41:23 2006
-lp map{$c='';$c=~y/IVXLC/XLCDM/,$c.=('',I,II,III,IV,V,VI,VII,VIII,IX)[$_]for/./g;$d[$$c=$_]=$c}1..3999;y/m/-/;s/\w+/+${$&}/g;$_=$d[eval]

137.56 ambrus Wed Dec 27 20:15:43 2006
-lp sub k{my$t;$t=~y/IVXLC/XLCDM/,$t.=("",I,II,III,IV,V,VI,VII,VIII,IX)[$_]for/./g;$$t=$_;$t}y/iul-z/-$+ /;k for 1..4e3;$_=k$_=eval"\$$_"

138.52 Daniel Tuijnman Tue Jan 2 00:46:51 2007
-pl s#\d#$@+=$.*$&*(2gt$'^$`=~/m[^p]*$/||-1),""#ge,$..=0while y/MDCLXVI/CLXVI51/;$@=~s!.!y$IVCXL91-z 0$XLMCDXVIII$dfor$_.=4x$&%1859^7;5!eg

139.46 Daniel Tuijnman Sun Dec 31 16:00:55 2006
-pl y/IVXLCDM/1-7/;s#\d#$@+=10**($&>>1)/(2-$&%2)*(1+$&gt$'^$`=~/i[^p]*$/||-1)#ge;$_=$@;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;5!eg

139.50 Jasper Sun Dec 31 11:45:12 2006
-lp @d=map{ y/IVXLC/XLCDM/,s!\d!$&^4?$&^9?V x($&>3).I x($&%5):IX:IV!ewhile//; $$_=$n++;$_ }0..4e3; y/m/-/;s/\w+/+${$&}/g;$_=$d[eval]

Finally fits in one of my screen widths!

139.51 pijll Sat Dec 30 16:48:43 2006
-lp y/pma-z/+-/d;for$a(1..4e3){$n[$a]=~y/IVXLC/XLCDM/,$s=$n[$a].=('',I,II,III,IV,V,VI,VII,VIII,IX)[$_]for$a=~/./g;s/\b$s\b/$a/g}$_=$n[eval]

140.46 Daniel Tuijnman Sun Dec 31 14:30:23 2006
-pl y/IVXLCDM/1-7/;s#\d#$@+=10**($&>>1)/(2-$&%2)*(1+$&le$'^$`=~/i[^p]*$/?-1:1)#ge;$_=$@;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;5!eg

140.47 Jasper Fri Dec 29 16:24:42 2006
-lp map{$;='s/IIII/IV/;s/VIV/IX/;s/I(V|X)I/$1/;$;=~y/IVXLC/XLCDM/';eval$;for($c.=I)x3;$d[$$c=$_]=$c}1..4e3;y/m/-/;s/\w+/+${$&}/g;$_=$d[eval]

140.49 jchsw Mon Jan 1 03:39:35 2007
map{y/IVXLC/XLCDM/,s//("",I,II,III,IV,V,VI,VII,VIII,IX)[$&]/ewhile/\d/;$r{$_}=$i++}@n=0..4E3;$_=<>;y/pm/+-/;s/\w+/$r{$&}/g;print"$n[eval]\n"

141.45 Daniel Tuijnman Sun Dec 31 14:05:31 2006
-pl y/IVXLCDM/2-8/;s#\d#$@+=(10**(~-$&>>1)>>$&%2)*(1+$&le$'^$`=~/i[^p]*$/?-1:1)#ge;$_=$@;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;5!eg

141.47 Juho Snellman Tue Dec 26 19:11:27 2006
-pl sub T{$_=$?;y!IVXLCDM!XLCDM_!,$_.=$&-9?$&-4?I x$&:IV:IX,s!I{5}!V!while s/\d//;$_}s!(m.*?)?([A-Z]+)!++$?until$2 eq T;$?=$r+=$1?-$?:$?!ge;T

between 2 - 8 seconds per test on a dual xeon, that was fun!

142.53 Util Mon Jan 1 20:45:09 2007
-lp @_=map{$i=0;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$i.=4x$&%1859^7;5!eg;$i}0..3999;@_{@_,plus,minus}=(0..$#_,'+','-');s/\S+/$_{$&}/eg;$_=$_[eval]

Part of the code is taken from the Perl Golf book, section 9.3.2, Ton Hospel's post-mortem solution

143.48 Jasper Fri Dec 29 15:21:10 2006
-lp %r=map{$;='s/IIII/IV/;s/VIV/IX/;s/I(V|X)I/$1/;$;=~y/IVXLC/XLCDM/';eval$;for($c.=I)x3;$d[$_]=$c,$_}1..4e3;y/m/-/;s/\w+/+$r{$&}/g;$_=$d[eval]

143.49 jchsw Sat Dec 30 08:01:54 2006
map{y/IVXLC/XLCDM/,s//("",I,II,III,IV,V,VI,VII,VIII,IX)[$&]/e while/\d/;$r{$_}=$i++}@n=(0..4E3);$_=<>;y/pm/+-/;s/\w+/$r{$&}/g;print"$n[eval]\n"

143.50 DWilson Mon Jan 1 21:11:25 2007
-alp sub r{$#='';s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;5!eg;$#}%%=map{$~=$_;r,$~}1..3999;y$mp^-~$-+$d||($_=$%{$_})for@F;$_=eval"@F";r

Still using ton's a2r code as basis of conversion function.

143.51 DWilson Mon Jan 1 20:57:14 2007
-alp sub r{$#='';s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;5!eg;$#}%%=map{$~=$_;r,$~}1..3999;y/mpa-z/-+/d||($_=$%{$_})for@F;$_=eval"@F";r

Still using ton's a2r code as basis for conversion function.

143.54 ambrus Wed Dec 27 13:54:44 2006
-lp sub k{my$t;$t=~y/IVXLC/XLCDM/,$t.=("",I,II,III,IV,V,VI,VII,VIII,IX)[$_]for$q=~/./g;s/\b$t\b/$q/g;$t}y/il-z/-+ /;for$q(1..4e3){k}$_=k$q=eval

144.53 ambrus Wed Dec 27 13:22:49 2006
-lp sub k{$t="";$t=~y/IVXLC/XLCDM/,$t.=("",I,II,III,IV,V,VI,VII,VIII,IX)[$_]for$q=~/./g;$t}for$q(1..4e3){k,s/\b$t\b/$q/g}y/il-z/-+ /;$_=k$q=eval

145.51 Daniel Tuijnman Sat Dec 30 14:08:11 2006
-pl y/mIVXLCDM-z/-1-7 /;s/\d+/+($&)/g;s#\d#qw/- +/[1+$&gt$'].10**($&>>1)/(2-$&%2)#ge;$_=eval;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;5!eg

145.56 Shlomi Fish Sun Dec 31 20:51:55 2006
-lp sub f{split//;reverse map{(/./g)[map{vec'\xff\xfc\xf0\xc0\xf1\xfd\xf4\xd0@\xf2',$_++,2}(4*pop)x4]}qw(IVX XLC CDM M)}y/pm/+-/;s!\w+!(grep$&eq f,1..4x4)[0]!ge;$_=f$_=eval

146.49 Jasper Thu Dec 28 13:32:58 2006
-lp %r=map{$s='s/IIII/IV/;s/VIV/IX/;s/I(V|X)I/$1/';eval"$s;\$s=~y/IVXLC/XLCDM/"for($a.=I)x3;$d[$_]=$a,$_}1..4e3;y/m/-/;s/\w+/+$r{$&}/g;$_=$d[eval]

146.51 DWilson Mon Jan 1 20:50:06 2007
-alp sub r{$#='';s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;5!eg;$#}%%=map{$~=$_;r,$~}1..3999;y/mpa-z/-+/d||($_=$%{$_})for@F;$_=eval"@F";$_=r

Using ton's a2r code (from web) as basis for conversion function.

147.33 mmultima Mon Jan 1 09:20:17 2007
-pa $_=${{map{$q+=$u{$t=$_}*$*;$*=5-/m/;s/./--$*x!($&%5-4).($*+4**($&<9))x($&>3).$*x($&%5&3)/ge;y/1-7/IXCMVLD/;$u{$_}=$t+0,$_}$|x4..4x4,@F}}{$q}.$/

Tried a reference.

147.54 ambrus Wed Dec 27 13:15:11 2006
-lp sub k{$t="";$t=~y/IVXLCD/XLCDMP/d,$t.=("",I,II,III,IV,V,VI,VII,VIII,IX)[$_]for$q=~/./g}for$q(1..4e3){k,s/\b$t\b/$q/g}y/il-z/-+ /;k$q=eval;$_=$t

147.56 Shlomi Fish Wed Dec 27 16:21:17 2006
-lp sub f{split//;reverse map{(/./g)[map{vec'\xff\xfc\xf0\xc0\xf1\xfd\xf4\xd0@\xf2',$_++,2}(4*pop)x4]}qw(IVX XLC CDM M)}tr/pm/+-/;s!\w+!(grep$&eq f,1..3999)[0]!ge;$_=f$_=eval

148.48 Daniel Tuijnman Sat Dec 30 13:53:00 2006
-pl y/mIVXLCDM-z/-1-7 /;s/\d+/+($&)/g;s#\d#qw/+ -/[("?"&$')>$&].10**($&>>1)/(2-$&%2)#ge;$_=eval;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;5!eg

148.53 ambrus Wed Dec 27 11:58:32 2006
-lp sub k{$t="";$t=~y/IVXLCD/XLCDMP/d,$t.=("",I,II,III,IV,V,VI,VII,VIII,IX)[$_]for$q=~/./g}for$q(1..4e3){k,s/\b$t\b/$q/g}y/il-z/-+ /;$q=eval;k;$_=$t

the 147 char version had a bug

148.59 Honza Pazdziora Mon Jan 1 19:32:57 2007
-lp ($c=F1000M900CM500D400CD100C90XC50L40XL10X9IX5V4IV1I)=~s/\d+(\D+)/${$$1=0 x$&}=$1,"|$$1|$1"/eg;sub p{s!$c!${$&}!g}p;1while s!\D+|(0+) m\D+\1!!;p

149.48 Daniel Tuijnman Sat Dec 30 05:05:15 2006
-pl y/mIVXLCDM-z/-1-7 /;s/\d+/+($&)/g;s#\d(?=(.))#qw/+ -/[$1>$&].10**($&>>1)/(2-$&%2)#ge;$_=eval;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;5!eg

150.45 Juho Snellman Tue Dec 26 13:55:25 2006
-pl sub T{$_='';y!IVXLC!XLCDM!,$_.=I x$&,s!I{5}|(I)III!$1V!g,s!VIV!IX!while$?=~/./g;$_}s!(m.*?)?([A-Z]+)!$?=0;++$?until$2 eq T;$?=$r+=($1&"-").$?!ge;T

150.46 Daniel Tuijnman Fri Dec 29 18:51:58 2006
-pl y/mIVXLCDM-z/-1-7 /;s/\d+/+($&)/g;s#\d(?=(.))#($1>$&?"-":"+").10**($&>>1)/(2-$&%2)#ge;$_=eval;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;5!eg

151.32 mmultima Mon Jan 1 00:46:15 2007
-pa %y=map{$q+=$u{$t=$_}*$*;$*=5-/m/;s/./(--$*.$*+(5&$&))x!($&%5-4)||($*+4)x($&>4).$*x($&%5)/ge;y/1-7/IXCMVLD/;$u{$_}=$t+0,$_}$|x4..4x4,@F;$_=$y{$q}.$/

And removed a pair of unnecessary parentheses.

151.46 Daniel Tuijnman Wed Dec 27 22:26:15 2006
-pl y/mIVXLCDMa-z/-1-7 /;s/\d+/+($&)/g;s#\d(?=(.))#($1>$&?"-":"+").10**($&>>1)/(2-$&%2)#ge;$_=eval;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;5!eg

152.51 TedYoung Wed Dec 27 14:33:08 2006
-lp for$=(0..3){s/I[XV]/-$&/g,s/I|V/+$&E$=/g,y/MDCLXVIl-u/CLXVI51/d}s/i \S+/-($&)/g;$_=eval;y/IVXLC/XLCDM/,s//$&-9?$&-4?I x$&:IV:IX/e,s/I{5}/V/while/\d/

152.55 Shlomi Fish Wed Dec 27 00:39:17 2006
-lp sub f{split//;reverse map{$k=4*pop;(/./g)[map{vec'\xff\xfc\xf0\xc0\xf1\xfd\xf4\xd0@\xf2',$k++,2}0..3]}qw(IVX XLC CDM M)}tr/pm/+-/;s!\w+!(grep$&eq f,1..3999)[0]!ge;$_=eval;$_=f

153.32 mmultima Mon Jan 1 00:40:34 2007
-pa %y=map{$q+=$u{$t=$_}*$*;$*=5-/m/;s/./(--$*.($*+(5&$&)))x!($&%5-4)||($*+4)x($&>4).$*x($&%5)/ge;y/1-7/IXCMVLD/;$u{$_}=$t+0,$_}$|x4..4x4,@F;$_=$y{$q}.$/

Back to position 14 for Amazon gift sertificate. Done with less obvious arithmetics.

153.53 TedYoung Tue Dec 26 19:58:37 2006
-lp for$i(0..3){s/I[XV]/-$&/g,s/I|V/+$&E$i/g,y/MDCLXVImp/CLXVI51+/}s/nus \S+/-($&)/g;$_=eval;y/IVXLC/XLCDM/,s//$&-9?$&-4?I x$&:IV:IX/e,s/I{5}/V/while/\d/

155.32 tybalt89 Tue Dec 26 17:48:22 2006
-lp ++$I;$$_=$.*=$^F^=7for@@=VXLCDM=~/(.)/g;s//pm1=~$&?$-=$':$%+=$$1<${_&$'}^$-?-$$1:$$1/ge;$_=I x$%;$I+=2while+s/(.)\1{3}(\1{5})?(\1?)/$1x!$+.$@[$I^!$2]/ge

156.33 tybalt89 Sun Dec 24 15:26:26 2006
-lp ++$I;$$_=$.*=$^F^=7for@@=VXLCDM=~/(.)/g;s//$%+=$$1<${_&$'}^$-?-$$1:$$1;pm1!~$&or$-=$'/ge;$_=I x$%;$I+=2while+s/(.)\1{3}(\1{5})?(\1)?/$1x!$3.$@[$I^!$2]/ge

156.49 pijll Sat Dec 30 16:20:40 2006
-lp @r{@r=('',I,II,III,IV,V,VI,VII,VIII,IX)}=0..9;y/pma-z/+-/d;for$a(1..3999){$n[$a]=~y/IVXLC/XLCDM/,$n[$a].=$r[$_]for$a=~/./g;s/\b$n[$a]\b/$a/g}$_=$n[eval]

The first real improvement!

157.55 Honza Pazdziora Mon Jan 1 16:22:50 2007
-p $c=F1000M900CM500D400CD100C90XC50L40XL10X9IX5V4IV1I;$c=~s/\d+(\D+)/$R{1x$&}=$1,"|$1|".($$1=1x$&)/eg;s!$c!${$&}!g;1while s! \D+|(1+) m\D+\1!!;s!$c!$R{$&}!g

158.34 tybalt89 Sun Dec 24 02:22:35 2006
-lp $I=1;$$_=$.*=$^F^=7for@@=VXLCDM=~/l|n|(.)/g;s//$%+=$$1<${_&$'}^$??-$$1:$$1;$+or$?=$&=~n/ge;$_=I x$%;$I+=2while+s/(.)\1{3}(\1{5})?(\1)?/$1x!$3.$@[$I^!$2]/ge

158.46 DWilson Mon Jan 1 15:47:23 2007
-alp sub r{$#='';s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;5!eg;$#}%%=map{$~=$_;r,$~}1..3999;s/p.*/)+(/||s/m.*/)-(/||($_=$%{$_})for@F;$_=eval"(@F)";$_=r

aha. still using ton's a2r code.

159.53 Shlomi Fish Tue Dec 26 22:18:53 2006
-lp sub f{split//;reverse map{(/./g)[($k=pop)%5<4?((0)x($k%5),$k>4||()):(($k+1)/5,0)]}qw(IVX XLC CDM M)}tr/pm/+-/;s!\w+!(grep$&eq f,1..3999)[0]!ge;$_=eval;$_=f

160.55 Honza Pazdziora Mon Jan 1 15:33:58 2007
-p while(M1000CM900D500CD400C100XC90L50XL40X10IX9V5IV4I1=~/(\D+)(\d+)/g){$a.="|$1|".($$1=1x$2);$R{$$1}=$1}s!$a!${$&}!g;1while s! \D+|(1+) m\D+\1!!;s!$a!$R{$&}!g

163.31 mmultima Sun Dec 31 15:00:32 2006
-pa %y=map{$q+=$u{$_}*++$*;$*=4-/m/;$t=$_;s/./(--$*.($*+4**($&<9)))x!(($&+1)%5)||($*+4)x($&>4).$*x($&%5)/ge;y/0-6/IXCMVLD/;$u{$_}=$t+0,$_}$|x4..4x4,@F;$_=$y{$q}.$/

This is my first try at Perl Golf. I'm actually not a Perl programmer, so no wonder the pros beat me.

166.45 SubStack Mon Jan 1 01:23:29 2007
-lp @r{map@q{$_}=I x(10,9,5,4)[$@%4]x10**int 3-++$@/4,@s}=@s=MCMDCDCXCLXLXIXVIV=~/(.)(..)/g;1 while$"="|",s/@s|[^mpI]/$q{$&}/g+s/p|(I+)m(I+)/$1^$2/e;s/@q{@s}/$r{$&}/g

168.43 DWilson Mon Jan 1 00:35:37 2007
-alpF// @@{IVXLCDM=~/./g}=grep/^[15]0*$/,1..1e3;/m|p/&&($~=/m/),$^+=$@{$_}*($~^$@{$_}<$@{$F[++$*]}?-1:1)for@F;$_=$^;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;5!eg

Still using ton's Arabic to Roman conversion code for part of the solution.

168.44 SubStack Fri Dec 29 00:56:47 2006
-lp @r{map@q{$_}=I x(10,9,5,4)[$@%4]x(100,10,1)[$@++/4],@s}=@s=MCMDCDCXCLXLXIXVIV=~/(.)(..)/g;1 while$"="|",s/@s|[^mpI]/$q{$&}/g+s/p|(I+)m(I+)/$1^$2/e;s/@q{@s}/$r{$&}/g

168.48 DWilson Sun Dec 31 23:48:44 2006
-alpF// @r{IVXLCDM=~/./g}=grep/^[15]0*$/,1..1e3;/m|p/&&($c=/m/),$b+=$r{$_}*($c^$r{$_}<$r{$F[++$d]}?-1:1)for@F;$_=$b;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;5!eg

still using ton's published code for half of the solution.

169.36 tybalt89 Sat Dec 23 23:20:17 2006
-lp $@=.1;$$_=$@*=$^F^=7for-IVXLCDM=~/l|n|(.)/g;s//$%+=$$1<${_&$'}^$@eq+n?-$$1:$$1;$+or$@=$&/ge;sub'f{s/(.)\1{3}(\1{5})?(\1)?/$1x!$3.$_[!$2]/ge}$_=I x$%;f+X,V;f+C,L;f+M,D

169.40 Jasper Thu Dec 28 01:51:11 2006
-lp %r=@d=map{$a.=I;for(IVX,XLC,CDM){($i,$v,$x)=/./g;$a=~s/($v)?$i{4}/$i.($1?$x:$v)/e;$a=~s/$i($v|$x)$i/$1/}$a,"+$_"}1..3999;s/m\w+/-/g;s/\w+/$r{$&}/g;$_=$d[-2+2*eval$_]

169.49 DWilson Sun Dec 31 19:15:58 2006
-anlpF// @r{IVXLCDM=~/./g}=grep/^[15]0*$/,1..1e3;/m|p/&&($c=/m/),$b+=$r{$_}*($c^$r{$_}<$r{$F[++$d]}?-1:1)for@F;$_=$b;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;5!eg

Previous comment still applies (using ton's published arabic to roman code)

169.51 m.wrenn Tue Jan 2 06:55:20 2007
-lp @@{@@=map{$_,$_.0,$_*100}4,5,9,10}=qw(IV XL CD V L D IX XC CM X C M);for$~(@@){s/$@{$~}/"I "x$~/ge}s/I//while s/m\w* +I/m /;$~=y/I//cd;s/I{$~}/$@{$~}||$&/gewhile$~--

Last try for the T-Shirt! My eyes are popping too!

169.58 Honza Pazdziora Sun Dec 31 20:33:30 2006
-p while(M1000CM900D500CD400C100XC90L50XL40X10IX9V5IV4I1=~/(\D+)(\d+)/g){$a.='|'.($x=1x$2);$R{$x}=$m=$1;1while s!(\b|1)$m!$1$x!}1while s! \D+|(1+) m\D+\1!!;s!$a!$R{$&}!g

170.51 `/anick Tue Jan 2 02:00:41 2007
-lp040 $s=/m/ if/u/;($y=I1V5X10L50C100D500M1000IV4IX9XL40XC90CD400CM900)=~/$&/,$i=$t+=$s^"$;">($;=$')?-$;:$;while s/.$//}{1while$y=~/(\D+)$i/&&$t>=$i?($_.=$1,$t-=$i):$i--

170.58 Honza Pazdziora Sun Dec 31 19:38:29 2006
-p while(M1000CM900D500CD400C100XC90L50XL40X10IX9V5IV4I1=~/(\D+)(\d+)/g){$a.='|'.($x=1x$2);$R{$x}=$m=$1;1while s!(\b|1)$m!$1$x!}1while s! p\D+|(1+) m\D+\1!!;s!$a!$R{$&}!g

171.50 m.wrenn Mon Jan 1 21:13:10 2007
-lp $^F**=@@{@@=map{$_,$_.0,$_*100}4,9,5,10}=qw(IV XL CD IX XC CM V L D X C M);for$~(@@){s/$@{$~}/"I "x$~/ge}s/I//while s/n\w* +I/n /;y/I//cd;s/I{$^F}/$@{$^F}||$&/gewhile$^F--

Using $^F! I hope it loads correctly

171.51 `/anick Tue Jan 2 01:55:30 2007
-lp040 $s=/m/ if/u/; ($y=I1V5X10L50C100D500M1000IV4IX9XL40XC90CD400CM900)=~/$&/,$i=$t+=$s^"$;">($;=$')?-$;:$;while s/.$//}{1while$y=~/(\D+)$i/&&$t>=$i?($_.=$1,$t-=$i):$i--

172.33 tybalt89 Sat Dec 23 20:37:47 2006
-lp $@=.1;$$_=$@*=$^F^=7for-IVXLCDM=~/l|n|(.)/g;s//!$+?$.=(Z^$&)-5:$%+=$$1*($$1<${_&$'}?-$.:$.)/ge;sub'f{s/(.)\1{3}(\1{5})?(\1)?/$1x!$3.$_[!$2]/ge}$_=I x$%;f+X,V;f+C,L;f+M,D

172.48 DWilson Sun Dec 31 18:57:14 2006
-anlpF// @r{@r=IVXLCDM=~/./g}=grep/^[15]0*$/,1..1e3;/m|p/&&($c=/m/),$b+=$r{$_}*($c^$r{$_}<$r{$F[++$d]}?-1:1)for@F;$_=$b;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;5!eg

Up until now, it's been all my work as a general non-golfer. In this one, I used previously published Roman to Arabic code(Ton's) as part of the solution.

172.50 m.wrenn Mon Jan 1 16:51:34 2007
-lp @@{@@=map{$_,$_.0,$_*100}4,9,10,5}=qw(IV XL CD IX XC CM X C M V L D);for$~(@@){s/$@{$~}/"I "x$~/ge}s/I//while s/n\w* +I/n /;y/I//cd;$~=$$;s/I{$~}/$@{$~}||$&/gewhile--$~

Slow and uses $$, so I hope it still OK!

172.52 `/anick Tue Jan 2 01:47:22 2007
-lp040 $s=/m/ if/u/; ($y=I1V5X10L50C100D500M1000IV4IX9XL40XC90CD400CM900)=~/$&/,$i=$t+=$s^"$p">($p=$')?-$':$' while s/.$//}{1while$y=~/(\D+)$i/&&$t>=$i?($_.=$1,$t-=$i):$i--

172.55 sf Sun Dec 31 20:30:16 2006
-pl %v=@a=M1000CM900D500CD400C100XC90L50XL40X10IX9V5IV4I1=~/\d+|\D+/g;$n+=/m/../p/?-$v{$_}:$v{$_}for/C[MD]|X[CL]|I[XV]|./g;$_<1?$s=$_:$n<$_||($r.=$s,$n-=$_,redo)for@a;$_=$r

foo bar 2

172.60 Honza Pazdziora Sun Dec 31 19:31:20 2006
-p while(M1000CM900D500CD400C100XC90L50XL40X10IX9V5IV4I1=~/(\D+)(\d+)/g){$a.='|'.($x=1x$2);$R{$x}=$m=$1;1while s!(\b|1)$m!$1$x!}1while s! plus |(1+) m\D+ \1!!;s!$a!$R{$&}!g

173.51 m.wrenn Mon Jan 1 16:12:58 2007
-lp @@{@@=map{$_,$_.0,$_*100}4,9,10,5}=qw(IV XL CD IX XC CM X C M V L D);for$~(@@){s/$@{$~}/"I "x$~/ge}s/I//while s/n\w* +I/n /;y/I//cd;$~=2e3;s/I{$~}/$@{$~}||$&/gewhile--$~

I'm getting that cotton feeling!

173.52 eyepopslikeamosquito Thu Dec 28 11:45:44 2006
-lp y;mpislun;-+;d;s}\w+}$==1e3;$;=$_=$&;s>.>I1V5X10L50C100D500M1000!~/$&(.+)/;$;-=2*$=x($=<$1)-($==$1)>eg;$;}eg;$_=eval;s}.}y.IVCXL91-I0.XLMCDXVIII.dfor$#.=4x$&%1859^7;5}eg

Sorry, it would not accept my Australian phone number, so I entered George Bush's phone number. The remarkable Ton Hospel strikes again! I wonder if he's generating all sorts of weird magical xor functions again. :-) I haven't played golf for four years now and am feeling very rusty. This first approach seems to be going nowhere, time for a new approach. I'm unhappy with this (dull) first attempt but thought I'd submit it anyway as a marker of my first approach. (I'm sure you'll recognize the last bit stolen from Mr Hospel's last Roman brilliancy).

173.53 `/anick Sun Dec 31 20:46:32 2006
-lp040 $s=/m/ if/u/; ($y=I1V5X10L50C100D500M1000IV4IX9XL40XC90CD400CM900) =~/$&/,$i=$t+=$s^"$p">($p=$')?-$':$' while s/.$//}{1while$y=~/(\D+)$i/&&$t>=$i?($_.=$1,$t-=$i):$i--

174.46 SubStack Thu Dec 28 11:11:09 2006
-lp @r{map@q{$_}=I x(10,9,5,4)[$@%4]x(100,10,1)[$@++/4],@s}=@s=MCMDCDCXCLXLXIXVIV=~/(.)(..)/g;1 while$"="|",s/@s|[\0linus ]/$q{$&}/eg+s/p|(I+)m(I+)/$1^$2/e;s/@q{@s}/$r{$&}/eg

174.51 `/anick Sun Dec 31 18:01:55 2006
-lp040 $s=/m/ if/u/;($y=a1I5V10X50L100C500D1000M4IV9IX40XL90XC400CD900CM)=~/\d+$&/,$i=$t+=$s^"$p">($p=$&)?-$&:$&while s/.$//}{1while$y=~/$i(\D+)/&&$t>=$&?($_.=$1,$t-=$i):$i--

Yes, squeezing at 0.01 points before grizzley!

174.52 grizzley Fri Dec 29 13:36:40 2006
-pl sub f{s/[-+]\d/$&0/g;s/C(?=[MD])/-1/g;s/M/DD/g;s/D/+5/g;y/XCVLpIx/CMLDIX/}y/mpi-u/-+ /;s/\w+/($&)/g;f;f;f;s/M/+1/g;$_=eval;f,s/IIII/IV/,s/IVI/V/while s/\d/$&-9?p x$&:px/e

No time to investigate it - bloody New Year's Eve... :P

175.33 tybalt89 Sat Dec 23 18:53:03 2006
-lp $@=.5;$$_=$@*=--$|?2:5for+IVXLCDM=~/l|n|(.)/g;s//!$+?$.=(Z^$&)-5:$%+=$$1*($$1<${_&$'}?-$.:$.)/ge;sub'f{s/(.)\1{3}(\1{5})?(\1)?/$1x!$3.$_[!$2]/ge}$_=I x$%;f+X,V;f+C,L;f+M,D

A test to see if I have to get a 5.8.5, it runs on a 5.8.7

175.47 SubStack Thu Dec 28 04:32:33 2006
-lp $s{$q{$_}=I x(10,9,5,4)[$@%4]x(100,10,1)[$@++/4]}=$_ for@s=MCMDCDCXCLXLXIXVIV=~/(.)(..)/g;$"="|";1 while s/@s|[\0linus ]/$q{$&}/eg+s/p|(I+)m(I+)/$1^$2/e;s/@q{@s}/$s{$&}/eg

better way of reversing a hash

175.51 `/anick Sun Dec 31 16:14:39 2006
-lp040 $y=a1I5V10X50L100C500D1000M4IV9IX40XL90XC400CD900CM;$s=/m/ if/u/;$y=~/\d+$&/,$i=$t+=$s^"$p">($p=$&)?-$&:$&while s/.$//}{1while$y=~/$i(\D+)/&&$t>=$&?($_.=$1,$t-=$i):$i--

175.56 sf Sun Dec 31 20:28:36 2006
-pl %v=@a=M1000CM900D500CD400C100XC90L50XL40X10IX9V5IV4I1=~/\d+|\D+/g; $n+=/m/../p/?-$v{$_}:$v{$_}for/C[MD]|X[CL]|I[XV]|./g; $_<1?$s=$_:$n<$_||($r.=$s,$n-=$_,redo)for@a; $_=$r

foo bar

176.45 carldr Tue Dec 26 05:27:04 2006
-p for($i=4e3;$j=--$i;){for$y(3,2,1,0){map{$e=$m[$i].=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I)[-3+$f++%16]x($j/($u=$_*10**$y));$j%=$u}(9,5,4,1)}s/\b$e/$i/g}y/pma-z/+-/d;$_="$m[eval] "

176.52 grizzley Thu Dec 28 22:47:16 2006
-pl sub f{s/[-+]\d/$&0/g;s/C(?=[MD])/-1/g;s/M/DD/g;s/D/+5/g;y/XCVLpIx/CMLDIX/} y/mpi-u/-+ /;s/\w+/($&)/g;f;f;f;s/M/+1/g;$_=eval; f,s/IIII/IV/,s/IVI/V/while s/\d/$&-9?p x$&:px/e

little better - still leave some newlines

176.58 Honza Pazdziora Sun Dec 31 13:13:59 2006
-p while(M1000CM900D500CD400C100XC90L50XL40X10IX9V5IV4I1=~/(\D+)(\d+)/g){$a.='|'.($x=1x$2);$R{$x}=$m=$1;1while s!(\b|1)$m!$1$x!}1while s!^(1+) plus |(1+)\D+\2!$1!;s!$a!$R{$&}!g

176.59 m.wrenn Mon Jan 1 00:25:53 2007
-lp @A{@A=map{$_,$_.0,$_*100}4,9,10,5}=qw(IV XL CD IX XC CM X C M V L D);for$k(@A){s/$A{$k}/7x$k/ge}y/7/I/;s/I//while s/n\S* I/n /;y/I//cd;$m=2e3;s/I{$m}/$A{$m}||$&/gewhile--$m

That T-shirt was quickly snatched from my grasp ... The champagne must wait!

178.45 carldr Tue Dec 26 04:59:41 2006
-p for($i=4e3;$j=--$i;){for$y(3,2,1,0){for$d(9,5,4,1){$e=$m[$i].=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I)[-3+$f++%16]x($j/($u=$d*10**$y));$j%=$u}}s/\b$e/$i/g}y/pma-z/+-/d;$_="$m[eval] "

A 1-byte shorter, non-packed version.

178.51 `/anick Sun Dec 31 16:09:37 2006
-lp040 $y=a1I5V10X50L100C500D1000M4IV9IX40XL90XC400CD900CM;$s=/m/ if/u/;$y=~/\d+$&/,$i=$t+=$s^("$p">($p=$&))?-$&:$&while s/.$//}{1while$y=~/$i(\D+)/&&$t>=$&?($_.=$1,$t-=$i):$i--

178.52 Lester/Krawczyk Tue Jan 2 06:47:06 2007
-lpa sub e{$z=I x$t;/\d+/,eval"\$z=~s/$`$`\{$&\}/$'/g"for I9X,X9C,C9M,C8CM,C4D,C3CD,X8XC,X4L,X3XL,I8IX,I4V,I3IV;$z}for$t(1..4e3,0){$x{&e}=$t}$t+=($.=/p/-/n/||$.)*$x{$_}for@F;$_=e

Those pesky 10s are really just 9s that need to be incremented.

179.48 SubStack Thu Dec 28 01:35:39 2006
-lp @q{@s=MCMDCDCXCLXLXIXVIV=~/(.)(..)/g}=map{I x($_*(100,10,1)[$@++/4])}(10,9,5,4)x3;$"="|";1 while s/@s|[\0linus ]/$q{$&}/eg+s/p|(I+)m(I+)/$1^$2/e;s/@q{@s}/+{reverse%q}->{$&}/eg

map!

180.51 carldr Sun Dec 24 13:03:46 2006
-p for($i=4e3;$j=--$i;){for$d(1000,900,500,400,100,90,50,40,10,9,5,4,1){$e=$m[$i].=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I)[$f++%13]x($j/$d);$j%=$d}s/\b$e/$i/g}y/pma-z/+-/d;$_="$m[eval] "

180.53 Lester/Krawczyk Mon Jan 1 20:24:29 2007
-lpa sub e{$z=I x$t;/\d+/,eval"\$z=~s/$`\{$&\}/$'/g"for I10X,X10C,C10M,C9CM,C5D,C4CD,X9XC,X5L,X4XL,I9IX,I5V,I4IV;$z}for$t(1..4e3,0){$x{&e}=$t} $t+=($.=/p/-/n/||$.)*$x{$_}for@F;$_=e

Pete and I are putting our heads together, so you can knock out our previous entries.

180.57 m.wrenn Sat Dec 30 20:23:26 2006
-lp @A{@A=((map{$_,$_.0,$_*100}4,9,10,5),1)}=qw(IV XL CD IX XC CM X C M V L D I);for$k(@A){s/$A{$k}/7x$k/ge}s/7//while s/n\S* 7/n /;s/\D//g;for$k(sort{$b<=>$a}@A){s/7{$k}/$A{$k}/g}

Just keep it moving ...

181.53 `/anick Sun Dec 31 06:06:19 2006
-lp040 $y=a1I5V10X50L100C500D1000M4IV9IX40XL90XC400CD900CM;$s=n gt$_ if/u/;$y=~/\d+$&/,$i=$t+=$s^("$p">($p=$&))?-$&:$&while s/.$//}{1while$y=~/$i(\D+)/&&$t>=$&?($_.=$1,$t-=$i):$i--

181.55 m.wrenn Sat Dec 30 06:00:04 2006
-lp @A{@A=((map{$_,$_.0,$_*100}4,9,10,5),1)}=qw(IV XL CD IX XC CM X C M V L D I);y/ispmlun/-())+ /;for$k(@A){s/$A{$k}/+$k/g}$_=7x eval"($_)";for$k(sort{$b<=>$a}@A){s/7{$k}/$A{$k}/g}

Just one stroke, but I need to protect my T-shirt!

181.57 Honza Pazdziora Sun Dec 31 11:52:33 2006
-p $"='|';while(M1000CM900D500CD400C100XC90L50XL40X10IX9V5IV4I1=~/(\D+)(\d+)/g){push@a,$r{$R{1x$2}=$1}=1x$2;push@l,$1;}s!@l!$r{$&}!g;1while s!^(1+) plus |(1+)\D+\2!$1!;s!@a!$R{$&}!g

182.38 Jasper Thu Dec 28 01:20:20 2006
-lp %r=@d=map{$a.=I;for$n(IVX,XLC,CDM){($i,$v,$x)=$n=~/./g;$a=~s/($v)?$i{4}/$i.($1?$x:$v)/e;$a=~s/$i($v|$x)$i/$1/g}$a,$_}1..3999;s/(m)?\w+/$1?'-':'+'.($r{$&}+0)/eg;$_=$d[-2+2*eval$_]

182.42 pengvado Mon Jan 1 07:32:13 2007
-alp use utf8;y/IVXLCDM/^A^E 2d\xc7\xb4\xcf\xa8/,$%=/s/?/m/:s/./$:+=("$&\xcf\xbf"lt$'^$%||-1)*ord$&/sgefor@F;$,=(($^=1+chop$:)%5?"":$_).($^>4&&int$_+$^/5).$_ x($^%5-1).$,for 0,2,4,6;$_=$,;y/0-6/IVXLCDM/

182.50 carldr Sun Dec 24 13:00:50 2006
-p for($i=4e3;$j=--$i;){for$d(1000,900,500,400,100,90,50,40,10,9,5,4,1){$e=$m[$i].=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I)[$f++%13]x($j/$d);$j%=$d}s/\b$e\b/$i/g}y/pma-z/+-/d;$_="$m[eval] "

182.50 carldr Sun Dec 24 13:03:33 2006
-p for($i=4e3;$j=--$i;){for$d(1000,900,500,400,100,90,50,40,10,9,5,4,1){$e=$m[$i].=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I)[$f++%13]x($j/$d);$j%=$d}s/\b$e\b/$i/g}y/pma-z/+-/d;$_="$m[eval] "

182.52 `/anick Sun Dec 31 05:57:52 2006
-lp040 $y=a1I5V10X50L100C500D1000M4IV9IX40XL90XC400CD900CM;$s=n gt$&if/m|p/;$y=~/\d+$&/,$i=$t+=$s^("$p">($p=$&))?-$&:$&while s/.$//}{1while$y=~/$i(\D+)/&&$t>=$&?($_.=$1,$t-=$i):$i--

182.55 m.wrenn Fri Dec 29 22:47:13 2006
-lp @A{@A=((map{$_,$_*10,$_*100}4,9,10,5),1)}=qw(IV XL CD IX XC CM X C M V L D I);for$k(@A){s/$A{$k}/+$k/g}y/ispmlun/-())+ /;$_=7x eval"($_)";for$k(sort{$b<=>$a}@A){s/7{$k}/$A{$k}/g}

Still T-shirt capable ...

183.50 pijll Sat Dec 30 15:29:08 2006
-lp @r{@r=('',I,II,III,IV,V,VI,VII,VIII,IX)}=0..9;y/pma-z/+-/d;s#\w+#$_=$&;my$s;s/[VI].*|$//,$s=$r{$&}.$s,y/XLCDM/IVXLC/while$_;$s#ge;$g=~y/IVXLC/XLCDM/,$g.=$r[$_]for eval=~/./g;$_=$g

183.51 carldr Sun Dec 24 12:57:14 2006
-p for($i=4000;$j=--$i;){for$d(1000,900,500,400,100,90,50,40,10,9,5,4,1){$e=$m[$i].=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I)[$f++%13]x($j/$d);$j%=$d}s/\b$e\b/$i/g}y/pma-z/+-/d;$_="$m[eval] "

183.51 `/anick Sun Dec 31 05:54:24 2006
-lp040 $y=a1I5V10X50L100C500D1000M4IV9IX40XL90XC400CD900CM;$s=n gt$&if/m|p/;$y=~/\d+$&/,$i=$t+=$s^("$p">($p=$&))?-$&:$&while s/.$//}{$y=~/$i(\D+)/&&$t>=$&?($_.=$1,$t-=$i):$i--while$i

183.55 m.wrenn Fri Dec 29 15:50:31 2006
-lp @A{@A=((map{$_,$_*10,$_*100}4,9,10,5),1)}=qw(IV XL CD IX XC CM X C M V L D I);for$k(@A){s/$A{$k}/+$k/g}y/ispmlun/-())+ /;$_=I x eval"($_)";for$k(sort{$b<=>$a}@A){s/I{$k}/$A{$k}/g}

Creeping into the money makes me wonder if the Fonality T-shirts are available on Amazon ... I'm sure the game will heat up and I will struggle on!

185.52 Shlomi Fish Tue Dec 26 16:35:10 2006
-lp sub f{split//;my$s;map{$s=join"",(/./g)[($k=pop)%5<4?($k>4||(),(0)x($k%5)):(0,($k+1)/5)],$s}qw(IVX XLC CDM M);$s}s!minus!-!g;s!plus!+!g;s!\w+!(grep$&eq f,1..3999)[0]!ge;$_=eval;$_=f

186.44 davidrw Fri Dec 29 04:55:17 2006
-lp @V{@I=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I)}=unpack w13,'\x87h\x87^D\x83t\x83^PdZ2( ^E^D^A';y/i-u/-+/s;s/\w+/($&)/g;s/C[MD]|X[CL]|I[VX]|\w/+$V{$&}/g;$d=$_=eval;for(@I){$#.=$_,$d-=$/while$d>=($/=$V{$_})}

186.48 Andy Lester Mon Jan 1 07:02:44 2007
-pla %n=I1V5X10L50C100D500M1000=~/(.)(\d+)/g;sub d{$#_-=$z*2*(@_&&$z<$_)-($z=$_)for@n{/./g};@_}$t+=($.=/p/-/n/||$.)*d for@F;map{$s.=$_ x($t/d),$t%=d}M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I;$_=$s

Changed a for() to a map

187.43 Daniel Tuijnman Wed Dec 27 20:05:56 2006
-pl y/IVXLCDMpma-z/1-7+-/d;s/\d+/($&)/g;s#\d(?=(.))#($1>$&?"-":"+").10**($&>>1)/(2-$&%2)#ge;$_=eval;s#.#substr"IVIIIXLXXXCDCCCMMMMM",$&/5+2*($&<4)+3*($&>8)+5*length$',($&%4||$&/2)+$&/9#ge

187.49 Andy Lester Mon Jan 1 06:14:52 2007
-pla %n=I1V5X10L50C100D500M1000=~/(.)(\d+)/g;sub d{$#_-=$z*2*(@_&&$z<$_)-($z=$_)for@n{/./g};@_}$t+=($.=/p/-/n/||$.)*d for@F;$s.=$_ x($t/d),$t%=d for(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I);$_=$s

188.55 Sec Sun Dec 31 20:37:30 2006
-l %r=map {$a="";s/./y!IVCXL91-80!XLMCDXVIII!d for $a.=4x$&%1859^7/eg; ($a,++$b,$b,$a) }1..4e3; #for (keys %r){ print "$_ => $r{$_}"; }; $_=<>; y/pm/+-/; s/\w+/$r{$&}/ge; print $r{eval$_};

First try at optimizing.

189.44 alankila Wed Dec 27 22:58:03 2006
-pliIV4IX9XL40XC90CD400CM900I1V5X10L50C100D500M1000 $^I=~s!\D+!$={$==+$'}=$&;s/$&/+$=/g!ge;y/ipul-s/-)(+)/d;$_=eval"($_)";$==10**y///c;s!.!$={$&*($=/=10)}||($&>5&&$={5*$=}).$={$=}x($&%5)!ge

Beat Jasper & Substack for now!

189.50 carldr Sun Dec 24 12:55:46 2006
-p @r=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I);for($i=4000;$j=--$i;){for$d(1000,900,500,400,100,90,50,40,10,9,5,4,1){$e=$m[$i].=$r[$f++%13]x($j/$d);$j%=$d}s/\b$e\b/$i/g}y/pma-z/+-/d;$_="$m[eval] "

189.50 carldr Sun Dec 24 12:56:54 2006
-p @r=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I);for($i=4000;$j=--$i;){for$d(1000,900,500,400,100,90,50,40,10,9,5,4,1){$e=$m[$i].=$r[$f++%13]x($j/$d);$j%=$d}s/\b$e\b/$i/g}y/pma-z/+-/d;$_="$m[eval] "

189.50 Jasper Wed Dec 27 15:04:37 2006
-lp @r{@a=IVXLCDM=~/./g}=($m=1,5,10,50,100,500,1e3);$t+=($r{$a}<$m^/n[^p]+$/?-1:1)*($m=$r{$a})while$a=chop;s/^/('',1,11,111,13,3,31,311,3111,15)[chop$t]/e,eval"y/1-9/@a/",@a=@a[2..9]while$t

189.52 SubStack Wed Dec 27 10:16:04 2006
-lp $q{$_}=I x(1000,900,500,400,100,90,50,40,10,9,5,4)[$c++]for@s=MCMDCDCXCLXLXIXVIV=~/(.)(..)/g;$"="|";1 while s/@s|[\0linus ]/$q{$&}/g+s/p|(I+)m(I+)/$1^$2/e;s/@q{@s}/+{reverse%q}->{$&}/eg

linus!

189.52 `/anick Sun Dec 31 05:50:34 2006
-ln040 $y=a1I5V10X50L100C500D1000M4IV9IX40XL90XC400CD900CM;$s=n gt$&if/m|p/;$y=~/\d+$&/,$i=$t+=$s^("$p">($p=$&))?-$&:$&while s/.$//}{$y=~/$i(\D+)/&&$t>=$&?($_.=$1,$t-=$i):$i--while$i;print

190.44 davidrw Thu Dec 28 17:43:46 2006
-lp @h{@A=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I)}=unpack w13,'\x87h\x87^D\x83t\x83^PdZ2( ^E^D^A';y/l-u//d;s/i.(\S+)/-($1)/g;s/C[MD]|X[CL]|I[VX]|\w/+$h{$&}/g;$d=$_=eval;for(@A){$#.=$_,$d=$!while($!=$d-$h{$_})>=0}

190.58 m.wrenn Fri Dec 29 05:12:52 2006
-lp @A{@A=(4,9,40,90,400,900,1,5,10,50,100,500,1e3)}=qw(IV IX XL XC CD CM I V X L C D M);for$k(@A){s/$A{$k}/+$k/g}y/ipmslun/-))(+ /;$_=I x eval"($_)";for$k(sort{$b<=>$a}@A){s/I{$k}/$A{$k}/g}

So which logo looks better, Fonality or Trixbox?
equal coolness on the logo.

191.49 pijll Sat Dec 30 15:12:06 2006
-lp @r{@r=('',I,II,III,IV,V,VI,VII,VIII,IX)}=0..9;y/pma-z/+-/d;s#\w+#$x=$&;my$s;$x=~s/[VI].*|$//,$s=$r{$&}.$s,$x=~y/XLCDM/IVXLC/while$x;$s#ge;$g=~y/IVXLC/XLCDM/,$g.=$r[$_]for eval=~/./g;$_=$g

192.50 Andy Lester Sat Dec 30 07:22:13 2006
-pla %n=I1V5X10L50C100D500M1000=~/(.)(\d+)/g;sub d{my$a;$a-=$z*2*($z<$_)-($z=$_)for@n{/./g};$a}$t+=($.=/p/-/n/||$.)*d for@F;map{while($t>=d){$t-=d;$s.=$_}}M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I;$_=$s

Hooray for hash slices!

194.49 SubStack Tue Dec 26 04:17:55 2006
-lp $q{$_}=(1000,900,500,400,100,90,50,40,10,9,5,4)[$i++]for@r=MCMDCDCXCLXLXIXVIV=~/(.)(..)/g;$"="|";s/@r/I x$q{$&}/eg;1 while s/\0| p.{4}|(I+) m.{5}(I+)/$1^$2/e;for$@(@r){s/@{[I x$q{$@}]}/$@/g}

combined hash and array creation for double plus goodness

195.49 Venky Iyer Sun Dec 31 23:35:54 2006
-pla @v=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I,10,9,5,4);sub R{$s=1x$_[0];map{$A=$v[13+$_%4]*10**(2-int$_/4);$s=~s/1{$A}/$v[$_]/g}0..12;$s}@s=map{/m/?'-':/p/?'+':grep{$' eq R$_}//..4e3}@F;$_=R eval"@s"

196.46 alankila Wed Dec 27 22:34:25 2006
-pliIV4IX9XL40XC90CD400CM900I1V5X10L50C100D500M1000 $^I=~s!(\D+)(\d+)!$={$==$2}=$1;s/$1/+$=/g!ge;y/implusn/-))+(/d;$_=eval"($_)";$==10**y///c;s!.!$={$&*($=/=10)}||($&>5&&$={5*$=}).$={$=}x($&%5)!ge

Improved initial setup

196.49 Andy Lester Thu Dec 28 23:29:10 2006
-pla %n=I1V5X10L50C100D500M1000=~/(.)(\d+)/g;sub d{my$a;$a-=$z*2*($z<$n{$_})-($z=$n{$_})for/./g;$a}$t+=($.=/p/-/n/||$.)*d for@F;map{while($t>=d){$t-=d;$s.=$_}}M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I;$_=$s

196.49 Venky Iyer Sun Dec 31 13:27:37 2006
-pla @v=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I,10,9,5,4);sub r{$s=I x$_[0];map{$A=$v[13+$_%4]*10**(2-int$_/4),$s=~s/I{$A}/$v[$_]/g}0..12;$s}@s=map{/m/?'-':/p/?'+':grep{$' eq r$_}//..4e3}@F;$_=r eval"@s"

197.48 Andy Lester Thu Dec 28 20:20:18 2006
-pla %n=I1V5X10L50C100D500M1000=~/(.)(\d+)/g;sub d{$a=0;$a-=$z*2*($z<$n{$_})-($z=$n{$_})for/./g;$a}$t+=$.*d,$.=/p/-/n/||$. for@F;map{while($t>=d){$t-=d;$s.=$_}}M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I;$_=$s

197.49 carldr Sun Dec 24 12:42:29 2006
-p @n=(1000,900,500,400,100,90,50,40,10,9,5,4,1);@r=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I);for($i=4000;$j=--$i;){for$d(@n){$e=$m[$i].=$r[$f++%13]x($j/$d);$j%=$d}s/\b$e\b/$i/g}y/pma-z/+-/d;$_="$m[eval] "

198.49 carldr Sun Dec 24 12:40:46 2006
-p @n=(1000,900,500,400,100,90,50,40,10,9,5,4,1);@r=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I);for($i=4000;$j=--$i;){for$d(@n){$m[$i].=$r[$f++%13]x($j/$d);$j%=$d}s/\b$m[$i]\b/$i/g}y/pma-z/+-/d;$_="$m[eval] "

200.40 Daniel Tuijnman Wed Dec 27 19:55:29 2006
-pl y/IVXLCDMpma-z/1-7+-/d;s/\d+/($&)/g;s#\d(?=(.))#($1>$&?"-":"+").10**($&>>1)/(2-$&%2)#ge;$_=eval;s#.#($@=length$')>2?"M"x$&:substr"IVIIIXLXXXCDCCCM",5*$@+$&/5+2*($&<4)+3*($&>8),($&%4||$&/2)+$&/9#ge

200.59 Shlomi Fish Tue Dec 26 13:49:34 2006
-lp sub f{split//;my$s;for(0..3){$d=("",qw(0 00 000 01 1 10 100 1000 02))[pop];$d=~s/\d/(qw(I V X L C D M))[$_*2+$&]/ge;$s=$d.$s}$s}s!minus!-!g;s!plus!+!g;s!\w+!(grep$&eq f,1..3999)[0]!ge;$_=eval;$_=f

201.50 Venky Iyer Sun Dec 31 09:43:11 2006
-pla @v=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I,10,9,5,4);sub r{$s=I x$_[0];map{$A=$v[13+$_%4]*10**(2-int$_/4);$s=~s/I{$A}/$v[$_]/g}0..12;$s}@s=map{$z=$_;/p/?'+':/m/?'-':grep{$z eq r$_}1..4e3}@F;$_=r eval"@s"

202.39 Daniel Tuijnman Wed Dec 27 19:41:17 2006
-pl y/IVXLCDMpma-z/1-7+-/d;s/\d+/($&)/g;s#\d(?=(.))#($1>$&?"-":"+").10**($&>>1)/(2-$&%2)#ge;$_=eval;s#.#($@=length$')>2?"M"x$&:substr"IVIIIXLXXXCDCCCM",5*$@+($&>4)+2*($&<4)+3*($&>8),($&%4||$&/2)+$&/9#ge

202.47 Andy Lester Mon Dec 25 21:15:37 2006
-pla %n=(I,1,V,5,X,10,L,50,C,100,D,500,M,1E3);sub d{$a=0;$a-=$z*2*($z<$n{$_})-($z=$n{$_})for/./g,0;$a}/p|n/?$.=/p/-/n/:$t+=$.*d for@F;map{while($t>=d){$t-=d;$s.=$_}}M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I;$_=$s

202.47: General pruning. It's amazing what you can scrape away.

203.40 DWilson Sun Dec 31 09:14:14 2006
-alpF// @r{@r=IVXLCDM=~/./g}=grep/^[15]0*$/,1..1e3;/m|p/&&($c=/m/),$b+=$r{$_}*($c^$r{$_}<$r{$F[++$d]}?-1:1)for@F;$_=I x$b;{map$$_=$r[$i++],b..d;s/$b{5}/$c/g;s/$b{4}/$b$c/;s/$c($b?)$c/$1$d/g;$i--<6&&redo}

203.50 pijll Sat Dec 30 13:50:02 2006
-lp @r{@r=('',I,II,III,IV,V,VI,VII,VIII,IX)}=0..9;s/plus/+/g;s/minus/-/g;s#\w+#$x=$&;my$s;$x=~s/[VI].*|$//,$s=$r{$&}.$s,$x=~tr/XLCDM/IVXLC/while$x;$s#ge;$x=~tr/IVXLC/XLCDM/,$x.=$r[$_]for eval=~/./g;$_=$x

In the prizes, but this can't be shortened much more...

204.39 DWilson Sun Dec 31 08:47:57 2006
-lp @r{@r=IVXLCDM=~/./g}=grep/^[15]0*$/,1..1e3;/m|p/&&($c=/m/),$b+=$r{$_}*($c^$r{$_}<$r{$k[++$d]}?-1:1)for@k=/./g;$_=I x$b;{map$$_=$r[$i++],b..d;s/$b{5}/$c/g;s/$b{4}/$b$c/;s/$c($b?)$c/$1$d/g;$i--<6&&redo}

204.47 davidrw Thu Dec 28 16:33:41 2006
-lp @h{@A=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I)}=(1e3,900,500,400,100,90,50,40,10,9,5,4,1);y/ma-z/-/d;s/-.(\S+)/-($1)/g;s/C[MD]|X[CL]|I[VX]|\w/+$h{$&}/g;$d=$_=eval;for(@A){$d-=$h{$_},$#.=$_ while$d-$h{$_}>=0}

204.53 Venky Iyer Wed Dec 27 08:32:24 2006
-pl %v=(I,1,IV,4,V,5,IX,9,X,10,XL,40,L,50,XC,90,C,100,CD,400,D,500,CM,900,M,1e3);$_="($_)";y/plumi/)+()-/d;s/IV|IX|XL|XC|CD|CM|\w/+$v{$&}/g;$_=I x eval;for$x(sort{$v{$b}<=>$v{$a}}keys%v){s/I{$v{$x}}/$x/g}

204.53 `/anick Sun Dec 31 00:38:33 2006
-ln040 %u=reverse%v=I1IV4V5IX9X10XL40L50XC90C100D500CD400CM900M1000=~/\d+|\D+/g;$i=$t+=$s^($p>($;=$v{$&}))?-$;:$;,$p=$;,s/m|p/$s=n gt$&/ewhile s/.$//}{$u{$i}&&$t>=$i?($_.=$u{$i},$t-=$i):$i--while$i;print

204.57 m.wrenn Fri Dec 29 04:42:07 2006
$_=<>;@A{@A=(4,9,40,90,400,900,1,5,10,50,100,500,1000)}=qw(IV IX XL XC CD CM I V X L C D M);for$k(@A){s/$A{$k}/+$k/g}y/ipmslun/-))(+ /;$k="I"x eval"($_)";$k=~s/I{$_}/$A{$_}/gfor sort{$b<=>$a}@A;print"$k "

Do the T-Shirts mention Perl Golf?

205.48 carldr Sun Dec 24 12:31:10 2006
-p @n=(1000,900,500,400,100,90,50,40,10,9,5,4,1);@r=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I);for($i=4000;$j=--$i;){$f=0;for$d(@n){$m[$i].=$r[$f++]x($j/$d);$j%=$d}s/\b$m[$i]\b/$i/g}y/pm/+-/;y/a-z//d;$_="$m[eval] "

206.39 DWilson Sat Dec 30 12:22:56 2006
-lp @r{@r=IVXLCDM=~/./g}=grep/^[15]0*$/,1..1e3;/m|p/&&($c=/m/),$b+=$r{$_}*($c^$r{$_}<$r{$k[++$d]}?-1:1)for@k=/./g;$_=I x$b;for$e(0,2,4){($b,$c,$d)=@r[$e..$e+2];s/$b{5}/$c/g;s/$b{4}/$b$c/;s/$c($b?)$c/$1$d/g}

206.46 sgifford Tue Jan 2 07:33:03 2007
-lp sub g{s/\d/$_[-$&]/ge for my@l=(1,11,111,12,2,21,211,2111,13);$#_-=2;@_&&(@l,map{my$y=$_;map{$y.$_}('',@l)}&g);}@A=('',g(K,G,M,D,C,L,X,V,I));tr/pm/+\-/;s/\w+/(grep{$A[$_]eq$&}(0..@A))[0]/ge;$_=$A[eval];

206.50 davidrw Thu Dec 28 00:36:01 2006
-lp @h{@A=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I)}=(1e3,900,500,400,100,90,50,40,10,9,5,4,1);y/ma-z/-/d;s/- (\S+)/-($1)/g;s/CM|CD|XC|XL|IX|IV|\w/+$h{$&}/g;$d=eval;for(@A){$d-=$h{$_},$s.=$_ while$d-$h{$_}>=0}$_=$s

206.53 `/anick Sun Dec 31 00:27:51 2006
-ln040 %u=reverse%v="I1IV4V5IX9X10XL40L50XC90C100D500CD400CM900M1000"=~/\d+|\D+/g;$i=$t+=$s^($p>($;=$v{$&}))?-$;:$;,$p=$;,s/m|p/$s=n gt$&/ewhile s/.$//}{$u{$i}&&$t>=$i?($_.=$u{$i},$t-=$i):$i--while$i;print

206.54 grizzley Thu Dec 28 15:54:58 2006
-pl y/mpinlus/-+ /;s/[A-Z]+/($&)/g; $x='s/C(?=[MD])/-1$r/g,s/M/DD/g,s/D/+5$r/g';for$r('00',0,''){eval$x;$x=~y/MDCLX/CLXVI/} s/I/+1/g; $_=eval; y/XCVLpIx/CMLDIX/,s/IIII/IV/,s/IVI/V/while s/\d/$&-9?p x$&:px/e

golfman, the beginning

206.59 explorer Mon Jan 1 04:02:09 2007
-lp %r=@r='M1000CM900D500CD400C100XC90L50XL40X10IX9V5IV4I1'=~/(\D+)(\d+)/g;$"=1;map{$"=/p/?1:/m/?-1:s/CM|CD|XC|XL|IX|IV|\w/$?+=$"*$r{$&}/ge}split;$?=~s/./y!IVCXL91-I0!XLMCDXVIII!dfor$a.=4x$&%1859^7/eg;$_=$a

207.47 carldr Sun Dec 24 12:26:48 2006
-p @n=(1000,900,500,400,100,90,50,40,10,9,5,4,1);@r=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I);for($i=4000;$j=--$i;){$f=0;for$d(@n){$m[$i].=$r[$f++]x($j/$d);$j%=$d}s/\b$m[$i]\b/$i/g}y/pm/+-/;s/[a-z]//g;$_="$m[eval] "

208.38 DWilson Sat Dec 30 11:26:26 2006
-lp @r{@r=IVXLCDM=~/./g}=map{$e=10**$_,5*$e}0..3;/m|p/&&($c=/m/),$b+=$r{$_}*($c^$r{$_}<$r{$k[++$d]}?-1:1)for@k=/./g;$_=I x$b;for$e(0,2,4){($b,$c,$d)=@r[$e..$e+2];s/$b{5}/$c/g;s/$b{4}/$b$c/;s/$c($b?)$c/$1$d/g}

208.45 Jasper Wed Dec 27 14:17:55 2006
-lp @r{@a=IVXLCDM=~/./g}=($m=1,5,10,50,100,500,1000);$t+=($r{$a}<$m^/n[^p]+$/?-1:1)*($m=$r{$a})while$a=chop;while($t=~s/.$//){$k=('',1,11,111,13,3,31,311,3111,15)[$&];eval"\$k=~y/1-9/@a/";@a=@a[2..9];s/^/$k/}

208.47 alankila Wed Dec 27 14:45:03 2006
-pl %==reverse%+=split/(\d+)/,$@=IV4IX9XL40XC90CD400CM900I1V5X10L50C100D500M1000;$@=~s!\D+!s/$&/+$+{$&}/g!ge;y/implusn/-))+(/d;$_=eval"($_)";$==10**y///c;s!.!$={$&*($=/=10)}||($&>5&&$={5*$=}).$={$=}x($&%5)!ge

Better y trick!

209.38 alankila Sat Dec 30 10:40:41 2006
-lp @r{@r=IVXLCDM=~/./g}=map{$j=10**$_,5*$j}0..3;/m|p/&&($c=/m/),$r+=$r{$_}*($c^$r{$_}<$r{$d[++$i]}?-1:1)for@d=/./g;$_="I"x$r;for$j(0,2,4){($b,$c,$d)=@r[$j..$j+2];s/$b{5}/$c/g;s/$b{4}/$b$c/;s/$c($b?)$c/$1$d/g}

209.48 carldr Sun Dec 24 12:18:20 2006
-p @n=(1000,900,500,400,100,90,50,40,10,9,5,4,1);@r=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I);for($i=4000;$j=--$i;){$f=0;for$d(@n){$m[$i].=$r[$f++]x($j/$d);$j%=$d}s/\b$m[$i]\b/$i/g}s/plus/+/g;s/m\S+/-/g;$_="$m[eval] "

210.48 Andy Lester Mon Dec 25 04:17:04 2006
-pla %n=(I,1,V,5,X,10,L,50,C,100,D,500,M,1E3);sub d{$z=$a=0;$a-=$z*2*($z<$n{$_})-($z=$n{$_})for/./g;$a} /p|n/?$.=/p/-/n/:$t+=$.*d for@F;map{while($t>=d){$t-=d;$s.=$_}}M,IM,CM,D,ID,CD,C,XC,L,XL,X,IX,V,IV,I;$_=$s

Still more random twiddling. Rewrote the plus/minus detection.

210.50 carldr Sun Dec 24 12:15:20 2006
-p @n=(1000,900,500,400,100,90,50,40,10,9,5,4,1);@r=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I);for($i=4000;$j=--$i;){$f=0;for$d(@n){$m[$i].=$r[$f++]x($j/$d);$j%=$d}s/\b$m[$i]\b/$i/g}s/plus/+/g;s/minus/-/g;$_="$m[eval] "

210.57 SubStack Tue Dec 26 03:03:31 2006
-lp %q=V5X10L50C100D500M1000IV4IX9XL40XC90CD400CM900=~/(.+?)(\d+)/g;@r=MCMDCDCXCLXLXIXVIV=~/(.)(..)/g;$"="|";s/@r/I x$q{$&}/eg;y/\0//d while s/ p.{4}|(I+) m.{5}(I+)/$1^$2/e;s/@{[I x$q{$@=shift@r}]}/$@/g while@r

major restructuring, catching up!

211.39 DWilson Sat Dec 30 10:17:04 2006
-lp @r{@r=IVXLCDM=~/./g}=map{$j=10**$_,5*$j}0..3;for(@d=/./g){$c=/m/ if/m|p/;$r+=$r{$_}*($c^$r{$_}<$r{$d[++$i]}?-1:1)}$_="I"x$r;for$j(0,2,4){($b,$c,$d)=@r[$j..$j+2];s/$b{5}/$c/g;s/$b{4}/$b$c/;s/$c($b?)$c/$1$d/g}

211.60 grizzley Fri Dec 29 12:27:49 2006
-pl $s.="sg/_/$_/gs;"for DCD,DD,CCCC,CCCCC,LXL,LL,XXXX,XXXXX,VIV,VV,IIII,IIIII; $s.='$1&&s/$2$2//while s/ (m?)\w+ (I+)/$2/;'.reverse$s; $s=~s/_(.*)_/$_$1$_/sfor CM,M,CD,D,XC,C,XL,L,IX,X,IV,V; $s=~s/sg/s/g;eval$s

Worse score, but good starting point for golfing another algorithm. Print $s to see how it works

212.56 carldr Sun Dec 24 12:13:39 2006
-p @n=(1000,900,500,400,100,90,50,40,10,9,5,4,1);@r=qw(M CM D CD C XC L XL X IX V IV I);for($i=4000;$j=--$i;){$f=0;for$d(@n){$m[$i].=$r[$f++]x($j/$d);$j%=$d}s/\b$m[$i]\b/$i/g}s/plus/+/g;s/minus/-/g;$_="$m[eval] "

Slightly different method to previous submissions.

214.44 Jasper Wed Dec 27 13:53:12 2006
-lp @r{@a=IVXLCDM=~/./g}=(1,5,10,50,100,500,1000);$m=$"='';$t+=($r{$a}<$m^/n[^p]+$/?-1:1)*($m=$r{$a})while$a=chop;$m=7;while($t=~s/.$//){$k=('',7,77,777,78,8,87,877,8777,79)[$&];eval"\$k=~y/$m-9/@a/";$m-=2;s/^/$k/}

215.47 alankila Wed Dec 27 14:28:05 2006
-pl %==reverse%+=split/(\d+)/,$@=IV4IX9XL40XC90CD400CM900I1V5X10L50C100D500M1000;$@=~s!\D+!s/$&/+$+{$&}/g!ge;y/miplnus/-(+/d;s!\( \S*!$&)!g;$_=eval;$==10**y///c;s!.!$={$&*($=/=10)}||($&>5&&$={5*$=}).$={$=}x($&%5)!ge

more y tricks

215.47 explorer Sat Dec 30 03:14:56 2006
%r=@r='M1000CM900D500CD400C100XC90L50XL40X10IX9V5IV4I1'=~/(\D+)(\d+)/g;$"=1;$_=<>;for(map{$"=/p/?1:/m/?-1:s/CM|CD|XC|XL|IX|IV|\w/$?+=$"*$r{$&}/ge}split;$-<@r;$-+=2){$?-=$=,$,.=$r[$-]while$?>=($==$r[$-+1])}print$,.$/

216.50 pijll Sat Dec 30 13:14:36 2006
-ln @r=('',I,II,III,IV,V,VI,VII,VIII,IX);@r{@r}=0..9;s/plus/+/g;s/minus/-/g;s#\w+#$x=$&;my$s;while($x){$x=~s/[VI].*|$//;$s=$r{$&}.$s;$x=~tr/XLCDM/IVXLC/}$s#ge;$_=eval;for(/./g){$g=~tr/IVXLC/XLCDM/;$g.=$r[$_]}print $g

217.43 alankila Wed Dec 27 14:10:36 2006
-pl %==reverse%+=split/(\d+)/,$@=IV4IX9XL40XC90CD400CM900I1V5X10L50C100D500M1000;$@=~s!\D+!s/$&/+$+{$&}/g!ge;s/[pm]..(.)./)@{[$1^X]}(/g;$_=eval"($_)";$==10**y///c;s!.!$={$&*($=/=10)}||($&>5&&$={5*$=}).$={$=}x($&%5)!ge

Gain of 1 byte with y///c.

217.51 `/anick Sat Dec 30 22:55:08 2006
-lp %u=reverse%v="I1IV4V5IX9X10XL40L50XC90C100D500CD400CM900M1000"=~/\d+|\D+/g;map{$;=$v{$&},$t+=$s^($p>$;)?-$;:$;,$p=$;,/[mp]/&&($s=n gt$&)while s/.$//}split;($i,$_)=1E3;$u{$i}&&$t>=$i?($_.=$u{$i},$t-=$i):$i--while$i

218.40 DWilson Fri Dec 29 07:34:50 2006
-lp @r{@r=IVXLCDM=~/./g}=map{$i=10**$_,5*$i}0..3;for(split){$f=/m/ if/s/;$r+=$r{$&}*($f^$r{$&}<$r{$1}?-1:1)while/.(?=(.?))/g}$_="I"x$r;for$i(0,2,4){($t,$u,$v)=@r[$i..$i+2];s/$t{5}/$u/g;s/$t{4}/$t$u/;s/$u($t?)$u/$1$v/g}

218.45 alankila Wed Dec 27 11:59:10 2006
-pl s/[pm]..(.)./)@{[$1^X]}(/g;%==reverse%+=split/(\d+)/,$@=IV4IX9XL40XC90CD400CM900I1V5X10L50C100D500M1000;$@=~s!\D+!s/$&/+$+{$&}/g!ge;$_=eval"($_)";$==10**length;s!.!$={$&*($=/=10)}||($&>5&&$={5*$=}).$={$=}x($&%5)!ge

Don't need a variable, yay.

218.47 explorer Sat Dec 30 03:11:30 2006
%r=@r='M1000CM900D500CD400C100XC90L50XL40X10IX9V5IV4I1'=~/(\D+)(\d+)/g;$"=1;$_=<>;for(map{$"=/p/?1:/m/?-1:s/CM|CD|XC|XL|IX|IV|\w/$?+=$"*$r{$&}/ge}split;$-<@r;$-+=2){$?-=$=,$,.=$r[$-],redo if$?>=($==$r[$-+1])}print$,.$/

218.53 explorer Fri Dec 29 23:44:05 2006
%r=@r='M1000CM900D500CD400C100XC90L50XL40X10IX9V5IV4I1'=~/(\D+)(\d+)/g;$_=<>;$s=1;for(map{$s=/p/?1:/m/?-1:s/CM|CD|XC|XL|IX|IV|\w/$t+=$s*$r{$&}/ge}split;$i<@r;$i+=2){$t-=$c,$,.=$r[$i],redo if$t>=($c=$r[$i+1])}print$,.$/

220.52 explorer Fri Dec 29 23:31:49 2006
%r=@r=('M1000CM900D500CD400C100XC90L50XL40X10IX9V5IV4I1'=~/(\D+)(\d+)/g);$_=<>;$s=1;for(map{$s=/p/?1:/m/?-1:s/CM|CD|XC|XL|IX|IV|\w/$t+=$s*$r{$&}/ge}split;$i<@r;$i+=2){$t-=$c,$,.=$r[$i],redo if$t>=($c=$r[$i+1])}print$,.$/

221.45 alankila Wed Dec 27 11:15:56 2006
-pl s/[pm]..(.)./)@{[$1^X]}(/g;%==reverse%+=split/(\d+)/,$@=IV4IX9XL40XC90CD400CM900I1V5X10L50C100D500M1000;$@=~s!\D+!s/$&/+$+{$&}/g!ge;$_=eval"($_)";$==10**length;s!.!$={$v=$&*($=/=10)}||($&>5&&$={5*$=}).$={$=}x($&%5)!ge

New numeral generation -- shave off 4 chars

223.41 DWilson Fri Dec 29 07:04:57 2006
-lp @r{@r=IVXLCDM=~/./g}=map{$i=10**$_,5*$i}0..3;for(split){$f=/m/,next if/s/;$r+=$r{$&}*($f^$r{$&}<$r{$1}?-1:1)while/.(?=(.?))/g}$_="I"x$r;for$i(0,2,4){($t,$u,$v)=@r[$i..$i+2];s/$t{5}/$u/g;s/$t{4}/$t$u/;s/$u($t?)$u/$1$v/g}

224.59 Util Sun Dec 31 06:13:40 2006
-ln %r=@r=split/(\d+)/,'I1IV4V5IX9X10XL40L50XC90C100CD400D500CM900M1000';s/plus/+/g;s/m\S+ (\w+)/-($1)/g;s/C?[MD]|X?[CL]|I?[XV]|I/"+$r{$&}"/ge;$z=eval;Z:@ARGV=@r;for(1..13){$b=pop;$a=pop;$z-=$b,$e.=$a,goto Z if$z>=$b}print$e

225.41 DWilson Fri Dec 29 06:28:24 2006
-lp @r{@r=IVXLCDM=~/./g}=map{$i=10**$_,5*$i}0..3;for(split){$f=/m/,next if/m|p/;$r+=$r{$&}*($f^$r{$&}<$r{$1}?-1:1)while/.(?=(.?))/g}$_="I"x$r;for$i(0,2,4){($t,$u,$v)=@r[$i..$i+2];s/$t{5}/$u/g;s/$t{4}/$t$u/;s/$u($t?)$u/$1$v/g}

225.45 alankila Tue Dec 26 11:55:50 2006
-nl %==reverse%+=split/(\d+)/,$@=IV4IX9XL40XC90CD400CM900I1V5X10L50C100D500M1000;s/[pm]..(.)./)@{[$1^X]}(/g;$@=~s!\D+!s/$&/+$+{$&}/g!ge;$==eval"($_)";print+map$={$-*($~=$=/($-=$+{$_})%10)}||($~>5&&$={5*$-},$_ x($~%5)),M,C,X,I

A vast 0.07 stroke improvement. At least less than half of it is in readable chars now.

225.52 alankila Tue Dec 26 11:17:35 2006
-nl %x=reverse%c=split/(\d+)/,$t=IV4IX9XL40XC90CD400CM900I1V5X10L50C100D500M1000;s/[pm]..(.)./)@{[$1^X]}(/g;$t=~s!\D+!s/$&/+$c{$&}/g!ge;$r=eval"($_)";print+map$x{$n*($v=$r/($n=$c{$_})%10)}||($v>5&&$x{5*$n},$_ x($v%5)),M,C,X,I

Increasinly desperate tricks.

225.53 Tom Hargreaves Fri Dec 29 07:26:36 2006
-p @a='IVXLCDM'=~/./g;for$g(0,2,4){map{s/[012]/\$a[$&+$g]/g;eval"unshift\@b,[$_];push\@d,[reverse$_]"}@w=qw<1,0x5 0.1,0x4 2,1.1 0.2,1.0.1>}sub c{for$m(@_){s/$m->[0]/$m->[1]/g}}c@b;1while s/^(I+) plus /$1/+s/(I+) .{5} \1//;c@d

initial attempt

226.43 DWilson Fri Dec 29 04:21:36 2006
-lp @r{@r=IVXLCDM=~/./g}=(1,5,10,50,100,500,1000);for(split){$f=/m/,next if/m|p/;$r+=$r{$&}*($f^$r{$&}<$r{$1}?-1:1)while/.(?=(.?))/g}$_="I"x$r;for$i(0,2,4){($t,$u,$v)=@r[$i..$i+2];s/$t{5}/$u/g;s/$t{4}/$t$u/;s/$u($t?)$u/$1$v/g}

226.52 `/anick Sat Dec 30 22:35:24 2006
-lp %u=reverse%v="I1IV4V5IX9X10XL40L50XC90C100D500CD400CM900M1000"=~/\d+|\D+/g;map{$p=0or$s=n gt$&if s/[mp].*//;$;=$v{$&},$t+=$s^($p>$;)?-$;:$;,$p=$;while s/.$//}split;($i,$_)=1E3;$u{$i}&&$t>=$i?($_.=$u{$i},$t-=$i):$i--while$i

227.52 `/anick Sat Dec 30 22:26:20 2006
-lp %u=reverse%v="I1IV4V5IX9X10XL40L50XC90C100D500CD400CM900M1000"=~/\d+|\D+/g;for(split){$p=0or$s=n gt$&if s/[mp].*//;$;=$v{$&},$t+=$s^($p>$;)?-$;:$;,$p=$;while s/.$//}($i,$_)=1E3;$u{$i}&&$t>=$i?($_.=$u{$i},$t-=$i):$i--while$i

228.49 carldr Sat Dec 23 18:57:20 2006
-p %t=(1=>I,4=>IV,5=>V,9=>IX,10=>X,40=>XL,50=>L,90=>XC,100=>C,400=>CD,500=>D,900=>CM,1000=>M);for($i=4000;$j=--$i;){for$n(sort{$b<=>$a}keys%t){$m[$i].=$t{$n}x($j/$n);$j%=$n}s/\b$m[$i]\b/$i/g}s/plus/+/g;s/minus/-/g;$_="$m[eval] "

Fixed failing some of the tests.

229.52 Util Sat Dec 30 21:22:44 2006
-lp %r=@r=split/(\d+)/,'I1IV4V5IX9X10XL40L50XC90C100CD400D500CM900M1000';$s=1;s/(C?[MD]|X?[CL]|I?[XV]|I)(?{$z+=$s*$r{$^N}})| (p|m)(?{$s=$^N eq 'p'?1:-1})\S+ //g;Z:for($i=25;$i>0;$i-=2){$z-=$r[$i],$_.=$r[$i-1],goto Z if$z>=$r[$i]}

229.69 mjskier Sat Dec 30 20:34:41 2006
-lp %T=qw/I 1 IV 4 V 5 IX 9 X 10 XL 40 L 50 XC 90 C 100 CD 400 D 500 CM 900 M 1000 plus 0)+( minus 0)-(/;$P=join'|',sort{$T{$b}<=>$T{$a}}keys%T;s/$P/'+'.$T{$&}/eg;$_=eval"($_)";s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;5!eg

231.38 shmem Sun Dec 31 12:13:56 2006
-lp y/pma-z/+-/d;s/\w+/($&)/g;$c=.5;@l=IVXLCDM=~/./g;for$i(0..6){$c*=$i%2?5:2;s/$l[$i]([@l[$i+1,$i+2]])?/($1?'-':'+').$c.$1/eg}$_=I x eval;for$i(-1..4){$u=$i%2?5:2;($c,$d,$e)=@l[$i..6];s/($d){$u}/$e/g;s/($d)?$c{4}/$c.($1?$e:$d)/eg}

232.47 Jasper Wed Dec 27 03:01:23 2006
-lp @r{@a=IVXLCDM=~/./g}=(1,5,10,50,100,500,1000);$t=$m=0;$t+=($r{$&}<$m?-1:1)*($m=$r{$&})*(/nus \w*$/?-1:1)while s/.$//;$m=0;while($t=~s/.$//){$k=('',qw{0 00 000 01 1 10 100 1000 02})[$&];$k=~s/$_/$a[$_+$m]/gfor 0..2;$m+=2;s/^/$k/}

232.50 femto Sat Dec 30 19:38:50 2006
%H=@H='M1000CM900D500CD400C100XC90L50XL40X10IX9V5IV4I1'=~/(\D+)(\d+)/g;$_=<>;s/m\w+/-/g;s/p\w+/+/g;s/\w+/($&)/g;s/CM|CD|XC|XL|IX|IV/-$&/g;s/\w/"+$H{$&}"/ge;$n=eval;for(grep{/\D+/}@H){while($n>=$H{$_}){$s.=$_;$n-=$H{$_};}}print"$s\n"

use slightly terser (and more general, but safe due to restricted input) expressions, and a grep instead of sorting hash keys

232.53 alankila Tue Dec 26 10:38:21 2006
-nl %x=reverse%c=split/(\d+)/,$t=IV4IX9XL40XC90CD400CM900I1V5X10L50C100D500M1000;s/[i-u]+/$&gt n?'+':'-'/ge;s/\w+/($&)/g;$t=~s!\D+!s/$&/+$c{$&}/g!ge;$r=eval;print+map$x{$n*($v=$r/($n=$c{$_})%10)}||($v>5&&$x{5*$n},$_ x($v%5)),M,C,X,I

Final tweaks.

232.53 C_Is_Better Sat Dec 30 02:34:55 2006
-alp @v=(M1000,CM900,D500,CD400,C100,XC90,L50,XL40,X10,IX9,V5,IV4,I1);/(\D+)/;map{$n=$_,$i=0;$o=/p/?1:/m/?-1:$o;grep{s//$a+=($o||1)*$',$i+=$0while substr($n,$i,$0=length$1)eq$1/e}@w=@v}@F;grep{s//$z.=$1,$a-=$' while$a>=$'/e}@v;$_=$z

233.39 shmem Fri Dec 29 12:12:08 2006
-lp y/mplinus/-+/d;s/\w+/($&)/g;@l=IVXLCDM=~/./g;$c=.5;for$i(0..6){$c*=$i%2?5:2;s/$l[$i]([@l[$i+1,$i+2]])?/($1?'-':'+').$c.$1/eg}$_=I x eval;for$i(-1..4){$u=$i%2?5:2;($c,$d,$e)=@l[$i..6];s/($d){$u}/$e/g;s/($d)?$c{4}/$c.($1?$e:$d)/eg}

233.56 Util Sat Dec 30 06:44:43 2006
-lp %r=reverse@r=split/(\D+)/,'1000M900CM500D400CD100C90XC50L40XL10X9IX5V4IV1I';s/plus/+/g;s/m\S+ (\w+)/-($1)/g;s/(C?[MD]|X?[CL]|I?[XV]|I)/"+$r{$1}"/ge;$z=eval;$_='';Z:for$i(map$_*2,0..12){$z-=$r[$i],$_.=$r[$i+1],goto Z if$z>=$r[$i]}

234.50 Honza Pazdziora Sun Dec 31 11:00:03 2006
-p @l=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I); @n=(1000,900,500,400,100,90,50,40,10,9,5,4,1); for(0..13){ push@a,$r{$l[$_]}=$x=1x$n[$_]; $R{$x}=$l[$_]; } $"='|'; s!@l!$r{$&}!g; while(s!^(1+) plus !$1! or s!(1+) m\S+ \1!!){} s!@a!$R{$&}!g;

234.51 alankila Tue Dec 26 10:29:22 2006
-nl %x=reverse%c=($t=IV4IX9XL40XC90CD400CM900I1V5X10L50C100D500M1000)=~/\d+|\D+/g;s/[i-u]+/$&gt n?'+':'-'/ge;s/\w+/($&)/g;$t=~s!\D+!s/$&/+$c{$&}/g!ge;$r=eval;print+map{$x{($v=$r/($n=$c{$_})%10)*$n}||($v>5&&$x{5*$n},$_ x($v%5))}M,C,X,I

Some final assignment transformations.

234.53 C_Is_Better Sat Dec 30 02:13:42 2006
-alp @v=(M1000,CM900,D500,CD400,C100,XC90,L50,XL40,X10,IX9,V5,IV4,I1);map{$n=$_,$i=0;$o=/p/?1:/m/?-1:$o;grep{s/(\D+)/$a+=($o||1)*$',$i+=$0while substr($n,$i,$0=length$1)eq$1/e}@w=@v}@F;grep{s/(\D+)/$z.=$1,$a-=$' while$a>=$'/e}@v;$_=$z

235.39 shmem Fri Dec 29 11:48:19 2006
-lp y/mplinus/-+/d;s/\w+/($&)/g;@l=IVXLCDM=~/./g;$c=.5;for$i(0..6){$c*=$i%2?5:2;s/$l[$i]([@l[$i+1,$i+2]])?/($1?'-':'+').$c.$1/eg}$_=I x eval;for$i(1..6){$u=$i%2?5:2;($c,$d,$e)=@l[$i-2..$i];s/($d){$u}/$e/g;s/($d)?$c{4}/$c.($1?$e:$d)/eg}

236.51 alankila Tue Dec 26 10:14:57 2006
-nl $t=IV4IX9XL40XC90CD400CM900I1V5X10L50C100D500M1000;%x=reverse%c=$t=~/\d+|\D+/g;s/[i-u]+/$&gt n?'+':'-'/ge;s/\w+/($&)/g;$t=~s!\D+!s/$&/+$c{$&}/g!ge;$r=eval;print+map{$v=$r/($n=$c{$_})%10;$x{$v*$n}||($v>5&&$x{5*$n},$_ x($v%5))}M,C,X,I

Some more tweaking

236.53 `/anick Sat Dec 30 21:45:52 2006
-lp $s=1;%u=reverse%v="I1IV4V5IX9X10XL40L50XC90C100D500CD400CM900M1000"=~/\d+|\D+/g;for(split){$p=0or$s=n gt$&?-1:1if s/[mp].*//;$t+=($v{$p}>$v{$p=$&}?-$s:$s)*$v{$&}while s/.$//}($i,$_)=1E3;$u{$i}&&$t>=$i?($_.=$u{$i},$t-=$i):$i--while$i

236.53 rir Mon Jan 1 17:37:08 2007
-pl push@a,{split/([(-5]+)/,'I1V5X10L50C100D500M1000p)+(m)-('}->{$_}for split'';while ($i<=$#a){for($a[$i]){$_*=-1if$_+0&&$a[$i+1]>$_;$_='+'.$_ if$_>0;$i++;}}$_=eval join'','(',@a,')';s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;5!eg

Thanks for seducing me into an attempt at golfing; interesting but I don't think I'll pursue it. Hope you find a good recruit. Be well, rir

237.44 jql Thu Dec 28 23:08:14 2006
-lp y/IXCMVLDpmslia-z/0123456))(+-/d;s// /g;s/\d/qw(+ -)[$'%4>=$&&$'>$&].10**($&&3)*($&<4||5)/eg;$_=join"",map{(4-$x++)x$_}split//,eval"1000+($_)";s/([^4])(\1{3}(\1{1}(\1{4})?)?)/$4?$1.($1+1):$3?$1+4:$1.(4+$1)/eg;y/1234567/IXCMVLD/;s/.//

I suspect the word wrap got me last time. Script attached, this time. romancalc.pl: 237.44 strokes (ok), md5=12bede24cff7cc7993666cbfdc9406a7 Congratulations! All tests passed for all holes (v1 testsuite)

238.62 mreece Tue Jan 2 01:35:04 2007
-lpa %r=qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000);sub a{$l=1000;$n=0;for(split//,shift){$d=$r{$_};$l<$d&&($n-=2*$l);$n+=$l=$d}$n}sub R{$_=a shift;$_+=a(pop)*(pop=~/p/||-1)while@_;s;.;y$IVCXL91-I0$XLMCDXVIII$dfor$I.=4x$&%1859^7;eg;$_=$I}R@F

239.49 Andy Lester Sun Dec 24 13:49:11 2006
-pla %n=(I,1,V,5,X,10,L,50,C,100,D,500,M,1E3);sub d{$w=$_;$z=1E4;$d=0;for(split//,$w){$x=$n{$_};$x-=$z*2if$z<$x;$d+=$z=$x}$d} map{/[pn]/?$.=ord($&)-111:$a+=$.*d}@F; map{while($a>=d){$a-=d;$s.=$_}}M,IM,CM,D,ID,CD,C,XC,L,XL,X,IX,V,IV,I;$_=$s

Redid the d() function.

241.51 alankila Tue Dec 26 09:58:23 2006
-pl $t=IV4IX9XL40XC90CD400CM900I1V5X10L50C100D500M1000;%x=reverse%c=$t=~/\d+|\D+/g;s/[i-u]+/$&gt n?'+':'-'/ge;s/\w+/($&)/g;$t=~s!\D+!s/$&/+$c{$&}/g!ge;$r=eval;$_=join"",map{$n=$c{$_};$v=$r/$n%10;$x{$v*$n}||($v>5&&$x{5*$n}).$_ x($v%5)}M,C,X,I

Some work on numeral generation.

241.53 C_Is_Better Sat Dec 30 01:18:23 2006
-alp @v=(M1000,CM900,D500,CD400,C100,XC90,L50,XL40,X10,IX9,V5,IV4,I1);map{$n=$_,$i=0;$o=/p/?1:/m/?-1:$o;grep{s/(\D+)(.+)/$a+=($o||1)*$2,$i+=$0while substr($n,$i,$0=length$1)eq$1/e}@w=@v}@F;grep{s/(\D+)(.+)/$z.=$1,$a-=$2while$a>=$2/e}@v;$_=$z

241.54 Pete Krawczyk Thu Dec 28 23:45:11 2006
-alp sub a{$_='I'x$_[0];for$z(qw(I10X X10C C10M C9CM C5D C4CD X9XC X5L X4XL I9IX I5V I4IV)){$z=~/(.)(\d+)(.*)/;eval"s/$1\{$2\}/$3/g"}$_}for$b(1..4e3){$x{a($b)}=$b}$c=$x{$F[0]};for$p(1,3,5){$y=$x{$F[$p+1]};$c+=($F[$p]ne'plus'?-$y:$y)}$_=a($c)

241.55 miraso Mon Jan 1 00:04:20 2007
sub a{($c)=@_;join'',map{$e=int($c/$n{$_});$c-=$n{$_}*$e;$_ x$e}@a}$n=M1000CM900D500CD400C100XC90L50XL40X10IX9V5IV4I1;@a=$n=~/\D+/g;@n{@a}=$n=~/\d+/g;%m=map{a($_),$_}1..4000;$m{plus}='+';print a(eval join'',map{$m{$_}||'-'}split' ',<>)."\n"

241.65 mjskier Sat Dec 30 16:51:49 2006
-lp %T=qw/I 1 IV 4 V 5 IX 9 X 10 XL 40 L 50 XC 90 C 100 CD 400 D 500 CM 900 M 1000 plus )+( minus )-(/;$P=join'|',sort{$T{$b}<=>$T{$a}}keys%T;s/$P/'+'.$T{$&}/eg;s/[+-]\)/\)/g;$_=eval"($_)";s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;5!eg

245.62 mreece Mon Jan 1 23:51:43 2007
-lpa %r=qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000);sub a{$l=1000;$n=0;for(split//,shift){$d=$r{$_};$l<$d&&($n-=2*$l);$n+=$l=$d}$n}sub R{$_=a(shift);$_+=(shift=~/p/||-1)*a(shift)while@_;s;.;y$IVCXL91-I0$XLMCDXVIII$dfor$I.=4x$&%1859^7;eg;$_=$I}R(@F)

245.64 mjskier Fri Dec 29 18:48:31 2006
-lp %T=qw(I 1 IV 4 V 5 IX 9 X 10 XL 40 L 50 XC 90 C 100 CD 400 D 500 CM 900 M 1000 plus \)+$ minus $-$);$P=join'|',sort{$T{$b}<=>$T{$a}}keys%T;s/$P/'+'.$T{$&}/eg;s/[+-]$/\)/g;$_=eval"($_)";s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;5!eg

247.37 shmem Fri Dec 29 01:15:56 2006
-lp s/(p|m)?\w+/$1?$1eq p?'+':'-':"($&)"/ge;@l=IVXLCDM=~/./g;$c=.5;for$i(0..6){$c*=$i%2?5:2;s/$l[$i]([@l[$i+1,$i+2]])?/($1?'-':'+').$c.$1/eg}$_=I x eval;for$i(1..6){$u=$i%2?5:2;($c,$d,$e)=@l[$i-2..$i];s/($d){$u}/$e/g;s/($d)?$c{4}/$c.($1?$e:$d)/eg}

247.42 DWilson Fri Dec 29 03:31:01 2006
-lp @r=IVXLCDM=~/./g;@r{@r}=(1,5,10,50,100,500,1000);for(split){$f=/m/,next if/m|p/;my$d;($f^$r{$&}<$r{$1}?$d:$r).="I"x$r{$&}while/.(?=(.?))/g;$d&&$r=~s/$d//}$_=$r;for$i(0,2,4){($t,$u,$v)=@r[$i..$i+2];s/$t{5}/$u/g;s/$t{4}/$t$u/;s/$u($t?)$u/$1$v/g}

247.44 explorer Wed Dec 27 03:59:43 2006
%r=@r=(M=>1E3,CM=>900,D=>500,CD=>400,C=>100,XC=>90,L=>50,XL=>40,X=>10,IX=>9,V=>5,IV=>4,I=>1);$_=<>;$s=1;for(split){$s=/p/?1:/m/?-1:s/C?(M|D)|X?(C|L)|I?(X|V)|I/$t+=$s*$r{$&}/ge}for(;$i<@r;$i+=2){$t-=$c,$,.=$r[$i],redo if$t>=($c=$r[$i+1])}print$,.$/

247.54 Pete Krawczyk Thu Dec 28 23:23:56 2006
-alp sub a{$_='I'x$_[0];for$z(qw(I10X X10C C10M C9CM C5D C4CD X9XC X5L X4XL I9IX I5V I4IV)){eval{$z=~/(.)(\d+)(.*)/;eval"s/$1\{$2\}/$3/g"}}$_}for$b(1..4e3){$x{a($b)}=$b}$c=$x{$F[0]};for$p(1,3,5){$y=$x{$F[$p+1]};$c+=($F[$p]ne'plus'?-$y:$y)}$_=a($c)

247.57 dcutter Sun Dec 31 13:38:53 2006
-an @a=qw(IV IX XL XC CD CM M D C L X V);@b=qw(I VI X LX C DC DD CC LL XX VV II);s/[IXC]\b/$&x4/e for@b;for(@F){for$f(0..12){s/$a[$f]/$b[$f]/g}}($r)=@F;$d++,/p/and$r.=$F[$d]or$r=~s/$F[$d]//for@F;for($f=12;$f-->0;){$r=~s/$b[$f]/$a[$f]/g}print"$r\n"

According to the rules the game ends today. According to the leaderboard it ends tomorrow. Which is right? Daniel

248.40 dirving Tue Jan 2 00:46:24 2007
-n @c=(M,D,C,L,X,V,I);$n=5e3;%v=map{$_,$n/=$z++%2?2:5}@c;for(split''){$.=-/m/||/p/||$.;$c=$v{$_};$t+=($l<$c?-$.:$.)*$l;$l=$c}for(@c){$i++;$p=int$t/$v{$_};$t%=$v{$_};push@o,$p>3?$o[-1]eq$c[$i-2]?do{pop@o;$_,$c[$i-3]}:($_,$c[$i-2]):$_ x$p}print@o," "

249.39 shmem Thu Dec 28 18:27:10 2006
-lp s/(p|m)?\w+/$1?$1eq p?'+':'-':"($&)"/ge;@l=split//,IVXLCDM;$c=.5;for$i(0..6){$c*=$i%2?5:2;s/$l[$i]([@l[$i+1,$i+2]])?/($1?'-':'+').$c.$1/eg}$_=I x eval;for$i(1..6){($c,$d,$e)=@l[$i-2..$i];$p=$d x($i%2?5:2);s/$p/$e/g;s/($d)?$c{4}/$c.($1?$e:$d)/eg}

250.40 dirving Tue Jan 2 00:44:53 2007
-n @c=(M,D,C,L,X,V,I);$n=5e3;%v=map{$_,$n/=$z++ %2?2:5}@c;for(split ''){$.=-/m/||/p/||$.;$c=$v{$_};$t+=($l<$c?-$.:$.)*$l;$l=$c}for(@c){$i++;$p=int$t/$v{$_};$t%=$v{$_};push@o,$p>3?$o[-1]eq$c[$i-2]?do{pop@o;$_,$c[$i-3]}:($_,$c[$i-2]):$_ x$p}print@o," "

251.52 miraso Sun Dec 31 17:18:50 2006
sub a{($c)=@_;join'',map {$e=int($c/$n{$_});$c-=$n{$_}*$e;$_ x$e}@a}@a=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I);@n{@a}=(1000,900,500,400,100,90,50,40,10,9,5,4,1);%m=map{a($_),$_}1..4000;print a(eval join'',map{$m{$_}||($_ eq'plus'?'+':'-')}split' ',<>)."\n"

252.48 lumpshiper Tue Jan 2 06:21:34 2007
-pl %r=reverse%n=split/(\d+)/,'I1V5X10L50C100D500M1000';s#.#$c=$n{$_=$&};$i+=($o=/p/<=>/m/||$o||1)*($c-2*$t*($t<$c));$t=$c#eg;$i-=$_*($j=int$i/$_),$x.=$j==4?/100/?'CD':/10/?'XL':'IV':$r{$_}x$j for sort{$b<=>$a}keys%r;$_=$x;s/VIV/IX/;s/DCD/CM/;s/LXL/XC/

253.53 alankila Tue Dec 26 09:47:59 2006
-pl $t=IV4IX9XL40XC90CD400CM900I1V5X10L50C100D500M1000;%x=reverse%c=$t=~/\d+|\D+/g;s/[i-u]+/$&gt n?'+':'-'/ge;s/\w+/($&)/g;$t=~s!\D+!s/$&/+$c{$&}/g!ge;$r=eval;$_=join"",map$_ x($r/$c{$_}%10),M,C,X,I;for$c(keys%c){for$x(9,5,4){s/$c {$x}/$x{$x*$c{$c}}/x}}

Some sneaky regex iteration added

254.40 dirving Tue Jan 2 00:34:29 2007
-n @c=(M,D,C,L,X,V,I);$n=5e3;%v=map{$_,$n/=$z++ %2?2:5}@c;for(split ''){$.=/^m/?-1:/^p/?1:$.;$c=$v{$_};$t+=($l<$c?-$.:$.)*$l;$l=$c}for(@c){$i++;$p=int$t/$v{$_};$t%=$v{$_};push@o,$p>3?$o[-1]eq$c[$i-2]?do{pop@o;$_,$c[$i-3]}:($_,$c[$i-2]):$_ x$p}print@o," "

254.41 shmem Thu Dec 28 17:54:05 2006
-lp s/(p|m)?\w+/$1?$1eq p?'+':'-':"($&)"/ge;@l=split//,IVXLCDM;$c=.5;for$i(0..6){$c*=$i%2?5:2;s/$l[$i]([@l[$i+1,$i+2]])?/($1?'-':'+').$c.$1/eg}$_=I x eval;for$i(0..5){($c,$d,$e)=@l[$i-1..$i+1];$p=$d x($i%2?2:5);s/$p/$e/g;$v=$c x4;s/$d$v/$c$e/;s/$v/$c$d/}

255.52 lumpshiper Tue Jan 2 03:10:39 2007
-pl %r=reverse%n=qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000);s#.#$c=$n{$_=$&};$i+=($o=/p/<=>/m/||$o||1)*($t<$c?$c-2*$t:$c);$t=$c#eg;$i-=$_*($j=int$i/$_),$x.=$j==4?/100/?'CD':/10/?'XL':'IV':$r{$_}x$j for sort{$b<=>$a}keys%r;$_=$x;s/VIV/IX/;s/DCD/CM/;s/LXL/XC/

forgot the l option

255.58 Snowhare Mon Jan 1 19:03:51 2007
%t=map{r($_),$_}1..3999;$_=<>;s/m\S+/-/g;s/plus/+/g;s/\b(\S+)/$t{$1}/g;print r(eval)."\n";sub r {($d,$o)=@_;@l=qw(Q Q Q M CM D CD C XC L XL X IX V IV I);$s=1000;while(@l){foreach $v qw(9 5 4 1){$q=shift @l;$n=$s*$v;while($d>=$n){$o.=$q;$d-=$n}}chop $s}$o}

One more stroke...

256.50 femto Sat Dec 30 10:28:10 2006
%H=@H='M1000CM900D500CD400C100XC90L50XL40X10IX9V5IV4I1'=~m/(\D+)(\d+)/g;$_=<>;s/m\w+/-/g;s/p\w+/+/g;s/([C-X]+)/($1)/g;s/CM|CD|XC|XL|IX|IV/-$&/g;s/[C-X]/'+'.$H{$&}/ge;$n=eval;for(sort{$H{$b}<=>$H{$a}}keys%H){while($n>=$H{$_}){$s.=$_;$n-=$H{$_};}}print"$s\n"

back to eval (only makes a couple characters difference at the moment), eliminated need for extra arrays

256.59 Snowhare Mon Jan 1 19:00:50 2007
%t=map{r($_),$_}1..3999;$_=<>;s/minus/-/g;s/plus/+/g;s/\b(\S+)/$t{$1}/g;print r(eval)."\n";sub r {($d,$o)=@_;@l=qw(Q Q Q M CM D CD C XC L XL X IX V IV I);$s=1000;while(@l){foreach $v qw(9 5 4 1){$q=shift @l;$n=$s*$v;while($d>=$n){$o.=$q;$d-=$n}}chop $s}$o}

just a few more strokes off...

257.62 dcutter Sat Dec 30 15:27:32 2006
-an @a=qw(IV IX XL XC CD CM M D C L X V);@b=qw(IIII VIIII XXXX LXXXX CCCC DCCCC DD CCCCC LL XXXXX VV IIIII);for(@F){for$f(0..12){s/$a[$f]/$b[$f]/g}}($r,@F)=@F;$d++,/p/and$r.=$F[$d]or$r=~s/$F[$d]//for@F;for($f=11;$f>=0;$f--){$r=~s/$b[$f]/$a[$f]/g}print"$r\n"

Completely different algorithm. A lot shorter and if I find the time also hackable to even shorter regions.

258.48 davidrw Wed Dec 27 01:38:48 2006
-lna %h=(I,1,V,5,X,10,L,50,C,100,D,500,M,1e3);@h{@H=qw/IV IX XL XC CD CM/}=(4,9,40,90,400,900);$x=join'|',@H;$|--?($G=/p/?'':'-',$_=''):s/$x|./($G||'+').$h{$&}/eg for@F;$d=eval"@F";for(sort{$h{$b}<=>$h{$a}}keys%h){$d-=$h{$_},$s.=$_ while $d-$h{$_}>=0}print$s

258.54 alankila Tue Dec 26 09:39:45 2006
-pl $t=IV4IX9XL40XC90CD400CM900I1V5X10L50C100D500M1000;%x=reverse%c=$t=~/\d+|\D+/g;s/[i-u]+/$&gt n?'+':'-'/ge;s/\w+/($&)/g;for$c($t=~/\D+/g){s/$c/+$c{$c}/g}$r=eval;$_=join"",map$_ x($r/$c{$_}%10),M,C,X,I;for$c(keys%c){for$x(9,5,4){s/$c {$x}/$x{$x*$c{$c}}/x}}

Still shorter.

259.38 SubStack Mon Dec 25 07:12:29 2006
-nlp %r=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000);y/mpa-z/-+/d;s#\w+#$@=$l=0;$@-=($l<$r{$_})*2*$l-($l=$r{$_})for$&=~/./g;$@#eg;$n=eval;$_="";for$@(M,C,X,I){$u=(MMM,D,L,V)[$e++];$_.=("",($@x$v)x3,$@.$u,$u,($u.$@x($v-5))x3,$@.$j)[$v=int$n/$r{$@}];$n-=$r{$j=$@}*$v}

259.48 davidrw Tue Dec 26 20:53:10 2006
-lna %h=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000);@h{@H=qw/IV IX XL XC CD CM/}=(4,9,40,90,400,900);$x=join'|',@H;$|--?($G=/p/?'':'-',$_=''):s/$x|./($G||'+').$h{$&}/eg for@F;$d=eval"@F";for(sort{$h{$b}<=>$h{$a}}keys%h){$d-=$h{$_},$s.=$_ while $d-$h{$_}>=0}print$s

259.63 mjskier Fri Dec 29 03:49:59 2006
-lp %T=qw(I 1 IV 4 V 5 IX 9 X 10 XL 40 L 50 XC 90 C 100 CD 400 D 500 CM 900 M 1000 plus \)+$ minus $-$);$P="IV|IX|XL|XC|CD|CM|I|V|X|L|C|D|M|[a-z]+";s/$P/'+'.$T{$&}/eg;s/\+$/\)/g;s/-\)/\)/g;$_=eval"($_)";s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;5!eg

I hope you make the top solutions available after the contest. I'm dying to see what Ton came up with. The last part of my script is his solution to a perl golf round to convert arabic to roman.

260.50 lumpshiper Tue Jan 2 02:58:21 2007
-p $\=$/;%r=reverse%n=qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000);s#.#$c=$n{$_=$&};$i+=($o=/p/<=>/m/||$o||1)*($t<$c?$c-2*$t:$c);$t=$c#eg;$i-=$_*($j=int$i/$_),$x.=$j==4?/100/?'CD':/10/?'XL':'IV':$r{$_}x$j for sort{$b<=>$a}keys%r;$_=$x;s/VIV/IX/;s/DCD/CM/;s/LXL/XC/

261.41 DWilson Fri Dec 29 03:01:05 2006
-lp @r=IVXLCDM=~/./g;@r{@r}=(1,5,10,50,100,500,1000);for(split){$f=/m/,next if/m|p/;my$d;($f^$r{$&}<$r{$1}?$d:$r).="I"x$r{$&}while/.(?=(.?))/g;$d&&$r=~s/$d//}$_=$r;for$i(0..5){($t,$u,$v)=@r[$i..$i+2];s/$t{10}/$v/g;s/$t{5}/$u/;$i%2?s/$t(.)$t/$1$u/:s/$t{4}/$t$u/}

261.59 Snowhare Mon Jan 1 18:42:23 2007
%t=map{r($_),$_}1..3999;@t{'plus','minus'}=qw(+ -);$_=<>;s/\b(\S+)/$t{$1}/sg;print r(eval)."\n";sub r {($d,$o)=@_;@l=qw(Q Q Q M CM D CD C XC L XL X IX V IV I);$s=1000;while(@l){foreach $v qw(9 5 4 1){$q=shift @l;$n=$s*$v;while($d>=$n){$o.=$q;$d-=$n}}chop $s}$o}

Getting there....

262.48 davidrw Tue Dec 26 18:18:59 2006
-lna %h=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000);@h{@H=qw/IV IX XL XC CD CM/}=(4,9,40,90,400,900);$x=join'|',@H;$|--?($G=/p/?'':'-',$_=''):s/($x|\D)/($G||'+').$h{$&}/eg for@F;$d=eval"@F";for(sort{$h{$b}<=>$h{$a}}keys%h){$d-=$h{$_},$s.=$_ while $d-$h{$_}>=0}print$s

263.39 DWilson Fri Dec 29 00:01:15 2006
-lp @r=IVXLCDM=~/./g;@r{@r}=(1,5,10,50,100,500,1000);y/mp a-z/-+/d;s/\W/)$&(/g;s/\w(?=(\w?))/($r{$&}<$r{$1}?"-":"+").$r{$&}/eg;$i=@e=split'',eval"($_)";$_=join'',map$r[--$i*2]x$_,@e;for$i(0..5){($t,$u)=@r[$i,$i+1];s/$t{5}/$u/;s/$t{4}/$t$u/;$i%2&&s/$t(.)$t/$1$u/};

263.40 shmem Thu Dec 28 17:46:45 2006
-lp s/(p|m)?\w+/$1?$1eq p?'+':'-':"($&)"/ge;@l=split//,IVXLCDM;$c=.5;for$i(0..6){$c*=$i%2?5:2;s/$l[$i]([@l[$i+1,$i+2]])?/($1?'-':'+').$c.$1/eg}$_=I x eval;for$i(0..5){$d=$l[$i+1];$p=$l[$i]x($i%2?2:5);s/$p/$d/g;$c=$l[$i-1];$v=$c x4;s/$l[$i]$v/$c$d/;s/$v/$c$l[$i]/}

263.42 dirving Tue Jan 2 00:33:40 2007
-n @c=(M,D,C,L,X,V,I); $n=5e3; %v=map{$_,$n/=$z++ %2?2:5}@c; for(split ''){$.=/^m/?-1:/^p/?1:$.; $c=$v{$_}; $t+=($l<$c?-$.:$.)*$l; $l=$c}for(@c){$i++; $p=int$t/$v{$_}; $t%=$v{$_}; push@o,$p>3?$o[-1]eq$c[$i-2]?do{pop@o;$_,$c[$i-3]}:($_,$c[$i-2]):$_ x$p}print@o," "

264.37 SubStack Mon Dec 25 05:07:06 2006
-nlp %r=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000);for(/\S+/g){$z=0;$z-=($l<$r{$_})*2*$l-($l=$r{$_})for/./g;$c.=/p/?"+":/m/?"-":$z}$n=eval$c;$_="";for$@(M,C,X,I){$u=(MMM,D,L,V)[$e++];$_.=("",($@x$v)x3,$@.$u,$u,($u.$@x($v-5))x3,$@.$j)[$v=int$n/$r{$@}];$n-=$r{$j=$@}*$v}

265.38 DWilson Thu Dec 28 23:47:17 2006
-lp @r=(I,V,X,L,C,D,M);@r{@r}=(1,5,10,50,100,500,1000);y/mp a-z/-+/d;s/\W/)$&(/g;s/\w(?=(\w?))/($r{$&}<$r{$1}?"-":"+").$r{$&}/eg;$i=@e=split'',eval"($_)";$_=join'',map$r[--$i*2]x$_,@e;for$i(0..5){($t,$u)=@r[$i,$i+1];s/$t{5}/$u/;s/$t{4}/$t$u/;$i%2&&s/$t(.)$t/$1$u/};

266.54 lumpshiper Fri Dec 29 08:42:51 2006
-p $\=$/;%r=reverse %n=qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000);s#.#$c=$n{$_=$&};$o=/m/?-1:/p/?1:$o||1;$i+=$o*($t<$c?$c-2*$t:$c);$t=$c#eg;$j=int$i/$_,$x.=$r{$_}x$j,$i-=$j*$_ for sort{$b<=>$a}keys%r;$_=$x;s/IIII/IV/;s/CCCC/CD/;s/XXXX/XL/;s/VIV/IX/;s/DCD/CM/;s/LXL/XC/

first attempt at golf, go easy on me

267.38 SubStack Sun Dec 24 07:20:07 2006
-nlp %r=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000);for(/\S+/g){$z=0;$z-=($l<$r{$_})*2*$l,$z+=$l=$r{$_}for/./g;$c.=/p/?"+": /m/?"-":$z}$n=eval$c;$_="";for$@(M,C,X,I){$u=(MMM,D,L,V)[$e++];$_.=("",($@x$v)x3,$@.$u,$u,($u.$@x($v-5))x3,$@.$j)[$v=int$n/$r{$@}];$n-=$r{$j=$@}*$v}

minor update, condesation of less-than logic

267.40 DWilson Thu Dec 28 18:24:38 2006
-lp @r=(I,V,X,L,C,D,M);@r{@r}=(1,5,10,50,100,500,1000);y/mp a-z/-+/d;s/\W/)$&(/g;s/\w(?=(\w?))/($r{$&}<$r{$1}?"-":"+").$r{$&}/eg;$r=$r[$i++*2]x$_.$r for reverse split'',eval"($_)";$_=$r;for$i(0..5){($t,$u)=@r[$i,$i+1];s/$t{5}/$u/;s/$t{4}/$t$u/;$i%2&&s/$t(.)$t/$1$u/};

269.38 SubStack Sun Dec 24 06:34:43 2006
-nlp %r=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000);for(/\S+/g){$z=0;($l<$r{$_}?$z-=2*$l:0),$z+=$l=$r{$_}for/./g;$c.=/p/?"+": /m/?"-":$z}$n=eval$c;$_="";for$@(M,C,X,I){$u=(MMM,D,L,V)[$e++];$_.=("",($@x$v)x3,$@.$u,$u,($u.$@x($v-5))x3,$@.$j)[$v=int$n/$r{$@}];$n-=$r{$j=$@}*$v}

simplified conditional structure

270.47 ciscoqid Fri Dec 29 19:25:01 2006
-an @t=(IV,4,IX,9,I,1,V,5,XL,40,XC,90,X,10,L,50,CD,400,D,500,CM,900,C,100,M,1e3);for(@F){$e.=/m/?'-':/p/?'+':sub{for($i=0;$i<26;$i+=2){s/$t[$i]/"$t[$i+1]+"/ge};"($_ 0)"}->()}$n=eval$e;for(sort{$b<=>$a}keys%{$t={reverse@t}}){while($n>=$_){$o.=$$t{$_};$n-=$_}}print"$o\n";

270.51 Andy Lester Sun Dec 24 05:28:03 2006
-pla %n=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000);sub d{local$_=$_;$d=- s/I([MDXV])/$1/g;$d-=s/X([CL])/$1/g*10;$d-=s/C([MD])/$1/g*100;$d+=$n{$_}for split//;$d} map{/[pn]/?$.=ord($&)-111:$n+=$.*d}@F; map{while($n>=d){$n-=d;$s.=$_}}M,IM,CM,D,ID,CD,C,XC,L,XL,X,IX,V,IV,I;$_=$s

Pruning more little bits here and there.

271.38 DWilson Thu Dec 28 04:21:25 2006
-lp @r=(I,V,X,L,C,D,M);@r{@r}=(1,5,10,50,100,500,1000);y/mpa-z/-+/d;s/[+-]/)$&(/g;s/\w(?=(\w?))/($r{$&}<$r{$1}?"-":"+").$r{$&}/eg;@e=split'',eval"($_)";$r=$r[$_*2]x(pop@e).$r for 0..@e;$_=$r;for$i(0..5){($t,$u)=@r[$i,$i+1];s/$t{5}/$u/;s/$t{4}/$t$u/;$i%2&&s/$t(.)$t/$1$u/}

272.55 pijll Sat Dec 30 12:45:10 2006
-ln @r=('',I,II,III,IV,V,VI,VII,VIII,IX); s/plus/+/g; s/minus/-/g; s/\w+/'('.f($&).')'/ge; $_=eval; for(/./g){ $g=~tr/IVXLC/XLCDM/; $g.=$r[$_]; } print $g; sub f{($x)=@_;my$s;while($x){for(4,reverse 0..9){if($x =~ s/$r[$_]$//){$s="$_$s";last}}$x=~tr/XLCDM/IVXLC/}return$s}

My first working solution. I'll start golfing now...

275.47 BasharTeg Thu Dec 28 03:37:02 2006
-nl %_=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000,CM,900,CD,400,XC,90,XL,40,IX,9,IV,4);$l=split//;$o=1;while($i<$l){$_=$_[$i];$o=/m/?-1:/p/?1:$o;$_=$_{$_};$y=$_{$_[++$i]};$_=$y-$_,$i++if$_&&$_<$y;$a+=$_*$o}map{$s.=$_,$a-=$_{$_}while$a>$_{$_}-1}sort{$_{$b}<=>$_{$a}}keys%_;print$s;

I've been trying to figure out how I can walk my hash for the decode for like 10 versions. Finally got it.

275.58 alankila Tue Dec 26 09:21:43 2006
-pl %c=split/(\d+)/,I1V5X10L50C100D500M1000IV4IX9XL40XC90CD400CM900;s/[i-u]+/$&gt n?'+':'-'/ge;s/\w+/($&)/g;for$c(sort{length$a<length$b}keys%c){s/$c/+$c{$c}/g}$r=eval;$_=join"",map$_ x($r/$c{$_}%10),M,C,X,I;%x=reverse%c;for$c(keys%c){for$x(9,5,4){s/$c {$x}/$x{$x*$c{$c}}/x}}

More incremental development.

277.40 DWilson Thu Dec 28 03:45:17 2006
-lp @r=(I,V,X,L,C,D,M);@r{@r}=(1,5,10,50,100,500,1000);y/mpa-z/-+/d;s/[+-]/)$&(/g;s/\w(?=(\w?))/($r{$&}<$r{$1}?"-":"+").$r{$&}/eg;my$r;my$i;$r=$r[$i++*2]x$_.$r for split'',reverse eval"($_)";$_=$r;for$i(0..5){($t,$u)=@r[$i,$i+1];s/$t{5}/$u/;s/$t{4}/$t$u/;$i%2&&s/$t(.)$t/$1$u/}

277.44 Pete Krawczyk Thu Dec 28 22:28:33 2006
-alp sub a{$_='I'x$_[0];s/I{10}/X/g;s/X{10}/C/g;s/C{10}/M/g;s/C{9}/CM/;s/C{5}/D/;s/C{4}/CD/;s/X{9}/XC/;s/X{5}/L/;s/X{4}/XL/;s/I{9}/IX/;s/I{5}/V/;s/I{4}/IV/;$_}for$b(1..4e3){$x{a($b)}=$b}$_=$x{$F[0]};for$p(1,3,5){$F[$p]and$_+=($F[$p]eq'plus'?$x{$F[$p+1]}:-$x{$F[$p+1]})}$_=a($_)

277.47 femto Sat Dec 30 10:16:17 2006
%H=@H='M1000CM900D500CD400C100XC90L50XL40X10IX9V5IV4I1'=~m/(\D+)(\d+)/g;push@{$_%2?A:R},$H[$_]for(0..$#H);$_=<>;$g=1;for(split//){$p=$q;/m/?$g=-1:/p/?$g=1:/[C-X]/?$n+=(($q=$H{$_})>$p?-1:1)*$g*$p:($n+=$g*$p,$q=0)}for(0..$#A){while($n>=$A[$_]){$s.=$R[$_];$n-=$A[$_];}}print"$s\n"

iterate through the string to do the math instead of using eval(), couple other incremental format improvements

277.48 ciscoqid Fri Dec 29 02:28:08 2006
-an @t=(IV,4,IX,9,I,1,V,5,XL,40,XC,90,X,10,L,50,CD,400,D,500,CM,900,C,100,M,1e3);for(@F){$e.=/m/?'-':/p/?'+':sub{for($i=0;$i<26;$i+=2){s/$t[$i]/"$t[$i+1]+"/ge};"($_ 0)"}->()}$n=eval$e;for(25,21,19,17,23,11,15,9,13,3,7,1,5){while($n>=$t[$_]){$o.=$t[$_-1];$n-=$t[$_]}}print"$o\n"

279.49 BasharTeg Thu Dec 28 03:29:23 2006
-nl %_=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000,CM,900,CD,400,XC,90,XL,40,IX,9,IV,4);$l=split//;$o=1;while($i<$l){$_=$_[$i];$o=/m/?-1:/p/?1:$o;$_=$_{$_};$y=$_{$_[++$i]};$_=$y-$_,$i++if$_&&$_<$y;$a+=$_*$o}map{$s.=$_,$a-=$_{$_}while$a>$_{$_}-1}M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I;print$s;

Learning map better than I knew before

281.40 DWilson Thu Dec 28 03:09:46 2006
-lp @r=(I,V,X,L,C,D,M);@r{@r}=(1,5,10,50,100,500,1000);y/mpa-z/-+/d;s/[+-]/)$&(/g;s/\w(?=(\w?))/($r{$&}<$r{$1}?"-":"+").$r{$&}/eg;my$r;my$i;$r=$r[$i++*2]x$_.$r for split'',reverse eval"($_)";$_=$r;for$i(0..5){($t,$u)=@r[$i,$i+1];s/$t{5}/$u/;s/($t){4}/$1$u/;$i%2&&s/($t)(.)\1/$2$u/}

281.44 C_Is_Better Thu Dec 28 18:53:04 2006
-alp @v=([M,1000],[CM,900],[D,500],[CD,400],[C,100],[XC,90],[L,50],[XL,40],[X,10],[IX,9],[V,5],[IV,4],[I,1]);$o=1;map{$n=$_;$r=$i=0;map{while(substr($n,$i,$l=length@$_[0])eq@$_[0]){$a+=$o*@$_[1];$i+=$l}}@v;$o=/p/?1:/m/?-1:$o}@F;map{while($a>=@$_[1]){$z.=@$_[0];$a-=@$_[1]}}@v;$_=$z

282.48 femto Sat Dec 30 09:03:16 2006
@H=('M1000CM900D500CD400C100XC90L50XL40X10IX9V5IV4I1'=~m/(\D+)(\d+)/g);%H=@H;push@{$_%2?'A':'R'},$H[$_]for(0..$#H);$_=<>;s/m\w+/-/g;s/p\w+/+/g;s/([C-X]+)/($1)/g;s/CM|CD|XC|XL|IX|IV/-$&/g;s/[C-X]/'+'.$H{$&}/ge;$n=eval;for(0..$#A){while($n>=$A[$_]){$s.=$R[$_];$n-=$A[$_];}}print"$s\n"

283.37 SubStack Sun Dec 24 05:21:36 2006
-nlp %r=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000);for(/\w+/g){$z=0;$@=$r{$_},($l<$@&&$l?$z-=2*$l:0),$z+=$l=$@for/./g;$c.=/p/?"+":/m/?"-":$z}$n=eval$c;$_="";for$@(M,C,X,I){$u=(MMM,D,L,V)[$e++];$_.=$v<4?$@x$v:$v<5?$@.$u:$v<6?$u:$v==9?$@.$j:$u.$@x($v-5)if$v=int$n/$r{$@};$n-=$r{$j=$@}*$v;}

Added a -l for newlines, ran on the test script

283.48 ciscoqid Fri Dec 29 01:32:52 2006
@t=(IV,4,IX,9,I,1,V,5,XL,40,XC,90,X,10,L,50,CD,400,D,500,CM,900,C,100,M,1e3);$_=<>;for(split){$e.=/m/?'-':/p/?'+':sub{for($i=0;$i<26;$i+=2){s/$t[$i]/"$t[$i+1]+"/ge};"($_ 0)"}->()}$n=eval$e;for(25,21,19,17,23,11,15,9,13,3,7,1,5){while($n>=$t[$_]){$o.=$t[$_-1];$n-=$t[$_]}}print"$o\n";

283.50 Andy Lester Sat Dec 23 23:46:51 2006
-pl %n=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000);@w=(M,IM,CM,D,ID,CD,C,XC,L,XL,X,IX,V,IV,I);sub d{local$_=$_;$d=- s/I([MDXV])/$1/g;$d-=s/X([CL])/$1/g*10;$d-=s/C([MD])/$1/g*100;map{$d+=$n{$_}}split//;$d} map{/[pn]/?$.=ord($&)-111:$n+=$.*d}split$"; map{while($n>=d){$n-=d;$s.=$_}}@w;$_=$s

Same as previous, minus a few underscores.

286.61 mreece Mon Jan 1 23:16:41 2007
%r=qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000);sub a{$l=1000;$a=0;for(split//,shift){($d)=$r{$_};$l<$d&&($a-=2*$l);$a+=($l=$d)}$a}sub R{$_=shift;s;.;y$IVCXL91-I0$XLMCDXVIII$dfor$I.=4x$&%1859^7;eg;$_=$I;"$_\n"}sub n{$_=<>;split;$n=a(shift);$n+=(shift=~/p/||-1)*a(shift)while@_;$n}print R(n)

288.48 femto Sat Dec 30 08:48:40 2006
@H=('M1000CM900D500CD400C100XC90L50XL40X10IX9V5IV4I1'=~m/(\D+)(\d+)/g);%H=@H;push@{$_%2?'A':'R'},$H[$_]for(0..$#H);$_=<>;s/m\w+/-/g;s/p\w+/+/g;s/([C-X]+)/($1)/g;s/CM|CD|XC|XL|IX|IV/-$&/g;s/[C-X]/'+'.$H{$&}/ge;$n=eval;foreach$i(0..$#A){while($n>=$A[$i]){$s.=$R[$i];$n-=$A[$i];}}print"$s\n"

terser hash initialization,two simple regexes that are a couple chars shorter than a more general one

288.50 Andy Lester Sat Dec 23 23:39:08 2006
-pl %n=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000);@w=(M,IM,CM,D,ID,CD,C,XC,L,XL,X,IX,V,IV,I);sub d{local$_=$_;$d=- s/I([MDXV])/$1/g;$d-=s/X([CL])/$1/g*10;$d-=s/C([MD])/$1/g*100;map{$d+=$n{$_}}split//,$_;$d} map{/[pn]/?$.=ord($&)-111:$n+=$.*d$_}split$"; map{while($n>=d){$n-=d;$s.=$_}}@w;$_=$s

Redid the d() function to use the idea of accumulating deficits to the total.

289.41 DWilson Thu Dec 28 02:59:55 2006
-lp @r=(I,V,X,L,C,D,M);@r{@r}=(1,5,10,50,100,500,1000);y/mpa-z/-+/d;s/[+-]/)$&(/g;s/\w(?=(\w?))/($r{$&}<$r{$1}?"-":"+").$r{$&}/eg;my$r;my$i;$r.=$r[$i++*2]x$_ for split'',reverse eval"($_)";$_=reverse$r;for$i(0..5){$t=$r[$i+1];$u=$r[$i];s/$u{5}/$t/;s/($u){4}/$1$t/;$i%2&&s/($u)(.)\1/$2$t/};

290.45 C_Is_Better Thu Dec 28 03:33:25 2006
-l @v=([M,1000],[CM,900],[D,500],[CD,400],[C,100],[XC,90],[L,50],[XL,40],[X,10],[IX,9],[V,5],[IV,4],[I,1]);$o=1;map{$n=$_;$r=$i=0;map{while(substr($n,$i,$l=length@$_[0])eq@$_[0]){$r+=@$_[1];$i+=$l}}@v;$a+=$o*$r;$o=/p/?1:-1}split' ',<>;map{while($a>=@$_[1]){$z.=@$_[0];$a-=@$_[1]}}@v;print$z

290.46 C_Is_Better Thu Dec 28 03:13:34 2006
@v=([M,1000],[CM,900],[D,500],[CD,400],[C,100],[XC,90],[L,50],[XL,40],[X,10],[IX,9],[V,5],[IV,4],[I,1]);$o=1;map{$n=$_;$r=$i=0;map{while(substr($n,$i,$l=length@$_[0])eq@$_[0]){$r+=@$_[1];$i+=$l}}@v;$a+=$o*$r;$o=/p/?1:-1}split' ',<>;map{while($a>=@$_[1]){print@$_[0];$a-=@$_[1]}}@v;print"\n"

293.41 DWilson Thu Dec 28 02:22:21 2006
-lp sub r{reverse@_}@r=(I,V,X,L,C,D,M);@r{@r}=(1,5,10,50,100,500,1000);y/mpa-z/-+/d;s/[+-]/)$&(/g;s/\w(?=(\w?))/($r{$&}<$r{$1}?"-":"+").$r{$&}/eg;my$r;my$i;$r.=$r[$i++*2]x$_ for r split'',eval"($_)";$_=r$r;for$i(0..5){$t=$r[$i+1];$u=$r[$i];s/$u{5}/$t/;s/($u){4}/$1$t/;$i%2&&s/($u)(.)\1/$2$t/};

295.41 DWilson Thu Dec 28 02:07:58 2006
-lp sub r{reverse@_}@r=(I,V,X,L,C,D,M);@r{@r}=(1,5,10,50,100,500,1000);y/mpa-z/-+/d;s/[+-]/)$&(/g;s/\w(?=(\w?))/($r{$&}<$r{$1}?"-":"+").$r{$&}/eg;my$r;my$i;$r.=$r[$i++*2]x$_ for r split'',eval"($_)";$_=r$r;for$i(0..5){$t=$r[$i+1];$u=$r[$i];s/($u){5}/$t/;s/($u){4}/$1$t/;$i%2&&s/($u)(.)\1/$2$t/};

Broke 300! Yeah!

296.46 C_Is_Better Thu Dec 28 02:55:54 2006
@v=([M,1000],[CM,900],[D,500],[CD,400],[C,100],[XC,90],[L,50],[XL,40],[X,10],[IX,9],[V,5],[IV,4],[I,1]);$o=1;for(split(' ',<>)){$n=$_;$r=$i=0;for(@v){while(substr($n,$i,$l=length@$_[0])eq@$_[0]){$r+=@$_[1];$i+=$l}}$a+=$o*$r;$o=/p/?1:-1}for(@v){while($a>=@$_[1]){print@$_[0];$a-=@$_[1]}}print "\n"

297.50 BasharTeg Thu Dec 28 03:17:49 2006
-nl sub u{$s.=$_[1],$a-=$_[0]while$a>$_[0]-1}%_=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000,CM,900,CD,400,XC,90,XL,40,IX,9,IV,4);$l=split//;$o=1;while($i<$l){$_=$_[$i];$o=/m/?-1:/p/?1:$o;$_=$_{$_};$y=$_{$_[++$i]};$_=$y-$_,$i++if$_&&$_<$y;$a+=$_*$o}u$_{$_},$_ for M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I;print$s;

Catching up to that C_Is_Better guy

298.43 dr Thu Dec 28 02:15:15 2006
-lp split'','IVXLCDM';y~m A-Z~~cd,s~m (\S+)~-($1)~g;for$b(0..3){$d=10**$b,$b*=2;do{for$s(1,2){s~$_[$b]$_[$b+$s]~-$d+5*$s*$d~g,s~$_[$b+1]~+5*$d~g}}if$b<6;s~$_[$b]~+$d~g}$k=eval,$_='';do{$t=10**$p,$f=2*$p++;s~^~($i=chop$k)%5==4?$_[$f].$_[($i>4?2:1)+$f]:$i>4?$_[$f+1].$_[$f]x($i-5):$_[$f]x$i~e}while$k

300.49 ciscoqid Fri Dec 29 00:50:25 2006
@t=(IV,4,IX,9,I,1,V,5,XL,40,XC,90,X,10,L,50,CD,400,D,500,CM,900,C,100,M,1000);$_=<>;for(split){if(/m/){$e.="-"}elsif(/p/){$e.="+"}else{for($i=0;$i<26;$i+=2){s/$t[$i]/"$t[$i+1]+"/ge};$e.="($_ 0)"}}$n=eval$e;for(25,21,19,17,23,11,15,9,13,3,7,1,5){while($n>=$t[$_]){$o.=$t[$_-1];$n-=$t[$_]}}print"$o\n";

300.61 Andy Lester Sat Dec 23 20:19:48 2006
-pl %n=qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000); @w=qw(M IM VM XM CM D ID CD C IC XC L XL X IX V IV I); sub d($){$d=0;@v=map{$n{$_}}split//,shift;while($z=shift@v){$d+=$z<$v[0]?-$z:$z}$d} $m=1;for(split' '){/[pn]/?$m=ord($&)-111:$n+=$m*d$_} $_='';for$l(@w){$f=d$l;while($n&&($n>=$f)){$n-=$f;$_.=$l;}}

First version that is just squashed down. No real trickery other than the plus/minus trick.

301.52 `/anick Thu Dec 28 20:08:30 2006
-lp sub t{my$s;$s+=$r{$_=pop}-($r{$_}>$r{$_[-1]}&&$r{pop@_})while@_;$s}%r='@I1?IV4>V5=IX9<X10;XL40:L50/XC90.C100-CD400+D500*CM900)M1000'=~/\d+|\D+/g;@r{map/^.(.)$/?$1:Z,keys%r}=values%r;s!\S+!$_=$&;lc ne$_?t(/./g):p gt$_?'-':'+'!eg;$s=eval;$x.=$_ x($s/$r{$_}),$s%=$r{$_}for sort keys%r;$_=$x;y/C-X//cd

Me? Rusty? Naah...

303.45 Pete Krawczyk Thu Dec 28 22:25:09 2006
-alp sub a{$_='M'x($_[0]/1000).'C'x($_[0]%1000/100).'X'x($_[0]%100/10).'I'x($_[0]%10);s/C{9}/CM/;s/C{5}/D/;s/C{4}/CD/;s/X{9}/XC/;s/X{5}/L/;s/X{4}/XL/;s/I{9}/IX/;s/I{5}/V/;s/I{4}/IV/;$_}for$b(1..4e3){$x{a($b)}=$b}$_=$x{$F[0]};for$p(1,3,5){$F[$p]and$_+=($F[$p]eq'plus'?$x{$F[$p+1]}:-$x{$F[$p+1]})}$_=a($_)

304.41 DWilson Thu Dec 28 01:22:09 2006
-lp @r=(I,V,X,L,C,D,M);@q=(1,5,10,50,100,500,1000);@r{@r}=@q;%d=reverse%r;y/mpa-z/-+/d;s/[+-]/)$&(/g;s/\w(?=(\w?))/($r{$&}<$r{$1}?"-":"+").$r{$&}/eg;my$r;my$i;$r=$r[$i++*2]x$_.$r for reverse split'',eval"($_)";$_=$r;for$i(0..5){$t=$r[$i+1];$u=$r[$i];s/($u){5}/$t/;s/($u){4}/$1$t/;$i%2&&s/($u)(.)\1/$2$t/}

304.51 BasharTeg Thu Dec 28 03:13:08 2006
-nl sub u{$s.=$_[1],$a-=$_[0]while$a>$_[0]-1}%_=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000,CM,900,CD,400,XC,90,XL,40,IX,9,IV,4);$l=length;split//;$o=1;while($i<$l){$_=$_[$i];$o=/m/?-1:/p/?1:$o;$_=$_{$_};$y=$_{$_[++$i]};$_=$y-$_,$i++if$_&&$_<$y;$a+=$_*$o}u$_{$_},$_ for M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I;print$s;

a little here, a little there

305.45 C_Is_Better Thu Dec 28 02:41:11 2006
@v=([M,1000],[CM,900],[D,500],[CD,400],[C,100],[XC,90],[L,50],[XL,40],[X,10],[IX,9],[V,5],[IV,4],[I,1]);$o=1;for(split(' ',<>)){$n=$_;$r=$i=0;for(@v){$l=length$_->[0];while(substr($n,$i,$l)eq$_->[0]){$r+=$_->[1];$i+=$l}}$a+=$o*$r;$o=/p/?1:-1}for(@v){while($a>=$_->[1]){print$_->[0];$a-=$_->[1]}}print "\n"

306.41 DWilson Thu Dec 28 00:27:29 2006
-lp @r=(I,V,X,L,C,D,M);@q=(1000,500,100,50,10,5,1);@r{@r}=reverse@q;%d=reverse%r;y/mpa-z/-+/d;s/[+-]/)$&(/g;s/\w(?=(\w?))/($r{$&}<$r{$1}?"-":"+").$r{$&}/eg;$_=eval"($_)";my$r;$v=$_;$r.=$d{$_}x($v/$_),$v-=$_*int$v/$_ for@q;$r=~s/($r[$_]){4}/$1$r[$_+1]/for 0..4;$r=~s/($r[$_])(.)\1/$2$r[$_+1]/for 1,3,5;$_=$r

307.44 explorer Tue Dec 26 16:36:18 2006
@r=(M=>1E3,CM=>900,D=>500,CD=>400,C=>100,XC=>90,L=>50,XL=>40,X=>10,IX=>9,V=>5,IV=>4,I=>1);%r=@r;$_=<>;s/p\w+/+/g;s/m\w+/-/g;s/\w+/($&)/g;s/C?(M|D)|X?(C|L)|I?(X|V)|I/"+$r{$&}"/ge;for($_=eval$_;$i<@r;$i+=2){($r,$c)=@r[$i,$i+1];($p=$c)=~s/0/./g;next if!($i-2)%4and!/$p$/;if($_>=$c){$_-=$c;print$r;redo}}print$/

308.42 dr Wed Dec 27 05:42:50 2006
-lp $"='';split'','IVXLCDM';y~m A-Z~~cd,s~m (\S+)~-($1)~g;for$b(0..3){$t=10**$b,$b*=2;do{for$s(1,2){s~@_[$b,$b+$s]~-$t+5*$s*$t~g,s~$_[$b+1]~+5*$t~g}}if$b<6;s~$_[$b]~+$t~g}$k=eval,$_='';do{$t=10**$p,$f=2*$p++;s~^~($i=chop$k)==9?"@_[$f,2+$f]":$i==4?"@_[$f,1+$f]":$i>4?$_[$f+1].$_[$f]x($i-5):$_[$f]x$i~e}while$k

309.53 solo Fri Dec 29 15:33:36 2006
-an @v=(1000,500,100,50,10,5,1);@q=('',qw(0 00 000 01 1 10 100 1000 02));@r=qw(IVX XLC CDM M);for(@F){if(/(n|p)/){$o=$1;next}$l=$s=0;for(split//){$r=index('MDCLXVI',$_);$s-=2*$v[$l]if$r<$l;$s+=$v[$r];$l=$r;}$t+=$o=~/n/?-$s:$s;}$i=length$t;for(split//,$t){$i--;$_=$q[$_];eval"y/012/$r[$i]/";$z.=$_;}print$z.$/;

without changing algorithm...

310.50 BasharTeg Thu Dec 28 03:02:45 2006
-n sub u{$s.=$_[1],$a-=$_[0]while$a>$_[0]-1}%_=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000,CM,900,CD,400,XC,90,XL,40,IX,9,IV,4);$l=length;split//;$o=1;while($i<$l){$_=$_[$i];$o=/m/?-1:/p/?1:$o;$_=$_{$_};$y=$_{$_[++$i]};if($_&&$_<$y){$_=$y-$_;$i++}$a+=$_*$o}u$_{$_},$_ for M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I;print"$s\n";

This $o optimization took forever to get right

312.46 C_Is_Better Thu Dec 28 02:15:14 2006
@v=([M,1000],[CM,900],[D,500],[CD,400],[C,100],[XC,90],[L,50],[XL,40],[X,10],[IX,9],[V,5],[IV,4],[I,1]);$o=1;for(split(' ',<>)){$n=$_;$r=$i=0;foreach(@v){$l=length$_->[0];while(substr($n,$i,$l)eq$_->[0]){$r+=$_->[1];$i+=$l}}$a+=$o*$r;$o=/p/?1:-1}foreach(@v){while($a>=$_->[1]){print$_->[0];$a-=$_->[1]}}print"\n"

312.51 BasharTeg Thu Dec 28 02:57:28 2006
-n sub u{$s.=$_[1],$a-=$_[0]while$a>$_[0]-1}%_=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000,CM,900,CD,400,XC,90,XL,40,IX,9,IV,4);$l=length;split//;$o=1;while($i<$l){$_=$_[$i];$o=1if/p/;$o=-1if/m/;$_=$_{$_};$y=$_{$_[++$i]};if($_&&$_<$y){$_=$y-$_;$i++}$a+=$_*$o}u$_{$_},$_ for M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I;print"$s\n";

Finally got rid of those fucking repeated calls to u()

313.48 TeamSPAM Thu Dec 28 04:27:37 2006
-lp %r=(I,1,IV,4,V,5,IX,9,X,10,XL,40,L,50,XC,90,C,100,CD,400,D,500,CM,900,M,1E3);while(s/(\w+) (\w+) (\w+)/d(r($1)+(-1,1)[$2eq plus]*r($3))/e){}sub r{$o=$d=0;for(split(//,pop)){$n=$r{$_};$d+=($n>$o)?$n-2*$o:$n;$o=$n;}$d;}sub d{my$s;for(sort{$r{$b}<=>$r{$a}}keys%r){while($_[0]>=$r{$_}){$_[0]-=$r{$_};$s.=$_;}}$s;}

314.42 dr Wed Dec 27 05:11:14 2006
-lp $"='',@n=qw(I V X L C D M),y~m A-Z~~cd,s~m (\S+)~-($1)~g;for$b(0..3){$t=10**$b,$b*=2;do{for$s(1,2){s~@n[$b,$b+$s]~-$t+5*$s*$t~g,s~$n[$b+1]~+5*$t~g}}if$b<6;s~$n[$b]~+$t~g}$k=eval,$_='';do{$t=10**$p,$f=2*$p++;s~^~($i=chop$k)==9?"@n[$f,2+$f]":$i==4?"@n[$f,1+$f]":$i-5>-1?$n[$f+1].$n[$f]x($i-5):$n[$f]x$i~e}while$k

314.43 DWilson Thu Dec 28 00:17:34 2006
-lp @r=(I,V,X,L,C,D,M);@q=(1000,500,100,50,10,5,1);@r{@r}=reverse@q; %d=reverse%r;y/mplusin/-+/d;s/[+-]/)$&(/g; s/\w(?=(\w?))/($r{$&}<$r{$1}?"-":"+").$r{$&}/eg;$_=eval"($_)";my$r;$v=$_; $r.=$d{$_}x($v/$_),$v-=$_*int$v/$_ for@q; $r=~s/($r[$_]){4}/$1$r[$_+1]/for 0,2,4; $r=~s/($r[$_])(.)\1/$2$r[$_+1]/for 1,3,5;$_=$r

318.55 femto Thu Dec 28 05:36:20 2006
%H=qw/M 1000 CM 900 D 500 CD 400 C 100 XC 90 L 50 XL 40 X 10 IX 9 V 5 IV 4 I 1/;@A=sort{$b<=>$a}values%H;@R=sort{$H{$b}<=>$H{$a}}keys%H;$_=<>;s/([mp])\S+/$1eq'm'?'-':'+'/ge;s/([C-X]+)/($1)/g;s/CM|CD|XC|XL|IX|IV/-$&/g;s/[C-X]/'+'.$H{$&}/ge;$n=eval;foreach$i(0..$#A){while($n>=$A[$i]){$s.=$R[$i];$n-=$A[$i];}}print"$s\n"

slightly terser array/hash generation, skips a variable initialization, leave off final semi colon, eliminate all newlines

319.41 dr Wed Dec 27 04:20:42 2006
-lp $"='',@n=qw(I V X L C D M),y~m A-Z~~cd;for$b(-0..3){$t=10**$b,$b*=2;$b<6?do{for$s(1,2){s~@n[$b,$b+$s]~+(5*$s-1)*$t~g,s~$n[$b+1]~+5*$t~g}}:-0;s~$n[$b]~+$t~g}s~m (\S+)~-($1)~g,$k=eval,$_='';do{$t=10**$p,$f=2*$p++;s~^~($i=chop$k)==9?"@n[$f,2+$f]":$i==4?"@n[$f,1+$f]":$i-5>-1?$n[$f+1].$n[$f]x($i-5):$n[$f]x$i~e}while$k;

319.43 DWilson Thu Dec 28 00:10:39 2006
-lp @r=(I,V,X,L,C,D,M);@q=(1000,500,100,50,10,5,1);my%r;@r{@r}=reverse@q; %d=reverse%r;y/mplusin/-+/d;s/[+-]/)$&(/g; s/\w(?=(\w?))/($r{$&}<$r{$1}?"-":"+").$r{$&}/eg;$_=eval"($_)";my$r;$v=$_; $r.=$d{$_}x($v/$_),$v-=$_*int$v/$_ for@q; $r=~s/($r[$_]){4}/$1$r[$_+1]/for 0,2,4; $r=~s/($r[$_])(.)\1/$2$r[$_+1]/for 1,3,5;$_=$r

319.44 Pete Krawczyk Thu Dec 28 22:02:59 2006
-alp sub a{$_='M'x($_[0]/1000).'C'x($_[0]%1000/100).'X'x($_[0]%100/10).'I'x($_[0]%10);s/C{9}/CM/;s/C{5}/D/;s/C{4}/CD/;s/X{9}/XC/;s/X{5}/L/;s/X{4}/XL/;s/I{9}/IX/;s/I{5}/V/;s/I{4}/IV/;$_}for$b(1..4e3){$r=a($b);$x{$r}=$b;$x{$b}=$r}$_=$x{$F[0]};for$p(1,3,5){$F[$p]and$_+=($F[$p]eq'plus'?$x{$F[$p+1]}:-$x{$F[$p+1]})}$_=a($_)

323.44 DWilson Wed Dec 27 23:33:06 2006
-lp @r=(I,V,X,L,C,D,M);@q=(1000,500,100,50,10,5,1);my%r;@r{@r}=reverse@q; %d=reverse%r;y/mplusin/-+/d;s/[+-]/)$&(/g; s/\w(?=(\w?))/($r{$&}<$r{$1}?"-":"+").$r{$&}/eg;$_=eval"($_)";my$r;$v=$_; $d=int$v/$_,$r.=$d{$_}x$d,$v-=$_*$d for@q; $r=~s/($r[$_])\1\1\1/$1$r[$_+1]/for 0,2,4; $r=~s/($r[$_])(.)\1/$2$r[$_+1]/for 1,3,5;$_=$r

324.46 C_Is_Better Thu Dec 28 02:05:15 2006
@v=([M,1000],[CM,900],[D,500],[CD,400],[C,100],[XC,90],[L,50],[XL,40],[X,10],[IX,9],[V,5],[IV,4],[I,1]);sub c{($n)=@_;$r=$i=0;foreach(@v){$l=length$_->[0];while(substr($n,$i,$l)eq$_->[0]){$r+=$_->[1];$i+=$l}}$r}$o=1;for(split(' ',<>)){$a+=$o*c$_;$o=/p/?1:-1}foreach(@v){while($a>=$_->[1]){print$_->[0];$a-=$_->[1]}}print"\n"

325.57 tryit Sun Dec 31 08:08:42 2006
-n @d=grep/\d/,(@m=split/((?:\d+|[A-Z]+))/,'4IV9IX40XL90XC400CD900CM1I5V10X50L100C500D1000M');@r=grep/[A-Z]/,@m;@v=split/0/,'M0CM0D0CD0C0XC0L0XL0X0IX0V0IV0I';@q=sort{$b<=>$a}@d;s/ m\S+ (\w+)/-($1)/g;for$n(0..12){s/$r[$n]/+$d[$n]/g}s/ \w+ //g;$t=eval;for(0..12){$b=int($t/$q[$_]);if($b){print$v[$_]x$b;$t-=$b*$q[$_]}}print"\n"

327.47 C_Is_Better Thu Dec 28 01:28:29 2006
@v=([M,1000],[CM,900],[D,500],[CD,400],[C,100],[XC,90],[L,50],[XL,40],[X,10],[IX,9],[V,5],[IV,4],[I,1]);sub c{($n)=@_;$r=$i=0;foreach(@v){$l=length$_->[0];while(substr($n,$i,$l)eq$_->[0]){$r+=$_->[1];$i+=$l}}$r}$o=1;for(split(' ',<>)){$a+=$o*c$_;$o=/plus/?1:-1}foreach(@v){while($a>=$_->[1]){print$_->[0];$a-=$_->[1]}}print"\n"

328.44 Snowhare Mon Jan 1 14:14:38 2007
%d=(1,['I','V'],1000,['M','MMMMM'],10,['X','L'],100,['C','D']);%t=map{r($_),$_}1..3999;@t{'plus','minus'}=qw(+ -);$_=<>;s/\b(\S+)/$t{$1}/sg;print r(eval). "\n";sub r{($l,$h)=@_;foreach $p qw(1000 100 10 1){($j,$i,$v)=(int($l/$p),@{$d{$p}});$h.=!$j?'':$j<4?$i x $j:$j<5?$i.$v:$j<6?$v:$j<9?$v.$i x ($j-5):$i.$x;$l-=$j*$p;$x=$i}$h}

Tidy up before moving to next major version

328.54 alankila Tue Dec 26 09:06:48 2006
-pl %c=split/(\d+)/,I1V5X10L50C100D500M1000IV4IX9XL40XC90CD400CM900;s/[a-z]+/$&gt n?'+':'-'/ge;s/\w+/($&)/g;for$c(sort{length$b<=>length$a}keys%c){s/$c/+$c{$c}/g}$r=eval;$_="M"x($r/1000%10)."C"x($r/100%10)."X"x($r/10%10)."I"x($r%10);s/C{9}/CM/;s/C{5}/D/;s/C{4}/CD/;s/X{9}/XC/;s/X{5}/L/;s/X{4}/XL/;s/I{9}/IX/;s/I{5}/V/;s/I{4}/IV/

More incremental improvements.

329.39 shmem Thu Dec 28 11:48:27 2006
-lp @s{p,'m'}=qw(+ -);s/(p|m)\w+/$s{$1}/g;s/\w+/($&)/g;@l=split//,IVXLCDM;$c=.5;$r{$l[$_]}=$c=$c*($_%2?5:2)for 0..6;for$i(0..6){$d=$r{$l[$i]};s/$l[$i]($l[$i+1]|$l[$i+2])/($1?'-':'+').$d.$1/ge;s/$l[$i]/+$d/g;}$_=I x eval;for$i(0..5){$d=$l[$i+1];$p=$l[$i]x($i%2?2:5);s/$p/$d/g;$c=$l[$i-1];$v=$c x4;s/$l[$i]$v/$c$d/;s/$v/$c$l[$i]/;}

ungolfed

332.43 DWilson Wed Dec 27 23:03:42 2006
-lp %r=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000);@r=(I,V,X,L,C,D,M); %d=reverse%r;$_="($_)";y/mplusin/-+/d;s/[+-]/)$&(/g; s/\w(?=(\w?))/($r{$&}<$r{$1}?"-":"+").$r{$&}/eg;$_=eval;my$r;$v=$_; for(@r{reverse@r}){$d=int$v/$_;$r.=$d{$_}x$d;$v-=$_*$d} $r=~s/($r[$_])\1\1\1/$1$r[$_+1]/for 0,2,4; $r=~s/($r[$_])(.)\1/$2$r[$_+1]/for 1,3,5;$_=$r

334.43 DWilson Wed Dec 27 23:00:26 2006
-lp %r=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000);@r=(I,V,X,L,C,D,M); %d=reverse%r;$_="($_)";y/mplusin/-+/d;s/[+-]/)$&(/g; s/\w(?=(\w?))/($r{$&}<$r{$1}?"-":"+").$r{$&}/eg;$_=eval;my$r;$v=$_; for(@r{reverse@r}){$d=int($v/$_);$r.=$d{$_}x$d;$v-=$_*$d} $r=~s/($r[$_])\1\1\1/$1$r[$_+1]/for 0,2,4; $r=~s/($r[$_])(.)\1/$2$r[$_+1]/for 1,3,5;$_=$r

335.44 Pete Krawczyk Thu Dec 28 21:30:45 2006
-lp sub a{$_='M'x($_[0]/1000).'C'x($_[0]%1000/100).'X'x($_[0]%100/10).'I'x($_[0]%10);s/C{9}/CM/;s/C{5}/D/;s/C{4}/CD/;s/X{9}/XC/;s/X{5}/L/;s/X{4}/XL/;s/I{9}/IX/;s/I{5}/V/;s/I{4}/IV/;$_}@w=split(/\s+/);for$b(1..4e3){$r=a($b);$x{$r}=$b;$x{$b}=$r}$s=$x{$w[0]};for$p(1,3,5){$w[$p]and$s+=($w[$p]eq'plus'?$x{$w[$p+1]}:-$x{$w[$p+1]})}$_=$x{$s}

336.46 C_Is_Better Thu Dec 28 01:19:57 2006
@v=([M,1000],[CM,900],[D,500],[CD,400],[C,100],[XC,90],[L,50],[XL,40],[X,10],[IX,9],[V,5],[IV,4],[I,1]);sub c{($n)=@_;$r=$i=0;foreach(@v){$l=length$_->[0];while(substr($n,$i,$l)eq$_->[0]){$r+=$_->[1];$i+=$l}}$r}$o=1;for(split(' ',<>)){$p++%2?$o=/plus/?1:-1:($a+=$o*c$_)}foreach(@v){while($a>=$_->[1]){print$_->[0];$a-=$_->[1]}}print"\n"

338.44 Snowhare Mon Jan 1 14:06:20 2007
%d=(1,['I','V'],1000,['M','MMMMM'],10,['X','L'],100,['C','D']);%t=map{r($_),$_}1..3999;@t{'plus','minus'}=qw(+ -);$s=1;$l=0;$_=<>;s/\b(\S+)/$t{$1}/sg;print r(eval). "\n";sub r{($l,$h)=@_;foreach $p qw(1000 100 10 1){($j,$i,$v)=(int($l/$p),@{$d{$p}});$h.=!$j?'':$j<4?$i x $j:$j<5?$i.$v:$j<6?$v:$j<9?$v.$i x ($j-5):$i.$x;$l-=$j*$p;$x=$i}$h}

Inline substitution and eval...

340.43 DWilson Wed Dec 27 22:43:04 2006
-lp %r=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000);@r=(I,V,X,L,C,D,M); %d=reverse%r;$_="($_)";y/mplusin/-+/d;s/[+-]/)$&(/g; s/\w(?=(\w?))/($r{$&}<$r{$1}?"-":"+").$r{$&}/eg;$_=eval;my$r;$v=$_; for(sort{$b<=>$a}keys%d){$d=int($v/$_);$r.=$d{$_}x$d;$v-=$_*$d} $r=~s/($r[$_])\1\1\1/$1$r[$_+1]/for 0,2,4; $r=~s/($r[$_])(.)\1/$2$r[$_+1]/for 1,3,5;$_=$r

Got it down some more.

341.47 C_Is_Better Thu Dec 28 00:58:25 2006
@v=([M,1000],[CM,900],[D,500],[CD,400],[C,100],[XC,90],[L,50],[XL,40],[X,10],[IX,9],[V,5],[IV,4],[I,1]);sub c{($n)=@_;$r=$i=0;foreach(@v){$l=length$_->[0];while(substr($n,$i,$l)eq$_->[0]){$r+=$_->[1];$i+=$l}}$r}$o=1;for(split(' ',<>)){$p++%2?$o=$_ eq"plus"?1:-1:($a+=$o*c$_)}foreach(@v){while($a>=$_->[1]){print$_->[0];$a-=$_->[1]}}print"\n"

341.56 mreece Mon Jan 1 23:15:19 2007
%r=qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000);%d=(1,['I','V'],10,['X','L'],100,['C','D'],1000,['M']);sub a{$l=1000;$a=0;for(split//,shift){($d)=$r{$_};$l<$d&&($a-=2*$l);$a+=($l=$d)}$a}sub R{$_=shift;s;.;y$IVCXL91-I0$XLMCDXVIII$dfor$I.=4x$&%1859^7;eg;$_=$I;"$_\n"}sub n{$_=<>;split;$n=a(shift);$n+=(shift=~/p/||-1)*a(shift)while@_;$n}print R(n)

342.50 alankila Tue Dec 26 09:02:39 2006
-pl %c=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000,IV,4,IX,9,XL,40,XC,90,CD,400,CM,900);s/[a-z]+/$&gt n?'+':'-'/ge;s/\w+/($&)/g;for$c(sort{length$b<=>length$a}keys%c){s/$c/+$c{$c}/g}$r=eval;$_="M"x($r/1000%10)."C"x($r/100%10)."X"x($r/10%10)."I"x($r%10);s/C{9}/CM/;s/C{5}/D/;s/C{4}/CD/;s/X{9}/XC/;s/X{5}/L/;s/X{4}/XL/;s/I{9}/IX/;s/I{5}/V/;s/I{4}/IV/

Incremental improvement over the same tired approach.

342.51 TeamSPAM Thu Dec 28 03:28:31 2006
-lp %r=(I,1,IV,4,V,5,IX,9,X,10,XL,40,L,50,XC,90,C,100,CD,400,D,500,CM,900,M,1000);%o=(plus,1,minus,-1);while(s/^([IVXLCDM]+) (plus|minus) ([IVXLCDM]+)/d(r($1)+$o{$2}*r($3))/e){}sub r{$o=$d=0;for(split(//,pop)){$n=$r{$_};$d+=($n>$o)?$n-2*$o:$n;$o=$n}$d}sub d{my$s;for(sort{$r{$b}<=>$r{$a}}keys%r){while($_[0]>=$r{$_}){$_[0]-=$r{$_};$s.=$_}}$s}

343.41 femto Thu Dec 28 03:40:35 2006
@A=(1000,900,500,400,100,90,50,40,10,9,5,4,1);@R=('M','CM','D','CD','C','XC','L','XL','X','IX','V','IV','I');%H;foreach$i(0..$#A){$H{$R[$i]}=$A[$i];} $_=<>;s/([mp])\S+/$1eq'm'?'-':'+'/ge;s/([C-X]+)/($1)/g;s/CM|CD|XC|XL|IX|IV/-$&/g;s/[C-X]/'+'.$H{$&}/ge; $n=eval;$_=''; foreach$i(0..$#A){while($n>=$A[$i]){$_.=$R[$i];$n-=$A[$i];}}print $_."\n";

mostly whitespace trims

345.48 BasharTeg Thu Dec 28 02:42:11 2006
-n %_=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000);$l=length;split//;$o=1;while($i<$l){$_=$_[$i];$o=1if/p/;$o=-1if/m/;$_=$_{$_};$y=$_{$_[++$i]};if($_&&$_<$y){$_=$y-$_;$i++}$a+=$_*$o}u(1000,M);u(900,CM);u(500,D);u(400,CD);u(100,C);u(90,XC);u(50,L);u(40,XL);u(10,X);u(9,IX);u(5,V);u(4,IV);u(1,I);print"$s\n";sub u{while($a>$_[0]-1){$s.=$_[1];$a-=$_[0]}}

BT for the win

346.46 C_Is_Better Wed Dec 27 23:49:45 2006
@v=([M,1000],[CM,900],[D,500],[CD,400],[C,100],[XC,90],[L,50],[XL,40],[X,10],[IX,9],[V,5],[IV,4],[I,1]);sub c{($n)=@_;$r=$i=0;foreach(@v){$l=length$_->[0];while(substr($n,$i,$l)eq$_->[0]){$r+=$_->[1];$i+=$l}}$r}$p=0;$o=1;for(split(' ',<>)){$p++%2?$o=$_ eq"plus"?1:-1:($a+=$o*c$_)}foreach(@v){while($a>=$_->[1]){print$_->[0];$a-=$_->[1]}}print"\n"

346.58 dcutter Wed Dec 27 15:28:35 2006
-an @r=qw(IV IX XL XC CD CM V L D I X C M);@s=qw(IVX XLC CDM M);for(@F){for($i=$a=0;$i<13;$i++){$a+=qw(4 9 40 90 400 900 5 50 500 1 10 100 1000)[$i]*$_ for$_=~s/$r[$i]//g}$_=$a if!/s/}$F[0]+=$F[++$j]*(/p/*2-1)for@F;$_=sprintf"%04d",$F[0];for(/./g){($i,$v,$x)=split//,pop@s;$r.=$i.(/4/?$v:$x),next if/4|9/;$v=''if$_<4;$r.=$v.$i x($_%5)}print"$r\n"

I'm not finished with it yet. I'd just love to get under 300. Still basicly the same algorith though.

346.62 Sec Sun Dec 31 20:10:56 2006
-l @r=qw(1000 M 900 CM 500 D 400 CD 100 C 90 XC 50 L 40 XL 10 X 9 IX 5 V 4 IV 1 I); for $num (1..3999){ @v=@r;$o=""; $z=$num; while(@v){ while($num-$v[0]>=0){ # print "$num / $o\n"; $o.=$v[1];$num-=$v[0]; }; shift@v;shift@v; #print "v:@v\n"; }; #print "$o\n"; $$o=$z; $r{$z}=$o; }; $_=<>;s/p\w+/+/g;s/m\w+/-/g;s/\w+/${$&}/ge;;print $r{eval $_};

First try

347.42 femto Thu Dec 28 02:53:54 2006
@A=(1000,900,500,400,100,90,50,40,10,9,5,4,1);@R=('M','CM','D','CD','C','XC','L','XL','X','IX','V','IV','I');%H;foreach$i(0..$#A){$H{$R[$i]}=$A[$i];} $_=<>;s/([mp])\S+/$1eq'm'?'-':'+'/ge;s/([C-X]+)/($1)/g;s/CM|CD|XC|XL|IX|IV/-$&/g;s/[MDCLXVI]/'+'.$H{$&}/ge; $n=eval;$_=''; foreach$i(0..$#A){while($n>=$A[$i]){$_.=$R[$i];$n-=$A[$i];}}print $_."\n";

substitution converts roman numberals to a math expression in arabic, eval does the actual math, then the value is converted back to roman

349.46 NumberCruncher Thu Dec 28 15:23:50 2006
@o=<>=~/(\S+)/g;%r=(I=>1,V=>5,X=>10,L=>50,C=>100,D=>500,M=>1000,IV=>4,IX=>9,XL=>40,XC=>90,CD=>400,CM=>900);foreach$e(@o){@d=$e=~/(.)/g;$c=$r{shift@d};$x=$#d>-1?0:$c;map{$n=$r{$_};$x+=$n>$c?-$c:$c;$c=$n}@d;$x+=$n;$s.= $x>0?$x:$e=~/plus/?"+":"-"};$z=eval$s;foreach$g(sort{$b<=>$a}values%r){while($z>=$g){print grep{$g==$r{$_}}keys%r;$z-=$g}}print"\n";

More tweaks, replaced 2 arrays with 1, removed splits in favor or regex, still stuck with a lookup loop for printing, will look into optimizing this.

352.47 alankila Tue Dec 26 08:23:41 2006
-pl s/[A-Z]+/($&)/g;s/[a-z]+/$&gt'n'?'+':'-'/ge;s/IV/+4/g;s/IX/+9/g;s/XL/+40/g;s/XC/+90/g;s/CD/+400/g;s/CM/+900/g;s/I/+1/g;s/V/+5/g;s/X/+10/g;s/L/+50/g;s/C/+100/g;s/D/+500/g;s/M/+1000/g;$r=eval;$_="M"x($r/1000%10)."C"x($r/100%10)."X"x($r/10%10)."I"x($r%10);s/C{9}/CM/;s/C{5}/D/;s/C{4}/CD/;s/X{9}/XC/;s/X{5}/L/;s/X{4}/XL/;s/I{9}/IX/;s/I{5}/V/;s/I{4}/IV/

The lamest imaginable solution or something.

353.47 C_Is_Better Wed Dec 27 23:14:42 2006
@v=([M,1000],[CM,900],[D,500],[CD,400],[C,100],[XC,90],[L,50],[XL,40],[X,10],[IX,9],[V,5],[IV,4],[I,1]);sub c{($n)=@_;$r=$i=0;foreach(@v){$l=length$_->[0];while(substr($n,$i,$l)eq$_->[0]){$r+=$_->[1];$i+=$l;}}$r}$p=0;$o=1;for(split(' ',<STDIN>)){$p++%2?$o=$_ eq"plus"?1:-1:($a+=$o*c$_);}foreach(@v){while($a>=$_->[1]){print$_->[0];$a-=$_->[1]}}print"\n"

353.47 Snowhare Mon Jan 1 01:50:51 2007
-na %d=(1,['I','V'],1000,['M','MMMMM'],10,['X','L'],100,['C','D']);%t=map{r($_),$_}1..3999;$s=1;$l=0;while($_=shift @F){chomp;$l+=$t{$_}*$s;$s=shift(@F) eq 'plus'?1:-1}print r($l)."\n";sub r{($l,$h)=@_;foreach $p qw(1000 100 10 1){($j,$i,$v)=(int($l/$p),@{$d{$p}});$h.=!$j?'':$j<4?$i x $j:$j<5?$i.$v:$j<6?$v:$j<9?$v.$i x ($j-5):$i.$x;$l-=$j*$p;$x=$i}$h}

Ittybitty tweak

355.47 Snowhare Mon Jan 1 01:29:45 2007
-na %d=(1,['I','V'],1000,['M','MMMMM'],10,['X','L'],100,['C','D']);%t=map{r($_),$_}1..3999;$s=1;$l=0;while($_=shift @F){chomp;$l+=$t{$_}*$s;$s=shift(@F) eq 'plus'?1:-1}print r($l)."\n";sub r{($l,$h)=@_;foreach $p qw(1000 100 10 1){($j,$i,$v)=(int($l/$p),@{$d{$p}});$h.=!$j?'':$j<4?$i x $j:$j<5?$i.$v:$j<6?$v:$j<9?$v.$i x ($j-5):$i.$x; $l-=$j*$p; $x=$i}$h}

A slightly different approach.

359.45 ciscoqid Thu Dec 28 22:03:43 2006
@r=([IV,4],[V,5],[IX,9],[I,1],[XL,40],[L,50],[XC,90],[X,10],[CD,400],[CM,900],[C,100],[D,500],[M,1000]);sub f{$i=pop;my$o;while($i){for(@r){$i=~s/$$_[0]//&&{$o+=$$_[1],last}}}$o}sub t{$i=pop;my$o;while($i){for(sort{$$b[1]<=>$$a[1]}@r){$i>=$$_[1]&&{$o.=$$_[0],$i-=$$_[1],last}}}$o}$l=<>;$l=~s/plus/+/g;$l=~s/minus/-/g;$l=~s/(\w+)/f($1)/ge;print t(eval$l),"\n";

360.52 solo Thu Dec 28 21:06:41 2006
$d='MDCLXVI';@v=(1000,500,100,50,10,5,1);@q=('',qw(0 00 000 01 1 10 100 1000 02));@r=qw(IVX XLC CDM M);while(<>){$t=$o=0;for(split){if(/n/){$o=1;next};if(/p/){$o=0;next};$l=$s=0;for(split//){$r=index($d,$_);if($r<$l){$s-=(2*$v[$l])}$s+=$v[$r];$l=$r;}$t+=$o?-$s:$s}$r='';$i=length($t)-1;for(split(//,$t)){$_=$q[$_];eval"tr/012/$r[$i]/";$r.=$_;$i--}print "$r\n"}

just a litmus test

364.46 ciscoqid Thu Dec 28 22:02:12 2006
@r=([IV,4],[V,5],[IX,9],[I,1],[XL,40],[L,50],[XC,90],[X,10],[CD,400],[CM,900],[C,100],[D,500],[M,1000]);sub f{$i=pop;my$o;while($i){for(@r){$i=~s/$$_[0]//&&{$o+=$$_[1],last}}}$o}sub t{$i=pop;my$o;while($i){for(sort{$$b[1]<=>$$a[1]}@r){$i>=$$_[1]&&{$o.=$$_[0],$i-=$$_[1],last}}}$o}$l=<STDIN>;$l=~s/plus/+/g;$l=~s/minus/-/g;$l=~s/(\w+)/f($1)/ge;print t(eval$l),"\n";

369.46 BasharTeg Thu Dec 28 02:05:00 2006
-n %t=(I=>1,V=>5,X=>10,L=>50,C=>100,D=>500,M=>1000);$l=length;@c=split//;$o=1;while($i<$l){$f=$c[$i];$_=$t{$f};$y=$t{$c[++$i]};$o=1if($f=~/p/);$o=-1if($f=~/m/);if($_&&$_<$y){$_=$y-$_;$i++}$a+=$_*$o}u(1000,M);u(900,CM);u(500,D);u(400,CD);u(100,C);u(90,XC);u(50,L);u(40,XL);u(10,X);u(9,IX);u(5,V);u(4,IV);u(1,I);print"$s\n";sub u(){while($a>$_[0]-1){$s.=$_[1];$a-=$_[0]}}

Mess with the best, die like the rest.

373.47 ciscoqid Thu Dec 28 20:04:38 2006
@r=([IV,4],[V,5],[IX,9],[I,1],[XL,40],[L,50],[XC,90],[X,10],[CD,400],[CM,900],[C,100],[D,500],[M,1000]);sub f{$i=pop;my$o;R:while($i){for(@r){$i=~s/$$_[0]//&&{$o+=$$_[1],next R}}}$o}sub t{$i=pop;my$o;R:while($i){for(sort{$$b[1]<=>$$a[1]}@r){$i>=$$_[1]&&{$o.=$$_[0],$i-=$$_[1],next R}}}$o}$l=<STDIN>;$l=~s/plus/+/g;$l=~s/minus/-/g;$l=~s/(\w+)/f($1)/ge;print t(eval $l),"\n";

377.47 ciscoqid Thu Dec 28 19:59:23 2006
@r=([IV,4],[V,5],[IX,9],[I,1],[XL,40],[L,50],[XC,90],[X,10],[CD,400],[CM,900],[C,100],[D,500],[M,1000]);sub f{$i=pop;my$o;R:while($i){for(@r){if($i=~s/$$_[0]//){$o+=$$_[1];next R}}}$o}sub t{$i=pop;my$o;R:while($i){for(sort{$$b[1]<=>$$a[1]}@r){if($i>=$$_[1]){$o.=$$_[0];$i-=$$_[1];next R}}}$o}$l=<STDIN>;$l=~s/plus/+/g;$l=~s/minus/-/g;$l=~s/(\w+)/f($1)/ge;print t(eval $l),"\n";

378.50 TeamSPAM Thu Dec 28 02:29:31 2006
-lp %r=(I,1,IV,4,V,5,IX,9,X,10,XL,40,L,50,XC,90,C,100,CD,400,D,500,CM,900,M,1000);%o=(plus,1,minus,-1);s/(plus|minus)/$o{$1}/g;while(/^([IVXLCDM]+) (-?1) ([IVXLCDM]+)(.*)/){$_=d(r($1)+$2*r($3)).$4}sub r{$o=$d=0;foreach$i(split(//,$_[0])){$n=$r{$i};$d+=($n>$o)?$n-2*$o:$n;$o=$n}$d}sub d{my$s;foreach $v(sort{$r{$b}<=>$r{$a}} keys%r){while($_[0]>=$r{$v}){$_[0]-=$r{$v};$s.=$v}}$s}

379.46 DWilson Wed Dec 27 16:38:46 2006
-pl %r=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000);%d=reverse%r;%o=(I,V,X,L,C,D);%i=(V,X,L,C,D,M); sub r{my($p,$t); for(split'',$_[0]){$c=$r{$_};$p=-$p if $p<$c;$t+=$p;$p=$c}$t+=$p} sub d{$c=$_[0];my$r;for(sort{$b<=>$a}keys%d){$d=int($c/$_);$r.=$d{$_}x$d;$c-=$d*$_} $r=~s/(?:(.)\1\1\1)/$1$o{$1}/g;$r=~s/(?:([VLD])([IXCM])\1)/$2$i{$1}/g;$r} y/pm/+-/;y/a-z//d;s/(\w+)/r($1)/eg;$_=d eval

I broke 400. Woo hoo! I can still take out a few line feeds, but I don't think I'll pass anyone ahead of me.

380.46 BasharTeg Thu Dec 28 02:00:17 2006
-n %t=(I=>1,V=>5,X=>10,L=>50,C=>100,D=>500,M=>1000);$l=length;@c=split//;$o=1;while($i<$l){$f=$c[$i];$_=$t{$f};$y=$t{$c[++$i]};$o=1if($f=~/p/);$o=-1if($f=~/m/);if($_&&$_<$y){$a+=($y-$_)*$o;$i++;next}$a+=$_*$o}u(1000,M);u(900,CM);u(500,D);u(400,CD);u(100,C);u(90,XC);u(50,L);u(40,XL);u(10,X);u(9,IX);u(5,V);u(4,IV);u(1,I);print"$s\n";sub u(){while($a>$_[0]-1){$s.=$_[1];$a-=$_[0]}}

more pimpin

382.47 ciscoqid Thu Dec 28 19:50:47 2006
@r=([IV,4],[V,5],[IX,9],[I,1],[XL,40],[L,50],[XC,90],[X,10],[CD,400],[CM,900],[C,100],[D,500],[M,1000]);sub f{$i=shift;$o=0;R:while($i){for(@r){if($i=~s/$$_[0]//){$o+=$$_[1];next R}}}$o}sub t{$i=shift;$o="";R:while($i){for(sort{$$b[1]<=>$$a[1]}@r){if($i>=$$_[1]){$o.=$$_[0];$i-=$$_[1];next R}}}$o}$l=<STDIN>;$l=~s/plus/+/g;$l=~s/minus/-/g;$l=~s/(\w+)/f($1)/ge;print t(eval $l),"\n";

387.46 BasharTeg Thu Dec 28 01:44:04 2006
-n %t=(I=>1,V=>5,X=>10,L=>50,C=>100,D=>500,M=>1000);$l=length;@c=split(//);$o=1;while($i<$l){$f=$c[$i];$_=$t{$f};$y=$t{$c[++$i]};$o=1 if($f=~/p/);$o=-1 if($f=~/m/);if($_&&$_<$y){$a+=($y-$_)*$o;$i++;next}$a+=($_*$o)}u(1000,M);u(900,CM);u(500,D);u(400,CD);u(100,C);u(90,XC);u(50,L);u(40,XL);u(10,X);u(9,IX);u(5,V);u(4,IV);u(1,I);print "$s\n";sub u(){while($a>$_[0]-1){$s.=$_[1];$a-=$_[0]}}

pimpin

390.47 NumberCruncher Wed Dec 27 16:23:27 2006
-a %r=(I=>1,V=>5,X=>10,L=>50,C=>100,D=>500,M=>1000);%t=(1=>I,4=>IV,5=>V,9=>IX,10=>X,40=>XL,50=>L,90=>XC,100=>C,400=>CD,500=>D,900=>CM,1000=>M);@o=split/\s+/,<>;foreach$e(@o){@d=split/ */,$e;$x=$#d>0?0:$r{$d[0]};$n="";$c=$r{shift@d};map{$n=$r{$_};$x+=$n>$c?-$c:$c;$c=$n}@d;$x+=$n;$s.= $x>0?$x:$e=~/plus/?"+":"-"};$z=eval$s;map{while($z>=$_){print$t{$_};$z-=$_}}sort{$b<=>$a}keys%t;print"\n";

More tweaking

391.49 derek_smalls Thu Dec 28 09:51:16 2006
%x=(1,1,2,11,3,111,4,12,5,2,6,21,7,211,8,2111,9,13);@y=(z,zIVX,zXLC,zCDM,zMMM);@A=split(/\s+/,<>); sub c{$d=shift;my$r;foreach$p(4,3,2,1){map{$r.=substr($y[$p],$_,1)}(split(//,$x{(split(//,$d))[-$p]}))};[$r,$d]}; sub f{$v=shift;map{if(c($_)->[0]eq$v){return $_}}(0..4000)}; $t+=f($A[0]);map{if($A[$_]=~/p/){$t+=f($A[$_+1])}elsif($A[$_]=~/m/){$t-=f($A[$_+1])}}(1..$#A);print c($t)->[0]."\n";

396.46 BasharTeg Thu Dec 28 01:36:10 2006
-n %t=(I=>1,V=>5,X=>10,L=>50,C=>100,D=>500,M=>1000);$l=length;@c=split(//);$o=1;while($i<$l){$f=$c[$i];$_=$t{$f};$y=$t{$c[++$i]};$o=1 if($f=~/p/);$o=-1 if($f=~/m/);next if(!$_);if($_<$y){$a+=($y-$_)*$o;$i++;next}$a+=($_*$o)}u(1000,M);u(900,CM);u(500,D);u(400,CD);u(100,C);u(90,XC);u(50,L);u(40,XL);u(10,X);u(9,IX);u(5,V);u(4,IV);u(1,I);print "$s\n";sub u(){while($a>$_[0]-1){$s.=$_[1];$a-=$_[0]}}

word.jpg

398.39 dirving Mon Jan 1 22:41:45 2007
-n @c=(M,D,C,L,X,V,I);$z{$_}=$l++ for@c,Z,$s++;split;for(@_){$s=/^m/?-1:/^p/?1:$s;@d=(split(''),Z);$p{$d[$_]}+=$z{$d[$_]}>$z{$d[$_+1]}?-$s:$s for 0..$#d}sub p{@o=(@_,$m?$c[$m]:'',$c[$i],@o)}for($i=7;$i--;){for($p{$c[$i]}){if($m&&$m-$i>1){$_--;p;$m=0}$g=$i%2?2:5;while($y=$_<0?1:$_>=$g?-1:0){$p{$c[$i-1]}-=$y;$_+=$g*$y}if($_>3&&!$m){$p{$c[$i-1]}++;$m=$i}elsif($_>0){p$c[$i]x($_-1);$m=0}}}print@o," "

408.48 Snowhare Mon Jan 1 00:23:24 2007
%c=qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000);%d=(1,['I','V'],1000,['M','MMMMM'],10,['X','L'],100,['C','D']);$s=1;$l;@ARGV=split(/ /,<>);while($q=shift){($_,$k,$f)=($q,0,1000);s/(.)/$j=$c{$1};$k-=($f<$j)*2*$f-$j;$f=$j/ge;$l+=$k*$s;$s=shift eq 'plus'?1:-1}map{($j,$i,$v)=(int($l/$_),@{$d{$_}});$h.=!$j?'':$j<4?$i x $j:$j<5?$i.$v:$j<6?$v:$j<9?$v.$i x ($j-5):$i.$x;$l-=$j*$_;$x=$i} qw(1000 100 10 1);print "$h\n";

Not even close to the smallest. Mainly just for fun. I'll be interested to find out how the top ones approached 100. :)

409.47 BasharTeg Thu Dec 28 01:31:09 2006
-n %t=(I=>1,V=>5,X=>10,L=>50,C=>100,D=>500,M=>1000);$l=length;@c=split(//);$o=1;for(;$i<$l;$i++){$f=$c[$i];$_=$t{$f};$y=$t{$c[$i+1]};$o=1 if($f=~/p/);$o=-1 if($f=~/m/);next if(!$_);if($_<$y){$a+=($y-$_)*$o;$i++;next}$a+=($_*$o)}u(1000,M);u(900,CM);u(500,D);u(400,CD);u(100,C);u(90,XC);u(50,L);u(40,XL);u(10,X);u(9,IX);u(5,V);u(4,IV);u(1,I);print "$s\n";sub u(){$v=shift;$c=shift;while($a>$v-1){$s.=$c;$a-=$v}}

word

410.52 DWilson Wed Dec 27 08:21:00 2006
-l %r=qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000);%d=reverse%r;%o=qw(I V X L C D);%i=qw(V X L C D M); sub r{$p=0;$t=0; for(split'',$_[0]) {$c=$r{$_};if($p<$c){$c-=$p;$p=0}$t+=$p;$p=$c}$t+=$p} sub d{$c=$_[0];my$r;for(sort{$b<=>$a}keys%d){$d=int($c/$_);$r.=$d{$_}x$d;$c-=$d*$_} $r=~s/(?:(.)\1\1\1)/$1$o{$1}/g;$r=~s/(?:([VLD])([IXCM])\1)/$2$i{$1}/g;$r} while(<>){s/plus/+/g;s/m\w+/-/g;s/(\w+)/r($1)/eg;print d(eval)}

411.53 DWilson Wed Dec 27 08:13:36 2006
-l %r=qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000);%d=reverse%r;%o=qw(I V X L C D);%i=qw(V X L C D M); sub r{$p=0;$t=0; for(split'',$_[0]) {$c=$r{$_};if($p<$c){$c-=$p;$p=0}$t+=$p;$p=$c}$t+=$p} sub d{$c=$_[0];my$r;for(sort{$b<=>$a}keys%d){$d=int($c/$_);$r.=$d{$_}x$d;$c-=$d*$_} $r=~s/(?:(.)\1\1\1)/$1$o{$1}/g;$r=~s/(?:([VLD])([IXCM])\1)/$2$i{$1}/g;$r} while(<>){s/plus/+/g;s/minus/-/g;s/(\w+)/r($1)/eg;print d(eval)}

I don't think I'll win...I've stripped all but a few line feeds from this solution...but at least it USED to be readable :-)

412.43 tryit Mon Dec 25 04:32:46 2006
$_=<STDIN>;@r=('IV','IX','XL','XC','CD','CM','I','V','X','L','C','D','M');@d=(4,9,40,90,400,900,1,5,10,50,100,500,1000);s/ p\S+ /+/g;s/ m\S+ (\w+)/-$$1$/g;for$n(0..$#d){s/$r[$n]/+$d[$n]/g}s/\+\+/+/g;$t=eval($_);@r=('M','CM','D','CD','C','XC','L','XL','X','IX','V','IV','I');@d=(1000,900,500,400,100,90,50,40,10,9,5,4,1);while($t>0){for$n(0..$#d){for$o(0..3){if($t>=$d[$n]){$r.=$r[$n];$t-=$d[$n]}}}}print$r."\n"

romancalc.pl: 412.57 strokes (ok), md5=8a9e86331e208b287fdbae84979bfd5d Congratulations! All tests passed for all holes (v1 testsuite)

416.60 dcutter Wed Dec 27 00:13:23 2006
-an @r=qw(IV IX XL XC CD CM V L D I X C M);@s=qw(M CDM XLC IVX);for(@F){push(@o,$_),next if/s/;for($i=$a=0;$i<13;$i++){$a+=qw(4 9 40 90 400 900 5 50 500 1 10 100 1000)[$i]*$_ for$_=~s/$r[$i]//g}push@n,$a}$a=shift@n;for(@o){$b=shift@n;$a+=$b if/p/;$a-=$b if/m/}for(reverse$a=~/./g){($i,$v,$x)=split//,pop@s;$r="$i$v$r",next if$_==4;$r="$i$x$r",next if$_>8;$r=$v.($i x($_%5)).$r,next if$_>4;$r=($i x$_).$r}print"$r\n";

Shaved a few strokes here and there but basicly the same algorithm.

424.50 TeamSPAM Thu Dec 28 01:53:53 2006
%r=(I,1,IV,4,V,5,IX,9,X,10,XL,40,L,50,XC,90,C,100,CD,400,D,500,CM,900,M,1000);$c=<>;%o=(plus,1,minus,-1);$c=~s/(plus|minus)/$o{$1}/g;while($c=~/^([IVXLCDM]+) (-?1) ([IVXLCDM]+)(.*)/){$c=d(r($1)+$2*r($3)).$4}print"$c\n";sub r{@r=split(//,$_[0]);$o=$d=0;foreach$ri(@r){$n=$r{$ri};$d+=($n>$o)?$n-2*$o:$n;$o=$n}return$d}sub d{$d=$_[0];my$s;foreach my$v(sort{$r{$b}<=>$r{$a}}keys%r){while($d>=$r{$v}){$s.=$v;$d-=$r{$v}}}return$s}

434.46 NumberCruncher Wed Dec 27 15:35:01 2006
-a %r=(I=>1,V=>5,X=>10,L=>50,C=>100,D=>500,M=>1000);%t=(1=>I,4=>IV,5=>V,9=>IX,10=>X,40=>XL,50=>L,90=>XC,100=>C,400=>CD,500=>D,900=>CM,1000=>M);@o=split/\s+/,<>;foreach$e(@o){@d=split/ */,$e;$x=$#d>0?0:$r{$d[0]};$n="";$c=$r{shift@d};map{$n=$r{$_};$x+=$n>$c?-$c:$c;$c=$n}(@d);$x+=$n;push @v,($x>0?$x:($e=~/plus/?"+":"-"))};$s=join(" ",@v);$z=eval$s;map{while($z>=$_){push@l,$t{$_};$z-=$_}}(sort{$b<=>$a}keys%t);printf"%s\n",join("",@l);

Tweaked ...

435.59 dcutter Tue Dec 26 20:01:40 2006
-an @r=qw(IV IX XL XC CD CM V L D I X C M);@a=qw(4 9 40 90 400 900 5 50 500 1 10 100 1000);@t=qw(IVX XLC CDM M);for(@F){push(@op,$_),next if/s/;for($i=$a=0;$i<13;$i++){$a+=$a[$i]*$_ for$_=~s/$r[$i]//g};push@n,$a}for(@op){$a=shift@n;$n[0]+=$a if/p/;$n[0]=$a-$n[0]if/m/}for(reverse$n[0]=~/./g){($i,$v,$x)=split//,shift@t;$r="$i$v$r",next if$_==4;$r="$i$x$r",next if$_==9;$c=$_%5;$r=$v.($i x$c).$r,next if$_>4;$r=($i x$c).$r;}print"$r\n";

I couldn't get -an to work. It wasn't until I pasted, that I noticed I had only written '#Perl -an'. Fool me to use windows.

437.44 BasharTeg Thu Dec 28 01:21:33 2006
-n %t=(I=>1,V=>5,X=>10,L=>50,C=>100,D=>500,M=>1000);$l=length;@c=split(//);$o=1;for(;$i<$l;$i++){$f=$c[$i];$_=$t{$f};$y=$t{$c[$i+1]};$o=1 if($f=~/p/);$o=-1 if($f=~/m/);next if(!$_);if($_<$y){$a+=($y-$_)*$o;$i++;next;}$a+=($_*$o);}u(1000,'M');u(900,'CM');u(500,'D');u(400,'CD');u(100,'C');u(90,'XC');u(50,'L');u(40,'XL');u(10,'X');u(9,'IX');u(5,'V');u(4,'IV');u(1,'I');print "$s\n";sub u(){$v=shift;$c=shift;while($a>$v-1){$s.=$c;$a-=$v}}

Not bad for a C++ developer.

437.49 jimbo Thu Dec 28 23:12:09 2006
%t=(0,':0:0:0:0:0',1,':I:X:C',2,':II:XX:CC',3,':III:XXX:CCC',4,':IV:XL:CD',5,':V:L:D',6,':VI:LX:DC',7,':VII:LXX:DCC',8,':VIII:LXXX:DCCC',9,':IX:XC:CM');for$i(1..16384){$x{rt($i)}=$i}$_=uc<STDIN>;chomp;@a=split/ /;$t=shift@a;$u=$x{$t};while(@a){$o=shift@a;$b=shift@a;$u+=($o=~/^P/?$x{$b}:$x{$b}*-1)}sub rt{@r=split//,$_[0];$z='';while(@r){$y=shift@r;$y+=10if(@r>3);$z.=(@r>2?'M'x$y:(split/:/,$t{$y})[@r+1])}$z=~s/0//g;$z}print rt($u)."\n"

romancalc.pl: 437.49 strokes (ok), md5=a6907362fa904eebb94355e1cef7dd3b Congratulations! All tests passed for all holes (v1 testsuite) How about a test that goes beyond 4000? Like: in: MMMCMXCIX PLUS MMMCMXCIX out: MMMMMMMCMXCVIII

440.59 dcutter Tue Dec 26 19:59:24 2006
@r=qw(IV IX XL XC CD CM V L D I X C M);@a=qw(4 9 40 90 400 900 5 50 500 1 10 100 1000);@t=qw(IVX XLC CDM M);for(split/ /,<>){push(@op,$_),next if/s/;for($i=$a=0;$i<13;$i++){$a+=$a[$i]*$_ for$_=~s/$r[$i]//g};push@n,$a}for(@op){$a=shift@n;$n[0]+=$a if/p/;$n[0]=$a-$n[0]if/m/}for(reverse$n[0]=~/./g){($i,$v,$x)=split//,shift@t;$r="$i$v$r",next if$_==4;$r="$i$x$r",next if$_==9;$c=$_%5;$r=$v.($i x$c).$r,next if$_>4;$r=($i x$c).$r;}print"$r\n";

It was nice to golf again after so long. Haven't got any better though.

461.57 cdman83 Thu Dec 28 21:54:02 2006
%b=(0,'');sub a{$j=0;$b{$c*++$j} = $_ for@z;}$c=1;@z=qw{I II III IV V VI VII VIII IX};a;$c*=10;@z=qw{X XX XXX XL L LX LXX LXXX XC};a; $c*=10;@z=qw{C CC CCC CD D DC DCC DCCC CM};a;$c*=10;@z=qw{M MM MMM};a;foreach(1..3999) {next if($b{$_});@d=reverse split //,$_;$b{$_}=$b{$d[3]*1000}.$b{$d[2]*100}.$b{$d[1]*10}.$b{$d[0]};}%e=();$e{$b{$_}}=$_ for keys%b;$g=0;$h=1;foreach(split /\s+/,<>){$h=1 if(/p/);$h=-1 if(/min/);$g+=$e{$&}*$h if(/[A-Z]+/);}print $b{$g}."\n";

462.58 cdman83 Wed Dec 27 21:13:34 2006
%v=qw{M 1000 D 500 C 100 L 50 X 10 V 5 I 1}; %z=qw{4 IV 9 IX 40 XL 90 XC 400 CD 900 CM};foreach $l(1..3){foreach(keys%v){$i=$v{$_}*$l;$z{$i}=$_ x$l if(!$z{$i});}}$l=0;$x=1;foreach(split/\s+/,<>){$x=1 if(/p/);$x=-1 if(/min/);if (/[A-Z]+/) {foreach $n(1..8000){if($& eq r($n)){$l+=$x*$n;last;}}}}print r($l)."\n";sub r{($a)=@_;$b='';$c=10**(-1+length $a);foreach(split //, $a){$d=$_*$c;foreach (sort {$b<=>$a} keys %z){if($_ <= $d){$b.=$z{$_};$d-=$_;}}$c/=10;}$b;}

467.40 Pete Krawczyk Thu Dec 28 19:40:15 2006
-lp @v=(1000,500,100,50,10,5,1);@l=qw(M D C L X V I);sub a{$n=shift;$s='';for$i(0..6) {while($n>=$v[$i]){$s.=$l[$i];$n -= $v[$i]}if($v[$i+1]*5!=$v[$i]&&$n>=($v[$i]-$v[$i+2])){$s.=$l[$i+2].$l[$i];$n-=($v[$i]-$v[$i+2])}if($v[$i+1]*2!=$v[$i]&&$n>=($v[$i]-$v[$i+1])){$s.=$l[$i+1].$l[$i];$n-=($v[$i]-$v[$i+1]);}}$s}for$b(1..3999){$r=a($b);$x{$r}=$b;$x{$b}=$r}$s=0;@w=split(/\s+/);$s=$x{$w[0]};for$p(1,3,5){$w[$p]and$s+=($w[$p]eq'plus'?$x{$w[$p+1]}:-$x{$w[$p+1]})}$_=$x{$s}

486.50 Friar Tue Jan 2 06:10:14 2007
%h=(M=>1000,D=>500,C=>100,L=>50,X=>10,V=>5,I=>1);%r=reverse%h;sub plus{$v+=shift}sub minus{$v-=shift}sub i{$b=$w=0;split//,reverse shift@n;for(0..$#_){$x=$h{@_[$_]};$b+=$x<$w?-$x:($w=$x);}$b}$_=<>;s/\+/plus/;s/-/minus/;@n=split;$v=i();while(int@n){$f=shift@n;&$f(i())}@n=split//,$v;while(defined($v=shift@n)){$v*=10**int@n;for(sort{$b<=>$a}keys%r){$k=$r{$_};m/^(.)/;$g=$r{$_/($1==1?10:5)};while($v>$_){$o.=$k;$v-=$_}if($v==$_){$o.=$k;last}if($v+$h{$g}==$_){$o.=$g.$k;last}}}print"$o\n";

488.52 reveng Sat Dec 23 05:54:25 2006
-l sub a{$@=pop;$a=0;$l=1e3;for(split//,$@){$d=$r{$_};$a-=2*$l if$l<$d;$a+=($l=$d)}$a}%r=qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000);%Z=qw(1 IV 10 XL 100 CD 1000 MMMMMM);@f=reverse sort keys%Z;grep($Z{$_}=[split(//,$Z{$_},2)],@f);sub R{$y=pop;for(@f){($d,$i,$v)=(int($y/$_),@{$Z{$_}});if(1<=$d&&$d<=3){$r.=$i x$d}elsif($d==4){$r.="$i$v"}elsif($d==5){$r.=$v}elsif(6<=$d&&$d<=8){$r.=$v.$i x($d-5)}elsif($d==9){$r.="$i$@"}$y-=$d*$_;$@=$i}$r}$_=<>;s/plus/+/g;s/m\w+/-/g;s/\w+/a$&/eg;print R+eval

489.49 mreece Mon Jan 1 00:16:00 2007
%r=qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000);%d=(1,['I','V'],10,['X','L'],100,['C','D'],1000,['M']);sub a{$l=1000;$a=0;for(split//,shift){($d)=$r{$_};$l<$d&&($a-=2*$l);$a+=($l=$d)}$a}sub R {$a=shift;for(1000,100,10,1){($d,$i,$v)=(int($a/$_),@{$d{$_}});if(1<=$d&&$d<=3){$r.=$i x$d}elsif($d==4){$r.="$i$v"}elsif($d==5){$r.=$v}elsif(6<=$d&&$d<=8){$r.=$v.$i x($d-5)}elsif($d==9){$r.="$i$x"}$a-=$d*$_;$x=$i}$r}sub n{$_=<>;split;$n=a(shift);$n+=(shift=~/p/||-1)*a(shift)while@_;$n}print R(n),"\n"

493.54 corps Fri Dec 29 16:47:38 2006
-l @F=split' ',<>;@L=qw(IIII VIIII XXXX LXXXX CCCC DCCCC);@S=qw(IV IX XL XC CD CM);@Q=qw(IIIII VV XXXXX LL CCCCC DD);@R=qw(V X L C D M);sub x{index('MDCLXVI',"@_")}sub f{$_[0]=~s/$Q[$_]/$R[$_]/gfor(0..5)}sub a{$_[0]=~s/$S[$_]/$L[$_]/gfor(0..5)}$_=$F[0];while($F[$I+1]){a$_;a$F[$I+2];if($F[++$I]eq'plus'){$_=join'',sort{x($a)<=>x($b)}split//,$_.$F[++$I];f$_}else{++$I;while($F[$I]){$F[$I]=~s/$&//&&s/$&//while(/./g);for$i(0..5){s/$R[$i]/$Q[$i]/g}}f$_}for$i(1..6){$i*=-1;s/$L[$i]/$S[$i]/g}}print

508.61 cdman83 Wed Dec 27 20:20:37 2006
%v=qw{M 1000 D 500 C 100 L 50 X 10 V 5 I 1};%z=qw{4 IV 9 IX 40 XL 90 XC 400 CD 900 CM};foreach $k (keys %v) {foreach (1..3){$i=$v{$k} * $_; $z{$i} = $k x $_ if(!exists $z{$i});}}$l=0;$x=1;foreach(split /\s+/,<>) {$x=1 if(/plus/);$x=-1 if(/minus/);if(/[IVXLCDM]+/){foreach $n (1..8000){if ($& eq r($n)){$l+=$x*$n;last;}}}}print r($l)."\n";sub r{$a=shift;$b='';$c=1;foreach (reverse split //, $a) {$d=$_*$c; $e='';foreach (sort {$b<=>$a} keys %z){if ($_ <= $d) {$e.=$z{$_};$d-=$_;}}$c*=10;$b=$e.$b;}return $b;}

533.47 NumberCruncher Tue Dec 26 23:22:15 2006
%r=(I=>1,V=>5,X=>10,L=>50,C=>100,D=>500,M=>1000);%t=(1=>I,4=>IV,5=>V,9=>IX,10=>X,40=>XL,50=>L,90=>XC,100=>C,400=>CD,500=>D,900=>CM,1000=>M);@j=(0,2,4,6);@k=(1,3,5);@o=split/\s+/,<>;foreach(@k){last if$_>$#o;$v[$_]=$o[$_]eq"plus"?"+":"-"}; foreach(@j){last if$_>$#o;@d=split/ */,$o[$_];$x=$#d>0?0:$r{$d[0]};$n="";for($i=0;$i<$#d;$i++){$c=$r{$d[$i]};$n=$r{$d[$i+1]}; $x+=$n>$c?-$c:$c}$x+=$n;$v[$_]=$x}; $s=sprintf "%s",join(" ",@v);$z=eval$s;foreach(sort{$b<=>$a}keys%t){while($z>=$_){push@l,$t{$_};$z-=$_}}printf"%s\n",join("",@l);

578.64 ciscoqid Thu Dec 28 19:46:34 2006
@r = ( [IV,4], [V,5], [IX,9], [I,1], [XL,40], [L,50], [XC,90], [X,10], [CD,400], [CM,900], [C,100], [D,500], [M,1000] ); sub f { $i = shift; $o = 0; R: while ($i) { for (@r) { if ($i =~ s/$$_[0]//) { $o += $$_[1]; next R; } } } $o; } sub t { $i = shift; $o = ""; R: while ($i) { for (sort {$$b[1]<=>$$a[1]} @r) { if ($i >= $$_[1]) { $o .= $$_[0]; $i -= $$_[1]; next R; } } } $o; } $l = <STDIN>; $l =~ s/plus/+/g; $l =~ s/minus/-/g; $l =~ s/(\w+)/f($1)/ge; print t(eval $l), "\n";

647.50 jimbo Thu Dec 28 21:48:19 2006
-w %tt=(0,'0:-:-:-:-:-',1,'0:I:X:C',2,'0:II:XX:CC',3,'0:III:XXX:CCC',4,'0:IV:XL:CD',5,'0:V:L:D',6,'0:VI:LX:DC',7,'0:VII:LXX:DCC',8,'0:VIII:LXXX:DCCC',9,'0:IX:XC:CM');%hs=(IV,'IIII',IX,'VIIII',XL,'XXXX',XC,'LXXXX',CD,'CCCC',CM,'DCCCC');%ht=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000);$_=uc<STDIN>;chomp;@a=split/ /;$t=shift@a;$z='';while(@a){$o=shift@a;$b=shift@a;foreach$i(keys%hs){$t=~s/$i/$hs{$i}/g;$b=~s/$i/$hs{$i}/g}foreach$i(keys%ht){$t=~s/$i/+$ht{$i}/g;$b=~s/$i/+$ht{$i}/g}$y=sprintf('$t=(%s)%s(%s)',$t,$o=~m/^P/?'+':'-',$b);eval"$y"}@r=split//,$t;$c=@r;while(@r){$y=shift@r;$z.=($c<4?(split(/:/,$tt{$y}))[$c]:'M'x$y);$c--}$z=~s/\-//g;print"$z\n"

romancalc.pl: 647.50 strokes (ok), md5=a2845f8cad89f3c787d92bfdec310fdc Congratulations! All tests passed for all holes (v1 testsuite)

758.55 Friar Mon Jan 1 21:51:37 2007
%h=(I=>1,V=>5,X=>10,L=>50,C=>100,D=>500,M=>1000); %m=(V=>"I",X=>"I",L=>"X",C=>"X",D=>"C",M=>"C"); %r=reverse %h; sub plus {shift()+shift} sub minus {shift()-shift} sub p {my $x=shift;for(0..shift){$x*=10}$x} sub i {my $v=$n=0;split //,shift;for(reverse 0..$#_){$x=$h{@_[$_]};$v+=($x<$n)?(-$x):($n=$x);}$v;} while(<>){ s/\+/plus/; s/-/minus/; @n=split; my $v=i(shift @n); for(0..($#n/2)) {$f=shift @n;$v=&$f($v,i(shift @n));} @n=split //,$v; @o=map p(shift @n,int @n-1),@n; for $v (@o){ next if($v==0); for $x (sort {$b<=>$a} keys %r){ while($v-$x>0){print($r{$x});$v-=$x;} if($v-$x==0){print($r{$x});$v-=$x;last;} if($v-$x==-1||$v-$x==-10||$v-$x==-100){print $m{$r{$x}}.$r{$x};$foo=$x-$h{$m{$r{$x}}};$v-=$foo;last;} } } print "\n"; }

1034.51 jimbo Thu Dec 28 17:59:07 2006
-w my %tt=(0,'0:-:-:-:-:-',1,'0:I:X:C',2,'0:II:XX:CC',3,'0:III:XXX:CCC',4,'0:IV:XL:CD',5,'0:V:L:D',6,'0:VI:LX:DC',7,'0:VII:LXX:DCC',8,'0:VIII:LXXX:DCCC',9,'0:IX:XC:CM',);my %sc2=('IV','IIII','IX','VIIII','XL','XXXX','XC','LXXXX','CD','CCCC','CM','DCCCC',);my %t2=(1,'I',2,'X',3,'C',4,'M',5,'MMMMMMMMM',);my %hrt;my %hrtn;my $z;$hrt{0}=0;for my $i(1..16384){$hrt{rc($i)}=$i;$hrtn{$i}=$z;}my $si=<STDIN>;chomp($si);my @a=split(/ /,$si);my $b;my $t=sprintf('$b = %s %s %s %s %s %s %s',$hrt{(ec($a[0]))},($a[1]=~m/^p/)?'+':'-',$hrt{(ec($a[2]))},(defined($a[3])&&$a[3]=~m/^p/)?'+':'-',$hrt{(defined($a[4]))?ec($a[4]):0},(defined($a[5])&&$a[5]=~m/^p/)?'+':'-',$hrt{(defined($a[6]))?ec($a[6]):0});eval $t;printf( "%s\n",$hrtn{$b});exit 0;sub rc{my $v="";$z="";my $t=$_[0];my $l=length $t;for my $c(reverse 1..$l){my $p=$l-$c;my $y=substr$t,$p,1;$v=$v.$t2{$c}x$y;$z=$z.($c<4?(split(/:/,$tt{$y}))[$c]:'M'x$y);}$z=~s/\-//g;$v}sub ec{my $t=uc$_[0];foreach my $x(keys %sc2){$t=~s/$x/$sc2{$x}/g;}$t=~s/V/IIIII/g;$t=~s/L/XXXXX/g;$t=~s/D/CCCCC/g;$t}

romancalc.pl: 1034.51 strokes (ok), md5=8975d6263dd9fb355c13b34e6232988f Congratulations! All tests passed for all holes (v1 testsuite)

1154.84 Andy Lester Sat Dec 23 18:39:54 2006
-l my %numerals = qw( I 1 V 5 X 10 L 50 C 100 D 500 M 1000 ); chomp(my $line = <STDIN>); my @words = split / /, $line; my $total = 0; my $mult = 1; for my $word ( @words ) { if ( $word eq 'plus' ) { $mult = 1; } elsif ( $word eq 'minus' ) { $mult = -1; } else { my $value = deroman( $word ); $total += ($mult * $value); } } print romanify( $total ); sub deroman { my $str = uc shift; my $n = 0; my @values = ( ( map { $numerals{$_} } split //, $str ), 0 ); while ( my $x = shift @values ) { if ( $x >= $values[0] ) { $n += $x; } else { $n -= $x; } } return $n; } sub romanify { my $n = shift; my $str = ''; my @whittlers = qw( M IM VM XM CM D ID CD C IC XC L XL X IX V IV I ); while ( my $letter = shift @whittlers ) { my $factor = deroman( $letter ); while ( $n && ( $n >= $factor ) ) { $n -= $factor; $str .= $letter; } } # while return $str; }

NOW definitely w/o warnings and strict.

Artistic/Unorthodox

Score Golfer Submit Time Code

Rejected

Score Golfer Submit Time Code

2.99 reveng Sat Dec 23 09:18:38 2006
hm

17.94 ton Sat Dec 30 23:01:02 2006
-switches c ecode

31.97 ton Sat Dec 30 22:37:36 2006
-switches codecodecodecod ecode

147.53 ambrus Wed Dec 27 10:10:11 2006
-lp sub k{$t="";$t=~y/IVXLCD/XLCDMP/d,$t.=("",I,II,III,IV,V,VI,VII,VIII,IX)[$_]for$q=~/./g}for$q(1..4e3){k,s/\b$t\b/$q/}y/il-z/-+ /;$q=eval;k;$_=$t

romancalc.pl: Running test 2 ... Unexpected STDOUT: Tested: I plus I Expected: II but got: I

164.58 Nexion Thu Dec 28 06:39:25 2006
%x=qw/M 1000 D 500 C 100 L 50 X 10 V 5 I 1/;for(split(/\s/,<>)){s/plus/+/;s/minus/-/;if(/\w/){while($_){s/^(\w)//;$r=$r+$x{$1}}$x.=$r;$r=0}else{$x.=$_}}print eval$x

Use the test program! Hole 'romancalc' romancalc.pl: Running test 1 ... Unexpected STDOUT: Tested: II minus I Expected: I but got: 1

167.57 Nexion Thu Dec 28 06:20:38 2006
%x=qw/M 1000 D 500 C 100 L 50 X 10 V 5 I 1/;for(split(/\s/,<>)){s/plus/+/;s/minus/-/;if(/\w/){while($_){s/^(\w)//;$r=$r+$x{$1}}$x.=$r;$r=0}else{$x.=$_;}}print eval($x)

179.42 carldr Sun Dec 24 13:27:30 2006
-p for($i=4e3;$j=--$i;){for$d(unpack"n*","^C\xe8^C\x84^A\xf4^A\x90\0d\0Z\02\0(\0 \0 \0^E\0^D\0^A"){$e=$m[$i].=(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I)[$f++%13]x($j/$d);$j%=$d}s/\b$e/$i/g}y/pma-z/+-/d;$_="$m[eval] "

Bah, packing only saves me one bytes! I think it's time to look for a better way of generating the roman numerals.
couldn't retrieve golf code

181.38 pengvado Mon Jan 1 17:57:07 2007
-alp y/IVXLCDM/0-6/,$%=/s/?/m/:s#.#$:-=("$&9"lt$'^$%||-1)*5**($&%2)*10**($&>>1)#gefor@F;$,=(($^=1+chop$:)%5?"":$_).($^>4&&int$_+$^/5).$_ x($^%5-1).$,for 0,2,4,6;$_=$,;y/0-6/IVXLCDM/

186.43 Nexion Thu Dec 28 06:07:34 2006
%x=('M'=>1000,'D'=>500,'C'=>100,'L'=>50,'X'=>10,'V'=>5,'I'=>1);for(split(/\s/,<>)){s/plus/+/;s/minus/-/;if(/\w/){while($_){s/^(\w)//;$r=$r+$x{$1}}$x.=$r;$r=0}else{$x.=$_;}}print eval($x)

190.43 Nexion Thu Dec 28 06:00:57 2006
%x=('M'=>1000,'D'=>500,'C'=>100,'L'=>50,'X'=>10,'V'=>5,'I'=>1);for(split(/\s/,<>)){s/plus/+/;s/minus/-/;if($_=~/\w/){while($_){s/^(\w)//;$r=$r+$x{$1}}$x.=$r;$r=0}else{$x.=$_;}}print eval($x)

196.50 jimbo Wed Dec 27 03:57:45 2006
-lp %v=(I,1,V,5,X,10,L,50,C,100,D,500,M,1e3);s/plus/+/g;s/minus/-/g;s/I(?!(\b|I))/-I/g;s/(\w)(?!\b)/$1+/g;s/(\w)/$v{$1}/g;$x=I x eval$_;map{$x=~s/I{$v{$_}}/$_/g}keys%v;$_=$x;s/VIIII/IX/;s/IIII/IV/

romancalc.pl: Running test 40 ... Unexpected STDOUT: Tested: XXXIX plus I Expected: XL but got: XXXX

203.43 Nexion Thu Dec 28 05:52:06 2006
%x=('M'=>1000,'D'=>500,'C'=>100,'L'=>50,'X'=>10,'V'=>5,'I'=>1);chomp($_=<>);s/plus/+/;s/minus/-/;for(split(/\s/,$_)){if($_=~/\w/){while($_){s/^(\w)//;$r=$r+$x{$1}}$x.=$r;$r=0}else{$x.=$_;}}print eval($x)

weee

203.46 shmem Thu Dec 28 17:01:28 2006
-lp s/(p|m)?\w+/$1?$1eq p?'+':'-':"($&)"/ge;@l=split//,IVXLCDM;$c=.5;for$i(0..6){$c*=$i%2?5:2;s/$l[$i]([@l[$i+1,$i+2]])?/($1?'-':'+').$c.$1/eg}$_=eval;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;1!eg

romancalc.pl: Running test 4 ... Unexpected STDOUT: Tested: III plus I Expected: IV but got: IIII

205.46 shmem Thu Dec 28 16:07:06 2006
-lp s/(p|m)?\w+/$1?($1eq p?'+':'-'):"($&)"/ge;@l=split//,IVXLCDM;$c=.5;for$i(0..6){$c*=$i%2?5:2;s/$l[$i]([@l[$i+1,$i+2]])?/($1?'-':'+').$c.$1/ge}$_=eval;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;1!eg

Be sure to use the test program!

208.45 Nexion Thu Dec 28 04:58:40 2006
%x=('M'=>1000,'D'=>500,'C'=>100,'L'=>50,'X'=>10,'V'=>5,'I'=>1);chomp($_=<STDIN>);s/plus/+/;s/minus/-/;for(split(/\s/,$_)){if($_=~/\w/){while($_){s/^(\w)//;$r=$r+$x{$1}}$x.=$r;$r=0}else{$x.=$_;}}print eval($x)

*burp*

208.46 shmem Thu Dec 28 15:30:50 2006
-lp s/(p|m)?\w+/$1?($1eq p?'+':'-'):"($&)"/ge;@l=split//,IVXLCDM;$c=.5;for$i(0..6){$c*=$i%2?5:2;s/$l[$i]($l[$i+1]|$l[$i+2])?/($1?'-':'+').$c.$1/ge;}$_=eval;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;1!eg

215.47 jimbo Wed Dec 27 03:48:59 2006
%v=(I,1,V,5,X,10,L,50,C,100,D,500,M,1e3);$_=<>;s/\s//g;s/plus/+/g;s/minus/-/g;s/I(?!(\b|I))/-I/g;s/(\w)(?!\b)/$1+/g;s/(\w)/$v{$1}/g;$x=I x(eval$_);map{$x=~s/I{$v{$_}}/$_/g;}keys%v;$_=$x;s/VIIII/IX/;s/IIII/IV/;print;

Need to print out newlines -- use the test program to test

216.47 davidrw Wed Dec 27 22:56:56 2006
-lp @.{@!=qw/M CM D CD C XC L XL X IX V IV I/}=(1e3,900,500,400,100,90,50,40,10,9,5,4,1);y/ma-z/-/d;s/- (\S+)/-($1)/g;$$=join'|',grep/../,@!;s/$$|\w/+$.{$&}/g;$.=eval;for(@!){$.-=$.{$_},$,.=$_ while$.-$.{$_}>=0}$_=$,

Hole 'romancalc' romancalc.pl: Running test 1 ... Unexpected STDERR: Tested: II minus I Expected: but got: Modification of a read-only value attempted at romancalc.15659 line 2, <> line 1.

222.45 shmem Thu Dec 28 14:37:05 2006
-lp s/(p|m)?\w+/$1?($1eq p?'+':'-'):"($&)"/ge;@l=split//,IVXLCDM;$c=.5;for$i(0..6){$c*=$i%2?5:2;s/$l[$i]($l[$i+1]|$l[$i+2])/($1?'-':'+').$c.$1/ge;s/$l[$i]/+$c/g;}$_=eval;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;1!eg

224.49 carldr Sat Dec 23 10:53:12 2006
-p %t=(1=>I,4=>IV,5=>V,9=>IX,10=>X,40=>XL,50=>L,90=>XC,100=>C,400=>CD,500=>D,900=>CM,1000=>M);for($i=4000;$j=--$i;){for$n(sort{$b<=>$a}keys%t){$m[$i].=$t{$n}x($j/$n);$j%=$n}s/$m[$i]/$i/g}s/plus/+/g;s/minus/-/g;$_="$m[eval] "

232.48 carldr Sat Dec 23 10:47:52 2006
-p %t=(1=>I,4=>IV,5=>V,9=>IX,10=>X,40=>XL,50=>L,90=>XC,100=>C,400=>CD,500=>D,900=>CM,1000=>M);for($i=4000;$j=--$i;){$s="";for$n(sort{$b<=>$a}keys%t){$s.=$t{$n}x($j/$n);$j%=$n}$m[$i]=$s;s/$s/$i/g}s/plus/+/g;s/minus/-/g;$_="$m[eval] "

238.44 jql Thu Dec 28 21:46:47 2006
-lp y/IXCMVLDpmslia-z/0123456))(+-/d;s// /g;s/\d/qw(+ -)[$'%4>=$&&$'>$&].10**($&&3)*($&<4||5)/eg;$_=join"",map{(4-$x++)x$_}split//,eval"1000+($_)";s/([^4])(\1{3}(\1{1}(\1{4})?)?)/$4?$1.($1+1):$3?$1+4:$1.(4+$1)/e g;y/1234567/IXCMVLD/;s/.//

Have you used the test program? If so, try attaching your solution just in case it's getting munged somehow in the text box: romancalc.pl: Running test 1 ... Unexpected STDOUT: Tested: II minus I Expected: I but got: MMMMMMMMCMXC

241.47 carldr Sat Dec 23 10:37:37 2006
-p %t=(1=>I,4=>IV,5=>V,9=>IX,10=>X,40=>XL,50=>L,90=>XC,100=>C,400=>CD,500=>D,900=>CM,1000=>M);for($i=4000;$j=--$i;){$s=$t="";for$n(sort{$b<=>$a}keys%t){$s.=$t{$n}x($j/$n);$j%=$n}$m[$i]=$s;s/$s/$i/g}s/plus/+/g;s/minus/-/g;$_=eval;$_="$m[$_] "

Getting shorter! Only the plus/minus regular expressions are annoying me now.

257.48 carldr Sat Dec 23 10:26:09 2006
-p %t=(1=>I,4=>IV,5=>V,9=>IX,10=>X,40=>XL,50=>L,90=>XC,100=>C,400=>CD,500=>D,900=>CM,1000=>M);for($i=4000;--$i>0;){$j=$i;$t=0;$s="";for$n(sort{$b<=>$a}keys%t){$s.=$t{$n}x int($j/$n);$j=$j%$n;}$m[$i]=$s;s/$s/$i/g}s/plus/+/g;s/minus/-/g;$_=eval;$_=$m[$_]." ";

262.48 davidrw Tue Dec 26 18:06:39 2006
-na %h=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000);@h{@H=qw/IV IX XL XC CD CM/}=(4,9,40,90,400,900);$x=join'|',@H;$|--?($G=/p/?'':'-',$_=''):s/($x|\D)/($G||'+').$h{$&}/eg for@F;$d=eval"@F";for(sort{$h{$b}<=>$h{$a}}keys%h){$d-=$h{$_},$s.=$_ while $d-$h{$_}>=0}print$s;

Your output is missing newlines. Be sure to use the test program!

268.44 shmem Thu Dec 28 12:05:26 2006
-lp @s{p,'m'}=qw(+ -);s/(p|m)\w+/$s{$1}/g;s/\w+/($&)/g;@l=split//,IVXLCDM;$c=.5;$r{$l[$_]}=$c=$c*($_%2?5:2)for 0..6;for$i(0..6){$d=$r{$l[$i]};s/$l[$i]($l[$i+1]|$l[$i+2])/($1?'-':'+').$d.$1/ge;s/$l[$i]/+$d/g;}$_=eval;s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$#.=4x$&%1859^7;1!eg

cheating a bit using ton's old golf entry

282.37 SubStack Sun Dec 24 04:57:26 2006
-np %r=(I,1,V,5,X,10,L,50,C,100,D,500,M,1000);for(/\w+/g){$z=0;$@=$r{$_},($l<$@&&$l?$z-=2*$l:0),$z+=$l=$@for/./g;$c.=/p/?"+":/m/?"-":$z}$n=eval$c;$_="";for$@(M,C,X,I){$u=(MMM,D,L,V)[$e++];$_.=$v<4?$@x$v:$v<5?$@.$u:$v<6?$u:$v==9?$@.$j:$u.$@x($v-5)if$v=int$n/$r{$@};$n-=$r{$j=$@}*$v;}

The solution works but is not printing out newlines...did you use the test program?

289.44 carldr Sat Dec 23 10:20:29 2006
%t=(1=>"I",4=>"IV",5=>"V",9=>"IX",10=>"X",40=>"XL",50=>"L",90=>"XC",100=>"C",400=>"CD",500=>"D",900=>"CM",1000=>"M");$_=<>;for($i=4000;--$i>0;){$j=$i;$t=0;$s="";for$n(sort{$b<=>$a}keys%t){$s.=$t{$n}x int($j/$n);$j=$j%$n;}$m[$i]=$s;s/$s/$i/g}s/plus/+/g;s/minus/-/g;$_=eval;print $m[$_]." ";

First effort, not particularly golfed.

289.44 carldr Sat Dec 23 10:20:38 2006
%t=(1=>"I",4=>"IV",5=>"V",9=>"IX",10=>"X",40=>"XL",50=>"L",90=>"XC",100=>"C",400=>"CD",500=>"D",900=>"CM",1000=>"M");$_=<>;for($i=4000;--$i>0;){$j=$i;$t=0;$s="";for$n(sort{$b<=>$a}keys%t){$s.=$t{$n}x int($j/$n);$j=$j%$n;}$m[$i]=$s;s/$s/$i/g}s/plus/+/g;s/minus/-/g;$_=eval;print $m[$_]." ";

First effort, not particularly golfed.

331.51 dogwelder Mon Jan 1 03:48:12 2007
@s=split //,'IVXLCDM';@d=map{&c($_)}(0..3999);%r=(plus=>'+',minus=>'-');for(0..3999){$r{$d[$_]}=$_}print $d[eval join '',map{$r{$_}}@ARGV]."\n"; sub c{$a=shift;$i=(length($a)-1)*2;return'' if !length($g=substr $a,0,1);$c=$s[$i];my$o=$c x $g;$o=~s/$c{9}/$c$s[$i+2]/;$o=~s/$c{5}/$s[$i+1]/;$o=~s/$c{4}/$c$s[$i+1]/;$o.&c(substr $a,1)}

529.53 reveng Sat Dec 23 18:23:09 2006
-ln sub a{$a=0;$@=1e3;for(split//,pop){$d=$r{$_};$a-=2*$@if$@<$d;$a+=$@=$d}$a} %r=qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000); $z=.5;%r=map{$_=>$z*=++$i%2?2:5}I,V,X,L,C,D,M; %Z=qw(1 IV 10 XL 100 CD 1000 MMMMMM);@f=reverse sort keys%Z;grep($Z{$_}=[split(//,$Z{$_},2)],@f); sub R{$y=pop;for(@f){($d,$i,$v)=(int($y/$_),@{$Z{$_}}); if(1<=$d&&$d<=3){$r.=$i x$d}elsif($d==4){$r.="$i$v"}elsif($d==5){$r.=$v} elsif(6<=$d&&$d<=8){$r.=$v.$i x($d-5)}elsif($d==9){$r.="$i$x"}$y-=$d*$_;$x=$i}$r} s/plus/+/g;s/m\w+/-/g; s/\w+/a$&/eg;print R+eval

529.53 reveng Sat Dec 23 18:23:43 2006
-ln sub a{$a=0;$@=1e3;for(split//,pop){$d=$r{$_};$a-=2*$@if$@<$d;$a+=$@=$d}$a} %r=qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000); $z=.5;%r=map{$_=>$z*=++$i%2?2:5}I,V,X,L,C,D,M; %Z=qw(1 IV 10 XL 100 CD 1000 MMMMMM);@f=reverse sort keys%Z;grep($Z{$_}=[split(//,$Z{$_},2)],@f); sub R{$y=pop;for(@f){($d,$i,$v)=(int($y/$_),@{$Z{$_}}); if(1<=$d&&$d<=3){$r.=$i x$d}elsif($d==4){$r.="$i$v"}elsif($d==5){$r.=$v} elsif(6<=$d&&$d<=8){$r.=$v.$i x($d-5)}elsif($d==9){$r.="$i$x"}$y-=$d*$_;$x=$i}$r} s/plus/+/g;s/m\w+/-/g; s/\w+/a$&/eg;print R+eval

529.53 reveng Sat Dec 23 18:24:25 2006
-ln sub a{$a=0;$@=1e3;for(split//,pop){$d=$r{$_};$a-=2*$@if$@<$d;$a+=$@=$d}$a} %r=qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000); $z=.5;%r=map{$_=>$z*=++$i%2?2:5}I,V,X,L,C,D,M; %Z=qw(1 IV 10 XL 100 CD 1000 MMMMMM);@f=reverse sort keys%Z;grep($Z{$_}=[split(//,$Z{$_},2)],@f); sub R{$y=pop;for(@f){($d,$i,$v)=(int($y/$_),@{$Z{$_}}); if(1<=$d&&$d<=3){$r.=$i x$d}elsif($d==4){$r.="$i$v"}elsif($d==5){$r.=$v} elsif(6<=$d&&$d<=8){$r.=$v.$i x($d-5)}elsif($d==9){$r.="$i$x"}$y-=$d*$_;$x=$i}$r} s/plus/+/g;s/m\w+/-/g; s/\w+/a$&/eg;print R+eval

529.53 reveng Sat Dec 23 18:25:47 2006
-ln sub a{$a=0;$@=1e3;for(split//,pop){$d=$r{$_};$a-=2*$@if$@<$d;$a+=$@=$d}$a} %r=qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000); $z=.5;%r=map{$_=>$z*=++$i%2?2:5}I,V,X,L,C,D,M; %Z=qw(1 IV 10 XL 100 CD 1000 MMMMMM);@f=reverse sort keys%Z;grep($Z{$_}=[split(//,$Z{$_},2)],@f); sub R{$y=pop;for(@f){($d,$i,$v)=(int($y/$_),@{$Z{$_}}); if(1<=$d&&$d<=3){$r.=$i x$d}elsif($d==4){$r.="$i$v"}elsif($d==5){$r.=$v} elsif(6<=$d&&$d<=8){$r.=$v.$i x($d-5)}elsif($d==9){$r.="$i$x"}$y-=$d*$_;$x=$i}$r} s/plus/+/g;s/m\w+/-/g; s/\w+/a$&/eg;print R+eval

529.53 reveng Sat Dec 23 18:57:01 2006
-ln sub a{$a=0;$@=1e3;for(split//,pop){$d=$r{$_};$a-=2*$@if$@<$d;$a+=$@=$d}$a} %r=qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000); $z=.5;%r=map{$_=>$z*=++$i%2?2:5}I,V,X,L,C,D,M; %Z=qw(1 IV 10 XL 100 CD 1000 MMMMMM);@f=reverse sort keys%Z;grep($Z{$_}=[split(//,$Z{$_},2)],@f); sub R{$y=pop;for(@f){($d,$i,$v)=(int($y/$_),@{$Z{$_}}); if(1<=$d&&$d<=3){$r.=$i x$d}elsif($d==4){$r.="$i$v"}elsif($d==5){$r.=$v} elsif(6<=$d&&$d<=8){$r.=$v.$i x($d-5)}elsif($d==9){$r.="$i$x"}$y-=$d*$_;$x=$i}$r} s/plus/+/g;s/m\w+/-/g; s/\w+/a$&/eg;print R+eval

529.53 reveng Sat Dec 23 20:03:53 2006
-ln sub a{$a=0;$@=1e3;for(split//,pop){$d=$r{$_};$a-=2*$@if$@<$d;$a+=$@=$d}$a} %r=qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000); $z=.5;%r=map{$_=>$z*=++$i%2?2:5}I,V,X,L,C,D,M; %Z=qw(1 IV 10 XL 100 CD 1000 MMMMMM);@f=reverse sort keys%Z;grep($Z{$_}=[split(//,$Z{$_},2)],@f); sub R{$y=pop;for(@f){($d,$i,$v)=(int($y/$_),@{$Z{$_}}); if(1<=$d&&$d<=3){$r.=$i x$d}elsif($d==4){$r.="$i$v"}elsif($d==5){$r.=$v} elsif(6<=$d&&$d<=8){$r.=$v.$i x($d-5)}elsif($d==9){$r.="$i$x"}$y-=$d*$_;$x=$i}$r} s/plus/+/g;s/m\w+/-/g; s/\w+/a$&/eg;print R+eval

541.42 withigo Tue Jan 2 07:45:47 2007
$_ = $ARGV[0]; s/\G(\s|$)(?{$s.=$a;undef$a})|(plus)(?{$s.='+'})|(minus)(?{$s.='-'})|(IV)(?{$a+=4})|(IX)(?{$a+=9})|(IL)(?{$a+=49})|(XL)(?{$a+=40})|(IC)(?{$a+=99})|(XC)(?{$a+=90})|(ID)(?{$a+=499})|(XD)(?{$a+=490})|(IM)(?{$a+=999})|(XM)(?{$a+=990})|(V)(?{$a+=5*length$^N})|(D)(?{$a+=500*length$^N})|(I+)(?{$a+=length$^N})|(X+)(?{$a+=10*length$^N})|(C+)(?{$a+=100*length$^N})|(M+)(?{$a+=1000*length$^N})|//gc; $s=eval$s; map {split/:/;$a=int$s/$_[1] and $t.=$_[0] and $s-=$a*$_[1]} ('M:1000','D:500','C:100','L:50','X:10','V:5','I:1'); print $t;

naive solution, testing min score lengths to see how close i might be

943.50 jimbo Tue Dec 26 23:04:31 2006
-w %tt=(0,'0:-:-:-:-:-',1,'0:I:X:C',2,'0:II:XX:CC',3,'0:III:XXX:CCC',4,'0:IV:XL:CD',5,'0:V:L:D',6,'0:VI:LI:DI',7,'0:VII:LXX:DCC',8,'0:VIII:LXXX:DCCC',9,'0:IX:XC:CM',); %sc2=('IV','IIII','IX','VIIII','XL','XXXX','XC','LXXXX','CD','CCCC','CM','DCCC',); %t2=(1,'I',2,'X',3,'C',4,'M',5,'MMMMMMMMM',); @a=@ARGV; $hrt{0}=0; for $i(1..16384){$hrt{rc($i)}=$i;$hrtn{$i}=$z;} $t=sprintf('$a=%s %s %s %s %s %s %s',$hrt{(ec($a[0]))},($a[1]=~m/^p/)?'+':'-',$hrt{(ec($a[2]))},(defined($a[3])&&$a[3]=~m/^p/)?'+':'-',$hrt{(defined($a[4]))?ec($a[4]):0},(defined($a[5])&&$a[5]=~m/^p/)?'+':'-',$hrt{(defined($a[6]))?ec($a[6]):0}); eval $t;print $hrtn{$a};exit 0; sub rc{my $v="";$z="";my $t=$_[0];my $l=length $t;for $c(reverse 1..$l){$p=$l-$c;$y=substr $t,$p,1;$v=$v.$t2{$c}x$y;$z=$z.($c<4?(split(/:/,$tt{$y}))[$c]:'M'x$y);}$z =~ s/\-//g;$v;} sub ec{my $t=uc$_[0];foreach my $x(keys %sc2){$t=~s/$x/$sc2{$x}/g}$t=~s/V/IIIII/g;$t=~s/L/XXXXX/g;$t=~s/D/CCCCC/g;$t;}

Test your solution with the test program.

1034.51 jimbo Wed Dec 27 04:17:45 2006
-w my %tt=(0,'0:-:-:-:-:-',1,'0:I:X:C',2,'0:II:XX:CC',3,'0:III:XXX:CCC',4,'0:IV:XL:CD',5,'0:V:L:D',6,'0:VI:LX:DC',7,'0:VII:LXX:DCC',8,'0:VIII:LXXX:DCCC',9,'0:IX:XC:CM',);my %sc2=('IV','IIII','IX','VIIII','XL','XXXX','XC','LXXXX','CD','CCCC','CM','DCCCC',);my %t2=(1,'I',2,'X',3,'C',4,'M',5,'MMMMMMMMM',);my %hrt;my %hrtn;my $z;$hrt{0}=0;for my $i(1..16384){$hrt{rc($i)}=$i;$hrtn{$i}=$z;}my $si=<STDIN>;chomp($si);my @a=split(/ /,$si);my $b;my $t=sprintf('$b = %s %s %s %s %s %s %s',$hrt{(ec($a[0]))},($a[1]=~m/^p/)?'+':'-',$hrt{(ec($a[2]))},(defined($a[3])&&$a[3]=~m/^p/)?'+':'-',$hrt{(defined($a[4]))?ec($a[4]):0},(defined($a[5])&&$a[5]=~m/^p/)?'+':'-',$hrt{(defined($a[6]))?ec($a[6]):0});eval $t;printf( "%s\n",$hrtn{$b});exit 0;sub rc{my $v="";$z="";my $t=$_[0];my $l=length $t;for my $c(reverse 1..$l){my $p=$l-$c;my $y=substr$t,$p,1;$v=$v.$t2{$c}x$y;$z=$z.($c<4?(split(/:/,$tt{$y}))[$c]:'M'x$y);}$z=~s/\-//g;$v}sub ec{my $t=uc$_[0];foreach my $x(keys %sc2){$t=~s/$x/$sc2{$x}/g;}$t=~s/V/IIIII/g;$t=~s/L/XXXXX/g;$t=~s/D/CCCCC/g;$t}

romancalc.pl: Running test 6 ... Unexpected STDOUT: Tested: V plus I Expected: VI but got: I

1034.51 jimbo Wed Dec 27 05:35:34 2006
-w my %tt=(0,'0:-:-:-:-:-',1,'0:I:X:C',2,'0:II:XX:CC',3,'0:III:XXX:CCC',4,'0:IV:XL:CD',5,'0:V:L:D',6,'0:VI:LX:DC',7,'0:VII:LXX:DCC',8,'0:VIII:LXXX:DCCC',9,'0:IX:XC:CM',);my %sc2=('IV','IIII','IX','VIIII','XL','XXXX','XC','LXXXX','CD','CCCC','CM','DCCCC',);my %t2=(1,'I',2,'X',3,'C',4,'M',5,'MMMMMMMMM',);my %hrt;my %hrtn;my $z;$hrt{0}=0;for my $i(1..16384){$hrt{rc($i)}=$i;$hrtn{$i}=$z;}my $si=<STDIN>;chomp($si);my @a=split(/ /,$si);my $b;my $t=sprintf('$b = %s %s %s %s %s %s %s',$hrt{(ec($a[0]))},($a[1]=~m/^p/)?'+':'-',$hrt{(ec($a[2]))},(defined($a[3])&&$a[3]=~m/^p/)?'+':'-',$hrt{(defined($a[4]))?ec($a[4]):0},(defined($a[5])&&$a[5]=~m/^p/)?'+':'-',$hrt{(defined($a[6]))?ec($a[6]):0});eval $t;printf( "%s\n",$hrtn{$b});exit 0;sub rc{my $v="";$z="";my $t=$_[0];my $l=length $t;for my $c(reverse 1..$l){my $p=$l-$c;my $y=substr$t,$p,1;$v=$v.$t2{$c}x$y;$z=$z.($c<4?(split(/:/,$tt{$y}))[$c]:'M'x$y);}$z=~s/\-//g;$v}sub ec{my $t=uc$_[0];foreach my $x(keys %sc2){$t=~s/$x/$sc2{$x}/g;}$t=~s/V/IIIII/g;$t=~s/L/XXXXX/g;$t=~s/D/CCCCC/g;$t}

Are you running the test program to test this? romancalc.pl: Running test 6 ... Unexpected STDOUT: Tested: V plus I Expected: VI but got: I

1176.56 withigo Tue Jan 2 07:34:10 2007
$_ = $ARGV[0]; s/\G(\s|$)(?{$s.=$a;undef$a})|(plus)(?{$s.='+'})|(minus)(?{$s.='-'})|(IV)(?{$a+=4})|(IX)(?{$a+=9})|(IL)(?{$a+=49})|(XL)(?{$a+=40})|(IC)(?{$a+=99})|(XC)(?{$a+=90})|(ID)(?{$a+=499})|(XD)(?{$a+=490})|(IM)(?{$a+=999})|(XM)(?{$a+=990})|(V)(?{$a+=5*length$^N})|(D)(?{$a+=500*length$^N})|(I+)(?{$a+=length$^N})|(X+)(?{$a+=10*length$^N})|(C+)(?{$a+=100*length$^N})|(M+)(?{$a+=1000*length$^N})|//gc; $s=eval$s; $a=int$s/1000 and $t='M' x $a and $s-=$a*1000; $s == 999 and $t.='IM' and $s-=999; $s == 990 and $t.='XM' and $s-=990; $a=int$s/500 and $t.='D' x $a and $s-=$a*500; $s == 499 and $t.='ID' and $s-=499; $s == 490 and $t.='XD' and $s-=490; $a=int$s/100 and $t.='C' x $a and $s-=$a*100; $s == 99 and $t.='IC' and $s-=99; $s == 90 and $t.='XC' and $s-=90; $a=int$s/100 and $a < 4 and $t.='X' x $a and $s-=$a*10; $a > 3 and $t.='XL' and $s-=$a*10; $a=int$s/50 and $t.='L' x $a and $s-=$a*50; $s == 49 and $t.='IL' and $s-=49; $s == 40 and $t.='XL' and $s-=40; $a=int$s/10 and $a < 4 and $t.='X' x $a and $s-=$a*10; $a > 3 and $t.='XL' and $s-=$a*10; $s == 9 and $t.='IX' and $s-=9; $s>4 and $t.='V' and $s-=5; $s == 4 and $t.='IV' and $s-=4; $t.='I' x $s; print $t

testing!

1273.83 Andy Lester Sat Dec 23 18:24:51 2006
-l # http://www.fonality.com/golf/ use warnings; use strict; my %numerals = ( I => 1, V => 5, X => 10, L => 50, C => 100, D => 500, M => 1000, ); chomp(my $line = <STDIN>); my @words = split / /, $line; my $total = 0; my $mult = 1; for my $word ( @words ) { if ( $word eq 'plus' ) { $mult = 1; } elsif ( $word eq 'minus' ) { $mult = -1; } else { my $value = deroman( $word ); $total += ($mult * $value); } } print romanify( $total ); sub deroman { my $str = uc shift; my $n = 0; my @values = ( ( map { $numerals{$_} } split //, $str ), 0 ); while ( my $x = shift @values ) { if ( $x >= $values[0] ) { $n += $x; } else { $n -= $x; } } return $n; } sub romanify { my $n = shift; my $str = ''; my @whittlers = qw( M IM VM XM CM D ID CD C IC XC L XL X IX V IV I ); while ( my $letter = shift @whittlers ) { my $factor = deroman( $letter ); # Do the obvious whittling while ( $n && ( $n >= $factor ) ) { $n -= $factor; $str .= $letter; } } # while return $str; }

First working version, without the uses I was using for debugging.

1315.62 jimbo Tue Dec 26 22:54:13 2006
-w %tt = ( 0 => '0:-:-:-:-:-', 1 => '0:I:X:C', 2 => '0:II:XX:CC', 3 => '0:III:XXX:CCC', 4 => '0:IV:XL:CD', 5 => '0:V:L:D', 6 => '0:VI:LI:DI', 7 => '0:VII:LXX:DCC', 8 => '0:VIII:LXXX:DCCC', 9 => '0:IX:XC:CM', ); %sc2 = ( 'IV' => 'IIII', 'IX' => 'VIIII', 'XL' => 'XXXX', 'XC' => 'LXXXX', 'CD' => 'CCCC', 'CM' => 'DCCC', ); %t2 = ( 1 => 'I', 2 => 'X', 3 => 'C', 4 => 'M', 5 => 'MMMMMMMMM', ); @a = @ARGV; $hrt{0} = 0; for $i (1..16384) { $hrt{ rc( $i )} = $i; $hrtn{ $i } = $z; } $t = sprintf( '$a = %s %s %s %s %s %s %s', $hrt{(ec($a[0]))}, ($a[1] =~ m/^p/)?'+':'-', $hrt{(ec($a[2]))}, (defined( $a[3]) && $a[3] =~ m/^p/) ? '+' : '-', $hrt{(defined( $a[4])) ? ec($a[4]) : 0}, (defined( $a[5]) && $a[5] =~ m/^p/) ? '+' : '-', $hrt{(defined( $a[6])) ? ec($a[6]) : 0 } ); eval $t; print $hrtn{$a}; exit 0; sub rc { my $v = ""; $z = ""; my $t = $_[0]; my $l = length( $t ); for $c (reverse 1..$l) { $p = $l - $c; $y = substr( $t, $p, 1); $v = $v . $t2{$c} x $y; $z = $z . ($c < 4?(split( /:/, $tt{$y} ))[$c]:'M'x$y); } $z =~ s/\-//g; $v; } sub ec { my $t = uc $_[0]; foreach my $x (keys %sc2 ) {$t =~ s/$x/$sc2{$x}/g} $t =~ s/V/IIIII/g; $t =~ s/L/XXXXX/g; $t =~ s/D/CCCCC/g; $t; } __END__

Your program needs to accept data from STDIN, not @ARGV. Use the test program to test!

1520.83 Andy Lester Sat Dec 23 18:10:52 2006
-w # http://www.fonality.com/golf/ use strict; use warnings; use Data::Dumper; my %numerals = ( I => 1, V => 5, X => 10, L => 50, C => 100, D => 500, M => 1000, ); my %letters = reverse %numerals; if ( @ARGV ) { for ( @ARGV ) { print "$_ -> "; print romanify( $_ ), "\n"; } exit; } my $line = <STDIN>; chomp $line; my @words = split / /, $line; my $total = 0; my $mult = 1; for my $word ( @words ) { if ( $word eq 'plus' ) { $mult = 1; } elsif ( $word eq 'minus' ) { $mult = -1; } else { my $value = deroman( $word ); $total += ($mult * $value); } } print romanify( $total ), "\n"; sub deroman { my $str = uc shift; my $n = 0; my @values = ( ( map { $numerals{$_} } split //, $str ), 0 ); while ( my $x = shift @values ) { if ( $x >= $values[0] ) { $n += $x; } else { $n -= $x; } } return $n; } sub romanify { my $n = shift; my $str = ''; my @whittlers = qw( M IM VM XM CM D ID CD C IC XC L XL X IX V IV I ); while ( my $letter = shift @whittlers ) { #print "romaning $letter"; my $factor = deroman( $letter ); #print " as $factor\n"; # Do the obvious whittling while ( $n && ( $n >= $factor ) ) { $n -= $factor; $str .= $letter; } } # while return $str; }

My first, entirely non-golfy, just-get-it-working version.

© Fonality 2004-2006