I've got 99 Problems - and OCaml is all of them (Binary Trees)

Problemset

Construct completely balanced binary trees. (medium)

In OCaml, one can define a new type binary_tree that carries an arbitrary value of type 'a at each node.

# type 'a binary_tree =
    | Empty
    | Node of 'a * 'a binary_tree * 'a binary_tree;;
type 'a binary_tree = Empty | Node of 'a * 'a binary_tree * 'a binary_tree

let rec cbal_tree nodes =
if nodes = 0 then [Empty] else
let rec attach_deep v = function
| [] -> []
| hd :: tl -> Node ("x", v, hd) :: attach_deep v tl in
let rec attach lis = function
| [] -> []
| hd :: tl -> attach_deep hd lis @ attach lis tl in
let lhs = (nodes-1)/2 in
let rhs = (nodes-1) - ((nodes-1)/2) in
if nodes % 2 = 1 then attach (cbal_tree lhs) (cbal_tree rhs) else attach (cbal_tree lhs) (cbal_tree rhs) @ attach (cbal_tree rhs) (cbal_tree lhs)
;;

Symmetric binary trees. (medium)

let rec is_mirror lhs rhs =
match (lhs, rhs) with
| (Empty, Empty) -> true
| (Node (_, l1, r1), Node (_, l2, r2)) -> if is_mirror l1 r2 && is_mirror l2 r1 then true else false
| _ -> false;;

let is_symmetric = function
| Empty -> true
| Node (v, l, r) -> is_mirror l r
;;

Binary search trees (dictionaries). (medium)

let construct lis =
let rec insert v = function
| Empty -> Node (v, Empty, Empty)
| Node (hv, l, r) as orig -> if v < hv then Node (hv, insert v l, r) else if v > hv then Node (hv, l, insert v r) else orig
in
let rec aux tree = function
| [] -> tree
| h :: t -> insert h (aux tree t)
in
aux Empty (List.rev lis);;

Generate-and-test paradigm. (medium)

let sym_cbal_trees nodes =
List.filter ~f:(fun x -> is_symmetric x) (cbal_tree nodes);;

Construct height-balanced binary trees. (medium)

let rec hbal_tree height =
if height = 0 then [Empty] else
if height = 1 then [Node ("x", Empty, Empty)] else
let rec attach_deep v = function
| [] -> []
| hd :: tl -> Node ("x", v, hd) :: attach_deep v tl in
let rec attach lis = function
| [] -> []
| hd :: tl -> attach_deep hd lis @ attach lis tl in
let lhs = height-2 in
let rhs = height-1 in
attach (hbal_tree lhs) (hbal_tree rhs) @ attach (hbal_tree rhs) (hbal_tree lhs) @ attach (hbal_tree rhs) (hbal_tree rhs);;

I've got 99 problems - and OCaml is all of them (Multiway trees)

Multiway Trees

# type 'a mult_tree = T of 'a * 'a mult_tree list;;
type 'a mult_tree = T of 'a * 'a mult_tree list

Count the nodes of a multiway tree. (easy)

let rec count_nodes tree =

let rec count_list = function

| [] -> 0

| h :: t -> count_nodes h + count_list t

in

match tree with

| T (_, c) -> 1 + count_list c;;

Tree construction from a node string. (medium)

let rec string_of_tree tree =

let rec aux = function

| [] -> ""

| h :: t -> string_of_tree h ^ aux t

in

match tree with

| T (v, c) -> String.make 1 v ^ aux c ^ "^";;

I've got 99 Problems - and OCaml is all of them (Logic and codes)

Problemset

Logic and Codes

Let us define a small "language" for boolean expressions containing variables:

# type bool_expr =
    | Var of string
    | Not of bool_expr
    | And of bool_expr * bool_expr
    | Or of bool_expr * bool_expr;;
type bool_expr =
    Var of string
  | Not of bool_expr
  | And of bool_expr * bool_expr
  | Or of bool_expr * bool_expr

A logical expression in two variables can then be written in prefix notation. For example, (a ∨ b) ∧ (a ∧ b) is written:

# And(Or(Var "a", Var "b"), And(Var "a", Var "b"));;
- : bool_expr = And (Or (Var "a", Var "b"), And (Var "a", Var "b"))

Truth tables for logical expressions (2 variables). (medium)

Define a function, table2 which returns the truth table of a given logical expression in two variables (specified as arguments). The return value must be a list of triples containing(value_of_a, balue_of_b, value_of_expr).

let table2 e1 e2 expr =
let rec eval e1 e2 e1val e2val = function
| And (a, b) -> eval e1 e2 e1val e2val a && eval e1 e2 e1val e2val b
| Or (a, b) -> eval e1 e2 e1val e2val a || eval e1 e2 e1val e2val b
| Var a -> if a = e1 then e1val else e2val
| Not a -> not (eval e1 e2 e1val e2val a) in
[(true, true, eval e1 e2 true true expr);
 (true, false, eval e1 e2 true false expr);
 (false, true, eval e1 e2 false true expr);
 (false, false, eval e1 e2 false false expr);];;

Truth tables for logical expressions. (medium)

let table vars expr =
let rec findfirst v def = function
| [] -> def
| (key, value) :: t -> if key = v then value else findfirst v def t
in
let rec eval values = function
| Var a -> findfirst a false values
| Not e -> not (eval values e)
| Or (a, b) -> eval values a || eval values b
| And (a, b) -> eval values a && eval values b
in
let rec aux acc values expr = function
| [] -> (List.rev values, eval values expr) :: acc
| h :: t -> aux (aux acc ((h, false) :: values) expr t) ((h, true) :: values) expr t
in
aux [] [] expr vars;;

Gray code. (medium)

let gray bits =
let rec aux bits prefix parity =
if bits = 0 then [prefix] else
if parity = true then (aux (bits-1) (prefix ^ "1") false) @ (aux (bits-1) (prefix ^ "0") true) else
(aux (bits-1) (prefix ^ "0") false) @ (aux (bits-1) (prefix ^ "1") (true)) in
aux bits "" false;;

Huffman code (hard)

let huffman fs =
let freqof = function
| Leaf (f, _) -> f
| Branch (f, _, _) -> f in
let rec insert v = function
| [] -> [v]
| hd :: tl as orig -> if freqof hd >= freqof v then v :: orig else hd :: insert v tl in
let rec encode = function
| [] | [_] as orig -> orig
| h1 :: h2 :: tl -> encode (insert (Branch (freqof h1 + freqof h2, h1, h2)) tl) in
let encoded = encode (List.map ~f:(fun (v, f) -> Leaf (f, v)) (List.sort ~cmp:(fun (v1, f1) (v2, f2) -> if f1 = f2 then 0 else if f1 < f2 then -1 else 1) fs)) in
let rec develop acc prefix = function
| Leaf (_, a) -> (a, prefix) :: acc
| Branch (_, a, b) -> develop (develop acc (prefix ^ "1") b) (prefix ^ "0") a in
match encoded with
| [a] -> develop [] "" a
| [] | _::_ -> [];;

I've got 99 Problems - and OCaml is all of them (Arithmetic)

Problemset

Determine whether a given integer number is prime. (medium)

let is_prime n =
if n < 2 then false else
let rec aux n c =
if c * c > n then true elseif n % c = 0 then false else
aux n (c+1) in
aux n 2;;

Determine the greatest common divisor of two positive integer numbers. (medium)

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

Determine whether two positive integer numbers are coprime. (easy)

let co_prime a b = if gcd a b = 1 then true else false;;

Calculate Euler's totient function φ(m). (medium)

Skipped. See improved version.

Determine the prime factors of a given positive integer. (medium)

let rec factors ?(c=2) n =
if n % c = 0 then c :: factors (n / c) ~c else
if c * c > n then if n = 1 then [] else [n] else
factors n ~c:(c+1);;

Determine the prime factors of a given positive integer (2). (medium)

