How to solve N-Queens on a circuit?

Question

I am stuck in Exercise 28.2, How to Create Programs . I used a vector of true or false values ​​to represent the board instead of using a list. This is what I have that doesn't work:

#lang Scheme (define-struct posn (ij)) ;takes in a position in i, j form and a board and ; returns a natural number that represents the position in index form ;example for board xxx ; xxx ; xxx ;(0, 1) -> 1 ;(2, 1) -> 7 (define (board-ref a-posn a-board) (+ (* (sqrt (vector-length a-board)) (posn-i a-posn)) (posn-j a-posn))) ;reverse of the above function ;1 -> (0, 1) ;7 -> (2, 1) (define (get-posn n a-board) (local ((define board-length (sqrt (vector-length a-board)))) (make-posn (floor (/ n board-length)) (remainder n board-length)))) ;determines if posn1 threatens posn2 ;true if they are on the same row/column/diagonal (define (threatened? posn1 posn2) (cond ((= (posn-i posn1) (posn-i posn2)) #t) ((= (posn-j posn1) (posn-j posn2)) #t) ((= (abs (- (posn-i posn1) (posn-i posn2))) (abs (- (posn-j posn1) (posn-j posn2)))) #t) (else #f))) ;returns a list of positions that are not threatened or occupied by queens ;basically any position with the value true (define (get-available-posn a-board) (local ((define (get-ava index) (cond ((= index (vector-length a-board)) '()) ((vector-ref a-board index) (cons index (get-ava (add1 index)))) (else (get-ava (add1 index)))))) (get-ava 0))) ;consume a position in the form of a natural number and a board ;returns a board after placing a queen on the position of the board (define (place n a-board) (local ((define (foo x) (cond ((not (board-ref (get-posn x a-board) a-board)) #f) ((threatened? (get-posn x a-board) (get-posn n a-board)) #f) (else #t)))) (build-vector (vector-length a-board) foo))) ;consume a list of positions in the form of natural numbers, and a board ;returns a list of boards after placing queens on each of the positions ; on the board (define (place/list alop a-board) (cond ((empty? alop) '()) (else (cons (place (first alop) a-board) (place/list (rest alop) a-board))))) ;returns a possible board after placing n queens on a-board ;returns false if impossible (define (placement n a-board) (cond ((zero? n) a-board) (else (local ((define available-posn (get-available-posn a-board))) (cond ((empty? available-posn) #f) (else (or (placement (sub1 n) (place (first available-posn) a-board)) (placement/list (sub1 n) (place/list (rest available-posn) a-board))))))))) ;returns a possible board after placing n queens on a list of boards ;returns false if all the boards are not valid (define (placement/list n boards) (cond ((empty? boards) #f) ((zero? n) (first boards)) ((not (boolean? (placement n (first boards)))) (first boards)) (else (placement/list n (rest boards))))) 

Answer 1

This is not the fastest implementation of the circuit, but it is pretty brief. I came up with this on my own, but I doubt it is unique. This is in the PLT Scheme, so some function names need to be changed to run it in R6RS. The list of solutions and each solution are built with minuses, so they are reversed. The turns and maps at the end reorder everything and add lines to the solutions for pretty output. Most languages ​​have a function like fold, see:
http://en.wikipedia.org/wiki/Fold_%28higher-order_function%29

 #lang scheme/base (define (N-Queens N) (define (attacks? delta-row column solution) (and (not (null? solution)) (or (= delta-row (abs (- column (car solution)))) (attacks? (add1 delta-row) column (cdr solution))))) (define (next-queen safe-columns solution solutions) (if (null? safe-columns) (cons solution solutions) (let move-queen ((columns safe-columns) (new-solutions solutions)) (if (null? columns) new-solutions (move-queen (cdr columns) (if (attacks? 1 (car columns) solution) new-solutions (next-queen (remq (car columns) safe-columns) (cons (car columns) solution) new-solutions))))))) (unless (exact-positive-integer? N) (raise-type-error 'N-Queens "exact-positive-integer" N)) (let ((rows (build-list N (λ (row) (add1 row))))) (reverse (map (λ (columns) (map cons rows (reverse columns))) (next-queen (build-list N (λ (i) (add1 i))) null null))))) 

If you are thinking about a problem, the list is indeed the natural data structure for this problem. Since only one queen can be placed on each row, all you need to do is pass the list of inert or unused columns to the iterator for the next row. This is done by calling remq in the cond clause, which makes a callback to the next queen.

