queens.lisp

;;; Paper:     https://arxiv.org/pdf/2001.02491.pdf
;;; Code:      https://github.com/cvlab-epfl/n-queens-benchmark
;;; Lisp Code: https://github.com/cvlab-epfl/n-queens-benchmark/blob/master/code/queens.lisp

;;; Changes/extensions to the original Common Lisp code: Rainer Joswig, joswig@lisp.de, 2020
;;   * using bitvectors is faster than 'boolean' arrays (which typically aren't supported in CL)

;;; In Common Lisp
;;;  * use Quicklisp
;;;  * compile and load this file


;;; ================================================================
;;; Setup

#-quicklisp
(eval-when (:compile-toplevel :load-toplevel :execute)
  (let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname))))
    (when (probe-file quicklisp-init)
      (load quicklisp-init))))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload "cl-parallel")  ; version 1
  (pushnew :cl-parallel *features*)
  (ql:quickload "lparallel"))   ; version 2

(eval-when (:compile-toplevel :load-toplevel :execute)
  (unless lparallel:*kernel*
    (setf lparallel:*kernel* (lparallel:make-kernel 16))))  ; 8 cores / 16 threads Intel Xeon


;;; ================================================================
;;; N-QUEENS

(defun allQueensAux (n i col dg1 dg2)
  (declare (type fixnum n i)
           (type (array bit 1) col dg1 dg2 )
           (optimize (speed 3) (debug 0) (safety 0) #+lispworks (fixnum-safety 0)))

  (if (= i n)
      1
    (loop for j fixnum below n 
          for a fixnum = (+ i j) and b fixnum = (- (+ i n) j)

          when (and (= 1 (sbit col j))
                    (= 1 (sbit dg1 a))
                    (= 1 (sbit dg2 b)))
          do (setf (sbit col j) 0
                   (sbit dg1 a) 0
                   (sbit dg2 b) 0)
             and sum (the fixnum (allQueensAux n (+ i 1) col dg1 dg2)) fixnum and do
             (setf (sbit col j) 1
                   (sbit dg1 a) 1
                   (sbit dg2 b) 1))))

(defun allQueensRec (n)
  (declare (type fixnum n)
           (optimize (speed 3) (debug 0) (safety 0) #+lispworks (fixnum-safety 0)))

  (let ((col (make-array n       :initial-element 1 :element-type 'bit))
        (dg1 (make-array (* 2 n) :initial-element 1 :element-type 'bit))
        (dg2 (make-array (* 2 n) :initial-element 1 :element-type 'bit)))
    (declare (type (array bit 1) col dg1 dg2))
    
    (allQueensAux n 0 col dg1 dg2)))


;;; ================================================================
;;; parallel map versions of n-queens

(defun allQueensCol (n j)
  (declare (type fixnum n j)
           (optimize (speed 3) (debug 0) (safety 0) #+lispworks (fixnum-safety 0)))

  (let ((col (make-array n       :initial-element 1 :element-type 'bit))
        (dg1 (make-array (* 2 n) :initial-element 1 :element-type 'bit))
        (dg2 (make-array (* 2 n) :initial-element 1 :element-type 'bit)))
    (declare (type (array bit 1) col dg1 dg2))
    (setf (sbit col j) 0
          (sbit dg1 j) 0
          (sbit dg2 (- n j)) 0)
    (allQueensAux n 1 col dg1 dg2)))

#+cl-parallel
(defun allQueensPara-1 (n)
  (parallel:par-map-reduce (lambda (j)
                             (allQueensCol n j))
                           #'+
                           (loop for i from 0 below n collect i)
                           :initial-value 0))
#+lparallel
(defun allQueensPara-2 (n)
  (reduce #'+ (lparallel:pmap 'list
                              (lambda (j)
                                (allQueensCol n j))
                              (loop for i from 0 below n collect i))))


;;; ================================================================
;;; Benchmark code

(defparameter *queen-benchmarks*
  '((allQueensRec    "Benchmark queens~%")
    #+(and cl-parallel (not abcl) (not ecl))
    (allQueensPara-1 "CL-Parallel Benchmark queens~%")
    #+(and lparallel (not ecl))
    (allQueensPara-2 "LParallel Benchmark queens~%")))


(defun test-queens (fromN toN rept)
  (loop for (benchmark-function message) in *queen-benchmarks* do
        (format t message)
        (loop with np = rept and dt
              for n from fromN to toN
              for t0 = (get-internal-real-time)
              
              do
              (loop repeat np do (funcall benchmark-function n))
              (setq dt (/ (- (get-internal-real-time) t0)
                          (* rept internal-time-units-per-second)))
              (format t "~2d: ~f~%" n dt))))

(eval-when (:load-toplevel :execute)
  (test-queens 8 14 10))

;;; ================================================================
;;; End of File