let factors n =
let rec aux cur cnt n =
if n mod cur = 0 then aux cur (cnt+1) (n/cur) else
if cnt > 0 then (cur, cnt) :: aux (cur+1) 0 n else
if cur * cur > n then if n = 1 then [] else [(n, 1)] else
aux (cur+1) 0 n in
aux 2 0 n;;

Note: Complexity = sqrt(N)

Calculate Euler's totient function φ(m) (improved). (medium)

let phi_improved n =
let pf = factors n in
List.fold ~init:1 ~f:(fun old (n, c) -> old * ((n-1) * Int.of_float((Float.of_int n) ** (Float.of_int (c - 1))))) pf;;

Compare the two methods of calculating Euler's totient function. (easy)

I used their implementation as benchmark for slow one.

let timeit f a =

let start = Unix.gettimeofday () in

let res = f a in

let e = Unix.gettimeofday () in

e -. start;;

A list of prime numbers. (easy)

let all_primes s f =

List.filter ~f:is_prime (range s f);;

Goldbach's conjecture. (medium)

let goldbach num =

let rec aux n num =

if is_prime n && is_prime (num-n) then (n, (num-n)) else aux (n+1) num in

aux 2 num;;

A list of Goldbach compositions. (medium)

let rec goldbach_list s f =

if s mod 2 <> 0 then goldbach_list (s+1) f else

if s > f then [] else

(s, goldbach s) :: goldbach_list (s+1) f;;

I've got 99 Problems - and OCaml is all of them (List operations)

Problemset

I am new to OCaml & Functional languages. I am NOT new to programming. Let's get up to speed.

Write a function last : 'a list -> 'a option that returns the last element of a list. (easy)

let rec last x = match x with | [] -> None | [hd] -> Some hd | hd :: tail -> last tail;;

Find the last but one (last and penultimate) elements of a list. (easy)

let rec last_two lis =

match lis with

| [] | [_] -> None

| [h1; h2] -> Some (h1, h2)

| _ :: t -> last_two t;;

Find the k'th element of a list. (easy)

let rec at n lis =

if n = 1 then

    match lis with

    | hd :: _ -> Some hd

    | [] -> None

else

    match lis with

    | _ :: t -> at (n-1) t

    | [] -> None;

Find the number of elements of a list. (easy)

let rec length ?(count=0) lis =

match lis with

| [] -> count

| _ :: t -> length ~count:(count+1) t;;

Reverse a list. (easy)

let rec rev lis =

match lis with

| [] -> []

| hd :: tl -> rev tl @ [hd];;

^ NO good! It's O(N^2)!

let rev lis =

let aux acc rem =

match rem with

| [] -> acc

| hd :: tl -> aux (hd :: acc) tl in

aux [] lis;;

Find out whether a list is a palindrome. (easy)

let is_palindrome lis =

if (rev lis) = lis then true else false;;

Flatten a nested list structure. (medium)

# (* There is no nested list type in OCaml, so we need to define one
     first. A node of a nested list is either an element, or a list of
     nodes. *)
  type 'a node =
    | One of 'a 
    | Many of 'a node list;;
type 'a node = One of 'a | Many of 'a node list

let rec flatten lis =

match lis with

| [] -> []

| One x :: tl -> x :: flatten tl

| Many x :: tl -> (flatten x) @ (flatten tl);;

Eliminate consecutive duplicates of list elements. (medium)

let rec compress lis =

let rec aux acc rem hd =

match rem with

| [] -> hd :: acc

| h :: t when h = hd -> aux acc t hd

| h :: t -> aux (hd :: acc) t h in

match lis with

| [] -> []

| hd :: tl -> List.rev (aux [] tl hd);;

Pack consecutive duplicates of list elements into sublists. (medium)

let pack lis =

let rec aux res acc rem v =

match rem with

| [] -> acc :: res

| hd :: tl when hd = v -> aux res (hd :: acc) tl v

| hd :: tl -> aux (acc :: res) [hd] tl hd

in

match lis with

| [] -> []

| hd :: tl -> List.rev (aux [] [hd] tl hd)

;;

Run-length encoding of a list. (easy)

