SchemeでABC(その2)

前回の続き。C問題にチャレンジ
abc036.contest.atcoder.jp

 (define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence )))))
(define nil '())
(define (toNil . x) nil)
(define (toUndef . x) (undefined))
(define (map p sequence) (accumulate (lambda (x y) (cons (p x) y)) nil sequence ))
(define (read-lines n)
  (if (= n 1)
      (list (read))
      (append (list (read)) (read-lines (- n 1)))))
(define (reverse l)
  (if (= (length l) 1)
    (list (car l))
    (append (reverse (cdr l)) (list (car l)))))
(define (print-list ls)
  (map (lambda (x) (display x) (newline)) (reverse ls)))
(define (find-list n ls)
  (define (find-acc lis count)
    (if (= n (car lis))
        count
        (find-acc (cdr lis) (+ count 1))))
  (find-acc ls 0))
(define (get-answer a)
  (define b (sort (delete-duplicates a)))
  (accumulate (lambda (x y) (append (list (find-list x b)) y)) nil a))
(define (add-hash-table ht ls)
  (define (add-hash-table-acc ls count)
    (if (null? ls)
        (undefined)
        (toUndef (toNil (hash-table-put! ht (car ls) count)) (add-hash-table-acc (cdr ls) (+ count 1)))))
  (add-hash-table-acc ls 0))
(define (print-hash-table ht ls)
  (if (null? ls)
      (undefined)
      (toUndef (toNil (display (hash-table-get ht (car ls)))) (toNil (newline)) (print-hash-table ht (cdr ls)))))

(define n (read))
(define a (read-lines n))
(define b (sort (delete-duplicates a)))
(define ht (make-hash-table 'eqv?))
(add-hash-table ht b)
(print-hash-table ht a)

これで
Submission #701486 - AtCoder Beginner Contest 036 | AtCoder
こうなった。
N<=10^3までなら通るけど10^5までだとギリギリまだ遅いらしい。
悲しい。誰か助けて。

SICPゼミ第3回

練習問題1.17

対数時間で掛け算を定義せよ(再帰的に)

(define (fast-prod b n)
  (define (even? a)
    (= (remainder a 2) 0))
  (define (double a) (* 2 a))
  (define (halve a) (/ a 2))
  (cond ((= n 0) 0)
        ((even? n) (double (fast-prod b (halve n))))
        (else (+ b (fast-prod b (- n 1))))))
練習問題1.18

1.16,1.17を参考に掛け算を反復プロセスで定義

(define (fast-prod b n)
  (define (double a) (* 2 a))
  (define (fast-prod-iter count prod)
    (cond ((= 0 n) 0)
          ((= n count) prod)
          ((<= (double count) n) (fast-prod-iter (double count) (double prod)))
          (else (fast-prod-iter (+ count 1) (+ prod b)))))
  (fast-prod-iter 1 b))

イテレータ上から回さないと対数時間にならなくねと言われたので書き直し

(define (fast-prod b n)
  (define (double a) (* 2 a))
  (define (halve a) (/ a 2))
  (define (even? a) (= (remainder a 2) 0))
  (define (fast-prod-iter count prod)
    (cond ((= count 0) prod)
          ((even? count) (fast-prod-iter (halve count) (double prod)))
          (else (fast-prod-iter (- count 1) (+ prod b)))))
  (fast-prod-iter n 0))
練習問題1.19
(define (square n) (* n n))
(define (fib n)
  (fib-iter 1 0 0 1 n))
(define (fib-iter a b p q count)
  (cond ((= count 0) b)
        (( even? count)
         (fib-iter a
                   b
                   (+
                    (square p)
                    (square q))
                   (+
                    (* 2 p q)
                    (square q))
                   (/ count 2)))
        (else (fib-iter (+ (* b q) (* a q) (* a p))
                        (+ (* b p) (* a q))
                        p
                        q
                        (- count 1)))))

SICPゼミ第2回

1.2 手続きとそれが生成するプロセス

プロセスと手続きという単語が出てくるが、プロセスは所謂OS的な意味でのプロセス。手続きは演算処理と認識した。プロセスとプログラムとも換言できるかも。

1.2.1 線形再帰と反復

再帰をする時に1ステップごとの結果が出ないものを線形再帰プロセス、1ステップごとに結果が出るものを線形反復プロセスと呼ぶらしい。
線形反復プロセスの実装を末尾再帰と呼ぶという認識。

練習問題1.9

次の二つの手続きは、どちらもinc, dec という手続きによって二つの正の整数を加算する方法を定義している。*1

(define (+ a b)
	(if (= a 0) b (inc (+ (dec a) b))))
(define (+ a b)
	(if (= a 0) b (+ (dec a) (inc b))))

置換モデルを使って、それぞれの手続きが(+ 4 5) を評価する際に生成するプロセスを図示せよ。これらのプロセスは反復だろうか、それとも再帰だろうか。
1つ目の手続きは

(define (+ 4 5)
	(if (= 4 0) 5 (inc (+ (dec 4) 5))))
(define (+ 4 5)
	(inc (+ 3 5)))
(define (+ 4 5)
	(inc (if (= 3 0) 5 (inc (+ (dec 3) 5)))))
(define (+ 4 5)
	(inc (inc (+ 2 5))))
(define (+ 4 5)
	(inc (inc (inc (inc 5))))
(define (+ 4 5) 9)

となるので、再帰である。
2つ目の手続きは

(define (+ 4 5)
	(if (= 4 0) 5 (+ (dec 4) (inc 5))))
(define (+ 4 5)
	(+ (dec 4) (inc 5)))
(define (+ 4 5) (+ 3 6))
(define (+ 4 5)
	(if (= 3 0) 6 (+ (dec 3) (inc 6))))
(define (+ 4 5) (+ 2 7))
(define (+ 4 5) (+ 1 8))
(define (+ 4 5) (+ 0 9))
(define (+ 4 5) 9)

となるので反復である。

練習問題1.10

次の手続きは、アッカーマン関数と呼ばれる数学の関数を計算する。

(define (A x y)
	(cond	((= y 0) 0)
		((= x 0) (* 2 y))
		((= y 1) 2)
		(else (A (- x 1) (A x (- y 1))))))

これを実行すると以下のようになる

gosh> (A 1 10)
1024
gosh> (A 2 4)
65536
gosh> (A 3 3)
65536

以下の手続きが何を表すかを考える

(define (f n) (A 0 n))

xが0なので、単純に(* 2 y)つまり2nを返す

(define (f n) (A 1 n))

nが0の時は0、1の時は2を返す、それ以外の時は

(A 0 (A 1 (- y 1)))

つまり

(* 2 (A 1 (- y 1)))

を返すのでこれは再帰的にyを1ずつ減らしていき、1になるまでにかかったステップ数だけ2を掛ける演算になるので
2^nを返す(ただしn=0の時は0)

(define (f n) (A 2 3))
(define (f n)
	(A 1 (A 2 (- 3 1))))
(define (f n)
	(A 1 (A 2 2)))
(define (f n)
	(A 1 (A 1 (A 2 1))))
(define (f n)
	(A 1 (A 1 2)))
(define (f n)
	(A 1 (A 1 (A 1 (A 2 0)))))

となっていくので2↑↑n*2を返す

1.2.2 木の再帰

木構造再帰を書くと計算量は吹っ飛ぶけどまぁ書き方としては自然だよねというお話
計算量小さくしたかったら反復してということか

練習問題1.11

以下のfを演算する手続きを再帰と反復で書け。
\begin{eqnarray}f(n) = \left\{ \begin{array}{} n & (n<3)\\ f(n-1)+2f(n-2)+3f(n-3) & (n>=3)\\ \end{array}\right. \end{eqnarray}

再帰は式をそのまま書くだけ

(define (f n)
  (cond ((< n 3) n)
        (else (+ (f (- n 1)) (* 2 (f (- n 2))) (* 3 (f (- n 3)))))))

反復は3以上の場合についてのみ反復して求めれば良い。2まではデフォルトで埋めてやる必要があるのでcountの初期値は2である必要があるところに注意。

(define (f n)
  (define (f-iter count f1 f2 f3)
    (cond ((< n 3) n)
          ((= count n) f1)
          (else (f-iter (+ count 1) (+ f1 (* 2 f2) (* 3 f3)) f1 f2))))
  (f-iter 2 2 1 0))
練習問題1.12

パスカルの三角形の要素を再帰プロセスによって求める手続きを書け
パスカルの三角形は
1
1 1
1 2 1
1 3 3 1
1 4 6 4 1
と書けるので、m行目n列目の値はm-1行目n-1列目の値とm-1行目n列目の値の和であるから単純に書いて

(define (pascal m n)
  (cond ((< m n) 0)
        ((= n 1) 1)
        ((= m n) 1)
        (else (+ (pascal (- m 1) (- n 1)) (pascal (- m 1) n)))))

(エラー処理が不十分だが許して)

練習問題1.13

数学なので省略

1.2.3 増加オーダー

時間計算量・空間計算量のお話

練習問題1.14

以下のcount-change手続きで11セントに対する両替のやり方を求める際に生成されるプロセスを図示する

(define (count-change amount) (cc amount 5))
(define (cc amount kinds-of-coins)
  (cond ((= amount 0) 1)
        ((or (< amount 0) (= kinds-of-coins 0)) 0)
        (else (+ (cc amount
                     (- kinds-of-coins 1))
                 (cc (- amount
                        (first-denomination
                         kinds-of-coins ))
                     kinds-of-coins )))))
(define (first-denomination kinds-of-coins)
  (cond ((= kinds-of-coins 1) 1)
        ((= kinds-of-coins 2) 5)
        ((= kinds-of-coins 3) 10)
        ((= kinds-of-coins 4) 25)
        ((= kinds-of-coins 5) 50)))

最初に50引くor引かない→50引いた木はamountが負になるのでそこまで、引かない木は25でまた2分といった2分木ができる。

練習問題1.15

以下のsineに関して
a.(sine 12.15) を評価する際に、手続きp は何回適用されるか。

(define (cube x) (* x x x))
(define (p x) (- (* 3 x) (* 4 (cube x))))
(define (sine angle)
  (if (not (> (abs angle) 0.1))
      angle
    (p (sine (/ angle 3.0)))))

a.12.15*3.0^{-n} \le 0.1となるようなnなので121.5 \le 3.0^{n}であるから5回適用される。

1.2.4 指数計算

指数計算は再帰でかけるけど2乗毎に計算すると早いよねというよくあるお話

練習問題1.16

以下のプログラムを反復プロセスになる手続きにせよ

(define (even? n)
  (= (remainder n 2) 0))

(define (fast-expt b n)
  (cond ((= n 0) 1)
        (( even? n) (square (fast-expt b (/ n 2))))
        (else (* b (fast-expt b (- n 1))))))

これを末尾再帰にする。

(define (fast-expt b n)
  (define (fast-expt-iter b n count prod)
    (cond ((= n 0) 1)
          ((= n count) prod)
          ((<= (* 2 count) n) (fast-expt-iter b n (* 2 count) (* prod prod)))
          (else (fast-expt-iter b n (+ count 1) (* prod b)))))
  (fast-expt-iter b n 1 b))

b^nを求めるプログラム。0乗が1というのは別で定義して、n=1の時からステップ毎に計算していく。nを2倍ずつしていき、求めたいnを超えそうになったら1ずつ増やしていくことで計算回数を減らすという書き方。計算結果は逐次的にprodに保持している。末尾再帰であること以外はやっていることは上のプログラムとほぼ一緒。実行も結構早くなった。
追記
この方がシンプルで分かりやすいかも

(define (fast-expt b n)
  (define (fast-expt-iter count prod)
    (cond ((= n 0) 1)
          ((= n count) prod)
          ((<= (* 2 count) n) (fast-expt-iter (* 2 count) (* prod prod)))
          (else (fast-expt-iter (+ count 1) (* prod b)))))
  (fast-expt-iter 1 b))

*1:手続きinc は引数を1 増やし、dec は引数を1 減らす。

*2:クヌースの矢印表記 - Wikipedia