How could I solve this Dictionary problem in Ocaml? - ocaml

Being given the list of tuples [("x", 3); ("num", 17); ("y", 7); ("x", 5)] create a dictionary in which if there are equal keys their values are summed. So on this example, a dictionary like this should be created
[("x", 8); ("num", 17); ("y", 7)]; it doesn't matter the order in dictionary.
This is the code I tried:
module MS = Map.Make(String);;
let f l = List.fold_left (fun acc (key, value) -> MS.add key value acc) MS.empty l;;
let f1 = f [("x", 3); ("num", 17); ("y", 7); ("x", 5)];;
MS.bindings f1;;
But it keeps overwriting the value of the same keys(the output is [("num", 17); ("x", 5); ("y", 7)])

You're looking for Map's update function, not add:
module MS = Map.Make(String)
let f l =
List.fold_left
(fun acc (key, value) ->
MS.update key (function Some v -> Some (value + v) | None -> Some value) acc)
MS.empty l
let f1 = f [("x", 3); ("num", 17); ("y", 7); ("x", 5)]
With this version, MS.bindings f1 will return [("num", 17); ("x", 8); ("y", 7)].

Related

Printing a Function After Calling (ocaml)

I am very new to ocaml! I am using the code found here: https://rosettacode.org/wiki/Cartesian_product_of_two_or_more_lists#OCaml
I have been trying to figure out how to print the result after running the product function, Thank you very much!
open Printf
let rec product l1 l2 = (* Create a recursive function (rec) named product that has 2 parameters *)
(*ignore (Printf.printf "Debug: %s\n" 1);*)
match l1, l2 with
| [], _ | _, [] -> []
| h1::t1, h2::t2 -> (h1,h2)::(product [h1] t2)#(product t1 l2)
;;
let test =
product [1;2] [3;4];;
ignore (Printf.printf "test: %d*" 1);
(*- : (int * int) list = [(1, 3); (1, 4); (2, 3); (2, 4)]*)
product [3;4] [1;2];;
(*- : (int * int) list = [(3, 1); (3, 2); (4, 1); (4, 2)]*)
product [1;2] [];;
(*- : (int * 'a) list = []*)
product [] [1;2];;
(*- : ('a * int) list = []*)
Your fuction product has this type:
'a list -> 'b list -> ('a * 'b) list
There is no built-in way to print out the results of this function, because the results don't have a particular type. The type of the results depends on the types of the two input lists. Since OCaml is a strongly typed language, there's no way in general to examine a type at runtime and print it differently depending on the type.
If you run your code in the toplevel (OCaml's REPL), it will write out the results for you. It uses code that's not really available to an ordinary OCaml program:
# product [1;2] [3;4];;
- : (int * int) list = [(1, 3); (1, 4); (2, 3); (2, 4)]
# product [1.; 2.] ['a'; 'b'];;
- : (float * char) list = [(1., 'a'); (1., 'b'); (2., 'a'); (2., 'b')]
If you're willing to restrict yourself to lists of ints you can use this function to print a list of type (int * int) list:
let print_ints pair_list =
let pair_str (i, j) = Printf.sprintf "(%d, %d)" i j in
print_string
("[" ^ String.concat "; " (List.map pair_str pair_list) ^ "]\n")
If you run it in the toplevel it looks like this:
# print_ints (product [2;3] [4;5]);;
[(2, 4); (2, 5); (3, 4); (3, 5)]
- : unit = ()

How can i make inner recursive function reach original variable in OCaml?

I am learning OCaml and now stuck with a code.
This is a code that makes a list of the accessible nodes from a graph.
type graph = (vertex * vertex) list
and vertex = int
let rec sort lst =
match lst with
[] -> []
| h::t -> insert h (sort t)
and insert n lst =
match lst with
[] -> [n]
| h::t -> if n <= h then n :: lst else h :: insert n t;;
let rec remove lst =
match lst with
| [] -> []
| x::[] -> x::[]
| x::y::tl ->
if x=y then remove (y::tl)
else x::remove (y::tl);;
let rec reach : graph * vertex -> vertex list
= fun (g, v) ->
match g with
|[] -> []
|h::t ->let x = [] in
match h with
|a,b -> if a = v then remove(sort(v::x) # (reach (g, b)))
else
remove(sort(v::reach (t, v)));;
reach([(1,2);(2,3);(3,4);(4,2);(2,5)],4);;
I think my code is meaninglessly complicated due to my lack of coding ability.
Besides, the main problem that I confront now is that I cannot make the recursive function 'reach' to access with original list 'g' as it goes recursive in else condition as it access with list 't'.
trace says
reach <-- ([(1, 2); (2, 3); (3, 4); (4, 2); (2, 5)], 4)
reach <-- ([(2, 3); (3, 4); (4, 2); (2, 5)], 4)
reach <-- ([(3, 4); (4, 2); (2, 5)], 4)
reach <-- ([(4, 2); (2, 5)], 4)
reach <-- ([(4, 2); (2, 5)], 2)
reach <-- ([(2, 5)], 2)
reach <-- ([(2, 5)], 5)
reach <-- ([], 5)
reach --> []
reach --> [5]
reach --> [2; 5]
reach --> [2; 5]
reach --> [4; 2; 5]
reach --> [2; 4; 5]
reach --> [2; 4; 5]
reach --> [2; 4; 5]
- : vertex list = [2; 4; 5]
First, I claimed a new variable with let y = g and change code
|a,b -> if a = v then remove(sort(v::x) # (reach (y, b)))
else
remove(sort(v::reach (t, v)));;
as I believed that the duplicates will be removed by fun 'remove' and inner function will access with list y, not t which lost its head. However, things did
not go as I planned. It still gives me a same result.
To make function access with original list 'g' in else condition what should I do...?
reach <-- ([(1, 2); (2, 3); (3, 4); (4, 2); (2, 5)], 4)
reach <-- ([(2, 3); (3, 4); (4, 2); (2, 5)], 4)
reach <-- ([(3, 4); (4, 2); (2, 5)], 4)
reach <-- ([(4, 2); (2, 5)], 4)
reach <-- ([(1, 2); (2, 3); (3, 4); (4, 2); (2, 5)], 2)
(*I want function goes back to original list as the variable changes like above*)
You can define an auxiliary function:
let reach g v =
let rec aux g' v' = ... (* here you can use g as the auxiliary function defines g' instead *)
in aux g v
Note that I also define the function with two arguments instead of one tuple, it's more idiomatic :)
Also if v' is always the same value the auxiliary function need not redefine it
let reach g v =
let rec aux g' = ...
in aux g v
One more remark. You can du deeper pattern matching, e.g.:
match g with
|[] -> []
|(a,b)::t -> let x = [] in
if a = v
then remove(sort(v::x) # (reach (g, b)))
else remove(sort(v::reach (t, v)));;
No need for a second match.
Finally, you might be aware of the function keyword that creates a function of one argument creating pattern matching:
let f x = match x with
(* same as *)
let f = function
Therefore:
let reach (g:graph) (v:vertex) =
let aux v' = function (*we don't create a g' variable here, we match it straight *)
| [] -> []
| (a,b)::t as g' -> (* you can still define the variable in the matching if you need it *)
let x = [] in
if a = v
then remove(sort(v::x) # (aux b g')) (* or g if that's what you need *)
else remove(sort(v::aux v t))
in aux v g
would do the same as your code
Edit: correctected recusrive calls to reach by recursive calls to aux as it wouldn't work.
Answering directly to your question, here is how to access the original value in a recursive function
let to_matrix outer =
let rec loop = function
| [] -> []
| x :: xs -> [x::outer] # loop xs in
loop outer
This function will iterate over each element of a list and create a list of list, where each element is a list made of the original element prepended to the whole original list, e.g.,
# to_matrix [1;2;3];;
- : int list list =
[[1; 1; 2; 3]; [2; 1; 2; 3]; [3; 1; 2; 3]]
The example might be silly, but I hope it clarifies the technique. Here the idea is that we create an inner function, named loop in our case, which has its own parameter, and we recurse only on this parameter while leaving the original outer list intact.
While it is an idiomatic approach, in general it is not required to create an inner function or an auxiliary function. What is really needed, is an extra parameter, so that at the end of the day we will have two parameters - one which decreases with each iteration and the other which stays invariant, e.g.,
let rec to_matrix outer inner = match inner with
| [] -> []
| x :: xs -> [x::outer] # to_matrix outer xs
the only caveat of this approach is that now we have to pass the list twice, e.g.,
to_matrix [1;2;3] [1;2;3];;
That's why it is idiomatic to hide this function by a nicer interface.

Get min/max int in a list of tuples of (int, string) in PolyML

I have seen this question for Python, But I have the same question for SML (PolyMl).
I want to create a function to extract from a list of tuples (int, string) the string value of the tuple with minimum int.
For example, if I have this list:
l = [('a', 5), ('b', 3), ('c', 1), ('d', 6)]
The output should be 'c', because the minimum integer is in the tuple ('c', 1). Thank You!
val l = [(#"a", 5), (#"b", 3), (#"c", 1), (#"d", 6)]
fun min [] = NONE
| min [x] = SOME x
| min ((c1,n1) :: (c2,n2) :: xs) = if n1 < n2 then
min ((c1,n1) :: xs)
else
min ((c2,n2) :: xs)
val SOME (c,_) = min l
val lst = [(#"a", 5), (#"b", 3), (#"c", 1), (#"d", 6)];
(* The first item of a tuple is fetched with #1. *)
#1(List.foldl
(fn ((new as (_,n)), (old as (_,n0))) =>
if n < n0 then new else old)
(hd lst)
(tl lst));
(* val it = #"c" : char *)

merge (int * string) list ocaml

I have this function:
let encode list =
let rec aux count acc = function
| [] -> [] (* Caso a lista esteja vazia*)
| [x] -> (count+1, x) :: acc
| a :: (b :: _ as t) ->
if a = b then aux (count + 1) acc t
else aux 0 ((count+1,a) :: acc) t in
List.rev (aux 0 [] list)
;;
and with this input:
let test = encode ["a";"a";"a";"a";"b";"f";"f";"c";"c";"a";"a";"d";"e";"e";"e";"e"];;
And i have this Output:
val test : (int * string) list =
[(4, "a"); (1, "b"); (2, "f"); (2, "c"); (2, "a"); (1, "d"); (4, "e")]
but the "a" is a repeated and "f" need to be at final!
I need a output like:
val test : (int * string) list =
[(6, "a"); (1, "b"); (2, "c"); (1, "d"); (4, "e"); (2, "f")]
Can anybody help, please?! Thanks!
You are counting repeated adjacent values, so-called run-length encoding. It appears you want to count occurrences across the whole input. You can either sort the input beforehand, or you can use a more complicated data structure (such as a Map) to keep track of your counts.
Something like this:
let encode xs =
let f acc x =
let n = try M.find x acc with Not_found -> 0 in
M.add x (n+1) acc in
let ans = (List.fold_left f M.empty) xs in
M.bindings ans ;;
# encode ["a";"a";"a";"a";"b";"f";"f";"c";"c";"a";"a";"d";"e";"e";"e";"e"];;
- : (M.key * int) list =
[("a", 6); ("b", 1); ("c", 2); ("d", 1); ("e", 4); ("f", 2)]

SML: Scan a relation list to get all the transitive associations

I have an environment list which keeps associations between variables and values, such as env = [("x", 1), ("y", 2), ("z", 3), ...]. I also have another substitution list (which is returned by a pattern matching control function) that keeps associations between variables and pattern, such as s = [("v", Var_p "z"), ("w", Var_p "v"), ("u", Var_p "w"), ...]. Let's consider the first pair ("v", Var_p "z"): my function should check the value corresponding to zin the environment, create a new association between v and z's value (i. e. ("v", 3)) and put it into the environment. My code for this function is the following.
fun augment_env ([], e : env) = e
| augment_env (s :: srest, e : env) =
let
val (a, b) = s
in
case b of
Const_p i => [] # augment_env_with_vars (srest, e)
| Var_p x =>
if (exists (e, x)) then (a, lookup (e, x)) :: augment_env_with_vars (srest, e)
end;
Here, s is the substitution list and exists and lookup are functions which check the existence of a variable in the environment and look for the corresponding value, respectively. The problem with this function is that works fine only for direct associations (in the example, it puts the direct association between v and 3 into the environment). It obviously doesn't work for the transitive associations unless I call it multiple times (which I don't know in advance how many they are). To recall the example, by the end of this function, my environment list should be env = [("x", 1), ("y", 2), ("z", 3), ("v", 3), ("w", 3), ("u", 3), ...].
Could you please give me a hint about how to modify this function to work fine with the transitive associations, too?
Thanks in advance!
First, it is hard to give precise hint since functions lookup, augment_env_with_vars and some types are unknown.
However, guessing from what you've provided, it could be done like:
Take 1
type const = int
type var = string
type env = (var * const) list
datatype value = Const_p of const | Var_p of var
exception Not_found
fun lookup_env (e, v) =
case e of
[] => raise Not_found
| (a, b)::xs => if a = v then b else lookup_env (xs, v)
fun new_env (l, e) =
case l of
[] => e
| (a, b)::xs =>
case b of
Const_p _ => new_env (xs, e)
| Var_p b => new_env (xs, e # [(a, lookup_env (e, b))])
(* test *)
val e = [("x", 1), ("y", 2), ("z", 3)]
val s = [("v", Var_p "z"), ("w", Var_p "v"), ("u", Var_p "w")]
val test = new_env (s, e)
Result 1
val e = [("x",1),("y",2),("z",3)] : (string * int) list
val s = [("v",Var_p "z"),("w",Var_p "v"),("u",Var_p "w")]
: (string * value) list
val test = [("x",1),("y",2),("z",3),("v",3),("w",3),("u",3)]
: (var * int) list
However, if any variable in your substitution list comes before its definition, new_env will fail. To solve this, just scan the substitution list before referring to lookup_env:
Take 2
fun lookup_var (l, v) =
case l of
[] => v
| (a, b)::xs =>
case b of
Const_p _ => lookup_var (xs, v)
| Var_p b => lookup_var (if a = v then (l, b) else (xs, v))
fun new_env2 (l, e) =
case l of
[] => e
| (a, b)::xs =>
case b of
Const_p _ => new_env2 (xs, e)
| Var_p b => new_env2 (xs, e # [(a, lookup_env (e, lookup_var (l, b)))])
(* test *)
val e = [("x", 1), ("y", 2), ("z", 3)]
val s2 = [("v", Var_p "z"), ("u", Var_p "w"), ("w", Var_p "v")]
val test2 = new_env2 (s2, e)
Result 2
val e = [("x",1),("y",2),("z",3)] : (string * int) list
val s2 = [("v",Var_p "z"),("u",Var_p "w"),("w",Var_p "v")]
: (string * value) list
val test2 = [("x",1),("y",2),("z",3),("v",3),("u",3),("w",3)]
: (var * int) list
Note the swapped "u" and "w" in the second example.