let encode list =

let rec aux current acc = function

| [] -> []

| [hd] -> (current + 1, hd) :: acc

| a :: (b :: _ as tl) when a = b -> aux (current + 1) acc tl

| a :: (b :: _ as tl) -> aux 0 ((current+1, a) :: acc) tl

in

List.rev (aux 0 [] list)

;;

Modified run-length encoding. (easy)

Modify the result of the previous problem in such a way that if an element has no duplicates it is simply copied into the result list. Only elements with duplicates are transferred as (N E) lists.

Since OCaml lists are homogeneous, one needs to define a type to hold both single elements and sub-lists.

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

let encode list =

let rec aux current acc = function

| [] -> []

| [hd] -> if current = 0 then (One hd) :: acc else (Many (current+1, hd)) :: acc

| a :: (b :: _ as tl) when a = b -> aux (current + 1) acc tl

| a :: (b :: _ as tl) -> if current = 0 then aux 0 ((One a) :: acc) tl else aux 0 (Many (current+1, a) :: acc) tl

in

List.rev (aux 0 [] list)

;;

Decode a run-length encoded list. (medium)

let decode list =

let rec aux acc = function

| [] -> acc

| (One x) :: tl -> aux (x :: acc) tl

| (Many (n, v)) :: tl -> if n = 0 then aux acc tl else aux (v :: acc) ((Many ((n-1), v)) :: tl)

in

List.rev (aux [] list)

;;

Run-length encoding of a list (direct solution). (medium)

let rec encode ?(cur=0) ?(acc=[]) = function

| [] -> []

| [hd] -> if cur = 0 then (One hd) :: acc else (Many (cur + 1, hd)) :: acc

| a :: (b :: _ as t) when a = b -> encode ~cur:(cur+1) ~acc:acc t

| a :: (b :: _ as t) -> if cur = 0 then encode ~cur:0 ~acc:(One a :: acc) t else encode ~cur:0 ~acc:(Many (cur+1, a) :: acc) t;;

Duplicate the elements of a list. (easy)

let duplicate list =

let rec aux acc = function

| [] -> acc

| hd :: tl -> aux (hd :: hd :: acc) tl

in

List.rev (aux [] list);;

Replicate the elements of a list a given number of times. (medium)

let replicate list n =

let rec aux acc tn = function

| [] -> acc

| hd :: tl as orig -> if tn = 0 then aux (hd :: acc) (n-1) tl else aux (hd :: acc) (tn-1) orig in

List.rev (aux [] (n-1) list);;

Drop every N'th element from a list. (medium)

let drop list n =

let rec aux acc tn = function

| [] -> acc

| hd :: tl -> if tn = 0 then aux acc (n-1) tl else aux (hd :: acc) (tn-1) tl in

List.rev (aux [] (n-1) list);;

Split a list into two parts; the length of the first part is given. (easy)

let split list n =

let rec aux first n = function

| [] -> (List.rev first, [])

| hd :: tl -> if n = 0 then (List.rev first, hd::tl) else aux (hd :: first) (n-1) tl in

aux [] n list;;

Extract a slice from a list. (medium)

let slice list i k =

let rec aux acc i k j = function

| [] -> acc

| hd :: tl -> if j > k then acc else if j >= i then aux (hd :: acc) i k (j+1) tl else aux [] i k (j+1) tl in

List.rev (aux [] i k 0 list);;

Rotate a list N places to the left. (medium)

let rotate list n =

let rot = ((n mod (List.length list)) + List.length list) mod (List.length list) in

let rec aux left n = function

| [] -> (List.rev left)

| hd :: tl -> if n = 0 then (hd :: tl @ (List.rev left)) else aux (hd :: left) (n-1) tl in

aux [] rot list;;

Remove the K'th element from a list. (easy)

let remove_at n list =

let rec aux lhs n = function

| [] -> List.rev lhs

| hd :: tl -> if n = 0 then List.rev lhs @ tl else aux (hd :: lhs) (n-1) tl in

aux [] n list;;

From now on I will abandon tail recursion just for style change

Insert an element at a given position into a list. (easy)

let rec insert_at v n = function

| [] -> if n = 0 then [v] else []

| hd :: tl -> if n = 0 then v :: hd :: tl else hd :: insert_at v (n-1) tl;;

Create a list containing all integers within a given range. (easy)

let rec range s f =

if s = f then [s] else

if s < f then s :: (range (s+1) f) else

s :: range (s-1) f;;

Extract a given number of randomly selected elements from a list. (medium)

let rand_select list n =

let rec pop_at pos def = function

| [] -> (def, [])

| hd :: tl -> if pos = 0 then (hd, tl) else

    let (v, rem) = (pop_at (pos-1) def tl) in

    (v, hd :: rem)

in

let rec aux n acc = function

| [] -> acc

| hd :: tl as lis -> if n = 0 then acc else let (v, rem) = pop_at (Random.int (List.length tl + 1)) hd lis in aux (n-1) (v :: acc) rem in

aux n [] list;;

Lotto: Draw N different random numbers from the set 1..M. (easy)

let lotto_select n f =

rand_select (range 1 f) n;;

Generate a random permutation of the elements of a list. (easy)

let permutation list = rand_select list (List.length list);;

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

let extract n lis =

let rec cross lis = function

| [] -> []

| hd :: tl -> (lis :: hd) :: cross lis tl in

let rec aux n = function

| [] -> if n = 0 then [[]] else []

| hd :: tl -> if n = 0 then [[]] else (cross hd (aux (n-1) tl)) @ aux n tl in

aux n lis;;

Sol 2:

let extract n lis =

let rec aux suffix n = function

| [] -> if n = 0 then [suffix] else []

| hd :: tl -> if n = 0 then [suffix] else aux (hd :: suffix) (n-1) tl @ aux suffix n tl in

aux [] n lis;;

Sol 3:

let extract n lis =

let rec aux suffix n acc = function

| [] -> acc

| h :: t -> if n = 1 then aux suffix n ((h :: suffix) :: acc) t else aux (h :: suffix) (n-1) (aux suffix n acc t) t in

aux [] n [] lis;;

Sol 4:

let extract n lis =

let rec aux suffix n acc = function

| [] -> if n = 0 then (suffix :: acc) else acc

| h :: t -> if n = 0 then (suffix :: acc) else aux (h :: suffix) (n-1) (aux suffix n acc t) t in

aux [] n [] lis;;

Group the elements of a set into disjoint subsets. (medium)

let group list sizes =
let rec aux acc cur pre sizes lhs = function
| [] -> acc
| h :: t -> match sizes with
    | [] -> acc
    | sd :: st -> if sd = 1 then
         if st = [] then
             aux (((h :: pre) :: cur) :: acc) cur pre sizes lhs t
         else
             aux (aux acc cur pre sizes (h :: lhs) t) ((h :: pre) :: cur) [] st [] (lhs @ t)
      else
          aux (aux acc cur pre sizes (h :: lhs) t) cur (h :: pre) ((sd - 1) :: st) lhs t
in
aux [] [] [] sizes [] (List.rev list);;

Sorting a list of lists according to length of sublists. (medium)

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.

let length_sort lis =
let rec merge comp a b =
    match a with | [] -> b
    | ah :: at -> match b with | [] -> a
        | bh :: bt -> if comp ah bh < 0 then (ah :: merge comp at b)
                      else (bh :: merge comp a bt)
in
let rec mergesort comp lis = match lis with
| [] | [_] as l -> l
| _ -> merge comp (mergesort comp (slice lis 0 ((List.length lis) / 2 - 1))) (mergesort comp (slice lis ((List.length lis) / 2) (List.length lis -1)))
in
let enumerated = List.map ~f:(fun a -> (List.length a, a)) lis in
List.map ~f:(fun (a, b) -> b) (mergesort (fun x y -> if x < y then -1 else 1) enumerated);;

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.

