Digits of π
In celebration of Pi Day, here is an AppleScript I wrote that outputs the digits of π until the machine runs out of memory and crashes horribly.
(*
From the paper "An Unbounded Spigot Algorithm for the Digits of Pi"
http://web.comlab.ox.ac.uk/oucl/work/jeremy.gibbons/publications/spigot.pdf
*)
property MINUS : -1
property PLUS : 1
set q to {1}
set r to {0}
set t to {1}
set k to {1}
repeat
set n to divide(add(multiply({3}, q), r), t)
if compare(divide(add(multiply({4}, q), r), t), n) = 0 then
log n
set q to multiply({1, 0}, q)
set r to multiply({1, 0}, subtract(r, multiply(n, t)))
else
set r to add(multiply(q, add(multiply({4}, k), {2})), ¬
multiply(r, add(multiply({2}, k), {1})))
set q to multiply(q, k)
set t to multiply(t, add(multiply({2}, k), {1}))
set k to add(k, {1})
end if
end repeat
on divide(a, b)
set c to {}
if (count of a) = 1 then
if item 1 of a = 0 then
return {0}
end if
end if
if (count of b) = 1 then
if item 1 of b = 0 then
return c
else if item 1 of b = 1 then
return a
end if
end if
if item 1 of a < 0 then
set a_signbit to MINUS
else
set a_signbit to PLUS
end if
if item 1 of b < 0 then
set b_signbit to MINUS
else
set b_signbit to PLUS
end if
set item 1 of a to (item 1 of a) * a_signbit
set item 1 of b to (item 1 of b) * b_signbit
set row to {}
repeat with i from 1 to count of a
set the end of row to item i of a
set row to trim_zeros(row)
set n to 0
repeat while compare(row, b) ≠ PLUS
set n to n + 1
set row to subtract(row, b)
end repeat
set the end of c to n
end repeat
set item 1 of a to (item 1 of a) * a_signbit
set item 1 of b to (item 1 of b) * b_signbit
set c to trim_zeros(c)
set item 1 of c to (item 1 of c) * a_signbit * b_signbit
return c
end divide
on multiply(a, b)
set c to {0}
if (count of a) = 1 then
if item 1 of a = 0 then
return c
else if item 1 of a = 1 then
return b
end if
end if
if (count of b) = 1 then
if item 1 of b = 0 then
return c
else if item 1 of b = 1 then
return a
end if
end if
if item 1 of a < 0 then
set a_signbit to MINUS
else
set a_signbit to PLUS
end if
if item 1 of b < 0 then
set b_signbit to MINUS
else
set b_signbit to PLUS
end if
set item 1 of a to (item 1 of a) * a_signbit
set item 1 of b to (item 1 of b) * b_signbit
copy a to t --fast but uses more memory
set b_count to count of b
repeat with i from b_count to 1 by -1
repeat (item i of b) times
set c to add(c, t)
end repeat
set t to shift(t, 1)
end repeat
set item 1 of a to (item 1 of a) * a_signbit
set item 1 of b to (item 1 of b) * b_signbit
set item 1 of c to (item 1 of c) * a_signbit * b_signbit
set c to trim_zeros(c)
return c
end multiply
on shift(n, d)
repeat d times
set the end of n to 0
end repeat
return n
end shift
on subtract(a, b)
set c to {}
if item 1 of a < 0 then
set a_signbit to MINUS
else
set a_signbit to PLUS
end if
if item 1 of b < 0 then
set b_signbit to MINUS
else
set b_signbit to PLUS
end if
if a_signbit = MINUS or b_signbit = MINUS then
set item 1 of b to (item 1 of b) * MINUS
set c to add(a, b)
set item 1 of b to (item 1 of b) * MINUS
else if compare(a, b) = PLUS then
set c to subtract(b, a)
if item 1 of c > 0 then set item 1 of c to (item 1 of c) * MINUS
else
set borrow to 0
set v to 0
set a_count to count of a
set b_count to count of b
set i to a_count
set j to b_count
repeat while i > 0 and j > 0
set v to (item i of a) - borrow - (item j of b)
if item i of a > 0 then set borrow to 0
if v < 0 then
set v to v + 10
set borrow to 1
end if
set the beginning of c to v mod 10
set i to i - 1
set j to j - 1
end repeat
repeat while i > 0
set v to (item i of a) - borrow
if item i of a > 0 then set borrow to 0
if v < 0 then
set v to v + 10
set borrow to 1
end if
set the beginning of c to v mod 10
set i to i - 1
end repeat
end if
return trim_zeros(c)
end subtract
on trim_zeros(a)
set a_count to count of a
set i to 1
repeat while i ≤ a_count
if item i of a ≠ 0 then exit repeat
set i to i + 1
end repeat
if i ≤ a_count then
set a to items i thru -1 of a
else
set a to {0}
end if
return a
end trim_zeros
on add(a, b)
set c to {}
if item 1 of a < 0 then
set a_signbit to MINUS
else
set a_signbit to PLUS
end if
if item 1 of b < 0 then
set b_signbit to MINUS
else
set b_signbit to PLUS
end if
if a_signbit ≠ b_signbit then
if a_signbit = MINUS then
set item 1 of a to (item 1 of a) * a_signbit
set c to subtract(b, a)
set item 1 of a to (item 1 of a) * a_signbit
else
set item 1 of b to (item 1 of b) * b_signbit
set c to subtract(a, b)
set item 1 of b to (item 1 of b) * b_signbit
end if
else
set carry to 0
set a_count to count of a
set b_count to count of b
set i to a_count
set j to b_count
set item 1 of a to (item 1 of a) * a_signbit
set item 1 of b to (item 1 of b) * b_signbit
repeat while i > 0 and j > 0
set n to (carry + (item i of a) + (item j of b))
set the beginning of c to n mod 10
if n < 10 then
set carry to 0
else
set carry to 1
end if
set i to i - 1
set j to j - 1
end repeat
repeat while i > 0
set n to (carry + (item i of a))
set the beginning of c to n mod 10
if n < 10 then
set carry to 0
else
set carry to 1
end if
set i to i - 1
end repeat
repeat while j > 0
set n to (carry + (item j of b))
set the beginning of c to n mod 10
if n < 10 then
set carry to 0
else
set carry to 1
end if
set j to j - 1
end repeat
set item 1 of a to (item 1 of a) * a_signbit
set item 1 of b to (item 1 of b) * b_signbit
if carry > 0 then set the beginning of c to carry
set item 1 of c to (item 1 of c) * a_signbit
end if
return c
end add
on compare(a, b)
if item 1 of a < 0 then
set a_signbit to MINUS
else
set a_signbit to PLUS
end if
if item 1 of b < 0 then
set b_signbit to MINUS
else
set b_signbit to PLUS
end if
if a_signbit = MINUS and b_signbit = PLUS then return PLUS
if a_signbit = PLUS and b_signbit = MINUS then return MINUS
set a_count to count of a
set b_count to count of b
if b_count > a_count then return PLUS * a_signbit
if a_count > b_count then return MINUS * a_signbit
set r to 0
set item 1 of a to (item 1 of a) * a_signbit
set item 1 of b to (item 1 of b) * b_signbit
repeat with i from 1 to a_count
if item i of a > item i of b then
set r to MINUS * a_signbit
exit repeat
end if
if item i of b > item i of a then
set r to PLUS * a_signbit
exit repeat
end if
end repeat
set item 1 of a to (item 1 of a) * a_signbit
set item 1 of b to (item 1 of b) * b_signbit
return r
end compare