(*Problem 1*) let closer_to_origin (x1, y1) (x2, y2) = let d1 = sqrt (x1 *. x1 +. y1 *. y1) and d2 = sqrt (x2 *. x2 +. y2 *. y2) in compare d1 d2 (*Problem 2*) let swap_eq (x1,y1) (x2,y2) = ((x1,x2) = (y2,y1)) (*Problem 3*) let two_funs (f, g) (x, y) = (f x, g y) (*Problem 4*) let rec ackermann m n = if m < 0 || n < 0 then 0 else match (m, n) with (0, _) -> n + 1 | (_, 0) -> ackermann (m - 1) 1 | _ -> ackermann (m - 1) (ackermann m (n - 1)) (*Problem 5*) let rec collatz n = if n <= 1 then 0 else if n mod 2 = 0 then 1 + collatz (n / 2) else 1 + collatz (3 * n + 1) (*Problem 6*) let rec delannoy (m, n) = if m < 0 || n < 0 then 0 else match (m, n) with (0, 0) -> 1 | _ -> delannoy (m - 1, n) + delannoy (m, n - 1) + delannoy (m - 1, n - 1) (*Problem 7*) let rec product l = match l with [] -> 1. | x::xs -> x *. product xs (*Problem 8*) let rec double_all l = match l with [] -> [] | x::xs -> (2. *. x) :: double_all xs (*Problem 9*) let upto n = if n < 0 then [] else let rec upto' i = if i > n then [] else i :: upto' (i+1) in upto' 0 (*Problem 10*) let upuntil f = let rec upuntil' n = if f n || n = 100 then [] else n :: (upuntil' (n+1)) in upuntil' 0 (*Problem 11*) let rec pair_with_all x l = match l with [] -> [] | y::ys -> (x, y) :: pair_with_all x ys (*Problem 12*) let rec insert_by comp x l = match l with [] -> [x] | y::ys -> if comp x y = -1 then x::(y::ys) else y :: insert_by comp x ys (* Problem 13 *) let rec sub_list l1 l2 = match l2 with [] -> true | (x::xs) -> (match l1 with [] -> false | (y::ys) -> if x = y then sub_list ys xs else sub_list ys l2) (*Extra Credit - Problem 14*) let rec collect_key key l = match l with (k,value)::rest when k = key -> let (values, pairs) = collect_key key rest in (value :: values, pairs) | _ -> ([], l) let rec collect_adjacent l = match l with (k, v)::_ -> let (vals, rest) = collect_key k l in (k, vals) :: collect_adjacent rest | _ -> []