Baishampayan Ghose wrote:
> Nico Swart wrote:
>
>> I recently got clojure source and rebuilt clojure.jar. I noticed that
>> the performance is
>> significantly worse with the new clojure.jar compared to a older
>> clojure.jar. Everything else is the same, I just change
>> the clojure.jar file and the performance is 4x slower. Below the output
>> - Note the runtimes.
>> The application is just a solution finder to a solitaire type problem.
>> Incidently, the equivalent solution
>> in Clisp runs in < 10s.
>>
>> -------------------------
>> With new clojure.jar
>> -------------------------
>> user=> (time (find-sol-biz 25000))
>>
>> OOO
>> OOO
>> OOOOOOO
>> OOOXOOO
>> OOOOOOO
>> OOO
>> OOO
>>
>> "Elapsed time: 108985.946259 msecs"
>> ((10 24) (15 17) (30 16) (17 15) (19 17) (4 18) (2 4) (25 11) (4 18) (14
>> 16) (9 23) (17 19) (20 18) (39 25) (18 32) (44 30) (23 37) (21 23) (23
>> 25) (25 39) (27 25) (46 32) (25 39) (28 30) (30 44) (34 32) (31 33) (44
>> 46) (46 32) (33 31) (38 24))
>> user=>
>>
>> ------------------------------------
>> With previous clojure.jar
>> ---------------------------
>> (time (find-sol-biz 25000))
>>
>> OOO
>> OOO
>> OOOOOOO
>> OOOXOOO
>> OOOOOOO
>> OOO
>> OOO
>>
>> "Elapsed time: 27402.569601 msecs"
>> ((10 24) (15 17) (30 16) (17 15) (19 17) (4 18) (2 4) (25 11) (4 18) (14
>> 16) (9 23) (17 19) (20 18) (39 25) (18 32) (44 30) (23 37) (21 23) (23
>> 25) (25 39) (27 25) (46 32) (25 39) (28 30) (30 44) (34 32) (31 33) (44
>> 46) (46 32) (33 31) (38 24))
>> user=>
>>
>
> Can you kindly attach the code that you used to test?
>
> Regards,
> BG
>
>
Attached the code I used. I did not include it at first since it was the
same on
both occasions.
Thanks.
--~--~---------~--~----~------------~-------~--~----~
You received this message because you are subscribed to the Google
Groups "Clojure" group.
To post to this group, send email to [email protected]
Note that posts from new members are moderated - please be patient with your
first post.
To unsubscribe from this group, send email to
[email protected]
For more options, visit this group at
http://groups.google.com/group/clojure?hl=en
-~----------~----~----~----~------~----~------~--~---
;; Solitaire solution finder.
(use 'clojure.contrib.math)
(defstruct game-position :pos :moves)
(def solution-pos (struct game-position (vector 'ill 'ill 'emp 'emp 'emp 'ill
'ill
'ill 'ill 'emp 'emp 'emp 'ill
'ill
'emp 'emp 'emp 'emp 'emp 'emp
'emp
'emp 'emp 'emp 'pin 'emp 'emp
'emp
'emp 'emp 'emp 'emp 'emp 'emp
'emp
'ill 'ill 'emp 'emp 'emp 'ill
'ill
'ill 'ill 'emp 'emp 'emp 'ill
'ill
), nil))
(def test-pos (struct game-position (vector 'ill 'ill 'emp 'emp 'pin 'ill 'ill
'ill 'ill 'emp 'pin 'pin 'ill 'ill
'emp 'emp 'emp 'pin 'emp 'pin 'pin
'emp 'pin 'pin 'emp 'emp 'emp 'emp
'emp 'emp 'emp 'emp 'emp 'emp 'emp
'ill 'ill 'emp 'emp 'emp 'ill 'ill
'ill 'ill 'emp 'emp 'emp 'ill 'ill
), nil))
(defn pin<->emp [elem]
(cond (= elem 'pin) 'emp
(= elem 'emp) 'pin
true 'ill))
;; map-vector : (vectorof elem) -> (vectorof elem)
;; apply f to v and produce a new vector
;; example: (map-vector (lambda (x) x) v) produces a copy of v
(defn map-vector [f v]
(vec (map f v)))
;; start is inverse of solution
(def start-pos (struct game-position (map-vector pin<->emp (:pos solution-pos))
nil))
(defn add1 [val] (+ 1 val))
(defn sub1 [val] (- val 1))
(defn valid-right [{pos :pos} from]
(let [to (+ from 2)
jump (add1 from)]
(if (and (>= to 0) (< to 49)
(> jump 0) (< jump 49)
(= (int (/ to 7)) (int (/ from 7)))
(= (nth pos from) 'pin)
(= (nth pos to) 'emp)
(= (nth pos jump) 'pin))
(list from to) nil)))
(defn valid-left [{pos :pos} from]
(let [to (- from 2)
jump (sub1 from)]
(if (and (>= to 0) (< to 49)
(> jump 0) (< jump 49)
(= (int (/ to 7)) (int (/ from 7)))
(= (nth pos from) 'pin)
(= (nth pos to) 'emp)
(= (nth pos jump) 'pin))
(list from to) nil)))
(defn valid-down [{pos :pos} from]
(let [to (+ from 14)
jump (+ from 7)]
(if (and (>= to 0) (< to 49)
(> jump 0) (< jump 49)
(= (mod to 7) (mod from 7))
(= (nth pos from) 'pin)
(= (nth pos to) 'emp)
(= (nth pos jump) 'pin))
(list from to) nil)))
(defn valid-up [{pos :pos} from]
(let [to (- from 14)
jump (- from 7)]
(if (and (>= to 0) (< to 49)
(> jump 0) (< jump 49)
(= (mod to 7) (mod from 7))
(= (nth pos from) 'pin)
(= (nth pos to) 'emp)
(= (nth pos jump) 'pin))
(list from to) nil)))
(defn make-move [position move]
(assoc position :moves (cons move (:moves position))
:pos (assoc (:pos position)
(first move) 'emp,
(int (/ (+ (first move) (second move)) 2)) 'emp,
(second move) 'pin)))
(defn easy-read [{pos :pos} i]
(cond (= (nth pos i) 'pin) \X
(= (nth pos i) 'emp) \O
true \space))
(defn print-pos-aux [pos i]
(when (<= i 48)
(print (easy-read pos i))
(when (= (mod (add1 i) 7) 0) (println))
(recur pos (add1 i))))
(defn print-pos [pos]
(do
(println)
(print-pos-aux pos 0)
(println)))
;;;; Top level calls ;;;;
(defn solution? [{pos :pos}]
(= pos (:pos solution-pos)))
(def try-dirs [valid-up valid-down valid-right valid-left])
(defn all-moves-from-pos [pos]
(filter #(not (nil? %)) (for [pin (range 49) f try-dirs] (f pos pin))))
(defn all-positions [pos]
(for [mov (all-moves-from-pos pos)] (make-move pos mov)))
;(defun find-sol-2 ()
; (let ((path-so-far (list start-pos)))
; (do () (nil)
; (cond ((null path-so-far) (return 'no-solution))
; ((solution? (car path-so-far)) (print-pos (car path-so-far))
(return (get-moves (car path-so-far))))
; (t
; (let ((pos (pop path-so-far)))
; (dolist (move-todo (all-moves-from-pos pos))
; (unless (null move-todo)
; (setf path-so-far (push (make-move pos move-todo)
path-so-far))))))))))
(defn find-solution [init-pos max-iter]
(loop [path-so-far (list init-pos) x max-iter y 0]
(cond (zero? x) path-so-far
(empty? path-so-far) 'no-solution
(solution? (first path-so-far)) (do (print-pos (first path-so-far))
(:moves (first path-so-far)))
true
(let [present-pos (first path-so-far)]
(recur (concat (reverse (all-positions present-pos)) (rest
path-so-far)) (dec x) (inc y))))))
(defn find-solution2 [init-pos max-iter]
(loop [path-so-far (list init-pos) x max-iter y 0]
(cond (zero? x) path-so-far
(empty? path-so-far) 'no-solution
(solution? (first path-so-far)) (do (print-pos (first path-so-far))
(:moves (first path-so-far)))
:else
(recur (concat (reverse (all-positions (first path-so-far))) (rest
path-so-far)) (dec x) (inc y)))))
(def r-path (ref (list start-pos)))
(defn rconcat [pref & [args]]
(concat args pref))
(defn find-sol-biz [max-iter]
(loop [x max-iter]
(cond (zero? x) (println "No solution so far - run more iterations")
(empty? @r-path) 'no-solution
(solution? (first @r-path)) (do (print-pos (first @r-path)) (:moves
(first @r-path)))
:else
(let [ppos (first @r-path)]
(dosync (alter r-path rest)
(alter r-path rconcat (reverse (all-positions ppos))))
(recur (dec x))))))
(def lisp-sol '((10 24) (15 17) (30 16) (17 15) (19 17) (4 18) (2 4) (25 11) (4
18) (14 16)
(9 23) (17 19) (20 18) (39 25) (18 32) (44 30) (23 37) (21 23) (23 25) (25
39)
(27 25) (46 32) (25 39) (28 30) (30 44) (34 32) (31 33) (44 46) (46 32)
(33 31) (38 24)))
;; make-move test
(defn t-l-moves [sol]
(loop [moves sol pos start-pos]
(let [next-pos (make-move pos (first moves))]
(print-pos next-pos)
(println)
(when (solution? next-pos) (println "Solution above"))
(when (not (empty? (rest moves)))
(recur (rest moves) next-pos)))))
