Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Tree: 15b8d7cf33
Fetching contributors…

Cannot retrieve contributors at this time

75 lines (65 sloc) 2.916 kB
; 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
(:gen-class))
(set! *warn-on-reflection* true)
(set! *unchecked-math* true)
(def min-depth 4)
(deftype TreeNode [left right ^int item])
(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)))))))
(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)
results []]
(if (> depth stretch-depth)
(doseq [r results] (println @r))
(let [result (promise)]
(send a (fn [_]
(deliver result (iterate-trees max-depth min-depth depth))))
(recur (+ 2 depth) more (conj results result)))))
(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)))
Jump to Line
Something went wrong with that request. Please try again.