🎉 Exercism Research is now launched. Help Exercism, help science and have some fun at research.exercism.io 🎉 # emengd's solution

## to Custom Set in the OCaml Track

Published at Apr 18 2019 · 0 comments
Instructions
Test suite
Solution

#### Note:

This exercise has changed since this solution was written.

Create a custom set type.

Sometimes it is necessary to define a custom data structure of some type, like a set. In this exercise you will define your own set. How it works internally doesn't matter, as long as it behaves like a set of unique elements.

## Getting Started

For installation and learning resources, refer to the exercism help page.

## Installation

To work on the exercises, you will need `Opam` and `Base`. Consult opam website for instructions on how to install `opam` for your OS. Once `opam` is installed open a terminal window and run the following command to install base:

``````opam install base
``````

To run the tests you will need `OUnit`. Install it using `opam`:

``````opam install ounit
``````

## Running Tests

A Makefile is provided with a default target to compile your solution and run the tests. At the command line, type:

``````make
``````

## Interactive Shell

`utop` is a command line program which allows you to run Ocaml code interactively. The easiest way to install it is via opam:

``````opam install utop
``````

Consult utop for more detail.

## Feedback, Issues, Pull Requests

The exercism/ocaml repository on GitHub is the home for all of the Ocaml exercises.

If you have feedback about an exercise, or want to help implementing a new one, head over there and create an issue. We'll do our best to help you!

## Submitting Incomplete Solutions

It's possible to submit an incomplete solution so you can see how others have completed the exercise.

### test.ml

``````open OUnit2

module type EXPECTED = sig
type t
val of_list : int list -> t
val is_empty : t -> bool
val is_member : t -> int -> bool
val is_subset : t -> t -> bool
val is_disjoint: t -> t -> bool
val equal : t -> t -> bool
val add : t -> int -> t
val intersect : t -> t -> t
val difference : t -> t -> t
val union : t -> t -> t
end

module CSet : EXPECTED = Custom_set.Make(struct
type t = int
let compare a b = compare (a mod 10) (b mod 10)
end)

