(ocaml5)プログラミングinOCaml

練習問題5.1〜5.8まで

(* ;;練習問題5 *)
(* 5.1 *)
[[]];;
(* [[1;3] ; ["hoge"]] ;;　型が違うので無理 *)
[3] :: [];;
(* 2 :: [3] :: [] 型が違うので無理 *)
[(fun x -> x); (fun b -> not b)];;


(* 5.2 *)
let rec downto1 n =
  if n = 1 then [1] else n :: downto1 (n - 1)
;;

let roman seed n =
  let rec ntimes ch n = if n = 0 then "" else ntimes ch (n - 1) ^ ch 
  and iter result n = function
      [] -> result
    | (x, str) :: rest ->
	if n < x then iter result n rest else
	  let chs = ntimes str (n / x) in
	    iter (result ^ chs) (n mod x) rest
  in iter "" n seed
;;     


let assoced = [(1000, "M"); (500, "D") ; (100, "C") ; (50, "L") ; (10 ,"X") ; (5, "V") ; (1, "I")];;
roman assoced 1984;;
(* - : string = "MDCCCCLXXXIIII" *)

let nested_length pl =
  List.fold_right (+) (List.map List.length pl) 0;;

nested_length [[1;2;3];[4;5];[6];[7;8;9]];;
(* - : int = 9 *)

let  concat pl =
  List.fold_right (@) pl [] ;;

concat [[0;3;4];[2];[];[5;0]];;
(* - : int list = [0; 3; 4; 2; 5; 0] *)

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


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


let unzip pl =  
  (List.map (fun (x,y) -> x) pl, List.map (fun (x,y) -> y) pl)
;;
let t = zip2 [1;2;3;4] [10;10;10;10;10];;
(* val t : (int * int) list = [(1, 10); (2, 10); (3, 10); (4, 10)] *)
unzip t;;
(* - : int list * int list = ([1; 2; 3; 4], [10; 10; 10; 10]) *)

let rec filter p = function
    [] -> []
  | x :: rest -> if p x then x :: filter p rest else filter p rest;;

filter (fun x -> x mod 2 = 1) [1;2;3;4;5];;
(* - : int list = [1; 3; 5] *)


let rec take n = function
    [] -> []
  | x :: rest -> if n = 0 then [] else x :: take (n - 1) rest;;

let rec drop n = function
    [] -> [] | x :: rest -> if n = 0 then x :: rest else drop (n - 1) rest;;

let t = [1;2;3;4;5];; 
take 2 t;;
(* - : int list = [1; 2] *)
drop 2 t;;
(* - : int list = [3; 4; 5] *)


let max_list xs =  
    List.fold_right (fun x max -> if x > max then x else max) xs 0;;
      
max_list [1;3;2;4;2];;

List.filter (fun x -> x mod 2 = 1) [1;2;3];;

(* 問題5。3 *)
let rec mem a = function
    [] -> false
  | x :: rest -> if x = a then true else mem a rest
;;

mem 1 [1;2;3;4];;
(* - : bool = true *)
mem 5 [1;2;3;4];;
(* - : bool = false *)

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

let intersect2 s1 s2 =  List.filter (fun x -> mem x s1) s2 ;;
  
intersect [1;2;3;4] [2;4;6]
(* - : int list = [2; 4] *)

let union s1 s2 = 
  let rec iter result = function
      [] -> result
    | x :: rest -> 
	if mem x result then 
	  iter (x :: result) rest
	else iter result rest 
  in iter s1 s2
;;

let union2 s1 s2  = s1 @ diff s2 s1 ;;
union [1;2;3;4;5] [2;4;6] ;;
(* - : int list = [6; 1; 2; 3; 4; 5] *)
union2 [1;2;3;4;5] [2;4;6] ;;
(* - : int list = [1; 2; 3; 4; 5; 6] *)

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

diff [1;2;3] [2]
(* - : int list = [1; 3] *)

(* 練習問題5。4 *)
let mapmap f g = function
    [] -> [] 
  | list -> List.map (fun x -> f (g x )) list
;;
mapmap (fun x -> x * x) (fun x -> x + 1) [1;2;3;4];;
(* - : int list = [4; 9; 16; 25] *)

(* 練習問題5.5 *)
let concat l  =   List.fold_right (@) l []
;;
concat [[1;2]; [2;3]];;
(* - : int list = [1; 2; 2; 3] *)

let for_all p l = List.fold_right (fun x y -> p x) l true;;
for_all (fun x -> x mod 2 = 0) [2;4;6];;
(* - : bool = true *)

let exists p l = List.fold_right (fun x y -> y || p x) l false;;
exists (fun x -> x mod 2 = 1) [2;4;6;8];;
(* - : bool = false *)

(* 練習問題5.6 *)
"後で"
(* 練習問題5.7 *)
let squares r =
  let sr = 1 + (int_of_float (sqrt (float_of_int r)))
  and sq = fun x -> x * x in
  let rec iter x y result =
    match x with
	x when x = sr -> result
      | x when x = y -> iter (x + 1) 1 result
      | x -> 
	  if (sq x) + (sq y) = r then
	    iter x (y + 1) ((x, y) :: result)
	  else iter x (y + 1) result
  in iter 2 1 []
;; 
squares 25;;
(* - : (int * int) list = [(4, 3)] *)
List.length (squares 48612265);;
(* - : int = 32 *)

(* 練習問題5.8 *)

let map2 f lst = 
  let result = List.fold_left (fun x y -> (f y) :: x) [] lst in
    List.rev result
;;

map2 (fun x -> x * x * x) [1;3;4] ;;
(* - : int list = [1; 27; 64] *)