Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (define (element-by-index index lis)
- (define (iter i rest-lis)
- (if (< i index)
- (iter (+ i 1) (cdr rest-lis))
- (car rest-lis)))
- (if (> index (length lis))
- (begin (print "error element-by-index")
- 0)
- (iter 1 lis)))
- (define (replace-by-index el index lis)
- (define (iter i result rest-lis)
- (if (< i index)
- (iter (+ i 1)
- (append result (list (car rest-lis)))
- (cdr rest-lis))
- (append (append result (list el)) (cdr rest-lis))))
- (if (> index (length lis))
- (begin (print "error replace-by-index")
- 0)
- (iter 1 (list) lis)))
- (define (queens board-size)
- (define empty-board (map (lambda (i) (map (lambda (j) (list j 0))
- (enumerate 1 board-size)))
- (enumerate 1 board-size)))
- (define empty-col (map (lambda (x) (list x 0)) (enumerate 1 board-size)))
- (define (safe? k positions)
- (define (queen-row col)
- (fold-right
- (lambda (x y) (+ y (if (= 1 (cadr x))
- (car x)
- 0)))
- 0
- (element-by-index col positions)))
- (define (safe-row?)
- (if (< 1 (fold-right
- (lambda (x y) (+ y (cadr x)))
- 0
- (element-by-index
- (queen-row k)
- (transpose positions))))
- #f
- #t))
- (define (safe-diag-top?)
- (define (iter row col)
- (cond ((or (< row 1)
- (< col 1))
- #t)
- ((= 1 (cadr (element-by-index
- row
- (element-by-index
- col
- positions))))
- #f)
- ((or (<= col 1)
- (<= row 1))
- #t)
- (else (iter (- row 1) (- col 1)))))
- (iter (- (queen-row k) 1) (- k 1)))
- (define (safe-diag-bot?)
- (define (iter row col)
- (cond ((or (> row board-size)
- (< col 1))
- #t)
- ((= 1 (cadr (element-by-index
- row
- (element-by-index
- col
- positions))))
- #f)
- ((or (<= col 1)
- (>= row board-size))
- #t)
- (else (iter (+ row 1) (- col 1)))))
- (iter (+ (queen-row k) 1) (- k 1)))
- (and (safe-row?)
- (safe-diag-top?)
- (safe-diag-bot?)))
- (define (adjoin-position nr c q)
- (replace-by-index
- (replace-by-index (list nr 1) nr empty-col)
- c
- q))
- (define (queen-cols k)
- (if (= 0 k)
- (list empty-board)
- (filter (lambda (positions) (safe? k positions))
- (flatmap (lambda (rest-of-queens)
- (map (lambda (new-row)
- (adjoin-position new-row k rest-of-queens))
- (enumerate 1 board-size)))
- (queen-cols (- k 1))))))
- (queen-cols board-size))
- (define (print-board b)
- (map (lambda (row) (print (map (lambda (col) (cadr col)) row)))
- (transpose b))
- (newline))
- (time (map print-board (queens 8)))
Add Comment
Please, Sign In to add comment