code.ml

(* Q1 *)
let rec sum_to n =
  match n with
  | 0 -> 0
  | n -> n + sum_to (n - 1)

(* Q2*)
let rec fib_exp n =
  match n with
  | 0 -> 1
  | 1 -> 1
  | x -> (fib_exp (x - 1)) + (fib_exp (x - 2))

let fib_lin n =
  let rec fib a b c =
    match c with
    | 0 -> a
    | c -> fib b (a + b) (c - 1) in
  fib 1 1 n

(* Q3 *)
let twice f =
  (fun x -> f (f x))

let rec repeat f n =
  match n with
  | 0 -> (fun x -> x)
  | n -> (fun x -> (repeat f (n - 1)) x)

(* Q4 *)
let rec fix f x = f (fix f) x

let sum_to_fix =
  let sum_to f n =
    match n with
    | 0 -> 0
    | n -> n + f (n - 1) in
  fix sum_to

let fib_exp_fix =
  let rec fib f n =
    match n with
    | 0 -> 1
    | 1 -> 1
    | x -> (f (x - 1)) + (f (x - 2)) in
  fix fib

let fib_lin_fix n = 
  let fib f (a, b, c) =
    match c with
    | 0 -> a
    | c -> f (b, (a + b), (c - 1)) in
  (fix fib) (1, 1, n)

(* Q5 *)
let rec fold_right f l e =
  match l with
  | [] -> e
  | x::xs -> f x (fold_right f xs e)

let rec fold_left f e l =
  match l with
  | [] -> e
  | x::xs -> fold_left f (f e x) xs

(* Q7: Q6のappendがreverseに依存する*)
let reverse l =
  let rec reverse_r l acc =
    match l with
    | [] -> acc
    | x::xs -> reverse_r xs (x::acc) in
  reverse_r l []
				 
(* Q6 *)
let append a b =
  let rec append_r a b =
    match a with
    | [] -> b
    | x::xs -> append_r xs (x::b) in
  append_r (reverse a) b

let rec last l =
  match l with
  | x::[] -> x
  | _::xs -> last xs

let rec map f l =
  match l with
  | [] -> []
  | x::xs -> (f x)::(map f xs)
		   
(* Q8 *)
let reverse_f =
  fold_left (fun xs x -> x :: xs) []

let append_f a b =
  fold_left (fun xs x -> x :: xs) b (reverse_f a)

let last_f (x::xs) =
  fold_left (fun xs x -> x) x xs

let map_f f l =
  fold_right (fun x e -> (f x)::e) l []

(* Q9 *)
let trimap f l =
  let rec trimap_ sx x xs acc =
    match xs with
    | [] -> reverse ((f x (append (reverse sx) xs))::acc)
    | y::ys -> trimap_ (x::sx) y ys ((f x (append (reverse sx) xs))::acc) in
  match l with
  | [] -> []
  | x::xs -> trimap_ [] x xs []

let flatten l  =
  fold_right (fun x xs -> append x xs) l []

let rec perm l =
  let hoge x xs =
    map (fun y -> x::y) (perm xs) in
  match l with
  | [] -> []
  | [a] -> [[a]]
  | l -> flatten (trimap hoge l)