http://www.perlmonks.org?node_id=849776


in reply to Code Golf: Four is magic

A version that returns the English names of the input 1-2 digit number.

Update: Hmmm. I just noticed on the stackoverflow page that they clarified that the numbers should be spelled out in both the left AND right columns. Phooey.

Another update: And now there's some further stipulation that there be a separator(space, hyphen, whatever) between spelled words and the input number must come in through STDIN, not as a passed parameter, so no pop @ARGV.

Update: 283

@p=(Thir,Four,Fif,Six,Seven,Eigh,Nine);@n=("\x8",One,Two,Three,Four,Fi
+ve,@p[3..6],Ten,Eleven,Twelve,map$_.teen,@p);s/u//for@m=map$_.ty,Twen
+,@p;$n[8].=t;sub n{$n=shift;$n?$n<20?$n[$n]:"$m[$n/10-2]-$n[$n%10]":Z
+ero}$p+=<>;warn$m=n($p)," is ",$_=$p-4?n$p=()=$m=~/\w/g:magic,".\n"un
+til/c/

[download]
0
Zero is Four.
Four is magic.

40
Forty is Five.
Five is Four.
Four is magic.

67
Sixty-Seven is Ten.
Ten is Three.
Three is Five.
Five is Four.
Four is magic.

83
Eighty-Three is Eleven.
Eleven is Six.
Six is Three.
Three is Five.
Five is Four.
Four is magic.

##### Versions that don't spell out right column. #####

Update:Sigh. Apparently I'm blind. Using duelafns suggestion, modifying the end conditional and some other minor tweaks.

256

@p=(Thir,Four,Fif,Six,Seven,Eigh,Nine);@n=("",One,Two,Three,Four,Five,
+@p[3..6],Ten,Eleven,Twelve,map($_.teen,@p),map$_.ty,Twen,@p);$n[22]=~
+s/u//;$n[8].=t;$_+=<>;print$z=$_?$_<20?$n[$_]:$n[$_/10+18].$n[$_%10]:
+Zero," is ",$_=$_-4?length$z:magic,".\n"until/a/

[download]

or

perl -E'@p=(Thir,Four,Fif,Six,Seven,Eigh,Nine);@n=("",One,Two,Three,Fo
+ur,Five,@p[3..6],Ten,Eleven,Twelve,map($_.teen,@p),map$_.ty,Twen,@p);
+$n[22]=~s/u//;$n[8].=t;$_+=<>;say$z=$_?$_<20?$n[$_]:$n[$_/10+18].$n[$
+_%10]:Zero," is ",$_=$_-4?length$z:magic,"."until/a/'

[download]

Previous versions

Update: 314 Reformatted a bit to make it easier to run as a one liner. Capitalized names... because I could. Knocked another 2 strokes off. It bothers me that I can't figure out how to get rid of the duplicated Four without making it longer. I guess Four IS magic...

@u="0335443554366887798866555766"=~/./g;sub n{@p=(Thir,Four,Fif,Six,Se
+ven,Eigh,Nine);@n=("",One,Two,Three,Four,Five,@p[3..6],Ten,Eleven,Twe
+lve,map($_.teen,@p),map$_.ty,Twen,@p);$n[22]=~s/u//;$n[8].=t;shift()?
+$_<20?$n[$_]:$n[$_/10+18].$n[$_%10]:Zero}$_=pop;print$z=n($_)," is ",
+$_=$_-4?length$z:magic,".\n"while/\d/

[download]

Update: 316

@u='0335443554366887798866555766'=~/./g;sub n{@p=(thir,four,fif,six,se
+ven,eigh,nine);@n=('',one,two,three,four,five,@p[3..6],ten,eleven,twe
+lve,map($_.teen,@p),twenty,map$_.ty,@p);$n[22]=~s/u//;$n[8].=t;shift(
+)?$_<20?$n[$_]:$n[$_/10+18].$n[$_%10]:zero}$_=pop;print$z=n($_)," is 
+",$_=$_-4?length$z:magic,".\n"while/\d/

[download]

Update: 337

