Add racket version of original 8-queens for comparison

This commit is contained in:
Oliver Payne 2023-11-12 22:29:12 +00:00
parent a1fb98ddad
commit 3d5db17a33
1 changed files with 86 additions and 0 deletions

86
2-42.rkt Normal file
View File

@ -0,0 +1,86 @@
#lang sicp
;; From the book
(define (filter predicate sequence)
(cond ((null? sequence) nil)
((predicate (car sequence))
(cons (car sequence)
(filter predicate (cdr sequence))))
(else (filter predicate (cdr sequence)))))
(define (accumulate op initial sequence)
(if (null? sequence)
initial
(op (car sequence)
(accumulate op initial (cdr sequence)))))
(define (flatmap proc seq)
(accumulate append nil (map proc seq)))
(define (enumerate-interval low high)
(if (> low high)
nil
(cons low (enumerate-interval (+ low 1) high))))
;; EXERCISE 2.42
(define (queens board-size)
(define (queen-cols k)
(if (= k 0)
(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-interval 1 board-size)))
(queen-cols (- k 1))))))
(queen-cols board-size))
(define empty-board '())
(define (position row col) (cons row col))
(define (row position) (car position))
(define (col position) (cdr position))
(define (intercepts horiz pos neg) (list horiz pos neg))
(define (horiz intercepts) (car intercepts))
(define (pos intercepts) (cadr intercepts))
(define (neg intercepts) (caddr intercepts))
(define (col-k-pos k positions)
(car (filter (lambda (x) (= (col x) k)) positions)))
; Compute the y-intercepts of the horizontal line the line
; of gradient +1 and the line of gradient -1 through the
; given position. Any two positions that share one of these
; intercepts put are not safe wrt each other.
(define (compute-intercepts position)
(intercepts (row position)
(- (row position) (col position))
(+ (row position) (col position))))
(define (checks pos1 pos2)
(if (= (col pos1) (col pos2))
#f
(let ((int1 (compute-intercepts pos1))
(int2 (compute-intercepts pos2)))
(or (= (horiz int1) (horiz int2))
(= (pos int1) (pos int2))
(= (neg int1) (neg int2))))))
(define (adjoin-position row col rest-of-queens)
(append rest-of-queens (list (position row col))))
; Calculuate the intercepts of each of the position. If any
; match, then the k-th position is not safe.
(define (safe? k positions)
(if (= (col (car positions)) k) #t ; Need to only check with first k-1
(let* ((k-pos (col-k-pos k positions))
(k-int (compute-intercepts k-pos))
(int (compute-intercepts (car positions))))
(and (not (= (horiz int) (horiz k-int)))
(not (= (pos int) (pos k-int)))
(not (= (neg int) (neg k-int)))
(safe? k (cdr positions))))))