Top > OCaml > SICP-1a
Counter: 4142, today: 1, yesterday: 0

練習問題の概要と解答案 (1章)

正解かどうかの保証はしない。問題の解釈を間違えている可能性もある。

1.1

OCaml 流に書き換えるとこうなるか。

10;;
5 + 3 + 4;; または (+) 5 ((+) 3 4);;
 (* OCaml にはリスト型(三項以上)の + 演算はない。fold使うのもねぇ *)
9 - 1;;
6 / 2;;
2 * 4 + (4 - 6);;
let a = 3;;
let b = a + 1;;
a + b + a * b;;
a = b;;
if b>a & b<a*b then b else a;;
if a=4 then 6 else if b=4 then 6+7+a else 25;; 
2 + if b>a then b else a;;
(if a>b then a else if a<b then b else -1) * (a+1);;

で結果がこれ。

- : int = 10
- : int = 12
- : int = 8
- : int = 3
- : int = 6
val a : int = 3
val b : int = 4
- : int = 19
- : bool = false
- : int = 4
- : int = 16
- : int = 6
- : int = 16

1.2

中置で普通にかけるのにわざわざ前置に書き直したくないのでパス。

1.3

3つの数を引数に取りその中の大きいもの二つの平方の和を返す手続きを定義せよ。

let result a1 a2 a3 = (* 整数限定 *)
  let m1,m2 =
    if a1>a2 & a2>a3 then (a1,a2)
    else if a1>a2 then (a1,a3)
    else if a1>a3 then (a1,a2)
    else (a2,a3)
  in
    m1*m1 + m2*m2;;

1.4

全体は a+|b| を返す。

1.5

これはずいぶんと苦労した。

(define (p) (p))
(define (test x y)
  (if (= x 0)
      0
      y))

という定義に対する評価が、

(test 0 (p))

適用順評価と正規順評価それぞれのインタプリタでどのような挙動が観測されるかの説明。

まず与えられる二つの定義を OCaml に正しく翻訳できない。 紆余曲折の末にたどり着いたのはこんなのか

let rec p x = p x
let test x y =
    if x=0 then () else ignore(y);;
test 0 (p ());;

あるいはこんなの。

let rec p = 0 :: p
let test x y =
   if x=0 then 0 else List.length y;;
test 0 p;;

OCaml は実のところマニュアルの整備が甘くて、境界動作がさっぱりわからないところがある。

オライリー本によるとこれは意図的らしくて、未定義動作はプログラマが使わないことを暗黙に要請している模様。そのぶんコンパイラの自由度を上げている、ということだが、未定義動作/不定動作を明示する努力くらいはして欲しいなぁ。

1.6

if - then - else が特殊構文であるのはなぜかという話。

以下でやってみた(浮動小数限定)。 OCaml ではシンボルに - や ? を使えないので書き換えている。

let new_if predicate then_clause else_clause =
  if predicate then then_clause
  else else_clause
let abs x = if x>0.0 then x else 0.0-.x
let square x = x *. x
let average x y = (x+.y)/. 2.0
let improve guess x = average guess (x/.guess)
let good_enough guess x =
  (abs ((square guess)-.x)) < 0.001 
 let rec sqrt_iter guess x =
   new_if (good_enough guess x)       (* if なら動く *)
     guess
     (sqrt_iter (improve guess x) x)
let sqrt x = sqrt_iter 1.0 x ;;
sqrt 3.0;;

結果:

Stack overflow during evaluation (looping recursion?).

scheme と同じ結果かな? (if 文で書いたときは 1.73... を返した)

if - then - else は条件に依存して片方しか評価しないが、 new_if と定義された関数は全部の引数は評価してしまうので else 以降が無限降下すると。 非strict(遅延評価)だと Alyssa の期待どおり動いてくれるんだろう。

open Lazy
let new_if predicate then_clause else_clause =
  if predicate then (force then_clause)
  else (force else_clause)
let abs x = if x>0.0 then x else 0.0-.x
let square x = x *. x
let average x y = (x+.y)/. 2.0
let improve guess x = average guess (x/.guess)
let good_enough guess x =
  (abs ((square guess)-.x)) < 0.001
let rec sqrt_iter guess x =
  (new_if (good_enough guess x) 
    (lazy guess)
    (lazy (sqrt_iter (improve guess x) x)))
let sqrt x = sqrt_iter 1.0 x;;
print_float (sqrt 3.0);;
1.73214285714- : unit = ()

1.7

こたえ:小さい数だと収束前に打ち切るし、大きい数だと ulp 未満に行けなくて破綻。というわけで書き換え。

let good_enough guess x =
  abs ((abs ((square guess)/.x))-.1.0) < 0.000001 ;;

1.8

三乗根(立方根)の定義。

let rec cube_iter a org =
  let e = 0.00000001 in 
  let fabs f = if f > 0.0 then f else -.f in
  let is_converge f1 f2 = fabs (fabs (f1 /. f2) -. 1.0) < e (*epsilon*) in
  let cubefunc f2 f1 = (f1 /. (f2 *. f2) +. 2.0 *. f2) /. 3.0 in
    if (is_converge (a*.a*.a) org) then a else 
      cube_iter (cubefunc a org) org
let cube_root x =
  cube_iter x x;;

1.9

パス。

1.10

アッカーマン関数。

let rec acker x y =
  if y=0 then 0
  else if x=0 then 2*y
  else if y=1 then 2
  else acker (x-1) (acker x (y-1))
let f n = acker 0 n
let g n = acker 1 n
let h n = acker 2 n
# acker 1 10;;
- : int = 1024
# acker 2 4;;
- : int = 65536
# acker 3 3;;
- : int = 65536
# f 1;;
- : int = 2
# f 2 ;;
- : int = 4
# f 3 ;;
- : int = 6
# f 4 ;;
- : int = 8
# g 1 ;;
- : int = 2
# g 2;;
- : int = 4
# g 3 ;;
- : int = 8
# g 4;;
- : int = 16
# h 1 ;;
- : int = 2
# h 2 ;;
- : int = 4
# h 3 ;;
- : int = 16
# h 4 ;;
- : int = 65536

f は 2*n、gは2^n、hは2↑↑n (というのであってたっけ)


Reload   New Lower page making Edit Freeze Diff Upload Copy Rename   Front page List of pages Search Recent changes Backup Referer   Help   RSS of recent changes
Last-modified: (5275d)