let assert_true exp _text_ctxt = assert_equal exp true
let assert_false exp _text_ctxt = assert_equal exp false
let tests = [
"sets with no elements are empty">::
assert_true (CSet.is_empty (CSet.of_list []));
"sets with elements are not empty">::
assert_false (CSet.is_empty (CSet.of_list ));
"nothing is contained in the empty set">::
assert_false (CSet.is_member (CSet.of_list []) 1);
"when the element is in the set">::
assert_true (CSet.is_member (CSet.of_list [1;2;3]) 1);
"when the element is not in the set">::
assert_false (CSet.is_member (CSet.of_list [1;3;3]) 4);
"empty set is a subset of an other empty set">::
assert_true (CSet.is_subset (CSet.of_list []) (CSet.of_list []));
"empty set is a subset of a non empty set">::
assert_true (CSet.is_subset (CSet.of_list []) (CSet.of_list ));
"non-empty set is a not subset of an empty set">::
assert_false (CSet.is_subset (CSet.of_list ) (CSet.of_list []));
"set is a subset of set with exact same elements">::
assert_true (CSet.is_subset (CSet.of_list [1;2;3]) (CSet.of_list [1;2;3]));
"set is a subset of larger set with exact same elements">::
assert_true (CSet.is_subset (CSet.of_list [1;2;3]) (CSet.of_list [4;1;2;3]));
"set is not a subset of set that does not contain its elements">::
assert_false (CSet.is_subset (CSet.of_list [1;2;3]) (CSet.of_list [4;1;3]));
"the empty set is disjoint with itself">::
assert_true (CSet.is_disjoint (CSet.of_list []) (CSet.of_list []));
"the empty set is disjoint with non-empty set">::
assert_true (CSet.is_disjoint (CSet.of_list []) (CSet.of_list ));
"non-empty set is disjoint with empty set">::
assert_true (CSet.is_disjoint (CSet.of_list ) (CSet.of_list []));
"sets are not disjoint if they share an element">::
assert_false (CSet.is_disjoint (CSet.of_list [1;2]) (CSet.of_list [2;3]));
"sets are disjoint if they do not share an element">::
assert_true (CSet.is_disjoint (CSet.of_list [1;2]) (CSet.of_list [3;4]));
"empty sets are equal">::
assert_true (CSet.equal (CSet.of_list []) (CSet.of_list []));
"empty set is not equal to non-empty set">::
assert_false (CSet.equal (CSet.of_list []) (CSet.of_list [1;2;3]));
"non-empty set is not equal to empty set">::
assert_false (CSet.equal (CSet.of_list [1;2;3]) (CSet.of_list []));
"sets with the same elements are equal">::
assert_true (CSet.equal (CSet.of_list [1;2]) (CSet.of_list [2;1]));
"sets with different elements are not equal">::
assert_false (CSet.equal (CSet.of_list [1;2;3]) (CSet.of_list [1;2;4]));
"add to empty set">::
assert_true (CSet.equal (CSet.of_list ) (CSet.add (CSet.of_list []) 3));
"add to non-empty set">::
assert_true (CSet.equal (CSet.of_list [1;2;3;4]) (CSet.add (CSet.of_list [1;2;4]) 3));
"adding existing element does not change set">::
assert_true (CSet.equal (CSet.of_list [1;2;3]) (CSet.add (CSet.of_list [1;2;3]) 3));
"intersection of two empty sets is empty set">::
assert_true (CSet.equal (CSet.of_list []) (CSet.intersect (CSet.of_list []) (CSet.of_list [])));
"intersection of empty set with non-empty set is an empty set">::
assert_true (CSet.equal (CSet.of_list []) (CSet.intersect (CSet.of_list []) (CSet.of_list [3;2;5])));
"intersection of non-empty set with empty set is an empty set">::
assert_true (CSet.equal (CSet.of_list []) (CSet.intersect (CSet.of_list [1;2;3;4]) (CSet.of_list [])));
"intersection of sets with no shared elements is empty set">::
assert_true (CSet.equal (CSet.of_list []) (CSet.intersect (CSet.of_list [1;2;3]) (CSet.of_list [4;5;6])));
"intersection of set with shared elements is set of shared elements">::
assert_true (CSet.equal (CSet.of_list [2;3]) (CSet.intersect (CSet.of_list [1;2;3;4]) (CSet.of_list [3;2;5])));
"difference of two empty sets is an empty set">::
assert_true (CSet.equal (CSet.of_list []) (CSet.difference (CSet.of_list []) (CSet.of_list [])));
"difference of empty set and non-empty set is empty set">::
assert_true (CSet.equal (CSet.of_list []) (CSet.difference (CSet.of_list []) (CSet.of_list [3;2;5])));
"difference of non-empty set and empty set is the non-empty set">::
assert_true (CSet.equal (CSet.of_list [1;2;3;4]) (CSet.difference (CSet.of_list [1;2;3;4]) (CSet.of_list [])));
"difference of two non-empty sets is the sets of elements only in the first set">::
assert_true (CSet.equal (CSet.of_list [1;3]) (CSet.difference (CSet.of_list [3;2;1]) (CSet.of_list [2;4])));
"union of two empty sets is an empty set">::
assert_true (CSet.equal (CSet.of_list []) (CSet.union (CSet.of_list []) (CSet.of_list [])));
"union of empty set and non-empty set is non-empty set">::
assert_true (CSet.equal (CSet.of_list ) (CSet.union (CSet.of_list []) (CSet.of_list )));
"union of non-empty set and empty set is the non-empty set">::
assert_true (CSet.equal (CSet.of_list [1;3]) (CSet.union (CSet.of_list [1;3]) (CSet.of_list [])));
"union of two non-empty sets contains all unique elements">::
assert_true (CSet.equal (CSet.of_list [1;2;3]) (CSet.union (CSet.of_list [1;3]) (CSet.of_list [2;3])));
]

let () =
run_test_tt_main ("custom_set tests" >::: tests)``````
``````open Base

module type S = sig
type t
type elt
val empty : t
val of_list : elt list -> t
val to_list : t -> elt list
val is_empty : t -> bool
val is_member : t -> elt -> bool
val is_subset : t -> t -> bool
val is_disjoint: t -> t -> bool
val equal : t -> t -> bool
val add : t -> elt -> t
val intersect : t -> t -> t
val difference : t -> t -> t
val union : t -> t -> t
end

module type P = sig
type t
val compare : t -> t -> int
end

module Make (Parameter : P) : S with type elt = Parameter.t = struct

type elt = Parameter.t

(* Red-Black trees *)
type color = Red | Black
type t =
| Empty
| Node of color * t * elt * t

let empty = Empty

let is_empty = function
| Empty -> true
| Node _ -> false

