Code Golf: Fractran - code-golf

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
Write a program that acts as a Fractran interpreter. The shortest interpreter by character count, in any language, is the winner. Your program must take two inputs: The fractran program to be executed, and the input integer n. The program may be in any form that is convenient for your program - for example, a list of 2-tuples, or a flat list. The output must be a single integer, being the value of the register at the end of execution.
Fractran
Fractran is a trivial esoteric language invented by John Conway. A fractran program consists of a list of positive fractions and an initial state n. The interpreter maintains a program counter, initially pointing to the first fraction in the list. Fractran programs are executed in the following fashion:
Check if the product of the current state and the fraction currently under the program counter is an integer. If it is, multiply the current state by the current fraction and reset the program counter to the beginning of the list.
Advance the program counter. If the end of the list is reached, halt, otherwise return to step 1.
For details on how and why Fractran works, see the esolang entry and this entry on good math/bad math.
Test Vectors
Program: [(3, 2)]
Input: 72 (2332)
Output: 243 (35)
Program: [(3, 2)]
Input: 1296 (2434)
Output: 6561 (38)
Program: [(455, 33), (11, 13), (1, 11), (3, 7), (11, 2), (1, 3)]
Input: 72 (2332)
Output: 15625 (56)
Bonus test vector:
Your submission does not need to execute this last program correctly to be an acceptable answer. But kudos if it does!
Program: [(455, 33), (11, 13), (1, 11), (3, 7), (11, 2), (1, 3)]
Input: 60466176 (210310)
Output: 7888609052210118054117285652827862296732064351090230047702789306640625 (5100)
Submissions & Scoring
Programs are ranked strictly by length in characters - shortest is best. Feel free to submit both a nicely laid out and documented and a 'minified' version of your code, so people can see what's going on.
The language 'J' is not admissible. This is because there's already a well-known solution in J on one of the linked pages. If you're a J fan, sorry!
As an extra bonus, however, anyone who can provide a working fractran interpreter in fractran will receive a 500 reputation point bonus. In the unlikely event of multiple self-hosting interpreters, the one with the shortest number of fractions will receive the bounty.
Winners
The official winner, after submitting a self-hosting fractran solution comprising 1779 fractions, is Jesse Beder's solution. Practically speaking, the solution is too slow to execute even 1+1, however.
Incredibly, this has since been beaten by another fractran solution - Amadaeus's solution in only 84 fractions! It is capable of executing the first two test cases in a matter of seconds when running on my reference Python solution. It uses a novel encoding method for the fractions, which is also worth a close look.
Honorable mentions to:
Stephen Canon's solution, in 165 characters of x86 assembly (28 bytes of machine code)
Jordan's solution in 52 characters of ruby - which handles long integers
Useless's solution in 87 characters of Python, which, although not the shortest Python solution, is one of the few solutions that isn't recursive, and hence handles harder programs with ease. It's also very readable.

