felixm
/
SICP
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Implement till 4.44

main
Felix Martin 2021-02-05 11:12:59 -05:00
parent 59a86be7e5
commit 1a2ae825d2
2 changed files with 71 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
ex-2_33-43.scm
View File

@ -274,9 +274,9 @@
(display (length (queens 8))) (newline)
(display "\nex-2.43 - see comments\n")
(display "[done]\n")
;(flatmap
; (lambda (new-row)
; (map (lambda (rest-of-queens)

70
ex-4_35-xx.scm
View File

@ -264,5 +264,73 @@
(display "\nex-4.43 - lornas-father\n")
; (display "\nex-4.44 - eight-queens\n")
; (daughter father yacht)
(define daughter first)
(define father second)
(define yacht third)
(define (lornas-father)
(let* ((moore-daughter (amb 'mary-ann))
(moore-yacht (amb 'lorna))
(moore (list moore-daughter 'moore moore-yacht)))
(let* ((downing-daughter (amb 'gabrielle 'lorna 'rosalind))
(downing-yacht (amb 'melissa))
(downing (list downing-daughter 'downing downing-yacht)))
(require (distinct? (list moore-daughter downing-daughter)))
(require (distinct? (list moore-yacht downing-yacht)))
(require (distinct? (list downing-yacht downing-daughter)))
(let* ((hall-daughter (amb 'gabrielle 'lorna 'melissa))
(hall-yacht (amb 'rosalind))
(hall (list hall-daughter 'hall hall-yacht)))
(require (distinct? (list hall-yacht hall-daughter)))
(require (distinct? (list moore-daughter downing-daughter hall-daughter)))
(require (distinct? (list moore-yacht downing-yacht hall-yacht)))
(let* ((barnacle-daughter (amb 'melissa))
(barnacle-yacht (amb 'gabrielle))
(barnacle (list barnacle-daughter 'barnacle barnacle-yacht)))
(require (distinct? (list barnacle-yacht barnacle-daughter)))
(require (distinct? (list moore-daughter downing-daughter hall-daughter barnacle-daughter)))
(require (distinct? (list moore-yacht downing-yacht hall-yacht barnacle-yacht)))
(let* ((parker-daughter (amb 'gabrielle 'lorna 'rosalind 'melissa))
(parker-yacht (amb 'mary-ann 'gabrielle 'lorna 'rosalind 'melissa))
(parker (list parker-daughter 'parker parker-yacht)))
(require (distinct? (list parker-yacht parker-daughter)))
(require (distinct? (list moore-daughter downing-daughter hall-daughter barnacle-daughter parker-daughter)))
(require (distinct? (list moore-yacht downing-yacht hall-yacht barnacle-yacht parker-yacht)))
(require (eq? parker-daughter (yacht (assoc 'gabrielle (list moore downing hall barnacle parker)))))
(father (assoc 'lorna (list moore downing hall barnacle parker)))))))))
(my-assert (lornas-father) 'downing)
(display "\nex-4.44 - eight-queens\n")
; Copied from ex-2_33-43.scm
(define (safe? board)
(define (valid-position row diag board)
(if (null? board)
#t
(let ((cur_row (car board)))
(if (or (= row cur_row) ; same row
(= (+ row diag) cur_row) ; upper right diagonal
(= (- row diag) cur_row)) ; lower left diagonal
#f
(valid-position row (+ diag 1) (cdr board))))))
(valid-position (car board) 1 (cdr board)))
(define (queens)
(define (positions)
(amb 1 2 3 4 5 6 7 8))
(define (queens-iter board remaining)
(if (= remaining 0)
board
(let* ((current-queen (positions))
(new-board (cons current-queen board)))
(require (safe? new-board))
(queens-iter new-board (- remaining 1)))))
(queens-iter '() 8))
(my-assert (queens) '(4 2 7 3 6 8 5 1))
(display "\nex-4.45\n")