In the program below, if I use the commented-out version of thsolve
(program is the N queens puzzle), the with-local-vars construct causes
a NullPointerException when its block exits, after appearingt o work
correctly. The same thing happens if I use binding instead.
The non-commented version of thsolve that uses a nested recursive
helper function thhelp does not work if thsolve does not explicitly
pass parameter thdepth to thhelp as a parameter. If I try to use
lexical nesting to let thhelp get the value of thdepth without making
thdepth a parameter of thhelp, then thhelp gets incorrect values at
run time. There is no error indicator, but the values are wrong.
These are in 1.1, and the first problem is in the current beta of 1.2.
Not sure where I should post this.
Dale
; Clojure solution to nqueens benchmark.
; D. Parson, Summer 2010.
; See threadlim_nqueens.java for more details.
(defstruct boardstate
; :xcol_occupied is (0 .. n-1), set to 1 for true when column
occupied
; :yrow_occupied is (0 .. n-1), set to true when row occupied.
; value is stored as either 0 for false or the value x+1 for the y
; value at the array index, so that the print method can extract
; x,y pairs from yrow_occupied without storing yet another 2D
array,
; which slows down both machines, especially Harry.
; :diag_occupied is (X+Y) is (0..2n-2) for "/" diagonal occupation
; :rdia_occupied is (X-Y+(n-1)) is (0..2n-2) for "\" diagonal
occupation
:nqueens :xcol_occupied :yrow_occupied :diag_occupied :rdia_occupied
)
; Construct an empty boardstate -- 0 in all vectors
(defn newboardstate [nqueens]
(let [
diagsize (- (* 2 nqueens) 1)
line0 (for [i (range 0 nqueens)] 0)
diag0 (for [i (range 0 diagsize)] 0)
linev (vec line0)
diagv (vec diag0)
]
(struct-map boardstate
:nqueens nqueens
:xcol_occupied linev
:yrow_occupied linev
:diag_occupied diagv
:rdia_occupied diagv
)
)
)
; nextboardstate takes a previous board state and insert value
; state at location x,y, returning the new board
(defn nextboardstate [oldboard x y state]
(let [
newxcol (assoc (get oldboard :xcol_occupied) x state)
newyrow (assoc (get oldboard :yrow_occupied) y state)
newdiag (assoc (get oldboard :diag_occupied) (+ x y) state)
newrdia (assoc (get oldboard :rdia_occupied)
(+ (- x y) (- (get oldboard :nqueens) 1)) state)
]
(struct-map boardstate
:nqueens (get oldboard :nqueens)
:xcol_occupied newxcol
:yrow_occupied newyrow
:diag_occupied newdiag
:rdia_occupied newrdia
)
)
)
; Check whether it is safe to place a queen at location x, y
; We can skip the [x] column check because solve uses only 1
; location at a time in a given column.
(defn issafe [board x y]
(and
(== (nth (get board :yrow_occupied) y) 0)
(== (nth (get board :diag_occupied) (+ x y)) 0)
(== (nth (get board :rdia_occupied)
(+ (- x y) (- (get board :nqueens) 1))) 0)
)
)
; Print out the board contents
(defn printboard [board]
(let [nq (get board :nqueens)]
(doseq [i (range 0 nq)] (print "**"))
(println "")
(doseq [qiy (range 0 nq)]
(let [qx (- (nth (get board :yrow_occupied) qiy) 1)]
(doseq [x (range 0 qx)] (print " -"))
(print " Q")
(doseq [x (range (+ qx 1) nq)] (print " -"))
(println "")
)
)
(doseq [i (range 0 nq)] (print "**"))
(println "")
)
)
; Following are set to run-time values in mainfunc
(def NQUEENS nil)
(def THREADDEPTH nil)
(def IS_PRINT nil)
(def IS_COUNT_THREADS nil)
(def NUMSOLUTIONS (atom 0)) ; Counts solutions across threads.
(def THCOUNTERS (atom nil)) ; Vector of thread counters, see
mainfunc.
(defn printsolution [mystate]
(do
(swap! NUMSOLUTIONS (fn [oldval] (+ oldval 1)))
(if IS_PRINT (printboard mystate))
)
)
(defn solve [instate mycolumn]
(doseq [myrow (range 0 NQUEENS)]
(if (issafe instate mycolumn myrow)
(let [newstate (nextboardstate instate mycolumn myrow (+
mycolumn 1))]
(if (== mycolumn (- NQUEENS 1))
(printsolution newstate)
(solve newstate (+ mycolumn 1))
)
)
)
)
)
(defn countThreads [thdepth thcount]
;(println "DEPTH" thdepth "COUNT" thcount)
(swap! THCOUNTERS (fn [oldval]
(assoc oldval thdepth (+ (nth oldval thdepth) thcount))))
)
; ARGHHH!!! with-local-vars blows up with a NullPointerException
; from the runtime when the with-local-vars block terminates,
; regardless of nesting level, apparently trashing the stack.
; So does the "binding" command for creating mutable local VARS.
; I could probably rebind symbols using loop-recur, but it is
; clumsier than just using tail recursion, so I am replacing
; the following broken thsolve with a tail recursive verison below.
;(defn thsolve [instate mycolumn thdepth]
; (with-local-vars [thlocalcntr 0 thlocalfutures (seq nil)]
; (if (or (< thdepth 1) (== mycolumn (- NQUEENS 1)))
; (solve instate mycolumn)
;
; (
; ; Start a future running in another thread for each advance
in state.
; (doseq [myrow (range 0 NQUEENS)]
; (if (issafe instate mycolumn myrow)
; (let [newstate (nextboardstate instate mycolumn myrow (+
mycolumn 1))]
; (var-set thlocalfutures (concat (var-get
thlocalfutures)
; (list (future (thsolve newstate (+ mycolumn 1) (-
thdepth 1))))))
; (var-set thlocalcntr (+ (var-get thlocalcntr) 1))
; )
; )
; )
; ; Next line blocks until all futures have completed.
; (doseq [myfut (var-get thlocalfutures)]
; (deref myfut))
; (if (and IS_COUNT_THREADS (> (var-get thlocalcntr) 0))
; (countThreads thdepth (var-get thlocalcntr))
; )
; )
; )
; )
;)
; BUG clojure does not compile access to thdepth for nested function
; thhelp correctly to access the enclosing function's parameter;
; You MUST pass thdepth as a parameter to thhelp -- lexical access
; to the enclosing function's parameter is busted.
(defn thsolve [instate mycolumn thdepth]
(defn thhelp [instate mycolumn myrow thdepth]
(if (< myrow NQUEENS)
(if (issafe instate mycolumn myrow)
(let [newstate (nextboardstate instate mycolumn myrow (+
mycolumn 1))
fut (future (thsolve newstate (+ mycolumn 1) (- thdepth
1)))]
; finish this column before waiting on the future
(let [fsum (thhelp instate mycolumn (+ myrow 1) thdepth)]
;(if IS_COUNT_THREADS
;(countThreads thdepth 1)
;)
(deref fut) ; wait for threads while unwinding myrow++
loop
(+ fsum 1) ; how many threads started by this+recursive
calls
)
)
; else not safe, trying another and returns its sum
(thhelp instate mycolumn (+ myrow 1) thdepth)
)
; else mrow == NQUEENS
0
)
)
(if (or (< thdepth 1) (== mycolumn (- NQUEENS 1)))
(solve instate mycolumn)
(let [threadcount (thhelp instate mycolumn 0 thdepth)]
(if (and IS_COUNT_THREADS (> threadcount 0))
(countThreads thdepth threadcount)
)
)
)
)
(defn mainfunc [nqueens threaddepth is_print is_count_threads]
(do
(println "NQUEENS " nqueens ", THREADDEPTH " threaddepth
", IS_PRINT " is_print ", IS_COUNT_THREADS " is_count_threads)
(def NQUEENS nqueens)
(def THREADDEPTH threaddepth)
(def IS_PRINT is_print)
(def IS_COUNT_THREADS is_count_threads)
(reset! NUMSOLUTIONS 0)
(reset! THCOUNTERS (vec (for [i (range 0 nqueens)] 0)))
(let [initialstate (newboardstate nqueens)]
(time
(if (== threaddepth 0)
(solve initialstate 0)
(thsolve initialstate 0 threaddepth)
)
)
(println "NUMSOLUTIONS=" @NUMSOLUTIONS)
(if is_count_threads
(let [thc @THCOUNTERS]
(doseq [i (range 0 nqueens)]
(if (> (nth thc i) 0)
(println "Threadcount at height" i
"=" (nth thc i))
)
)
)
)
)
)
)
(defn testit []
(println "**********************")
(mainfunc 14 0 false true)
(println "**********************")
(. Thread sleep 1000)
(mainfunc 14 1 false true)
(println "**********************")
(. Thread sleep 1000)
(mainfunc 14 2 false true)
(println "**********************")
(. Thread sleep 1000)
(mainfunc 14 3 false true)
(println "**********************")
(. Thread sleep 1000)
(mainfunc 15 0 false true)
(println "**********************")
(. Thread sleep 1000)
(mainfunc 15 1 false true)
(println "**********************")
(. Thread sleep 1000)
(mainfunc 15 2 false true)
(println "**********************")
(. Thread sleep 1000)
(mainfunc 15 3 false true)
(. System exit 0)
)
(testit)
--
You received this message because you are subscribed to the Google
Groups "Clojure" group.
To post to this group, send email to clojure@googlegroups.com
Note that posts from new members are moderated - please be patient with your
first post.
To unsubscribe from this group, send email to
clojure+unsubscr...@googlegroups.com
For more options, visit this group at
http://groups.google.com/group/clojure?hl=en
