Topic: -={ Challenge }=- Eight Queens Puzzle

[ribarm]

I see that you solved the problem by programming, but there are far more solutions per square... Just try to visualize :

- rotation of square by 90 degree
- mirroring the square by horizontal & vertical symmetry axises of square
(mirroring the square by diagonals of square, witch is the same as combination of rotation of square by 90 degree and mirroring the square by horizontal & vertical symmetry axises of square)
(mirroring the square by it horizontal & vertical edges of square, witch is the same as mirroring the square by horizontal & vertical symmetry axises of square)

M.R.

[Lee Mac]

... but there are far more solutions per square...

Oh definitely...

Even considering only unique solutions (i.e. excluding solutions which are the rotation/reflection of other solutions), there are still 12 unique solutions for the 8-queen puzzle, 46 unique solutions for 9-queens, 92 for 10, 341 for 11...

[ElpanovEvgeniy]

my recursiv version:

Code: [Select]

(defun nQueens_e (n / f f1)
 (defun f (n x y l)
  (cond ((>= x n) l)
        ((= y n) nil)
        ((f1 (list (list x y) (list x (1+ y)) (list x (+ y 2))) l) (f n x (1+ y) l))
        ((f n (1+ x) 0 (cons (list (1+ x) (1+ y)) l)))
        ((f n x (1+ y) l))
  )
 )
 (defun f1 (pl l)
  (and l
       (or (vl-some (function equal) pl (list (car l) (car l) (car l)))
           (f1 (mapcar (function mapcar) '(+ + +) '((-1 -1) (-1 0) (-1 1)) pl) (cdr l))
       )
  )
 )
 (f n 1 1 '((1 2)))
)

[Lee Mac]

Nice! I see that you opted for a recursive approach in all aspects of the code... 

I like your method for testing the 'threat' of surrounding queens ('f1') 

Condensing my '_Conflict' function to optimise:

Code: [Select]

(defun LM:nQueens ( n / _Conflict _nQueens )

    (defun _Conflict ( i j l / x y )
        (and l
            (or
                (= i (setq x (caar  l)))
                (= j (setq y (cadar l)))
                (= (- i j) (- x y))
                (= (+ i j) (+ x y))
                (_Conflict i j (cdr l))
            )
        )
    )
   
    (defun _nQueens ( m i j l / r )
        (cond
            (   (zerop m)
                l
            )
            (   t
                (while (and (<= (setq i (1+ i)) n) (not r))
                    (while
                        (and (<= (setq j (1+ j)) n)
                            (or (_Conflict i j l)
                                (not (setq r (_nQueens (1- m) i 0 (cons (list i j) l))))
                            )
                        )
                    )
                )
                r
            )
        )
    )
   
    (_nQueens n 0 0 nil)
)

[ElpanovEvgeniy]

I wrote code that would be different from yours.
you wrote a simple agoritm...

[ElpanovEvgeniy]

Using your optimization, a very compact!:

Code: [Select]

(defun nQueens_e1 (n / f f1)
 (defun f (n x y l)
  (cond ((> y n) nil)
        ((> x n) l)
        ((f1 x y l) (f n x (1+ y) l))
        ((f n (1+ x) 1 (cons (list x y) l)))
        ((f n x (1+ y) l))
  )
 )
 (defun f1 (i j l)
  (and l
       (or (= j (cadar l))
           (= (- i j) (- (caar l) (cadar l)))
           (= (+ i j) (+ (caar l) (cadar l)))
           (f1 i j (cdr l))
       )
  )
 )
 (f n 2 1 '((1 2)))
)

[ElpanovEvgeniy]

added optimization for large chessboards:

Code: [Select]

(defun nQueens_e2 (n / f f1 f2)
 (defun f (n x y l)
  (cond ((> y n) nil)
        ((> x n) l)
        ((f1 x y l) (f n x (1+ y) l))
        ((f n (1+ x) 1 (cons (list x y) l)))
        ((f n x (1+ y) l))
  )
 )
 (defun f1 (i j l)
  (and l
       (or (= j (cadar l))
           (= (- i j) (- (caar l) (cadar l)))
           (= (+ i j) (+ (caar l) (cadar l)))
           (f1 i j (cdr l))
       )
  )
 )
 (defun f2 (n)
  (if (> n 1)
   (cons (list (/ n 2) n) (f2 (- n 2)))
  )
 )
 (f n (1+ (/ n 2)) 1 (f2 n))
)
function to test:

Code: [Select]

(defun c:test (/ I N P)
 (if (and (setq n (getint "\nSpecify the number of queens (recommended that more than 3, less than 50):"))
          (setq i 0
                p (getpoint "\nSpecify a point:")
          )
     )
  (progn (repeat (1+ n)
          (entmakex (list '(0 . "line")
                          '(62 . 252)
                          (list 10 (+ i (car p)) (cadr p))
                          (list 11 (+ i (car p)) (+ n (cadr p)))
                    )
          )
          (entmakex (list '(0 . "line")
                          '(62 . 252)
                          (list 10 (car p) (+ i (cadr p)))
                          (list 11 (+ n (car p)) (+ i (cadr p)))
                    )
          )
          (setq i (1+ i))
         )
         (foreach a (nQueens_e2 n)
          (entmakex (list '(0 . "LWPOLYLINE")
                          '(100 . "AcDbEntity")
                          '(62 . 1)
                          '(100 . "AcDbPolyline")
                          '(90 . 2)
                          '(70 . 1)
                          '(43 . 0.25)
                          (list 10 (+ (car a) (car p) -0.75) (+ (cadr p) (cadr a) -0.5))
                          '(42 . 1.0)
                          (list 10 (+ (car a) (car p) -0.25) (+ (cadr p) (cadr a) -0.5))
                          '(42 . 1.0)
                    )
          )
         )
  )
 )
 (princ)
)

[ElpanovEvgeniy]

new version - fix bug - 9 15 27 ...

Code: [Select]

(defun nQueens_e2 (n / f f1 f2)
 (defun f (n x y l)
  (cond ((> y n) nil)
        ((> x n) l)
        ((f1 x y l) (f n x (1+ y) l))
        ((f n (1+ x) 1 (cons (list x y) l)))
        ((f n x (1+ y) l))
  )
 )
 (defun f1 (i j l)
  (and l
       (or (= j (cadar l))
           (= (- i j) (- (caar l) (cadar l)))
           (= (+ i j) (+ (caar l) (cadar l)))
           (f1 i j (cdr l))
       )
  )
 )
 (defun f2 (n x y)
  (if (<= y n)
   (cons (list x y) (f2 n (1+ x) (+ y 2)))
  )
 )
 (if (and (= 0 (rem n 3)) (= 1 (rem (/ n 3) 2)))
  (f n (+ 2 (/ (- n (/ n 2)) 2)) 1 (reverse (f2 n 1 (/ n 2))))
  (f n (1+ (/ n 2)) 1 (reverse (f2 n 1 2)))
 )
)

[Krushert]

Can you adjust "square" size before hand?  Could you select a block as a queen to be inserted?   Or could you hatch the square instead of the dot you are showing? 

I have not look at the code or tested it but in reading of the thread and then going to my thinking closet, I came up with an idea that one could use this algorithm to use to populate a reflected ceiling grid with light fixtures (block) or fill in a floor tile pattern with accent tiles (hatch).   To the untrained eye, it would like a random pattern but to trained eye would pick up in the pattern.  But then again, the arm chair conspiracy experts would start a whole new conspiracy theory that would rival some of the Masonic conspiracy theories.  That could be good and bad. 

[Lee Mac]

Any or all of those things could be included in the code, however, the main focus of this thread is the algorithm to calculate the positions of the queens so that no two are in conflict.

[Krushert]

Any or all of those things could be included in the code,

Cool, I figured as much but I do not want it.  I was just thinking of how to break up future visits of boredoms with something clever.

however, the main focus of this thread is the algorithm to calculate the positions of the queens so that no two are in conflict.

I know the purpose of the thread and would want and keep it in the code.  I see this as "two birds killed with one stone" sort of thing.  It would break up my boredom and it would mess with the "square - uniform pattern - unimaginative" people that come in contact with my drawings.    

Just the architect smell affecting my brain, don't mind me to much.

[qjchen]

Recently, In Chinses Visual Lisp forum. There also exist some Challenges. This is the fourth Challenge problem.

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=90628&page=1#pid493821

I write this following code, it find all the solutions of n queens. certainly this code is not as good as Lee Mac's and Evgeniy's.

Code: [Select]

;;;; n queen solutions
(defun q:queen (n lst / i)
  (setq i 0)
  (repeat qn
    (if (not (q:queen:check i lst))
      (if (= n (1- qn))
          (setq final (cons (reverse (cons i lst)) final))
          (q:queen (1+ n) (cons i lst)))
    )
    (setq i (1+ i))
  )
)
;;;;position check
(defun q:queen:check (n1 lst1 / res x j)
  (setq j 1)
  (foreach x lst1
    (setq res (append res (list (- x j) x (+ x j)))j (1+ j))
  )
  (member n1 (vl-sort res '<))
)
;;;;Main solution
(defun c:test(/ final qn)
  (setq qn 8)
  (q:queen 0 nil)
  (foreach x (reverse final) (princ "\n") (princ x))
  (princ)
)
(princ "\n By qjchen@gmail.com, n Queens solution，The command is test")
(princ)


This following codes is to remove the same construction solutions and get the 12 unique solutions in 8 queens.

Code: [Select]

;;;; n queen solutions
(defun q:queen (n lst / i)
  (setq i 0)
  (repeat qn
    (if (not (q:queen:check i lst))
      (if (= n (1- qn))
          (setq final (cons (reverse (cons i lst)) final))
          (q:queen (1+ n) (cons i lst)))
    )
    (setq i (1+ i))
  )
)
;;;;position check
(defun q:queen:check (n1 lst1 / res x j)
  (setq j 1)
  (foreach x lst1
    (setq res (append res (list (- x j) x (+ x j)))j (1+ j))
  )
  (member n1 (vl-sort res '<))
)
;;;;inversion of queen lst
(defun q:queen:inv(lst / res)
 (setq i 0)
 (repeat (length lst) (setq res (cons (vl-position i lst) res) i (1+ i)))
 (reverse res)
)
;;;;mirror of y axis of queen lst
(defun q:queen:mirrory(lst)
 (mapcar '(lambda(x) (- (length lst) 1 x)) lst)
)
;;;;mirror of x axis of queen lst
(defun q:queen:mirrorx(lst) (reverse lst))
;;;;rotate 90 degreed of queen lst
(defun q:queen:rot90(lst) (q:queen:mirrory (q:queen:inv lst)))
;;;;all 9 same construction solutions
(defun q:queen:allsame(lst / res l1 l2 l3)
 (setq l1 (q:queen:rot90 lst) res (cons (q:queen:mirrorx l1) (cons (q:queen:mirrory l1) (cons l1 res))))
 (setq l2 (q:queen:rot90 l1) res (cons (q:queen:mirrorx l2) (cons (q:queen:mirrory l2) (cons l2 res))))
 (setq l3 (q:queen:rot90 l2) res (cons (q:queen:mirrorx l1) (cons (q:queen:mirrory l3) (cons l3 res))))
 res
)
;;;;deal the same construction solution
(defun q:queen:removeallsame(lst / res a1)
 (while (car lst)
   (setq res (cons (setq a1 (car lst)) res)
         lst (q:list:removebfroma (cdr lst) (q:queen:allsame a1)))
 )
 res
)
;;;;remove lstb from lsta
(defun q:list:removebfroma(lsta lstb / x)
 (foreach x lstb (setq lsta (vl-remove x lsta)))
)
;;;;Main solution
(defun c:test(/ final qn)
  (setq qn (getint "\n Please input the number of queens (suggest to be less than 10):"))
  (if (not qn) (setq qn 8))
  (q:queen 0 nil)
  (setq final (q:queen:removeallsame (reverse final)))
  (foreach x (reverse final) (princ "\n") (princ x))
  (princ)
)
(princ "\n By qjchen@gmail.com, n Queens solution，The command is test")
(princ)

BTW, in MJTD, the Chinese LISP forum.
The other recent three challenges are

1. How to Calculate PI to 10000 digits
http://bbs.mjtd.com/thread-90139-1-1.html
In this post, I write the code by Machin algorithm, but it is not so quick, and Highflybird write a very quick code.

2. To draw the 10000 paths of the light from one point to a curve (which represent the boundary between two different isotropic media) and then refract.  (That means, you select a curve for boundary, a point for sun, then input the indices of refraction of the two medias, then draw 10000 paths)
http://bbs.mjtd.com/thread-90226-1-1.html


3. The problem of Squaring the square
http://bbs.mjtd.com/thread-90547-1-1.html
This is a very difficult problem. I have still no ideas on it.
To Find the Lowest-order perfect squared square
http://en.wikipedia.org/wiki/Squaring_the_square


My dear friends in theSwamp, I hope you will also like these Challenges.

[Lee Mac]

Thanks for sharing Chen! 

[apricot125]

Code: [Select]

(defun queen (n / ans)
  (foreach e (Permutation n)
    (if (valid e 0 1) (setq ans (append ans (list e))))
  )
  ans
)

(defun list-ins-i (lst pos v)
  (if (zerop pos)
    (cons v lst)
    (cons (car lst) (list-ins-i (cdr lst) (1- pos) v))
  )
)

(defun Permutation (n)
  (if (= n 1)
    '((1))
    (apply 'append (mapcar '(lambda (x) (mapcar '(lambda (m) (list-ins-i x m n)) (range 0 n)))
                                        (Permutation (1- n))
                   ))
  )
)

(defun range(m n)
  (cond ((= m (1- n)) (list (1- n)))
        (t (cons m (range (1+ m) n)))
  )
)

(defun valid (x left-pos dist)
  (cond
     ((= dist (length x)) t)
     ((= dist (abs (- (nth left-pos x) (nth (+ left-pos dist) x)))) nil)
     ((< (+ left-pos dist) (1- (length x))) (valid x (1+ left-pos) dist))
     (t (valid x 0 (1+ dist)))
  )
)


[d2010]

I try make 3D view.