Clisp implementation of quickperm algorithm

Question

I'm working on an iterative solution to the n queens problem. I've decided to represent the state space as an array of 0's and 1's, such that a 1 represents the presence of a queen. The plan is to generate all permutations of the array and then write a verifier to prune incorrect solutions. I'm trying to do this is common lisp, even though I had never touched functional programming before today.

In order to generate the permutations, I chose to try and implement this algorithm, using the first pseudocode example: http://www.quickperm.org/

Here is my attempt:

(defun permute (n)
  (setf total (* n n)) 
  (let ((a (make-array total :initial-element 0))      ;list of objects to permute
       (p (make-array total :initial-element 0)))     ;array to control iteration 
    (dotimes (i n) (setf (aref a i) 1))
    (loop for index from 1 while (< index total) do
      (setf (aref p index) (- (aref p index) 1))      ;decrement p[i] by 1
      (if (= (rem index 2) 1)                         ;if index is odd
          (setf j (aref p index))                     ;j = p[index]
          (setf j 0))                                 ;else j = 0
      (rotatef (aref a index) (aref a j))             ;swap a[index] & a[j]
      (setf index 1)                                  ;index = 1 
      (loop while (= (aref p index) 0) do             ;while p[index] == 0
        (setf (aref p index) index)                   ;p[index] = i
        (setf index (+ index 1)))                     ;index++
      print a)))           
(permute 4)

Currently, I'm getting the error: AREF: index -1 for #array, which seems to be caused by the (setf (aref p index) (- (aref p index) 1)) line. In pseudocode, that line seems to implement p[index] = p[index] - 1. This is the only subtraction operation I have, but it shouldn't be operating on index itself, just on the value at its location.

What am I missing?

EDIT: I initialized every element of p to 0. Each element is actually supposed to be equal to its index. Will post updated code when completed.

Yeah you're setting consecutive elements of p to 0, -1, -2 ... Then you set j = p[i]. Then you have rotatef ... a[j]. My bet is that's where the -1 is occurring, not the line you cite. — Gene, Oct 11 '16 at 01:11

Gene · Accepted Answer · 2016-10-17T04:47:33.613

It's been a long time since I've written CL, but here is a version that uses some idiomatic forms.

(defun permute (n) 
  (let ((a (make-array n))                        ;list of objects to permute
       (p (make-array (1+ n))))                   ;array to control iteration 
    (dotimes (i n) (setf (aref a i) (1+ i)))
    (dotimes (i (1+ n)) (setf (aref p i) i))
    (setf i 1)
    (loop with i = 1 and j = 0 while (< i n) do
      (decf (aref p i))                           ;decrement p[i] by 1
      (setf j (if (oddp i) (aref p i) 0))         ;j = odd(i) ? a[i] : 0
      (rotatef (aref a i) (aref a j))             ;swap a[i] & a[j]
      (setf i 1)                                  ;i = 1 
      (loop while (zerop (aref p i)) do           ;while p[i] == 0
        (setf (aref p i) i)                       ;p[i] = i
        (incf i))                                 ;index++
      (verif a n))))

Yeah, that is much better! Thanks for your contribution. – FutureShocked Oct 12 '16 at 16:16 — FutureShocked, Oct 12 '16 at 16:16
The variables j and index are undefined. – Rainer Joswig Oct 16 '16 at 21:55 — Rainer Joswig, Oct 16 '16 at 21:55

score 0 · Answer 2 · answered Oct 11 '16 at 21:39

Here's the final product, in case any sad sap stumbles here some day.

(defun permute (n) 
  (let ((a (make-array n))                            ;list of objects to permute
       (p (make-array (+ 1 n))))                      ;array to control iteration 
    (dotimes (i n) (setf (aref a i) (+ i 1)))
    (dotimes (i (+ n 1)) (setf (aref p i) i)) 
    (setf index 1)
    (loop while (< index n) do
      (setf (aref p index) (- (aref p index) 1))      ;decrement p[i] by 1
      (if (= (rem index 2) 1)                         ;if index is odd
          (setf j (aref p index))                     ;j = p[index]
          (setf j 0))                                 ;else j = 0
      (rotatef (aref a index) (aref a j))             ;swap a[index] & a[j]
      (setf index 1)                                  ;index = 1 
      (loop while (= (aref p index) 0)  do            ;while p[index] == 0
        (setf (aref p index) index)                   ;p[index] = i
        (setf index (+ index 1)))                     ;index++
      (verif a n))))

Clisp implementation of quickperm algorithm

2 Answers2