Chromium Code Reviews
chromiumcodereview-hr@appspot.gserviceaccount.com (chromiumcodereview-hr) | Please choose your nickname with Settings | Help | Chromium Project | Gerrit Changes | Sign out
(311)

Unified Diff: ports/gambc_ppapi/scm/pi.scm

Issue 150413008: Initial support for gambit-scheme v4.7.0 Base URL: https://chromium.googlesource.com/external/naclports.git@master
Patch Set: Add support for pnacl Created 6 years, 10 months ago
Use n/p to move between diff chunks; N/P to move between comments. Draft comments are only viewable by you.
Jump to:
View side-by-side diff with in-line comments
Download patch
« no previous file with comments | « ports/gambc_ppapi/repl_.c ('k') | ports/glibc-compat/src/getprotobyname_r.c » ('j') | no next file with comments »
Expand Comments ('e') | Collapse Comments ('c') | Show Comments Hide Comments ('s')
Index: ports/gambc_ppapi/scm/pi.scm
diff --git a/ports/gambc_ppapi/scm/pi.scm b/ports/gambc_ppapi/scm/pi.scm
new file mode 100644
index 0000000000000000000000000000000000000000..27f354f1d648a7875796bb4747f10c352451983d
--- /dev/null
+++ b/ports/gambc_ppapi/scm/pi.scm
@@ -0,0 +1,45 @@
+(define (pi num)
+ (define (pi-brent-salamin-approximate base k) ; k is number of digits
+ (define base^k (expt base k))
+ (define (fixed.+ x y)
+ (+ x y))
+
+ (define (fixed.- x y)
+ (- x y))
+
+ (define (fixed.* x y)
+ (quotient (* x y) base^k))
+
+ (define (fixed.square x)
+ (fixed.* x x))
+
+ (define (fixed./ x y)
+ (quotient (* x base^k) y))
+
+ (define (fixed.sqrt x)
+ (integer-sqrt (* x base^k)))
+
+ (define (number->fixed x)
+ (round (* x base^k)))
+
+ (define (fixed->number x)
+ (/ x base^k))
+
+ (let ((one (number->fixed 1)))
+ (let loop ((a one)
+ (b (fixed.sqrt (quotient one 2)))
+ (t (quotient one 4))
+ (x 1))
+ (if (= a b)
+ (quotient (* a a) t)
+ (let ((new-a (quotient (fixed.+ a b) 2)))
+ (loop new-a
+ (integer-sqrt (* a b))
+ (fixed.- t (* x (fixed.square (fixed.- new-a a))))
+ (* 2 x)))))))
+
+ (define (pi-brent-salamin base k) ; k is number of digits
+ (let ((n (ceiling (inexact->exact (+ 2 (log k))))))
+ (quotient (pi-brent-salamin-approximate base (+ k n)) (expt base n))))
+
+ (pi-brent-salamin-approximate 10 num))
« no previous file with comments | « ports/gambc_ppapi/repl_.c ('k') | ports/glibc-compat/src/getprotobyname_r.c » ('j') | no next file with comments »

Powered by Google App Engine
This is Rietveld 408576698