プログラミング in OCaml 5th chapter 練習問題を解いた

練習問題 5.1

let downto1 n =
  if n < 1 then []
  else
    let rec downto1' n =
      match n with
      | 1 -> [1]
      | n -> n :: downto1' (n - 1)
    in downto1' n;;

練習問題 5.2

let roman alphabet n =
  let rec roman' alphabet' n p =
    if n = 0 then p
    else match alphabet' with
      | x :: xs ->
        let (k, c) = x in
        if k <= n then roman' alphabet' (n - k) (p ^ c)
        else roman xs n p
  in roman alphabet n "";;

let rec nested_length (a: 'a list list): int =
  match a with
    | [] -> 0
    | x :: xs -> List.length x + nested_length xs;;

let rec concat (a: 'a list list): 'a list =
  match a with
    | [] -> []
    | x::xs -> List.append x (concat xs);;

let rec zip a b = match (a, b) with
  | (x :: xs, y :: ys) -> (x, y) :: zip xs ys
  | _ -> [];;

let rec unzip l = match l with
  | x :: xs ->
    let (p, q) = x in
    let (ps, qs) = unzip xs in
    (p :: ps, q :: qs)
  | [] -> ([], [])

let rec filter cond l = match l with
  | x :: xs ->
    if cond x then x :: filter cond xs
    else filter cond xs
  | [] -> [];;

let rec take n l = match (n, l) with
  | (0, _) -> []
  | (_, []) -> []
  | (_, x::xs) -> x :: take (n - 1) xs ;;

let rec drop n l = match (n, l) with
  | (0, x) -> x
  | (_, []) -> []
  | (_, x::xs) -> drop (n - 1) xs;;

let max_list l =
  let rec max_list' n l' = match l' with
    | [] -> n
    | x :: xs -> max_list' (max x n) xs
  in max_list' min_int l;;

練習問題 5.3

let rec mem s a = match s with
  | [] -> false
  | x::xs ->
    if x = a then true
      else mem xs a;;

let rec intersect s1 s2 = match s2 with
  | [] -> []
  | x :: xs ->
    if mem s1 x then x :: intersect s1 xs
    else intersect s1 xs;;

let rec union s1 s2 = match s2 with
  | [] -> s1
  | x :: xs ->
    if mem s1 x then union s1 xs
    else  x :: union s1 xs;;

let diff s1 s2 = filter (fun x -> not (mem s2 x)) s1;;

練習問題 5.4

let nested_map f g l = map (fun x -> f (g x)) l;;

練習問題 5.5

練習問題 5.6

let rec fold_right f l e =
  match l with
    | [] -> e
    | x :: rest -> f x (fold_right f rest e);;

(* concat *)
let concat (l: 'a list list): 'a list =
  fold_right (fun elem acc -> List.append elem acc) l [];;

(* forall *)
let forall (cond: 'a -> bool)(l: 'a list): bool =
  fold_right (fun elem acc -> acc && (cond elem)) l true;;

(* exists *)
let exists (cond: 'a -> bool)(l: 'a list): bool =
  fold_right (fun elem acc -> acc || (cond elem)) l false;;

練習問題 5.7

(* 直積を作る部分を参考にした: https://rosettacode.org/wiki/Cartesian_product_of_two_or_more_lists#OCaml *)
let squares (r:int): (int * int) list =
  let m = (int_of_float (sqrt (float_of_int r))) + 1 in
  let verify x y = x * x + y * y = r in
  let cart_prod l1 l2 =
    List.fold_left (fun acc1 ele1 ->
      List.fold_left (fun acc2 ele2 -> (ele1,ele2)::acc2) acc1 l2) [] l1 in
  let downto0 n =
    let rec downto0' k prod =
      if k = n then n :: prod
      else downto0' (k + 1) (k :: prod) in
      downto0' 0 [] in
  let m_to_0 = downto0 m in
  let candidates = cart_prod m_to_0 m_to_0 in (* ここもっと候補減らせるけどめんどいからいいや *)
  List.filter (fun (x, y) -> x >= y && (verify x y)) candidates;;

練習問題 5.8

let reverse a =
  let rec reverse' a' prod = match a' with
    | [] -> prod
    | x :: xs -> reverse' xs (x::prod)
  in reverse' a [];;

(* 末尾再帰で実装したreverseを補助関数として使う *)
let iterative_map f l =
  let rec iterative_map' l' prod = match l' with
    | x::xs -> iterative_map' xs ((f x) :: prod)
    | [] -> prod
  in reverse (iterative_map' l []);;