ompayne
/
sicp
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Rewrite 2.42 more clearly and add 2.43 (was missing)

This commit is contained in:
Oliver Payne 2023-11-15 22:54:12 +00:00
parent 32eabfa3e0
commit 1c6d87d844
2 changed files with 48 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
2-42.rkt
View File

@ -1,5 +1,7 @@
#lang sicp
(#%require racket/trace)
(#%require (only racket/base time))
;; From the book
@ -25,6 +27,8 @@
(cons low (enumerate-interval (+ low 1) high))))
;; EXERCISE 2.42
(define (queens board-size)
(define (queen-cols k)
(if (= k 0)
@ -39,48 +43,57 @@
(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))))
(define (safe? 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
;; lie on the same diagonal and are thus not safe wrt each other.
(define (positive-intercept position)
(- (row position) (col position)))
(define (negative-intercept position)
(+ (row position) (col position)))
(let ((kth-position (list-ref positions (- k 1)))
(pre-kth-positions (cdr (reverse positions))))
;; If the row, positive or negative intercept of the k-th position
;; is equal to any of the first k-1 positions, then the k-th
;; position is not safe.
(and (not (memv (row kth-position)
(map row pre-kth-positions)))
(not (memv (positive-intercept kth-position)
(map positive-intercept pre-kth-positions)))
(not (memv (negative-intercept kth-position)
(map negative-intercept pre-kth-positions))))))
; 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))))))
;; Exercise 2.43
;; This is slower than the first version from the book because
;; (queen-cols (- k 1)) is inside the inner lambda and so is
;; re-evaluated recursively for each new row (ie board-size times).
;; The faster version evaluates (queen-cols (- k 1)) only once in the
;; outer flatmap.
;; So if the faster version takes time T, this version will take
;; approximately time
(define (queens-slow board-size)
(define (queen-cols k)
(if (= k 0)
(list empty-board)
(filter
(lambda (positions) (safe? k positions))
(flatmap
(lambda (new-row)
(map (lambda (rest-of-queens)
(adjoin-position new-row k rest-of-queens))
(queen-cols (- k 1))))
(enumerate-interval 1 board-size)))))
(queen-cols board-size))

65
2_40.sch
View File

@ -87,68 +87,3 @@
(define (triple-leq-n-sum-s n s)
(filter (lambda (x) (= (sum x) s)) (ordered-triples n)))
;; 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))))))
; Neater solution using map / accumulate with checks?
;(define (safe? k positions)
; (accumulate and #t (map