Objective Caml 入門 手習い（6章）その4

いよいよ6章も最後。

• Objective Caml 入門

Exercise 9

問題

Exercise9 関数 sift を定義し，⟨ 自分の学籍番号+3000 ⟩番目の素数を求めよ．

自分の答え

type 'a seq = Cons of 'a * (unit -> 'a seq);;

let head (Cons (x, _)) = x;;
let tail (Cons (_, f)) = f ();;
let rec take n s =
  if n = 0 then [] else head s :: take (n-1) (tail s);;

let rec from n = Cons (n, fun () -> from (n+1));;

let rec sift n (Cons (x, f)) =
  if (x mod n) = 0 then sift n (f ())
  else Cons (x, fun () -> sift n (f ()))
;;

let rec sieve (Cons (x, f)) = Cons (x, fun () -> sieve (sift x (f ())));;

let primes = sieve (from 2);;

let rec nthseq n (Cons (x, f)) =
  if n = 1 then x
  else nthseq (n-1) (f())
;;

Exercise 10

問題

Exercise10 以下で定義される ('a, 'b) sum 型は，「α型の値もしくは β型の値」という和集合的なデータの構成を示す型である．
# type ('a, 'b) sum = Left of 'a | Right of 'b;;
これを踏まえて，次の型をもつ関数を定義せよ．
1. 'a * ('b, 'c) sum -> ('a * 'b, 'a * 'c) sum
2. ('a, 'b) sum * ('c, 'd) sum -> (('a * 'c, 'b * 'd) sum, ('a * 'd, 'b * 'c) sum) sum
3. ('a -> 'b) * ('c -> 'b) -> ('a, 'c) sum -> 'b
4. (('a, 'b) sum -> 'c) -> ('a -> 'c) * ('b -> 'c)
5. ('a -> 'b, 'a -> 'c) sum -> ('a -> ('b,'c) sum)

自分の答え

type ('a, 'b) sum = Left of 'a | Right of 'b;;

(* 1. val : 'a * ('b, 'c) sum -> ('a * 'b, 'a * 'c) sum *)
let expand_sum (x, y) =
  match y with
  | Left l -> Left (x, l)
  | Right r -> Right (x, r)
;;


(* 2. val: ('a, 'b) sum * ('c, 'd) sum -> 
   (('a * 'c, 'b * 'd) sum, ('a * 'd, 'b * 'c) sum) sum *)
let cross_sum (x, y) =
  match x, y with
  | Left xl, Left yl -> Left (Left (xl, yl))
  | Left xl, Right yr -> Right (Left (xl, yr))
  | Right xr, Left yl -> Right (Right (xr, yl))
  | Right xr, Right yr -> Left (Right (xr, yr))
;;

(* 3. val: ('a -> 'b) * ('c -> 'b) -> ('a, 'c) sum -> 'b *)
let merge_sum (fl, fr) = function
  | Left l -> fl l
  | Right r -> fr r
;;

(* 4. val: (('a, 'b) sum -> 'c) -> ('a -> 'c) * ('b -> 'c) *)
let fun_tuple f c =
  match f with
  | Left fl -> (fl c, None)
  | Right fr -> (None, fr c)
;;

(* 5. val: ('a -> 'b, 'a -> 'c) sum -> ('a -> ('b,'c) sum) *)  
let func_sum f a = 
  match f with
  | Left fl -> Left (fl a)
  | Right fr -> Right (fr a)
;;

感想

微妙にExercise 10が違ってる。困った。