Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Merge branch 'master' of github.com:clojure/test.benchmark into regexdna

  • Loading branch information...
commit 439e2794506b2f6fef2ff4bb48a1e74c9c45c4ba 2 parents 7ea4296 + 74aafa4
Paul Bauer authored February 13, 2012
2  README.markdown
Source Rendered
@@ -51,7 +51,7 @@ There are a number of completed benchmarks, but there is a lot more left to do.
51 51
 Andy Fingerhut has a suit of benchmarks tailored for Clojure 1.2 and need updated or redone for Clojure 1.3 (https://github.com/jafingerhut/clojure-benchmarks).
52 52
 
53 53
 A good general approach is to examine the fastest alioth implementations, usually Java or C, and write a Clojure port.
54  
-Idiomatic Clojure typically shows poorly in the benchmarks. Liberal use of primitive arrays, type hinting, and iteration apply.
  54
+Fast small programs in any language are also worthy of examination. These benchmarks should demonstrate how to write idiomatic high-performance Clojure.
55 55
 
56 56
 Long term goal is a performance regression test suit ...
57 57
 
169  src/main/clojure/alioth/nbody.clj
... ...
@@ -0,0 +1,169 @@
  1
+;   Copyright (c) Rich Hickey and contributors.
  2
+;   All rights reserved.
  3
+;   The use and distribution terms for this software are covered by the
  4
+;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
  5
+;   which can be found in the file epl-v10.html at the root of this distribution.
  6
+;   By using this software in any fashion, you are agreeing to be bound by
  7
+;   the terms of this license.
  8
+;   You must not remove this notice, or any other, from this software.
  9
+
  10
+;   Alioth benchmarks: http://shootout.alioth.debian.org/u64q/benchmark.php?test=nbody&lang=all
  11
+;   Inspired by http://shootout.alioth.debian.org/u64q/program.php?test=nbody&lang=java&id=1
  12
+
  13
+(ns alioth.nbody
  14
+  (:gen-class))
  15
+
  16
+(set! *warn-on-reflection* true)
  17
+(set! *unchecked-math* true)
  18
+
  19
+(defmacro for-loop [[binding pred adv] & body]
  20
+  `(loop [~@binding]
  21
+     (when ~pred
  22
+       ~@body
  23
+       (recur ~adv))))
  24
+
  25
+(def ^:const pi 3.141592653589793)
  26
+(def ^:const solar-mass (* 4 pi pi))
  27
+(def ^:const days-per-year 365.24)
  28
+
  29
+(defmacro defbody [& fields]
  30
+  (letfn [(setsym [f] (symbol (str "set" f "!")))
  31
+          (+=sym [f] (symbol (str "+=" f "!")))
  32
+          (-=sym [f] (symbol (str "-=" f "!")))
  33
+          (tag [f]
  34
+            (with-meta f
  35
+              {:unsynchronized-mutable true :tag 'double}))
  36
+          (getter [f]
  37
+            `(~(with-meta f {:tag 'double}) []))
  38
+          (getter-impl [f]
  39
+            `(~f [~'this] ~f))
  40
+          (setters [f]
  41
+            [`(~(setsym f) [~'this ~'n])
  42
+             `(~(+=sym f) [~'this ~'n])
  43
+             `(~(-=sym f) [~'this ~'n])])
  44
+          (setters-impl [f]
  45
+            [`(~(setsym f) [~'_ ~'n] (~'set! ~f (+ ~f (~'double ~'n))))
  46
+             `(~(+=sym f) [~'_ ~'n] (~'set! ~f (+ ~f (~'double ~'n))))
  47
+             `(~(-=sym f) [~'_ ~'n] (~'set! ~f (- ~f (~'double ~'n))))])]
  48
+    `(do
  49
+       (definterface ~'IBodyGet ~@(map getter fields))
  50
+       (defprotocol ~'IBodySet ~@(mapcat setters fields))
  51
+       (deftype ~'Body [~@(map tag fields)]
  52
+         ~'IBodyGet
  53
+         ~@(map getter-impl fields)
  54
+         ~'IBodySet
  55
+         ~@(mapcat setters-impl fields)))))
  56
+
  57
+(defbody x y z vx vy vz mass)
  58
+
  59
+(defn ^Body jupiter []
  60
+  (Body. 4.84143144246472090
  61
+         -1.16032004402742839
  62
+         -1.03622044471123109e-01
  63
+         (* 1.66007664274403694e-03 days-per-year)
  64
+         (* 7.69901118419740425e-03 days-per-year)
  65
+         (* -6.90460016972063023e-05 days-per-year)
  66
+         (* 9.54791938424326609e-04 solar-mass)))
  67
+
  68
+(defn ^Body saturn []
  69
+  (Body. 8.34336671824457987
  70
+         4.12479856412430479
  71
+         -4.03523417114321381e-01
  72
+         (* -2.76742510726862411e-03 days-per-year)
  73
+         (* 4.99852801234917238e-03 days-per-year)
  74
+         (* 2.30417297573763929e-05 days-per-year)
  75
+         (* 2.85885980666130812e-04 solar-mass)))
  76
+
  77
+(defn ^Body uranus []
  78
+  (Body. 1.28943695621391310e+01
  79
+         -1.51111514016986312e+01
  80
+         -2.23307578892655734e-01
  81
+         (* 2.96460137564761618e-03 days-per-year)
  82
+         (* 2.37847173959480950e-03 days-per-year)
  83
+         (* -2.96589568540237556e-05 days-per-year)
  84
+         (* 4.36624404335156298e-05 solar-mass)))
  85
+
  86
+(defn ^Body neptune []
  87
+  (Body. 1.53796971148509165e+01
  88
+         -2.59193146099879641e+01
  89
+         1.79258772950371181e-01
  90
+         (* 2.68067772490389322e-03 days-per-year)
  91
+         (* 1.62824170038242295e-03 days-per-year)
  92
+         (* -9.51592254519715870e-05 days-per-year)
  93
+         (* 5.15138902046611451e-05 solar-mass)))
  94
+
  95
+(defn sun []
  96
+  (Body. 0.0 0.0 0.0 0.0 0.0 0.0 solar-mass))
  97
+
  98
+(defn advance [^objects bodies ^double dt ]
  99
+  (dotimes [i (alength bodies)]
  100
+    (let [^Body ibody (aget bodies i)]
  101
+      (for-loop [(j (inc i)) (< j (alength bodies)) (inc j)]
  102
+        (let [^Body jbody (aget bodies j)
  103
+              dx (- (.x ibody) (.x jbody))
  104
+              dy (- (.y ibody) (.y jbody))
  105
+              dz (- (.z ibody) (.z jbody))
  106
+              dsq (+ (* dx dx) (* dy dy) (* dz dz))
  107
+              d (Math/sqrt dsq)
  108
+              mag (/ dt (* dsq d))
  109
+              imass (.mass ibody)
  110
+              jmass (.mass jbody)]
  111
+          (doto ibody
  112
+            (-=vx! (* dx jmass mag))
  113
+            (-=vy! (* dy jmass mag))
  114
+            (-=vz! (* dz jmass mag)))
  115
+          (doto jbody
  116
+            (+=vx! (* dx imass mag))
  117
+            (+=vy! (* dy imass mag))
  118
+            (+=vz! (* dz imass mag)))))))
  119
+  (dotimes [i (alength bodies)]
  120
+    (let [^Body body (aget bodies i)]
  121
+      (+=x! body (* dt (.vx body)))
  122
+      (+=y! body (* dt (.vy body)))
  123
+      (+=z! body (* dt (.vz body))))))
  124
+
  125
+(defn energy ^double [^objects bodies]
  126
+  (loop [i 0 e 0.0]
  127
+    (if (< i (alength bodies))
  128
+      (let [^Body ibody (aget bodies i)
  129
+            vx (.vx ibody)
  130
+            vy (.vy ibody)
  131
+            vz (.vz ibody)
  132
+            e (+ e (* 0.5 (.mass ibody)
  133
+                      (+ (* vx vx) (* vy vy) (* vz vz))))
  134
+            e (loop [j (inc i) e e]
  135
+                (if (< j (alength bodies))
  136
+                  (let [^Body jbody (aget bodies j)
  137
+                        dx (- (.x ibody) (.x jbody))
  138
+                        dy (- (.y ibody) (.y jbody))
  139
+                        dz (- (.z ibody) (.z jbody))
  140
+                        d (Math/sqrt (+ (* dx dx) (* dy dy) (* dz dz)))]
  141
+                    (recur (inc j) (- e (/ (* (.mass ibody) (.mass jbody)) d))))
  142
+                  e))]
  143
+        (recur (inc i) (double e)))
  144
+      e)))
  145
+
  146
+(defn offset-momentum [^Body body ^double px ^double py ^double pz]
  147
+  (doto body
  148
+    (setvx! (/ (- px) solar-mass))
  149
+    (setvy! (/ (- py) solar-mass))
  150
+    (setvz! (/ (- pz) solar-mass))))
  151
+
  152
+(defn nbody-system []
  153
+  (let [bodies (object-array [(sun) (jupiter) (saturn) (uranus) (neptune)])]
  154
+    (loop [i 0 px 0.0 py 0.0 pz 0.0]
  155
+      (if (< i (alength bodies))
  156
+        (let [^Body body (aget bodies i)]
  157
+          (recur (inc i)
  158
+                 (+ px (* (.vx body) (.mass body)))
  159
+                 (+ py (* (.vy body) (.mass body)))
  160
+                 (+ pz (* (.vz body) (.mass body)))))
  161
+        (offset-momentum (aget bodies 0) px py pz)))
  162
+    bodies))
  163
+
  164
+(defn -main [& args]
  165
+  (let [bodies (nbody-system)
  166
+        n (if-let [n (first args)] (Integer/parseInt n) 500000)]
  167
+    (println (format "%.9f\n" (energy bodies)))
  168
+    (dotimes [i n] (advance bodies 0.01))
  169
+    (println (format "%.9f\n" (energy bodies)))))
35  src/main/clojure/alioth/spectral_norm.clj
@@ -11,46 +11,39 @@
11 11
 ;   Inspired by http://shootout.alioth.debian.org/u64q/program.php?test=spectralnorm&lang=java&id=1
12 12
 
13 13
 (ns alioth.spectral-norm
14  
-  (:import [java.text DecimalFormat NumberFormat])
  14
+  (:import [java.text DecimalFormat])
15 15
   (:gen-class))
16 16
 
17 17
 (set! *warn-on-reflection* true)
18 18
 (set! *unchecked-math* true)
19 19
 
20  
-(defmacro for-loop [[binding pred adv] & body]
21  
-  `(loop [~@binding]
22  
-     (when ~pred
23  
-       ~@body
24  
-       (recur ~adv))))
25  
-
26 20
 (defn a ^double [^long i ^long j]
27 21
   (/ 1.0 (+ (/ (* (+ i j) (+ i j 1)) 2.0) i 1)))
28 22
 
29  
-(defn multiply-av [^long n ^doubles v ^doubles av]
30  
-  (for-loop [(i 0) (< i n) (inc i)]
  23
+(defn mul-av [^long n ^doubles v ^doubles av]
  24
+  (dotimes [i n]
31 25
     (aset av i 0.0)
32  
-    (for-loop [(j 0) (< j n) (inc j)]
  26
+    (dotimes [j n]
33 27
       (aset av i (+ (aget av i) (* (a i j) (aget v j)))))))
34 28
 
35  
-(defn multiply-atv [^long n ^doubles v ^doubles atv]
36  
-  (for-loop [(i 0) (< i n) (inc i)]
  29
+(defn mul-atv [^long n ^doubles v ^doubles atv]
  30
+  (dotimes [i n]
37 31
     (aset atv i 0.0)
38  
-    (for-loop [(j 0) (< j n) (inc j)]
  32
+    (dotimes [j n]
39 33
       (aset atv i (+ (aget atv i) (* (a j i) (aget v j)))))))
40 34
 
41  
-(defn multiply-atav [^long n ^doubles v ^doubles atav]
  35
+(defn mul-atav [^long n ^doubles v ^doubles atav]
42 36
   (let [u (double-array n)]
43  
-    (multiply-av n v u)
44  
-    (multiply-atv n u atav)))
  37
+    (mul-av n v u)
  38
+    (mul-atv n u atav)))
45 39
 
46 40
 (defn approximate ^double [^long n]
47 41
   (let [u (double-array n)
48 42
         v (double-array n)]
49  
-    (for-loop [(i 0) (< i n) (inc i)] (aset u i 1.0))
50  
-    (for-loop [(i 0) (< i n) (inc i)] (aset v i 0.0))
51  
-    (for-loop [(i 0) (< i 10) (inc i)]
52  
-      (multiply-atav n u v)
53  
-      (multiply-atav n v u))
  43
+    (dotimes [i n] (aset u i 1.0) (aset v i 0.0))
  44
+    (dotimes [i 10]
  45
+      (mul-atav n u v)
  46
+      (mul-atav n v u))
54 47
     (loop [i 0 vbv 0.0 vv 0.0]
55 48
       (if (< i n)
56 49
         (recur (inc i)

0 notes on commit 439e279

Please sign in to comment.
Something went wrong with that request. Please try again.