The Computer Language
Benchmarks Game

fannkuch-redux Clojure #2 program

source code

;;   The Computer Language Benchmarks Game

;; contributed by Andy Fingerhut.  
;; Speed improvements contributed by Stuart Halloway.

(ns fannkuchredux
  (:require clojure.string)

(set! *warn-on-reflection* true)

;; This macro assumes that 1 <= n <= (alength a), where a is a Java
;; array of ints.  No guarantees are made of its correctness if this
;; condition is violated.  It does this merely to avoid checking a few
;; conditions, and thus perhaps be a bit faster.

(defmacro reverse-first-n! [n #^ints a]
  `(let [n# (int ~n)
         n-1# (int (dec n#))]
     (loop [i# (int 0)
            j# (int n-1#)]
       (when (< i# j#)
         (let [temp# (aget ~a i#)]
           (aset ~a i# (aget ~a j#))
           (aset ~a j# temp#))
         (recur (inc i#) (dec j#))))))

(defmacro rotate-left-first-n! [n #^ints a]
  `(let [n# (int ~n)
	 n-1# (dec n#)
	 a0# (aget ~a 0)]
     (loop [i# (int 0)]
       (if (== i# n-1#)
	 (aset ~a n-1# a0#)
	 (let [i+1# (inc i#)]
	   (aset ~a i# (aget ~a i+1#))
	   (recur i+1#))))))

(defn fannkuch-of-permutation [#^ints p]
  (if (== (int 1) (aget p 0))
    ;; Handle this special case without bothering to create a Java
    ;; array.
    ;; Using aclone instead of copy-java-int-array was a big
    ;; improvement.
    (let [#^ints p2 (aclone p)]
      (loop [flips (int 0)]
        (let [first-num (int (aget p2 0))]
          (if (== (int 1) first-num)
              (reverse-first-n! first-num p2)
              (recur (inc flips)))))))))

;; initialize the permutation generation algorithm.  The permutations
;; need to be generated in a particular order so that the checksum may
;; be computed correctly (or if you can determine some way to
;; calculate the sign from an arbitrary permutation, then you can
;; generate the permutations in any order you wish).

;; With the particular order of generating permutations used in this
;; program, it turns out that each of the n consecutive "groups" of
;; (n-1)!  permutations begin with these permutations (example given
;; for n=6):

;;   1st permutation: 1 2 3 4 5 6    sign: 1  count vals: 1 2 3 4 5 6
;; 121st permutation: 2 3 4 5 6 1    sign: 1  count vals: 1 2 3 4 5 5
;; 241st permutation: 3 4 5 6 1 2    sign: 1  count vals: 1 2 3 4 5 4
;; 361st permutation: 4 5 6 1 2 3    sign: 1  count vals: 1 2 3 4 5 3
;; 481st permutation: 5 6 1 2 3 4    sign: 1  count vals: 1 2 3 4 5 2
;; 601st permutation: 6 1 2 3 4 5    sign: 1  count vals: 1 2 3 4 5 1

;; This makes it very easy to divide the work into n parallel tasks
;; that each start at one of the permutations above, and generate only
;; (n-1)! permutations each.  Then combine the checksum and maxflips
;; values of each thread and print.

(defn init-permutations [n]
  (let [n-1 (dec n)]
    (loop [i 1
           p (int-array (range 1 (inc n)))
           sign 1
           c (int-array (range 1 (inc n)))
           tasks [{:perm p :sign sign :counts c}]]
      (if (== i n)
        (let [p2 (aclone p)
              c2 (aclone c)]
          (rotate-left-first-n! n p2)
          (aset c2 n-1 (dec (aget c2 n-1)))
          (recur (inc i) p2 sign c2
                 (conj tasks {:perm p2 :sign sign :counts c2})))))))

(defmacro swap-array-elems! [a i j]
  `(let [temp# (aget ~a ~i)]
     (aset ~a ~i (aget ~a ~j))
     (aset ~a ~j temp#)))

;; Modify the passed Java arrays p (a permutation) and c (count
;; values) in place.  Let caller negate the sign themselves.

;; Return true if the final value of p is a new permutation, false if
;; there are no more permutations and the caller should not use the
;; value of p for anything.

(defn next-permutation! [N #^ints p sign #^ints c]
  (if (neg? sign)
    (let [N (int N)
	  N-1 (dec N)]
      (swap-array-elems! p 1 2)
      (loop [i (int 2)]
	(if (== i N)
	(let [cx (aget c i)
	      i+1 (inc i)]
	  (if (not= cx 1)
	      (aset c i (dec cx))
	    (if (== i N-1)
		(aset c i i+1)
		(rotate-left-first-n! (inc i+1) p)
		(recur i+1)))))))
    ;; else sign is +1
    (swap-array-elems! p 0 1)))

(defn partial-fannkuch [num-perms #^ints p-arg first-sign #^ints c-arg]
  (let [#^ints p (aclone p-arg)
        #^ints c (aclone c-arg)
        N (int (count p))]
    (loop [i (int num-perms)
           sign (int first-sign)
	   maxflips (int 0)
	   checksum (int 0)]
      (if (zero? i)
        [checksum maxflips]
        (let [curflips (int (fannkuch-of-permutation p))]
          (next-permutation! N p sign c)
          (recur (dec i) (- sign) (int (max maxflips curflips))
                 (+ checksum (* sign curflips))))))))

(defn fannkuch [N]
  (let [init-perms (init-permutations N)
        N-1-factorial (reduce * (range 1 N))
        partial-results (pmap (fn [{p :perm, s :sign, c :counts}]
                                (partial-fannkuch N-1-factorial p s c))
    (reduce (fn [[checksum1 maxflips1] [checksum2 maxflips2]]
              [(+ checksum1 checksum2) (max maxflips1 maxflips2)])

(defn -main [& args]
  (let [N (if (and (>= (count args) 1)
		   (re-matches #"^\d+$" (nth args 0)))
	    (. Integer valueOf (nth args 0) 10)
    (let [[checksum maxflips] (fannkuch N)]
      (printf "%d\n" checksum)
      (printf "Pfannkuchen(%d) = %d\n" N maxflips)))
  (. System (exit 0)))

notes, command-line, and program output

64-bit Ubuntu quad core
Clojure 1.8.0
java version "1.8.0_45"
Java(TM) SE Runtime Environment (build 1.8.0_45-b14)
Java HotSpot(TM) 64-Bit Server VM (build 25.45-b02, mixed mode)

Sat, 27 Feb 2016 17:34:44 GMT

mv fannkuchredux.clojure-2.clojure fannkuchredux.clj
/usr/local/src/jdk1.8.0_45/bin/java -Dclojure.compile.path=. -cp .:/usr/local/src/clojure/clojure-1.8.0.jar clojure.lang.Compile fannkuchredux
Compiling fannkuchredux to .
1.30s to complete and log all make actions

/usr/local/src/jdk1.8.0_45/bin/java -server -XX:+TieredCompilation -XX:+AggressiveOpts -Xmx16m -cp .:/usr/local/src/clojure/clojure-1.8.0.jar fannkuchredux 12

Pfannkuchen(12) = 65