Data commit

Task/N-queens-problem/Racket/n-queens-problem-1.rkt

@@ -0,0 +1,30 @@
+#lang racket
+
+(struct Q (x y) #:transparent)
+
+;; returns true if given q1 and q2 do not conflict
+(define (safe? q1 q2)
+  (match* (q1 q2)
+    [((Q x1 y1) (Q x2 y2))
+     (not (or (= x1 x2) (= y1 y2)
+              (= (abs (- x1 x2)) (abs (- y1 y2)))))]))
+
+;; returns true if given q doesn't conflict with anything in given list of qs
+(define (safe-lst? q qs) (for/and ([q2 qs]) (safe? q q2)))
+
+(define (nqueens n)
+  ;; qs is partial solution; x y is current position to try
+  (let loop ([qs null] [x 0] [y 0])
+    (cond [(= (length qs) n) qs]          ; found a solution
+          [(>= x n) (loop qs 0 (add1 y))] ; go to next row
+          [(>= y n) #f]                   ; current solution is invalid
+          [else
+           (define q (Q x y))
+           (if (safe-lst? q qs) ; is current position safe?
+               (or (loop (cons q qs) 0 (add1 y)) ; optimistically place a queen
+                                                 ; (and move pos to next row)
+                   (loop qs (add1 x) y))  ; backtrack if it fails
+               (loop qs (add1 x) y))])))
+
+(nqueens 8)
+; => (list (Q 3 7) (Q 1 6) (Q 6 5) (Q 2 4) (Q 5 3) (Q 7 2) (Q 4 1) (Q 0 0))

Task/N-queens-problem/Racket/n-queens-problem-2.rkt

@@ -0,0 +1,10 @@
+(require htdp/show-queen)
+
+(define (show-nqueens n)
+  (define qs (time (nqueens n)))
+  (show-queen
+   (for/list ([row n])
+     (for/list ([col n])
+       (if (member (Q row col) qs) #t #f)))))
+
+(show-nqueens 8)

Task/N-queens-problem/Racket/n-queens-problem-3.rkt

@@ -0,0 +1,45 @@
+#lang racket
+
+(struct Q (x y) #:transparent)
+
+(define-syntax-rule (lcons x y) (cons x (lazy y)))
+
+(define (lazy-filter p? lst)
+  (define flst (force lst))
+  (if (null? flst) '()
+      (let ([x (car flst)])
+        (if (p? x)
+            (lcons x (lazy-filter p? (cdr flst)))
+            (lazy-filter p? (cdr flst))))))
+
+(define (lazy-foldr f base lst)
+  (define flst (force lst))
+  (if (null? flst) base
+      (f (car flst) (lazy (lazy-foldr f base (cdr flst))))))
+
+(define (tails lst)
+  (if (null? lst) '(())
+      (cons lst (tails (cdr lst)))))
+
+(define (safe? q1 q2)
+  (match* (q1 q2)
+    [((Q x1 y1) (Q x2 y2))
+     (not (or (= x1 x2) (= y1 y2)
+              (= (abs (- x1 x2)) (abs (- y1 y2)))))]))
+
+(define (safe-lst? lst)
+  (or (null? lst)
+      (let ([q1 (car lst)])
+        (for/and ([q2 (cdr lst)]) (safe? q1 q2)))))
+
+(define (valid? lst) (andmap safe-lst? (tails lst)))
+
+(define (nqueens n)
+  (define all-possible-solutions
+    (for/fold ([qss-so-far '(())]) ([row (in-range n)])
+      (lazy-foldr
+       (λ (qs new-qss)
+         (append (for/list ([col (in-range n)]) (cons (Q row col) qs))
+                 new-qss))
+       '() qss-so-far)))
+  (lazy-filter valid? all-possible-solutions))

Task/N-queens-problem/Racket/n-queens-problem-4.rkt

@@ -0,0 +1,2 @@
+(car (nqueens 8))
+;; => (list (Q 7 3) (Q 6 1) (Q 5 6) (Q 4 2) (Q 3 5) (Q 2 7) (Q 1 4) (Q 0 0))

Task/N-queens-problem/Racket/n-queens-problem-5.rkt

@@ -0,0 +1,17 @@
+(define (force-and-print qs)
+  (define forced (force qs))
+  (unless (null? forced)
+    (printf "~v\n" (car forced))
+    (force-and-print (cdr forced))))
+
+(force-and-print (nqueens 8))
+
+; =>
+;(list (Q 7 3) (Q 6 1) (Q 5 6) (Q 4 2) (Q 3 5) (Q 2 7) (Q 1 4) (Q 0 0))
+;(list (Q 7 4) (Q 6 1) (Q 5 3) (Q 4 6) (Q 3 2) (Q 2 7) (Q 1 5) (Q 0 0))
+;(list (Q 7 2) (Q 6 4) (Q 5 1) (Q 4 7) (Q 3 5) (Q 2 3) (Q 1 6) (Q 0 0))
+;(list (Q 7 2) (Q 6 5) (Q 5 3) (Q 4 1) (Q 3 7) (Q 2 4) (Q 1 6) (Q 0 0))
+...
+;(list (Q 7 5) (Q 6 3) (Q 5 6) (Q 4 0) (Q 3 2) (Q 2 4) (Q 1 1) (Q 0 7))
+;(list (Q 7 3) (Q 6 6) (Q 5 4) (Q 4 1) (Q 3 5) (Q 2 0) (Q 1 2) (Q 0 7))
+;(list (Q 7 4) (Q 6 6) (Q 5 1) (Q 4 5) (Q 3 2) (Q 2 0) (Q 1 3) (Q 0 7))

Task/N-queens-problem/Racket/n-queens-problem-6.rkt

@@ -0,0 +1,56 @@
+#lang racket
+(define (remove x lst)
+  (for/list ([i (in-range (length lst))]
+             #:when (not (= x i)))
+    (list-ref lst i)))
+
+(define (switch-pairs lst)
+  (cond [(null? lst) '()]
+        [(null? (cdr lst)) (list '() (car lst))]
+        [else (append (list (cadr lst) (car lst))
+                      (switch-pairs (cddr lst)))]))
+
+(define (switch-places a1 a2 lst)
+  (for/list ([i (length lst)])
+    (list-ref lst (cond [(= a1 i) a2] [(= a2 i) a1] [else i]))))
+
+(define (position-queens n)
+  (cond [(= 1 n) (list (list 1))]
+        [(> 4 n) #f]
+        [else (possible-queens n)]))
+
+(define (possible-queens n)
+  (define rem (remainder n 12))
+  (define lst (build-list n add1))
+  (define evens (filter even? lst))
+  (define odds (filter odd? lst))
+  (cond [(or (= rem 9) (= rem 3)) (case3or9 evens odds)]
+        [(= rem 8) (case8 evens odds)]
+        [(= rem 2) (case2 evens odds)]
+        [else (append evens odds)]))
+
+(define (case3or9 evens odds)
+  (for/fold ([acum (append (cdr evens) (list (car evens)) odds)])
+            ([i (in-list '(1 3))])
+    (append (remove (list-ref acum i) acum) (list i))))
+
+(define (case8 evens odds)
+  (append evens (switch-pairs odds)))
+
+(define (case2 evens odds)
+  (define nums (append evens odds))
+  (define idx (map (λ(i) (list-ref nums i)) '(1 3 5)))
+  (append (remove (caddr idx)
+                  (switch-places (car idx) (cadr idx) nums))
+          '(5)))
+
+(define (queens n)
+  (define position-numbers (position-queens n))
+  (define positions-on-board
+    (for/list ([i n]) (cons i (sub1 (list-ref position-numbers i)))))
+  (for/list ([x n])
+    (for/list ([y n])
+      (if (member (cons x y) positions-on-board) "Q" "."))))
+
+(define (print-queens n)
+  (for ([x (queens n)]) (displayln (string-join x))))