Created
October 13, 2013 07:42
-
-
Save rui314/6959261 to your computer and use it in GitHub Desktop.
A nqueen solver that works on my lisp implemenation (https://github.com/rui314/minilisp)
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(defun list (expr . rest) | |
(cons expr rest)) | |
(defun zero? (expr) | |
(= expr 0)) | |
(defun nil? (expr) | |
(eq expr ())) | |
(defmacro let1 (var val . body) | |
(list (cons 'lambda (cons (list var) body)) | |
val)) | |
(defun not (expr) | |
(if expr () t)) | |
(defmacro unless (expr . body) | |
(cons 'if (cons expr (cons () body)))) | |
(defmacro and (expr . rest) | |
(if (nil? rest) | |
expr | |
(list 'if expr (cons 'and rest)))) | |
(defmacro or (expr . rest) | |
(if (nil? rest) | |
expr | |
(let1 var (gensym) | |
(list 'let1 var expr | |
(list 'if var var (cons 'or rest)))))) | |
(defun any (lis pred) | |
(if (nil? lis) | |
() | |
(or (pred (car lis)) | |
(any (cdr lis) pred)))) | |
(defmacro do (label vars vals . body) | |
(list 'let1 label () | |
(list 'setq label (cons 'lambda (cons vars body))) | |
(cons label vals))) | |
(defun for-each (list fn) | |
(if (nil? (cdr list)) | |
(fn (car list)) | |
(fn (car list)) | |
(for-each (cdr list) fn))) | |
(defun <= (e1 e2) | |
(or (< e1 e2) (= e1 e2))) | |
;;; ---------------------------------------------------------------------- | |
(defun make-list (len gen) | |
(if (zero? len) | |
() | |
(cons (gen) (make-list (- len 1) gen)))) | |
(defun nth (list n) | |
(if (zero? n) | |
(car list) | |
(nth (cdr list) (- n 1)))) | |
(defun nth-tail (list n) | |
(if (zero? n) | |
list | |
(nth-tail (cdr list) (- n 1)))) | |
(defun iota (n) | |
(do loop (m) (0) | |
(if (< m n) | |
(cons m (loop (+ m 1))) | |
()))) | |
;;; ---------------------------------------------------------------------- | |
(define board-size 6) | |
(defun make-board (size) | |
(make-list size | |
(lambda () (make-list size (lambda () 'x))))) | |
(define board (make-board board-size)) | |
(defun set? (board x y) | |
(eq (nth (nth board x) y) '@)) | |
(defun set (board x y) | |
(setcar (nth-tail (nth board x) y) '@)) | |
(defun clear (board x y) | |
(setcar (nth-tail (nth board x) y) 'x)) | |
(defun print-board (board) | |
(for-each board println) | |
(println '$)) | |
(defun conflict? (board x y) | |
(or (any (iota board-size) | |
(lambda (n) (set? board n y))) | |
(any (iota x) | |
(lambda (n) | |
(or (let1 m (- y (- x n)) | |
(and (<= 0 m) | |
(set? board n m))) | |
(let1 m (+ y (- x n)) | |
(and (< m board-size) | |
(set? board n m)))))))) | |
(defun %solve (board x) | |
(if (= x board-size) | |
(print-board board) | |
(for-each (iota board-size) | |
(lambda (y) | |
(unless (conflict? board x y) | |
(set board x y) | |
(%solve board (+ x 1)) | |
(clear board x y)))))) | |
(defun solve (board) | |
(println 'begin) | |
(%solve board 0) | |
(println 'done)) | |
(solve board 0) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment