99 OCaml: Intermediate Exercises

Intermediate problems taken from here. Instead of just being a store for solutions, this aims to actually go deeper and float all the learning takeaways that I had when completing the problem set. The code-snippets here can be tangled in emacs I will expose this code as an org-file publicly once I’ve completed the 99 problems. It will be hosted on Codeberg, hopefully it helps others. and can be executed directly.

TODO Lists #

1. Flatten a List #

Flatten a nested list structure.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14

type 'a node =
  | One of 'a
  | Many of 'a node list

let flatten l =
  let rec aux acc = function
      | [] -> acc
      | One x :: t -> aux ( x::acc ) t
      | Many inner :: t -> aux ((aux [] inner) @ acc) t
  in
  l |> aux [] |> List.rev;;

(* input: *)
flatten [One "a"; Many [One "b"; Many [One "c" ;One "d"]; One "e"]];;

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14

type 'a node =
  | One of 'a
  | Many of 'a node list

let flatten l =
  let rec aux acc = function
      | [] -> acc
      | One x :: t -> aux ( x::acc ) t
      | Many inner :: t -> aux (aux acc inner) t
  in
  List.rev (aux [] l);;

(* input: *)
flatten [One "a"; Many [One "b"; Many [One "c" ;One "d"]; One "e"]];;

Tree-shaped Recursion #

In this problem we see a nested recursive structure, which feels like a tree / there’s a bifurcation for the Many case. The inner case is what we prioritise first, that’s why it’s in the bracketed recursive call.

We control the direction of the tree traversal by choosing to flatten inner into acc first, then continuing with t.

Lack of Tail Recursion #

In the solution above, there’s an outer and an inner aux call.

The outer aux is in tail position but the inner call aux acc inner is an argument to the outer call — this dependency means that the stack holds a frame for the outer aux while the inner aux resolves — we can get one stack frame per nesting level, so each level of nesting adds a frame.

It’s not linear recursion stack overflow but also, this isn’t tail-recursive.

@-elimination pattern #

Whenever we write (f x) @ acc, we should ask: can I pass acc into f directly?

• If yes, do it — eliminates the allocation and the \(O(n)\) concat.
• Recognition signal: @ on the left operand of a recursive call result.

Explicit Stack for Tail-Recursive Solution \(\implies\) Iterative Tree Traversal Pattern #

1
2
3
4
5
6
7
8
9

let flatten l =
  let rec aux acc stack = match stack with
    | [] -> List.rev acc (* stack exhausted, done *)
    | [] :: rest -> aux acc rest (* current sublist exhausted, pop to parent *)
    | (One x :: t) :: rest -> aux (x::acc) (t::rest) (* emit x, continue current sublist *)
    | (Many inner :: t) :: rest -> aux acc (inner :: t :: rest) (* push inner onto tack, defer t*)
  in
  aux [] [l];;
flatten [One "a"; Many [One "b"; Many [One "c" ;One "d"]; One "e"]];;

The stack is just a list of lists for pending work, there’s no frame-nesting, it’s \(O(1)\) stack — stack is a worklist.

2. Eliminate Duplicates #

Eliminate consecutive duplicates of list elements.

This feels like it’s all about doing cheap lookaheads

1
2
3
4
5
6
7
8
9

let compress l =
  let rec aux acc = function
      | [] -> List.rev acc
      | [x] -> List.rev ( x::acc )
      | a :: (( b :: _ ) as tl) ->
         if Stdlib.(=) a b then aux acc tl else aux (a :: acc) tl in
  aux [] l;;

compress ["a"; "a"; "a"; "a"; "b"; "c"; "c"; "a"; "a"; "d"; "e"; "e"; "e"; "e"];;

1
2
3

let rec compress = function
    | a :: (b :: _ as t) -> if a = b then compress t else a :: compress t
    | smaller -> smaller;;

The model solution given is not tail-recursive though.

Pattern: 3-armed lookahead skeleton #

A two-element lookahead pattern always requires a 3-arm skeleton:

| []                    -> base
| [x]                   -> last-element base
| x :: ((y :: _) as tl) -> general case

3. Pack Consecutive Duplicates #

Pack consecutive duplicates of list elements into sublists.

This is about having sub-pattern name bindings and using the right sub-patterns – it’s opposite of the flattening case.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10

let pack ls =
  let rec aux acc l = match ( acc, l ) with
      | [[]], y :: t -> aux [[y]] t
      | (a :: _ as h) :: acc_t, b :: t ->  if Stdlib.(=) a b
                        then aux ((b :: h) :: acc_t) t
                        else aux ([b] :: acc) t
      | _, [] -> List.rev acc in
    aux [[]] ls;;

pack ["a"; "a"; "a"; "a"; "b"; "c"; "c"; "a"; "a"; "d"; "d"; "e"; "e"; "e"; "e"];;

this works! output:

Gotcha: sub-pattern extraction syntactic sugar: [this] \(\implies\) (this :: []) #

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15

let pack ls =
  let rec aux acc l = match ( acc, l ) with
      | [[]], y :: t -> aux [[y]] t
      | [a :: _ as h] :: acc_t, b :: t ->  if Stdlib.(=) a b
                        then aux ((b :: h) :: acc_t) t
                        else aux ([b] :: acc) t
      | _, [] -> List.rev acc in
    aux [[]] ls;;

(* pack ["a"; "a"; "a"; "a"; "b"; "c"; "c"; "a"; "a"; "d"; "d"; "e"; "e"; "e"; "e"];; *)
(*
  - : string list list =
  [["a"; "a"; "a"; "a"]; ["b"]; ["c"; "c"]; ["a"; "a"]; ["d"; "d"];
  ["e"; "e"; "e"; "e"]]
 *)

Line 4, characters 59-60:
4 |       | [a :: _ as h] :: acc_t, b :: t ->  if Stdlib.(=) a b
                                                               ^
Error: The value b has type 'a list/2 but an expression was expected of type
         'a
       The type variable 'a occurs inside 'a list/2
       File "_none_", line 1:
         Definition of type list/2

The problem in my original approach is here.

Our intention is to match the head of acc as a non-empty list and we want to bind the first element of that non-empty list to a.

to complete the reasoning for why that type error came up, it’s because the unifier infers teh head of acc as 'a list list (i.e. one element list of lists) which makes acc: 'a list list list, but in the other arm and the call site, the type constraint is different.

aux [[]] ls constrain acc : 'a list list. The unifier attempt to reconcile 'a list = 'a coming from b ::: t on the l side, which is where the occurs-check failure is felt, that’s why the /2 on list

so the diff is just:

      | [[]], y :: t -> aux [[y]] t
-      | [a :: _ as h] :: acc_t, b :: t ->  if Stdlib.(=) a b
+      | (a :: _ as h) :: acc_t, b :: t ->  if Stdlib.(=) a b
                        then aux ((b :: h) :: acc_t) t
                        else aux ([b] :: acc) t
      | _, [] -> List.rev acc in

Pattern: Separating Current-Group from Completed-Group Accumulator #

This pattern is seen in the model solution, but I’m not too sold on the notion that it’s better, though it’s slightly cleaner to read.

consider the model solution:

1
2
3
4
5
6
7
8

let pack list =
    let rec aux current acc = function
      | [] -> []    (* Can only be reached if original list is empty *)
      | [x] -> (x :: current) :: acc
      | a :: (b :: _ as t) ->
         if a = b then aux (a :: current) acc t
         else aux [] ((a :: current) :: acc) t  in
    List.rev (aux [] [] list);;

In my approach, I had embedded the in-progress group as the head of the acc, so the acc did double duty of holding the current and completed groups — this meant that I had to use [[]] as a sentinel, which demanded its own arm | [[]], y :: t just for the initialisation artefact.

In the model solution, the current group and the completed groups accumulator are separated which buys us cleaner arms.

4. Decode a Run-Length Encoded List #

Given a run-length code list generated as specified in the previous problem, construct its uncompressed version.

This is essentially a counted repetition.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19

type 'a rle =
  | One of 'a
  | Many of int * 'a

let decode encoding =
  let rec aux acc = function
    | [] -> List.rev acc
    | One x :: t -> aux ( x :: acc ) t
    | Many (n, x) :: t ->
       if n = 2
       then aux ( x :: acc ) ( One x :: t )
       else aux (x :: acc) ( Many (n - 1, x) :: t ) in
  aux [] encoding;;

decode [Many (4, "a"); One "b"; Many (2, "c"); Many (2, "a"); One "d"; Many (4, "e")];;
(*
  - : string list =
  ["a"; "a"; "a"; "a"; "b"; "c"; "c"; "a"; "a"; "d"; "e"; "e"; "e"; "e"]
 *)

My solution does a lot of packing, unpacking as well.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10

let decode list =
  let rec many acc n x =
    if n = 0 then acc else many (x :: acc) (n - 1) x
  in
  let rec aux acc = function
    | [] -> acc
    | One x :: t -> aux (x :: acc) t
    | Many (n, x) :: t -> aux (many acc n x) t
  in
  aux [] (List.rev list);;

The model solution splits it up into two helper functions. It’s clean and likely better performance also. W.r.t performance it’s because of the

Pattern: Prefer dedicated helper when unwinding a counted repetition #

When unwinding a counted repetition, prefer a dedicated helper with the count as a plain integer parameter over re-encoding the count back into the algebraic type on each step. The type is the right representation for the data structure; it is not the right representation for a loop counter.

5. Run-Length Encoding of a List (Direct Solution) #

Implement the so-called run-length encoding data compression method directly.

I.e. don’t explicitly create the sublists containing the duplicates, as in problem “Pack consecutive duplicates of list elements into sublists”, but only count them.

As in problem “Modified run-length encoding”, simplify the result list by replacing the singleton lists (1 X) by X.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15

type 'a rle =
  | One of 'a
  | Many of int * 'a

let encode l =
  let make (c, e)  = if c = 1 then One e else Many (c, e)  in
  let rec aux (curr_count, curr_elem) acc = function
      | [] -> make (curr_count, curr_elem) :: acc
      | h :: t -> if Stdlib.(=) curr_elem h
                  then aux (curr_count + 1, h) acc t
                  else aux (1, h) ( make (curr_count, curr_elem) ::  acc) t in
  let h :: t = l in
  List.rev(aux (1, h) [] t);;

encode ["a";"a";"a";"a";"b";"c";"c";"a";"a";"d";"e";"e";"e";"e"];;

1
2
3
4
5
6
7
8
9

let encode list =
    let rle count x = if count = 0 then One x else Many (count + 1, x) in
    let rec aux count acc = function
      | [] -> [] (* Can only be reached if original list is empty *)
      | [x] -> rle count x :: acc
      | a :: (b :: _ as t) -> if a = b then aux (count + 1) acc t
                              else aux 0 (rle count a :: acc) t
    in
      List.rev (aux 0 [] list);;

The model’s rle counts from 0 (representing “seen one so far, count additional occurrences”), which lets it initialize aux 0 [] list and pass the full list in. My make counts from 1 (representing “actual count of elements seen”), which forces the let h :: t extraction to seed aux (1, h) [] t.

Both are internally consistent; the model’s convention is slightly more brittle to misread (count = 0 means one element, not zero), mine is more natural to reason about. Neither is wrong.

6. Replicate the Elements of a List a Given Number of Times #

Replicate the elements of a list a given number of times.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10

let replicate ls n =
  let rec aux acc (c, e) src = match (c, src) with
    | 0, []     -> List.rev acc
    | 0, h :: t -> aux acc (n, h) t
    | i, _      -> aux (e :: acc) (i - 1, e) src
  in
  match ls with
  | []     -> []
  | h :: t -> aux [] (n, h) t
replicate ["a"; "b"; "c"] 3;;

Improvements:

1. it’s not a good idea to couple the (c, e) as a tuple because it means every recursive call reconstructs the tuple even when only one field changes. We can separate them out and get our intent explicit: let rec aux acc c e src = match (c, src) with ...
2. my solution is slightly less readable because:
   • the 3rd arm | i, _ -> matches src = [] when c > 0, which is correct but not super obvious
   • a reader would have to convince themselves that c eventually hits 0 and then | 0, [] fires
   • in comparison, the prepend function in the model answer makes everything explicit

1
2
3
4
5
6
7
8
9

let replicate list n =
    let rec prepend n acc x =
      if n = 0 then acc else prepend (n-1) (x :: acc) x in
    let rec aux acc = function
      | [] -> acc
      | h :: t -> aux (prepend n acc h) t in
    (* This could also be written as:
       List.fold_left (prepend n) [] (List.rev list) *)
    aux [] (List.rev list);;

7. Drop Every N’th Element From a List #

Drop every N’th element from a list.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10

let drop l n =
  let rec aux acc counter = function
      | [] -> List.rev acc
      | h :: t -> if counter = 1
                  then aux acc n t
                  else aux (h :: acc) (counter - 1) t in
  aux [] n l;;

drop ["a"; "b"; "c"; "d"; "e"; "f"; "g"; "h"; "i"; "j"] 3;;
(* - : string list = ["a"; "b"; "d"; "e"; "g"; "h"; "j"] *)

For extra clarity, the counter could have been counted-up-to instead of a downcount — would mimic the question’s context better.

1
2
3
4
5

let drop list n =
    let rec aux i = function
      | [] -> []
      | h :: t -> if i = n then aux 1 t else h :: aux (i + 1) t  in
    aux 1 list;;

The model answer is not tail recursive. I prefer my solution.

8. Extract a Slice From a List #

Given two indices, i and k, the slice is the list containing the elements between the i‘th and k‘th element of the original list (both limits included).

Start counting the elements with 0 (this is the way the List module numbers elements).

Everything is zero-indexed.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17

let slice ls lo hi  =
  let width = hi - lo + 1 in
  let rec drop i src = match i with
    | 0 -> src
    | _ ->  match src with
            | [] -> src
            | h :: t -> drop (i - 1) t in
  let rec take k acc = function
    | [] -> List.rev acc
    | h :: t -> if k = 0
                then List.rev acc
                else take (k - 1) (h :: acc) t
  in
  ls |> drop lo |> take width [];;

slice ["a"; "b"; "c"; "d"; "e"; "f"; "g"; "h"; "i"; "j"] 2 6;;
slice ["a"; "b"; "c"; "d"; "e"; "f"; "g"; "h"; "i"; "j"] 0 6;;

 1
 2
 3
 4
 5
 6
 7
 8
 9
10

 let slice list i k =
    let rec take n = function
      | [] -> []
      | h :: t -> if n = 0 then [] else h :: take (n - 1) t
    in
    let rec drop n = function
      | [] -> []
      | h :: t as l -> if n = 0 then l else drop (n - 1) t
    in
    take (k - i + 1) (drop i list);;

Careful on the edge cases #

I’ve been writing solutions that aren’t defensive enough. For example, my pedestrian approach to this used a down-counter but it stopped at i = 1 — so input where i = 0 would break the solution.

Part of this is just because I’ve been too focused on making the code short and recursive functions be tail-recursive.

Careful / Style: wrap nested pattern matches with parentheses #

This is just good style for now, the parentheses are fine to be omitted from below because it’s the last arm, but if there was another arm then it would all be consumed at the same time.

let rec drop i src = match i with
  | 0 -> src
  | _ -> (match src with
          | [] -> src
          | _ :: t -> drop (i - 1) t)

naturally, there’s other ways to do this — such as just flattening the nesting:

let rec drop i src = match (i, src) with
  | 0, _ | _, [] -> src
  | _, _ :: t    -> drop (i - 1) t

9. Rotate a List N Places to the Left #

Rotate a list N places to the left.

I naturally feel inclined towards a pipeline pattern of data transformations. Wonder if that is idiomatic / what other patterns and idioms may apply here.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14

let rotate l n =
  let rec shift_left i accum_p rest = match rest with
      | [] -> List.rev accum_p, List.rev rest
      | h :: t -> match i with
                    | 0 -> List.rev accum_p, List.rev rest
                    | _ ->  shift_left (i - 1) ( h::accum_p ) t in
  let rec extend acc =  function
      | [] -> List.rev acc
      | h :: t -> extend ( h :: acc ) t in
  let ext, partial = l |> shift_left n [] in
  extend partial ext;;

rotate ["a"; "b"; "c"; "d"; "e"; "f"; "g"; "h"] 3;;
(* - : string list = ["d"; "e"; "f"; "g"; "h"; "a"; "b"; "c"] *)

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18

let rotate l n =
  let rec shift_left i accum_p rest = match rest with
    | [] -> List.rev accum_p, List.rev rest
    | h :: t -> (
      match i with
      | 0 -> List.rev accum_p, List.rev rest
      | _ ->  shift_left (i - 1) ( h::accum_p ) t
    ) in
  let rec extend acc =  function
    | [] -> List.rev acc
    | h :: t -> extend ( h :: acc ) t in
  let n_mod = n mod (List.length l) in
  let ext, partial = l |> shift_left n_mod [] in
  extend partial ext;;

rotate ["a"; "b"; "c"; "d"; "e"; "f"; "g"; "h"] 3;;
rotate ["a"; "b"; "c"; "d"; "e"; "f"; "g"; "h"] 27;; (* modulo check, should be same*)
(* - : string list = ["d"; "e"; "f"; "g"; "h"; "a"; "b"; "c"] *)

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13

let rotate l n =
  let rec shift_left i accum_p rest = match (i, rest) with
      | _, [] -> accum_p, []
      | 0, _ ->  accum_p, rest
      | _, h :: t -> shift_left (i - 1) (h :: accum_p) t
  let len = List.length l in
  let n_mod = if n = 0 then 0 else ( ( n mod len ) + len ) mod len in
  let ext, partial = l |> shift_left n_mod [] in
  partial @ ext;;

rotate ["a"; "b"; "c"; "d"; "e"; "f"; "g"; "h"] 3;;
rotate ["a"; "b"; "c"; "d"; "e"; "f"; "g"; "h"] 27;; (* modulo check, should be same*)
(* - : string list = ["d"; "e"; "f"; "g"; "h"; "a"; "b"; "c"] *)

This isn’t too great yet, I wish it would have been more pipeline-like.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13

let split list n =
    let rec aux i acc = function
      | [] -> List.rev acc, []
      | h :: t as l -> if i = 0 then List.rev acc, l
                       else aux (i - 1) (h :: acc) t  in
    aux n [] list

  let rotate list n =
    let len = List.length list in
    (* Compute a rotation value between 0 and len - 1 *)
    let n = if len = 0 then 0 else (n mod len + len) mod len in
    if n = 0 then list
    else let a, b = split list n in b @ a;;

Math: modulo fix #

-   let n_mod = n mod (List.length l) in
+   let n_mod = if n = 0
+       then 0
+       else ( ( n mod len ) + len ) mod len

n mod (List.length l) handles n > len but breaks on negative n. The model ans uses (n mod len + len) mod len which handles negative rotations correctly — rotating left by -1 is rotating right by 1. The extra + len absorbs the negative residue.

Also: List.length [] is 0, and n mod 0 raises Division_by_zero. The model solution therefore guards with if len = 0 then 0.

10. Extract a Given Number of Randomly Selected Elements From a List #

The selected items shall be returned in a list. We use the Random module and initialise it with Random.init 0 at the start of the function for reproducibility and validate the solution. To make the function truly random, however, one should remove the call to Random.init 0.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

let rand_select l n =
  Random.init 0;
  let take_random l =
    let hi = List.length l in
    let i_chosen = Random.int hi in
    let rec aux_take i acc_rest = function
      | [] -> raise Not_found
      | h :: t -> if i = 0
                  then (h, List.rev_append acc_rest t)
                  else aux_take (i - 1) (h :: acc_rest) t
    in
    aux_take i_chosen [] l
  in
  let rec aux_extract i acc l =
  if i = 0 then List.rev acc
  else match l with
    | [] -> List.rev acc
    | src -> let extracted, rest = take_random src in
             aux_extract (i - 1) (extracted :: acc) rest

  in
  aux_extract n [] l;;

rand_select ["a"; "b"; "c"; "d"; "e"; "f"; "g"; "h"] 3;;

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

let rand_select l n =
  Random.init 0;
  let take_random l =
    let hi = List.length l in
    let i_chosen = Random.int hi in
    let rec aux_take i acc_target acc_rest = function
        | [] -> acc_target, List.rev acc_rest
        | h :: (i_h :: i_t as t) -> if i = i_chosen
                                    then aux_take (i + 1) h ( i_h::acc_rest ) i_t
                                    else aux_take (i + 1) acc_target (i_h::acc_rest) t in
    aux_take 0 0 [] l in
  let rec aux_extract i acc = function
      | [] -> List.rev acc
      | src -> if i = 0
             then List.rev acc
             else let extracted, rest = take_random src
                  in
                  aux_extract (i - 1) (extracted :: acc) rest
  in
  aux_extract n [] l;;

rand_select ["a"; "b"; "c"; "d"; "e"; "f"; "g"; "h"] 3;;
(* - : string list = ["e"; "c"; "g"] *)

Line 2, characters 13-16:
2 | rand_select ["a"; "b"; "c"; "d"; "e"; "f"; "g"; "h"] 3;;
                 ^^^
Error: This constant has type string/2 but an expression was expected of type
         int/2
       File "_none_", line 1:
         Definition of type int/2
       File "_none_", line 1:
         Definition of type string/2

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16

let rand_select list n =
    Random.init 0;
    let rec extract acc n = function
      | [] -> raise Not_found
      | h :: t -> if n = 0 then (h, acc @ t) else extract (h :: acc) (n - 1) t
    in
    let extract_rand list len =
      extract [] (Random.int len) list
    in
    let rec aux n acc list len =
      if n = 0 then acc else
        let picked, rest = extract_rand list len in
        aux (n - 1) (picked :: acc) rest (len - 1)
    in
    let len = List.length list in
      aux (min n len) [] list len;;

The model solution does things differently here:

1. the model ans does silent-capping instead of exception throwing

   it doesn’t raise an error, it just guards against it at the call-site

   the model calls aux (min n len) [] \(\rightarrow\) if n > len then it silently caps the extraction at the list length rather than raising Not_found

   Technically, whether the silent wrapping is better of exception throwing is better should be spec-dependent — for me the more explicit one is better.

2. the model threads the length through the function calls so there’s only a single call to List.length vs my approach that calls length at each iteration — effectively \(O(n^{2})\)

Caution: Avoid the Redundant Double Exit Pattern #

From the first version below, we have two arms with exits (line 3 and 4). We can just do it in the style of the second version, where the pattern matching has a single exit site (line 12).

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16

(* --- my aux_extract *)
  let rec aux_extract i acc = function
    | [] -> List.rev acc
    | src -> if i = 0
             then List.rev acc
             else let extracted, rest = take_random src
                  in
                  aux_extract (i - 1) (extracted :: acc) rest

(* --- without the redundancy *)
  let rec aux_extract i acc l =
  if i = 0 then List.rev acc
  else match l with
    | [] -> List.rev acc  (* <- single exit site @ pattern *)
    | src -> let extracted, rest = take_random src in
             aux_extract (i - 1) (extracted :: acc) rest

11. Generate the Combinations of K Distinct Objects Chosen From the N Elements of a List #

Generate the combinations of K distinct objects chosen from the N elements of a list.

In how many ways can a committee of 3 be chosen from a group of 12 people? We all know that there are C(12,3) = 220 possibilities (C(N,K) denotes the well-known binomial coefficients). For pure mathematicians, this result may be great. But we want to really generate all the possibilities in a list.

So doing this using a mutable style feels so much simpler than doing this on immutable, recursive style. Must be a change in ideology that I need here. My mind immediately goes into a 1/0 Knapsack Algo approach, but that’s best done in a mutable fashion.

The pedestrian recursive solution is a decision-tree traversal.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22

let extract r l =
  if r <= 0 then [[]]
  else
    let rec build_combi all_combis curr_len curr_combi = function
      | [] ->
         if curr_len = r
         then curr_combi::all_combis else all_combis
      | h :: t ->
         if curr_len = r
         then curr_combi::all_combis
         else
           let with_h = build_combi all_combis ( curr_len + 1 ) (h :: curr_combi) t
           in
           let without_h = build_combi all_combis curr_len curr_combi t in
           with_h @ without_h
    in
    build_combi [] 0 [] l ;;


extract 2 ["a"; "b"; "c"; "d"];;
(* - : string list list = *)
(* [["a"; "b"]; ["a"; "c"]; ["a"; "d"]; ["b"; "c"]; ["b"; "d"]; ["c"; "d"]] *)

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14

let extract r l =
  let rec build_combi curr_len curr_combi = function
    | [] ->
        if curr_len = r then [List.rev curr_combi] else []
    | h :: t ->
        if curr_len = r then [List.rev curr_combi]
        else
          let with_h    = build_combi (curr_len + 1) (h :: curr_combi) t in
          let without_h = build_combi curr_len curr_combi t in
          with_h @ without_h
  in
  if r <= 0 then [[]] else build_combi 0 [] l;;

extract 2 ["a"; "b"; "c"; "d"];;

This works but my solution is also not tail recursive. It’s closer to the imperative 0/1 knapsack mental model, that’s why it felt natural.

1
2
3
4
5
6
7
8

let rec extract k list =
    if k <= 0 then [[]]
    else match list with
         | [] -> []
         | h :: tl ->
            let with_h = List.map (fun l -> h :: l) (extract (k - 1) tl) in
            let without_h = extract k tl in
            with_h @ without_h;;

The model solution adopts the typical recursive approach to this, however, it doesnt seem to be tail-recursive.

I’m compelled to look for a tail-recursive solution.

Tree Traversal Recursion #

This question traverses a decision-tree. The decision-trees are the same in mine vs model solution.

For the model solution, the with_h case does a List.map which prepends the head to all the inner-recursed answers (here).

Here, we shouldn’t be pursuing tail-recursion. If we analyse the complexity of this approach, we see that the recursion depth is limited by min r (List.length l) — i.e. it’s at most r deep, which for combination generation, is always small. The with_h @ without_h at the end of each frame is not avoidable because we need both subtrees before merging them.

• Complexity Analysis

  with_h @ without_h is \(O ( | with\_h | )\) @ every node.

  When we’re focused on combination generation, this is an inherent — we’re building a result of size C(n, k) so we need to somehow assemble it.

  Unless we use some sort of mutable approach, neither mine nor the model version can be improved on here.

Style: Interface design and recursive outer function vs non-recursive initialiser #

Consider the two approaches above between mine vs the model solution. Their shapes look different:

(* --- shape of the model ans: recursive outer function *)
let rec extract k list = ...


(* --- shape of my ans: non-recursive initialiser *)
let extract r l =
  let rec build_combi curr_len curr_combi = function ...
  in
  build_combi 0 [] l

It’s a matter of style here.

12. Group the Elements of a Set Into Disjoint Subsets #

Group the elements of a set into disjoint subsets

1. In how many ways can a group of 9 people work in 3 disjoint subgroups of 2, 3 and 4 persons? Write a function that generates all the possibilities and returns them in a list.
2. Generalize the above function in a way that we can specify a list of group sizes and the function will return a list of groups.

1
2
3
4
5
6
7
8
9

group ["a"; "b"; "c"; "d"] [2; 1];;

(*
- : string list list list =
[[["a"; "b"]; ["c"]]; [["a"; "c"]; ["b"]]; [["b"; "c"]; ["a"]];
 [["a"; "b"]; ["d"]]; [["a"; "c"]; ["d"]]; [["b"; "c"]; ["d"]];
 [["a"; "d"]; ["b"]]; [["b"; "d"]; ["a"]]; [["a"; "d"]; ["c"]];
 [["b"; "d"]; ["c"]]; [["c"; "d"]; ["a"]]; [["c"; "d"]; ["b"]]]
*)

13. Sorting a List of Lists According to Length of Sublists #

Sorting a list of lists according to length of sublists.

1. We suppose that a list contains elements that are lists themselves. The objective is to sort the elements of this list according to their length. E.g. short lists first, longer lists later, or vice versa.

2. Again, we suppose that a list contains elements that are lists themselves. But this time the objective is to sort the elements of this list according to their length frequency; i.e., in the default, where sorting is done ascendingly, lists with rare lengths are placed first, others with a more frequent length come later.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15

length_sort [["a"; "b"; "c"]; ["d"; "e"]; ["f"; "g"; "h"]; ["d"; "e"];
             ["i"; "j"; "k"; "l"]; ["m"; "n"]; ["o"]];;
(*
- : string list list =
[["o"]; ["d"; "e"]; ["d"; "e"]; ["m"; "n"]; ["a"; "b"; "c"]; ["f"; "g"; "h"];
 ["i"; "j"; "k"; "l"]]
*)

frequency_sort [["a"; "b"; "c"]; ["d"; "e"]; ["f"; "g"; "h"]; ["d"; "e"];
                ["i"; "j"; "k"; "l"]; ["m"; "n"]; ["o"]];;
(*
- : string list list =
[["i"; "j"; "k"; "l"]; ["o"]; ["a"; "b"; "c"]; ["f"; "g"; "h"]; ["d"; "e"];
 ["d"; "e"]; ["m"; "n"]]
*)

TODO Arithmetic #

14. Determine Whether a Given Integer Number Is Prime #

Determine whether a given integer number is prime.

1
2
3
4
5
6

not (is_prime 1);;
(* - : bool = true *)
is_prime 7;;
(* - : bool = true *)
not (is_prime 12);;
(* - : bool = true *)

15. Determine the Greatest Common Divisor of Two Positive Integer Numbers #

Determine the greatest common divisor of two positive integer numbers.

Use Euclid’s algorithm.

1
2
3
4
5

let rec gcd lo hi =
  if lo = 0 then hi else if hi = 0 then lo else
    let lo, hi = (Int.min lo hi), (Int.max lo hi) in
    let diff = hi - lo in
    gcd lo diff;;

1
2

let rec gcd a b =
    if b = 0 then a else gcd b (a mod b);;

1
2
3
4
5
6
7

let gcd a b =
  let rec aux a b =
    if b = 0 then a
    else aux b (a % b) (*--- modulo makes it logarithmic because big jumps*)
  in
  aux (abs a) (abs b);;
gcd 20536 7826;;

16. Calculate Euler’s Totient Function \(\phi(m)\) #

Euler’s so-called totient function \(\phi(m)\) is defined as the number of positive integers r (1 ≤ r < m) that are coprime to m. We let \(\phi(1)\) = 1.

Find out what the value of \(\phi(m)\) is if m is a prime number.

Euler’s totient function plays an important role in one of the most widely used public key cryptography methods (RSA). In this exercise you should use the most primitive method to calculate this function (there are smarter ways that we shall discuss later).

1
2
3
4
5
6
7

let rec gcd a b =
    if b = 0 then a else gcd b (a mod b);;
let coprime a b = ( gcd a b ) = 1;;
let phi m =
  let rec aux acc n =
    if n = 1 then acc + 1 else if coprime m n then aux (acc + 1) (n - 1) else aux acc (n - 1) in
  aux 0 (m - 1);;

1
2
3
4
5
6
7

let phi n =
  let rec count_coprime acc d =
    if d < n then
      count_coprime (if coprime n d then acc + 1 else acc) (d + 1)
    else acc
  in
  if n = 1 then 1 else count_coprime 0 1;;

17. Determine the Prime Factors of a Given Positive Integer #

Construct a flat list containing the prime factors in ascending order.

1
2
3

factors 315;;
(* - : int list = [3; 3; 5; 7] *)

18. Determine the Prime Factors of a Given Positive Integer (2) #

Construct a list containing the prime factors and their multiplicity.

Hint: The problem is similar to problem Run-length encoding of a list (direct solution).

1
2

factors 315;;
(* - : (int * int) list = [(3, 2); (5, 1); (7, 1)] *)

19. Calculate Euler’s Totient Function \(\phi(m)\) (Improved) #

See problem “Calculate Euler’s totient function \(\phi(m)\)” for the definition of Euler’s totient function.

If the list of the prime factors of a number m is known in the form of the previous problem then the function phi(m) can be efficiently calculated as follows: Let [(p1, m1); (p2, m2); (p3, m3); ...] be the list of prime factors (and their multiplicities) of a given number m. Then \(\phi(m)\) can be calculated with the following formula:

\[ \phi(m) \newline = (p1 - 1) \times p1^{m1 - 1} \times (p2 - 1) \times p2^{m2 - 1} \times (p3 - 1) \times p3^{m3 - 1} \times … \]

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22

let factors n =
    let rec aux d n =
      if n = 1 then [] else
        if n mod d = 0 then
          match aux d (n / d) with
          | (h, n) :: t when h = d -> (h, n + 1) :: t
          | l -> (d, 1) :: l
        else aux (d + 1) n
    in
      aux 2 n;;
let pow base exp =
  let rec aux acc b e =
    if e = 0 then acc else aux (acc * b) b (e - 1) in
  aux 1 base exp;; (*--- naive power fn, tail recursive*)
let phi_improved n =
  let rec aux acc = function
    | [ ] -> acc
    | (p, m) :: t -> aux ( (p - 1) * (pow p (m - 1)) * acc ) t
  in
  aux 1 (factors n);;
phi_improved 10;;
phi_improved 13;;

20. Goldbach’s Conjecture #

Goldbach’s conjecture says that every positive even number greater than 2 is the sum of two prime numbers. Example: 28 = 5 + 23. It is one of the most famous facts in number theory that has not been proved to be correct in the general case. It has been numerically confirmed up to very large numbers. Write a function to find the two prime numbers that sum up to a given even integer.

1
2

goldbach 28;;
(* - : int * int = (5, 23) *)

21. A List of Goldbach Compositions #

Given a range of integers by its lower and upper limit, print a list of all even numbers and their Goldbach composition.

In most cases, if an even number is written as the sum of two prime numbers, one of them is very small. Very rarely, the primes are both bigger than say 50. Try to find out how many such cases there are in the range 2..3000.

1
2
3
4
5
6

goldbach_list 9 20;;
(*
- : (int * (int * int)) list =
[(10, (3, 7)); (12, (5, 7)); (14, (3, 11)); (16, (3, 13)); (18, (5, 13));
 (20, (3, 17))]
 *)

TODO Binary Trees #

TODO Logic and Codes #

TODO Multiway Trees #

TODO Graphs #

TODO Miscellaneous #