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.
Inspired by http://xkcd.com/710/ here is a code golf for it.
The Challenge
Given a positive integer greater than 0, print out the hailstone sequence for that number.
The Hailstone Sequence
See Wikipedia for more detail..
If the number is even, divide it by two.
If the number is odd, triple it and add one.
Repeat this with the number produced until it reaches 1. (if it continues after 1, it will go in an infinite loop of 1 -> 4 -> 2 -> 1...)
Sometimes code is the best way to explain, so here is some from Wikipedia
function collatz(n)
show n
if n > 1
if n is odd
call collatz(3n + 1)
else
call collatz(n / 2)
This code works, but I am adding on an extra challenge. The program must not be vulnerable to stack overflows. So it must either use iteration or tail recursion.
Also, bonus points for if it can calculate big numbers and the language does not already have it implemented. (or if you reimplement big number support using fixed-length integers)
Test case
Number: 21
Results: 21 -> 64 -> 32 -> 16 -> 8 -> 4 -> 2 -> 1
Number: 3
Results: 3 -> 10 -> 5 -> 16 -> 8 -> 4 -> 2 -> 1
Also, the code golf must include full user input and output.
x86 assembly, 1337 characters
;
; To assemble and link this program, just run:
;
; >> $ nasm -f elf collatz.asm && gcc -o collatz collatz.o
;
; You can then enjoy its output by passing a number to it on the command line:
;
; >> $ ./collatz 123
; >> 123 --> 370 --> 185 --> 556 --> 278 --> 139 --> 418 --> 209 --> 628 --> 314
; >> --> 157 --> 472 --> 236 --> 118 --> 59 --> 178 --> 89 --> 268 --> 134 --> 67
; >> --> 202 --> 101 --> 304 --> 152 --> 76 --> 38 --> 19 --> 58 --> 29 --> 88
; >> --> 44 --> 22 --> 11 --> 34 --> 17 --> 52 --> 26 --> 13 --> 40 --> 20 --> 10
; >> --> 5 --> 16 --> 8 --> 4 --> 2 --> 1
;
; There's even some error checking involved:
; >> $ ./collatz
; >> Usage: ./collatz NUMBER
;
section .text
global main
extern printf
extern atoi
main:
cmp dword [esp+0x04], 2
jne .usage
mov ebx, [esp+0x08]
push dword [ebx+0x04]
call atoi
add esp, 4
cmp eax, 0
je .usage
mov ebx, eax
push eax
push msg
.loop:
mov [esp+0x04], ebx
call printf
test ebx, 0x01
jz .even
.odd:
lea ebx, [1+ebx*2+ebx]
jmp .loop
.even:
shr ebx, 1
cmp ebx, 1
jne .loop
push ebx
push end
call printf
add esp, 16
xor eax, eax
ret
.usage:
mov ebx, [esp+0x08]
push dword [ebx+0x00]
push usage
call printf
add esp, 8
mov eax, 1
ret
msg db "%d --> ", 0
end db "%d", 10, 0
usage db "Usage: %s NUMBER", 10, 0
Befunge
&>:.:1-|
>3*^ #
|%2: <
v>2/>+
LOLCODE: 406 CHARAKTERZ
HAI
BTW COLLATZ SOUNDZ JUS LULZ
CAN HAS STDIO?
I HAS A NUMBAR
BTW, I WANTS UR NUMBAR
GIMMEH NUMBAR
VISIBLE NUMBAR
IM IN YR SEQUENZ
MOD OF NUMBAR AN 2
BOTH SAEM IT AN 0, O RLY?
YA RLY, NUMBAR R QUOSHUNT OF NUMBAR AN 2
NO WAI, NUMBAR R SUM OF PRODUKT OF NUMBAR AN 3 AN 1
OIC
VISIBLE NUMBAR
DIFFRINT 2 AN SMALLR OF 2 AN NUMBAR, O RLY?
YA RLY, GTFO
OIC
IM OUTTA YR SEQUENZ
KTHXBYE
TESTD UNDR JUSTIN J. MEZA'S INTERPRETR. KTHXBYE!
Python - 95 64 51 46 char
Obviously does not produce a stack overflow.
n=input()
while n>1:n=(n/2,n*3+1)[n%2];print n
Perl
I decided to be a little anticompetitive, and show how you would normally code such problem in Perl.
There is also a 46 (total) char code-golf entry at the end.
These first three examples all start out with this header.
#! /usr/bin/env perl
use Modern::Perl;
# which is the same as these three lines:
# use 5.10.0;
# use strict;
# use warnings;
while( <> ){
chomp;
last unless $_;
Collatz( $_ );
}
Simple recursive version
use Sub::Call::Recur;
sub Collatz{
my( $n ) = #_;
$n += 0; # ensure that it is numeric
die 'invalid value' unless $n > 0;
die 'Integer values only' unless $n == int $n;
say $n;
given( $n ){
when( 1 ){}
when( $_ % 2 != 0 ){ # odd
recur( 3 * $n + 1 );
}
default{ # even
recur( $n / 2 );
}
}
}
Simple iterative version
sub Collatz{
my( $n ) = #_;
$n += 0; # ensure that it is numeric
die 'invalid value' unless $n > 0;
die 'Integer values only' unless $n == int $n;
say $n;
while( $n > 1 ){
if( $n % 2 ){ # odd
$n = 3 * $n + 1;
} else { #even
$n = $n / 2;
}
say $n;
}
}
Optimized iterative version
sub Collatz{
my( $n ) = #_;
$n += 0; # ensure that it is numeric
die 'invalid value' unless $n > 0;
die 'Integer values only' unless $n == int $n;
#
state #next;
$next[1] //= 0; # sets $next[1] to 0 if it is undefined
#
# fill out #next until we get to a value we've already worked on
until( defined $next[$n] ){
say $n;
#
if( $n % 2 ){ # odd
$next[$n] = 3 * $n + 1;
} else { # even
$next[$n] = $n / 2;
}
#
$n = $next[$n];
}
say $n;
# finish running until we get to 1
say $n while $n = $next[$n];
}
Now I'm going to show how you would do that last example with a version of Perl prior to v5.10.0
#! /usr/bin/env perl
use strict;
use warnings;
while( <> ){
chomp;
last unless $_;
Collatz( $_ );
}
{
my #next = (0,0); # essentially the same as a state variable
sub Collatz{
my( $n ) = #_;
$n += 0; # ensure that it is numeric
die 'invalid value' unless $n > 0;
# fill out #next until we get to a value we've already worked on
until( $n == 1 or defined $next[$n] ){
print $n, "\n";
if( $n % 2 ){ # odd
$next[$n] = 3 * $n + 1;
} else { # even
$next[$n] = $n / 2;
}
$n = $next[$n];
}
print $n, "\n";
# finish running until we get to 1
print $n, "\n" while $n = $next[$n];
}
}
Benchmark
First off the IO is always going to be the slow part. So if you actually benchmarked them as-is you should get about the same speed out of each one.
To test these then, I opened a file handle to /dev/null ($null), and edited every say $n to instead read say {$null} $n. This is to reduce the dependence on IO.
#! /usr/bin/env perl
use Modern::Perl;
use autodie;
open our $null, '>', '/dev/null';
use Benchmark qw':all';
cmpthese( -10,
{
Recursive => sub{ Collatz_r( 31 ) },
Iterative => sub{ Collatz_i( 31 ) },
Optimized => sub{ Collatz_o( 31 ) },
});
sub Collatz_r{
...
say {$null} $n;
...
}
sub Collatz_i{
...
say {$null} $n;
...
}
sub Collatz_o{
...
say {$null} $n;
...
}
After having run it 10 times, here is a representative sample output:
Rate Recursive Iterative Optimized
Recursive 1715/s -- -27% -46%
Iterative 2336/s 36% -- -27%
Optimized 3187/s 86% 36% --
Finally, a real code-golf entry:
perl -nlE'say;say$_=$_%2?3*$_+1:$_/2while$_>1'
46 chars total
If you don't need to print the starting value, you could remove 5 more characters.
perl -nE'say$_=$_%2?3*$_+1:$_/2while$_>1'
41 chars total
31 chars for the actual code portion, but the code won't work without the -n switch. So I include the entire example in my count.
Haskell, 62 chars 63 76 83, 86, 97, 137
c 1=[1]
c n=n:c(div(n`mod`2*(5*n+2)+n)2)
main=readLn>>=print.c
User input, printed output, uses constant memory and stack, works with arbitrarily big integers.
A sample run of this code, given an 80 digit number of all '1's (!) as input, is pretty fun to look at.
Original, function only version:
Haskell 51 chars
f n=n:[[],f([n`div`2,3*n+1]!!(n`mod`2))]!!(1`mod`n)
Who the #&^# needs conditionals, anyway?
(edit: I was being "clever" and used fix. Without it, the code dropped to 54 chars.
edit2: dropped to 51 by factoring out f())
Golfscript : 20 chars
~{(}{3*).1&5*)/}/1+`
#
# Usage: echo 21 | ruby golfscript.rb collatz.gs
This is equivalent to
stack<int> s;
s.push(21);
while (s.top() - 1) {
int x = s.top();
int numerator = x*3+1;
int denominator = (numerator&1) * 5 + 1;
s.push(numerator/denominator);
}
s.push(1);
return s;
bc 41 chars
I guess this kind of problems is what bc was invented for:
for(n=read();n>1;){if(n%2)n=n*6+2;n/=2;n}
Test:
bc1 -q collatz.bc
21
64
32
16
8
4
2
1
Proper code:
for(n=read();n>1;){if(n%2)n=n*3+1else n/=2;print n,"\n"}
bc handles numbers with up to INT_MAX digits
Edit: The Wikipedia article mentions this conjecture has been checked for all values up to 20x258 (aprox. 5.76e18). This program:
c=0;for(n=2^20000+1;n>1;){if(n%2)n=n*6+2;n/=2;c+=1};n;c
tests 220,000+1 (aprox. 3.98e6,020) in 68 seconds, 144,404 cycles.
Perl : 31 chars
perl -nE 'say$_=$_%2?$_*3+1:$_/2while$_>1'
# 123456789 123456789 123456789 1234567
Edited to remove 2 unnecessary spaces.
Edited to remove 1 unnecessary space.
MS Excel, 35 chars
=IF(A1/2=ROUND(A1/2,0),A1/2,A1*3+1)
Taken straight from Wikipedia:
In cell A1, place the starting number.
In cell A2 enter this formula =IF(A1/2=ROUND(A1/2,0),A1/2,A1*3+1)
Drag and copy the formula down until 4, 2, 1
It only took copy/pasting the formula 111 times to get the result for a starting number of 1000. ;)
C : 64 chars
main(x){for(scanf("%d",&x);x>=printf("%d,",x);x=x&1?3*x+1:x/2);}
With big integer support: 431 (necessary) chars
#include <stdlib.h>
#define B (w>=m?d=realloc(d,m=m+m):0)
#define S(a,b)t=a,a=b,b=t
main(m,w,i,t){char*d=malloc(m=9);for(w=0;(i=getchar()+2)/10==5;)
B,d[w++]=i%10;for(i=0;i<w/2;i++)S(d[i],d[w-i-1]);for(;;w++){
while(w&&!d[w-1])w--;for(i=w+1;i--;)putchar(i?d[i-1]+48:10);if(
w==1&&*d==1)break;if(*d&1){for(i=w;i--;)d[i]*=3;*d+=1;}else{
for(i=w;i-->1;)d[i-1]+=d[i]%2*10,d[i]/=2;*d/=2;}B,d[w]=0;for(i=0
;i<w;i++)d[i+1]+=d[i]/10,d[i]%=10;}}
Note: Do not remove #include <stdlib.h> without at least prototyping malloc/realloc, as doing so will not be safe on 64-bit platforms (64-bit void* will be converted to 32-bit int).
This one hasn't been tested vigorously yet. It could use some shortening as well.
Previous versions:
main(x){for(scanf("%d",&x);printf("%d,",x),x-1;x=x&1?3*x+1:x/2);} // 66
(removed 12 chars because no one follows the output format... :| )
Another assembler version. This one is not limited to 32 bit numbers, it can handle numbers up to 1065534 although the ".com" format MS-DOS uses is limited to 80 digit numbers. Written for A86 assembler and requires a Win-XP DOS box to run. Assembles to 180 bytes:
mov ax,cs
mov si,82h
add ah,10h
mov es,ax
mov bh,0
mov bl,byte ptr [80h]
cmp bl,1
jbe ret
dec bl
mov cx,bx
dec bl
xor di,di
p1:lodsb
sub al,'0'
cmp al,10
jae ret
stosb
loop p1
xor bp,bp
push es
pop ds
p2:cmp byte ptr ds:[bp],0
jne p3
inc bp
jmp p2
ret
p3:lea si,[bp-1]
cld
p4:inc si
mov dl,[si]
add dl,'0'
mov ah,2
int 21h
cmp si,bx
jne p4
cmp bx,bp
jne p5
cmp byte ptr [bx],1
je ret
p5:mov dl,'-'
mov ah,2
int 21h
mov dl,'>'
int 21h
test byte ptr [bx],1
jz p10
;odd
mov si,bx
mov di,si
mov dx,3
dec bp
std
p6:lodsb
mul dl
add al,dh
aam
mov dh,ah
stosb
cmp si,bp
jnz p6
or dh,dh
jz p7
mov al,dh
stosb
dec bp
p7:mov si,bx
mov di,si
p8:lodsb
inc al
xor ah,ah
aaa
stosb
or ah,ah
jz p9
cmp si,bp
jne p8
mov al,1
stosb
jmp p2
p9:inc bp
jmp p2
p10:mov si,bp
mov di,bp
xor ax,ax
p11:lodsb
test ah,1
jz p12
add al,10
p12:mov ah,al
shr al,1
cmp di,bx
stosb
jne p11
jmp p2
dc - 24 chars 25 28
dc is a good tool for this sequence:
?[d5*2+d2%*+2/pd1<L]dsLx
dc -f collatz.dc
21
64
32
16
8
4
2
1
Also 24 chars using the formula from the Golfscript entry:
?[3*1+d2%5*1+/pd1<L]dsLx
57 chars to meet the specs:
[Number: ]n?[Results: ]ndn[d5*2+d2%*+2/[ -> ]ndnd1<L]dsLx
dc -f collatz-spec.dc
Number: 3
Results: 3 -> 10 -> 5 -> 16 -> 8 -> 4 -> 2 -> 1
Scheme: 72
(define(c n)(if(= n 1)`(1)(cons n(if(odd? n)(c(+(* n 3)1))(c(/ n 2))))))
This uses recursion, but the calls are tail-recursive so I think they'll be optimized to iteration. In some quick testing, I haven't been able to find a number for which the stack overflows anyway. Just for example:
(c 9876543219999999999000011234567898888777766665555444433332222
7777777777777777777777777777777798797657657651234143375987342987
5398709812374982529830983743297432985230985739287023987532098579
058095873098753098370938753987)
...runs just fine. [that's all one number -- I've just broken it to fit on screen.]
Mathematica, 45 50 chars
c=NestWhileList[If[OddQ##,3#+1,#/2]&,#,#>1&]&
Ruby, 50 chars, no stack overflow
Basically a direct rip of makapuf's Python solution:
def c(n)while n>1;n=n.odd?? n*3+1: n/2;p n end end
Ruby, 45 chars, will overflow
Basically a direct rip of the code provided in the question:
def c(n)p n;n.odd?? c(3*n+1):c(n/2)if n>1 end
import java.math.BigInteger;
public class SortaJava {
static final BigInteger THREE = new BigInteger("3");
static final BigInteger TWO = new BigInteger("2");
interface BiFunc<R, A, B> {
R call(A a, B b);
}
interface Cons<A, B> {
<R> R apply(BiFunc<R, A, B> func);
}
static class Collatz implements Cons<BigInteger, Collatz> {
BigInteger value;
public Collatz(BigInteger value) { this.value = value; }
public <R> R apply(BiFunc<R, BigInteger, Collatz> func) {
if(BigInteger.ONE.equals(value))
return func.call(value, null);
if(value.testBit(0))
return func.call(value, new Collatz((value.multiply(THREE)).add(BigInteger.ONE)));
return func.call(value, new Collatz(value.divide(TWO)));
}
}
static class PrintAReturnB<A, B> implements BiFunc<B, A, B> {
boolean first = true;
public B call(A a, B b) {
if(first)
first = false;
else
System.out.print(" -> ");
System.out.print(a);
return b;
}
}
public static void main(String[] args) {
BiFunc<Collatz, BigInteger, Collatz> printer = new PrintAReturnB<BigInteger, Collatz>();
Collatz collatz = new Collatz(new BigInteger(args[0]));
while(collatz != null)
collatz = collatz.apply(printer);
}
}
Python 45 Char
Shaved a char off of makapuf's answer.
n=input()
while~-n:n=(n/2,n*3+1)[n%2];print n
TI-BASIC
Not the shortest, but a novel approach. Certain to slow down considerably with large sequences, but it shouldn't overflow.
PROGRAM:COLLATZ
:ClrHome
:Input X
:Lbl 1
:While X≠1
:If X/2=int(X/2)
:Then
:Disp X/2→X
:Else
:Disp X*3+1→X
:End
:Goto 1
:End
Haskell : 50
c 1=[1];c n=n:(c$if odd n then 3*n+1 else n`div`2)
not the shortest, but an elegant clojure solution
(defn collatz [n]
(print n "")
(if (> n 1)
(recur
(if (odd? n)
(inc (* 3 n))
(/ n 2)))))
C#: 216 Characters
using C=System.Console;class P{static void Main(){var p="start:";System.Action<object> o=C.Write;o(p);ulong i;while(ulong.TryParse(C.ReadLine(),out i)){o(i);while(i > 1){i=i%2==0?i/2:i*3+1;o(" -> "+i);}o("\n"+p);}}}
in long form:
using C = System.Console;
class P
{
static void Main()
{
var p = "start:";
System.Action<object> o = C.Write;
o(p);
ulong i;
while (ulong.TryParse(C.ReadLine(), out i))
{
o(i);
while (i > 1)
{
i = i % 2 == 0 ? i / 2 : i * 3 + 1;
o(" -> " + i);
}
o("\n" + p);
}
}
}
New Version, accepts one number as input provided through the command line, no input validation. 173 154 characters.
using System;class P{static void Main(string[]a){Action<object>o=Console.Write;var i=ulong.Parse(a[0]);o(i);while(i>1){i=i%2==0?i/2:i*3+1;o(" -> "+i);}}}
in long form:
using System;
class P
{
static void Main(string[]a)
{
Action<object>o=Console.Write;
var i=ulong.Parse(a[0]);
o(i);
while(i>1)
{
i=i%2==0?i/2:i*3+1;
o(" -> "+i);
}
}
}
I am able to shave a few characters by ripping off the idea in this answer to use a for loop rather than a while. 150 characters.
using System;class P{static void Main(string[]a){Action<object>o=Console.Write;for(var i=ulong.Parse(a[0]);i>1;i=i%2==0?i/2:i*3+1)o(i+" -> ");o(1);}}
Ruby, 43 characters
bignum supported, with stack overflow susceptibility:
def c(n)p n;n%2>0?c(3*n+1):c(n/2)if n>1 end
...and 50 characters, bignum supported, without stack overflow:
def d(n)while n>1 do p n;n=n%2>0?3*n+1:n/2 end end
Kudos to Jordan. I didn't know about 'p' as a replacement for puts.
nroff1
Run with nroff -U hail.g
.warn
.pl 1
.pso (printf "Enter a number: " 1>&2); read x; echo .nr x $x
.while \nx>1 \{\
. ie \nx%2 .nr x \nx*3+1
. el .nr x \nx/2
\nx
.\}
1. groff version
Scala + Scalaz
import scalaz._
import Scalaz._
val collatz =
(_:Int).iterate[Stream](a=>Seq(a/2,3*a+1)(a%2)).takeWhile(1<) // This line: 61 chars
And in action:
scala> collatz(7).toList
res15: List[Int] = List(7, 22, 11, 34, 17, 52, 26, 13, 40, 20, 10, 5, 16, 8, 4, 2)
Scala 2.8
val collatz =
Stream.iterate(_:Int)(a=>Seq(a/2,3*a+1)(a%2)).takeWhile(1<) :+ 1
This also includes the trailing 1.
scala> collatz(7)
res12: scala.collection.immutable.Stream[Int] = Stream(7, 22, 11, 34, 17, 52, 26, 13, 40, 20, 10, 5, 16, 8, 4, 2, 1)
With the following implicit
implicit def intToEven(i:Int) = new {
def ~(even: Int=>Int, odd: Int=>Int) = {
if (i%2==0) { even(i) } else { odd(i) }
}
}
this can be shortened to
val collatz = Stream.iterate(_:Int)(_~(_/2,3*_+1)).takeWhile(1<) :+ 1
Edit - 58 characters (including input and output, but not including initial number)
var n=readInt;while(n>1){n=Seq(n/2,n*3+1)(n%2);println(n)}
Could be reduced by 2 if you don't need newlines...
F#, 90 characters
let c=Seq.unfold(function|n when n<=1->None|n when n%2=0->Some(n,n/2)|n->Some(n,(3*n)+1))
> c 21;;
val it : seq<int> = seq [21; 64; 32; 16; ...]
Or if you're not using F# interactive to display the result, 102 characters:
let c=Seq.unfold(function|n when n<=1->None|n when n%2=0->Some(n,n/2)|n->Some(n,(3*n)+1))>>printf"%A"
Common Lisp, 141 characters:
(defun c ()
(format t"Number: ")
(loop for n = (read) then (if(oddp n)(+ 1 n n n)(/ n 2))
until (= n 1)
do (format t"~d -> "n))
(format t"1~%"))
Test run:
Number: 171
171 -> 514 -> 257 -> 772 -> 386 -> 193 -> 580 -> 290 -> 145 -> 436 ->
218 -> 109 -> 328 -> 164 -> 82 -> 41 -> 124 -> 62 -> 31 -> 94 -> 47 ->
142 -> 71 -> 214 -> 107 -> 322 -> 161 -> 484 -> 242 -> 121 -> 364 ->
182 -> 91 -> 274 -> 137 -> 412 -> 206 -> 103 -> 310 -> 155 -> 466 ->
233 -> 700 -> 350 -> 175 -> 526 -> 263 -> 790 -> 395 -> 1186 -> 593 ->
1780 -> 890 -> 445 -> 1336 -> 668 -> 334 -> 167 -> 502 -> 251 -> 754 ->
377 -> 1132 -> 566 -> 283 -> 850 -> 425 -> 1276 -> 638 -> 319 ->
958 -> 479 -> 1438 -> 719 -> 2158 -> 1079 -> 3238 -> 1619 -> 4858 ->
2429 -> 7288 -> 3644 -> 1822 -> 911 -> 2734 -> 1367 -> 4102 -> 2051 ->
6154 -> 3077 -> 9232 -> 4616 -> 2308 -> 1154 -> 577 -> 1732 -> 866 ->
433 -> 1300 -> 650 -> 325 -> 976 -> 488 -> 244 -> 122 -> 61 -> 184 ->
92 -> 46 -> 23 -> 70 -> 35 -> 106 -> 53 -> 160 -> 80 -> 40 -> 20 ->
10 -> 5 -> 16 -> 8 -> 4 -> 2 -> 1
The program frm Jerry Coffin has integer over flow, try this one:
#include <iostream>
int main(unsigned long long i)
{
int j = 0;
for( std::cin>>i; i>1; i = i&1? i*3+1:i/2, ++j)
std::cout<<i<<" -> ";
std::cout<<"\n"<<j << " iterations\n";
}
tested with
The number less than 100 million with the longest total stopping time is 63,728,127, with 949 steps.
The number less than 1 billion with the longest total stopping time is 670,617,279, with 986 steps.
ruby, 43, possibly meeting the I/O requirement
Run with ruby -n hail
n=$_.to_i
(n=n%2>0?n*3+1: n/2
p n)while n>1
C# : 659 chars with BigInteger support
using System.Linq;using C=System.Console;class Program{static void Main(){var v=C.ReadLine();C.Write(v);while(v!="1"){C.Write("->");if(v[v.Length-1]%2==0){v=v.Aggregate(new{s="",o=0},(r,c)=>new{s=r.s+(char)((c-48)/2+r.o+48),o=(c%2)*5}).s.TrimStart('0');}else{var q=v.Reverse().Aggregate(new{s="",o=0},(r, c)=>new{s=(char)((c-48)*3+r.o+(c*3+r.o>153?c*3+r.o>163?28:38:48))+r.s,o=c*3+r.o>153?c*3+r.o>163?2:1:0});var t=(q.o+q.s).TrimStart('0').Reverse();var x=t.First();q=t.Skip(1).Aggregate(new{s=x>56?(x-57).ToString():(x-47).ToString(),o=x>56?1:0},(r,c)=>new{s=(char)(c-48+r.o+(c+r.o>57?38:48))+r.s,o=c+r.o>57?1:0});v=(q.o+q.s).TrimStart('0');}C.Write(v);}}}
Ungolfed
using System.Linq;
using C = System.Console;
class Program
{
static void Main()
{
var v = C.ReadLine();
C.Write(v);
while (v != "1")
{
C.Write("->");
if (v[v.Length - 1] % 2 == 0)
{
v = v
.Aggregate(
new { s = "", o = 0 },
(r, c) => new { s = r.s + (char)((c - 48) / 2 + r.o + 48), o = (c % 2) * 5 })
.s.TrimStart('0');
}
else
{
var q = v
.Reverse()
.Aggregate(
new { s = "", o = 0 },
(r, c) => new { s = (char)((c - 48) * 3 + r.o + (c * 3 + r.o > 153 ? c * 3 + r.o > 163 ? 28 : 38 : 48)) + r.s, o = c * 3 + r.o > 153 ? c * 3 + r.o > 163 ? 2 : 1 : 0 });
var t = (q.o + q.s)
.TrimStart('0')
.Reverse();
var x = t.First();
q = t
.Skip(1)
.Aggregate(
new { s = x > 56 ? (x - 57).ToString() : (x - 47).ToString(), o = x > 56 ? 1 : 0 },
(r, c) => new { s = (char)(c - 48 + r.o + (c + r.o > 57 ? 38 : 48)) + r.s, o = c + r.o > 57 ? 1 : 0 });
v = (q.o + q.s)
.TrimStart('0');
}
C.Write(v);
}
}
}
Related
I am writing a 8bit integer newton raphson function in MASM X8086-32bit assembly and I think I am stuck in an infinite loop. The editor I have to use for class does not send an error for infinite loops.
Anyways I am not sure where my problem is. I just started MASM a few weeks ago and am kind of lost any help with the infinite loop would be appreciated. My initial x value is defined as 1.
The function is y = 1/2(x+n/x) ===> x/2+ n/2x where n is the number in question. and x is the intitialized value and then the previous iterations y value.
mov ah, 09h
lea dx, prompt ;Prompt User
int 21h
mov ah, 01h
int 21h ;User input
sub al, 30h
mov bh, al
mov bl, x ;Loading for loop
mov al, x
iteration:
mul bl; al*bl = al
mov dl, al ; storing x^2
add al, 01h ; (x+1)^2
mul al
cmp bh, dl
jge doneCheck ; bh - dl ====> n- x^2 => 0
doneCheck:
cmp bh, al; bh-al = ? ====>n - (x+1)^2 == -int
jl done
mov al, 02h; loading 2 in ah
mul bl ; bl*al = 2(bl) = 2x = al
shr bl, 1 ; x/2 = bl
mov cl, al ; storing 2x in cl
mov ah, 0 ; clearing ah
mov ch, 0; clearing ch
mov al, bh ; moving n into ax for division prep
div cx ; ax/cl ====> n/2x ===> p =ah and q = al
add bl, ah ;so this is finally 1/2(x+(n/x)) === (x/2+n/2x) y the new value y is now stored in bl for next loop
mov al, bl ; for next loop
jmp iteration
done:
mov dl, bl; print square root
mov ah, 02h
int 21h
This:
shl bl, 1 ; x/2 = bl
shouldn't be?:
shr bl,1
-- Updated:
And about your question:
BH = Number to find sqrt. When x^2 == BH then x is the sqrt(n)
AL and BL = y value of the last iteration
and you do:
mul bl ; AL*BH => AX
cmp bh, al ; BH == AL? or with names: n == x^2 ?
Why the infinite loop?:
As you take the input with AH=01h+int 21h, you only read one char and you get the ascii code in AL.
Let's assume the user input number is "A", which is translated into the number 65. By no means, any integer will give you x^2 = 65, so that loop will loop forever.
I suggest you to use this condition as the loop break. The result will be an approximation (rounded to the lower number):
(n >= x^2) && (n < (x+1)^2)
Bear in mind that you are working all with 8 bits, so the highest solution would be: y = 15. Look at this:
1^2 = 1
2^2 = 4
3^2 = 9
4^2 = 16
5^2 = 25
6^2 = 36
7^2 = 49
8^2 = 64
...
15^2 = 225
Those are the only numbers you can calculate sqrt with your code (without my proposal).
So you can only press the following keys as input:
$ = number 36
1 = number 49
# = number 64
Q = number 81
d = number 100
y = number 121
Any keypress between those will make your code get into an infinite loop.
And a tip for output: add 48 to BL before printing it so it goes to an ASCII number :)
-- Update 2 :
From your code I found this errors:
add al, 01h ; (x+1)^2 ; AL = x^2, therefore you are doing (x^2)+1
mul al
and here the execution flow will execute all lines always:
cmp bh, dl
jge doneCheck ; bh >= dl? ====> n >= x^2 ?
doneCheck:
cmp bh, al; bh-al = ? ====>n - (x+1)^2 == -int
jl done
I guess it should be something like:
cmp bh, dl ; n vs x^2
jb notSolution ; BH < DL? ====> if n < x^2 continue with next NR step
cmp bh, al ; here, n >= x^2
jb done ; BH < AL ? ====> if n < (x+1)^2 we found a solution
notSolution: ; n is not in [ x^2 , (x+1)^2 )
I used jb instead of jl because I assume only possitive numbers. jl will treat 129 as a negative number and maybe we will be in trouble.
-- Update 3:
From Peter Cordes' answer, a detail I didn't notice (I read div cl):
div cx ; ax/cl ====> n/2x ===> p =ah and q = al. That would be correct if you'd used div cl
I'm not sure you've correctly understood that MUL and DIV have one operand each that's double the width of the other two.
Your comments on those lines are wrong:
mul bl; al*bl = al: no, AX = AL*BL.
div cx ; ax/cl ====> n/2x ===> p =ah and q = al. That would be correct if you'd used div cl, but DIV r/m16 takes DX:AX as a 32-bit dividend, and produces results in AX=quotient, DX=remainder.
Look up MUL and DIV in the manual.
I highly recommend single-stepping through your code in a debugger. And/or stopping it in a debugger after it gets into an infinite loop, and single step from there while watching registers.
The bottom of the x86 tag wiki has some tips on using GDB to debug asm. (e.g. use layout reg). Since you're using MASM, you might be using Visual Studio, which has a debugger built in.
It doesn't matter what debugger you use, but it's an essential tool for developing asm.
I'm a noob in Haskell, but some experience with ActionScript 3.0 Object Orientated. Thus working on a major programming transition. I've read the basic knowledge about Haskel, like arithmetics. And I can write simple functions.
As a practical assignment I have to generate the Thue-Morse sequence called tms1 by computer in Haskell. So it should be like this:
>tms1 0
0
>tms1 1
1
>tms1 2
10
>tms1 3
1001
>tms1 4
10010110
and so on... According to wikipedia I should use the formula.
t0 = 0
t2n = tn
t2n + 1 = 1 − tn
I have no idea how I can implement this formula in Haskell. Can you guide me to create one?
This is what I got so far:
module ThueMorse where
tms1 :: Int -> Int
tms1 0 = 0
tms1 1 = 1
tms1 2 = 10
tms1 3 = 1001
tms1 x = tms1 ((x-1)) --if x = 4 the output will be 1001, i don't know how to make this in a recursion function
I did some research on the internet and found this code.
Source:
http://pastebin.com/Humyf6Kp
Code:
module ThueMorse where
tms1 :: [Int]
tms1 = buildtms1 [0] 1
where buildtms1 x n
|(n `rem` 2 == 0) = buildtms1 (x++[(x !! (n `div` 2))]) (n+1)
|(n `rem` 2 == 1) = buildtms1 (x++[1- (x !! ((n-1) `div` 2))]) (n+1)
custinv [] = []
custinv x = (1-head x):(custinv (tail x))
tms3 :: [Int]
tms3 = buildtms3 [0] 1
where buildtms3 x n = buildtms3 (x++(custinv x)) (n*2)
intToBinary :: Int -> [Bool]
intToBinary n | (n==0) = []
| (n `rem` 2 ==0) = intToBinary (n `div` 2) ++ [False]
| (n `rem` 2 ==1) = intToBinary (n `div` 2) ++ [True]
amountTrue :: [Bool] -> Int
amountTrue [] = 0
amountTrue (x:xs) | (x==True) = 1+amountTrue(xs)
| (x==False) = amountTrue(xs)
tms4 :: [Int]
tms4= buildtms4 0
where buildtms4 n
|(amountTrue (intToBinary n) `rem` 2 ==0) = 0:(buildtms4 (n+1))
|(amountTrue (intToBinary n) `rem` 2 ==1) = 1:(buildtms4 (n+1))
But this code doesn't give the desired result. Any help is well appreciated.
I would suggest using a list of booleans for your code; then you don't need to explicitly convert the numbers. I use the sequence defined like this:
0
01
0110
01101001
0110100110010110
01101001100101101001011001101001
...
Notice that the leading zeros are quite important!
A recursive definition is now easy:
morse = [False] : map step morse where step a = a ++ map not a
This works because we never access an element that is not yet defined. Printing the list is left as an excercise to the reader.
Here is another definition, using the fact that one can get the next step by replacing 1 with 10 and 0 with 01:
morse = [False] : map (concatMap step) morse where step x = [x,not x]
Edit
Here are easier definitions by sdcvvc using the function iterate. iterate f x returns a list of repeated applications of f to x, starting with no application:
iterate f x = [x,f x,f (f x),f (f (f x)),...]
And here are the definitions:
morse = iterate (\a -> a ++ map not a) [False]
morse = iterate (>>= \x -> [x,not x]) [False]
Your definition of the sequence seems to be as a sequence of bit sequences:
0 1 10 1001 10010110 ... etc.
t0 t1 t2 t3 t4
but the wikipedia page defines it as a single bit sequence:
0 1 1 0 1 ... etc
t0 t1 t2 t3 t4
This is the formulation that the definitions in Wikipedia refer to. With this knowledge, the definition of the recurrence relation that you mentioned is easier to understand:
t0 = 0
t2n = tn
t2n + 1 = 1 − tn
In English, this can be stated as:
The zeroth bit is zero.
For an even, non-zero index, the bit is the same as the bit at half the index.
For an odd index, the bit is 1 minus the bit at half the (index minus one).
The tricky part is going from subscripts 2n and 2n+1 to odd and even, and understanding what n means in each case. Once that is done, it is straightforward to write a function that computes the *n*th bit of the sequence:
lookupMorse :: Int -> Int
lookupMorse 0 = 0;
lookupMorse n | even n = lookupMorse (div n 2)
| otherwise = 1 - lookupMorse (div (n-1) 2)
If you want the whole sequence, map lookupMorse over the non-negative integers:
morse :: [Int]
morse = map lookupMorse [0..]
This is the infinite Thue-Morse sequence. To show it, take a few of them, turn them into strings, and concatenate the resulting sequence:
>concatMap show $ take 10 morse
"0110100110"
Finally, if you want to use the "sequence of bit sequences" definition, you need to first drop some bits from the sequence, and then take some. The number to drop is the same as the number to take, except for the zero-index case:
lookupMorseAlternate :: Int -> [Int]
lookupMorseAlternate 0 = take 1 morse
lookupMorseAlternate n = take len $ drop len morse
where
len = 2 ^ (n-1)
This gives rise to the alternative sequence definition:
morseAlternate :: [[Int]]
morseAlternate = map lookupMorseAlternate [0..]
which you can use like this:
>concatMap show $ lookupMorseAlternate 4
"10010110"
>map (concatMap show) $ take 5 morseAlternate
["0", "1", "10", "1001", "10010110"]
Easy like this:
invertList :: [Integer] -> [Integer]
invertList [] = []
invertList (h:t)
|h == 1 = 0:invertList t
|h == 0 = 1:invertList t
|otherwise = error "Wrong Parameters: Should be 0 or 1"
thueMorse :: Integer -> [Integer]
thueMorse 1 = [0]
thueMorse n = thueMorse (n - 1) ++ invertList (thueMorse (n - 1))
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.
You may remember these drawings from when you were a child, but now it's time to let the computer draw them (in full ascii splendour). Have fun!
Description:
The input are multiple lines (terminated by a newline) which describe a 'field'. There are 'numbers' scattered across this field (seperated by whitespace). All lines can be considered to be the same length (you can pad spaces to the end).
the numbers always start at 1
they follow the ordering of the natural numbers: every 'next number' is incremented with 1
every number is surrounded by (at least) one whitespace on its left and right
Task:
Draw lines between these numbers in their natural order
(1 -> 2 -> 3 -> ...N) (assume N <= 99) with the following characteristics:
replace a number with a '+' character
for horizontal lines: use '-'
for vertical lines: use '|'
going left and down or right and up: /
going left and up or right and down: \
Important notes:
When drawing lines of type 4 and 5 you can assume (given the points to connect with coordinates x1, y1 and x2, y2) that distance(x1,x2) == distance(y1,y2). Or in other words (as user jball commented): "consecutive elements that are not horizontally or vertically aligned always align to the slope of the slash or backslash".
It is important to follow the order in which the dots are connected (newer lines can strike out older lines).
-- Sample input 1 --
8
7 6
10 9
5
3 4
11
12 13
1 2
-- Sample output 1 --
+
/|
/ +--+
+--------+ \
/ \
/ +
/ |
/ +--+
+ |
\ |
+------------------------+
+--------------------------+
-- Sample input 2 --
64
63
62 61
1 65
66 57 58
2 56 59 45
67 55 46
3 44
54 60 47
53 52 49 48
4 51 50 43
5 42
41
6 23
22 25 26 40
20 21 24 34
7 13 12 33
19 27 32
14 35
8 15
16
39
17 18 28 31 36
9 38
10 11 29 30 37
-- Sample output 2 -- (unicorn reference)
+
/+
//
//
//
/+--+
+ + \
| + +-\+
+ \ + \ +
/ + + \ +\
+ \ \ | +
| + + +/
| +--+ +-------+/
+ +--+ +
/ \
+ +
| +
+ + /
\ +\ +---+ +
\ +--+ + \ /+
+ +--+ / \ /+|
/ | |+ + /+ |
/ + || / // +
+ + || / // /
\ + || / // /
\ | || / +/ /
\ +---+ + +\ +
+ | | | +|
+--+ +---+ +
Winner:
Shortest solution (by code character count). Input can be read via standard input.
Commodore 64 BASIC - 313 chars
EDIT: See below for the golfed version
A little trip down the memory lane with PET graphics, POKEs and PEEKs and everything :)
The program operates directly in the screen memory, so you just go ahead, clear the screen, place your dots, and type RUN:
You have to wait a minute or so while it finds the dots and then it starts to draw. It isn't fast - you can actually see the lines being drawn, but that's the coolest part :)
Golfed version:
Commodore BASIC seems like a great language for golfing, because it doesn't require whitespace :) You can also shorten most of the commands by entering an unshifted first letter followed by a shifted second letter. For example, POKE can be typed as P[SHIFT+O], which appears as P┌ on the screen:
Perl, 222 char (211)
Perl, 384 365 276 273 253 225 222 218 211 chars (222 when contest ended). Newlines are for "readability" only and are not included in the character count.
Last edit: no longer overwriting $", and printing #S directly
$_=join'',#S=map{$n=s/$/$"x97/e;(/./g)[0..95],$/}<>;
while(/\b$n /){$S[$q=$-[0]]='+';($P,$Q)=sort{$a-$b}$q,$p||$q;
for(qw'\98 |97 /96 -1'){/\D/;$S[$P]=$&until($Q-$P)%$'||$Q<=($P+=$')}
$n++;$p=$q}s/\d/ /,print for#S
Explanation:
$_=join'',#S=map{$n=s/$/$"x97/e;(/./g)[0..95],$/}<>;
This task will be easier if all the lines are the same length (say, 97 characters).
This statement takes each line of input, replaces the end-of-line character with
96 spaces, then pushes the first 96 characters plus a newline into the array #S.
Note we are also setting $n=1, as 1 is the first number we'll look for in
the input.
The join statement creates a single string from the array #S.
It is more convenient to use the scalar variable $_ for pattern matching, and more convenient to use the array #S for making updates to the picture.
while(/\b$n /){
Search for the number $n in the variable $_. Evaluating regular expressions in Perl
has several side-effects. One is to set the special variable $-[0] with the position of the start of the matched pattern within the matched string. This gives us the position of the number $n in the string $_ and also the array #S.
Of course, the loop will end when $n is high enough that we can't find it in the input.
$S[$q=$-[0]]='+';
Let $q be the position of the number $n in the string $_ and the array #S,
and assign the character '+' at that position.
$P=($p||=$q)+$q-($Q=$q>$p?$q:$p)
($P,$Q)=sort{$a-$b}$p||$q,$q;
The first time through the loop, set $p to $q. After the
first time, $p will hold the previous value of $q (which
will refer to the position in the input of the previous number).
Assign $P and $Q such that $P=min($p,$q),
$Q=max($p,$q)
for(qw'\98 |97 /96 -1'){
By construction, consecutive numbers are either
connected by a vertical line. Since the input is constructed
to have 97 characters on each line, this case means that
$p-$q is divisible by 97.
"aligned to the slope of a backslash", which would make
$p-$q divisible by 98
"aligned to the slope of a forward slash", which would make
$p-$q divisible by 96
on the same horizontal line
The elements of this list encode the possible number of positions
between line segments, and the character to encode that segment.
/\D/;
Another trivial regex evaluation. As a side-effect, it sets the
special variable $& (the MATCH variable) to the line segment
character (\ | / or -) and $' (the POSTMATCH variable) to
the number (98 97 96 or 1) encoded in the list element.
$S[$P]=$&until($Q-$P)%$'||$Q<=($P+=$')
This statement draws the line segment between two numbers.
If $Q-$P is divisible by $', then keep incrementing $P by $'
and assigning the character $& to $S[$P] until $P reaches $Q.
More concretely, for example if $Q-$P is divisible by 97, then
increment $P by 97 and set $S[$P]='|'. Repeat until $P>=$Q.
$n++;$p=$q
Prepare for the next iteration of the loop. Increment $n to the
next number to search for in the input, and let $p hold the
position of the previous number.
s/\d/ /,print for#S
Output the array, converting any leftover digits (from double
digit identifiers in the input where we only overwrote the first
digit with a '+') to spaces as we go.
MS-DOS Batch (yes, you read right!)
I often hear (or read) people say batch isn't very powerful and you can't do much with them, well to them I say, behold, the power of BATCH!
The actual script (script.bat):
set file=%~1
call :FindNextNum 1
for /F "tokens=2 delims=:" %%i IN ('find /c /V "" "%file%"') DO set /a totalLines=%%i
set maxLen=0
for /F "delims=" %%i IN (%file%) DO (
call :CountChars "%%i"
if /i !charCount! gtr !maxLen! set maxLen=!charCount!
)
for /L %%i IN (0,1,%totalLines%) DO set "final_%%i=" & for /L %%j IN (0,1,%maxLen%) DO set "final_%%i=!final_%%i! "
:MainLoop
set currLineNum=%lineNum%
set currCol=%linePos%
set currNum=%nextNum%
set /a targetNum=%currNum%+1
call :FindNextNum %targetNum%
if "%nextNum%"=="" goto MainEnd
REM echo %currNum% -^> %nextNum%
if /I %currLineNum% lss %lineNum% (
call :DrawLine %currCol% %currLineNum% %linePos% %lineNum%
) else (
call :DrawLine %linePos% %lineNum% %currCol% %currLineNum%
)
goto MainLoop
:MainEnd
for /L %%i IN (0,1,%totalLines%) DO echo.!final_%%i!
goto:eof
:DrawLine
if /I %2 equ %4 goto:DrawHoriz
set "char=" & set "pos=%1" & set "inc=0"
if /I %1 LSS %3 set "char=\" & set "pos=%1" & set "inc=1"
if /I %1 GTR %3 set "char=/" & set "pos=%1" & set "inc=-1"
for /L %%i IN (%2,1,%4) DO call :DrawChar %%i !pos! %char% & set /a "pos+=%inc%"
goto:DrawEnds
:DrawHoriz
set "start=%1+1" & set "end=%3"
if /I %start% gtr %end% set "start=%3+1" & set "end=%1"
set /a lineEnd=%end%+1
set lineEnd=!final_%2:~%lineEnd%!
for /L %%i IN (%start%,1,%end%) DO set final_%2=!final_%2:~0,%%i!-
set final_%2=!final_%2!!lineEnd!
:DrawEnds
call :DrawChar %2 %1 +
call :DrawChar %4 %3 +
goto:eof
:DrawChar
set /a skip2=%2+1
if "%3"=="" (
set final_%1=!final_%1:~0,%2!^|!final_%1:~%skip2%!
) else (
set final_%1=!final_%1:~0,%2!%3!final_%1:~%skip2%!
)
goto:eof
:CountChars
set charCount=0
set val=%~1
:CountChars_loop
if not "%val:~1%"=="" (
set /a charCount+=1
set val=!val:~1!
goto CountChars_loop
)
goto:eof
:FindNextNum
for /F "delims=" %%i IN ('type "%file%" ^| find /V /N ""') DO (
for /F "tokens=1,2 delims=[]" %%j IN ("%%i") DO (
set /a lineNum=%%j-1
call :FindNext_internal "%%k" %1
if /I !nextNum! equ %1 goto :eof
)
)
goto:eof
:FindNext_internal
set currLine=%~1
set linePos=0
:FindNext_internal_loop
call :NextNumInLine "%currLine%"
set /a linePos+=%spaceInterval%
if "%nextNum%"=="" goto :EOF
if /I %nextNum% equ %2 goto :EOF
set /a spaceInterval+=1
set /a linePos+=1
if /I %nextNum% GTR 9 set /a "spaceInterval+=1" & set /a linePos+=1
set currLine=!currLine:~%spaceInterval%!
goto FindNext_internal_loop
:NextNumInLine
set nextNum=
for /F %%i IN (%1) DO set /a nextNum=%%i
if "%nextNum%"=="" goto :eof
set /a spaceInterval=0
set val=%~1
:NextNumInLine_loop
if "%val:~0,1%"==" " (
set /a spaceInterval+=1
set val=!val:~1!
goto NextNumInLine_loop
)
goto :eof
And this is how you call it
echo off
setlocal ENABLEDELAYEDEXPANSION
call script.bat input.txt
where "input.txt" is a file that contains the input for the "program".
P.S. This isn't actually optimized for line length yet, I've already spent a couple of hours getting to this point and now I need to sleep... I'll see if I can improve it tomorrow (currently 'script.bat' sits at 2755 bytes)
Rebmu: 218 chars
Ma L{-|\/}Qb|[sg?SBaB]Da|[feSm[TfiSrj[spAsp]iT[++Tbr]]t]Xa|[i?A]Ya|[i?FImHDa]Ca|[skPCmSCaBKfsA]wh[Jd++N][roG[xJyJ]]Bf+GwhB[JcB Ff+GiF[KcF HqXkXj VqYkYju[chCbPClEZv1[ezH2[eeHv3 4]]e?A+bRE[hV]f]]chJeFIlSCj{+}{+ }Jk Bf]wM
I'm getting pretty good at reading and editing it natively in its pig-latin form. (Though I do use line breaks!!) :)
But here's how the dialect is transformed by the interpreter when the case-insensitive "mushing" trick is boiled away, and one gets accustomed to it. I'll add some comments. (Tips: fi is find, fe is foreach, sp is a space character, i? is index, hd is head, ch is change, sk is skip, pc is pick, bk is break, i is if, e is either, ee is either equal, ad nauseum)
; copy program argument into variable (m)atrix
m: a
; string containing the (l)etters used for walls
l: {-|\/}
; q is a "b|function" (function that takes two parameters, a and b)
; it gives you the sign of subtracting b from a (+1, -1, or 0)
q: b| [sg? sb a b]
; d finds you the iterator position of the first digit of a two digit
; number in the matrix
d: a| [fe s m [t: fi s rj [sp a sp] i t [++ t br]] t]
; given an iterator position, this tells you the x coordinate of the cell
x: a| [i? a]
; given an iterator position, this tells you the y coordinate of the cell
y: a| [i? fi m hd a]
; pass in a coordinate pair to c and it will give you the iterator position
; of that cell
c: a| [sk pc m sc a bk fr a]
; n defaults to 1 in Rebmu. we loop through all the numbers up front and
; gather their coordinate pairs into a list called g
wh [j: d ++ n] [ro g [x j y j]]
; b is the (b)eginning coordinate pair for our stroke. f+ returns the
; element at G's current position and advances G (f+ = "first+")
; advance g's iteration position
b: f+ g
wh b [
; j is the iterator position of the beginning stroke
j: c b
; f is the (f)inishing coordinate pair for our stroke
f: f+ g
; if there is a finishing pair, we need to draw a line
i f [
; k is the iterator position of the end of the stroke
k: c f
; the (h)orizontal and (v)ertical offsets we'll step by (-1,0,1)
h: q x k x j
v: q y k y j
u [
; change the character at iterator location for b (now our
; current location) based on an index into the letters list
; that we figure out based on whether v is zero, h is zero,
; v equals h, or v doesn't equal h.
ch c b pc l ez v 1 [ez h 2 [ee h v 3 4]]
; if we update the coordinate pair by the offset and it
; equals finish, then we're done with the stroke
e? a+ b re [h v] f
]
]
; whether we overwrite the number with a + or a plus and space
; depends on whether we detect one of our wall "letters" already
; one step to the right of the iterator position
ch j e fi l sc j {+} {+ }
; update from finish pair to be new begin pair for next loop iteration
j: k
b: f
]
; write out m
w m
Both the language and sample are new and in an experimental stage. For instance, ad couldn't be used to add together vectors and matrices before I changed it to help with this sample. But I think that's just the sort of thing that a language designed specifically for code golf has to have anyway. It's a subtle line between "language" and "library".
Latest source with comments available on GitHub
Haskell, 424 chars
Current char count: 424 430 451 466 511 515 516 518 525 532 541 545 550 556 569 571 577 582 586 592.
import List
x%c=[(i,c)|i<-x]
l k p q|p>q=l k q p|True=head[[p,p+j..q]%c|m<-zip[k-1,k,k+1,1]"/|\\-",let (j,c)=m,mod(q-p)j==0]
w=map snd
q(k,m,x)z=w$sort$nubBy((==)&fst)$x%'+'++(concat$zipWith(l k)x$tail x)++z%'\n'++[1..m]%' '
r(z,m,x)=q(last z,m-1,w$sort x)z
u[(m,_)]n x=(-m::Int,n):x;u _ _ x=x
t(z,n,x)s|s=="\n"=(n:z,n+1,x)|True=(z,n+length s,u(reads s)n x)
y&x=(.x).y.x
main=interact$r.foldl t([],1,[]).groupBy((&&)&(>' '))
This version takes a lot of inspiration from the original Haskell entry below, but makes some significant changes. Most importantly, it represents image locations with a single index, not a pair of coordinates.
There are some changes:
The input must now have all lines padded to the same length (allowed by the rules.)
No longer needs either language extension
Original version:
(Needs -XTupleSections, and maybe -XNoMonomorphismRestriction)
import List
b=length
f=map
g=reverse
a(x,y)" "=(x,y+1)
a(x,y)z=([y,read z]:x,y+b z)
x%y=[min x y+1..max x y-1]
j([x,y],[w,z])|y==z=f(,'-')$f(y,)$x%w|x==w=f(,'|')$f(,x)$y%z|(y<z)==(x<w)=f(,'\\')$zip(y%z)$x%w|True=f(,'/')$zip(y%z)$g$x%w
k 0='\n'
k _=' '
y&x=(.x).y.x
y?x=f y.sort.x.concat
r z=snd?(nubBy((==)&fst).g)$[((y,x),k x)|x<-[0..maximum$f b d],y<-[1..b d]]:[((y,x),'+')|[x,y]<-e]:(f j$zip e$tail e)where d=f(groupBy$(&&)&(>' '))$lines z;e=tail?f g$zipWith(f.(:))[1..]$f(fst.foldl a([],1))d
main=interact r
Explanation:
(1) d=...: Splits the input into spaces and numbers, e.g.
z = " 6 5\n\n1 2\n\n 4 3\n\n 7"
=> d = [[" ","6"," "," ","5"],[],["1"," "," "," "," "," "," "," ","2"],[],[" "," "," "," ","4"," "," "," ","3"],[],[" ","7"]]
(2) e=...: Converts d into a list of (y, x) coordinates for each number.
e = [[1,3],[9,3],[9,5],[5,5],[5,1],[2,1],[2,7]]
--- // 1 2 3 4 5 6 7
(3)
[((y,x),k x)|...] is an empty board. (k returns a space or a \n depending on the x-coordinate.)
[((y,x),'+'))|...] are the plus signs at the numbers.
(f j$zip e$tail e) are the lines connecting the numbers. (j maps a pair of coordinates into a list of (coordinate, character) which represents a line.)
These 3 components are concatenated and filtered to form the actual output. Note that the order is important, so that nubBy(...).g can only keep the last character in the same location.
AWK - 296 317 321 324 334 340
Not a prize winner (yet), but I am pleased with the effort (line breaks for display). This new version uses VT-100 escape sequences. The '^[' is just one character, Escape!!! Cut and paste will not work with this version, since the sequence "^[" has to be replaced with the real ESC character. To make it forum friendly, ESC could be specified as "\0x1b", but it takes too much space...
BEGIN{FS="[ ]"}{for(j=i=0;i<NF;j+=length(g)){if(g=$++i){x[g]=k=i+j;y[g]=NR;
m=m>k?m:k}}}END{printf"^[[2J[%d;%dH+",Y=y[i=1],X=x[1];while(a=x[++i])
{a-=X;b=y[i]-Y;t=a?b?a*b>0?92:47:45:124;A=a?a>0?1:-1:0;B=b?b>0?1:-1:0;
for(r=a?a*A:b*B;--r;){printf"^[[%d;%dH%c",Y+=B,X+=A,t}
printf"^[[%d;%dH+",Y+=B,X+=A}}
The older standard version
BEGIN{FS="[ ]"}{for(j=i=0;i<NF;j+=length(g)){if(g=$++i){x[g]=k=i+j;y[g]=NR;
m=m>k?m:k}}}END{q[X=x[1],Y=y[i=1]]=43;while(a=x[++i]){a-=X;b=y[i]-Y;
t=a?b?a*b>0?92:47:45:124;A=a?a>0?1:-1:0;B=b?b>0?1:-1:0;for(r=a?a*A:b*B;--r;
q[X+=A,Y+=B]=t);q[X+=A,Y+=B]=43}for(j=0;++j<NR;){for(i=0;i<m;){t=q[i++,j];
printf"%c",t?t:32}print}}
Now a little explanation
# This will break the input in fields separated by exactly 1 space,
# i.e. the fields will be null or a number.
BEGIN{FS="[ ]"}
# For each line we loop over all fields, if the field is not null
# it is a number, hence store it.
# Also account for the fact the numbers use space.
# Also, find the maximum width of the line.
{
for(j=i=0;i<NF;j+=length(g)){
if(g=$++i){
k=j+i;x[g]=k;y[g]=NR;m=m>k?m:k
}
}
}
# Once we have all the data, let start cooking.
END{
# First, create a matrix with the drawing.
# first point is a +
q[X=x[1],Y=y[i=1]]=43;
# loop over all points
while(a=x[++i]){
# Check next point and select character
# If a == 0 -> -
# If b == 0 -> |
# If a and b have same sign -> \ else /
a-=X;b=y[i]-Y;t=a?b?a*b>0?92:47:45:124;
# there is no sgn() function
A=a?a>0?1:-1:0;B=b?b>0?1:-1:0;
# Draw the line between the points
for(k=0;++k<(a?a*A:b*B);){
q[X+=A,Y+=B]=t
}
# store + and move to next point
q[X+=A,Y+=B]=43
}
# Now output all lines. If value in point x,y is 0, emit space
for(j=0;++j<NR;){
for(i=0;i<m;){
t=q[i++,j];printf("%c",t?t:32)
}
print
}
}
C, 386
402 386 character in C. Newlines after the first are only for readability.
#include <stdio.h>
int x[101],y[101],c=1,r,w,h,b,i,j,k,m,n;
int main(){
while((b=getchar())-EOF)
b-' '?b-'\n'?ungetc(b,stdin),scanf("%d",&b),x[b]=c++,y[b]=h,c+=b>9:(w=c>w?c:w,++h,c=1):++c;
for(r=0;r<h&&putchar('\n');++r)
for(c=0;c<w;++c){
for(b=' ',i=2,m=x[1]-c,n=y[1]-r;j=m,k=n,m=x[i]-c,n=y[i]-r,x[i++];)
b=j|k&&m|n?j*m>0|k|n?k*n<0?(j-k|m-n?j+k|m+n?j|m?b:'|':'/':'\\'):b:'-':'+';
putchar(b);
}
}
Intel Assembler
Assembled size: 506 bytes
Source: 2252 bytes (hey, it's not a trivial problem this one)
To Assemble: Use A86
To Run: Tested with a WinXP DOS box. Invocation jtd.com < input > output
mov ax,3
int 10h
mov ax,0b800h
mov es,ax
mov ah,0bh
int 21h
mov bx,255
cmp al,bl
mov dh,bh
mov si,offset a12
push offset a24
je a1
mov si,offset a14
a1: inc bl
a2: mov dl,255
call si
cmp al,10
jb a4
a3: cmp al,10-48
jne a1
inc bh
mov bl,dh
jmp a2
a4: mov dl,al
call si
cmp al,10
jae a5
mov ah,dl
aad
mov dl,al
a5: mov di,dx
mov ch,al
shl di,2
mov [di+a32],bx
cmp bl,[offset a30]
jb a6
mov [offset a30],bl
a6: cmp bh,[offset a31]
jb a7
mov [offset a31],bh
a7: push offset a19
mov al,80
mul bh
add al,bl
adc ah,0
add ax,ax
lea di,[di+2+a32]
mov [di],ax
add di,2
cmp di,[a22-3]
jbe a8
mov [a22-3],di
mov [a25-3],di
a8: mov di,ax
mov al,dl
aam
cmp ah,0
je a10
a9: add ah,48
mov es:[di],ah
add di,2
a10:add al,48
mov es:[di],al
mov al,ch
inc bl
jmp a3
a11:jmp si
a12:mov ah,0bh
int 21h
cmp al,255
jne a15
mov ah,8
int 21h
a13:cmp al,13
je a11
sub al,48
ret
a14:mov ah,1
int 21h
cmp al,26
jne a13
mov si,offset a15
ret
a15:cmp dl,255
je a16
mov al,32
ret
a16:mov si,offset a32 + 4
lodsw
mov cx,ax
mov dx,ax
lodsw
mov di,ax
mov b es:[di],1
mov bp,0f000h
call a26
add sp,6
mov bx,[a22-3]
mov ax,[offset a31]
inc ax
a17:mov bp,[offset a30]
a18:mov b[bx],32
inc bx
dec bp
jnz a18
mov w[bx],0a0dh
add bx,2
dec ax
jnz a17
mov b[bx],'$'
add w[a30],2
a19:lodsw
xchg ax,dx
cmp ah,dh
lahf
mov bl,ah
cmp al,dl
lahf
shr bl,6
shr ah,4
and ah,12
or bl,ah
mov bh,0
shl bx,3
a20:mov b es:[di],43
a21:mov al,b[a30]
mul ch
add al,cl
adc ah,0
mov bp,ax
mov b[bp+100h],43
a22:add di,[bx + a29]
add cl,[bx + a29 + 4]
add ch,[bx + a29 + 6]
mov b es:[di],1
mov al,[bx + a29 + 2]
mov [a21-1],al
mov [a22-1],al
mov bp,01000h
call a26
cmp di,[si]
jne a20
mov al,es:[di+2]
sub al,48
cmp al,10
jae a23
mov b es:[di+2],0
a23:mov b[a21-1],43
mov b[a22-1],43
mov b es:[di],43
lodsw
ret
a24:mov al,b[a30]
mul ch
add al,cl
adc ah,0
mov bp,ax
mov b[bp+100h],43
a25:mov dx,[a22-3]
mov ah,9
int 21h
ret
a26:pusha
a27:mov cx,0ffffh
a28:loop a28
dec bp
jnz a27
popa
ret
a29:dw -162,92,-1,-1,-2,45,-1,0,158,47,-1,1,0,0,0,0,-160,124,0,-1
a30:dw 0
a31:dw 0,0,0,160,124,0,1,0,0,0,0,-158,47,1,-1,2,45,1,0,162,92,1,1
a32:
Interesting features: self modifying code, animated output (the second example works, but is too big to display), abuse of 'ret' to implement a loop counter, interesting way of determining line/movement direction.
F#, 725 chars
open System
let mutable h,s,l=0,Set.empty,Console.ReadLine()
while l<>null do
l.Split([|' '|],StringSplitOptions.RemoveEmptyEntries)
|>Seq.iter(fun t->s<-s.Add(int t,h,(" "+l+" ").IndexOf(" "+t+" ")))
h<-h+1;l<-Console.ReadLine()
let w=Seq.map(fun(k,h,x)->x)s|>Seq.max
let o=Array2D.create h (w+1)' '
Seq.sort s|>Seq.pairwise|>Seq.iter(fun((_,b,a),(_,y,x))->
let a,b,x,y=if b>y then x,y,a,b else a,b,x,y
o.[b,a]<-'+'
o.[y,x]<-'+'
if b=y then for x in(min a x)+1..(max a x)-1 do o.[y,x]<-'-'
elif a=x then for h in b+1..y-1 do o.[h,x]<-'|'
elif a<x then for i in 1..y-b-1 do o.[b+i,a+i]<-'\\'
else for i in 1..y-b-1 do o.[b+i,a-i]<-'/')
for h in 0..h-1 do
for x in 0..w do printf"%c"o.[h,x]
printfn""
Legend:
h = height
s = set
l = curLine
w = (one less than) width
o = output array of chars
Lines 1-6: I keep a set of (number, lineNum, xCoord) tuples; as I read in each line of input I find all the numbers and add them to the set.
Line 7-8: Then I create an array of output chars, initialized to all spaces.
Line 9: Sort the set (by 'number'), then take each adjacent pair and ...
Lines 10-16: ... sort so (a,b) is the 'highest' of the two points and (x,y) is the other. Put the '+' signs, and then if horizontal, draw that, else if vertical, draw that, else draw the correct diagonal. If the input is not 'valid', then who knows what happens (this code was littered with 'asserts' before I golf-ized it).
Lines 17-19: Print the result
Powershell, 328 304 characters
$i=$l=0;$k=#{}
$s=#($input|%{[regex]::matches($_,"\d+")|%{$k[1*$_.Value]=#{y=$l
x=$_.Index}};$l++;""})
while($a=$k[++$i]){
if($i-eq1){$x=$a.x;$y=$a.y}
do{$d=$a.x.CompareTo($x);$e=$a.y.CompareTo($y)
$s[$y]=$s[($y+=$e)].PadRight($x+1).Remove($x,1).Insert(($x+=$d),
"\-/|+|/-\"[4+$d*3+$e])}while($d-or$e)}$s
and here's a pretty-printed version with comments:
# Usage: gc testfile.txt | dots.ps1
$l=$i=0 # line, dot index (used below)
$k=#{} # hashtable that maps dot index to coordinates
# Apply regular expression to each line of the input
$s=#( $input | foreach{
[regex]::matches($_,"\d+") | foreach{
# Store each match in the hashtable
$k[ 1*$_.Value ] = #{ y = $l; x = $_.Index }
}
$l++; # Next line
"" # For each line return an empty string.
# The strings are added to the array $s which
# is used to produce the final output
}
)
# Connect the dots!
while( $a = $k[ ++$i ] )
{
if( $i -eq 1 ) # First dot?
{
# Current position is ($x, $y)
$x = $a.x;
$y = $a.y
}
do
{
$d = $a.x.CompareTo( $x ) # sign( $a.x - $x )
$e = $a.y.CompareTo( $y ) # sign( $a.y - $y )
$c = '\-/|+|/-\'[ 4 + $d * 3 + $e ] # character '
# Move
$x += $d
$y += $e
# "Replace" the charcter at the current position
# PadRight() ensures the string is long enough
$s[ $y ]=$s[ $y ].PadRight( $x+1 ).Remove( $x, 1 ).Insert( $x, $c )
} while( $d -or $e ) # Until the next dot is reached
}
# Print the resulting string array
$s
Python - 381
import re
b=list(iter(raw_input,''))
c=sum((zip([i]*999,re.finditer('\\d+',x))for i,x in enumerate(b)),[])
d=sorted((int(m.group()),i,m.start())for i,m in c)
e=[[' ']*max(map(len,b))for x in b]
for(t,u,v),(x,y,z)in zip(d,d[1:]+d[-1:]):
e[u][v]='+'
while u!=y or v!=z:i,j=(u<y)-(u>y),(v<z)-(v>z);u+=i;v+=j;e[u][v]=['|','/\\-'[(i==j)+2*(i==0)]][j!=0]
print'\n'.join(map(''.join,e))
C#, 422 chars
758 754 641 627 584 546 532 486 457 454 443 440 422 chars (next time maybe I won't submit so soon.)
using A=System.Console;class B{static int C,o,d,e,G,O=1,f,F,u,n;static
void Main(){var s=A.In.ReadToEnd();A.Clear();while(++u<s.Length){f++;if
(s[u]<32){u++;F++;f= 0;}if(s[u]>32){if(int.Parse(s[u]+""+s[++u])==O){o=
e>f?1:f>e?-1:0;C=d>F?1:F>d?-1:0 ;G=e+o;n=d+C;if(O++>1)while(n!=F||G!=f)
{A.SetCursorPosition(G-=o,n-=C);A.Write( "+/-|\\"[n==d&&G==e?0:n==F&&G
==f?0:C+o==0?1:C==0?2:o==0?3:4]);}e=f;d=F;F=0;f=u=-1 ;}f++;}}A.Read();}}
Usage: run, paste (or type) the input, ensure the last line is terminated, press CTRL-Z or F6, press Enter.
Formatted but still basically unintelligable version:
using A = System.Console;
class B
{
// code golf fun!
static int C, o, d, e, G, O = 1, f, F, u, n;
static void Main()
{
// read the input into a string char by char until EOF
var s = A.In.ReadToEnd();
A.Clear(); // clear console, ready to draw picture
// O is the "dot" number we're looking for
// f is current column
// F is current row
// loop over the field looking for numbers sequentially
// until no more are found
while (++u < s.Length)
{
f++;
// any char <32 is expected to be a CR/LF
// increment the current row and reset the current column
if (s[u] < 32)
{
u++; // skip the other half of the CR/LF pair
F++; // next row
f = 0; // column reset
}
// any char >32 is expected to be a number
if (s[u] > 32)
{
// parse the current + next char and see if it's
// the number we want
if (int.Parse(s[u] + "" + s[++u]) == O)
{
// set up coordinates, compare X1 with X2
// and Y1 with Y2 to figure out line direction
// horizontal direction (same as o=e.CompareTo(f))
o = e > f ? 1 : f > e ? - 1 : 0;
// vertical direction (same as C=d.CompareTo(F))
C = d > F ? 1 : F > d ? - 1 : 0;
// initial offsets compensate for off-by-one
G = e + o;
n = d + C;
// draw the line (except for the very first dot)
if (O++ > 1)
while (n != F || G != f)
{
// update coords and write desired char
A.SetCursorPosition(G -= o, n -= C);
// this lovely line decides which char to
// print, and prints it
A.Write(
"+/-|\\"[n == d && G == e ? 0 : n == F && G
== f ? 0 : C + o == 0 ? 1 : C == 0 ? 2 : o
== 0 ? 3 : 4]);
}
// remember end point of this line, to use as start point
// of next line
e = f;
d = F;
// reset current row (F), column (f), field position (u)
F = 0;
f = u = -1;
}
// bump current column because we parse 2 chars when we
// find a dot
f++;
}
}
A.Read(); // prevent command prompt from overwriting picture
}
}
Here goes!
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
int sign(int x) {
if (x < 0)
return -1;
if (x > 0)
return +1;
return 0;
}
#define MAX_ROWS 100
#define MAX_COLS 100
#define MAX_DIGITS 100
int main(void)
{
// Read in the digits
int number[MAX_DIGITS][2];
int rows = 0;
int cols = 0;
char row[MAX_COLS];
int maxvalue = 0;
int i, j, value, x;
for (i = 0; i < MAX_ROWS; i++) {
if (row != fgets(row, MAX_COLS, stdin))
break;
value = 0;
for (j=0; row[j] != 0; j++) {
if (row[j] >= '0' && row[j] <= '9') {
x = j;
value = 0;
do {
value = 10*value + (row[j]-'0');
j++;
} while (row[j] >= '0' && row[j] <= '9');
number[value][0] = i;
number[value][1] = x;
if (maxvalue < value) maxvalue = value;
if (rows < i+1) rows = i+1;
if (cols < x+1) cols = x+1;
}
}
}
// Create an empty field
char field[rows][cols];
memset(field, ' ', rows*cols);
char lines[] = "\\|/-+-/|\\";
int dr,dc;
// Draw the numbers and lines
field[number[1][0]][number[1][1]] = '+';
for (i = 2; i <= maxvalue; ++i) {
int r = number[i-1][0];
int c = number[i-1][1];
int rt = number[i][0];
int ct = number[i][1];
dr = sign(rt-r);
dc = sign(ct-c);
char line = lines[(dr+1)*3+dc+1];
while (r != rt || c != ct) {
r += dr;
c += dc;
field[r][c] = line;
}
field[r][c] = '+';
}
for (i = 0; i < rows; ++i) {
for (j = 0; j < cols; ++j)
putchar(field[i][j]);
putchar('\n');
}
return 0;
}
C#, 638 chars
using System;
using System.Linq;
using System.Text.RegularExpressions;
class C
{
static void Main()
{
int i=0,j;
var p = Console.In.ReadToEnd()
.Split('\n')
.SelectMany(
r =>
{
i++; j =0;
return Regex.Matches(r, "\\s+(\\d+)").Cast<Match>()
.Select(m => { j += m.Length; return new { X = j, Y = i-1, N = int.Parse(m.Groups[1].Value) }; });
}
).OrderBy(a=>a.N).ToList();
var W = p.Max(a => a.X)+1;
var k = new char[W*i+W];
i = 0;
while (i < p.Count)
{
var b = p[i > 0 ? i - 1 : 0]; var a = p[i];
int h = a.Y - b.Y, w = a.X - b.X;
var s = "|-/\\"[h == 0 ? 1 : w == 0 ? 0 : h / w > 0 ? 3 : 2];
while ((h | w) != 0) { k[b.X + w + W * (b.Y + h)] = s; h -= h.CompareTo(0); w -= w.CompareTo(0); }
k[a.X + a.Y * W] = '+';
k[W * ++i] = '\n';
}
Console.Write(k);
}
}
I cannot do multi-line in a comment, so I will demonstrate here.
In the following examples, distance(x1,x2) == distance(y1,y2):
+
|\
+-+
+
|\
| \
+--+
+
|\
| \
| \
+---+
With the rules as explained, distance(x1,x2) == distance(y1,y2)+2:
+\
| \
+--\+
+\
| \
| \
+---\+
+\
| \
| \
| \
+----\+
C++ 637
#include <iostream>
#include <string>
#include <vector>
#define S(x)((x)<0?-1:x>0?1:0)
using namespace std;enum{R=100,C=100,D=100};int main(){string s;
int N[D][2],M=0,q=0,p=0,i,j,V,L,a,b;for(i=0;j=0,(i<R)&&getline(cin,s);i++)
while((j=s.find_first_not_of(" ",j))<=s.size()){L=sscanf(&s[j],"%d",&V);
N[V][0]=i;N[V][1]=j;if(M<V)M=V;if(q<=i)q=i+1;if(p<=j)p=j+1;j+=L+1;}
string F(q*p,' '),l="\\|/-+-/|\\";F[p*N[1][0]+N[1][1]]='+';for(i=2;i<=M;++i){
int r=N[i-1][0],c=N[i-1][1],d=N[i][0],e=N[i][1];for(a=S(d-r),b=S(e-c);r!=d||c!=e;)
r+=a,c+=b,F[p*r+c]=l[(a+1)*3+b+1];F[p*r+c]='+';}for(i=0;i<q;i++)
cout<<string(&F[i*p],p)+"\n";}
Indented, and with a few slightly more meaningful names, that looks like:
#include <iostream>
#include <string>
#include <vector>
#define S(x)((x)<0?-1:x>0?1:0)
using namespace std;
enum{R=100,C=100,D=100};
int main(){
string s;
int N[D][2],M=0,rs=0,cs=0,i,j,V,L,dr,dc;
for(i=0;j=0,(i<R)&&getline(cin,s);i++)
while((j=s.find_first_not_of(" ",j))<=s.size()){
L=sscanf(&s[j],"%d",&V);
N[V][0]=i;
N[V][1]=j;
if(M<V)M=V;
if(rs<=i)rs=i+1;
if(cs<=j)cs=j+1;
j+=L+1;
}
string F(rs*cs,' '),lines="\\|/-+-/|\\";
F[cs*N[1][0]+N[1][1]]='+';
for(i=2;i<=M;++i){
int r=N[i-1][0],c=N[i-1][1],rt=N[i][0],ct=N[i][1];
for(dr=S(rt-r),dc=S(ct-c);r!=rt||c!=ct;)
r+=dr,c+=dc,F[cs*r+c]=lines[(dr+1)*3+dc+1];
F[cs*r+c]='+';
}
for(i=0;i<rs;i++)
cout<<string(&F[i*cs],cs)+"\n";
}
Despite superficial differences, it's a blatant theft of morotspaj's code.
If I have a integer number n, how can I find the next number k > n such that k = 2^i, with some i element of N by bitwise shifting or logic.
Example: If I have n = 123, how can I find k = 128, which is a power of two, and not 124 which is only divisible by two. This should be simple, but it eludes me.
For 32-bit integers, this is a simple and straightforward route:
unsigned int n;
n--;
n |= n >> 1; // Divide by 2^k for consecutive doublings of k up to 32,
n |= n >> 2; // and then or the results.
n |= n >> 4;
n |= n >> 8;
n |= n >> 16;
n++; // The result is a number of 1 bits equal to the number
// of bits in the original number, plus 1. That's the
// next highest power of 2.
Here's a more concrete example. Let's take the number 221, which is 11011101 in binary:
n--; // 1101 1101 --> 1101 1100
n |= n >> 1; // 1101 1100 | 0110 1110 = 1111 1110
n |= n >> 2; // 1111 1110 | 0011 1111 = 1111 1111
n |= n >> 4; // ...
n |= n >> 8;
n |= n >> 16; // 1111 1111 | 1111 1111 = 1111 1111
n++; // 1111 1111 --> 1 0000 0000
There's one bit in the ninth position, which represents 2^8, or 256, which is indeed the next largest power of 2. Each of the shifts overlaps all of the existing 1 bits in the number with some of the previously untouched zeroes, eventually producing a number of 1 bits equal to the number of bits in the original number. Adding one to that value produces a new power of 2.
Another example; we'll use 131, which is 10000011 in binary:
n--; // 1000 0011 --> 1000 0010
n |= n >> 1; // 1000 0010 | 0100 0001 = 1100 0011
n |= n >> 2; // 1100 0011 | 0011 0000 = 1111 0011
n |= n >> 4; // 1111 0011 | 0000 1111 = 1111 1111
n |= n >> 8; // ... (At this point all bits are 1, so further bitwise-or
n |= n >> 16; // operations produce no effect.)
n++; // 1111 1111 --> 1 0000 0000
And indeed, 256 is the next highest power of 2 from 131.
If the number of bits used to represent the integer is itself a power of 2, you can continue to extend this technique efficiently and indefinitely (for example, add a n >> 32 line for 64-bit integers).
There is actually a assembly solution for this (since the 80386 instruction set).
You can use the BSR (Bit Scan Reverse) instruction to scan for the most significant bit in your integer.
bsr scans the bits, starting at the
most significant bit, in the
doubleword operand or the second word.
If the bits are all zero, ZF is
cleared. Otherwise, ZF is set and the
bit index of the first set bit found,
while scanning in the reverse
direction, is loaded into the
destination register
(Extracted from: http://dlc.sun.com/pdf/802-1948/802-1948.pdf)
And than inc the result with 1.
so:
bsr ecx, eax //eax = number
jz #zero
mov eax, 2 // result set the second bit (instead of a inc ecx)
shl eax, ecx // and move it ecx times to the left
ret // result is in eax
#zero:
xor eax, eax
ret
In newer CPU's you can use the much faster lzcnt instruction (aka rep bsr). lzcnt does its job in a single cycle.
A more mathematical way, without loops:
public static int ByLogs(int n)
{
double y = Math.Floor(Math.Log(n, 2));
return (int)Math.Pow(2, y + 1);
}
Here's a logic answer:
function getK(int n)
{
int k = 1;
while (k < n)
k *= 2;
return k;
}
Here's John Feminella's answer implemented as a loop so it can handle Python's long integers:
def next_power_of_2(n):
"""
Return next power of 2 greater than or equal to n
"""
n -= 1 # greater than OR EQUAL TO n
shift = 1
while (n+1) & n: # n+1 is not a power of 2 yet
n |= n >> shift
shift <<= 1
return n + 1
It also returns faster if n is already a power of 2.
For Python >2.7, this is simpler and faster for most N:
def next_power_of_2(n):
"""
Return next power of 2 greater than or equal to n
"""
return 2**(n-1).bit_length()
This answer is based on constexpr to prevent any computing at runtime when the function parameter is passed as const
Greater than / Greater than or equal to
The following snippets are for the next number k > n such that k = 2^i
(n=123 => k=128, n=128 => k=256) as specified by OP.
If you want the smallest power of 2 greater than OR equal to n then just replace __builtin_clzll(n) by __builtin_clzll(n-1) in the following snippets.
C++11 using GCC or Clang (64 bits)
#include <cstdint> // uint64_t
constexpr uint64_t nextPowerOfTwo64 (uint64_t n)
{
return 1ULL << (sizeof(uint64_t) * 8 - __builtin_clzll(n));
}
Enhancement using CHAR_BIT as proposed by martinec
#include <cstdint>
constexpr uint64_t nextPowerOfTwo64 (uint64_t n)
{
return 1ULL << (sizeof(uint64_t) * CHAR_BIT - __builtin_clzll(n));
}
C++17 using GCC or Clang (from 8 to 128 bits)
#include <cstdint>
template <typename T>
constexpr T nextPowerOfTwo64 (T n)
{
T clz = 0;
if constexpr (sizeof(T) <= 32)
clz = __builtin_clzl(n); // unsigned long
else if (sizeof(T) <= 64)
clz = __builtin_clzll(n); // unsigned long long
else { // See https://stackoverflow.com/a/40528716
uint64_t hi = n >> 64;
uint64_t lo = (hi == 0) ? n : -1ULL;
clz = _lzcnt_u64(hi) + _lzcnt_u64(lo);
}
return T{1} << (CHAR_BIT * sizeof(T) - clz);
}
Other compilers
If you use a compiler other than GCC or Clang, please visit the Wikipedia page listing the Count Leading Zeroes bitwise functions:
Visual C++ 2005 => Replace __builtin_clzl() by _BitScanForward()
Visual C++ 2008 => Replace __builtin_clzl() by __lzcnt()
icc => Replace __builtin_clzl() by _bit_scan_forward
GHC (Haskell) => Replace __builtin_clzl() by countLeadingZeros()
Contribution welcome
Please propose improvements within the comments. Also propose alternative for the compiler you use, or your programming language...
See also similar answers
nulleight's answer
ydroneaud's answer
Here's a wild one that has no loops, but uses an intermediate float.
// compute k = nextpowerof2(n)
if (n > 1)
{
float f = (float) n;
unsigned int const t = 1U << ((*(unsigned int *)&f >> 23) - 0x7f);
k = t << (t < n);
}
else k = 1;
This, and many other bit-twiddling hacks, including the on submitted by John Feminella, can be found here.
assume x is not negative.
int pot = Integer.highestOneBit(x);
if (pot != x) {
pot *= 2;
}
If you use GCC, MinGW or Clang:
template <typename T>
T nextPow2(T in)
{
return (in & (T)(in - 1)) ? (1U << (sizeof(T) * 8 - __builtin_clz(in))) : in;
}
If you use Microsoft Visual C++, use function _BitScanForward() to replace __builtin_clz().
function Pow2Thing(int n)
{
x = 1;
while (n>0)
{
n/=2;
x*=2;
}
return x;
}
Bit-twiddling, you say?
long int pow_2_ceil(long int t) {
if (t == 0) return 1;
if (t != (t & -t)) {
do {
t -= t & -t;
} while (t != (t & -t));
t <<= 1;
}
return t;
}
Each loop strips the least-significant 1-bit directly. N.B. This only works where signed numbers are encoded in two's complement.
What about something like this:
int pot = 1;
for (int i = 0; i < 31; i++, pot <<= 1)
if (pot >= x)
break;
You just need to find the most significant bit and shift it left once. Here's a Python implementation. I think x86 has an instruction to get the MSB, but here I'm implementing it all in straight Python. Once you have the MSB it's easy.
>>> def msb(n):
... result = -1
... index = 0
... while n:
... bit = 1 << index
... if bit & n:
... result = index
... n &= ~bit
... index += 1
... return result
...
>>> def next_pow(n):
... return 1 << (msb(n) + 1)
...
>>> next_pow(1)
2
>>> next_pow(2)
4
>>> next_pow(3)
4
>>> next_pow(4)
8
>>> next_pow(123)
128
>>> next_pow(222)
256
>>>
Forget this! It uses loop !
unsigned int nextPowerOf2 ( unsigned int u)
{
unsigned int v = 0x80000000; // supposed 32-bit unsigned int
if (u < v) {
while (v > u) v = v >> 1;
}
return (v << 1); // return 0 if number is too big
}
private static int nextHighestPower(int number){
if((number & number-1)==0){
return number;
}
else{
int count=0;
while(number!=0){
number=number>>1;
count++;
}
return 1<<count;
}
}
// n is the number
int min = (n&-n);
int nextPowerOfTwo = n+min;
#define nextPowerOf2(x, n) (x + (n-1)) & ~(n-1)
or even
#define nextPowerOf2(x, n) x + (x & (n-1))
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.
Write a program that take a single command line argument N and prints out the corresponding Roman Numeral.
Eg N = 2009 should print MMIX.
Let's say this should work for 0 < N < 3000.
(Had fun playing my first ever round of code golf with the Christmas edition, and thought this could fit for New Year. Googled to see if this has come up before elsewhere and it looks like it hasn't, but let me know if this is too hard or too easy or if the rules need changing. )
Happy MMIX!
Perl: 69 strokes (count 'em!)
Sixty-nine strokes including calling perl in the first place:
$ perl -ple's!.!($#.=5x$&*8%29628)=~y$IVCXL4620-8$XLMCDIXV$d!eg;last}{'
3484
MMMCDLXXXIV
Reads a single line, writes a single line.
Works from 0 to 3999, inclusive. (Prints empty string for 0.)
In Perl golf competitions, this is usually scored as 62 strokes = 58 for the code + 4 for the switches.
Why, yes, those are mismatched braces. Thanks for asking. =)
Credits: originally due to Ton Hospel. The trick involving the mismatched braces is from rev.pl in this post (which incidentally, is ingenious).
In C#, as an extension method to Int32:
public static class Int32Extension {
public static string ToRomanNumeral(this int number) {
Dictionary<int, string> lookup = new Dictionary<int, string>() {
{ 1000000, "M_" },
{ 900000, "C_D_" },
{ 500000, "D_" },
{ 400000, "C_D_" },
{ 100000, "C_" },
{ 90000, "X_C_" },
{ 50000, "L_" },
{ 40000, "X_L_" },
{ 10000, "X_" },
{ 9000, "MX_"},
{ 5000, "V_" },
{ 4000, "MV_" },
{ 1000, "M" },
{ 900, "CM" },
{ 500, "D" },
{ 400, "CD" },
{ 100,"C" },
{ 90, "XC" },
{ 50, "L" },
{ 40, "XL" },
{ 10, "X" },
{ 9, "IX" },
{ 5, "V" },
{ 4, "IV" },
{ 1, "I" }
};
StringBuilder answer = new StringBuilder();
foreach (int key in lookup.Keys.OrderBy(k => -1 * k)) {
while (number >= key) {
number -= key;
answer.Append(lookup[key]);
}
}
return answer.ToString();
}
}
The underscores should be overlines above the respective letter to be true Roman Numeral.
Common lisp (SBCL). 63 characters counted by "wc -c".
(format t "~#R~%" (parse-integer (elt *posix-argv* 1)))
(quit)
This only works for numbers upto 3999.
C#: 179 chars (not including spaces/tabs)
static string c(int a)
{
int[] v = { 1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1 };
var s = "";
for ( var i = 0; i < 13; i++ )
while (a >= v[i])
{
a -= v[i];
s += "M CM D CD C XC L XL X IX V IV I".Split()[i];
}
return s;
}
Perl, 19 strokes. Guaranteed to work for values between 1 and 12.
sub r{chr 8543+pop}
Language: JavaScript.
129 chars without the added formatting
The following code is a result of coding quiz which which took place at pl.comp.lang.javascript newsgrup several years ago. I'm not the author of the code.
function rome(N,s,b,a,o){
for(s=b='',a=5;N;b++,a^=7)for(o=N%a,N=N/a^0;o--;)
s='IVXLCDM'.charAt(o>2?b+N-(N&=~1)+(o=1):b)+s;return s
}
Original post by Elus
Python, 173 bytes.
r=lambda n:o[n]if n<10 else''.join(dict(zip('ivxlc','xlcdm'))[c]for c in r(n//10))+o[n%10]
o=' i ii iii iv v vi vii viii ix'.split(' ')
import sys
print r(int(sys.argv[1]))
(I first saw this algorithm in Gimpel's Algorithms in Snobol4; Snobol expressed it more elegantly.)
Language: C, Char count: 174
#define R(s,v)for(;n>=v;n-=v)printf(#s);
main(int n,char**a){n=atoi(a[1]);R(M,1000)R(CM,900)R(D,500)R(CD,400)R(C,100)R(XC,90)R(L,50)R(XL,40)R(X,10)R(IX,9)R(V,5)R(IV,4)R(I,1)}
Pike
60 characters, valid for 0 to 10000:
int main (int c, array a) {
write(String.int2roman((int)a[1]));
}
Perl 5.10
perl -nE'#l=qw{1 I 4 IV 5 V 9 IX 10 X 40 XL 50 L 90 XC 100 C 400 CD 500 D 900 CM 1000 M};
$o="";while(#l){$o.=pop(#l)x($_/($c=pop #l));$_%=$c;}say$o'
You input a line, it gives you the Roman numeral equivelent. This first version even lets you input more than one line.
Here is a shorter version that only works for one line, and ignores edge cases. so 4 becomes IIII instead of IV.
perl -nE'#l=qw{1 I 5 V 10 X 50 L 100 C 500 D 1000 M};
while(#l){$o.=pop(#l)x($_/($c=pop #l));$_%=$c;}say$o'
Here is what the first version would look like as a Perl script.
use 5.010;
while(<>){
#l=qw{1 I 4 IV 5 V 9 IX 10 X 40 XL 50 L 90 XC 100 C 400 CD 500 D 900 CM 1000 M};
$o="";
while(#l){
$o .= pop(#l) x ($_/($c=pop #l));
# $l = pop #l;
# $c = pop #l;
# $o .= $l x ($_/$c);
$_ %= $c;
}
say $o;
}
A simple Haskell version, that still keeps clarity. 205 characters, including white space.
l = ["M","CM","L","CD","C","XC","L","XL","X","IX","V","IV","I"]
v = [1000,900,500,400,100,90,50,40,10,9,5,4,1]
roman n i
| n == 0 = ""
| n >= v!!i = l!!i ++ roman (n-v!!i) i
| otherwise = roman n (i+1)
In Python - taken from ActiveState (credits: Paul Winkler) and compressed a bit:
def int2roman(n):
if not 0 < n < 4000: raise ValueError
ints = (1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1)
nums = ('M', 'CM', 'D', 'CD','C', 'XC','L','XL','X','IX','V','IV','I')
result = ""
for i in range(len(ints)):
count = int(n / ints[i])
result += nums[i] * count
n -= ints[i] * count
return result
Perl, 145 strokes (if you strip out all the newlines, which are optional), valid for 1..3999:
%t=qw(1000 M 900 CM 500 D 400 CD 100 C 90 XC 50 L 40 XL 10 X 9 IX 5 V 4 IV 1 I);
$d=pop;
for(sort{$b<=>$a}keys%t){$r.=$t{$_}x($d/$_);$d%=$_}
print$r
Some would say I could use say, but I don't have a say-capable Perl version here. Feel free to subtract 2 off the stroke count if using say works. :-)
For non-Perl programmers, this program exploits a number of useful Perl features:
Hashes are constructed from lists of even length.
Lists of strings can be specified in a compact syntax, using qw.
Strings can auto-coerce into integers, as used in the <=> comparison operator in sorting the keys.
There is an x operator which makes copies of strings/lists. Unfortunately for golfing here, x has identical precedence to /; if / were higher, the brackets would have been optional too.
Ruby, 136 chars
n = $*[0].to_i
for k,v in [1e3,900,500,400,100,90,50,40,10,9,5,4,1].zip %w{M CM D CD C XC L XL X IX V IV I}
until n < k
n -= k
print v
end
end
Language: dc (through shell) Char count:122
EDIT: q is equivalent of 2Q
dc -e '[I]1[IV]4[V]5[IX]9[X]10[XL]40[L]50[XC]90[C]100[CD]400[D]500[CM]900[M]?1000[szsz2Q]sq[~Sa[d0!<qrdPr1-lbx]dsbxLarz3<c]dscx10P' <<<$1
EDIT: two more chars by optimizing main loop stack manipulations
dc -e '[I]1[IV]4[V]5[IX]9[X]10[XL]40[L]50[XC]90[C]100[CD]400[D]500[CM]900[M]?1000[szsz2Q]sq[~Sa[d0!<qrdPr1-lbx]dsbxLarz3<c]dscx10P' <<<$1
EDIT: save 2 chars
dc -e '[I]1[IV]4[V]5[IX]9[X]10[XL]40[L]50[XC]90[C]100[CD]400[D]500[CM]900[M]1000?[sz2Q]sq[r~r[d0!<qSardPrLa1-lbx]dsbxrszz2<c]dscx10P' <<<$1
Previous version:
dc -e '[I]1[IV]4[V]5[IX]9[X]10[XL]40[L]50[XC]90[C]100[CD]400[D]500[CM]900[M]1000?[sz2Q]sq[r~r[d0!<qSaSadPLaLa1-lbx]dsbxrszz2<c]dscx10P' <<<$1
I'm no Haskell expert, and this is too long to be a winner, but here's a solution I wrote a while back to solve Euler #89.
toRoman 0 = ""
toRoman 1 = "I"
toRoman 2 = "II"
toRoman 3 = "III"
toRoman 4 = "IV"
toRoman n
| n >= 1000 = repeatRoman 'M' 1000
| n >= 900 = subtractRoman "CM" 900
| n >= 500 = subtractRoman "D" 500
| n >= 400 = subtractRoman "CD" 400
| n >= 100 = repeatRoman 'C' 100
| n >= 90 = subtractRoman "XC" 90
| n >= 50 = subtractRoman "L" 50
| n >= 40 = subtractRoman "XL" 40
| n >= 10 = repeatRoman 'X' 10
| n >= 9 = subtractRoman "IX" 9
| n >= 5 = subtractRoman "V" 5
| otherwise = error "Hunh?"
where
repeatRoman c n' = (take (n `div` n') (repeat c)) ++ (toRoman $ n `mod` n')
subtractRoman s n' = s ++ (toRoman $ n - n')
J, 20 characters!
'MDCLXVI'#~(7$5 2)#:
Usage:
'MDCLXVI'#~(7$5 2)#: 2009
MMVIIII
Okay, it doesn't do subtraction properly, but hey it's pretty cool!
Explanation;
(7$5 2)
This takes the right argument (the list 5 2) and turns it into a list of size 7 - namely 5 2 5 2 5 2 5.
(7$5 2)#: 2009
This does the "anti-base" operation - basically doing iterative div and mod operations, returning the list 2 0 0 0 0 0 1 4.
Then #~ uses the previous list as a tally to pull corresponding characters out of 'MDCLXVI'.
From a vaguely C-like language called LPC (precursor of Pike):
string roman_numeral(int val) {
check_argument(1, val, #'intp);
unless(val)
return "N";
string out = "";
if(val < 0) {
out += "-";
val = -val;
}
if(val >= 1000) {
out += "M" * (val / 1000);
val %= 1000;
}
if(val >= 100) {
int part = val / 100;
switch(part) {
case 9 :
out += "CM";
break;
case 6 .. 8 :
out += "D" + ("C" * (part - 5));
break;
case 5 :
out += "D";
break;
case 4 :
out += "CD";
break;
default :
out += "C" * part;
break;
}
val %= 100;
}
if(val >= 10) {
int part = val / 10;
switch(part) {
case 9 :
out += "XC";
break;
case 6 .. 8 :
out += "L" + ("X" * (part - 5));
break;
case 5 :
out += "L";
break;
case 4 :
out += "XL";
break;
default :
out += "X" * part;
break;
}
val %= 10;
}
switch(val) {
case 9 :
out += "IX";
break;
case 6 .. 8 :
out += "V" + ("I" * (val - 5));
break;
case 5 :
out += "V";
break;
case 4 :
out += "IV";
break;
default :
out += "I" * val;
break;
}
return out;
}
Python, 190 bytes. Based on snippet from ActiveState, via Federico.
A few small optimisations: removal of superfluous int() call, splitting string to get array, remove whitespace, ...
import sys
n=int(sys.argv[1])
N=(1000,900,500,400,100,90,50,40,10,9,5,4,1)
r=""
for i in range(len(N)):
c=n/N[i]
r+='M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I'.split(',')[i]*c
n-=N[i]*c
print r
EDIT: superfluous, not spurious, and remove range check - thanks to Chris and dreeves! Stole idea of using symbol array inline from balabaster.
VB: 193 chars
Function c(ByVal a)
Dim v() = {1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1}
Dim s = ""
For i = 0 To 12
While a >= v(i)
a -= v(i)
s += "M|CM|D|CD|C|XC|L|XL|X|IX|V|IV|I".Split("|")(i)
End While
Next
Return s
End Function
Excel 8 chars (not lincluding the number):
=ROMAN(N)
Works up to 3000.
Tongue in cheek
Real simple: pass the query to Google and screenscrape the answer. Next. :p
BTW, shouldn't this be a community wiki?
Java: 286 significant characters
public class R {
String[]x="M,CM,D,C,XC,L,X,IX,V,I".split(",");
int[]n={1000,900,500,100,90,50,10,9,5,1};
String p(String s,int d,int i){return 10<=i?s:n[i]<=d?p(s+x[i],d-n[i],i):p(s,d,i+1);}
public static void main(String[] a) {
System.out.println(new R().p("",Integer.parseInt(a[0]),0));
}
}
By "significant characters", I mean the printing characters and required spaces (e.g. between type and argument), but not pure cosmetic whitespace (newlines and indentation).
Delphi (or Pascal, there's nothing Delphi-specific here):
Function ToRoman(N : Integer) : String;
Const
V : Array [1..13] of Word = (1000,900,500,400,100,90,50,40,10.9,5,4,1);
T : Array [1..13] of String = ('M','CM','D','CD','C','XC','L','XL','X','IX','V','I');
Var I : Word;
Begin
I := 1;
Repeat
While N < V[I] do Inc(I);
Result := Result + T[I];
N := N - V[I];
Until N = 0;
End;
How is everyone getting the character counts? (I count 8 essential spaces, all the rest are simply for formatting.)
Here is a C solution in 252 meaningful chars. Valid from 0 <= i < 4000. Mostly I wrote this because so many solutions include IV and IX at array points. Decoding it: t is our temp buffer that we back fill so that we don't have to reverse it on output. The buffer passed in must be at least 16 chars (for 3888 -> MMMDCCCLXXXVIII).
char* i2r(int i, char* r) {
char t[20];
char* o=t+19;*o=0;
char* s="IVXLCDMM";
for (char*p=s+1;*p&&i;p+=2) {
int x=i%10;
if (x==9) {*--o=p[1];*--o=p[-1];}
else if (x==4) {*--o=*p;*--o=p[-1];}
else {
for(;x&&x!=5;--x)*--o=p[-1];
if(x)*--o=*p;
}
i/=10;
}
return strcpy(r,o);
}
And I always forget to put the main on. So much for 252 chars:
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
void main(int a,char**v){
char buf[16];
printf("%s\n",i2r(atoi(v[1])));
}
Language: C, Char count: 195
Based heavily off of me.yahoo.com/joe_mucchielle's C solution:
char t[99],*o=t+99,*s="IVXLCDMM",*p,x;n(v){*--o=p[v];}main(int i,int**v){i=atoi(v[1]);*o=0;
for(p=s+1;*p&&i;p+=2){x=i%10;if(x%5==4)n(x==9),n(-1);else{for(;x%5;--x)n(-1);if(x)n(0);}i/=10;}puts(o);}
Language: Erlang, Char count: 222
EDIT2: Erlang preprocessor allows some sort of unbalanced macros so this version is 9 chars shorter.
-module(n2).
-export([y/1]).
-define(D(V,S),n(N)when N>=V->[??S|n(N-V)];).
y(N)->io:format(n(N)).
?D(1000,M)?D(900,CM)?D(500,D)?D(400,CD)?D(100,C)?D(90,XC)?D(50,L)?D(40,XL)?D(10,X)?D(9,IX)?D(5,V)?D(4,IV)?D(1,I)n(0)->[10].
EDIT: Shorter version inspired by Darius version (231 chars)
-module(n).
-export([y/1]).
y(N)->io:format([n(N),10]).
n(N)when N>9->[Y||C<-n(N div 10),{K,Y}<-lists:zip("IVXLC","XLCDM"),K==C]++o(N rem 10);n(N)->o(N).
o(N)->lists:nth(N+1,[[]|string:tokens("I II III IV V VI VII VIII IX"," ")]).
It's less readable but save 2 chars (233 chars).
-module(n).
-export([y/1]).
-define(D(V,S),n(N)when N>=V->[??S|n(N-V)]).
y(N)->io:format(n(N)).
?D(1000,M);?D(900,CM);?D(500,D);?D(400,CD);?D(100,C);?D(90,XC);?D(50,L);?D(40,XL);?D(10,X);?D(9,IX);?D(5,V);?D(4,IV);?D(1,I);n(0)->[10].
Command line version:
-module(n).
-export([y/1]).
-define(D(V,S),n(N)when N>=V->[??S|n(N-V)]).
y([N])->io:format(n(list_to_integer(N))),init:stop().
?D(1000,M);?D(900,CM);?D(500,D);?D(400,CD);?D(100,C);?D(90,XC);?D(50,L);?D(40,XL);?D(10,X);?D(9,IX);?D(5,V);?D(4,IV);?D(1,I);n(0)->[10].
Invocation:
$ erl -noshell -noinput -run n y 2009
MMIX
EDIT: I saved 17 chars using literal macro expansion.
Railo CFML - 53 chars, 46 without whitespace...
<cfoutput>
#NumberFormat( N , 'roman' )#
</cfoutput>
Or, for other CF engines, not sure if these are shortest, but they'll do for now...
CFML - 350..453 characters:
<cffunction name="RomanNumberFormat">
<cfset var D = ListToArray('M,CM,D,C,XC,L,X,IX,V,IV,I') />
<cfset var I = [1000,900,500,100,90,50,10,9,5,4,1] />
<cfset var R = '' />
<cfset var x = 1 />
<cfset var A = Arguments[1] />
<cfloop condition="A GT 0">
<cfloop condition="A GTE I[x]">
<cfset R &= D[x] />
<cfset A -= I[x] />
</cfloop>
<cfset x++ />
</cfloop>
<cfreturn R />
</cffunction>
<cfoutput>
#RomanNumberFormat(N)#
</cfoutput>
CFScript - 219..323 characters:
<cfscript>
function RomanNumberFormat(A)
{
var D = ListToArray('M,CM,D,C,XC,L,X,IX,V,IV,I');
var I = [1000,900,500,100,90,50,10,9,5,4,1];
var R = '';
var x = 1;
while ( A > 0 )
{
while( A >= I[x] )
{
R &= D[x];
A -= I[x];
}
x++;
}
return R;
}
WriteOutput( RomanNumberFormat(N) );
</cfscript>
In C# (running on .NET 4 RC), with 335 chars (if you remove the extraneous formatting).
using System;
using System.Linq;
class C
{
static void Main()
{
Console.WriteLine(
Console.ReadLine()
.PadLeft(4,'0')
.Select(d=>d-'0')
.Zip(new[]{" M","MDC","CLX","XVI"},(x,y)=>new{x,y})
.Aggregate("",(r,t)=>r+
new string(t.y[2],t.x%5/4)+
new string(t.y[0],t.x%5/4*t.x/5)+
new string(t.y[1],Math.Abs(t.x%5/4-t.x/5))+
new string(t.y[2],t.x%5%4)));
}
}
I know it does not beat the current best C# answer (182 chars) but this is just one big LINQ one-liner. Once I saw a raytracer written as a single LINQ query, I started approaching code golfs from this perspective.
Since this approach is functional, I'm working on a Haskell version of the same algorithm (will surely be shorter).
Haskell version of my C#/LINQ answer, 234 chars:
main=putStrLn.foldr(\(y,x)s->concat[s,r(a x)(y!!2),r(a x*div x 5)(y!!0),r(abs(a x-div x 5))(y!!1),r(mod(mod x 5)4)(y!!2)])"".zip["XVI","CLX","MDC"," M"].map(read.(:[])).take 4.(++"000").reverse=<<getLine
r=replicate
a x=div(mod x 5)4