Product of 2 Lists in ocaml without Imperative Functions

Question

ers,

I'm attempting to learn functional programming through ocaml and CYK tables, so no List.mem or any imperative functions for that matter. My objective is to form the product of 2 cells.

Here is what I currently have:

let stringlister = function(mystring, newlist) ->
List.append newlist mystring;;

let rec append_func = function([listleft;listright], anslist, i, j) ->
if (j == (List.length listright)) then anslist
else begin
     append_func([listleft;listright], anslist, i, j + 1);
     List.append(anslist (stringlister((List.nth listright j), (stringlister( (List.nth listleft i), [])))))

   end;;

let rec prod_func = function([listleft;listright], anslist, i, j) ->
if (i == (List.length listleft)) then anslist
else begin
     prod_func([listleft;listright], anslist, i + 1, j);
     append_func([listleft;listright], anslist, i, j)
   end;;

let product = function[listleft;listright] ->
if (listleft == [] || listright == []) then []
else prod_func([listleft;listright], [], 0, 0);;

The expected output should be something like this:

#product[["A";"B"];["D","E","F","G"]];;
-: string list = ["AD"; "AE"; "AF"; "AG"; "BD"; "BE"; "BF"; "BG"]

#product[["A","B"];[]];;
-: string list = []

My thought process was to make a series of recursive functions to basically loop through the lists to place each string with each string from another list.

I think my error is how I am appending, specifically in append_func. I think the better question to ask might be how to create a list of strings.

Answer 1

I'm new to Ocaml so maybe there's a different way

let rec flat_map f xs =
  match xs with
  | [] -> []
  | x :: xs -> List.append (f x) (flat_map f xs);;
val flat_map : ('a -> 'b list) -> 'a list -> 'b list = <fun>

let product lists =
  let rec loop acc lists =
    match lists with
    | [] -> [[]]
    | first :: [] -> first |> List.map (fun x -> x :: acc)
    | first :: rest -> first |> flat_map (fun x -> loop (x :: acc) rest)
  in
    loop [] lists;;
val product : 'a list list -> 'a list list = <fun>

product [["A"; "B"]; ["D"; "E"; "F"; "G"]]
- : string list list =
[["D"; "A"]; ["E"; "A"]; ["F"; "A"]; ["G"; "A"]; ["D"; "B"]; ["E"; "B"];
 ["F"; "B"]; ["G"; "B"]]

Of course it works for any amount of input lists

product [["1"; "2"; "3"]; ["A"; "B"; "C"; "D"]; ["+"; "-"]];;
- : string list list =
[["+"; "A"; "1"]; ["-"; "A"; "1"]; ["+"; "B"; "1"]; ["-"; "B"; "1"];
 ["+"; "C"; "1"]; ["-"; "C"; "1"]; ["+"; "D"; "1"]; ["-"; "D"; "1"];
 ["+"; "A"; "2"]; ["-"; "A"; "2"]; ["+"; "B"; "2"]; ["-"; "B"; "2"];
 ["+"; "C"; "2"]; ["-"; "C"; "2"]; ["+"; "D"; "2"]; ["-"; "D"; "2"];
 ["+"; "A"; "3"]; ["-"; "A"; "3"]; ["+"; "B"; "3"]; ["-"; "B"; "3"];
 ["+"; "C"; "3"]; ["-"; "C"; "3"]; ["+"; "D"; "3"]; ["-"; "D"; "3"]]

Maybe they read a little nicer using function

let rec flat_map f = function
  | [] -> []
  | x :: xs -> List.append (f x) (flat_map f xs)

let product lists =
  let rec loop acc = function
    | [] -> [[]]
    | first :: [] -> first |> List.map (fun x -> x :: acc)
    | first :: rest -> first |> flat_map (fun x -> loop (x :: acc) rest)
  in
    loop [] lists

We can approach the problem from another angle too. Notice the difference in the order of the output

let product lists =
  let rec loop acc = function
    | [] -> acc
    | first :: rest -> loop acc rest |> flat_map (fun c -> List.map (fun x -> x :: c) first)
  in
    loop [[]] lists;;
val product : 'a list list -> 'a list list = <fun>

product [["1"; "2"; "3"]; ["A"; "B"; "C"; "D"]; ["+"; "-"]];;
- : string list list =
[["1"; "A"; "+"]; ["2"; "A"; "+"]; ["3"; "A"; "+"]; ["1"; "B"; "+"];
 ["2"; "B"; "+"]; ["3"; "B"; "+"]; ["1"; "C"; "+"]; ["2"; "C"; "+"];
 ["3"; "C"; "+"]; ["1"; "D"; "+"]; ["2"; "D"; "+"]; ["3"; "D"; "+"];
 ["1"; "A"; "-"]; ["2"; "A"; "-"]; ["3"; "A"; "-"]; ["1"; "B"; "-"];
 ["2"; "B"; "-"]; ["3"; "B"; "-"]; ["1"; "C"; "-"]; ["2"; "C"; "-"];
 ["3"; "C"; "-"]; ["1"; "D"; "-"]; ["2"; "D"; "-"]; ["3"; "D"; "-"]]

---

Above flat_map calls the expensive List.append for each element in the list. A variation below collects the intermediate results and then builds the output with a single call to List.concat

let flat_map f xs =
  let rec loop k = function
    | [] -> k []
    | x :: xs -> xs |> loop (fun r -> k (f x :: r))
  in
    loop List.concat xs;;
val flat_map : ('a -> 'b list) -> 'a list -> 'b list = <fun>

Answer 2

Imagine a C for nested loop. Further, the idea is to loop through the second list, starting with the tail. Put this in another loop through the first list, starting with the tail. The first round will reach the ends of both lists and you want this to return an empty list. It will then start to backtrack with the last element of both lists. The element you want returned is the first list head concat with the second list head. This goes to the same list you just created. The reason why it starts with the tail is because lists are immutable, it's less consuming to simply add a new head in front of the list. Your function has one parameter with two lists. However it's not the lists you want, it's what's inside the lists and this goes to the left of the arrow, the head and tail of both lists. Now remember, you're looping through the second list, looping through the first list, and concat the heads, in reverse order.

Answer 3

Using Monads (monads for functionnal programming) can simplify your code.

module ListMonad =
struct
  type 'a t = 'a list
  let return x = [x]                                                        
  let bind l f = List.fold_right (fun x acc -> (f x)@acc) l []
  let zero = []                                                             
  let ( >>= ) l f  = bind l f                                              
end;; 

First, a basic use case :

["A";"B"] >>= fun (x ->
[["C"];["D"]] >>= fun y -> x::y);;

It returns the product of the 2 list: [["A";"C"];["A";"D"];["B";"C"];["B";"D"]]

And the complete use case (product of a list of lists), we use List.fold :

 List.fold_right (fun x acc -> product x acc)
   [["a";"b"];["c";"d";"e"];["f";"g"]]     [[]];;

Will produce :

[["a"; "c"; "f"]; ["a"; "c"; "g"]; ["a"; "d"; "f"]; ["a"; "d"; "g"];
 ["a"; "e"; "f"]; ["a"; "e"; "g"]; ["b"; "c"; "f"]; ["b"; "c"; "g"];
 ["b"; "d"; "f"]; ["b"; "d"; "g"]; ["b"; "e"; "f"]; ["b"; "e"; "g"]]

`