let rec is_member set x =
match set with
| Empty -> false
| Node (_, left, y, right) ->
let cmp = Parameter.compare x y in
if cmp = 0 then
true
else if cmp < 0 then
is_member left x
else
is_member right x

let balance = function
| Node (Black, t0, x1, Node (Red, t2, x3, Node (Red, t4, x5, t6)))
| Node (Black, t0, x1, Node (Red, Node (Red, t2, x3, t4), x5, t6))
| Node (Black, Node (Red, t0, x1, Node (Red, t2, x3, t4)), x5, t6)
| Node (Black, Node (Red, Node (Red, t0, x1, t2), x3, t4), x5, t6) ->
Node (Red, Node (Black, t0, x1, t2), x3, Node (Black, t4, x5, t6))
| t -> t

let blacken_root set =
match set with
| Node (Red, left, y, right) -> Node (Black, left, y, right)
| t -> t

let add set x =
let rec add_inner set x =
match set with
| Empty -> Node (Black, Empty, x, Empty)
| Node (color, left, y, right) ->
let cmp = Parameter.compare x y in
if cmp = 0 then
set
else
let new_set =
if cmp < 0 then
Node (color, add_inner left x, y, right)
else
Node (color, left, y, add_inner right x)
in
balance new_set
in
blacken_root (add_inner set x)

let of_list list = List.fold ~f:add ~init:Empty list

let to_seq ?(order = `Increasing) set =
let open Sequence.Generator in
let rec walk order = function
| Empty -> return ()
| Node (_, left, x, right) ->
begin match order with
| `Increasing ->
walk order left >>= fun () ->
yield x >>= fun () ->
walk order right
| `Decreasing ->
walk order right >>= fun () ->
yield x >>= fun () ->
walk order left
end
in
run (walk order set)

let to_list set =
Sequence.to_list_rev (to_seq ~order:`Decreasing set)

type provenance = Left | Right | Both

(* walk two sets in increasing order in parallel *)
let mergelike_zip ~f ~init first second =
let rec loop acc
(state1 : (elt * elt Sequence.t) option)
(state2 : (elt * elt Sequence.t) option) =
let arg, seq1, seq2 =
match state1, state2 with
| None, None ->
None, None, None
| Some (x, seq), None ->
Some (x, Left), Some seq, None
| None, Some (x, seq) ->
Some (x, Right), None, Some seq
| Some (x1, seq1), Some (x2, seq2) ->
let cmp = Parameter.compare x1 x2 in
if cmp = 0 then
Some (x1, Both), Some seq1, Some seq2
else if cmp < 0 then
Some (x1, Left), Some seq1, None
else
Some (x2, Right), None, Some seq2
in
match f acc arg with
| `Return result ->
result
| `Continue acc ->
let get_state old_state seq =
Option.value_map ~default:old_state seq ~f:Sequence.next
in
loop acc (get_state state1 seq1) (get_state state2 seq2)
in
loop init (Sequence.next (to_seq first)) (Sequence.next (to_seq second))

let intersect first second =
mergelike_zip ~init:Empty first second ~f:(fun set x ->
match x with
| None -> `Return set
| Some (x, Both) -> `Continue (add set x)
| Some _ -> `Continue set)

let difference first second =
mergelike_zip ~init:Empty first second ~f:(fun set x ->
match x with
| None -> `Return set
| Some (x, Left) -> `Continue (add set x)
| _ -> `Continue set)

let union first second =
mergelike_zip ~init:Empty first second ~f:(fun set x ->
match x with
| None -> `Return set
| Some (x, _) -> `Continue (add set x))

let is_subset first second =
mergelike_zip ~init:() first second ~f:(fun () x ->
match x with
| None -> `Return true
| Some (_, Left) -> `Return false
| _ -> `Continue ())

let is_disjoint first second =
mergelike_zip ~init:() first second ~f:(fun () x ->
match x with
| None -> `Return true
| Some (_, Both) -> `Return false
| _ -> `Continue ())

let equal first second =
mergelike_zip ~init:() first second ~f:(fun () x ->
match x with
| None -> `Return true
| Some (_, Left) | Some (_, Right) -> `Return false
| _ -> `Continue ())

end``````

## Community comments

Find this solution interesting? Ask the author a question to learn more.

### What can you learn from this solution?

A huge amount can be learned from reading other people’s code. This is why we wanted to give exercism users the option of making their solutions public.

Here are some questions to help you reflect on this solution and learn the most from it.

• What compromises have been made?
• Are there new concepts here that you could read more about to improve your understanding?