# Some embarrassing code

Probably of interest to no one as I’m just dabbling but thought I’d share some code I’d written to try and compare to lists and return the items at the point they differ. First the embarrassing “why wont this language to what I want it to?” version:

``````module ListEx : sig
val mismatch : 'a list -> 'a list -> 'a option * 'a option
end = struct
let mismatch a b =
(* must: a_len <> b_len *)
let find_missing a b =
(* where list a is longer than b *)
let find_missing_left a b =
let len = List.length b in
match List.findi ~f:(fun i _ -> i = len) a with
| None        -> assert false (* shouldn't happen as expected must be longer than found *)
| Some (_, x) -> Some x, None (* the first expected item that has no match in found *)
in
(* where list b is longer than a *)
let find_missing_right a b =
match find_missing_left b a with
| b, a -> a, b
in
if List.length a > List.length b then
find_missing_left a b
else
find_missing_right a b
in
(* find the mismatching pair *)
let mismatch' ab =
(* true when a pair are unmatched *)
let unmatched = function
| a, b when a <> b -> true
| _ -> false
in
match List.find ~f:unmatched ab with
| None -> None, None            (* OK all match *)
| Some (a, b) -> Some a, Some b (* Some mismatch found *)
in
match List.zip a b with
| None    -> find_missing a b   (* lists of different lengths *)
| Some ab -> mismatch' ab       (* list of same length *)
end
``````

Then the slightly less embarrassing version:

``````module ListEx : sig
val mismatch : 'a list -> 'a list -> 'a option * 'a option
end = struct
let rec mismatch a b =
match (List.hd a), (List.hd b) with
| Some a', Some b' when a' = b' -> mismatch (List.tl_exn a) (List.tl_exn b)
| x, y -> x, y
end
``````

That’s quite some line count difference. Unfortunately I’m finding I’m mainly writing code like the former at the moment.

2 Likes

Have you tested your second version? What happens when the two lists are not the same length? Your code indicates that `List.hd` has type `'a list -> 'a option` but this is not the case in the standard library, where the type is `List.hd: 'a list -> 'a`. To arrive at a more compact version, you could start with something like the code below. There are some cases missing for you to fill in:

``````
let rec mismatch xs ys = match xs, ys with
| x::xs, y::ys when x = y  -> mismatch xs ys
| x::xs, y::ys             -> ...
| ...
``````
1 Like

Hi,

Yes, well tested.

Sorry about the confusion - I should have mentioned - as I’m working my way through Real World Ocaml at the moment I’m using `Core.Std` in which `List.hd` is indeed `'a list -> 'a option`, hence the use of `List.tl_exn`.

The following function reflects the expected (and actual) output:

``````let describe_mismatch to_string a b =
match ListEx.mismatch a b with
| None,    None    -> printf "Lists match\n"
| Some a', None    -> printf "List 'a' is longer and the first unmatched element is: %s\n" (to_string a')
| None,    Some b' -> printf "List 'b' is longer and the first unmatched element is: %s\n" (to_string b')
| Some a', Some b' -> printf "Lists 'a' and 'b' mismatch. Found: %s, %s\n" (to_string a') (to_string b')
``````

I guess the standard library version would look something like:

``````module ListEx : sig
val mismatch : 'a list -> 'a list -> 'a option * 'a option
end = struct
let rec mismatch a b =
match a, b with
| x::xs, y::ys when x = y -> mismatch xs ys
| x::xs, y::ys -> Some x, Some y
| x::xs, []    -> Some x, None
| [],    y::ys -> None,   Some y
| [],    []    -> None,   None
end
``````

Interesting, thanks for sharing @mikey! Care to tell how you arrived from the “embarrassing” version to the “less embarrassing” version? What resources helped you?

Can’t say that there was a particular resource I drew on for this example, although as I mentioned I’m reading my way through realworldocaml.org. Also I try to make sure when programming to explore a problem by iterating over different implementations, particularly important I find when learning a new language.

For the second implementation I just tried using pattern matching combined with recursive iteration that I had previously been introduced to through that book, something that the OCmal makes extremely easy therefore attractive to do.

I may also be of interest is to say what I was trying to do with the first implementation. I what I was trying to do was compare a list of `n` items form a stream selected with `Stream.npeek` to a list of expected items showing where they diverge, so actually the Embarrassing implementation wasn’t even the first, just the first where I had abstracted out some of that functionality that I had found I needed, and generalised it so that it wasn’t taking some of the shortcuts that I was taking as I knew that one of my lists would never be zero length, and actually it was probably trying to implement the more general case that helped highlight that there was probably a much simpler solution to be found.

Another thing that I was also trying to do with the embarrassing example was look at how the standard library (or in this case I was using `Core.Std`) could be leveraged to tackle problems in a new way (for me) by stepping up the level of abstraction of the code. This was an approach that I had seen in a YouTube video on functional programming (which if I recall directly is actually introducing Haskell for C# programmers). Also I should say that I’m not sure that how that approach is used in that video is actually a benefit to the problem he is trying to solve, as he does quite a number of steps that decrease code verbosity at the cost of increased abstraction away from the original problem. Still I’m interested I what can be achieved, however, through this approach, but in this case I obviously didn’t have much success, mainly because there didn’t seem to be a function for zipping lists that would accommodate lists of different lengths without having to introduce a completely separate code path to handle those cases. I guess no one’s felt the need for that as - as it turns out - it’s pretty trivial to do with recursive pattern matching.

1 Like