;2.30
(define (square-tree tree)
(cond ((null? tree) '())
((not (pair? tree)) (* tree tree))
(else (cons (square-tree (car tree))
(square-tree (cdr tree))))))
(define (sq-tree tree)
(map (lambda (sub-tree)
(if (not (pair? sub-tree))
(* sub-tree sub-tree)
(sq-tree sub-tree)))
tree))
;2.31
(define (tree-map f tree)
(map (lambda (sub-tree)
(if (not (pair? sub-tree))
(f sub-tree)
(tree-map f sub-tree)))
tree))
(define (t-tree tree)
(tree-map square tree))
(define (square x)
(* x x))
;2.32
;null define
(define nil '())
(define (subsets s)
(if (null? s)
(list '())
(let ((rest (subsets (cdr s))))
(append rest (map (lambda (x) (cons (car s) x)) rest)))))
;2.33
(define (taccumulate op initial seq)
(if (null? seq)
initial
(op (car seq)
(taccumulate op initial (cdr seq)))))
(define (tmap p sequencet)
(taccumulate (lambda (x y)
(if (not (pair? x))
(cons (p x) y)
(cons (tmap p x) y)))
nil
sequencet))
(define (tappend seq1 seq2)
(taccumulate cons seq2 seq1))
(define (tlength seq)
(taccumulate (lambda (x y) (+ 1 y)) 0 seq))
;2.34
(define (horner-eval x coefficient-sequence)
(taccumulate (lambda (this-coeff higher-terms)
(+ this-coeff (* x higher-terms)))
0
coefficient-sequence))
;2.35
(define (count-leaves t)
(taccumulate + 0 (map (lambda (x)
(if (not (pair? x))
1
(count-leaves x)))
t)))
;2.36
(define (accumulate-n op init seqs)
(if (null? (car seqs))
nil
(cons (taccumulate op init (map (lambda (x) (car x)) seqs))
(accumulate-n op init (map (lambda (x) (cdr x)) seqs)))))
;2.37
;v(i) * w(i)
(define (dot-product v w)
(taccumulate + 0 (map * v w)))
;matrix * vector
(define (matrix-*-vector m v)
(map (lambda (x) (dot-product v x)) m))
;transpot
(define (transpose mat)
(accumulate-n cons nil mat))
;2.38
(define (fold-left op initial seqs)
(define (iter result rest)
(if (null? rest)
result
(iter (op result (car rest))
(cdr rest))))
(iter initial seqs))
;2.39
(define fold-right taccumulate)
(define (r-reverse seqs)
(fold-right (lambda (x y)
(if (not (pair? x))
(cons y x)
(cons y (r-reverse x)))) nil seqs))
(define (l-reverse seqs)
(fold-left (lambda (x y)
(if (not (pair? y))
(cons y x)
(cons (l-reverse y) x))) nil seqs))
;2.40
;make pair
(define (enumerate-interval k n)
(define (iter i)
(cond ((= i (- n 1)) (list (- n 1)))
((or (> k n) (= k n)) nil)
(else (append (list i) (iter (+ 1 i))))))
(iter k))
(define (proc-i n)
(map (lambda (x) (cons n x)) (enumerate-interval 1 n)))
(define (unique-pair n)
(taccumulate append
nil
(map (lambda (i)
(map (lambda (j) (list i j))
(enumerate-interval 1 i)))
(enumerate-interval 1 (+ 1 n)))))
;2.41 it's a little complex to get a good displaying
(define (3-unique-pair n s)
(taccumulate (lambda (x y)
(op-s (filter-3-pair x) y))
nil
(map (lambda (i)
(map (lambda (j)
(map (lambda (k)
(if (and (not (= i j)) (not (= i k)) (not (= j k)) (= s (+ i j k)))
(list i j k)
nil))
(enumerate-interval 1 n)))
(enumerate-interval 1 n)))
(enumerate-interval 1 n))))
;3-pair?
(define 3-pair?
(lambda (x)
(if (and (pair? x)
(= (length x) 3)
(not (pair? (car x)))
(not (pair? (cadr x)))
(not (pair? (caddr x)))
(not (and (null? (car x)) (null? (cadr x)) (null? (caddr x)))))
#t
#f)))
;filter-3-pair
(define op-s
(lambda (x y)
(if (or (null? x) (null? y) (and (pair? x) (not (3-pair? x))) (and (pair? y) (not (3-pair? y))))
(append x y)
(list x y))))
(define (filter-3-pair x)
(if (3-pair? x)
x
(if (pair? x)
(op-s (filter-3-pair (car x)) (filter-3-pair (cdr x)))
nil)))
;2.42 the eight queens are everywhere
;flatmap
(define (flatmap proc seq)
(taccumulate append nil (map proc seq)))
;filter
(define (filter predicate sequencet)
(cond ((null? sequencet) nil)
((predicate (car sequencet))
(cons (car sequencet)
(filter predicate (cdr sequencet))))
(else (filter predicate (cdr sequencet)))))
; ;eight queens
; ; queen-cols
; ;( (1 3 5 7 ...)
; ; (2 4 5 4 ...)
; ; .....)
(define empty-board nil)
(define (queens board-size)
(define (queen-cols k)
(if (= 0 k)
(list empty-board)
(filter
(lambda (positions) (safe? k positions))
(flatmap
(lambda (reset-of-queens)
(map (lambda (new-row)
(adjoin-position new-row k reset-of-queens))
(enumerate-interval 1 (+ 1 board-size))))
(queen-cols (- k 1))))))
(queen-cols board-size))
;adjoin-position
(define (adjoin-position new-row k rest-of-queens)
(append rest-of-queens (list new-row)))
;safe?
(define (safe? k positions)
(define new-row (list-ref positions (- k 1)))
(define (iter i)
(cond ((= i k) #t)
((or (= new-row (list-ref positions (- i 1)))
(= (abs (- k i)) (abs (- new-row (list-ref positions (- i 1)))))) #f)
(else (iter (+ 1 i)))))
(if (null? (cdr positions))
#t
(iter 1)))