Multi-line functions in Commodore 64 BASIC - function

So, I'd like to write larger functions in Commodore 64 BASIC. So far, from what I'm seeing from other sources (such as various C64 wikis, as well as the user's manual for the C64 itself,) function definitions can only be one line long.
That is to say, I can't seem to find an analogous construct in BASIC to brackets/whatever else other languages use to delineate code blocks.
Does anyone know how I'd write code blocks in BASIC that are more than one line?
Example of one-line function:
10 def fn X(n) = n + 1
20 print fn X(5) rem Correctly called function. This will output 6
But I can't do something like:
10 def fn X(n) =
20 n = n + 1
30 print n
40 rem I'd like the definition of function X to end at line 30 above
50 fn X(5) rem Produces syntax error on line 40
Thank you for your time!

Sadly C64 BASIC doesn't support more complicated functions.
It does however support more complicated subroutines, and that's what you want in this case.
10 rem you can set up n in advance here
20 n = 23
30 gosub 50
40 rem n is now 24
50 rem start of subroutine; this line is not needed, it's just here for clarity
60 n=n+1
70 print n
80 return
90 rem now you can call the subroutine on line 50 and it'll return at line 80
Unfortunately passing parameters in to and returning values out of subroutines in C64 BASIC aren't formalized constructs, so you'll just have to work with ordinary variables as shown above.

From what I recall, you can do this virtually using a colan to have multiple commands on one line. Not the most elegant solution, but will let you break things up:
10 def fn X(n) =
20 n = n + 1
30 print n
40 rem I'd like the definition of function X to end at line 30 above
50 fn X(5) rem Produces syntax error on line 40
Becomes
10 n=n+1: print n
Note that you cannot pass arguments, so you would have to declare things and let the BASIC stack take care of it for you. Commonly I would structure programs like so:
1 rem lines 1-99 are definitions.
2 n% = 0 : rem this declares the variable n as an integer, initializing it to 0
100 rem lines 100-59999 are the core code
101 n%=5 : gosub 60100
59999 end : rem explicit end of the program to ensure we don't run into our subroutine block
60000 rem lines 60000+ are my subroutines..
60100 n% = n% + 1 : print n% : return
It's been a while; from memory the % character is what declares a variable as an integer, similar to $ declaring it as a string.

You can use existing variables and mathematical commands with DEF FN, for instance, if you wanted to PRINT 0 to 10 inclusive in 4-bit nybbles, one could do this:
0 DEF FN B(X)=SGN(X AND B)
1 FOR I=0 TO 10: REM OUR COUNTER
2 B=8: REM OUR BIT MARKER (128, 64, 32, 16, 8, 4, 2, 1)
3 FOR J=0 TO 3: REM WE WANT 4-BIT NYBBLES, SO 0 TO 3 INCLUSIVE
4 PRINT RIGHT$(STR$(FN B(I)),1);: REM CALLS OUR FUNCTION
5 B=B/2: REM MOVES TO NEXT BIT MARKER
6 NEXT J: REM PROCESS FOR LOOP J
7 PRINT: NEXT I: REM NEW LINE THEN PROCESS FOR LOOP I
I've tried nesting functions but it gets too confusing. In fact, I haven't seen many listings that use DEF FN. Maybe some high-brow artisan hipster BASIC programmers use them?

Related

Code Golf: Build Me an Arc

Locked. This question and its answers are locked because the question is off-topic but has historical significance. It is not currently accepting new answers or interactions.
Challenge
The shortest program by character count that accepts standard input of the form X-Y R, with the following guarantees:
R is a non-negative decimal number less than or equal to 8
X and Y are non-negative angles given in decimal as multiples of 45° (0, 45, 90, 135, etc.)
X is less than Y
Y is not 360 if X is 0
And produces on standard output an ASCII "arc" from the starting angle X to the ending angle Y of radius R, where:
The vertex of the arc is represented by o
Angles of 0 and 180 are represented by -
Angles of 45 and 225 are represented by /
Angles of 90 and 270 are represented by |
Angles of 135 and 315 are represented by \
The polygonal area enclosed by the two lines is filled with a non-whitespace character.
The program is not required to produce meaningful output if given invalid input. Solutions in any language are allowed, except of course a language written specifically for this challenge, or one that makes unfair use of an external utility. Extraneous horizontal and vertical whitespace is allowed in the output provided that the format of the output remains correct.
Happy golfing!
Numerous Examples
Input:
0-45 8
Output:
/
/x
/xx
/xxx
/xxxx
/xxxxx
/xxxxxx
/xxxxxxx
o--------
Input:
0-135 4
Output:
\xxxxxxxx
\xxxxxxx
\xxxxxx
\xxxxx
o----
Input:
180-360 2
Output:
--o--
xxxxx
xxxxx
Input:
45-90 0
Output:
o
Input:
0-315 2
Output:
xxxxx
xxxxx
xxo--
xxx\
xxxx\
Perl, 235 211 225 211 207 196 179 177 175 168 160 156 146 chars
<>=~/-\d+/;for$y(#a=-$'..$'){print+(map$_|$y?!($t=8*($y>0)+atan2(-$y,$_)/atan2 1,1)&-$&/45==8|$t>=$`/45&$t<=-$&/45?qw(- / | \\)[$t%4]:$":o,#a),$/}
Perl using say feature, 161 149 139 chars
$ echo -n '<>=~/-\d+/;for$y(#a=-$'"'"'..$'"'"'){say map$_|$y?!($t=8*($y>0)+atan2(-$y,$_)/atan2 1,1)&-$&/45==8|$t>=$`/45&$t<=-$&/45?qw(- / | \\)[$t%4]:$":o,#a}' | wc -c
139
$ perl -E '<>=~/-\d+/;for$y(#a=-$'"'"'..$'"'"'){say map$_|$y?!($t=8*($y>0)+atan2(-$y,$_)/atan2 1,1)&-$&/45==8|$t>=$`/45&$t<=-$&/45?qw(- / | \\)[$t%4]:$":o,#a}'
Perl without trailing newline, 153 143 chars
<>=~/-\d+/;for$y(#a=-$'..$'){print$/,map$_|$y?!($t=8*($y>0)+atan2(-$y,$_)/atan2 1,1)&-$&/45==8|$t>=$`/45&$t<=-$&/45?qw(- / | \\)[$t%4]:$":o,#a}
Original version commented:
$_=<>;m/(\d+)-(\d+) (\d+)/;$e=$1/45;$f=$2/45; # parse angles and radius, angles are 0-8
for$y(-$3..$3){ # loop for each row and col
for$x(-$3..$3){
$t=atan2(-$y,$x)/atan2 1,1; # angle of this point
$t+=8if($t<0); # normalize negative angles
#w=split//,"-/|\\"x2; # array of ASCII symbols for enclosing lines
$s.=!$x&&!$y?"o":$t==$e||$t==$f?$w[$t]:$t>$e&&$t<$f?"x":$";
# if it's origin -> "o", if it's enclosing line, get symbol from array
# if it's between enclosing angles "x", otherwise space
}
$s.=$/;
}
print$s;
EDIT 1: Inlined sub, relational and equality operators return 0 or 1.
EDIT 2: Added version with comments.
EDIT 3: Fixed enclosing line at 360º. Char count increased significantly.
EDIT 4: Added a shorter version, bending the rules.
EDIT 5: Smarter fix for the 360º enclosing line. Also, use a number as fill. Both things were obvious. Meh, I should sleep more :/
EDIT 6: Removed unneeded m from match operator. Removed some semicolons.
EDIT 7: Smarter regexp. Under 200 chars!
EDIT 8: Lots of small improvements:
Inner for loop -> map (1 char)
symbol array from split string -> qw (3 chars)
inlined symbol array (6 chars, together with the previous improvement 9 chars!)
Logical or -> bitwise or (1 char)
Regexp improvement (1 char)
Use arithmethic for testing negative angles, inspired by Jacob's answer (5 chars)
EDIT 9: A little reordering in the conditional operators saves 2 chars.
EDIT 10: Use barewords for characters.
EDIT 11: Moved print inside of loop, inspired by Lowjacker's answer.
EDIT 12: Added version using say.
EDIT 13: Reuse angles characters for fill character, as Gwell's answer does. Output isn't as nice as Gwell's though, that would require 5 additional chars :) Also, .. operator doen't need parentheses.
EDIT 14: Apply regex directly to <>. Assign range operator to a variable, as per Adrian's suggestion to bta's answer. Add version without the final newline. Updated say version.
EDIT 15: More inlining. map{block}#a -> map expr,#a.
Lua, 259 characters
Slightly abuses the non-whitespace character clause to produce a dazzling display and more importantly save strokes.
m=math i=io.read():gmatch("%d+")a=i()/45 b=i()/45 r=i()for y=r,-r,-1 do for x=-r,r do c=m.atan2(y,x)/m.pi*4 c=c<0 and c+8 or c k=1+m.modf(c+.5)io.write(x==0 and y==0 and'o'or c>=a and c<=b and('-/|\\-/|\\-'):sub(k,k)or c==0 and b==8 and'-'or' ')end print()end
Input: 45-360 4
\\\|||///
\\\|||//
\\\\|//
--\\|/
----o----
--//|\\--
////|\\\\
///|||\\\
///|||\\\
Able to handle odd angles
Input: 15-75 8
|/////
|//////
|//////
|//////
///////
|//////-
////---
//-
o
MATLAB, 188 chars :)
input '';[w x r]=strread(ans,'%d-%d%d');l='-/|\-/|\-';[X Y]=meshgrid(-r:r);T=atan2(-Y,X)/pi*180;T=T+(T<=0)*360;T(T>w&T<x)=-42;T(T==w)=-l(1+w/45);T(T==x)=-l(1+x/45);T(r+1,r+1)=-'o';char(-T)
Commented code:
%%# Get the string variable (enclose in quotes, e.g. '45-315 4')
input ''
%%# Extract angles and length
[w x r]=strread(ans,'%d-%d%d');
%%# Store characters
l='-/|\-/|\-';
%%# Create the grid
[X Y]=meshgrid(-r:r);
%%# Compute the angles in degrees
T=atan2(-Y,X)/pi*180;
%%# Get all the angles
T=T+(T<=0)*360;
%# Negative numbers indicate valid characters
%%# Add the characters
T(T>w&T<x)=-42;
T(T==w)=-l(1+w/45);
T(T==x)=-l(1+x/45);
%%# Add the origin
T(r+1,r+1)=-'o';
%%# Display
char(-T)
Mathematica 100 Chars
Out of competition because graphics are too perfect :)
f[x_-y_ z_]:=Graphics#Table[
{EdgeForm#Red,Disk[{0,0},r,{x °,y °}],{r,z,1,-1}]
SetAttributes[f,HoldAll]
Invoke with
f[30-70 5]
Result
alt text http://a.imageshack.us/img80/4294/angulosgolf.png
alt text http://a.imageshack.us/img59/7892/angulos2.png
Note
The
SetAttributes[f, HoldAll];
is needed because the input
f[a-b c]
is otherwise interpreted as
f[(a-b*c)]
GNU BC, 339 chars
Gnu bc because of read(), else and logical operators.
scale=A
a=read()/45
b=read()/45
c=read()
for(y=c;y>=-c;y--){for(x=-c;x<=c;x++){if(x==0)if(y<0)t=-2else t=2else if(x>0)t=a(y/x)/a(1)else if(y<0)t=a(y/x)/a(1)-4else t=a(y/x)/a(1)+4
if(y<0)t+=8
if(x||y)if(t==a||t==b||t==b-8){scale=0;u=(t%4);scale=A;if(u==0)"-";if(u==1)"/";if(u==2)"|";if(u==3)"\"}else if(t>a&&t<b)"x"else" "else"o"};"
"}
quit
MATLAB 7.8.0 (R2009a) - 168 163 162 characters
Starting from Jacob's answer and inspired by gwell's use of any non-whitespace character to fill the arc, I managed the following solution:
[w x r]=strread(input('','s'),'%d-%d%d');
l='o -/|\-/|\-';
X=meshgrid(-r:r);
T=atan2(-X',X)*180/pi;
T=T+(T<=-~w)*360;
T(T>x|T<w)=-1;
T(r+1,r+1)=-90;
disp(l(fix(3+T/45)))
And some test output:
>> arc
0-135 4
\||||////
\|||///-
\||//--
\|/---
o----
I could reduce it further to 156 characters by removing the call to disp, but this would add an extra ans = preceding the output (which might violate the output formatting rules).
Even still, I feel like there are some ways to reduce this further. ;)
Ruby, 292 276 186 chars
x,y,r=gets.scan(/\d+/).map{|z|z.to_i};s=(-r..r);s.each{|a|s.each{|b|g=Math::atan2(-a,b)/Math::PI*180/1%360;print a|b==0?'o':g==x||g==y%360?'-/|\\'[g/45%4].chr: (x..y)===g ?'*':' '};puts}
Nicer-formatted version:
x, y, r = gets.scan(/\d+/).map{|z| z.to_i}
s = (-r..r)
s.each {|a|
s.each {|b|
g = (((Math::atan2(-a,b) / Math::PI) * 180) / 1) % 360
print ((a | b) == 0) ? 'o' :
(g == x || g == (y % 360)) ? '-/|\\'[(g / 45) % 4].chr :
((x..y) === g) ? '*' : ' '
}
puts
}
I'm sure someone out there who got more sleep than I did can condense this more...
Edit 1: Switched if statements in inner loop to nested ? : operator
Edit 2: Stored range to intermediate variable (thanks Adrian), used stdin instead of CLI params (thanks for the clarification Jon), eliminated array in favor of direct output, fixed bug where an ending angle of 360 wouldn't display a line, removed some un-needed parentheses, used division for rounding instead of .round, used modulo instead of conditional add
Ruby, 168 characters
Requires Ruby 1.9 to work
s,e,r=gets.scan(/\d+/).map &:to_i;s/=45;e/=45;G=-r..r;G.map{|y|G.map{|x|a=Math.atan2(-y,x)/Math::PI*4%8;print x|y!=0?a==s||a==e%8?'-/|\\'[a%4]:a<s||a>e ?' ':8:?o};puts}
Readable version:
start, _end, radius = gets.scan(/\d+/).map &:to_i
start /= 45
_end /= 45
(-radius..radius).each {|y|
(-radius..radius).each {|x|
angle = Math.atan2(-y, x)/Math::PI * 4 % 8
print x|y != 0 ? angle==start || angle==_end%8 ? '-/|\\'[angle%4] : angle<start || angle>_end ? ' ' : 8 : ?o
}
puts
}
Perl - 388 characters
Since it wouldn't be fair to pose a challenge I couldn't solve myself, here's a solution that uses string substitution instead of trigonometric functions, and making heavy use of your friendly neighbourhood Perl's ability to treat barewords as strings. It's necessarily a little long, but perhaps interesting for the sake of uniqueness:
($x,$y,$r)=split/\D/,<>;for(0..$r-1){$t=$r-1-$_;
$a.=L x$_.D.K x$t.C.J x$t.B.I x$_."\n";
$b.=M x$t.F.N x$_.G.O x$_.H.P x$t."\n"}
$_=$a.E x$r.o.A x$r."\n".$b;$x/=45;$y/=45;$S=' ';
sub A{$v=$_[0];$x==$v||$y==$v?$_[1]:$x<$v&&$y>$v?x:$S}
sub B{$x<=$_[0]&&$y>$_[0]?x:$S}
#a=!$x||$y==8?'-':$S;
push#a,map{A$_,'\\'.qw(- / | \\)[$_%4]}1..7;
push#a,!$x?x:$S,map{B$_}1..7;
eval"y/A-P/".(join'',#a)."/";print
All newlines are optional. It's fairly straightforward:
Grab user input.
Build the top ($a) and bottom ($b) parts of the pattern.
Build the complete pattern ($_).
Define a sub A to get the fill character for an angle.
Define a sub B to get the fill character for a region.
Build an array (#a) of substitution characters using A and B.
Perform the substitution and print the results.
The generated format looks like this, for R = 4:
DKKKCJJJB
LDKKCJJBI
LLDKCJBII
LLLDCBIII
EEEEoAAAA
MMMFGHPPP
MMFNGOHPP
MFNNGOOHP
FNNNGOOOH
Where A-H denote angles and I-P denote regions.
(Admittedly, this could probably be golfed further. The operations on #a gave me incorrect output when written as one list, presumably having something to do with how map plays with $_.)
C# - 325 319 chars
using System;class P{static void Main(){var s=Console.ReadLine().Split(' ');
var d=s[0].Split('-');int l=s[1][0]-48,x,y,r,a=int.Parse(d[0]),b=int.Parse(d[1]);
for(y=l;y>=-l;y--)for(x=-l;x<=l;)Console.Write((x==0&&y==0?'o':a<=(r=((int)
(Math.Atan2(y,x)*57.3)+360)%360)&&r<b||r==b%360?
#"-/|\"[r/45%4]:' ')+(x++==l?"\n":""));}}
Newlines not significant.
Sample input/output
45-180 8
\||||||||////////
\\|||||||///////
\\\||||||//////
\\\\|||||/////
\\\\\||||////
\\\\\\|||///
\\\\\\\||//
\\\\\\\\|/
--------o
135-360 5
\
\\
\\\
\\\\
\\\\\
-----o-----
----/|\\\\\
---//||\\\\
--///|||\\\
-////||||\\
/////|||||\
Java - 304 chars
class A{public static void main(String[]a){String[]b=a[0].split("-");int e=new Integer(b[1]),r=new Integer(a[1]),g,x,y=r;for(;y>=-r;y--)for(x=-r;x<=r;)System.out.print((x==0&y==0?'o':new Integer(b[0])<=(g=((int)(Math.atan2(y,x)*57.3)+360)%360)&g<e|g==e%360?"-/|\\".charAt(g/45%4):' ')+(x++<r?"":"\n"));}}
More readable version:
class A{
public static void main(String[]a){
String[]b=a[0].split("-");
int e=new Integer(b[1]),r=new Integer(a[1]),g,x,y=r;
for(;y>=-r;y--)for(x=-r;x<=r;)System.out.print((
x==0&y==0
?'o'
:new Integer(b[0])<=(g=((int)(Math.atan2(y,x)*57.3)+360)%360)&g<e|g==e%360
?"-/|\\".charAt(g/45%4)
:' '
)+(x++<r?"":"\n"));
}
}
C (902 byte)
This doesn't use trigonometric functions (like the original perl version), so it's quite ``bloated''. Anyway, here is my first code-golf submission:
#define V(r) (4*r*r+6*r+3)
#define F for(i=0;i<r;i++)
#define C ;break;case
#define U p-=2*r+2,
#define D p+=2*r+2,
#define R *++p=
#define L *--p=
#define H *p='|';
#define E else if
#define G(a) for(j=0;j<V(r)-1;j++)if(f[j]==i+'0')f[j]=a;
#define O(i) for(i=0;i<2*r+1;i++){
main(int i,char**v){char*p,f[V(8)];
int j,m,e,s,x,y,r;p=*++v;x=atoi(p);while(*p!=45)p++;
char*h="0123";y=atoi(p+1);r=atoi(*++v);
for(p=f+2*r+1;p<f+V(r);p+=2*r+2)*p=10;
*(p-2*r-2)=0;x=x?x/45:x;y/=45;s=0;e=2*r;m=r;p=f;O(i)O(j)
if(j>e)*p=h[0];E(j>m)*p=h[1];E(j>s)*p=h[2];else*p=h[3];p++;}
if(i+1==r){h="7654";m--;e--;}E(i==r){s--;}E(i>r){s--;e++;}
else{s++;e--;}p++;}for(p=f+V(r)/2-1,i=0;i<r;i++)*++p=48;
for(i=0;i<8;i++)if(i>=x&&i<y){G(64);}else G(32);
y=y==8?0:y;q:p=f+V(r)/2-1;*p='o';switch(x){
C 0:F R 45 C 1:F U R 47 C 2:F U H C 3:F U L 92
C 4:F L 45 C 5:F D L 47 C 6:F D H C 7:F D R 92;}
if(y!=8){x=y;y=8;goto q;}puts(f);}
also, the #defines look rather ugly, but they save about 200 bytes so I kept them in, anyway. It is valid ANSI C89/C90 and compiles with very few warnings (two about atoi and puts and two about crippled form of main).

Code Golf: Who has the best poker hand?

Locked. This question and its answers are locked because the question is off-topic but has historical significance. It is not currently accepting new answers or interactions.
I love challenges like this, I'll hopefully submit my answer soon.
Which player has the best 7 card hand?
Given an unordered list of 9 cards (separated by a space), work out which player has the best poker hand. Here is a list of poker hand rankings. Example input:
2C 5H AS KS 2D 4D QD KH 3S
(ie: [[2C 5H] [AS KS] [2D 4D QD KH 3S]])
First 2 cards in the array represent player 1's hand, second 2 in the array represent player 2's hand. The last 5 cards represent the community cards, cards both players share. In effect, both players have 7 cards, and you must determine which player has the best 5 card poker hand.
A card is defined as a string, with the first character representing the card value, and the second value representing the suit. Always upper-case. No card may appear twice.
The function will calculate if the hand is a draw or a win to either player. It will ouput the totals at the end of the input. The output format is defined later on in this post.
Examples
2C 5H AS KS 2D 4D QD KH 3S
(ie: [[2C 5H] [AS KS] [2D 4D QD KH 3S]])
Player 2 wins this hand. Player 1 has a pair of 2's, player 2 has a pair of kings.
5S 6S 8H 9D 7S 8S JH TS 2H
(ie: [[5S 6S] [8H 9D] [7S 8S JH TS 2H]])
Player 1 wins this hand Player 1 has a flush, player 2 has a straight.
2S 2H AC AS 2C AH 9H TS 2D
(ie: [[2S 2H] [AC AS] [2C AH 9H TS 2D]])
Player 1 wins this hand. Player 1 has quads, player 2 has a full house
5S 6S 2D 4D 9S AS KD JC 9D
(ie: [[5S 6S] [2D 4D] [9S AS KD JC 9D]])
A draw. Both players have Ace high.
More Info
Thanks to mgroves for the following link to Project Euler which has a similar problem:
http://projecteuler.net/index.php?section=problems&id=54
Test Data
We will use the Project Euler test data:
http://projecteuler.net/project/poker.txt
Your solution should accept that text file as input, and output a total of wins and draws.
Example Output
Output must be in this format:
1: 45
2: 32
D: 12
Player 1 won 45 hands, player 2 won 32 hands, and there were 12 draws. (Not actual results)
Rules
Doesn't have to return the winning hand type, only WHO won if anyone
Card list input has no particular order
No card appears twice in the input
Input is always uppercase
Takes the Project Euler test data as an input
Outputs a count, of which player won the most hands and total draws in given format above
Perl, 414 398 370/458 344/416 char
Line breaks are not significant.
%M=map{$_,$Z++}0..9,T,J,Q,K,A;sub N{/.$/;$M{$`}.$&}
sub B{$s=#p=();
for$m(#_){$m-$_||($s+=2,++$p[$m])for#_}
#_=sort{$p[$b]-$p[$a]||$b-$a}#_;
$s=23 if$s<11&&($_[0]-$_[4]<5||$_[0]-$_[1]>8&&push#_,shift);
"#_"=~/.$/;$s+=14*(4<grep/$&/,#_);
$s=100*$s+$_ for#_;$s}
++$X{B((#c=map{N}split)[0..4])<=>B(#c[5..9])}for<>;
printf"1: %d\n2: %d\nD: %d\n",#X{1,-1,0}
This solves the "10 card" problem (10 cards are dealt, player 1 has the first 5 cards and player 2 has the second 5 cards).
The first section defines a subroutine N that can transform each card so that it has a numerical value. For non-face cards, this is a trivial mapping (5H ==> 5H) but it does transform the face cards (KC => 13C, AD => 14D).
The last section parses each line of input into cards, transforms the cards to contain numerical values, divides the cards into separate hands for the two players, and analyzes and compares those hands. Every hand increments one element of the hash %X. When all the input is parsed, %X contains the number of hands won by player 1, won by player 2, or ties.
The middle section is a subroutine that takes a set of five cards as input and produces a
12-digit number with the property that stronger poker hands will have higher-valued numbers. Here's how it works:
for$m(#_){$m-$_||($s+=2,++$p[$m])for#_}
This is the "pair" detector. If any two cards have the same numerical value, increment a hash element for one of the cards and increase the "score" variable $s by two. Note that we will end up comparing each card to itself, so $s will be at least 10 and $p[$x] will be at least one for every card $x. If the hand contains three of a kind, then those three cards will match with the other two cards -- it will be like there are 9 matches among those three cards and the "score" will be at least 18.
#_=sort{$p[$b]-$p[$a]||$b-$a}#_;
Sort the cards by (1) the number of times that card is part of a "pair" and (2) the value of the card. Thus in a hand with two 7's and two 3's, the two 7's will appear first, followed by the two 3's, followed by the kicker. In a hand with two 7's and three 3's, the three 3's will be first followed by the two 7's. The goal of this ordering is to distinguish two hands that have the same score -- a hand with a pair of 8's and a hand with a pair of 7's both have one pair, but we need to be able to tell that a pair of 8's is better.
$s=23 if$s<11&&($_[0]-$_[4]<5||$_[0]-$_[1]>8&&push#_,shift);
This line is the "straight" detector. A straight is worth 23 points and occurs when there are no pairs in the hand ($s<11 means only 5 "pairs" - each card matching with itself - were found) and either (1) the value of the highest card is exactly four more than the value of the lowest card ($_[0]-$_[4]==4), or (2) the highest value card is an Ace and the next highest card is a 5 ($_[0]-$_[1]==9), which means the hand has an A-2-3-4-5 straight. In the latter case, the Ace is now the least valuable card in the hand, so we manipulate #_ to reflect that (push#_,shift)
"#_"=~/.$/;$s+=14*(4<grep/$&/,#_);
This line is the flush detector. A flush is worth 14 more points and occurs when the last character is the same for each card. The first expression ("#_"=~/.$/) has the side effect of setting $& to the last character (the suit) of the last card in the hand. The final expression (4<grep/$&/,#_) will be true if and only if all elements of #_ have the same last character.
$s=100*$s+$_ for#_;$s}
Creates and returns a value that begins with the hand's score and then contains the values of the cards, in order of the card's importance. Scores for the various hands will be
Hand Score
---------- ------
High card 10 (each card matches itself for two points)
One pair 14 (2 additional matches)
Two pair 18 (4 additional matches)
Three of a kind 22 (6 additional matches)
Straight 23 (no pair, but 23 points for straight)
Flush 24 (no pair, but 14 additional points for the flush)
Full house 26 (8 additional matches)
4 of a kind 34 (12 additional matches)
Straight flush 37 (23 + 14 points)
which is consistent with the rules of poker. Hands with the same score can be distinguished by the values of the hand's cards, in order of importance to the hand, all the way down to the least valuable card in the hand.
The solution to the 9 card problem (two cards to player 1, two cards to player 2, the players share the next 5 cards and build their best 5 card hand) needs about 70 more strokes to choose the best 5 card hand out of the 7 cards available to each player:
%M=map{$_,$Z++}0..9,T,J,Q,K,A;sub N{/./;$M{$&}.$'}
sub A{my$I;
for$k(0..41){#d=#_;splice#d,$_,1for$k%7,$k/7;$s=#p=();
for$m(grep$_=N,#d){$m-$_||($s+=2,$p[$m]++)for#d}
#d=sort{$p[$b]-$p[$a]||$b-$a}#d;
$s=23 if$s<11&&($d[0]-$d[4]<5||$d[0]-$d[1]>8&&push#d,shift#d);
"#d"=~/.$/;$s+=14*(4<grep/$&/,#d);
$s=100*$s+$_ for#d;
$I=$s if$s>$I}$I}
++$X{A((#c=split)[0,1,4..8])<=>A(#c[2..8])}for<>;
printf"1: %d\n2: %d\nD: %d\n",#X{1,-1,0}
GolfScript - 151/187 chars
This program works on an input list of 10 cards per line, i.e. two 5 card hands.
n%0.#{3/5/{[zip~;.&,(!15*\[{n),*"TJQKA"+?}/]:|$),-4>=14*+1|{.2\?|#-,5\-.49?#*#+\.+#+\}/.16445=13*#+\]}%.~={0):0;;}{~>.!#+\#+\}if}/"1: "##n"2: "#n"D: "0
This program works on an input list of 9 cards per line, of the format described in the specifications.
n%0.#{3/.4>:D;2/2<{D+.{3/1$^.{3/1$^[zip~;.&,(!15*\[{n),*"TJQKA"+?}/]$:|),-4>=14*+1|{.2\?|#-,5\-.49?#*#+\.+#+\}/.16445=13*#+\]}%\;~}%$-1=\;}%.~={0):0;\(\}*~>.!#+\#+\}/"1: "##n"2: "#n"D: "0
Haskell: 793 796 806 826 864 904 901 880 863
Since the text file is inconsistent with 9 card hands, I'm just reading a line from the console and outputting who wins.
Bugfixes:
Ace now counts lower than a 2 in an ace-low run.
Comparing full houses fixed (again :D).
Guarantees that the best version of a given hand type is chosen. For example, if a player can choose between a 2-6 run and a 3-7 run, the 3-7 run is chosen (flushes aside).
Now shorter than the PHP solution!
Golfed:
import Data.List
(%)=mod
m=map
y=foldr1
t=0<1
z=13
w=[0,1,2,3,12]
n&x|length x<n=[]|t=take n x
b?x|b=x|t=[]
n!k= \c->e(n&m(%k)c)?(n&c)
e[]=1<1
e(x:y)=all(x==)y
k q c|any null[q c,p$c\\q c]=[]|t=q c
f=5!4
s c=(sort(m(%z)c)`elem`w:[[n..n+4]|n<-[0..8]])?c
r=3!z
p=2!z
g x y|c x y<2=x|t=y
q x(_,[])=x
q _ y=y
b h=y q$m($h)$zipWith(\t f->(,)t.y g.m(f.take 5).permutations)[1..][1!1,p,k p,r,s,f,k r,4!z,s.f]
h=reverse.a.m(%z)
a v|w\\v==[]=[-1..3]|t=sort v
c x y=o(h x)$h y
o[](_:_)=2
o[]_=0
o _[]=1
o(a:b)(k:d)|a>k=1|a<k=2|t=o b d
d n(a,k)|a==[]=0|n<1=0|r>s=1|r<s=2|f/=0=f|t=d(n-length o)(a\\o,k\\u)where(r,o)=b a;(s,u)=b k;f=c o u
i x=head.findIndices(x==)
u(n:k)c#[r,s]|n%z==i r"23456789TJQKA"&&n%4==i s"HDSC"=n|t=u k c
l c=(2&c++snd(splitAt 4c),drop 2c)
main=getLine>>=print.d 5.l.m(u[0..]).words
Ungolfed:
import Control.Exception (assert)
import Data.List (permutations, sort, intersect, findIndices, (\\))
import Data.Function (on)
(%) = mod
aceLowRun = [0,1,2,3,12]
tryTake n xs
| length xs < n = []
| otherwise = take n xs
cond ? xs
| cond = xs
| otherwise = []
eqOn n f cards = allEq (tryTake n $ map f cards) ? tryTake n cards
allEq [] = False
allEq (x:xs) = all (== x) xs
combWithPair pokerHand cards
| any null [picked1, picked2] = []
| otherwise = pokerHand cards
where
picked1 = pokerHand cards
picked2 = pair $ cards \\ picked1
straightFlush = straight . flush
quads = eqOn 4 (% 13)
fullHouse = combWithPair triples
flush = eqOn 5 (% 4)
straight cards = (sort (map (% 13) cards) `elem` runs) ? cards
where
runs = aceLowRun : [[n..n+4] | n <- [0..8]]
triples = eqOn 3 (% 13)
twoPair = combWithPair pair
pair = eqOn 2 (% 13)
single = eqOn 1 id
bestVersionOfHand [] ys = ys
bestVersionOfHand xs [] = xs
bestVersionOfHand xs ys
| compareSameRankedHands xs ys < 2 = xs
| otherwise = ys
rate rating pokerHand cards = (rating, handResult)
where
handResult = foldr1 bestVersionOfHand
(map (pokerHand . take 5) $ permutations cards)
pokerHands = zipWith rate [1..] [
single
, pair
, twoPair
, triples
, straight
, flush
, fullHouse
, quads
, straightFlush
]
bestHand hand = foldr1 (\xs ys -> if null (snd ys) then xs else ys)
(map ($ hand) pokerHands)
highestVals = reverse . arrangeVals . map (% 13)
where
arrangeVals vals = if vals `intersect` aceLowRun == aceLowRun
then [-1..3]
else sort vals
compareSameRankedHands = compareSameRankedHands' `on` highestVals
compareSameRankedHands' [] [] = 0
compareSameRankedHands' (card1:cards1) (card2:cards2)
| card1 > card2 = 1
| card1 < card2 = 2
| otherwise = compareSameRankedHands' cards1 cards2
decideWinner n cards1 cards2
| null cards1 = assert (null cards2) 0
| n < 1 = 0
| rating1 > rating2 = 1
| rating1 < rating2 = 2
| cmpRes /= 0 = cmpRes
| otherwise = decideWinner
(n - assert (length bests1 == length bests2) (length bests1))
(cards1 \\ bests1)
(cards2 \\ bests2)
where
(rating1, bests1) = bestHand cards1
(rating2, bests2) = bestHand cards2
cmpRes = compareSameRankedHands bests1 bests2
indexOf x = head . findIndices (x==)
toNum = toNum' [0..]
toNum' (n:ns) [rank, suit]
| n % 13 == indexOf rank "23456789TJQKA" && n % 4 == indexOf suit "HDSC" = n
| otherwise = toNum' ns [rank, suit]
cluster cards = (take 2 cards ++ snd (splitAt 4 cards), drop 2 cards)
main = getLine >>= print
. uncurry (decideWinner 5)
. cluster
. map toNum
. words
GolfScript 258 241 247/341 217/299 char
Solution for the 10 card problem. Only the last couple of newlines are significant:
10:T):J):Q):K):A;0:a;0:b;0:d;"\r\n"%{' '/5/{.{)\;}/4*-+++!:f;{);~}%{$0:z(%{.z-
!99*+:z}%}5*.{+}*99/:P!{..)\(#4+-!2*\;\.2<~9+-!\;+}and:s;[s f*6P=4P=f s P 6$]\;}
%.~={;;d):d;}{~>{a):a;}{b):b;}if}if}/
'1: 'a'
2: 'b'
D: 'd n
The 9 card problem currently needs about 80 more characters.
10:T):J):Q):K):A;0:a;0:b;0:d;"\r\n"%{' '/);{('Z'%+}2*[0$2>\7<]
{:H;7,{H=:x;H{x=!},:I;6,{I=:x;I{x=!},}/}%{.{)\;}/4*-+++!:f;
{);~}%{$0:z(%{.z-!99*+:z}%}5*.{+}*99/:P!{..)\(#4+-!2*\;\.2<~9+-!\;+}and:s;[
s f*6P=4P=f s P 6$]\;}%{[\].~>{~;}{~\;}if}*}%.~={;;d):d;}{~>{a):a;}{b):b;}if}if}/
'1: 'a'
2: 'b'
D: 'd n
Less golfed version of 10 card problem.
10:T;11:J;12:Q;13:K;14:A; # map for face cards
0:a;0:b;0:d; # other initialization
"\r\n"% # split input on \n
{ # on each line of input
' '/ # divide line into ten cards
5/ # split into five card hands
{. # on each of the two hands
{)\;}% # chop last character of each card
.(5*\;\{+}*= # check sum of elem == 5*1st elem
:f; # this is the flush flag
{);~}%$ # reduce cards to numerical values
0:z;{.z- 20%{}
{;z 20+}if:z}%{-1*}$ # detect pairs
.(:h;; # extract value of highest card
20h>{..)\(#4+-!2*\;\ # detect straight
.2<~9+-!\;+}and:s; # s=2 for regular straight, s=1 for A-5 straight
# result of this mapping - 6 elem array
[ 0$ # #6 - cards in the hand
.{20/}%{+}*:P # #5 - number of pairs
s # #4 - is this a straight?
f # #3 - is this a flush?
4P= # #2b - is this a full house?
h 59> # #2 - is this 4 of a kind?
s f * # #1 - is this a straight flush?
]-1%
\;
}/
\.#.# # put [hand1 hand2 hand1 hand2] on stack
= # check hand1==hand2
{;;d):d;} # if equal, increment d (draw)
{>{a):a;} # if >, increment a (player 1 wins)
{b):b;}if # if <, increment b (player 2 wins)
}if
}/
# output results
'1: 'a'
2: 'b'
D: 'd n
C, 665+379 chars
Here's my answer in 2 parts.
The first is a complete 7 card evaluator, including the "AddCard" macro A. It returns a 32-bit number ranking the hand. The high nibble is the type, bits 13..25 indicate the high card(s) and bits 0..12 indicate the kicker(s). When comparing the results, the better hand will always have the larger value.
#define U unsigned
#define c(a)X=a;i=C=0;while(X){C|=(X&1)<<i++;X/=4;}
#define A(h,c)h[c&7]+=c,h[3]|=c
U C,i,X;
U E(U h[]){
U a=h[0]+h[1]+h[2]+h[4]-(h[3]&-16),t,v,k,e=a&0x55555540,o=a&0xAAAAAA80;
if(v=e&o/2){t=7;k=h[3]^v;i=0;while(k/=4)i++;k=1<<2*i;}
else if(v=o&o-1){t=6;v/=2;k=o/2^v;}
else if(e>1&o>1){t=6;v=o/2;k=(i=e&e-1)?i:e;}
else{a=h[3];
if(t=h[i=1]-(a&1)&4||h[i=2]-(a&2)&8||h[i=4]-(a&4)&16||h[i=0]-(a&8)&32)a=h[i];
a&=-64;v=a|a>>26&16;t*=5;
if(v=v&v<<2&v<<4&v<<6&v<<8){t+=4;a=v&=~(v/2);}
else if(t)for(i=(h[i]&63)/(i?i:8),v=a;i-->5;)a&=a-1;
else if(v=o/2)t=3;
else if (e){o=e&e-1;v=(i=o&o-1)?o:e;t=1+(o>0);}
k=a^v;k&=k-1;k&=k-(i==0);}
c(v);v=C/8;c(k);
return t<<28|v<<13|C/8;}
The second is the input processor. It parses the project Euler file as 2+2+5 cards (ignoring the 10th card). It uses the Parse macro, P to create 32-bit values representing each card. The representation is 0A0K0Q0J0T090807060504030200shdc. A hand is stored as an array of 5 ints.
char*gets(char*);char*strchr(char*,char);
#define P(c)X=strchr(R,*c++)-R;C=1<<strchr(S,*c++)-S|64<<X*2;c++;
#define L(n)for(i=0;i<n;i++)
U g[5],h[5];
char*c,b[32];
char*S="CDHS";
char*R="23456789TJQKA";
int d,r[3]={0};
main(q){while(c=gets(b)){
L(2){P(c)A(g,C);}
L(2){P(c)A(h,C);}
L(5){P(c)A(g,C);A(h,C);}
d=E(g)-E(h);
r[d>0?0:d<0?1:2]++;
L(7)g[i]=h[i]=0;
}L(3)printf("%c:%d\n","12D"[i],r[i]);}
I'm sure there are a few more characters to be trimmed off. I'll add an explanation soon.
The evaluator runs #17.6 Million hands/second on my 3Ghz Core2 Duo. That's only 3.5x slower than the PokerSource evaluator, which uses at least 56K of lookup tables.
PHP, 799 chars
Line breaks are not significant. This takes input from the linked url, which is different from the example input (doesn't deal with community cards). Processing is similar to mobrule's perl answer, with a different scoring method.
<?php
function s($i){$o=array_map('intval',$i);$f=(count(array_unique(str_replace($o,'',$i)))==1);
sort($o);$v=array_count_values($o);arsort($v);$u=array_keys($v);$h=max($u);$m=$u[0];$c=reset($v);
$p=count($v);$e=$c==1&&$o[4]==14&&$o[3]==5;$r=$o==range($o[0],$o[0]+4)||$e;$q=$e?5:$h;
$s=($f&&$r&&($h==12)?2<<11:($f&&$r?(2<<10)+$q:0))+($c==4?(2<<9)+$m:0)+($c==3&&$p==2?(2<<8)+$m:0)+($f?(2<<7)+$h:0)+
($r?(2<<6)+$q:0)+($c==3?(2<<5)+$m:0)+($c==2&&$p==3?(2<<4)+$m:0)+($p==4?(2<<3)+$m:0);$s+=!$s?$h:0;return array($s,$u);}
foreach(file($argv[1]) as $d){
list($y,$z)=array_chunk(explode(' ',trim(strtr($d,array('T'=>10,'J'=>11,'Q'=>12,'K'=>13,'A'=>14)))),5);
$y=s($y);$z=s($z);$w=$y[0]-$z[0];$x=1;while(!$w&&$x<5){$w=$y[1][$x]-$z[1][$x++];}if(!$w)#$t++;elseif($w<0)#$l++;else #$k++;}
#print "1: $k\n2: $l\nD: $t";

Code Golf: Four is magic

Locked. This question and its answers are locked because the question is off-topic but has historical significance. It is not currently accepting new answers or interactions.
The puzzle
A little puzzle I heard while I was in high school went something like this...
The questioner would ask me to give him a number;
On hearing the number, the questioner would do some sort of transformation on it repeatedly (for example, he might say ten is three) until eventually arriving at the number 4 (at which point he would finish with four is magic).
Any number seems to be transformable into four eventually, no matter what.
The goal was to try to figure out the transformation function and then be able to reliably proctor this puzzle yourself.
The solution
The transformation function at any step was to
Take the number in question,
Count the number of letters in its English word representation, ignoring a hyphen or spaces or "and" (e.g., "ten" has 3 letters in it, "thirty-four" has 10 letters in it, "one hundred forty-three" has 20 letters in it).
Return that number of letters.
For all of the numbers I have ever cared to test, this converges to 4. Since "four" also has four letters in it, there would be an infinite loop here; instead it is merely referred to as magic by convention to end the sequence.
The challenge
Your challenge is to create a piece of code that will read a number from the user and then print lines showing the transformation function being repeatedly applied until "four is magic" is reached.
Specifically:
Solutions must be complete programs in and of themselves. They cannot merely be functions which take in a number-- factor in the input.
Input must be read from standard input. (Piping from "echo" or using input redirection is fine since that also goes from stdin)
The input should be in numeric form.
For every application of the transformation function, a line should be printed: a is b., where a and b are numeric forms of the numbers in the transformation.
Full stops (periods) ARE required!
The last line should naturally say, 4 is magic..
The code should produce correct output for all numbers from 0 to 99.
Examples:
> 4
4 is magic.
> 12
12 is 6.
6 is 3.
3 is 5.
5 is 4.
4 is magic.
> 42
42 is 8.
8 is 5.
5 is 4.
4 is magic.
> 0
0 is 4.
4 is magic.
> 99
99 is 10.
10 is 3.
3 is 5.
5 is 4.
4 is magic.
The winner is the shortest submission by source code character count which is also correct.
BONUS
You may also try to write a version of the code which prints out the ENGLISH NAMES for the numbers with each application of the transformation function. The original input is still numeric, but the output lines should have the word form of the number.
(Double bonus for drawing shapes with your code)
(EDIT) Some clarifications:
I do want the word to appear on both sides in all applicable cases, e.g. Nine is four. Four is magic.
I don't care about capitalization, though. And I don't care how you separate the word tokens, though they should be separated: ninety-nine is okay, ninety nine is okay, ninetynine is not okay.
I'm considering these a separate category for bonus competition with regard to the challenge, so if you go for this, don't worry about your code being longer than the numeric version.
Feel free to submit one solution for each version.
Perl, about 147 char
Loosely based on Platinum Azure's solution:
chop
($_.=
<>);#
u="433
5443554
366 887
798 866
555 766
"=~ /\d
/gx ;#4
sub r{4
-$_ ?$_
<20 ?$u
[$_ ]:(
$'? $u[
$'] :0)
+$u[18+$&]:magic}print"
$_ is ",$_=r(),'.'while
/\d
/x;
444
GolfScript - 101 96 93 92 91 90 94 86 bytes
90 → 94: Fixed output for multiples of 10.
94 → 86: Restructured code. Using base 100 to remove non-printable characters.
86 → 85: Shorter cast to string.
{n+~."+#,#6$DWOXB79Bd")base`1/10/~{~2${~1$+}%(;+~}%++=" is "\".
"1$4$4-}do;;;"magic."
Common Lisp 157 Chars
New more conforming version, now reading form standard input and ignoring spaces and hyphens:
(labels((g (x)(if(= x 4)(princ"4 is magic.")(let((n(length(remove-if(lambda(x)(find x" -"))(format nil"~r"x)))))(format t"~a is ~a.~%"x n)(g n)))))(g(read)))
In human-readable form:
(labels ((g (x)
(if (= x 4)
(princ "4 is magic.")
(let ((n (length (remove-if (lambda(x) (find x " -"))
(format nil "~r" x)))))
(format t"~a is ~a.~%" x n)
(g n)))))
(g (read)))
And some test runs:
>24
24 is 10.
10 is 3.
3 is 5.
5 is 4.
4 is magic.
>23152436
23152436 is 64.
64 is 9.
9 is 4.
4 is magic.
And the bonus version, at 165 chars:
(labels((g(x)(if(= x 4)(princ"four is magic.")(let*((f(format nil"~r"x))(n(length(remove-if(lambda(x)(find x" -"))f))))(format t"~a is ~r.~%"f n)(g n)))))(g(read)))
Giving
>24
twenty-four is ten.
ten is three.
three is five.
five is four.
four is magic.
>234235
two hundred thirty-four thousand two hundred thirty-five is forty-eight.
forty-eight is ten.
ten is three.
three is five.
five is four.
four is magic.
Python 2.x, 144 150 154 166 chars
This separates the number into tens and ones and sum them up. The undesirable property of the pseudo-ternary operator a and b or c that c is returned if b is 0 is being abused here.
n=input()
x=0x4d2d0f47815890bd2
while n-4:p=n<20and x/10**n%10or 44378/4**(n/10-2)%4+x/10**(n%10)%10+4;print n,"is %d."%p;n=p
print"4 is magic."
The previous naive version (150 chars). Just encode all lengths as an integer.
n=input()
while n-4:p=3+int('1yrof7i9b1lsi207bozyzg2m7sclycst0zsczde5oks6zt8pedmnup5omwfx56b29',36)/10**n%10;print n,"is %d."%p;n=p
print"4 is magic."
C - with number words
445 431 427 421 399 386 371 359* 356 354† 348 347 characters
That's it. I don't think I can make this any shorter.
All newlines are for readability and can be removed:
i;P(x){char*p=",one,two,three,four,five,six,sM,eight,nine,tL,elM,twelve,NP,4P,
fifP,6P,7P,8O,9P,twLQ,NQ,forQ,fifQ,6Q,7Q,8y,9Q,en,evL,thir,eL,tO,ty, is ,.\n,
4RmagicS,zero,";while(x--)if(*++p-44&&!x++)*p>95|*p<48?putchar(*p),++i:P(*p-48);
}main(c){for(scanf("%d",&c);c+(i=-4);P(34),P(c=i),P(35))P(c?c>19?P(c/10+18),
(c%=10)&&putchar(45):0,c:37);P(36);}
Below, it is somewhat unminified, but still pretty hard to read. See below for a more readable version.
i;
P(x){
char*p=",one,two,three,four,five,six,sM,eight,nine,tL,elM,twelve,NP,4P,fifP,6P,7P,8O,9P,twLQ,NQ,forQ,fifQ,6Q,7Q,8y,9Q,en,evL,thir,eL,tO,ty, is ,.\n,4RmagicS,zero,";
while(x--)
if(*++p-44&&!x++)
*p>95|*p<48?putchar(*p),++i:P(*p-48);
}
main(c){
for(scanf("%d",&c);c+(i=-4);P(34),P(c=i),P(35))
P(c?
c>19?
P(c/10+18),
(c%=10)&&
putchar(45)
:0,
c
:37);
P(36);
}
Expanded and commented:
int count; /* type int is assumed in the minified version */
void print(int index){ /* the minified version assumes a return type of int, but it's ignored */
/* see explanation of this string after code */
char *word =
/* 1 - 9 */
",one,two,three,four,five,six,sM,eight,nine,"
/* 10 - 19 */
"tL,elM,twelve,NP,4P,fifP,6P,7P,8O,9P,"
/* 20 - 90, by tens */
"twLQ,NQ,forQ,fifQ,6Q,7Q,8y,9Q,"
/* lookup table */
"en,evL,thir,eL,tO,ty, is ,.\n,4RmagicS,zero,";
while(index >= 0){
if(*word == ',')
index--;
else if(index == 0) /* we found the right word */
if(*word >= '0' && *word < 'a') /* a compression marker */
print(*word - '0'/*convert to a number*/);
else{
putchar(*word); /* write the letter to the output */
++count;
}
++word;
}
}
int main(int argc, char **argv){ /* see note about this after code */
scanf("%d", &argc); /* parse user input to an integer */
while(argc != 4){
count = 0;
if(argc == 0)
print(37/*index of "zero"*/);
else{
if(argc > 19){
print(argc / 10/*high digit*/ + 20/*offset of "twenty"*/ - 2/*20 / 10*/);
argc %= 10; /* get low digit */
if(argc != 0) /* we need a hyphen before the low digit */
putchar('-');
}
print(argc/* if 0, then nothing is printed or counted */);
}
argc = count;
print(34/*" is "*/);
print(argc); /* print count as word */
print(35/*".\n"*/);
}
print(36/*"four is magic.\n"*/);
}
About the encoded string near the beginning
The names of the numbers are compressed using a very simple scheme. Frequently used substrings are replaced with one-character indices into the name array. A "lookup table" of extra name entries is added to the end for substrings not used in their entirety in the first set. Lookups are recursive: entries can refer to other entries.
For instance, the compressed name for 11 is elM. The print() function outputs the characters e and l (lower-case 'L', not number '1') verbatim, but then it finds the M, so it calls itself with the index of the 29th entry (ASCII 'M' - ASCII '0') into the lookup table. This string is evL, so it outputs e and v, then calls itself again with the index of the 28th entry in the lookup table, which is en, and is output verbatim. This is useful because en is also used in eL for een (used after eight in eighteen), which is used in tO for teen (used for every other -teen name).
This scheme results in a fairly significant compression of the number names, while requiring only a small amount of code to decompress.
The commas at the beginning and end of the string account for the simplistic way that substrings are found within this string. Adding two characters here saves more characters later.
About the abuse of main()
argv is ignored (and therefore not declared in the compressed version), argc's value is ignored, but the storage is reused to hold the current number. This just saves me from having to declare an extra variable.
About the lack of #include
Some will complain that omitting #include <stdio.h> is cheating. It is not at all. The given is a completely legal C program that will compile correctly on any C compiler I know of (albeit with warnings). Lacking protoypes for the stdio functions, the compiler will assume that they are cdecl functions returning int, and will trust that you know what arguments to pass. The return values are ignored in this program, anyway, and they are all cdecl ("C" calling convention) functions, and we do indeed know what arguments to pass.
Output
Output is as expected:
0
zero is four.
four is magic.
1
one is three.
three is five.
five is four.
four is magic.
4
four is magic.
20
twenty is six.
six is three.
three is five.
five is four.
four is magic.
21
twenty-one is nine.
nine is four.
four is magic.
* The previous version missed the mark on two parts of the spec: it didn't handle zero, and it took input on the command line instead of stdin. Handling zeros added characters, but using stdin instead of command line args, as well as a couple of other optimzations saved the same number of characters, resulting in a wash.
† The requirements have been changed to make clear that the number word should be printed on both sides of " is ". This new version meets that requirement, and implements a couple more optimizations to (more than) account for the extra size necessary.
J, 107 112 characters
'4 is magic.',~}:('.',~":#{.,' is ',":#{:)"1]2&{.\.
(]{&(#.100 4$,#:3 u:ucp'䌵䐵吶梇禈榛ꪛ멩鮪鮺墊馊꥘誙誩墊馊ꥺ겻곋榛ꪛ멩鮪鮺'))^:a:
(Newline for readability only)
Usage and output:
'4 is magic.',~}:('.',~":#{.,' is ',":#{:)"1]2&{.\.(]{&(#.100 4$,#:3 u:ucp'䌵䐵吶梇禈榛ꪛ멩鮪鮺墊馊꥘誙誩墊馊ꥺ겻곋榛ꪛ멩鮪鮺'))^:a:12
12 is 6.
6 is 3.
3 is 5.
5 is 4.
4 is magic.
T-SQL, 413 451 499 chars
CREATE FUNCTION d(#N int) RETURNS int AS BEGIN
Declare #l char(50), #s char(50)
Select #l='0066555766',#s='03354435543668877987'
if #N<20 return 0+substring(#s,#N+1,1) return 0+substring(#l,(#N/10)+1,1) + 0+(substring(#s,#N%10+1,1))END
GO
CREATE proc M(#x int) as BEGIN
WITH r(p,n)AS(SELECT p=#x,n=dbo.d(#x) UNION ALL SELECT p=n,n=dbo.d(n) FROM r where n<>4)Select p,'is',n,'.' from r print '4 is magic.'END
(Not that I'm seriously suggesting you'd do this... really I just wanted to write a CTE)
To use:
M 95
Returns
p n
----------- ---- -----------
95 is 10.
10 is 3.
3 is 5.
5 is 4.
4 is magic.
Java (with boilerplate), 308 290 286 282 280 characters
class A{public static void main(String[]a){int i=4,j=0;for(;;)System.out.printf("%d is %s.%n",i=i==4?new java.util.Scanner(System.in).nextInt():j,i!=4?j="43354435543668877988699;::9;;:699;::9;;:588:998::9588:998::9588:998::97::<;;:<<;699;::9;;:699;::9;;:".charAt(i)-48:"magic");}}
I'm sure Groovy would get rid of much of that.
Explanation and formatting (all comments, newlines and leading/trailing whitespace removed in count):
Reasonably straight forward, but
//boilerplate
class A{
public static void main(String[]a){
//i is current/left number, j right/next number. i=4 signals to start
//by reading input
int i=4,j=0;
for(;;)
//print in the form "<left> is <right>."
System.out.printf(
"%d is %s.%n",
i=i==4?
//<left>: if i is 4 <left> will be a new starting number
new java.util.Scanner(System.in).nextInt():
//otherwise it's the next val
j,
i!=4?
//use string to map number to its length (:;< come after 9 in ASCII)
//48 is value of '0'. store in j for next iteration
j="43354435543668877988699;::9;;:699;::9;;:588:998::9588:998::9588:998::97::<;;:<<;699;::9;;:699;::9;;:".charAt(i)-48:
//i==4 is special case for right; print "magic"
"magic");
}
}
Edit: No longer use hex, this is less keystrokes
Windows PowerShell: 152 153 184 bytes
based on the previous solution, with more influence from other solutions
$o="03354435543668877988"
for($input|sv b;($a=$b)-4){if(!($b=$o[$a])){$b=$o[$a%10]-48+"66555766"[($a-$a%10)/10-2]}$b-=48-4*!$a
"$a is $b."}'4 is magic.'
C, 158 characters
main(n,c){char*d="03354435543668877988";for(scanf("%d",&n);n-4;n=c)printf("%d is %d.\n",n,c=n?n<19?d[n]-48:d[n%10]-"_,**+++)**"[n/10]:4);puts("4 is magic.");}
(originally based on Vlad's Python code, borrowed a trick from Tom Sirgedas' C++ solution to squeeze out a few more characters)
expanded version:
main(n, c) {
char *d = "03354435543668877988";
for (scanf("%d",&n); n-4; n = c)
printf("%d is %d.\n", n, c = n ? n<19 ? d[n]-48 : d[n%10] - "_,**+++)**"[n/10] : 4);
puts("4 is magic.");
}
Python, 129 133 137 148 chars
As a warm-up, here is my first version (improves couple of chars over previous best Python).
PS. After a few redactions now it is about twenty char's shorter:
n=input()
while n-4:p=(922148248>>n/10*3&7)+(632179416>>n%10*3&7)+(737280>>n&1)+4*(n<1);print n,'is %d.'%p;n=p
print'4 is magic.'
C#: 210 Characters.
Squished:
using C=System.Console;class B{static void Main(){int
x=0,y=int.Parse(C.ReadLine());while(x!=4)C.Write((x=y)+" is {0}.\n",x==4?"magic":""+(y=x==0?4:"03354435543668877988"[x<20?x:x%10]+"0066555766"[x/10]-96));}}
Expanded:
using C=System.Console;
class B
{
static void Main()
{
int x=0,y=int.Parse(C.ReadLine());
while(x!=4)
C.Write((x=y)+" is {0}.\n",
x==4?
"magic":
""+(y= x==0?
4:
"03354435543668877988"[x<20?x:x%10]+
"0066555766"[x/10]-96)
);
}
}
Tricks this approach uses:
Create a lookup table for number name lengths based on digits that appear in the number.
Use character array lookup on a string, and char arithmetic instead of a numeric array.
Use class name aliasing to short Console. to C.
Use the conditional (ternary) operator (?:) instead of if/else.
Use the \n with Write escape code instead of WriteLine
Use the fact that C# has a defined order of evaluation to allow assignments inside the Write function call
Use the assignment expressions to eliminate extra statements, and thus extra braces
Perl: 148 characters
(Perl: 233 181 212 206 200 199 198 185 179 149 148 characters)
Moved exceptions hash into unit array. This resulted in my being able to cut a lot of characters :-)
mobrule pointed out a nasty bug. Quick fix adds 31 characters, ouch!
Refactored for zero special case, mild golfing done as well.
Direct list access for single use rather than storing to array? Hell yes!
SO MUCH REFACTORING for just ONE bloody character. This, truly, is the life of a golfer. :-(
Oops, easy whitespace fix. 198 now.
Refactored some redundant code.
Last return keyword in r is unnecessary, shaved some more off.
Massive refactoring per comments; unfortunately I could only get it to 149 because I had to fix a bug that was present in both my earlier code and the commenters' versions.
Trying bareword "magic".
Let's get this ball rolling with a modest attempt in Perl.
#u=split'','4335443554366887798866555766';$_=<>;chop;print"$_ is ".($_=$_==4?0:$_<20?$u[$_]:($u[$_/10+18]+($_%10&&$u[$_%10]))or magic).".
"while$_
Tricks:
Too many!
JavaScript 1.8 (SpiderMonkey) - 153 Chars
l='4335443554366887798866555766'.split('')
for(b=readline();(a=+b)-4;print(a,'is '+b+'.'))b=a<20?l[a]:+l[18+a/10|0]+(a%10&&+l[a%10])
print('4 is magic.')
Usage: echo 42 | js golf.js
Output:
42 is 8.
8 is 5.
5 is 4.
4 is magic.
With bonus - 364 chars
l='zero one two three four five six seven eight nine ten eleven twelve thirteen fourteen fifteen sixteen seventeen eighteen nineteen twenty thirty fourty fifty sixty seventy eighty ninety'.split(' ')
z=function(a)a<20?l[a]:l[18+a/10|0]+(a%10?' '+l[a%10]:'')
for(b=+readline();(a=b)-4;print(z(a),'is '+z(b)+'.'))b=z(a).replace(' ','').length
print('four is magic.')
Output:
ninety nine is ten.
ten is three.
three is five.
five is four.
four is magic.
Haskell, 224 270 characters
o="43354435543668877988"
x!i=read[x!!i]
n x|x<20=o!x|0<1="0066555766"!div x 10+o!mod x 10
f x=zipWith(\a b->a++" is "++b++".")l(tail l)where l=map show(takeWhile(/=4)$iterate n x)++["4","magic"]
main=readLn>>=mapM putStrLn.f
And little more readable -
ones = [4,3,3,5,4,4,3,5,5,4,3,6,6,8,8,7,7,9,8,8]
tens = [0,0,6,6,5,5,5,7,6,6]
n x = if x < 20 then ones !! x else (tens !! div x 10) + (ones !! mod x 10)
f x = zipWith (\a b -> a ++ " is " ++ b ++ ".") l (tail l)
where l = map show (takeWhile (/=4) (iterate n x)) ++ ["4", "magic"]
main = readLn >>= mapM putStrLn . f
C++ Stdio version, minified: 196 characters
#include <cstdio>
#define P;printf(
char*o="43354435543668877988";main(int p){scanf("%d",&p)P"%d",p);while(p!=4){p=p<20?o[p]-48:"0366555966"[p/10]-96+o[p%10]P" is %d.\n%d",p,p);}P" is magic.\n");}
C++ Iostreams version, minified: 195 characters
#include <iostream>
#define O;std::cout<<
char*o="43354435543668877988";main(int p){std::cin>>p;O p;while(p!=4){p=p<20?o[p]-48:"0366555966"[p/10]-96+o[p%10]O" is "<<p<<".\n"<<p;}O" is magic.\n";}
Original, un-minified: 344 characters
#include <cstdio>
int ones[] = { 4, 3, 3, 5, 4, 4, 3, 5, 5, 4, 3, 6, 6, 8, 8, 7, 7, 9, 8, 8 };
int tens[] = { 0, 3, 6, 6, 5, 5, 5, 9, 6, 6 };
int n(int n) {
return n<20 ? ones[n] : tens[n/10] + ones[n%10];
}
int main(int p) {
scanf("%d", &p);
while(p!=4) {
int q = n(p);
printf("%i is %i\n", p, q);
p = q;
}
printf("%i is magic\n", p);
}
Delphi: 329 characters
Single Line Version:
program P;{$APPTYPE CONSOLE}uses SysUtils;const S=65;A='EDDFEEDFFEDGGIIHHJII';B='DGGFFFJGG';function Z(X:Byte):Byte;begin if X<20 then Z:=Ord(A[X+1])-S else Z:=(Ord(B[X DIV 10])-S)+Z(X MOD 10)end;var X,Y:Byte;begin Write('> ');ReadLn(X);repeat Y:=Z(X);WriteLn(Format('%d is %d.',[X,Y]));X:=Y;until X=4;WriteLn('4 is magic.');end.
Formated:
program P;
{$APPTYPE CONSOLE}
uses
SysUtils;
const
S = 65;
A = 'EDDFEEDFFEDGGIIHHJII';
B = 'DGGFFFJGG';
function Z(X:Byte):Byte;
begin
if X<20
then Z := Ord(A[X+1])-S
else Z := (Ord(B[X DIV 10])-S) + Z(X MOD 10);
end;
var
X,Y: Byte;
begin
Write('> ');
ReadLn(X);
repeat
Y:=Z(X);
WriteLn(Format('%d is %d.' , [X,Y]));
X:=Y;
until X=4;
WriteLn('4 is magic.');
end.
Probably room for some more squeezing... :-P
C# 314 286 283 274 289 273 252 chars.
Squished:
252
Normal:
using C = System.Console;
class P
{
static void Main()
{
var x = "4335443554366877798866555766";
int m, o, v = int.Parse(C.ReadLine());
do {
C.Write("{0} is {1}.\n", o = v, v == 4 ? (object)"magic" : v = v < 20 ? x[v] - 48 : x[17 + v / 10] - 96 + ((m = v % 10) > 0 ? x[m] : 48));
} while (o != 4);
C.ReadLine();
}
}
Edit Dykam: Did quite some carefull insertions and changes:
Changed the l.ToString() into a cast to object of the string "magic".
Created a temporary variable o, so I could move the break outside the for loop, that is, resulting in a do-while.
Inlined the o assignment, aswell the v assignment, continueing in inserting the calculation of l in the function arguments altogether, removing the need for l. Also inlined the assignment of m.
Removed a space in int[] x, int[]x is legit too.
Tried to transform the array into a string transformation, but the using System.Linq was too much to make this an improvement.
Edit 2 Dykam
Changed the int array to a char array/string, added proper arithmics to correct this.
Lua, 176 Characters
o={[0]=4,3,3,5,4,4,3,5,5,4,3,6,6,8,8,7,7,9,8,8}t={3,6,6,5,5,5,7,6,6}n=0+io.read()while n~=4 do a=o[n]or o[n%10]+t[(n-n%10)/10]print(n.." is "..a..".")n=a end print"4 is magic."
or
o={[0]=4,3,3,5,4,4
,3,5,5,4,3,6,6,8,8
,7,7,9,8,8}t={3,6,
6,5,5,5,7,6,6}n=
0+io.read()while
n ~= 4 do a= o[n
]or o[n%10]+t[(n
-n%10)/10]print(
n.." is "..a.."." )n=a
end print"4 is magic."
C - without number words
180 175* 172 167 characters
All newlines are for readability and can be removed:
i;V(x){return"\3#,#6$:WOXB79B"[x/2]/(x%2?1:10)%10;}main(c){for(scanf("%d",&c);
c-4;)i=c,printf("%d is %d.\n",i,c=c?c>19?V(c/10+19)+V(c%10):V(c):4);puts(
"4 is magic.");}
Slightly unminified:
i;
V(x){return"\3#,#6$:WOXB79B"[x/2]/(x%2?1:10)%10;}
main(c){
for(scanf("%d",&c);c-4;)
i=c,
printf("%d is %d.\n",i,c=c?c>19?V(c/10+19)+V(c%10):V(c):4);
puts("4 is magic.");
}
* The previous version missed the mark on two parts of the spec: it didn't handle zero, and it took input on the command line instead of stdin. Handling zero added characters, but using stdin instead of command line args saved even more, resulting in a net savings.
perl, 123 122 characters
Just realized that there is no requirement to output to STDOUT, so output to STDERR instead and knock off another character.
#u='0335443554366887798866555766'=~/./g;$_+=<>;warn"$_ is ",$_=$_-4?$_<20?$u[$_]||4:$u[chop]+$u[$_+18]:magic,".\n"until/g/
And, a version that returns spelled out numbers:
279 278 276 280 characters
#p=(Thir,Four,Fif,Six,Seven,Eigh,Nine);#n=("",One,Two,Three,Four,Five,#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]":Zero}$p+=<>;warnt$m=n($p)," is ",$_=$p-4?n$p=()=$m=~/\w/g:magic,".\n"until/c/
While that meets the spec, it is not 100% well formatted. It returns an extra space after numbers ending in zero. The spec does say:
"I don't care how you separate the word tokens, though they should be separated"
That's kind of weaselly though.
A more correct version at
282 281 279 283 characters
#p=(Thir,Four,Fif,Six,Seven,Eigh,Nine);#n=("\x8",One,Two,Three,Four,Five,#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]":Zero}$p+=<>;warn$m=n($p)," is ",$_=$p-4?n$p=()=$m=~/\w/g:magic,".\n"until/c/
Python:
#!/usr/bin/env python
# Number of letters in each part, we don't count spaces
Decades = ( 0, 3, 6, 6, 6, 5, 5, 7, 6, 6, 0 )
Smalls = ( 0, 3, 3, 5, 4, 4, 3, 5, 5, 4 )
Teens = ( 6, 6, 8, 8, 7, 7, 9, 8, 8 )
def Count(n):
if n > 10 and n < 20: return Teens[n-11]
return Smalls[n % 10 ] + Decades [ n / 10 ]
N = input()
while N-4:
Cnt = Count(N)
print "%d is %d" % ( N, Cnt)
N = Cnt
print "4 is magic"
C++, 171 characters (#include omitted)
void main(){char x,y,*a="03354435543668877988";scanf("%d",&x);for(;x-4;x=y)y=x?x<19?a[x]-48:"_466555766"[x/10]+a[x%10]-96:4,printf("%d is %d.\n",x,y);puts("4 is magic.");}
Ruby, 164 characters
n=gets.to_i;s="03354435543668877987";if n==0;puts"0 is 4.";else;puts"#{n} is #{n=(n<20)?s[n]-48:"0066555766"[n/10]-48+s[n%10]-48}." until n==4;end;puts"4 is magic."
decoded:
n = gets.to_i
s = "03354435543668877987"
if n == 0
puts "0 is 4."
else
puts "#{n} is #{n = (n < 20) ? s[n] - 48 : "0066555766"[n / 10] - 48 + s[n % 10] - 48}." until n == 4
end
puts "4 is magic."
Lua 185 190 199
added periods, added io.read, removed ()'s on last print
n=io.read();while(n~=4)do m=('43354435543668877988699;::9;;:699;::9;;:588:998::9588:998::9588:998::97::<;;:<<;699;::9;;:699;::9;;:'):sub(n+1):byte()-48;print(n,' is ',m,'.')n=m;end print'4 is magic.'
with line breaks
n=io.read()
while (n~=4) do
m=('43354435543668877988699;::9;;:699;::9;;:588:998::9588:998::9588:998::97::<;;:<<;699;::9;;:699;::9;;:'):sub(n+1):byte()-48;
print(n,' is ',m,'.')
n=m;
end
print'4 is magic.'
PhP Code
function get_num_name($num){
switch($num){
case 1:return 'one';
case 2:return 'two';
case 3:return 'three';
case 4:return 'four';
case 5:return 'five';
case 6:return 'six';
case 7:return 'seven';
case 8:return 'eight';
case 9:return 'nine';
}
}
function num_to_words($number, $real_name, $decimal_digit, $decimal_name){
$res = '';
$real = 0;
$decimal = 0;
if($number == 0)
return 'Zero'.(($real_name == '')?'':' '.$real_name);
if($number >= 0){
$real = floor($number);
$decimal = number_format($number - $real, $decimal_digit, '.', ',');
}else{
$real = ceil($number) * (-1);
$number = abs($number);
$decimal = number_format($number - $real, $decimal_digit, '.', ',');
}
$decimal = substr($decimal, strpos($decimal, '.') +1);
$unit_name[1] = 'thousand';
$unit_name[2] = 'million';
$unit_name[3] = 'billion';
$unit_name[4] = 'trillion';
$packet = array();
$number = strrev($real);
$packet = str_split($number,3);
for($i=0;$i<count($packet);$i++){
$tmp = strrev($packet[$i]);
$unit = $unit_name[$i];
if((int)$tmp == 0)
continue;
$tmp_res = '';
if(strlen($tmp) >= 2){
$tmp_proc = substr($tmp,-2);
switch($tmp_proc){
case '10':
$tmp_res = 'ten';
break;
case '11':
$tmp_res = 'eleven';
break;
case '12':
$tmp_res = 'twelve';
break;
case '13':
$tmp_res = 'thirteen';
break;
case '15':
$tmp_res = 'fifteen';
break;
case '20':
$tmp_res = 'twenty';
break;
case '30':
$tmp_res = 'thirty';
break;
case '40':
$tmp_res = 'forty';
break;
case '50':
$tmp_res = 'fifty';
break;
case '70':
$tmp_res = 'seventy';
break;
case '80':
$tmp_res = 'eighty';
break;
default:
$tmp_begin = substr($tmp_proc,0,1);
$tmp_end = substr($tmp_proc,1,1);
if($tmp_begin == '1')
$tmp_res = get_num_name($tmp_end).'teen';
elseif($tmp_begin == '0')
$tmp_res = get_num_name($tmp_end);
elseif($tmp_end == '0')
$tmp_res = get_num_name($tmp_begin).'ty';
else{
if($tmp_begin == '2')
$tmp_res = 'twenty';
elseif($tmp_begin == '3')
$tmp_res = 'thirty';
elseif($tmp_begin == '4')
$tmp_res = 'forty';
elseif($tmp_begin == '5')
$tmp_res = 'fifty';
elseif($tmp_begin == '6')
$tmp_res = 'sixty';
elseif($tmp_begin == '7')
$tmp_res = 'seventy';
elseif($tmp_begin == '8')
$tmp_res = 'eighty';
elseif($tmp_begin == '9')
$tmp_res = 'ninety';
$tmp_res = $tmp_res.' '.get_num_name($tmp_end);
}
break;
}
if(strlen($tmp) == 3){
$tmp_begin = substr($tmp,0,1);
$space = '';
if(substr($tmp_res,0,1) != ' ' && $tmp_res != '')
$space = ' ';
if($tmp_begin != 0){
if($tmp_begin != '0'){
if($tmp_res != '')
$tmp_res = 'and'.$space.$tmp_res;
}
$tmp_res = get_num_name($tmp_begin).' hundred'.$space.$tmp_res;
}
}
}else
$tmp_res = get_num_name($tmp);
$space = '';
if(substr($res,0,1) != ' ' && $res != '')
$space = ' ';
$res = $tmp_res.' '.$unit.$space.$res;
}
$space = '';
if(substr($res,-1) != ' ' && $res != '')
$space = ' ';
if($res)
$res .= $space.$real_name.(($real > 1 && $real_name != '')?'s':'');
if($decimal > 0)
$res .= ' '.num_to_words($decimal, '', 0, '').' '.$decimal_name.(($decimal > 1 && $decimal_name != '')?'s':'');
return ucfirst($res);
}
//////////// testing ////////////////
$str2num = 12;
while($str2num!=4){
$str = num_to_words($str2num, '', 0, '');
$str2num = strlen($str)-1;
echo $str . '=' . $str2num .'<br/>';
if ($str2num == 4)
echo 'four is magic';
}
////// Results /////////
Twelve =6
Six =3
Three =5
Five =4
four is magic
Perl - 130 chars
5.12.1 (130 chars) 121 123 132 136 140
# 1 2 3 4 5 6 7 8 9 100 11 12 13 14
#23456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123
#u='4335443554366887798866555766'=~/./g;$_=pop;say"$_ is ",$_=$_-4?$_<20?$u[$_]:$u[$_/10+18]+(($_%=10)&&$u[$_]):magic,"."until/\D/
5.10.1 (134 chars) 125 127 136 140 144
# 1 2 3 4 5 6 7 8 9 100 11 12 13 14
#23456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 1234
#u='4335443554366887798866555766'=~/./g;$_=pop;print"$_ is ",$_=$_-4?$_<20?$u[$_]:$u[$_/10+18]+(($_%=10)&&$u[$_]):magic,".\n"until/\D/
Change History:
20100714:2223 - reverted change at the attention of mobrule, but ($_%10&&$u[$_%10]) → (($_%=10)&&$u[$_]), which is the same # of chars, but I did it in case someone might see a way to improve it
20100714:0041 - split//,'...' → '...'=~/./g
20100714:0025 - ($_%10&&$u[$_%10]) → $u[$_%10]
20100713:2340 - while$_ → until/\D/ + removed unnecessary parentheses
20100713:xxxx - $=<>;chop; → $_=pop; - courtesy to mobrule
Note: I was tired of improving others' answers in comments, so now I'm being greedy and can just add my changes here :) This is a split off from Platinum Azure's answer - credit in part to Hobbs, mobrule, and Platinum Azure.
Shameless Perl with Number Words (329 characters)
Adapted fairly directly from P Daddy's C code, with some tweaks to p() to make it do the same thing using Perl primitives instead of C ones, and a mostly-rewritten mainloop. See his for an explanation. Newlines are all optional.
#t=(qw(zero one two three four five six sM eight nine
tL elM twelve NP 4P fifP 6P 7P 8O 9P twLQ NQ forQ fifQ
6Q 7Q 8y 9Q en evL thir eL tO ty 4SmagicT)," is ",".\n");
sub p{local$_=$t[pop];1while s/[0-Z]/$t[-48+ord$&]/e;
print;length}$_=<>;chop;while($_-4){
$_=($_>19?(p($_/10+18),$_&&print("-"),$_%=10)[0]:0)+p$_;
p 35;p$_;p 36}p 34
Side note: it's too bad that perl print just returns true/false; if it returned a count it would save me 7 strokes.
Ruby, 141 chars:
n=gets.to_i;m="4335443554366887798866555766";loop{s=n;n=n>20?m[18+n/10]+m[n%10]-96: m[n]-48;puts"#{s} is #{n==s ? 'magic': n}.";n==s &&break}
while(true)
{
string a;
ReadLine(a)
WriteLine(4);
}

Convert a string into Morse code [closed]

Closed. This question needs to be more focused. It is not currently accepting answers.
Closed 8 years ago.
Locked. This question and its answers are locked because the question is off-topic but has historical significance. It is not currently accepting new answers or interactions.
The challenge
The shortest code by character count, that will input a string using only alphabetical characters (upper and lower case), numbers, commas, periods and question mark, and returns a representation of the string in Morse code.
The Morse code output should consist of a dash (-, ASCII 0x2D) for a long beep (AKA 'dah') and a dot (., ASCII 0x2E) for short beep (AKA 'dit').
Each letter should be separated by a space (' ', ASCII 0x20), and each word should be separated by a forward slash (/, ASCII 0x2F).
Morse code table:
alt text http://liranuna.com/junk/morse.gif
Test cases:
Input:
Hello world
Output:
.... . .-.. .-.. --- / .-- --- .-. .-.. -..
Input:
Hello, Stackoverflow.
Output:
.... . .-.. .-.. --- --..-- / ... - .- -.-. -.- --- ...- . .-. ..-. .-.. --- .-- .-.-.-
Code count includes input/output (that is, the full program).
C (131 characters)
Yes, 131!
main(c){for(;c=c?c:(c=toupper(getch())-32)?
"•ƒŒKa`^ZRBCEIQiw#S#nx(37+$6-2&#/4)'18=,*%.:0;?5"
[c-12]-34:-3;c/=2)putch(c/2?46-c%2:0);}
I eeked out a few more characters by combining the logic from the while and for loops into a single for loop, and by moving the declaration of the c variable into the main definition as an input parameter. This latter technique I borrowed from strager's answer to another challenge.
For those trying to verify the program with GCC or with ASCII-only editors, you may need the following, slightly longer version:
main(c){for(;c=c?c:(c=toupper(getchar())-32)?c<0?1:
"\x95#\x8CKa`^ZRBCEIQiw#S#nx(37+$6-2&#/4)'18=,*%.:0;?5"
[c-12]-34:-3;c/=2)putchar(c/2?46-c%2:32);}
This version is 17 characters longer (weighing in at a comparatively huge 148), due to the following changes:
+4: getchar() and putchar() instead of the non-portable getch() and putch()
+6: escape codes for two of the characters instead of non-ASCII characters
+1: 32 instead of 0 for space character
+6: added "c<0?1:" to suppress garbage from characters less than ASCII 32 (namely, from '\n'). You'll still get garbage from any of !"#$%&'()*+[\]^_`{|}~, or anything above ASCII 126.
This should make the code completely portable. Compile with:
gcc -std=c89 -funsigned-char morse.c
The -std=c89 is optional. The -funsigned-char is necessary, though, or you will get garbage for comma and full stop.
135 characters
c;main(){while(c=toupper(getch()))for(c=c-32?
"•ƒŒKa`^ZRBCEIQiw#S#nx(37+$6-2&#/4)'18=,*%.:0;?5"
[c-44]-34:-3;c;c/=2)putch(c/2?46-c%2:0);}
In my opinion, this latest version is much more visually appealing, too. And no, it's not portable, and it's no longer protected against out-of-bounds input. It also has a pretty bad UI, taking character-by-character input and converting it to Morse Code and having no exit condition (you have to hit Ctrl+Break). But portable, robust code with a nice UI wasn't a requirement.
A brief-as-possible explanation of the code follows:
main(c){
while(c = toupper(getch())) /* well, *sort of* an exit condition */
for(c =
c - 32 ? // effectively: "if not space character"
"•ƒŒKa`^ZRBCEIQiw#S#nx(37+$6-2&#/4)'18=,*%.:0;?5"[c - 44] - 34
/* This array contains a binary representation of the Morse Code
* for all characters between comma (ASCII 44) and capital Z.
* The values are offset by 34 to make them all representable
* without escape codes (as long as chars > 127 are allowed).
* See explanation after code for encoding format.
*/
: -3; /* if input char is space, c = -3
* this is chosen because -3 % 2 = -1 (and 46 - -1 = 47)
* and -3 / 2 / 2 = 0 (with integer truncation)
*/
c; /* continue loop while c != 0 */
c /= 2) /* shift down to the next bit */
putch(c / 2 ? /* this will be 0 if we're down to our guard bit */
46 - c % 2 /* We'll end up with 45 (-), 46 (.), or 47 (/).
* It's very convenient that the three characters
* we need for this exercise are all consecutive.
*/
: 0 /* we're at the guard bit, output blank space */
);
}
Each character in the long string in the code contains the encoded Morse Code for one text character. Each bit of the encoded character represents either a dash or a dot. A one represents a dash, and a zero represents a dot. The least significant bit represents the first dash or dot in the Morse Code. A final "guard" bit determines the length of the code. That is, the highest one bit in each encoded character represents end-of-code and is not printed. Without this guard bit, characters with trailing dots couldn't be printed correctly.
For instance, the letter 'L' is ".-.." in Morse Code. To represent this in binary, we need a 0, a 1, and two more 0s, starting with the least significant bit: 0010. Tack one more 1 on for a guard bit, and we have our encoded Morse Code: 10010, or decimal 18. Add the +34 offset to get 52, which is the ASCII value of the character '4'. So the encoded character array has a '4' as the 33rd character (index 32).
This technique is similar to that used to encode characters in ACoolie's, strager's(2), Miles's, pingw33n's, Alec's, and Andrea's solutions, but is slightly simpler, requiring only one operation per bit (shifting/dividing), rather than two (shifting/dividing and decrementing).
EDIT:
Reading through the rest of the implementations, I see that Alec and Anon came up with this encoding scheme—using the guard bit—before I did. Anon's solution is particularly interesting, using Python's bin function and stripping off the "0b" prefix and the guard bit with [3:], rather than looping, anding, and shifting, as Alec and I did.
As a bonus, this version also handles hyphen (-....-), slash (-..-.), colon (---...), semicolon (-.-.-.), equals (-...-), and at sign (.--.-.). As long as 8-bit characters are allowed, these characters require no extra code bytes to support. No more characters can be supported with this version without adding length to the code (unless there's Morse Codes for greater/less than signs).
Because I find the old implementations still interesting, and the text has some caveats applicable to this version, I've left the previous content of this post below.
Okay, presumably, the user interface can suck, right? So, borrowing from strager, I've replaced gets(), which provides buffered, echoed line input, with getch(), which provides unbuffered, unechoed character input. This means that every character you type gets translated immediately into Morse Code on the screen. Maybe that's cool. It no longer works with either stdin or a command-line argument, but it's pretty damn small.
I've kept the old code below, though, for reference. Here's the new.
New code, with bounds checking, 171 characters:
W(i){i?W(--i/2),putch(46-i%2):0;}c;main(){while(c=toupper(getch())-13)
c=c-19?c>77|c<31?0:W("œ*~*hXPLJIYaeg*****u*.AC5+;79-#6=0/8?F31,2:4BDE"
[c-31]-42):putch(47),putch(0);}
Enter breaks the loop and exits the program.
New code, without bounds checking, 159 characters:
W(i){i?W(--i/2),putch(46-i%2):0;}c;main(){while(c=toupper(getch())-13)
c=c-19?W("œ*~*hXPLJIYaeg*****u*.AC5+;79-#6=0/8?F31,2:4BDE"[c-31]-42):
putch(47),putch(0);}
Below follows the old 196/177 code, with some explanation:
W(i){i?W(--i/2),putch(46-i%2):0;}main(){char*p,c,s[99];gets(s);
for(p=s;*p;)c=*p++,c=toupper(c),c=c-32?c>90|c<44?0:W(
"œ*~*hXPLJIYaeg*****u*.AC5+;79-#6=0/8?F31,2:4BDE"[c-44]-42):
putch(47),putch(0);}
This is based on Andrea's Python answer, using the same technique for generating the morse code as in that answer. But instead of storing the encodable characters one after another and finding their indexes, I stored the indexes one after another and look them up by character (similarly to my earlier answer). This prevents the long gaps near the end that caused problems for earlier implementors.
As before, I've used a character that's greater than 127. Converting it to ASCII-only adds 3 characters. The first character of the long string must be replaced with \x9C. The offset is necessary this time, otherwise a large number of characters are under 32, and must be represented with escape codes.
Also as before, processing a command-line argument instead of stdin adds 2 characters, and using a real space character between codes adds 1 character.
On the other hand, some of the other routines here don't deal with input outside the accepted range of [ ,.0-9\?A-Za-z]. If such handling were removed from this routine, then 19 characters could be removed, bringing the total down as low as 177 characters. But if this is done, and invalid input is fed to this program, it may crash and burn.
The code in this case could be:
W(i){i?W(--i/2),putch(46-i%2):0;}main(){char*p,s[99];gets(s);
for(p=s;*p;p++)*p=*p-32?W(
"œ*~*hXPLJIYaeg*****u*.AC5+;79-#6=0/8?F31,2:4BDE"
[toupper(*p)-44]-42):putch(47),putch(0);}
Using a Morse Code Font?
Console.Write(params[0]);
Perl, 170 characters (with a little help from accomplished golfer mauke). Wrapped for clarity; all newlines are removable.
$_=uc<>;y,. ,|/,;s/./$& /g;#m{A..Z,0..9,qw(| , ?)}=
".-NINNN..]IN-NII..AMN-AI---.M-ANMAA.I.-].AIAA-NANMMIOMAOUMSMSAH.B.MSOIONARZMIZ"
=~/../g;1while s![]\w|,?]!$m{$&}!;print
Explanation:
Extract the morse dictionary. Each symbol is defined in terms of two chars, which can be either literal dots or dashes, or a reference to the value of another defined char. E and T contain dummy chars to avoid desyncing the decoder; we'll remove them later.
Read and format the input. "Hello world" becomes "H E L L O / W O R L D"
The next step depends on the input and output dictionaries being distinct, so turn dots in the input to an unused char (vertical bar, |)
Replace any char in the input that occurs in the morse dictionary with its value in the dictionary, until no replacements occur.
Remove the dummy char mentioned in step 1.
Print the output.
In the final version, the dictionary is optimized for runtime efficiency:
All one-symbol characters (E and T) and two-symbol characters (A, I, M, and N) are defined directly and decode in one pass.
All three-symbol characters are defined in terms of a two-symbol character and a literal symbol, decoding in two passes.
All four-symbol characters are defined in terms of two two-symbol characters, decoding in two passes with three replacements.
The five- and six-symbol characters (numbers and punctuation) decode in three passes, with four or five replacements respectively.
Since the golfed code only replaces one character per loop (to save one character of code!) the number of loops is limited to five times the length of the input (three times the length of the input if only alphabetics are used). But by adding a g to the s/// operation, the number of loops is limited to three (two if only alphabetics are used).
Example transformation:
Hello 123
H E L L O / 1 2 3
II .] AI AI M- / AO UM SM
.... . .-.. .-.. --- / .-M- .A-- I.--
.... . .-.. .-.. --- / .---- ..--- ...--
Python list comprehension, 159-character one-liner
for c in raw_input().upper():print c<","and"/"or bin(ord("•ƒwTaQIECBRZ^`šŒ#S#n|':<.$402&9/6)(18?,*%+3-;=>"[ord(c)-44])-34)[3:].translate(" "*47+"/.-"+" "*206),
Uses the similar data packing to P Daddy's C implementation, but does not store the bits in reverse order and uses bin() to extract the data rather than arithmetic. Note also that spaces are detected using inequality; it considers every character "less than comma" to be a space.
Python for loop, 205 chars including newlines
for a in raw_input().upper():
q='_ETIANMSURWDKGOHVF_L_PJBXCYZQ__54_3___2__+____16=/_____7___8_90'.find(a);s=''
while q>0:s='-.'[q%2]+s;q=~-q/2
print['/','--..--','..--..','.-.-.-',''][' ,?.'.find(a)]+s,
I was dorking around with a compact coding for the symbols, but I don't see if getting any better than the implicit trees already in use, so I present the coding here in case some one else can use it.
Consider the string:
--..--..-.-.-..--...----.....-----.--/
which contains all the needed sequences as substrings. We could code the symbols by offset and length like this:
ET RRRIIGGGJJJJ
--..--..-.-.-..--...----.....-----.--/
CCCC DD WWW 00000
,,,,,, AALLLL BBBB 11111
--..--..-.-.-..--...----.....-----.--/
?????? KKK MMSSS 22222
FFFF PPPP 33333
--..--..-.-.-..--...----.....-----.--/
UUU XXXX 44444
NN PPPP OOO 55555
--..--..-.-.-..--...----.....-----.--/
ZZZZ 66666
77777 YYYY
--..--..-.-.-..--...----.....-----.--/
...... 88888 HHHH
99999 VVVV QQQQ
--..--..-.-.-..--...----.....-----.--/
with the space (i.e. word boundary) starting and ending on the final character (the '/'). Feel free to use it, if you see a good way.
Most of the shorter symbols have several possible codings, of course.
P Daddy found a shorter version of this trick (and I can now see at least some of the redundancy here) and did a nice c implementation. Alec did a python implementation with the first (buggy and incomplete) version. Hobbs did a pretty compact perl version that I don't understand at all.
J, 124 130 134 characters
'.- /'{~;2,~&.>(]`(<&3:)#.(a:=])"0)}.&,&#:&.></.40-~a.i.')}ggWOKIHX`dfggggggg-#B4*:68,?5</.7>E20+193ACD'{~0>.45-~a.i.toupper
J beats C! Awesome!
Usage:
'.- /'{~;2,~&.>(]`(<&3:)#.(a:=])"0)}.&,&#:&.></.40-~a.i.')}ggWOKIHX`dfggggggg-#B4*:68,?5</.7>E20+193ACD'{~0>.45-~a.i.toupper 'Hello World'
.... . .-.. .-.. --- / .-- --- .-. .-.. -..
'.- /'{~;2,~&.>(]`(<&3:)#.(a:=])"0)}.&,&#:&.></.40-~a.i.')}ggWOKIHX`dfggggggg-#B4*:68,?5</.7>E20+193ACD'{~0>.45-~a.i.toupper 'Hello, Stackoverflow.'
.... . .-.. .-.. --- .-.-.- / ... - .- -.-. -.- --- ...- . .-. ..-. .-.. --- .-- --..--
Python 3 One Liner: 172 characters
print(' '.join('/'if c==' 'else''.join('.'if x=='0'else'-'for x in bin(ord("ijÁĕÁÿïçãáàðøüþÁÁÁÁÁČÁÅ×ÚÌÂÒÎÐÄ×ÍÔÇÆÏÖÝÊÈÃÉÑËÙÛÜ"[ord(c)-44])-192)[3:])for c in input().upper()))
(Encoding the tranlation table into unicode code points. Works fine, and they display here fine in my test on my Windows Vista machine.)
Edited to pare down to 184 characters by removing some unnecessary spaces and brackets (making list comps gen exps).
Edit again: More spaces removed that I didn't even know was possible before seeing other answers here - so down to 176.
Edit again down to 172 (woo woo!) by using ' '.join instead of ''.join and doing the spaces separately. (duh!)
C# 266 chars
The 131 char C solution translated to C# yields 266 characters:
foreach(var i in Encoding.ASCII.GetBytes(args[0].ToUpper())){var c=(int)i;for(c=(c-32!=0)?Encoding.ASCII.GetBytes("•ƒŒKa`^ZRBCEIQiw#S#nx(37+$6-2&#/4)'18=,*%.:0;?5")[c-44]-34:-3;c!=0;c/=2)Console.Write(Encoding.ASCII.GetChars(new byte[]{(byte)((c/2!=0)?46-c%2:0)}));}
which is more readable as:
foreach (var i in Encoding.ASCII.GetBytes(args[0].ToUpper()))
{
var c = (int)i;
for (c = ((c - 32) != 0) ? Encoding.ASCII.GetBytes("•ƒŒKa`^ZRBCEIQiw#S#nx(37+$6-2&#/4)'18=,*%.:0;?5")[c - 44] - 34 : -3
; c != 0
; c /= 2)
Console.Write(Encoding.ASCII.GetChars(new byte[] { (byte)((c / 2 != 0) ? 46 - c % 2 : 0) }));
}
Golfscript - 106 chars - NO FUNNY CHARS :)
newline at the end of the input is not supported, so use something like this
echo -n Hello, Stackoverflow| ../golfscript.rb morse.gs
' '/{{.32|"!etianmsurwdkgohvf!l!pjbxcyzq"?)"UsL?/'#! 08<>"#".,?0123456789"?=or
2base(;>{'.-'\=}%' '}%}%'/'*
Letters are a special case and converted to lowercase and ordered in their binary positions.
Everything else is done by a translation table
Python
Incomplete solution, but maybe somebody can make a full solution out of it. Doesn't handle digits or punctuation, but weighs in at only 154 chars.
def e(l):
i='_etianmsurwdkgohvf_l_pjbxcyzq'.find(l.lower());v=''
while i>0:v='-.'[i%2]+v;i=(i-1)/2;return v or '/'
def enc(s):return ' '.join(map(e,s))
C (248 characters)
Another tree-based solution.
#define O putchar
char z[99],*t=
" ETINAMSDRGUKWOHBL~FCPJVX~YZQ~~54~3~~~2~~+~~~~16=/~~.~~7,~~8~90";c,p,i=0;
main(){gets(z);while(c=z[i++]){c-46?c-44?c:O(45):O(c);c=c>96?c-32:c;p=-1;
while(t[++p]!=c);for(;p;p/=2){O(45+p--%2);}c-32?O(32):(O(47),O(c));}}
Could be errors in source tree because wikipedia seems to have it wrong or maybe I misunderstood something.
F#, 256 chars
let rec D i=if i=16 then" "else
let x=int"U*:+F8c]uWjGbJ0-0Dnmd0BiC5?\4o`h7f>9[1E=pr_".[i]-32
if x>43 then"-"+D(x-43)else"."+D x
let M(s:string)=s.ToUpper()|>Seq.fold(fun s c->s+match c with
|' '->"/ "|','->"--..-- "|'.'->".-.-.- "|_->D(int c-48))""
For example
M("Hello, Stack.") |> printfn "%s"
yields
.... . .-.. .-.. --- --..-- / ... - .- -.-. -.- .-.-.-
I think my technique may be unique so far. The idea is:
there is an ascii range of chars that covers most of what we want (0..Z)
there are only 43 chars in this range
thus we can encode one bit (dash or dot) plus a 'next character' in a range of 86 chars
the range ascii(32-117) is all 'printable' and can serve as this 86-char range
so the string literal encodes a table along those lines
There's a little more to it, but that's the gist. Comma, period, and space are not in the range 0..Z so they're handled specially by the 'match'. Some 'unused' characters in the range 0..Z (like ';') are used in the table as suffixes of other morse translations that aren't themselves morse 'letters'.
Here's my contribution as a console application in VB.Net
Module MorseCodeConverter
Dim M() As String = {".-", "-...", "-.-.", "-..", ".", "..-.", "--.", "....", "..", ".---", "-.-", ".-..", "--", "-.", "---", ".--.", "--.-", ".-.", "...", "-", "..-", "...-", ".--", "-..-", "-.--", "--..", "-----", ".----", "..---", "...--", "....-", ".....", "-....", "--...", "---..", "----."}
Sub Main()
Dim I, O
Dim a, b
While True
I = Console.ReadLine()
O = ""
For Each a In I
b = AscW(UCase(a))
If b > 64 And b < 91 Then
O &= M(b - 65) & " "
ElseIf b > 47 And b < 58 Then
O &= M(b - 22) & " "
ElseIf b = 46 Then
O &= ".-.-.- "
ElseIf b = 44 Then
O &= "--..-- "
ElseIf b = 63 Then
O &= "..--.. "
Else
O &= "/"
End If
Next
Console.WriteLine(O)
End While
End Sub
End Module
I left he white space in to make it readable. Totals 1100 characters. It will read the input from the command line, one line at a time, and send the corresponding output back to the output stream. The compressed version is below, with only 632 characters.
Module Q
Dim M() As String={".-","-...","-.-.","-..",".","..-.","--.","....","..",".---","-.-",".-..","--","-.","---",".--.","--.-",".-.","...","-","..-","...-",".--","-..-","-.--","--..","-----",".----","..---","...--","....-",".....","-....","--...","---..","----."}
Sub Main()
Dim I,O,a,b:While 1:I=Console.ReadLine():O="":For Each a In I:b=AscW(UCase(a)):If b>64 And b<91 Then:O &=M(b-65)&" ":ElseIf b>47 And b<58 Then:O &=M(b-22)&" ":ElseIf b=46 Then:O &=".-.-.- ":ElseIf b=44 Then:O &="--..-- ":ElseIf b=63 Then:O &= "..--.. ":Else:O &="/":End IF:Next:Console.WriteLine(O):End While
End Sub
End Module
C (233 characters)
W(n,p){while(n--)putch(".-.-.--.--..--..-.....-----..../"[p++]);}main(){
char*p,c,s[99];gets(s);for(p=s;*p;){c=*p++;c=toupper(c);c=c>90?35:c-32?
"È#À#¶µ´³²±°¹¸·#####Ê##i Že‘J•aEAv„…`q!j“d‰ƒˆ"[c-44]:63;c-35?
W(c>>5,c&31):0;putch(0);}}
This takes input from stdin. Taking input from the command line adds 2 characters. Instead of:
...main(){char*p,c,s[99];gets(s);for(p=s;...
you get:
...main(int i,char**s){char*p,c;for(p=s[1];...
I'm using Windows-1252 code page for characters above 127, and I'm not sure how they'll turn up in other people's browsers. I notice that, in my browser at least (Google Chrome), two of the characters (between "#" and "i") aren't showing up. If you copy out of the browser and paste into a text editor, though, they do show up, albeit as little boxes.
It can be converted to ASCII-only, but this adds 24 characters, increasing the character count to 257. To do this, I first offset each character in the string by -64, minimizing the number of characters that are greater than 127. Then I substitute \xXX character escapes where necessary. It changes this:
...c>90?35:c-32?"È#À#¶µ´³²±°¹¸·#####Ê##i Že‘J•aEAv„…`q!j“d‰ƒˆ"[c-44]:63;
c-35?W(...
to this:
...c>90?99:c-32?"\x88#\x80#vutsrqpyxw#####\x8A#\0PA)\xE0N%Q\nU!O\5\1\66DE 1
\xE1*S$ICH"[c-44]+64:63;c-99?W(...
Here's a more nicely formatted and commented version of the code:
/* writes `n` characters from internal string to stdout, starting with
* index `p` */
W(n,p){
while(n--)
/* warning for using putch without declaring it */
putch(".-.-.--.--..--..-.....-----..../"[p++]);
/* dmckee noticed (http://tinyurl.com/n4eart) the overlap of the
* various morse codes and created a 37-character-length string that
* contained the morse code for every required character (except for
* space). You just have to know the start index and length of each
* one. With the same idea, I came up with this 32-character-length
* string. This not only saves 5 characters here, but means that I
* can encode the start indexes with only 5 bits below.
*
* The start and length of each character are as follows:
*
* A: 0,2 K: 1,3 U: 10,3 4: 18,5
* B: 16,4 L: 15,4 V: 19,4 5: 17,5
* C: 1,4 M: 5,2 W: 4,3 6: 16,5
* D: 9,3 N: 1,2 X: 9,4 7: 25,5
* E: 0,1 O: 22,3 Y: 3,4 8: 24,5
* F: 14,4 P: 4,4 Z: 8,4 9: 23,5
* G: 5,3 Q: 5,4 0: 22,5 .: 0,6
* H: 17,4 R: 0,3 1: 21,5 ,: 8,6
* I: 20,2 S: 17,3 2: 20,5 ?: 10,6
* J: 21,4 T: 1,1 3: 19,5
*/
}
main(){ /* yuck, but it compiles and runs */
char *p, c, s[99];
/* p is a pointer within the input string */
/* c saves from having to do `*p` all the time */
/* s is the buffer for the input string */
gets(s); /* warning for use without declaring */
for(p=s; *p;){ /* begin with start of input, go till null character */
c = *p++; /* grab *p into c, increment p.
* incrementing p here instead of in the for loop saves
* one character */
c=toupper(c); /* warning for use without declaring */
c = c > 90 ? 35 : c - 32 ?
"È#À#¶µ´³²±°¹¸·#####Ê##i Že‘J•aEAv„…`q!j“d‰ƒˆ"[c - 44] : 63;
/**** OR, for the ASCII version ****/
c = c > 90 ? 99 : c - 32 ?
"\x88#\x80#vutsrqpyxw#####\x8A#\0PA)\xE0N%Q\nU!O\5\1\66DE 1\xE1"
"*S$ICH"[c - 44] + 64 : 63;
/* Here's where it gets hairy.
*
* What I've done is encode the (start,length) values listed in the
* comment in the W function into one byte per character. The start
* index is encoded in the low 5 bits, and the length is encoded in
* the high 3 bits, so encoded_char = (char)(length << 5 | position).
* For the longer, ASCII-only version, 64 is subtracted from the
* encoded byte to reduce the necessity of costly \xXX representations.
*
* The character array includes encoded bytes covering the entire range
* of characters covered by the challenge, except for the space
* character, which is checked for separately. The covered range
* starts with comma, and ends with capital Z (the call to `toupper`
* above handles lowercase letters). Any characters not supported are
* represented by the "#" character, which is otherwise unused and is
* explicitly checked for later. Additionally, an explicit check is
* done here for any character above 'Z', which is changed to the
* equivalent of a "#" character.
*
* The encoded byte is retrieved from this array using the value of
* the current character minus 44 (since the first supported character
* is ASCII 44 and index 0 in the array). Finally, for the ASCII-only
* version, the offset of 64 is added back in.
*/
c - 35 ? W(c >> 5, c & 31) : 0;
/**** OR, for the ASCII version ****/
c - 99 ? W(c >> 5, c & 31) : 0;
/* Here's that explicit check for the "#" character, which, as
* mentioned above, is for characters which will be ignored, because
* they aren't supported. If c is 35 (or 99 for the ASCII version),
* then the expression before the ? evaluates to 0, or false, so the
* expression after the : is evaluated. Otherwise, the expression
* before the ? is non-zero, thus true, so the expression before
* the : is evaluated.
*
* This is equivalent to:
*
* if(c != 35) // or 99, for the ASCII version
* W(c >> 5, c & 31);
*
* but is shorter by 2 characters.
*/
putch(0);
/* This will output to the screen a blank space. Technically, it's not
* the same as a space character, but it looks like one, so I think I
* can get away with it. If a real space character is desired, this
* must be changed to `putch(32);`, which adds one character to the
* overall length.
} /* end for loop, continue with the rest of the input string */
} /* end main */
This beats everything here except for a couple of the Python implementations. I keep thinking that it can't get any shorter, but then I find some way to shave off a few more characters. If anybody can find any more room for improvement, let me know.
EDIT:
I noticed that, although this routine rejects any invalid characters above ASCII 44 (outputting just a blank space for each one), it doesn't check for invalid characters below this value. To check for these adds 5 characters to the overall length, changing this:
...c>90?35:c-32?"...
to this:
...c-32?c>90|c<44?35:"...
REBOL (118 characters)
A roughly 10 year-old implementation
foreach c ask""[l: index? find" etinamsdrgukwohblzfcpövxäqüyj"c while[l >= 2][prin pick"-."odd? l l: l / 2]prin" "]
Quoted from: http://www.rebol.com/oneliners.html
(no digits though and words are just separated by double spaces :/ ...)
Python (210 characters)
This is a complete solution based on Alec's one
def e(l):
i=(' etianmsurwdkgohvf_l_pjbxcyzq__54_3___2%7s16%7s7___8_90%12s?%8s.%29s,'%tuple('_'*5)).find(l.lower());v=''
while i>0:v='-.'[i%2]+v;i=(i-1)/2
return v or '/'
def enc(s):return ' '.join(map(e,s))
C, 338 chars
338 with indentation and all removable linebreaks removed:
#define O putchar
#define W while
char*l="x#####ppmmmmm##FBdYcbcbSd[Kcd`\31(\b1g_<qCN:_'|\25D$W[QH0";
int c,b,o;
main(){
W(1){
W(c<32)
c=getchar()&127;
W(c>96)
c^=32;
c-=32;
o=l[c/2]-64;
b=203+(c&1?o>>3:0);
o=c&1?o&7:o>>3;
W(o>6)
O(47),o=0;
c/=2;
W(c--)
b+=(l[c]-64&7)+(l[c]-64>>3);
b=(((l[b/7]<<7)+l[b/7+1])<<(b%7))>>14-o;
W(o--)
O(b&(1<<o)?46:45);
O(32);
}
}
This isn't based on the tree approach other people have been taking. Instead, l first encodes the lengths of all bytes between 32 and 95 inclusive, two bytes to a character. As an example, D is -.. for a length of 3 and E is . for a length of 1. This is encoded as 011 and 001, giving 011001. To make more characters encodable and avoid escapes, 64 is then added to the total, giving 1011001 - 89, ASCII Y. Non-morse characters are assigned a length of 0. The second half of l (starting with \031) are the bits of the morse code itself, with a dot being 1 and a dash 0. To avoid going into high ASCII, this data is encoded 7 bits/byte.
The code first sanitises c, then works out the morse length of c (in o), then adds up the lengths of all the previous characters to produce b, the bit index into the data.
Finally, it loops through the bits, printing dots and dashes.
The length '7' is used as a special flag for printing a / when encountering a space.
There are probably some small gains to be had from removing brackets, but I'm way off from some of the better results and I'm hungry, so...
C# Using Linq (133 chars)
static void Main()
{
Console.WriteLine(String.Join(" ", (from c in Console.ReadLine().ToUpper().ToCharArray()
select m[c]).ToArray()));
}
OK, so I cheated. You also need to define a dictionary as follows (didn't bother counting the chars, since this blows me out of the game):
static Dictionary<char, string> m = new Dictionary<char, string>() {
{'A', ".-"},
{'B', "-.."},
{'C', "-.-."},
{'D', "-.."},
{'E', "."},
{'F', "..-."},
{'G', "--."},
{'H', "...."},
{'I', ".."},
{'J', ".---"},
{'K', "-.-"},
{'L', ".-.."},
{'M', "--"},
{'N', "-."},
{'O', "---"},
{'P', ".--."},
{'Q', "--.-"},
{'R', ".-."},
{'S', "..."},
{'T', "-"},
{'U', "..-"},
{'V', "...-"},
{'W', ".--"},
{'X', "-..-"},
{'Y', "-.--"},
{'Z', "--.."},
{'0', "-----"},
{'1', ".----"},
{'2', "..---"},
{'3', "...--"},
{'4', "....-"},
{'5', "....."},
{'6', "-...."},
{'7', "--..."},
{'8', "---.."},
{'9', "----."},
{' ', "/"},
{'.', ".-.-.-"},
{',', "--..--"},
{'?', "..--.."},
};
Still, can someone provide a more concise C# implementation which is also as easy to understand and maintain as this?
Perl, 206 characters, using dmckee's idea
This is longer than the first one I submitted, but I still think it's interesting. And/or awful. I'm not sure yet. This makes use of dmckee's coding idea, plus a couple other good ideas that I saw around. Initially I thought that the "length/offset in a fixed string" thing couldn't come out to less data than the scheme in my other solution, which uses a fixed two bytes per char (and all printable bytes, at that). I did in fact manage to get the data down to considerably less (one byte per char, plus four bytes to store the 26-bit pattern we're indexing into) but the code to get it out again is longer, despite my best efforts to golf it. (Less complex, IMO, but longer anyway).
Anyway, 206 characters; newlines are removable except the first.
#!perl -lp
($a,#b)=unpack"b32C*",
"\264\202\317\0\31SF1\2I.T\33N/G\27\308XE0=\x002V7HMRfermlkjihgx\207\205";
$a=~y/01/-./;#m{A..Z,0..9,qw(. , ?)}=map{substr$a,$_%23,1+$_/23}#b;
$_=join' ',map$m{uc$_}||"/",/./g
Explanation:
There are two parts to the data. The first four bytes ("\264\202\317\0") represent 32 bits of morse code ("--.-..-.-.-----.....--..--------") although only the first 26 bits are used. This is the "reference string".
The remainder of the data string stores the starting position and length of substrings of the reference string that represent each character -- one byte per character, in the order (A, B, ... Z, 0, 1, ... 9, ".", ",", "?"). The values are coded as 23 * (length - 1) + pos, and the decoder reverses that. The last starting pos is of course 22.
So the unpack does half the work of extracting the data and the third line (as viewed here) does the rest, now we have a hash with $m{'a'} = '.-' et cetera, so all there is left is to match characters of the input, look them up in the hash, and format the output, which the last line does... with some help from the shebang, which tells perl to remove the newline on input, put lines of input in $_, and when the code completes running, write $_ back to output with newlines added again.
Python 2; 171 characters
Basically the same as Andrea's solution, but as a complete program, and using stupid tricks to make it shorter.
for c in raw_input().lower():print"".join(".-"[int(d)]for d in bin(
(' etianmsurwdkgohvf_l_pjbxcyzq__54_3___2%7s16%7s7___8_90%12s?%8s.%29s,'
%(('',)*5)).find(c))[3:])or'/',
(the added newlines can all be removed)
Or, if you prefer not to use the bin() function in 2.6, we can get do it in 176:
for c in raw_input():C=lambda q:q>0and C(~-q/2)+'-.'[q%2]or'';print C(
(' etianmsurwdkgohvf_l_pjbxcyzq__54_3___2%7s16%7s7___8_90%12s?%8s.%29s,'%
(('',)*5)).find(c.lower()))or'/',
(again, the added newlines can all be removed)
C89 (293 characters)
Based off some of the other answers.
EDIT: Shrunk the tree (yay).
#define P putchar
char t['~']="~ETIANMSURWDKGOHVF~L~PJBXCYZQ~~54~3",o,q[9],Q=10;main(c){for(;Q;)t[
"&./7;=>KTr"[--Q]]="2167890?.,"[Q];while((c=getchar())>=0){c-=c<'{'&c>96?32:0;c-
10?c-32?0:P(47):P(10);for(o=1;o<'~';++o)if(t[o]==c){for(;o;o/=2)q[Q++]=45+(o--&1
);for(;Q;P(q[--Q]));break;}P(32);}}
Here's another approach, based on dmckee's work, demonstrating just how readable Python is:
Python
244 characters
def h(l):p=2*ord(l.upper())-88;a,n=map(ord,"AF__GF__]E\\E[EZEYEXEWEVEUETE__________CF__IBPDJDPBGAHDPC[DNBSDJCKDOBJBTCND`DKCQCHAHCZDSCLD??OD"[p:p+2]);return "--..--..-.-.-..--...----.....-----.-"[a-64:a+n-128]
def e(s):return ' '.join(map(h,s))
Limitations:
dmckee's string missed the 'Y' character, and I was too lazy to add it. I think you'd just have to change the "??" part, and add a "-" at the end of the second string literal
it doesn't put '/' between words; again, lazy
Since the rules called for fewest characters, not fewest bytes, you could make at least one of my lookup tables smaller (by half) if you were willing to go outside the printable ASCII characters.
EDIT: If I use naïvely-chosen Unicode chars but just keep them in escaped ASCII in the source file, it still gets a tad shorter because the decoder is simpler:
Python
240 characters
def h(l):a,n=divmod(ord(u'\x06_7_\xd0\xc9\xc2\xbb\xb4\xad\xa6\x9f\x98\x91_____\x14_AtJr2<s\xc1d\x89IQdH\x8ff\xe4Pz9;\xba\x88X_f'[ord(l.upper())-44]),7);return "--..--..-.-.-..--...----.....-----.-"[a:a+n]
def e(s):return ' '.join(map(h,s))
I think it also makes the intent of the program much clearer.
If you saved this as UTF-8, I believe the program would be down to 185 characters, making it the shortest complete Python solution, and second only to Perl. :-)
Here's a third, completely different way of encoding morse code:
Python
232 characters
def d(c):
o='';b=ord("Y_j_?><80 !#'/_____f_\x06\x11\x15\x05\x02\x15\t\x1c\x06\x1e\r\x12\x07\x05\x0f\x16\x1b\n\x08\x03\r\x18\x0e\x19\x01\x13"[ord(c.upper())-44])
while b!=1:o+='.-'[b&1];b/=2
return o
e=lambda s:' '.join(map(d,s))
If you can figure out a way to map this onto some set of printable characters, you could save quite a few characters. This is probably my most direct solution, though I don't know if it's the most readable.
OK, now I've wasted way too much time on this.
Haskell
type MorseCode = String
program :: String
program = "__5__4H___3VS__F___2 UI__L__+_ R__P___1JWAE"
++ "__6__=B__/_XD__C__YKN__7_Z__QG__8_ __9__0 OMT "
decode :: MorseCode -> String
decode = interpret program
where
interpret = head . foldl exec []
exec xs '_' = undefined : xs
exec (x:y:xs) c = branch : xs
where
branch (' ':ds) = c : decode ds
branch ('-':ds) = x ds
branch ('.':ds) = y ds
branch [] = [c]
For example, decode "-- --- .-. ... . -.-. --- -.. ." returns "MORSE CODE".
This program is from taken from the excellent article Fun with Morse Code.
PHP
I modified the previous PHP entry to be slightly more efficient. :)
$a=array(32=>"/",44=>"--..--",1,".-.-.-",48=>"-----",".----","..---","...--","....-",".....","-....","--...","---..","----.",63=>"..--..",1,".-","-...","-.-.","-..",".","..-.","--.","....","..",".---","-.-",".-..","--","-.","---",".--.","--.-",".-.","...","-","..-","...-",".--","-..-","-.--","--..");
foreach(str_split(strtoupper("hello world?"))as$k=>$v){echo $a[ord($v)]." ";}
Komodo says 380 characters on 2 lines - the extra line is just for readability. ;D
The interspersed 1s in the array is just to save 2 bytes by filling that array position with data instead of manually jumping to the array position after that.
Consider the first vs. the second. The difference is clearly visible. :)
array(20=>"data",22=>"more data";
array(20=>"data",1,"more data";
The end result, however, is exactly as long as you use the array positions rather than loop through the contents, which we don't do on this golf course.
End result: 578 characters, down to 380 (198 characters, or ~34.26% savings).
Bash, a script I wrote a while ago (time-stamp says last year) weighing in at a hefty 1661 characters. Just for fun really :)
#!/bin/sh
txt=''
res=''
if [ "$1" == '' ]; then
read -se txt
else
txt="$1"
fi;
len=$(echo "$txt" | wc -c)
k=1
while [ "$k" -lt "$len" ]; do
case "$(expr substr "$txt" $k 1 | tr '[:upper:]' '[:lower:]')" in
'e') res="$res"'.' ;;
't') res="$res"'-' ;;
'i') res="$res"'..' ;;
'a') res="$res"'.-' ;;
'n') res="$res"'-.' ;;
'm') res="$res"'--' ;;
's') res="$res"'...' ;;
'u') res="$res"'..-' ;;
'r') res="$res"'.-.' ;;
'w') res="$res"'.--' ;;
'd') res="$res"'-..' ;;
'k') res="$res"'-.-' ;;
'g') res="$res"'--.' ;;
'o') res="$res"'---' ;;
'h') res="$res"'....' ;;
'v') res="$res"'...-' ;;
'f') res="$res"'..-.' ;;
'l') res="$res"'.-..' ;;
'p') res="$res"'.--.' ;;
'j') res="$res"'.---' ;;
'b') res="$res"'-...' ;;
'x') res="$res"'-..-' ;;
'c') res="$res"'-.-.' ;;
'y') res="$res"'-.--' ;;
'z') res="$res"'--..' ;;
'q') res="$res"'--.-' ;;
'5') res="$res"'.....' ;;
'4') res="$res"'....-' ;;
'3') res="$res"'...--' ;;
'2') res="$res"'..---' ;;
'1') res="$res"'.----' ;;
'6') res="$res"'-....' ;;
'7') res="$res"'--...' ;;
'8') res="$res"'---..' ;;
'9') res="$res"'----.' ;;
'0') res="$res"'-----' ;;
esac;
[ ! "$(expr substr "$txt" $k 1)" == " " ] && [ ! "$(expr substr "$txt" $(($k+1)) 1)" == ' ' ] && res="$res"' '
k=$(($k+1))
done;
echo "$res"
C89 (388 characters)
This is incomplete as it doesn't handle comma, fullstop, and query yet.
#define P putchar
char q[10],Q,tree[]=
"EISH54V 3UF 2ARL + WP J 1TNDB6=X/ KC Y MGZ7 Q O 8 90";s2;e(x){q[Q++]
=x;}p(){for(;Q--;putchar(q[Q]));Q=0;}T(int x,char*t,int s){s2=s/2;return s?*t-x
?t[s2]-x?T(x,++t+s2,--s/2)?e(45):T(x,t,--s/2)?e(46):0:e(45):e(46):0;}main(c){
while((c=getchar())>=0){c-=c<123&&c>96?32:0;if(c==10)P(10);if(c==32)P(47);else
T(c,tree,sizeof(tree)),p();P(' ');}}
Wrapped for readability. Only two of the linebreaks are required (one for the #define, one after else, which could be a space). I've added a few non-standard characters but didn't add non-7-bit ones.
C, 533 characters
I took advice from some comments and switched to stdin. Killed another 70 characters roughly.
#include <stdio.h>
#include <ctype.h>
char *u[36] = {".-","-...","-.-.","-..",".","..-.","--.","....","..",".---","-.-",".-..","--","-.","---",".--.","--.-",".-.","...","-","..-","...-",".--","-..-","-.--","--..","-----",".----","..---","...--","....-",".....","-....","--...","---..","----."};
main(){
char*v;int x;char o;
do{
o = toupper(getc(stdin));v=0;if(o>=65&&o<=90)v=u[o-'A'];if(o>=48&&o<=57)v=u[o-'0'+26];if(o==46)v=".-.-.-";if(o==44)v="--..--";if(o==63)v="..--..";if(o==32)v="/";if(v)printf("%s ", v);} while (o != EOF);
}
C (381 characters)
char*p[36]={".-","-...","-.-.","-..",".","..-.","--.","....","..",".---","-.-",".-..","--","-.","---",".--.","--.-",".-.","...","-","..-","...-",".--","-..-","-.--","--..","-----",".----","..---","...--","....-",".....","-....","--...","---..","----."};
main(){int c;while((c=tolower(getchar()))!=10)printf("%s ",c==46?".-.-.-":c==44?"--..--":c==63?"..--..":c==32?"/":*(p+(c-97)));}
C, 448 bytes using cmdline arguments:
char*a[]={".-.-.-","--..--","..--..","/",".-","-...","-.-.","-..",".","..-.","--.","....","..",".---","-.-",".-..","--","-.","---",".--.","--.-",".-.","...","-","..-","...-",".--","-..-","-.--","--..","-----",".----","..---","...--","....-",".....","-....","--...","---..","----."},*k=".,? ",*s,*p,x;main(int _,char**v){for(;s=*++v;putchar(10))for(;x=*s++;){p=strchr(k,x);printf("%s ",p?a[p-k]:isdigit(x)?a[x-18]:isalpha(x=toupper(x))?a[x-61]:0);}}
C, 416 bytes using stdin:
char*a[]={".-.-.-","--..--","..--..","/",".-","-...","-.-.","-..",".","..-.","--.","....","..",".---","-.-",".-..","--","-.","---",".--.","--.-",".-.","...","-","..-","...-",".--","-..-","-.--","--..","-----",".----","..---","...--","....-",".....","-....","--...","---..","----."},*k=".,? ",*p,x;main(){while((x=toupper(getchar()))-10){p=strchr(k,x);printf("%s ",p?a[p-k]:isdigit(x)?a[x-18]:isalpha(x)?a[x-61]:0);}}

Find a pattern of binary numbers using shift-right and bitwise-AND?

I'm attempting to write a function in assembly that will detect if a longer binary number contains a smaller binary pattern.
Example:
Does 100111 contain 1001?
When I read this problem I figured that I would do a bitwise-AND with the large number and its smaller pattern while shifting right (logical) each time in a loop.
So, in my head I thought it would do:
100111 AND 1001 = 0
Shift-right 1
010011 AND 1001 = 0
Shift-right 1
001001 AND 1001 = 1 // Pattern FOUND!
and repeat this until either the number was shifted until it was zero or the AND returned 1.
However, I think I must have something confused because this is returning 1 for most things I put in, on the first run of the loop. Am I confused on my usage of AND?
The problem is that "partial matches" also return a non-zero value for your AND check:
100111 AND 001001 = 000001
So this tests if any of the bits match, but you want to make sure all bits are the same. The result of the AND needs to be equal to the pattern you are searching:
x = 100111
if (x AND 1001 == 1001)
print "found"
Bitwise AND does not work the way you expect (judging from the samples and ignoring the notation which seems to suggest you are using bitwise AND as the logical AND of bits). AND only takes the bits that are set to 1 "into account". E.g 1111 AND 1001 == 1001.
You need to use XOR and compare against 0 for match (remember the mask the bits you are not comparing from the result). In your example a match is found when (N ^ 1001) & 1111 == 0000
In order to make sure that both the 0 and 1 bits match your search pattern, you need to do something like this:
if ((InputPattern AND SearchMask) == SearchPattern)
{
// then match
}
The SearchMask should be all 1 bits, of a length equal to your SearchPattern. For example, you could have SearchMask == 1111, SearchPattern == 1001.
You should AND and then test against the search pattern:
if ((TestPattern & SearchPattern) == SearchPattern)
{
// then match
}
(where & represents bitwise AND)