150 lines
4.4 KiB
Racket
150 lines
4.4 KiB
Racket
#lang racket
|
|
;; 2.40
|
|
(define (unique-pairs n)
|
|
(define (collect j)
|
|
(let loop [(j j) (i n) (acc '())]
|
|
(if (>= j i)
|
|
acc
|
|
(loop j (- i 1) (cons (list i j) acc)))))
|
|
(define (iter j acc)
|
|
(if (>= j n)
|
|
acc
|
|
(iter (+ j 1) (append (collect j) acc))))
|
|
(iter 1 '()))
|
|
|
|
;; 2.41
|
|
;; Note: this is kind of inefficient, as it generates a ton of
|
|
;; lists, but I presume that's what the book is kind of suggesting
|
|
;; in this chapter: i.e. the generate list, then filter approach.
|
|
(define (flatmap f l)
|
|
(foldr (λ (x y) (append (f x) y))
|
|
'()
|
|
l))
|
|
(define (triples n s)
|
|
(define (genlast l)
|
|
(map (λ (x) (cons x l))
|
|
(range 1 (if (null? l)
|
|
n
|
|
(first l)))))
|
|
(define (gentriples)
|
|
(flatmap genlast
|
|
(flatmap genlast
|
|
(flatmap genlast
|
|
'(())))))
|
|
(define (sum-s? l)
|
|
(= (foldl + 0 l) s))
|
|
(filter sum-s? (gentriples)))
|
|
|
|
;; 2.42
|
|
;; We represent a board as a linked-list of queen positions.
|
|
;; nth element is the position of the queen on column n.
|
|
;; each position is a list of (x y) coordinates (starting from 0).
|
|
(define empty-board '())
|
|
(define (adjoin-position r c board)
|
|
(append board (list (list c r))))
|
|
(define (kth-queen k board)
|
|
(list-ref board (- k 1)))
|
|
(define (threatens? p1 p2)
|
|
(let [(ydiff (abs (- (second p1) (second p2))))]
|
|
(cond
|
|
[(= (abs (- (first p1) (first p2))) ydiff) #t]
|
|
[(= ydiff 0) #t]
|
|
[else #f])))
|
|
(define (safe? c board)
|
|
(define (iter i)
|
|
(cond
|
|
[(< i 1) #t]
|
|
[(threatens? (kth-queen i board) (kth-queen c board)) #f]
|
|
[else (iter (- i 1))]))
|
|
(iter (- c 1)))
|
|
(define (enumerate-interval a b) (range a (+ b 1)))
|
|
(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))
|
|
|
|
;; 2.43
|
|
;; The reason this causes the program to run slowly, is that
|
|
;; now the recursive queen-cols call is inside another map
|
|
;; call. This means that queen-cols will recursively call
|
|
;; itself again and again with the same value - for instance,
|
|
;; (queen-cols 8) will call (queen-cols 7) 8 times, (one for each
|
|
;; item in the result of the enumerate-interval call).
|
|
;; But (queen-cols 7) itself will call (queen-cols 6) 7 times,
|
|
;; and so on and so forth.
|
|
|
|
;; This makes the algorithm inefficient,
|
|
;; as the same work is unnecessarily repeated.
|
|
;; The runtime of this flawed algorithm should roughly
|
|
;; be proportional to T^2.
|
|
|
|
;; 2.44
|
|
;; we don't have definitions for these yet, so I'm providing
|
|
;; dummy procedures
|
|
(define (beside x y) #f)
|
|
(define (below x y) #f)
|
|
(define (right-split painter n)
|
|
(if (= n 0)
|
|
painter
|
|
(let ((smaller (right-split painter (- n 1))))
|
|
(beside painter (below smaller smaller)))))
|
|
|
|
(define (up-split painter n)
|
|
(if (= n 0)
|
|
painter
|
|
(let ((smaller (up-split painter (- n 1))))
|
|
(below painter (beside smaller smaller)))))
|
|
;; 2.45
|
|
(define (split f1 f2)
|
|
(define (inner painter n)
|
|
(if (= n 0)
|
|
painter
|
|
(let [(smaller (inner painter (- n 1)))]
|
|
(f1 painter (f2 smaller smaller)))))
|
|
inner)
|
|
;(define right-split (split beside below))
|
|
;(define up-split (split below beside))
|
|
|
|
;; 2.46
|
|
;; make-vect is defined by the define-struct form.
|
|
;; we could also define using a cons. literally the same,
|
|
;; performance-wise. But a little nicer I think.
|
|
(define-struct vect (xcoor ycoor))
|
|
(define xcoor-vect vect-xcoor)
|
|
(define ycoor-vect vect-ycoor)
|
|
|
|
(define (op-vect op)
|
|
(λ (v1 v2)
|
|
(make-vect (apply op (map vect-xcoor (list v1 v2)))
|
|
(apply op (map vect-ycoor (list v1 v2))))))
|
|
(define add-vect (op-vect +))
|
|
(define sub-vect (op-vect -))
|
|
(define (scale-vect v n)
|
|
(make-vect (* (vect-xcoor v) n)
|
|
(* (vect-ycoor v) n)))
|
|
;; 2.47
|
|
(define (make-frame1 origin edge1 edge2)
|
|
(list origin edge1 edge2))
|
|
(define (frame-origin1 f)
|
|
(list-ref f 0))
|
|
(define (frame-edge1-1 f)
|
|
(list-ref f 1))
|
|
(define (frame-edge2-1 f)
|
|
(list-ref f 2))
|
|
|
|
(define (make-frame2 origin edge1 edge2)
|
|
(cons origin (cons edge1 edge2)))
|
|
(define frame-origin2 car)
|
|
(define frame-edge1-2 cadr)
|
|
(define frame-edge2-2 cddr)
|