The foldl function can be rewritten as named let:

 (define (next-queen safe-columns solution solutions) (if (null? safe-columns) (cons solution solutions) (let move-queen ((columns safe-columns) (new-solutions solutions)) (if (null? columns) new-solutions (move-queen 

This is significantly faster since it avoids checking the add-in built into foldl. I came up with the idea of ​​using implicit strings when viewing the PLT Scheme N-Queens test. Starting with the delta line of one and increasing it as the solution is tested, it is pretty smooth. For some reason, abs is expensive in PLT Scheme, so is there a faster form for attacks?

In a PLT scheme, you need to use a mutable list type for the fastest implementation. A test that takes decisions into account without returning them can be written without creating any cons elements other than the original list of columns. This avoids garbage collection up to N = 17, when 618 milliseconds were spent in gc, while the program spent 1 hour, 51 minutes searching 95,815 104 solutions.

Answer 2

This is me again. I thought and tormented the question over the past few days and finally got an answer.

Since no one answered the question. I will just post it here to those who may find this useful.

For the curious, I use DrScheme.

Below is the code.

  #lang scheme

 ; the code between the lines is a graph problem
 ; it is adapted into the n-queens problem later

 ; ------------------------------------------------- -------------------------------------------------- ----------------------

 (define (neighbors node graph)
   (cond
     ((empty? graph) '())
     ((symbol =? (first (first graph)) node)
      (first (rest (first graph))))
     (else (neighbors node (rest graph)))))

 ;;  find-route: node node graph -> (listof node) or false
 ;;  to create a path from origination to destination in G
 ;;  if there is no path, the function produces false
 (define (find-route origination destination G)
   (cond
     [(symbol =? origination destination) (list destination)]
     [else (local ((define possible-route 
             (find-route / list (neighbors origination G) destination G)))
         (cond
           [(boolean? possible-route) false]
           [else (cons origination possible-route)]))]))

 ;;  find-route / list: (listof node) node graph -> (listof node) or false
 ;;  to create a path from some node on lo-Os to D
 ;;  if there is no path, the function produces false
 (define (find-route / list lo-Os DG)
   (cond
     [(empty? lo-Os) false]
     [else (local ((define possible-route (find-route (first lo-Os) DG)))
         (cond
           [(boolean? possible-route) (find-route / list (rest lo-Os) DG)]
           [else possible-route]))]))

   (define Graph 
     '((A (BE))
       (B (EF))
       (C (D))
       (D ())
       (E (CF))
       (F (DG))
       (G ())))

 ; test
 (find-route 'A' G Graph)

 ; ------------------------------------------------- -------------------------------------------------- ----------------------


 ;  the chess board is represented by a vector (aka array) of # t / # f / 'q values
 ;  #t represents a position that is not occupied nor threatened by a queen
 ;  #f represents a position that is threatened by a queen
 ;  'q represents a position that is occupied by a queen
 ;  an empty chess board of nxn can be created by (build-vector (* nn) (lambda (x) #t))

 ;  returns the board length of a-board
 ;  eg.  returns 8 if the board is an 8x8 board
 (define (board-length a-board)
   (sqrt (vector-length a-board)))

 ;  returns the row of the index on a-board
 (define (get-row a-board index)
   (floor (/ index (board-length a-board))))

 ;  returns the column of the index on a-board
 (define (get-column a-board index)
   (remainder index (board-length a-board)))

 ;  returns true if the position refered to by index n1 threatens the position refered to by index n2 and vice-versa
 ;  true if n1 is on the same row / column / diagonal as n2
 (define (threatened? a-board n1 n2)
   (cond
     ((= (get-row a-board n1) (get-row a-board n2)) #t)
     ((= (get-column a-board n1) (get-column a-board n2)) #t)
     ((= (abs (- (get-row a-board n1) (get-row a-board n2)))
         (abs (- (get-column a-board n1) (get-column a-board n2)))) #t)
     (else #f)))

 ; returns a board after placing a queen on index n on a-board
 (define (place-queen-on-n a-board n)
   (local ((define (foo x)
             (cond
               ((= nx) 'q)
               ((eq? (vector-ref a-board x) 'q)' q)
               ((eq? (vector-ref a-board x) #f) #f)
               ((threatened? a-board nx) #f)
               (else #t))))
     (build-vector (vector-length a-board) foo)))

 ;  returns the possitions that are still available on a-board
 ;  basically returns positions that has the value #t
 (define (get-possible-posn a-board)
   (local ((define (get-ava index)
             (cond
               ((= index (vector-length a-board)) '())
               ((eq? (vector-ref a-board index) #t)
                (cons index (get-ava (add1 index))))
               (else (get-ava (add1 index))))))
     (get-ava 0)))

 ;  returns a list of boards after placing a queen on a-board
 ;  this function acts like the function neighbors in the above graph problem
 (define (place-a-queen a-board)
   (local ((define (place-queen lop)
             (cond
               ((empty? lop) '())
               (else (cons (place-queen-on-n a-board (first lop))
                           (place-queen (rest lop)))))))
     (place-queen (get-possible-posn a-board))))

 ;  main function
 ;  this function acts like the function find-route in the above graph problem
 (define (place-n-queens origination destination a-board)
   (cond
     ((= origination destination) a-board)
     (else (local ((define possible-steps
                     (place-n-queens / list (add1 origination)
                                          destination
                                          (place-a-queen a-board))))
             (cond
               ((boolean? possible-steps) #f)
               (else possible-steps))))))

 ;  this function acts like the function find-route / list in the above graph problem
 (define (place-n-queens / list origination destination boards)
   (cond
     ((empty? boards) #f)
     (else (local ((define possible-steps
                     (place-n-queens origination 
                                     destination 
                                     (first boards))))          
             (cond
               ((boolean? possible-steps)
                (place-n-queens / list origination 
                                     destination
                                     (rest boards)))
               (else possible-steps))))))

 ; test
 ; place 8 queens on an 8x8 board
 (place-n-queens 0 8 (build-vector (* 8 8) (lambda (x) #t)))

Answer 3

This is from about 11 years ago, when I had a functional programming class, and I think it used either the MIT scheme or mzScheme. Basically these are just changes from the Springer / Friedman text we used, which just decided for 8 queens. The exercise was to generalize it to the N queens that this code does.

 ;_____________________________________________________ ;This function tests to see if the next attempted move (try) ;is legal, given the list that has been constructed thus far ;(if any) - legal-pl (LEGAL PLacement list) ;NB - this function is an EXACT copy of the one from ;Springer and Friedman (define legal? (lambda (try legal-pl) (letrec ((good? (lambda (new-pl up down) (cond ((null? new-pl) #t) (else (let ((next-pos (car new-pl))) (and (not (= next-pos try)) (not (= next-pos up)) (not (= next-pos down)) (good? (cdr new-pl) (add1 up) (sub1 down))))))))) (good? legal-pl (add1 try) (sub1 try))))) ;_____________________________________________________ ;This function tests the length of the solution to ;see if we need to continue "cons"ing on more terms ;or not given to the specified board size. ; ;I modified this function so that it could test the ;validity of any solution for a given boardsize. (define solution? (lambda (legal-pl boardsize) (= (length legal-pl) boardsize))) ;_____________________________________________________ ;I had to modify this function so that it was passed ;the boardsize in its call, but other than that (and ;simply replacing "fresh-start" with boardsize), just ;about no changes were made. This function simply ;generates a solution. (define build-solution (lambda (legal-pl boardsize) (cond ((solution? legal-pl boardsize) legal-pl) (else (forward boardsize legal-pl boardsize))))) ;_____________________________________________________ ;This function dictates how the next solution will be ;chosen, as it is only called when the last solution ;was proven to be legal, and we are ready to try a new ;placement. ; ;I had to modify this function to include the boardsize ;as well, since it invokes "build-solution". (define forward (lambda (try legal-pl boardsize) (cond ((zero? try) (backtrack legal-pl boardsize)) ((legal? try legal-pl) (build-solution (cons try legal-pl) boardsize)) (else (forward (sub1 try) legal-pl boardsize))))) ;_____________________________________________________ ;This function is used when the last move is found to ;be unhelpful (although valid) - instead it tries another ;one until it finds a new solution. ; ;Again, I had to modify this function to include boardsize ;since it calls "forward", which has boardsize as a ;parameter due to the "build-solution" call within it (define backtrack (lambda (legal-pl boardsize) (cond ((null? legal-pl) '()) (else (forward (sub1 (car legal-pl)) (cdr legal-pl) boardsize))))) ;_____________________________________________________ ;This is pretty much the same function as the one in the book ;with just my minor "boardsize" tweaks, since build-solution ;is called. (define build-all-solutions (lambda (boardsize) (letrec ((loop (lambda (sol) (cond ((null? sol) '()) (else (cons sol (loop (backtrack sol boardsize)))))))) (loop (build-solution '() boardsize))))) ;_____________________________________________________ ;This function I made up entirely myself, and I only ;made it really to satisfy the syntactical limitations ;of the laboratory instructions. This makes it so that ;the input of "(queens 4)" will return a list of the ;two possible configurations that are valid solutions, ;even though my modifiend functions would return the same ;value by simply inputting "(build-all-solutions 4)". (define queens (lambda (n) (build-all-solutions n))) 

Answer 4

Watch the master (Hal Ableson):

http://www.youtube.com/watch?v=skd-nyVyzBQ