OCaml Tree Operation - functional-programming

I am trying to write methods on arbitrary trees in OCaml. Here is my tree constructor:
type 'a tree =
| Leaf of 'a
| Node of ('a tree) list
I am having trouble with fold_tree:
let rec fold_tree (f : 'b list -> 'b) (g : 'a -> 'b) (t : 'a tree): 'b.
For example, fold_tree sum (fun x -> x) (node [node [leaf 7; leaf 8]; leaf 9])=24

Not sure what you are trying to accomplish here... Is it something like this?
let rec fold_tree f acc (t:'a tree) =
match t with
| Leaf e -> f acc e
| Node l ->
List.fold_left
(
fun a e -> fold_tree f a e
) acc l
Example of usage:
let data = Node [Node [Leaf 7; Leaf 8; Leaf 100]; Leaf 9; Leaf 10;]
let ans = fold_tree (fun a e -> a + e) 0 data
let () = print_endline(string_of_int ans)

Related

Implement a map functional for a list of lists without using nested maps

I set myself the following challenge (and failed):
I want to write a map functional, map f lofls, that takes a function, f 'a -> 'b and a list of lists, lofls 'a list list and applies the function f on every element of the list of lists. The constraint that I added is that I am not allowed to used nested maps for lists, and I have to do it recursively.
I tried to do it in F# but any language should do. Any ideas?
Edit
Here is my attempt (which works but is ugly and I am not a fan of the use of rev either . . .)
let map f lis =
let rec map2 f lis aux =
match (lis, aux) with
|([], []) -> []
|([], aux) -> [aux]
|(hd::tl, aux) ->
match hd with
|[] -> (List.rev aux) :: (map2 f tl [])
|x::xs -> map2 f (xs::tl) ( (f x) :: aux )
map2 f lis []
(I also realised that this has been posted in a more concise form already)
Lets go step by step, from simple to complex.
This is the signature that you want your map function to have:
('a -> 'b) -> 'a list list -> 'b list list
The simple solution is this:
let map0 (f:'a -> 'b) (lofls:'a list list) : 'b list list = lofls |> List.map (List.map f)
But that one is not recursive and it uses nested maps.
A recursive solution could be this:
let rec map1 (f:'a -> 'b) (lofls:'a list list) : 'b list list =
match lofls with
| [] -> []
| l::rest -> (List.map f l) :: map1 f rest
It is recursive although it is still calling List.map in there.
So, here is the next level:
let rec map (f:'a -> 'b) (lofls:'a list list) : 'b list list =
match lofls with
| [ ] -> [ ]
| [ ] :: rest -> [ ] :: (rest |> map f)
| ( e::restl ) :: rest ->
match restl :: rest |> map f with
| [ ] -> [ ]
| [ ] :: rest -> [ f e ] :: rest
| ( restl ) :: rest -> ( f e :: restl ) :: rest
Another way:
let rec mapNested f lofls =
match lofls with
| [] -> []
| h::t -> (map f h) :: (mapNested f t)
and map f lst =
match lst with
| [] -> []
| h::t -> (f h) :: (map f t)
If this were a homework question, which I am sure it is not, the answer depends on what constitutes "a nested map for lists".
A construct like map [] (map [] f) can be rewritten with pipelining as f |> map [] |> map [], or with the function composition operator as (map [] >> map []) f, but may be still considered a nested map.
let mapNested f =
let rec map acc g = function
| [] -> List.rev acc
| x::xs -> map (g x::acc) g xs
f |> map [] |> map []
// val mapNested : f:('a -> 'b) -> ('a list list -> 'b list list)
This is the opportunity to demonstrate your grasp of lambda calculus and the Y combinator. Nested passing of the map function as an argument should clearly pass muster.
let rec Y f x = f (Y f) x
let map f acc g = function
| [] -> List.rev acc
| x::xs -> f (g x::acc) g xs
let map1 f =
Y map [] f
// val map1 : f:('a -> 'b) -> ('a list -> 'b list)
let map2 f =
Y map [] f
|> Y map []
// val map2 : f:('a -> 'b) -> ('a list list -> 'b list list)
A tail recursive way
let mapNested f lofls =
let rec map f lst acc =
match lst with
| [] -> List.rev acc
| h::t -> map f t (f h :: acc)
map (fun x -> map f x []) lofls []
I'm not sure why this question is tagged with SML, but since it is, here is how it can be done in SML:
First, this is the idiomatic solution that you're explicitly avoiding:
fun mapmap f = map (map f)
(You could write val mapmap = map o map if it weren't for ML's value restriction.)
And if you'd like to write mapmap using explicit recursion:
fun mapmap f [] = []
| mapmap f (xs::xss) = map f xs :: mapmap f xss
and map f [] = []
| map f (x::xs) = f x :: map f xs
One reason behind why this function is hard to write with a single explicitly recursive function is that the call stack is used for two things:
Collecting the result of each inner list, and
Collecting the result of the outer list.
One of those uses of the call stack can be turned into an explicit stack in an accumulating argument. This is how e.g. a tail-recursive rev is defined:
fun rev xs =
let fun aux [] acc = acc
| aux (x::xs) acc = aux xs (x::acc)
in aux xs [] end
The accumulating argument similarly isn't needed in the interface to mapmap, so it can be hidden in an inner helper function. So a single function that performs explicit recursion on both the inner and the outer list is complicated by this explicit bookkeeping:
fun mapmap f xss =
let fun aux f [] _ = []
| aux f ([]::xss) ys = rev ys :: aux f xss []
| aux f ((x::xs)::xss) ys = aux f (xs::xss) (f x :: ys)
in aux f xss [] end

The parameter order of function for ocaml

Suppose I have a map function like below:
let rec map f xs = match xs with
[] -> []
| hd :: tl -> f hd :: (map f tl)
I got some errors when I change the signature of map to let rec map xs f,
Could anyone pinpoint which knowledge I am lacking and explains why?
There's no problem if you change the definition and the recursive call.
# let rec map xs f = match xs with
[] -> []
| hd :: tl -> f hd :: (map tl f);;
val map : 'a list -> ('a -> 'b) -> 'b list = <fun>
# map [3; 5; 7] ((+) 1);;
- : int list = [4; 6; 8]
You should be able to switch the xs with the f
the only thing you have to make sure to change is the the order on line 3 where you have (map f tl) to (map tl f)

Ocaml - Path between two nodes (How to debug)

I need to make an algorithm to solve this problem using a BFS :
given an oriented weighted graph, a start node, a stop node, and a integer K, say if exist a path between start and stop with wight at least k.
So, first I declared my weighted oriented graph type, a list of triples:
type 'a graph = Gr of ('a * 'a * 'a) list;;
let grafo1 = Gr [(1,3,2);(1,1,5);(2,2,3);(5,5,3);(5,4,6);(3,1,6);(3,7,4);(6,2,7);(4,4,6)];;
In (x,y,z), x is the starting node, y the edge weight and z the arrive node.
Then I made a succ function:
let succ (Gr arcs) n=
let rec aux = function
[] -> []
| (x,y,z):: rest ->
if n = x then z::(aux rest)
else aux rest
in aux arcs;;
This function give me the successors of a node as oputput, so:
succ grafo1 1
gives me
int list = [2; 5]
as output.
In the end, I made this bf_path function, it's a modified BFS that can find a path between 2 nodes (otherwise it raises an exception) and it takes 3 inputs: a graph, a predicate and a starting node
let bf_path g p start =
let rec aux visited = function
[] -> raise Not_found
| x::rest -> if List.mem x visited then aux visited rest
else if p x then [x]
else try aux (x::visited) rest
with Not_found ->
x:: aux (x::visited) (succ g x)
in aux [] [start];;
The predicate specifies the condition, so the call:
bf_path grafo1 ((=)7)1
gives me int list = [1; 5; 6; 7] as output, the path between nodes 1 and 7.
Now, I can find a path but I need to find a path with at least weight K, so I made a little function that takes a list of triples as input and it sum the weight value:
let rec tot = function
[] -> 0
|(v,c,p)::t -> c + (tot t);;
So, call and output:
tot [(2,2,3);(4,5,6);(8,9,0)]
- : int = 16
I thought all I needed was to add the condition inside the function so I made this function where I add an int K as input and a condition: (tot path >= k)
let bf_path_final g p start k =
let rec aux visited = function
[] -> raise Not_found
| x::rest -> if List.mem x visited then aux visited rest
else if p x then
if (tot [x]) >= k then [x]
else aux visited rest
else try aux (x::visited) rest
with Not_found ->
x:: aux (x::visited) (succ g x)
in aux [] [start];;
The function compiles without problem:
val bf_path_final : ('a * int * 'b) graph ->
('a * int * 'b -> bool) -> 'a * int * 'b -> int -> ('a * int * 'b) list = <fun>
However, I get an error when I try to call it:
bf_path_final grafo1 ((=)4)1,13;;
^^^^^^
Error: This expression has type int graph_w
but an expression was expected of type ('a * int * 'b) graph_w
So, is the function wrong or do I have to call it on another way?
Another solution was to give the function bf_path output (the path) as input to my tot function, but my output is a list of int, not a list of triples, so i tried to convert my first function to give an output of triplees:
(ex: instead of [1;5;6;7] it should give [(1,1,5);(5,4,6);(6,2,7)])
let bf_path_tr g p start =
let rec aux visited = function
[] -> raise Not_found
| (x,y,z)::rest -> if List.mem x visited then aux visited rest
else if p x then [(x,y,z)]
else try aux (x::visited) rest
with Not_found ->
(x,y,z):: aux (x::visited) (succ_w g (x,y,z))
in aux [] [start];;
Same results, the function is compiled
val bf_path_tr :
('a * 'b * 'c) graph ->
('a -> bool) -> 'a * 'b * 'c -> ('a * 'b * 'c) list = <fun>
but I get the same error:
bf_path_tr grafo1 ((=)7)2
Characters 11-18:
bf_path_tr grafo1 ((=)7)2;;
^^^^^^
Error: This expression has type int graph
but an expression was expected of type ('a * 'b * 'c) graph
Any ideas to solve at least one of these two problems?
The best way to debug this sort of thing is to start adding explicit type annotations everywhere, till you find the place where your expectations don't match the inferred type.
let bf_path_final (g : int graph) (p : int -> bool) (start : int) (k : int) =
let rec aux (visited : int list) = function
[] -> raise Not_found
| x::rest -> if List.mem x visited then aux visited rest
else if p x then (
if (tot [x]) >= k then [x]
else aux visited rest )
else try aux (x::visited) rest
with Not_found ->
x:: aux (x::visited) (succ g x)
in aux [] [start];;
raises the error
File "test.ml", line 32, characters 17-18:
Error: This expression has type int but an expression was expected of type
'a * int * 'b
which points to if (tot [x]) where indeed tot expects a list of triples, but you have passed it an int list.
Also did you really mean to call tot [x]? It's not totaling anything; x is just a single node there.

OCaml Explicit polymorphic type annotations

I would enjoy to receive some helpful comments concerning an example given on:
http://caml.inria.fr/pub/docs/manual-ocaml-400/manual021.html#toc79
7.12 Explicit polymorphic type annotations
type 'a t = Leaf of 'a | Node of ('a * 'a) t
let rec depth : 'a. 'a t -> 'b = function
|Leaf _ -> 1
| Node x -> 1 + depth x
I understand this example function, but when I try to define a 'map-like' function of type
'a. 'a t -> ('a -> 'b) -> 'b t
e.g.:
let rec tmap: 'a. 'a t ->(f:'a->'b) -> 'b t = function
|Leaf x -> Leaf( f x)
|Node x -> let res = tmap x in Node(res);;
I get the following error:
Characters 67-77:
|Leaf x -> Leaf( f x)
^^^^^^^^^^
Error: This expression has type 'c t but an expression was expected of type
(f:'a -> 'b) -> 'b t
which I do not completely understand.
I would appreciate any helpful comment.
You forgot to get the second argument.
let rec tmap:
'a. 'a t ->(f:'a->'b) -> 'b t = (* asking for two arguments *)
function (* takes only the first argument *)
|Leaf x -> Leaf( f x)
|Node x -> let res = tmap x in Node(res);;
Also, 'b must be polymorphic too, as you want to generate nested tuples as long as you descend through the tree.
This should be, thanks to ivg:
let rec tmap : 'a 'b. 'a t -> f:('a->'b) -> 'b t = fun t ~f ->
match t with
|Leaf x -> Leaf( f x)
|Node x -> let f (a,b) = (f a, f b) in Node ( tmap x ~f ) ;;
You have a few problems, like improperly placed parenthesis around f, forgotten argument to the tmap function in the Node branch, and you've forget the quantifier for 'b. So, finally, with the help of PatJ we can write the following:
type 'a t = Leaf of 'a | Node of ('a * 'a) t
let rec depth : 'a. 'a t -> 'b = function
| Leaf _ -> 1
| Node x -> 1 + depth x
let rec tmap: 'a 'b. 'a t -> f:('a -> 'b) -> 'b t =
fun t ~f -> match t with
| Leaf x -> Leaf (f x)
| Node x ->
Node (tmap ~f:(fun (x,y) -> f x, f y) x)
tmap (Node (Leaf (7,8))) ~f:(fun x -> x + 1, x + 2);;
- : (int * int) t = Node (Leaf ((8, 9), (9, 10)))
many thanks for your great help.
Now my test cases work out as intended:
let int_tree = Node(Node(Leaf((3,-1),(0,4))));;
let char_tree = Node(Node(Leaf(('a','c'),('d','c'))));;
tmap int_tree ~f:(fun x -> x*x);;
- : int t = Node (Node (Leaf ((9, 1), (0, 16))))
tmap char_tree ~f:(fun x -> Char.uppercase x);;
- : char t = Node (Node (Leaf (('A', 'C'), ('D', 'C'))))

Tail-recursion on trees

I have a data structure,
datatype 'a tree = Leaf | Branch of 'a tree * 'a * 'a tree
and I want to write a function that traverses this tree in some order. It doesn't matter what it does, so it could be a treefold : ('a * 'b -> 'b) -> 'b -> 'a tree -> 'b. I can write this function like this:
fun treefold f acc1 Leaf = acc1
| treefold f acc1 (Branch (left, a, right)) =
let val acc2 = treefold f acc1 left
val acc3 = f (a, acc2)
val acc4 = treefold f acc3 right
in acc4 end
But because I inevitably have two branches in the last case, this is not a tail-recursive function.
Is it possible to create one that is, given the type signature is allowed to be expanded, and at what cost? I also wonder if it's even worth trying; that is, does it give any speed benefits in practice?
You can achieve a tail-recursive treefold using continuation-passing style:
fun treefold1 f Leaf acc k = k acc
| treefold1 f (Branch (left, a, right)) acc k =
treefold1 f left acc (fn x => treefold1 f right (f(a, x)) k)
fun treefold f t b = treefold1 f t b (fn x => x)
For example:
fun sumtree t = treefold op+ t 0
val t1 = Branch (Branch(Leaf, 1, Leaf), 2, Branch (Leaf, 3, Leaf))
val n = sumtree t1
results in n = 6 as expected.
Like #seanmcl writes, the systematic way to convert a function to be tail-recursive is to use continuation-passing style.
After that you probably want to reify your continuations and use a more concrete data type, like a list for instance:
fun treefoldL f init tree =
let fun loop Leaf acc [] = acc
| loop Leaf acc ((x, right) :: stack) =
loop right (f(x,acc)) stack
| loop (Branch (left, x, right)) acc stack =
loop left acc ((x, right) :: stack)
in loop tree init [] end

Resources