Fractran - 1779 fractions
(Edit: fixed)
(I hope people are still following this thread, because this took a while!)
It appears SO won't let me post something as long as this, so I posted the Fractran source here.
Input is specified as follows:
First, we encode a fraction m/n = p_0^a0... p_k^ak by:
Start with 1. Then, for each ai:
Multiply by p_2i^ai if ai > 0
Multiply by p_2i+1^{-ai} if a_i < 0
This way, we encode any fraction as a positive integer. Now, given a progoram (sequence of encoded fractions F0, F1, ...), we encode that by
p_0^F0 p1^F1 ...
Finally, input to the interpreter is given by:
2^(program) 3^(input) 5
where program and input are encoded as above. For example, in the first test problem, 3/2 gets encoded to 15, so the program gets encoded to 2^15; and 108 gets encoded to 500. So, we pass
2^{2^15} 3^500 5
to the program. The output, then is of the form
2^(program) 3^(output)
so in the first example, it'll be
2^{2^15} 3^3125
How does it work?
I wrote a meta-language that compiles down to Fractran. It allows for functions (simple Fractran and sequences of other functions), and a while loop and if statement (for convenience!). The code for that can be found here.
If you want to compile that code down to Fractran yourself, my (C++) program can be found here [tar.gz]. In a stunning display of dogfooding (and showing off), I used my C++ YAML parser yaml-cpp, so you'd have to download and link with that. For both yaml-cpp and the "compiler", you'll need CMake for cross-platform makefile generating.
The usage of this program is:
./fracc interpreter.frp
The it reads the name of a function from standard input, and writes the corresponding "pseudo-Fraction" (I'll explain that in a second) to standard output. So to compile the interpreter (the Interpret function), you could run
echo "Interpret" | ./fracc interpreter.frp > interpret
The output ("pseudo-Fractran") will be a sequence of lines, each with a string of space-separated digits. A line corresponds to a fraction: if the nth digit in the line is an, then the fraction is the product of p_n^an.
It's very easy to convert this to Fractran, but if you're lazy, you can use to-fractions.py. [Note: earlier I had a C++ program, and I had carelessly ignored integer overflow. I translated it to Python to avoid this.]
Note about input: if you want to test out a different function this way, the convention is always the same. It has a number of parameters (usually the comment above the function explains this) in pseudo-Fractran, so give it what it wants, plus a 1 on the very next slot (so in ordinary Fractran, multiply once by the first prime that it won't use). This is a "signal" bit to the function to start going.
However,
I don't recommend actually trying to run the Fractran interpreter (alas). I tested many of its components, and, for example, the function IncrementPrimes, which takes a pair of primes and returns the next two primes, takes about 8 minutes to run, using my silly C++ interpreter (no need to post that :). Plus, it goes (at least) quadratically in the number of function calls - doubling the number of function calls makes it take at least four times as long (more if there are while loops or if statements). So I'm guessing that running the interpreter will take at least days, if not years :(
So how do I know it works? Well, of course I'm not 100% certain, but I'm pretty close. First of all, I tested many, many of its components, and in particular, I tested all of the elements of the meta-language (sequences of functions and if and while statements) very thoroughly.
Also, the meta-language is easy to translate into your favorite language, and even easier to translate to C++, since all parameters of functions are passed by reference. If you're feeling lazy again, you can download my translation here [tar.gz] (there's no makefile; it's just two .cpp files, so directly calling gcc is fine).
So you can compare the two interpreters, run the C++ version (it also takes input/output in pseudo-Fractran), check that that works, and then convince yourself that the meta-language works too.
Or!
If you're feeling inspired, and really want to see this interpreter interpreted, you can write a "clever" Fractran interpreter based around the type of Fractran output that we get. The output is very structured - sequences of functions are implemented using signals, so if you somehow cache where the interpreter was, you could jump there immediately if nothing important changed. This, I think, would dramatically speed up the program (perhaps cutting down running time by one or more powers).
But, I'm not really sure how to do this, and I'm happy with what's done, so I'll leave it as an exercise for the reader.

Fractran: 84 fractions
FTEVAL = [197*103/(2^11*101), 101/103, 103*127/(2*101), 101/103, 109/101,
2*23/(197*109), 109/23, 29/109,197*41*47/(31*59), 11^10*53/(127*197), 197/53,
37/197, 7^10*43/(11^10*37), 37/43, 59/(37*47), 59/47, 41*61/59, 31*67/(41*61),
61/67, 7*67/(127*61), 61/67,101/71, 73/(127^9*29), 79/(127^2*73),
83/(127*73), 89/(2*29), 163/29, 127^11*89/79, 337/83, 2*59/89, 71/61,
7*173/(127*163), 163/173, 337*167/163, 347/(31*337), 337/347, 151/337,
1/71,19*179/(3*7*193), 193/179, 157/(7*193), 17*181/193, 7*211/(19*181),
181/211, 193/181, 157/193, 223/(7*157), 157/223, 281*283/239,
3*257*269/(7*241), 241/269, 263/241, 7*271/(257*263), 263/271, 281/263,
241/(17*281), 1/281, 307/(7*283), 283/307, 293/283, 71*131/107, 193/(131*151),
227/(19*157), 71*311/227, 233/(151*167*311), 151*311/229, 7*317/(19*229),
229/317, 239*331/217, 71*313/157, 239*251/(151*167*313), 239*251/(151*313),
149/(251*293), 107/(293*331), 137/199, 2^100*13^100*353/(5^100*137),
2*13*353/(5*137), 137/353, 349/137, 107/349, 5^100*359/(13^100*149),
5*359/(13*149), 149/359, 199/149]
This is written entirely by hand. I did make up a pseudo language to be able to express things more clearly, but I did not write a compiler and opted to write optimized Fractran code directly.
FTEVAL takes input 3^initial_state * 5^encoded_program * 199, produces intermediate results 3^interpreted_program_state * 199, and completely halts at a number divisible by 233.
The interpreted program is embeded as a list of base 10 digits inside a single base 11 number, using the digit "a" to mark the boundary except at the very end. The addition program [3/2] is encoded as
int("3a2", 11) = 475.
The multiplication program [455/33, 11/13, 1/11, 3/7, 11/2, 1/3] is encoded as
int("1a3a11a2a3a7a1a11a11a13a455a33", 11) = 3079784207925154324249736405657
which is a truly large number.
The first test vector finished in less than one second, produced the desired result after 4545 iterations and halted after 6172 iterations. Here is the complete output.
Unfortunately, sage segfaulted when I tried the second test vector (but I think it'll work under Nick's implementation using prime exponent vectors).
The space here is really too small to explain everything. But here is my pseudocode. I will write up my process in a couple of days, hopefully.
# Notations:
# %p
# designates the exponent of prime factor p that divides the
# current state.
# mov x y
# directly translates to the fraction y/x; its meaning: test if x divides
# the current state, if so divide the current state by x and multiply it by
# y. In effect, the prime exponents of x and y are exchanged. A Fractran
# program only comprises of these instructions; when one is executable, the
# program continues from the beginning.
# dec x => mov x, 1
# wipes out all factors of x
# inc x => mov 1, x
# this form is here for the sake of clarity, it usually appears in a
# loop's entry statement and is merged as such when compiled
# sub n ret m {...}
# conceptually represents a Fractran sub-program, which will execute just
# like a normal Fractran program, that is, the sub-program's statements
# execute when triggered and loop back. The sub-program only exits when none of
# its statement is executable, in which occasion we multiply the program's
# state by m. We can also explicitly break out early on some conditions.
# It is also possible to enter a sub-prorgram via multiple entry points and
# we must take care to avoiding this kind of behavior (except in case where
# it is desirable).
# entry point 101: return 29
# Divide %2 modulo 11:
# - quotient is modified in-place
# - remainder goes to %127
sub 101 ret 101 { mov 2^11, 197 }
sub 101 ret 109 { mov 2, 127 }
sub 109 ret 29 { mov 197, 2 }
# entry point 59: return 61
# Multiply %127 by 10^%31 then add result to %7,
# also multiply %31 by 10 in-place.
sub 59 ret 41*61 {
mov 31, 197*41
sub 197 ret 37 { mov 127, 11^10 }
sub 37 { mov 11^10, 7^10 }
}
sub 61 ret 61 { mov 41, 31 }
sub 61 ret 61 { mov 127, 7 } # the case where %31==0
# entry point 71: return 151 if success, 151*167 if reached last value
# Pop the interpreted program stack (at %2) to %7.
sub 71 {
# call sub 101
inc 101
# if remainder >= 9:
mov 29*127^9, 73
# if remainder == 11, goto 79
mov 73*127^2, 79
# else:
# if remainder == 10, goto 83
mov 73*127, 83
# else:
# if quotient >= 1: goto 89
mov 29*2, 89
# else: goto 163
mov 29, 163
# 79: restore remainder to original value, then goto 89
mov 79, 127^11*89
# 83: reached a border marker, ret
mov 83, 337
# 89: the default loop branch
# restore quotient to original value, call 59 and loop when that rets
mov 2*89, 59
mov 61, 71
# 163: reached stack bottom,
# ret with the halt signal
sub 163 ret 337*167 { mov 127, 7 }
# 337: clean up %31 before ret
sub 337 ret 151 { dec 31 }
}
# entry point 193, return 157
# Divide %3 modulo %7:
# - quotient goes to %17
# - remainder goes to %19
sub 193 ret 17*181 {
mov 3*7, 19
}
mov 7*193, 157
sub 181 ret 193 { mov 19, 7 }
mov 193, 157
sub 157 ret 157 { dec 7 }
# entry point 239: return 293
# Multiply %17 by %7, result goes to %3
mov 239, 281*283
sub 241 { mov 7, 3*257 }
sub 263 ret 281 { mov 257, 7 }
mov 281*17, 241
sub 283 ret 293 { dec 7 }
# entry point 107: return 149 if success, 233 if stack empty
# Pop the stack to try execute each fraction
sub 107 {
# pop the stack
inc 71*131
# 151: popped a value
# call divmod %3 %7
mov 131*151, 193
# if remainder > 0:
mov 19*157, 227
# pop and throw away the numerator
mov 227, 71*311
# if stack is empty: halt!
mov 151*167*311, 233
# else: call 239 to multiply back the program state and gave loop signal
mov 151*311, 229
sub 229 ret 239*331 { mov 19, 7 }
# else: (remainder == 0)
# pop the numerator
mov 157, 71*313
# clear the stack empty signal if present
# call 239 to update program state and gave ret signal
mov 151*167*313, 239*251
mov 151*313, 239*251
# after program state is updated
# 313: ret
mov 293*251, 149
# 331: loop
mov 293*331, 107
}
# main
sub 199 {
# copy the stack from %5 to %2 and %13
sub 137 ret 137 { mov 5^100, 2^100*13^100 }
sub 137 ret 349 { mov 5, 2*13 }
# call sub 107
mov 349, 107
# if a statement executed, restore stack and loop
sub 149 ret 149 { mov 13^100, 5^100 }
sub 149 ret 199 { mov 13, 5 }
}

x86_64 assembly, 165 characters (28 bytes of machine code).
State is passed in %rdi, Program (pointer to null-terminated array of fractions) is in %rsi. Results are returned in %rax per the usual C-style calling conventions. Using non-standard calling conventions or Intel syntax (this is AT&T syntax) would drop a few more characters, but I'm lazy; someone else can do that. An instruction or two can almost certainly be saved by re-arranging the control flow, if someone wants to do that, feel free.
Intermediate computations (state*numerator) can be up to 128 bits wide, but only 64 bit state is supported.
_fractran:
0: mov %rsi, %rcx // set aside pointer to beginning of list
1: mov (%rcx), %rax // load numerator
test %rax, %rax // check for null-termination of array
jz 9f // if zero, exit
mul %rdi
mov 8(%rcx), %r8 // load denominator
div %r8
test %rdx, %rdx // check remainder of division
cmovz %rax, %rdi // if zero, keep result
jz 0b // and jump back to program start
add $16, %rcx // otherwise, advance to next instruction
jmp 1b
9: mov %rdi, %rax // copy result for return
ret
Delete comments, extraneous whitespace, and the verbose label _fractran for minimized version.

Ruby, 58 57 56 53 52 characters
This is my first-ever code golf entry, so please be gentle.
def f(n,c)d,e=c.find{|i,j|n%j<1};d ?f(n*d/e,c):n end
Usage:
irb> f 108, [[455, 33], [11, 13], [1,11], [3,7], [11,2], [1,3]]
=> 15625
irb> f 60466176, [[455, 33], [11, 13], [1, 11], [3, 7], [11, 2], [1, 3]]
=> 7888609052210118054117285652827862296732064351090230047702789306640625
Pretty version (252):
def fractran(instruction, program)
numerator, denominator = program.find do |numerator, denominator|
instruction % denominator < 1
end
if numerator
fractran(instruction * numerator / denominator, program)
else
instruction
end
end
Ruby, 53 52 using Rational
Inspired by gnibbler's solution I was able to get a solution using Rational down to 53 52 characters. Still one longer than the (less elegant) solution above.
def f(n,c)c.map{|i|return f(n*i,c)if i*n%1==0};n end
Usage:
irb> require 'rational'
irb> f 60466176, [Rational(455, 33), Rational(11, 13), Rational(1, 11), Rational(3, 7), Rational(11, 2), Rational(1, 3)]
=> Rational(7888609052210118054117285652827862296732064351090230047702789306640625, 1)
(A to_i call for prettier output would add 5 more characters.)

Golfscript - 32
{:^{1=1$\%!}?.1={~#\/*^f}{}if}:f
; 108 [[3 2]] f p
# 243
; 1296 [[3 2]] f p
# 6561
; 108 [[455 33][11 13][1 11][3 7][11 2][1 3]] f p
# 15625
; 60466176 [[455 33][11 13][1 11][3 7][11 2][1 3]] f p
# 7888609052210118054117285652827862296732064351090230047702789306640625

Haskell, 102 characters
import List
import Ratio
l&n=maybe n((&)l.numerator.(n%1*).(!!)l)$findIndex((==)1.denominator.(n%1*))l
$ ghci
Prelude> :m List Ratio
Prelude List Ratio> let l&n=maybe n((&)l.numerator.(n%1*).(!!)l)$findIndex((==)1.denominator.(n%1*))l
Prelude List Ratio> [3%2]&108
243
Prelude List Ratio> [3%2]&1296
6561
Prelude List Ratio> [455%33,11%13,1%11,3%7,11%2,1%3]&108
15625
88 with relaxed restrictions on the input/output format.
import List
import Ratio
l&n=maybe n((&)l.(*)n.(!!)l)$findIndex((==)1.denominator.(*)n)l
Prelude List Ratio> let l&n=maybe n((&)l.(*)n.(!!)l)$findIndex((==)1.denominator
Prelude List Ratio> [455%33,11%13,1%11,3%7,11%2,1%3]&108
15625 % 1

Python, 83 82 81 72 70 characters.
It's convenient to have input as fractions.Fraction objects. Same idea as in Ruby solution.
def f(n,c):d=[x for x in c if x*n%1==0];return d and f(n*d[0],c) or n
# Test code:
from fractions import Fraction as fr
assert f(108, [fr(3, 2)]) == 243
assert f(1296, [fr(3, 2)]) == 6561
assert f(108, [fr(455, 33), fr(11, 13), fr(1, 11), fr(3, 7), fr(11, 2), fr(1, 3)]) == 15625
assert f(60466176, [fr(455, 33), fr(11, 13), fr(1, 11), fr(3, 7), fr(11, 2), fr(1, 3)]) == 7888609052210118054117285652827862296732064351090230047702789306640625

C, 159 153 151 131 111 110 characters
v[99],c,d;main(){for(;scanf("%d",v+c++););while(d++,v[++d])
*v%v[d]?0:(*v=*v/v[d]*v[d-1],d=0);printf("%d",*v);}
$ cc f.c
$ echo 108 3 2 . | ./a.out; echo
243
$ echo 1296 3 2 . | ./a.out; echo
6561
$ echo 108 455 33 11 13 1 11 3 7 11 2 1 3 . | ./a.out; echo
15625

Python - 53
Improvement thanks to Paul
f=lambda n,c:next((f(n*x,c)for x in c if x*n%1==0),n)
testcases
from fractions import Fraction as fr
assert f(108, [fr(3, 2)]) == 243
assert f(1296, [fr(3, 2)]) == 6561
assert f(108, [fr(455, 33), fr(11, 13), fr(1, 11), fr(3, 7), fr(11, 2), fr(1, 3)]) == 15625
assert f(60466176, [fr(455, 33), fr(11, 13), fr(1, 11), fr(3, 7), fr(11, 2), fr(1, 3)]) == 7888609052210118054117285652827862296732064351090230047702789306640625
Python - 54 Without using Fraction
f=lambda n,c:next((f(n*i/j,c)for i,j in c if n%j<1),n)
Python - 55
This one is somewhat theoretical. The first two cases run ok, but the other two fail from recursion depth. Maybe someone can get it to work with a generator expression
f=lambda n,c:([f(n*i/j,c)for i,j in c if n%j<1]+[n])[0]
Here's one possibility, but grows to 65 even without including the import
from itertools import chain
f=lambda n,c:(chain((f(n*i/j,c)for i,j in c if n%j<1),[n])).next()

F#: 80 chars
let rec f p=function|x,(e,d)::t->f p (if e*x%d=0I then(e*x/d,p)else(x,t))|x,_->x
Here's an expanded version using match pattern with |cases instead of function:
//program' is the current remainder of the program
//program is the full program
let rec run program (input,remainingProgram) =
match input, remainingProgram with
| x, (e,d)::rest ->
if e*x%d = 0I then //suffix I --> bigint
run program (e*x/d, program) //reset the program counter
else
run program (x, rest) //advance the program
| x, _ -> x //no more program left -> output the state
Test code:
let runtests() =
[ f p1 (108I,p1) = 243I
f p1 (1296I,p1) = 6561I
f p2 (108I,p2) = 15625I
f p2 (60466176I,p2) = pown 5I 100]
And result (tested in F# interactive):
> runtests();;
val it : bool list = [true; true; true; true]
Edit let's have some more fun with this, and calculate some primes (see linked page in the starting post). I've written a new function g that yields the intermediate values of the state.
//calculate the first n primes with fractran
let primes n =
let ispow2 n =
let rec aux p = function
| n when n = 1I -> Some p
| n when n%2I = 0I -> aux (p+1) (n/2I)
| _ -> None
aux 0 n
let pp = [(17I,91I);(78I,85I);(19I,51I);(23I,38I);(29I,33I);(77I,29I);(95I,23I);
(77I,19I);(1I,17I);(11I,13I);(13I,11I);(15I,14I);(15I,2I);(55I,1I)]
let rec g p (x,pp) =
seq { match x,pp with
|x,(e,d)::t -> yield x
yield! g p (if e*x%d=0I then (e*x/d,p) else (x,t))
|x,_ -> yield x }
g pp (2I,pp)
|> Seq.choose ispow2
|> Seq.distinct
|> Seq.skip 1 //1 is not prime
|> Seq.take n
|> Seq.to_list
Takes a whopping 4.7 seconds to cough up the first 10 prime numbers:
> primes 10;;
Real: 00:00:04.741, CPU: 00:00:04.005, GC gen0: 334, gen1: 0, gen2: 0
val it : int list = [2; 3; 5; 7; 11; 13; 17; 19; 23; 29]
This is, without doubt, the most bizarre and slow prime number generator I've ever written. I'm not sure whether that's a good thing or a bad thing.

A Javascript one: 99 characters. No bonus vector :(
function g(n,p,q,i,c){i=0;while(q=p[i],c=n*q[0],(c%q[1]?++i:(n=c/q[1],i=0))<p.length){};return n;};
Input is in the format [[a,b],[c,d]]. I took advantage of Javascript's lenience: instead of doing var x=0, y=0;, you can add as many parameters as you like. It doesn't matter whether you actually pass them or not, since they default to null.
Pretty version:
function g(n,p) {
var q, c, i=0;
while(i < p.length) {
q = p[i];
c = n * q[0];
if(c % q[1] != 0) {
++i;
} else {
n = c % q[1];
i = 0;
}
}
return n;
};

Python, 110 103 95 87 characters
frc.py
def f(n,c):
d=c
while len(d):
if n%d[1]:d=d[2:]
else:n=d[0]*n/d[1];d=c
return n
test.py
(shows how to drive it)
from frc import f
def test():
"""
>>> f(108, [3,2])
243
>>> f(1296, [3,2])
6561
>>> f(108, [455,33,11,13,1,11,3,7,11,2,1,3])
15625
>>> f(60466176, [455, 33,11, 13,1, 11,3, 7,11, 2,1, 3])
7888609052210118054117285652827862296732064351090230047702789306640625L
"""
pass
import doctest
doctest.testmod()

C#:
Tidy version:
using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;
namespace Test
{
class Program
{
static void Main(string[] args)
{
int ip = 1;
decimal reg = Convert.ToInt32(args[0]);
while (true)
{
if (ip+1 > args.Length)
{
break;
}
decimal curfrac = Convert.ToDecimal(args[ip]) / Convert.ToDecimal(args[ip+1]);
if ((curfrac * reg) % 1 == 0)
{
ip = 1;
reg = curfrac * reg;
}
else
{
ip += 2;
}
}
Console.WriteLine(reg);
Console.ReadKey(true);
}
}
}
Cut down version weighing in at 201 chars (without the namespace declarations or any of that, just the single using statement (not system) and the Main function):
using System;namespace T{using b=Convert;static class P{static void Main(string[] a){int i=1;var c=b.ToDecimal(a[0]);while(i+1<=a.Length){var f=b.ToDecimal(a[i])/b.ToDecimal(a[i+1]);if((f*c)%1==0){i=1;c*=f;}else{i+=2;}}Console.Write(c);}}}
Examples (input is through command line arguments):
input: 108 3 2
output: 243.00
input: 1296 3 2
output: 6561.0000
input: 108 455 33 11 13 1 11 3 7 11 2 1 3
output: 45045.000000000000000000000000

Groovy, 136 117 107 characters.
Call as groovy fractal.groovy [input state] [program vector as list of numbers]
a=args.collect{it as int}
int c=a[0]
for(i=1;i<a.size;i+=2) if(c%a[i+1]==0){c=c/a[i+1]*a[i];i=-1}
println c
Sample
bash$ groovy fractal.groovy 108 455 33 11 13 1 11 3 7 11 2 1 3
Output: 15625

Perl, 84 82 char
Uses standard input.
#P=<>=~/\d+/g;$_=<>;
($a,$%)=#P[$i++,$i++],$_*$a%$%or$i=0,$_*=$a/$%while$i<#P;
print
Takes 110 chars to pass the bonus test:
use Math'BigInt blcm;#P=<>=~/\d+/g;$_=blcm<>;
($%,$=)=#P[$i++,$i++],$_*$%%$=or$i=0,($_*=$%)/=$=while$i<#P;print

Haskell: 116 109 characters
f p x[]=x
f p x((n,d):b)|x*n`mod`d==0=f p(x*n`div`d)p|True=f p x b
main=do{p<-readLn;x<-readLn;print$f p x p}
This ended up as somewhat of a knockoff of Dario's entry.

Scheme: 326
I thought a Scheme submission was needed, for parity. I also just wanted the excuse to play with it. (Excuse my rudimentary knowledge, I'm sure this could be optimized, and I am open to suggestions!)
#lang scheme
(define fractran_interpreter
(lambda (state pc program)
(cond
((eq? pc (length program))
(print state))
((integer? (* state (list-ref program pc)))
(fractran_interpreter (* state (list-ref program pc)) 0 program))
(else
(fractran_interpreter state (+ pc 1) program)))))
Tests:
(fractran_interpreter 108 0 '(3/2))
(fractran_interpreter 60466176 0 '(455/33 11/13 1/11 3/7 11/2 1/3))
I get the bonus vector! (using Dr. Scheme, allocating 256 mb)

Lua:
Tidy code:
a=arg;
ip=2;
reg=a[1];
while a[ip] do
curfrac = a[ip] / a[ip+1];
if (curfrac * reg) % 1 == 0 then
ip=2;
reg = curfrac * reg
else
ip=ip+2
end
end
print(reg)
Compact code weighing in at 98 chars (reduction suggested by Scoregraphic on my other answer, and more suggested by gwell):
a=arg i=2 r=a[1]while a[i]do c=a[i]/a[i+1]v=c*r if v%1==0 then i=2 r=v else i=i+2 end end print(r)
Run from the command line, supplying the base number first then the series of fractions presented as numbers with space separation, like the following:
C:\Users\--------\Desktop>fractran.lua 108 3 2
243
C:\Users\--------\Desktop>fractran.lua 1296 3 2
6561
C:\Users\--------\Desktop>fractran.lua 108 455 33 11 13 1 11 3 7 11 2 1 3
15625
(manually typed some of that in because it's a pain to get stuff out of the command line, though that is the results returned)
Does NOT handle the bonus vector sadly :(

Reference implementation in Python
This implementation operates on prime factorizations.
First, it decodes a list of fraction tuples by encoding the numerator and denominator as a list of (idx, value) tuples, where idx is the number of the prime (2 is prime 0, 3 is prime 1, and so forth).
The current state is a list of exponents for each prime, by index. Executing an instruction requires first iterating over the denominator, checking if the indexed state element is at least the specified value, then, if it matches, decrementing state elements specified in the denominator, and incrementing those specified in the numerator.
This approach is about 5 times the speed of doing arithmetic operations on large integers in Python, and is a lot easier to debug!
A further optimisation is provided by constructing an array mapping each prime index (variable) to the first time it is checked for in the denominator of a fraction, then using that to construct a 'jump_map', consisting of the next instruction to execute for each instruction in the program.
def primes():
"""Generates an infinite sequence of primes using the Sieve of Erathsones."""
D = {}
q = 2
idx = 0
while True:
if q not in D:
yield idx, q
idx += 1
D[q * q] = [q]
else:
for p in D[q]:
D.setdefault(p + q, []).append(p)
del D[q]
q += 1
def factorize(num, sign = 1):
"""Factorizes a number, returning a list of (prime index, exponent) tuples."""
ret = []
for idx, p in primes():
count = 0
while num % p == 0:
num //= p
count += 1
if count > 0:
ret.append((idx, count * sign))
if num == 1:
return tuple(ret)
def decode(program):
"""Decodes a program expressed as a list of fractions by factorizing it."""
return [(factorize(n), factorize(d)) for n, d in program]
def check(state, denom):
"""Checks if the program has at least the specified exponents for each prime."""
for p, val in denom:
if state[p] < val:
return False
return True
def update_state(state, num, denom):
"""Checks the program's state and updates it according to an instruction."""
if check(state, denom):
for p, val in denom:
state[p] -= val
for p, val in num:
state[p] += val
return True
else:
return False
def format_state(state):
return dict((i, v) for i, v in enumerate(state) if v != 0)
def make_usage_map(program, maxidx):
firstref = [len(program)] * maxidx
for i, (num, denom) in enumerate(program):
for idx, value in denom:
if firstref[idx] == len(program):
firstref[idx] = i
return firstref
def make_jump_map(program, firstref):
jump_map = []
for i, (num, denom) in enumerate(program):
if num:
jump_map.append(min(min(firstref[idx] for idx, val in num), i))
else:
jump_map.append(i)
return jump_map
def fractran(program, input, debug_when=None):
"""Executes a Fractran program and returns the state at the end."""
maxidx = max(z[0] for instr in program for part in instr for z in part) + 1
state = [0]*maxidx
if isinstance(input, (int, long)):
input = factorize(input)
for prime, val in input:
state[prime] = val
firstref = make_usage_map(program, maxidx)
jump_map = make_jump_map(program, firstref)
pc = 0
length = len(program)
while pc < length:
num, denom = program[pc]
if update_state(state, num, denom):
if num:
pc = jump_map[pc]
if debug_when and debug_when(state):
print format_state(state)
else:
pc += 1
return format_state(state)

Perl 6: 77 Characters (experimental)
sub f(#p,$n is copy){
loop {my$s=first {!($n%(1/$_))},#p or return $n;$n*=$s}}
Newline is optional. Call as:
say f([3/2], 1296).Int;
say f([455/33, 11/13, 1/11, 3/7, 11/2, 1/3], 60466176).Int;
Readable version:
sub Fractran (#program, $state is copy) {
loop {
if my $instruction = first #program:
-> $inst { $state % (1 / $inst) == 0 } {
$state *= $instruction;
} else {
return $state.Int;
}
}
}
Notes:
The colon notation first #program: pointy-sub doesn't work on current implementations; first BLOCK, #program has to be used instead.
Rakudo appears to have a buggy Rat giving incorrect results. Current Niecza runs all of the test programs correctly and quickly, including the "bonus" fraction.

Haskell, 142 characters
Without any additional libraries and full I/O.
t n f=case f of{(a,b):f'->if mod n b == 0then(\r->r:(t r f))$a*n`div`b else t n f';_->[]}
main=readLn>>=(\f->readLn>>=(\n->print$last$t n f))

Java, 200 192 179 characters
I think everyone knows that Java would not have the shortest implementation, but I wanted to see how it would compare. It solves the trivial examples, but not the bonus one.
Here is the minimized version:
class F{public static void main(String[]a){long p=new Long(a[0]);for(int i=1;i<a.length;){long n=p*new Long(a[i++]),d=new Long(a[i++]);if(n%d<1){p=n/d;i=1;}}System.out.print(p);}}
java -cp . F 108 455 33 11 13 1 11 3 7 11 2 1 3
15625
java -cp . F 1296 3 2
6561
Here is the cleaned-up version:
public class Fractran {
public static void main(String[] args) {
long product = new Long(args[0]);
for (int index = 1; index < args.length;) {
long numerator = product * new Long(args[index++]);
long denominator = new Long(args[index++]);
if (numerator % denominator < 1) {
product = numerator / denominator;
index = 1;
} // if
} // for
System.out.print(product);
}
}

Scheme 73 characters
My first attempt, at doing this with completely standard R5RS Scheme, came in at 104 characters:
(define(f p n)(let l((q p)(n n))(if(null? q)n(let((a(* n(car q))))(if(integer?
a)(l p a)(l(cdr q)n))))))
Running against a few items in the test vector:
> (f '(3/2) 1296)
6561
> (f '(455/33 11/13 1/11 3/7 11/2 1/3) 60466176)
7888609052210118054117285652827862296732064351090230047702789306640625
If you assume that λ is bound to lambda and let/cc is defined (as they are in PLT Scheme; see below for definitions for running this in Schemes that don't define those), then I can adapt Jordan's second Ruby solution to Scheme, which comes out to 73 characters (note that the argument order is the reverse of my first solution, but the same as Jordan's; in this version, that saves one character).:
(define(f n p)(let/cc r(map(λ(i)(if(integer?(* n i))(r(f(* n i)p))))p)n))
If I don't have λ and let/cc predefined, then this one comes in at 111 characters (88 if the fairly common call/cc abbreviation is defined):
(define(f n p)(call-with-current-continuation(lambda(r)(map(lambda(i)(if(integer?(*
n i))(r(f(* n i)p))))p)n)))
Definitions of λ and let/cc:
(define-syntax λ
(syntax-rules ()
((_ . body) (lambda . body)))
(define-syntax let/cc
(syntax-rules ()
((_ var . body) (call-with-current-continuation (lambda (var) . body)))))

A bit late... dc 84 chars
Just for fun a dc solution (OpenBSD)
[ss1sp]s1[Rlp1+sp]s2?l1xz2/sz[z2/ds_:bl_:az0<L]dsLx
1[;als*lp;b~0=1e2lpdlz!<L]dsLxlsp
It handles all the cases:
$ dc fractran.dc
455 33 11 13 1 11 3 7 11 2 1 3 60466176
7888609052210118054117285652827862296732064351090230047702789306640625

I can't leave comments yet but here's a "slightly" shorter version of RCIX's C# version (i believe it's 7 chars shorter)
using System;namespace T{static class P{static void Main(string[] a){int i=1;Func<string,decimal> d=Convert.ToDecimal;var c=d(a[0]);while(i+1<=a.Length){var f=d(a[i])/d(a[++i]);if((f*c)%1==0){i=1;c*=f;}else i++;}Console.Write(c);}}}
which uses
Func<string,decimal> d=Convert.ToDecimal
and calls d(); instead of
using b=Convert;
and repeatedly calling b.ToDecimal();.
I also removed an unnecessary pair of curly braces around the else statement to gain 1 char :).
I also replaced the a[i+1] with a[++i] and in the following else body i replaced i+=2 with i++ to gain another char :P

Related

How to map lottery permutations without repeat to an unique id?

I store a tip of a lottery field of 49 fields with 6 numbers in a bit string like this:
"1011000001010000000000100000000000000000000000000" which represents the numbers 1 3 4 10 12 23.
I've been trying to find the mapping for hours. I know there is one, but I can't find it. It seems so simple.
Is there anyone here who can help me?
In case of 6 out of 49 there are 13.983.816 possibilities.
So:
1111110000000000000000000000000000000000000000000 = 1
1111101000000000000000000000000000000000000000000 = 2
.
.
.
0000000000000000000000000000000000000000000111111 = 13.983.816
To get your number from a list of input values, perform the following
value := 0
for i from 0..5:
value := value + 2 ** (49 - list[i])
-where ** denotes exponentiation.
Unpacking can be accomplished by either iterating over the bitstring collecting the indices of set bits, or from taking the floored log base 2 of the value and removing the leading '1' repeatedly:
for i from 0..5
list[i] := 49 - floor(log2(value))
value := value - 2 ** (49 - list[i])
However, you can do much better in terms of compression / packing. For an equally fast (probably faster) to unpack format, consider converting each number to a 6-bit bitstring, and then concatenating the results. This gives us 36 digits instead of the 49 required by your solution. Implementation:
value := 0
for i from 0..5
value := (value << 6) + list[i]
Unpacking is very efficient in this case, as you just mask off all but the last 6 bits with an & 0x3f and then a right bitshift >> 6 repeatedly.
for i from 5..0
list[i] := value & 0x3f
value := value >> 6
While more efficient, we can still do a bit better, at a slight cost of speed. If we instead represent these values as a single base-49 number, we avoid wasting any bits at all.
value := 0
for i from 0..5
value := value * 49 + list[i]
However unpacking is a bit more expensive
for i from 5..0
list[i] := value % 49
value := floor(value / 49)
This approach requires 34 bits, rather than the previous 36.
Here is an alternative approach based on the math.stackexchange links provided in the comments section. This method takes advantage of the fact that we are storing combinations, not permutations, so we can eliminate redundant representations of the same tuple. In fact, this approach brings the compression down to a mere 24 bits.
I wrote this algorithm out in Python rather than psuedo-code because I did not feel confident in giving you an algorithm this finicky without running it first. I also spent some time optimizing this solution (without sacrificing readability), so it will still handle large volumes of inputs fairly well if need be. However, if it does become a bottleneck you can always consider one of the simpler and cheaper alternatives in my original answer.
from functools import reduce
from math import factorial
def ncr(n, r):
if r > n: return 0
r = min(r, n-r)
result = reduce(int.__mul__, range(n, n-r, -1), 1)
return result // factorial(r)
def encode(numbers):
return sum(ncr(x, i) for i, x in enumerate(numbers, 1))
def decode(value, n=50, r=6, y=ncr(50,6)):
if not n: return (0,) if r else tuple()
if y <= value:
return decode(value - y, n - 1, r - 1, y * r // n) + (n,)
return decode(value, n - 1, r, y * (n - r) // n)
Do note however, that I use the range [0, 49), so you may need to offset everything by one if you plan to use 1-based indexing like your post shows.
To test it-
from itertools import combinations
def test_all():
numbers = list(range(0,49))
for comb in combinations(numbers, 6):
if comb != decode(encode(comb)):
print("error", comb, encode(comb), decode(encode(comb)))

More elegant way to convert 4 bytes to 32bit integer

I'm converting arrays consisting of four byte values to 32bit numbers by executing the following code:
a = [0, 16, 82, 0]
i = a.map { |e| "%02x" % e }.join.to_i(16)
# => 1069568
It works as intended, but I wonder if there's a more elegant way to perform this task. Maybe not utilizing strings.
Using pack and unpack1:
a = [0, 16, 82, 0]
a.pack('C4').unpack1('L>')
#=> 1069568
C4 means 8-bit unsigned (4 times) and L> means 32-bit unsigned (big endian).
However, pack returns a binary string, so this is not string-free.
If you have one byte, that would be the result as is. If you add one byte to the right side, that would make the original result move two positions to the left (which means multiplying by 0x100, or 16 ** 2 = 256), and add the new byte. You can repeat this as many times as there are bytes.
a.inject{|acc, byte| acc * 0x100 + byte}
# => 1069568

Why does 0 return on this ruby base conversion method

as part of a ruby challenge, I'm making a custom method num_to_s(num,base) which takes a number and base, and returns a string with the new base.
The question gave me the hint that you can find the value of each digit by this operation --
(123 / 10**0) % 10 == 3 # ones place
(123 / 10**1) % 10 == 2 # tens place
(123 / 10**2) % 10 == 1 # hundreds place
So, I created the following function --
def num_to_s(num, base)
values = ["0", "1", "2","3","4","5","6","7","8","9","a","b","c","d","e","f"]
answer_array = []
highest_power = 0
#find the highest power
while base**highest_power <= num
highest_power+=1
end
current_power = 0
#run a loop to find the values for base**0 to the highest power
while current_power <= highest_power
digit = values[ ((num / base**current_power) % base) ]
answer_array << digit
current_power +=1
end
answer_array.reverse.join
end
num_to_s(4,2)
num_to_s(20,16)
When I run this function, everything works great, except sometimes the answer is prefixed by 0. If I were to remove the 0 though, the answer would be correct.
Just out of curiuosity, why does the 0 show up in the method?
Example --
num_to_s(5,2) #=> 0101
While the actual answer is 101
while current_power <= highest_power
this is the problem. You look for the first power of the base higher than num, that means you don't have to consider such power: in your example, highest_power is 3, that means, if you allow current_power to be equal to it, you get 4 iterations {0,1,2,3}, while you only need 3, namely {0,1,2}.
Replace it with
while current_power < highest_power
and you should be fine. The strange part is that you say "sometime" you get a 0, while, in theory, you should get it every single time.
You may be interested in this solution. It uses a constant array Symbols to avoid reassigning the array values every time the method is called. It also makes use of Numeric#divmod, which returns the quotient and the remainder of a division in one operation.
Symbols = ('0' .. '9').to_a + ('a' .. 'z').to_a
def num_to_s(num, base)
ret = ''
while num > 0 or ret == ''
num, digit = num.divmod(base)
ret = Symbols[digit] + ret
end
ret
end
puts num_to_s(4, 2)
puts num_to_s(20, 16)
puts num_to_s(255, 8)
puts num_to_s(44_027, 36)
output
100
14
377
xyz

An algorithm for converting a base-10 number to a base-N number

I am looking for a way to convert a base-10 number into a base-N number where N can be large. Specifically i am looking at converting to base-85 and back again. Does anyone know a simple algorithm to perform the conversion? Ideally it would provide something like:
to_radix(83992, 85) -> [11, 53, 12]
Any ideas are appreciated!
Roja
That was kind of an interesting question, so I went a little overboard:
class Integer
def to_base(base=10)
return [0] if zero?
raise ArgumentError, 'base must be greater than zero' unless base > 0
num = abs
return [1] * num if base == 1
[].tap do |digits|
while num > 0
digits.unshift num % base
num /= base
end
end
end
end
This works for arbitrary bases. It only works for integers, although there is no reason why it couldn't be extended to work with any arbitrary number. Also, it ignores the sign of the number. Again, there is no reason why it must do that, but mainly I didn't want to have to come up with a convention for returning the sign in the return value.
class Integer
old_to_s = instance_method(:to_s)
define_method :to_s do |base=10, mapping=nil, sep=''|
return old_to_s.bind(self).(base) unless mapping || base > 36
mapping ||= '0123456789abcdefghijklmnopqrstuvwxyz'
return to_base(base).map {|digit| mapping[digit].to_s }.join(sep)
end
end
[Fixnum, Bignum].each do |klass|
old_to_s = klass.instance_method(:to_s)
klass.send :define_method, :to_s do |base=10, mapping=nil, sep=''|
return old_to_s.bind(self).(base) unless mapping || base > 36
return super(base, mapping, sep) if mapping
return super(base)
end
end
I also extended the to_s method so that it works with bases greater than 36. If you want to use a base greater than 36, you have to pass in a mapping object which maps the "digits" to strings. (Well, actually, all that is required is that you provide an object that responds to [] and returns something which responds to to_s. So, a string is perfect, but e.g. an array of integers also works.)
It also accepts an optional separator, which is used to separate the digits.
For example, this allows you to format an IPv4 address by treating it as a base-256 number and using the identity for the mapping and '.' as the separator:
2_078_934_278.to_s(256, Array.new(256) {|i| i }, '.') # => '123.234.5.6'
Here's an (incomplete) testsuite:
require 'test/unit'
class TestBaseConversion < Test::Unit::TestCase
def test_that_83992_in_base_85_is_11_53_12
assert_equal [11, 53, 12], 83992.to_base(85)
end
def test_that_83992_in_base_37_is_1_24_13_2
assert_equal [1, 24, 13, 2], 83992.to_base(37)
end
def test_that_84026_in_base_37_is_1_24_13_36
assert_equal [1, 24, 13, 36], 84026.to_base(37)
end
def test_that_0_in_any_base_is_0
100.times do |base|
assert_equal [0], 0.to_base(base)
assert_equal [0], 0.to_base(1 << base)
assert_equal [0], 0.to_base(base << base)
end
end
def test_that_84026_in_base_37_prints_1od_
assert_equal '1od_', 84026.to_s(37, '0123456789abcdefghijklmnopqrstuvwxyz_')
end
def test_that_ip_address_formatting_works
addr = 2_078_934_278
assert_equal '123.234.5.6', addr.to_s(256, (0..255).to_a, '.')
assert_equal '123.234.5.6', addr.to_s(256, Array.new(256) {|i| i}, '.')
end
def test_that_old_to_s_still_works
assert_equal '84026', 84026.to_s
assert_equal '1su2', 84026.to_s(36)
end
end
The pseudocode for this is fairly straightforward. To base 85 from unsigned integers:
digits := '';
while (number > 0)
digit := number % 85
digits := base85Digit(digit) + digits
number /= 85 // integer division so the remainder is rounded off
end while
And to base 10:
mult := 1
result := 0
for each digit in digits // starting from the rightmost working left
result += base10(digit) * mult
mult *= 85
end for
Just a general pseudocode algorithm:
initialize empty list
take current number mod base, store result at front of list
divide current number by base and floor it (integer division does this perfectly)
if result is still greater than zero, repeat at #2
83992 / 85 = 988, reminder 12
988 / 85 = 11, reminder 53
11 / 85 = 0, reminder 11
write the reminder in reverse order: 11, 53, 12 to get your base-85 number.
To get it back:
11 * 85^2 + 53 * 85^1 + 12 * 85^0 = 83992
The simplest algorithm that I can think of is (in pseudo-code):
N = base-10 number
1) N mod 85 = 1st number
2) tempVal = floor(N/85)
3) if(tempVal > 0 && tempVal < 85) then
tempVal= 2nd number
else
2nd number = (tempVal mod 85), then goto step (2), replacing N with N1
Base 85 is particularly useful for ASCII encoding of binary data, which I presume is what you're using it for. (However, if this is why you should ask yourself whether it's really worth the extra hassle and whether Base 64 won't be good enough.)
If you're using this as an encoding scheme, your job is going to be to convert integers (4 bytes) into groups of 5 base85 numbers. (How you deal with things that are not multiples of 4 bytes is up to you--usually the end is padded with zeros. See the Wikipedia page on Base 85 for details.)
The basic algorithm is quite simple: take the remainder on division of 85 when packing into base 85, then divide and repeat, until you're done. To go back again, repeatedly add the value and multiply by 85 until you're done. I'm not terribly familiar with Ruby, so the code here is a C/C++/Javaish style, which hopefully you can interpret:
// To base 85
unsigned int n = // your number
byte b85[5]; // What you want to fill
for (int i=0 ; i<5 ; i++) {
b85[4-i] = (n%85); // Fill backwards to get most significant value at front
n = n/85;
}
// From base 85
n = 0;
for (int i=0 ; i< 5 ; i++) {
n = n*85 + b85[i];
}
This is without worrying about overflow, without worrying about adding 33 to get into ASCII range, and without worrying about the convention that zero is encoded as z not !!!!!, and so on.
because I feel recursion is under-represented in the answers I give the following rough draft
def to_radix(int, radix)
int == 0 ? [] : (to_radix(int / radix, radix) + [int % radix])
end
Fixnum#to_s won't help you, as it only goes up to base 36.
I'm surprised that you're going up to base 85. Can you explain how radixs work?

Code Golf: Leibniz formula for Pi

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 recently posted one of my favourite interview whiteboard coding questions in "What's your more controversial programming opinion", which is to write a function that computes Pi using the Leibniz formula.
It can be approached in a number of different ways, and the exit condition takes a bit of thought, so I thought it might make an interesting code golf question. Shortest code wins!
Given that Pi can be estimated using the function 4 * (1 - 1/3 + 1/5 - 1/7 + ...) with more terms giving greater accuracy, write a function that calculates Pi to within 0.00001.
Edit: 3 Jan 2008
As suggested in the comments I changed the exit condition to be within 0.00001 as that's what I really meant (an accuracy 5 decimal places is much harder due to rounding and so I wouldn't want to ask that in an interview, whereas within 0.00001 is an easier to understand and implement exit condition).
Also, to answer the comments, I guess my intention was that the solution should compute the number of iterations, or check when it had done enough, but there's nothing to prevent you from pre-computing the number of iterations and using that number. I really asked the question out of interest to see what people would come up with.
J, 14 chars
4*-/%>:+:i.1e6
Explanation
1e6 is number 1 followed by 6 zeroes (1000000).
i.y generates the first y non negative numbers.
+: is a function that doubles each element in the list argument.
>: is a function that increments by one each element in the list argument.
So, the expression >:+:i.1e6 generates the first one million odd numbers:
1 3 5 7 ...
% is the reciprocal operator (numerator "1" can be omitted).
-/ does an alternate sum of each element in the list argument.
So, the expression -/%>:+:i.1e6 generates the alternate sum of the reciprocals of the first one million odd numbers:
1 - 1/3 + 1/5 - 1/7 + ...
4* is multiplication by four. If you multiply by four the previous sum, you have π.
That's it! J is a powerful language for mathematics.
Edit: since generating 9! (362880) terms for the alternate sum is sufficient to have 5 decimal digit accuracy, and since the Leibniz formula can be written also this way:
4 - 4/3 + 4/5 - 4/7 + ...
...you can write a shorter, 12 chars version of the program:
-/4%>:+:i.9!
Language: Brainfuck, Char count: 51/59
Does this count? =]
Because there are no floating-point numbers in Brainfuck, it was pretty difficult to get the divisions working properly. Grr.
Without newline (51):
+++++++[>+++++++<-]>++.-----.+++.+++.---.++++.++++.
With newline (59):
+++++++[>+++++++>+<<-]>++.-----.+++.+++.---.++++.++++.>+++.
Perl
26 chars
26 just the function, 27 to compute, 31 to print. From the comments to this answer.
sub _{$-++<1e6&&4/$-++-&_} # just the sub
sub _{$-++<1e6&&4/$-++-&_}_ # compute
sub _{$-++<1e6&&4/$-++-&_}say _ # print
28 chars
28 just computing, 34 to print. From the comments. Note that this version cannot use 'say'.
$.=.5;$\=2/$.++-$\for 1..1e6 # no print
$.=.5;$\=2/$.++-$\for$...1e6;print # do print, with bonus obfuscation
36 chars
36 just computing, 42 to print. Hudson's take at dreeves's rearrangement, from the comments.
$/++;$\+=8/$//($/+2),$/+=4for$/..1e6
$/++;$\+=8/$//($/+2),$/+=4for$/..1e6;print
About the iteration count: as far as my math memories go, 400000 is provably enough to be accurate to 0.00001. But a million (or as low as 8e5) actually makes the decimal expansion actually match 5 fractional places, and it's the same character count so I kept that.
Ruby, 33 characters
(0..1e6).inject{|a,b|2/(0.5-b)-a}
Another C# version:
(60 characters)
4*Enumerable.Range(0, 500000).Sum(x => Math.Pow(-1, x)/(2*x + 1)); // = 3,14159
52 chars in Python:
print 4*sum(((-1.)**i/(2*i+1)for i in xrange(5**8)))
(51 dropping the 'x' from xrange.)
36 chars in Octave (or Matlab):
l=0:5^8;disp((-1).^l*(4./(2.*l+1))')
(execute "format long;" to show all the significant digits.) Omitting 'disp' we reach 30 chars:
octave:5> l=0:5^8;(-1).^l*(4./(2.*l+1))'
ans = 3.14159009359631
Oracle SQL 73 chars
select -4*sum(power(-1,level)/(level*2-1)) from dual connect by level<1e6
Language: C, Char count: 71
float p;main(i){for(i=1;1E6/i>5;i+=2)p-=(i%4-2)*4./i;printf("%g\n",p);}
Language: C99, Char count: 97 (including required newline)
#include <stdio.h>
float p;int main(){for(int i=1;1E6/i>5;i+=2)p-=(i%4-2)*4./i;printf("%g\n",p);}
I should note that the above versions (which are the same) keep track of whether an extra iteration would affect the result at all. Thus, it performs a minimum number of operations. To add more digits, replace 1E6 with 1E(num_digits+1) or 4E5 with 4E(num_digits) (depending on the version). For the full programs, %g may need to be replaced. float may need to be changed to double as well.
Language: C, Char count: 67 (see notes)
double p,i=1;main(){for(;i<1E6;i+=4)p+=8/i/(i+2);printf("%g\n",p);}
This version uses a modified version of posted algorithm, as used by some other answers. Also, it is not as clean/efficient as the first two solutions, as it forces 100 000 iterations instead of detecting when iterations become meaningless.
Language: C, Char count: 24 (cheating)
main(){puts("3.14159");}
Doesn't work with digit counts > 6, though.
Haskell
I got it down to 34 characters:
foldl subtract 4$map(4/)[3,5..9^6]
This expression yields 3.141596416935556 when evaluated.
Edit: here's a somewhat shorter version (at 33 characters) that uses foldl1 instead of foldl:
foldl1 subtract$map(4/)[1,3..9^6]
Edit 2: 9^6 instead of 10^6. One has to be economical ;)
Edit 3: Replaced with foldl' and foldl1' with foldl and foldl1 respectively—as a result of Edit 2, it no longer overflows. Thanks to ShreevatsaR for noticing this.
23 chars in MATLAB:
a=1e6;sum(4./(1-a:4:a))
F#:
Attempt #1:
let pi = 3.14159
Cheating? No, its winning with style!
Attempt #2:
let pi =
seq { 0 .. 100 }
|> Seq.map (fun x -> float x)
|> Seq.fold (fun x y -> x + (Math.Pow(-1.0, y)/(2.0 * y + 1.0))) 0.0
|> (fun x -> x * 4.0)
Its not as compact as it could possibly get, but pretty idiomatic F#.
common lisp, 55 chars.
(loop for i from 1 upto 4e5 by 4 sum (/ 8d0 i (+ i 2)))
Mathematica, 27 chars (arguably as low as 26, or as high as 33)
NSum[8/i/(i+2),{i,1,9^9,4}]
If you remove the initial "N" then it returns the answer as a (huge) fraction.
If it's cheating that Mathematica doesn't need a print statement to output its result then prepend "Print#" for a total of 33 chars.
NB:
If it's cheating to hardcode the number of terms, then I don't think any answer has yet gotten this right. Checking when the current term is below some threshold is no better than hardcoding the number of terms. Just because the current term is only changing the 6th or 7th digit doesn't mean that the sum of enough subsequent terms won't change the 5th digit.
Using the formula for the error term in an alternating series (and thus the necessary number of iterations to achieve the desired accuracy is not hard coded into the program):
public static void Main(string[] args) {
double tolerance = 0.000001;
double piApproximation = LeibnizPi(tolerance);
Console.WriteLine(piApproximation);
}
private static double LeibnizPi(double tolerance) {
double quarterPiApproximation = 0;
int index = 1;
double term;
int sign = 1;
do {
term = 1.0 / (2 * index - 1);
quarterPiApproximation += ((double)sign) * term;
index++;
sign = -sign;
} while (term > tolerance);
return 4 * quarterPiApproximation;
}
C#:
public static double Pi()
{
double pi = 0;
double sign = 1;
for (int i = 1; i < 500002; i += 2)
{
pi += sign / i;
sign = -sign;
}
return 4 * pi;
}
Perl :
$i+=($_&1?4:-4)/($_*2-1)for 1..1e6;print$i
for a total of 42 chars.
Ruby, 41 chars (using irb):
s=0;(3..3e6).step(4){|i|s+=8.0/i/(i-2)};s
Or this slightly longer, non-irb version:
s=0;(3..3e6).step(4){|i|s+=8.0/i/(i-2)};p s
This is a modified Leibniz:
Combine pairs of terms. This gives you 2/3 + 2/35 + 2/99 + ...
Pi becomes 8 * (1/(1 * 3) + 1/(5 * 7) + 1/(9 * 11) + ...)
F# (Interactive Mode) (59 Chars)
{0.0..1E6}|>Seq.fold(fun a x->a+ -1.**x/(2.*x+1.))0.|>(*)4.
(Yields a warning but omits the casts)
Here's a solution in MUMPS.
pi(N)
N X,I
S X=1 F I=3:4:N-2 S X=X-(1/I)+(1/(I+2))
Q 4*X
Parameter N indicates how many repeated fractions to use. That is, if you pass in 5 it will evaluate 4 * (1 - 1/3 + 1/5 - 1/7 + 1/9 - 1/11)
Some empirical testing showed that N=272241 is the lowest value that gives a correct value of 3.14159 when truncated to 5 decimal points. You have to go to N=852365 to get a value that rounds to 3.14159.
C# using iterator block:
static IEnumerable<double> Pi()
{
double i = 4, j = 1, k = 4;
for (;;)
{
yield return k;
k += (i *= -1) / (j += 2);
}
}
For the record, this Scheme implementation has 95 characters ignoring unnecessary whitespace.
(define (f)
(define (p a b)
(if (> a b)
0
(+ (/ 1.0 (* a (+ a 2))) (p (+ a 4) b))))
(* 8 (p 1 1e6)))
Javascript:
a=0,b=-1,d=-4,c=1e6;while(c--)a+=(d=-d)/(b+=2)
In javascript. 51 characters. Obviously not going to win but eh. :P
Edit -- updated to be 46 characters now, thanks to Strager. :)
UPDATE (March 30 2010)
A faster (precise only to 5 decimal places) 43 character version by David Murdoch
for(a=0,b=1,d=4,c=~4e5;++c;d=-d)a-=d/(b-=2)
Here's a recursive answer using C#. It will only work using the x64 JIT in Release mode because that's the only JIT that applies tail-call optimisation, and as the series converges so slowly it will result in a StackOverflowException without it.
It would be nice to have the IteratePi function as an anonymous lambda, but as it's self-recursive we'd have to start doing all manner of horrible things with Y-combinators so I've left it as a separate function.
public static double CalculatePi()
{
return IteratePi(0.0, 1.0, true);
}
private static double IteratePi(double result, double denom, bool add)
{
var term = 4.0 / denom;
if (term < 0.00001) return result;
var next = add ? result + term : result - term;
return IteratePi(next, denom + 2.0, !add);
}
Most of the current answers assume that they'll get 5 digits accuracy within some number of iterations and this number is hardcoded into the program. My understanding of the question was that the program itself is supposed to figure out when it's got an answer accurate to 5 digits and stop there. On that assumption here's my C# solution. I haven't bothered to minimise the number of characters since there's no way it can compete with some of the answers already out there, so I thought I'd make it readable instead. :)
private static double GetPi()
{
double acc = 1, sign = -1, lastCheck = 0;
for (double div = 3; ; div += 2, sign *= -1)
{
acc += sign / div;
double currPi = acc * 4;
double currCheck = Math.Round(currPi, 5);
if (currCheck == lastCheck)
return currPi;
lastCheck = currCheck;
}
}
Language: C99 (implicit return 0), Char count: 99 (95 + 4 required spaces)
exit condition depends on current value, not on a fixed count
#include <stdio.h>
float p, s=4, d=1;
int main(void) {
for (; 4/d > 1E-5; d += 2)
p -= (s = -s) / d;
printf("%g\n", p);
}
compacted version
#include<stdio.h>
float
p,s=4,d=1;int
main(void){for(;4/d>1E-5;d+=2)p-=(s=-s)/d;printf("%g\n",p);}
Language: dc, Char count: 35
dc -e '9k0 1[d4r/r2+sar-lad274899>b]dsbxrp'
Ruby:
irb(main):031:0> 4*(1..10000).inject {|s,x| s+(-1)**(x+1)*1.0/(2*x-1)}
=> 3.14149265359003
64 chars in AWK:
~# awk 'BEGIN {p=1;for(i=3;i<10^6;i+=4){p=p-1/i+1/(i+2)}print p*4}'
3.14159
C# cheating - 50 chars:
static single Pi(){
return Math.Round(Math.PI, 5));
}
It only says "taking into account the formula write a function..." it doesn't say reproduce the formula programmatically :) Think outside the box...
C# LINQ - 78 chars:
static double pi = 4 * Enumerable.Range(0, 1000000)
.Sum(n => Math.Pow(-1, n) / (2 * n + 1));
C# Alternate LINQ - 94 chars:
static double pi = return 4 * (from n in Enumerable.Range(0, 1000000)
select Math.Pow(-1, n) / (2 * n + 1)).Sum();
And finally - this takes the previously mentioned algorithm and condenses it mathematically so you don't have to worry about keep changing signs.
C# longhand - 89 chars (not counting unrequired spaces):
static double pi()
{
var t = 0D;
for (int n = 0; n < 1e6; t += Math.Pow(-1, n) / (2 * n + 1), n++) ;
return 4 * t;
}
#!/usr/bin/env python
from math import *
denom = 1.0
imm = 0.0
sgn = 1
it = 0
for i in xrange(0, int(1e6)):
imm += (sgn*1/denom)
denom += 2
sgn *= -1
print str(4*imm)

Resources