let frequency_sort lis =
let rec merge comp a b =
    match a with | [] -> b
    | ah :: at -> match b with | [] -> a
        | bh :: bt -> if comp ah bh < 0 then (ah :: merge comp at b)
                      else (bh :: merge comp a bt)
in
let rec mergesort comp lis = match lis with
| [] | [_] as l -> l
| _ -> merge comp (mergesort comp (slice lis 0 ((List.length lis) / 2 - 1))) (mergesort comp (slice lis ((List.length lis) / 2) (List.length lis -1)))
in
let lengths = List.map ~f:(fun a -> List.length a) lis in
let sortedlengths = mergesort (fun x y -> if x < y then -1 else 1) lengths in

let encode list =
let rec aux current acc = function
| [] -> []
| [hd] -> (current + 1, hd) :: acc
| a :: (b :: _ as tl) when a = b -> aux (current + 1) acc tl
| a :: (b :: _ as tl) -> aux 0 ((current+1, a) :: acc) tl
in
List.rev (aux 0 [] list) in

let encodedlengths = List.map ~f:(fun (x, y) -> (y, x)) (encode sortedlengths) in

let rec findfirst v def = function
| [] -> def
| (a, b) :: t -> if v = a then b else findfirst v def t in

let enumerated = List.map ~f:(fun a -> (findfirst (List.length a) (-1) encodedlengths , a)) lis in
List.map ~f:(fun (a, b) -> b) (mergesort (fun x y -> if x < y then -1 else 1) enumerated);;

Real World OCaml - Day 2

I've just gone through chapter 2 (Variables and functions) on Day 1 and I realize that I need to play around with it a lot before I am comfortable with what's going on.

Also, it's taken me about 4 hours to digest the first chapter and semi-digest the second chapter. This is about 50 pages, or 1/10 of the book. Without further assumptions I'm looking at about 32 hours to finish the entire book, or 16 hours to finish the first part (Language Concepts). Every chapter in Language Concepts look useful. With only 5 days to work on this (remaining days are spent packing) I need to work 6 hours a day to finish the book or a bit over 3 hours a day to finish part II.

Let's go.

Progress========================

10:35 am: working through named arguments and optional arguments examples thoroughly.
10:49 am: Now onto Lists and Patterns.
12:00 am: I've finished and digested Lists and Patterns. I will be moving on to 99 problems - OCaml
https://ocaml.org/learn/tutorials/99problems.html

Real World OCaml - Day 1

Will be flying to work at Jane Street in less than 2 weeks! Exciting, however unfortunately exams (and procrastination) is taking it's toll on my progress on digesting that nice "Real World OCaml" book by Minsky, Madhavapeddy and Hickey.

I will be posting my progress as I go as a reminder that I have to get my shit together, and also for your interest - any interesting tidbits I will definitely let yall know.

So anyway, I have OCaml installed, will be installing Core and utop, and will be going through the guided tour!

Once I figure out how long a chapter roughly takes me, I will develop a time plan and commit to (at least trying to) finishing the book before my internship on the 30th of November.

~

Edit ===============================

Things that I screwed up:

Installation:

For some reason core wouldn't install, throwing me errors like

#=== ERROR while installing herelib.112.35.00 =================================#

# opam-version    1.2.2

# os              darwin

Cannot remove /Users/yujinwunz/.opam/system/build/herelib.112.35.00 (error 1).

but switching:

$ opam switch 4.02.1

and then installing again:

$ opam install core

worked. I still don't know what happened. I ran:

$ ocaml -version
The OCaml toplevel, version 4.02.1

before I switched, which is even more confusing.

Running ocaml with core:

When I first launched ocaml, I couldn't open core:

$ utop

# open Core.Std;;

Error: Unbound module Core

That's because we didn't #requre "core". So I appended the following to my ~/.ocamlinit (which contained core's associated libraries too):

#use “topfind”#thread#require “dynlink”#camlp4o#require “bin_prot.syntax”#require “sexplib.syntax”#require “variantslib.syntax”#require “fieldslib.syntax”#require “comparelib.syntax”#require “core”#require “async”#require “core_extended”#require “core.top”open Core.Std