Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Alioth binary-trees

  • Loading branch information...
commit 868b392c14f0d862f1c7c793b51fe8c16139fd8f 1 parent eef82b2
Stuart Halloway stuarthalloway authored
Showing with 103 additions and 1 deletion.
  1. +10 −1 pom.xml
  2. +6 −0 script/repl
  3. +87 −0 src/main/clojure/alioth/binary_trees.clj
11 pom.xml
View
@@ -1,7 +1,7 @@
<project xmlns="http://maven.apache.org/POM/4.0.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
<modelVersion>4.0.0</modelVersion>
<artifactId>test.benchmark</artifactId>
- <version>0.1.3-SNAPSHOT</version>
+ <version>0.1.0-SNAPSHOT</version>
<name>${artifactId}</name>
<parent>
@@ -15,4 +15,13 @@
<developerConnection>scm:git:git@github.com:clojure/test.benchmark.git</developerConnection>
<url>git@github.com:clojure/test.benchmark.git</url>
</scm>
+
+ <dependencies>
+ <dependency>
+ <groupId>org.clojure</groupId>
+ <artifactId>clojure</artifactId>
+ <version>1.3.0-alpha8</version>
+ </dependency>
+ </dependencies>
+
</project>
6 script/repl
View
@@ -0,0 +1,6 @@
+#!/bin/sh
+CLASSPATH=src/main/clojure:`cat script/maven-classpath`
+
+java -server -Xmx2G -Xms2G -Xmn256m -XX:-PrintGCDetails -XX:+DisableExplicitGC -cp $CLASSPATH clojure.main
+
+
87 src/main/clojure/alioth/binary_trees.clj
View
@@ -0,0 +1,87 @@
+; Copyright (c) Rich Hickey and contributors.
+; All rights reserved.
+; The use and distribution terms for this software are covered by the
+; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+; which can be found in the file epl-v10.html at the root of this distribution.
+; By using this software in any fashion, you are agreeing to be bound by
+; the terms of this license.
+; You must not remove this notice, or any other, from this software.
+
+; Alioth benchmarks: http://shootout.alioth.debian.org/u64q/benchmark.php?test=binarytrees&lang=all
+; Inspired by http://shootout.alioth.debian.org/u64q/program.php?test=binarytrees&lang=java&id=1
+; and http://shootout.alioth.debian.org/u64q/program.php?test=binarytrees&lang=clojure&id=5 ;
+(ns alioth.binary-trees)
+
+(set! *warn-on-reflection* true)
+(set! *unchecked-math* true)
+
+(definterface ITreeNode
+ (^long item [])
+ (left [])
+ (right []))
+
+(deftype TreeNode [left right ^long item]
+ ITreeNode
+ (^long item [this] item)
+ (left [this] left)
+ (right [this] right))
+
+(defn make-tree [^long item ^long depth]
+ (if (zero? depth)
+ (TreeNode. nil nil item)
+ (TreeNode.
+ (make-tree (dec (* 2 item))
+ (dec depth))
+ (make-tree (* 2 item)
+ (dec depth))
+ item)))
+
+(defn item-check ^long [^TreeNode node]
+ (if (nil? (.left node))
+ (.item node)
+ (+ (+ (.item node)
+ (item-check (.left node)))
+ (- (item-check (.right node))))))
+
+(defn iterate-trees [mx mn d]
+ (let [iterations (bit-shift-left 1 (long (+ mx mn (- d))))]
+ (format "%d\t trees of depth %d\t check: %d"
+ (* 2 iterations)
+ d
+ (loop [result 0
+ i 1]
+ (if (= i (inc iterations))
+ result
+ (recur (+ result
+ (item-check (make-tree i d))
+ (item-check (make-tree (- i) d)))
+ (inc i)))))))
+
+(def min-depth 4)
+
+(defn main [max-depth]
+ (let [stretch-depth (inc max-depth)]
+ (let [tree (make-tree 0 stretch-depth)
+ check (item-check tree)]
+ (println (format "stretch tree of depth %d\t check: %d" stretch-depth check)))
+ (let [agents (repeatedly (.availableProcessors (Runtime/getRuntime)) #(agent []))
+ long-lived-tree (make-tree 0 max-depth)]
+ (loop [depth min-depth
+ [a & more] (cycle agents)]
+ (if (>= depth stretch-depth)
+ (do
+ (doseq [a agents] (await a))
+ (doseq [trees-nfo (if (= 1 (count agents))
+ @(first agents)
+ (apply interleave (map deref agents)))]
+ (println trees-nfo)))
+ (do
+ (send a (fn [coll] (conj coll (iterate-trees max-depth min-depth depth))))
+ (recur (+ 2 depth) more))))
+ (println (format "long lived tree of depth %d\t check: %d" max-depth (item-check long-lived-tree))))))
+
+(defn -main [& args]
+ (let [n (if (first args) (Integer/parseInt (first args)) 0)
+ max-depth (if (> (+ min-depth 2) n) (+ min-depth 2) n)]
+ (main max-depth)
+ (shutdown-agents)))
Please sign in to comment.
Something went wrong with that request. Please try again.