(sicp42)m3.38~m3.40

m3.38

;;面倒なので、コードを書こう。

(define (Peter balance)
  (set! balance (+ balance 10)))
(define (Paul balance) 
  (set! balance (- balance 20)))
(define (Mary balance)
  (set! balance (- balance (/ balance 2))))

(define (permutation s)
  (if (null? s)
      (list '())
      (append-map (lambda (x)
                    (map (cut cons x <>) 
                         (permutation (filter (lambda (y) (not (equal? x y))) s))))
                  s)))

;; (permutation '(a b c))
;; 23:user> => ((a b c) (a c b) (b a c) (b c a) (c a b) (c b a))

(for-each 
   (lambda (x) 
     (print (x->string x) 
            " : " 
            (fold (cut <> <>) 100 x)))
   (permutation (list Peter Paul Mary)))

;; 22:user>
;; (#<closure Peter> #<closure Paul> #<closure Mary>) : 45
;; (#<closure Peter> #<closure Mary> #<closure Paul>) : 35
;; (#<closure Paul> #<closure Peter> #<closure Mary>) : 45
;; (#<closure Paul> #<closure Mary> #<closure Peter>) : 50
;; (#<closure Mary> #<closure Peter> #<closure Paul>) : 40
;; (#<closure Mary> #<closure Paul> #<closure Peter>) : 40

gaucheでの回答。
combinationsを使うと楽かも。

(use util.combinations)

(permutations-for-each 
   (lambda (x)
     (print (x->string x) 
            " : " 
            (fold (cut <> <>) 100 x)))
   (list Peter Paul Mary))

m3.39

;; 101, 121, 100

m3.40

	;;ありえない変更も加えているかもしれない＞＜
;; X1 = (* x x x), X2 = (* x x)
;; 1: (* X1 X1)
;; 2: (* x X1)
;; 3: (* X1 x) //ありえないかも？
;; 4: (* x x)
;; 5: (* X2 X2 X2)
;; 6: (* X2 X2 x) //ありえないかも？
;; 7: (* X2 x X2) //ありえないかも？
;; 8: (* X2 x x) //ありえないかも？
;; 9: (* x X2 X2)
;; 10: (* x X2 x) //ありえないかも？
;; 11: (* x x X2)
;; 12: (* x x x)

;;==SERIALIZE==
;; 1: (* X2 X2 X2)
;; 2: (* X1 X1)
;;答えはどちらも10**6

m3.38(もう一度）

失敗してしまう（変更される前に次の処理が行われてしまう）条件を忘れていた

(define (error balance) balance)

(define (cross-product . args)
  (define (adjoin src dest)
    (append-map (lambda (x)
                  (map (cut cons <> x) dest))
                src))
  (fold (lambda (x it) (adjoin it x)) (map list (car args)) (cdr args)))

(define (g l error)
  (let* ((state (apply cross-product (make-list (length l) '(#t #f))))
         (rest (filter (lambda (x) (car (last-pair x))) state))
         (lst (map (cut zip l <>) rest))) ;;最後がerrorになることはないので
      (map (lambda (xs)
             (map (lambda (x) (if (cadr x) (car x) error))  xs))
           lst)))

;; (g '(a b c) 'no)
;; 21:user> => ((a b c) (no b c) (a no c) (no no c))

(define (f l)
  (let ((rest (append-map (cut g <> error) (permutation l))))
    (for-each 
     (lambda (x) 
       (print (x->string x) 
              " : " 
              (fold (cut <> <>) 100 x)))
      rest)))
(f (list Peter Paul Mary))
;; 20:user>
;; (#<closure Peter> #<closure Paul> #<closure Mary>) : 45
;; (#<closure error> #<closure Paul> #<closure Mary>) : 40
;; (#<closure Peter> #<closure error> #<closure Mary>) : 55
;; (#<closure error> #<closure error> #<closure Mary>) : 50
;; (#<closure Peter> #<closure Mary> #<closure Paul>) : 35
;; (#<closure error> #<closure Mary> #<closure Paul>) : 30
;; (#<closure Peter> #<closure error> #<closure Paul>) : 90
;; (#<closure error> #<closure error> #<closure Paul>) : 80
;; (#<closure Paul> #<closure Peter> #<closure Mary>) : 45
;; (#<closure error> #<closure Peter> #<closure Mary>) : 55
;; (#<closure Paul> #<closure error> #<closure Mary>) : 40
;; (#<closure error> #<closure error> #<closure Mary>) : 50
;; (#<closure Paul> #<closure Mary> #<closure Peter>) : 50
;; (#<closure error> #<closure Mary> #<closure Peter>) : 60
;; (#<closure Paul> #<closure error> #<closure Peter>) : 90
;; (#<closure error> #<closure error> #<closure Peter>) : 110
;; (#<closure Mary> #<closure Peter> #<closure Paul>) : 40
;; (#<closure error> #<closure Peter> #<closure Paul>) : 90
;; (#<closure Mary> #<closure error> #<closure Paul>) : 30
;; (#<closure error> #<closure error> #<closure Paul>) : 80
;; (#<closure Mary> #<closure Paul> #<closure Peter>) : 40
;; (#<closure error> #<closure Paul> #<closure Peter>) : 90
;; (#<closure Mary> #<closure error> #<closure Peter>) : 60
;; (#<closure error> #<closure error> #<closure Peter>) : 110
;; => #<undef>