@u='0335443554366887798866555766'=~/./g;sub n{@p=(qw/thir four fif six
+ seven eigh nine/);@n=('',qw/one two three four five/,@p[3..6],qw/ten
+ eleven twelve/,map($_.'teen',@p),'twenty',map$_.'ty',@p);$n[22]=~s/u
+//;$n[8].='t';shift()?$_<20?$n[$_]:$n[$_/10+18].$n[$_%10]:'zero'}$_=<
+>;print$z=n($_)," is ",$_=$_-4?length$z:magic,".\n"while/\d/

[download]

Update: 341

@u='0335443554366887798866555766'=~/./g;sub n{shift;@p=(qw/thir four f
+if six seven eigh nine/);@n=('',qw/one two three four five/,@p[3..6],
+qw/ten eleven twelve/,map($_.'teen',@p),'twenty',map$_.'ty',@p);$n[22
+]=~s/u//;$n[8].='t';$t=$_?$_<20?$n[$_]:$n[$_/10+18].$n[$_%10]:'zero'}
+$_=<>;print$z=n($_)," is ",$_=$_-4?length$z:magic,".\n"while/\d/

[download]

Update: 343

@u='0335443554366887798866555766'=~/./g;sub n{shift;@p=(qw/thir four f
+if six seven eigh nine/);@n=('',qw/one two three four five/,@p[3..6],
+qw/ten eleven twelve/,map($_.'teen',@p),'twenty',map$_.'ty',@p);$n[22
+]=~s/u//;$n[8].='t';$t=$_?$_<20?$n[$_]:$n[$_/10+18].$n[$_%10]:'zero'}
+$_=<>;print n($_)," is ",$_=$_-4?length n($_):magic,".\n"while/\d/

[download]

Update: 344

@u='0335443554366887798866555766'=~/./g;sub n{shift;@p=(qw/thir four f
+if six seven eigh nine/);@n=('',qw/one two three four five/,@p[3..6],
+qw/ten eleven twelve/,map($_.'teen',@p),'twenty',map$_.'ty',@p);$n[22
+]=~s/u//;$n[8].='t';$t=$_?$_<20?$n[$_]:$n[$_/10+18].$n[$_%10]:'zero'}
+$_=pop;print n($_)," is ",$_=$_-4?length n($_):magic,".\n"while/\d/

[download]

Update: 345

@u='0335443554366887798866555766'=~/./g;sub n{shift;@p=(qw/thir four f
+if six seven eigh nine/);@n=('',qw/one two three four five/,@p[3..6],
+qw/ten eleven twelve/,map($_.'teen',@p),'twenty',map($_.'ty',@p);$n[2
+2]=~s/u//;$n[8].='t';$t=$_?$_<20?$n[$_]:$n[$_/10+18].$n[$_%10]:'zero'
+}$_=pop;print n($_)," is ",$_=$_-4?length n($_):magic,".\n"while/\d/

[download]

Update: 361

@u='0335443554366887798866555766'=~/./g;sub n{shift;@p=(qw/thir four f
+if six seven eigh nine/);@n=('',qw/one two three four five/,@p[3..6],
+qw/ten eleven twelve/);push@n,$_.'teen'for@p;$p[1]=~s/u//;push@n,'twe
+nty',;push@n,$_.'ty'for@p;$n[8].='t';$t=$_?$_<20?$n[$_]:$n[$_/10+18].
+$n[$_%10]:'zero'}$_=pop;print n($_)," is ",$_=$_-4?length n($_):magic
+,".\n"while/\d/

[download]

Update: Save a stroke: 383.

@u='0335443554366887798866555766'=~/./g;sub n{shift;@p=(qw/thir four f
+if six seven eigh nine/);@n=('',qw/one two three four five/,@p[3..6],
+qw/ten eleven twelve/);push@n,$_.'teen'for@p;$p[1]=~s/u//;push@n,'twe
+nty',;push@n,$_.'ty'for@p;$n[8].='t';$t=$_?$_<20?$n[$_]:$n[$_/10+18].
+$n[$_%10]:'zero'}$_=pop;print n($_)," is ",$_=$_-4?$_<20?$u[$_]||4:$u
+[chop]+$u[18+$_]:magic,".\n"while/\d/

[download]

Proof of concept. Should be lots of room for improvement.

Update: whoops. Fixed for fourteen/forty. Curse you, irregular number names!

384 strokes.

@u='0335443554366887798866555766'=~/./g;sub n{shift;@p=(qw/thir four f
+if six seven eigh nine/);@n=('',qw/one two three four five/,@p[3..6],
+qw/ten eleven twelve/);push@n,$_.'teen'for@p;push@n,'twenty',;push@n,
+$_.'ty'for@p;$n[8].='t';$n[22]=~s/u//;$t=$_?$_<20?$n[$_]:$n[$_/10+18]
+.$n[$_%10]:'zero'}$_=pop;print n($_)," is ",$_=$_-4?$_<20?$u[$_]||4:$
+u[chop]+$u[18+$_]:magic,".\n"while/\d/

[download]
C:\test>magic.pl 0
zero is 4.
four is magic.

C:\test>magic.pl 1
one is 3.
three is 5.
five is 4.
four is magic.

C:\test>magic.pl 14
fourteen is 8.
eight is 5.
five is 4.
four is magic.

C:\test>magic.pl 15
fifteen is 7.
seven is 5.
five is 4.
four is magic.

C:\test>magic.pl 18
eighteen is 8.
eight is 5.
five is 4.
four is magic.

C:\test>magic.pl 44
fortyfour is 9.
nine is 4.
four is magic.

C:\test>magic.pl 77
seventyseven is 12.
twelve is 6.
six is 3.
three is 5.
five is 4.
four is magic.

C:\test>magic.pl 80
eighty is 6.
six is 3.
three is 5.
five is 4.
four is magic.

C:\test>magic.pl 99
ninetynine is 10.
ten is 3.
three is 5.
five is 4.
four is magic.

Replies are listed 'Best First'.
Re^2: Code Golf: Four is magic
by duelafn (Parson) on Jul 16, 2010 at 00:17 UTC

    So, um, what's @u still doing in there? :)

    Update: Removing @u, using do{} instead of a sub, and applying the "say" cheat gives 261 260 (until/m/) strokes

        #123456789 123456789 123456789 123456789 123456789 123456789 12345
+6789 123456789 123456789 123456789_123456789 123456789 123456789 1234
+56789 123456789 123456789 123456789 123456789 123456789 123456789_123
+456789 123456789 123456789 123456789 123456789 123456789 
for f in 0 4 12 99; do
perl -E'$_=pop;say$z=do{@p=(Thir,Four,Fif,Six,Seven,Eigh,Nine);@n=("",
+One,Two,Three,Four,Five,@p[3..6],Ten,Eleven,Twelve,map($_.teen,@p),ma
+p$_.ty,Twen,@p);$n[22]=~s/u//;$n[8].=t;$_?$_<20?$n[$_]:$n[$_/10+18].$
+n[$_%10]:Zero}," is ",$_=$_-4?length$z:magic,"."until/m/' $f ; \
echo; done

    [download]

    Good Day,
        Dean

[reply]
[d/l]
[select]

      Ummm........ Wasting about 30 strokes? Apparently I have very selective blindness...

[reply]

In Section Meditations