i am constructing the operations of binary search tree in OCaml.
type ('a, 'b) bst =
| Node of 'a * 'b * ('a, 'b) bst * ('a, 'b) bst
| Leaf;;
let rec insert k v = function
| Leaf -> Node (k, v, Leaf, Leaf)
| Node (k', v', left, right) ->
if k < k' then Node (k', v', insert k v left, right)
else if k = k' then Node (k, v, left, right)
else Node (k', v', left, insert k v right);;
let rec delete k = function
| Leaf -> Leaf
| Node (k', v, l, r) as p ->
if k < k' then Node (k', v, (delete k l),r)
else if k > k' then Node (k', v, l, (delete k r))
else
match (l, r) with
| (Leaf, Leaf) -> Leaf
| (l, Leaf) -> l
| (Leaf, r) -> r
| (_, _) ->
let Node (km, vm, _, _) = max l in
Node (km, vm, delete km l, Leaf)
Can anyone tell me whether my deletion code is good enough or any improvement?
One improvement is the case when we insert things that are in the tree, or delete things that are not in the tree. Each of these operations will duplicate the search path to that particular node. Insertion is probably not a problem since you will want to update the value of that key, but deletion would be a case where you can make an improvement. This can be solved by wrapping the function with an exception to return the original tree.
Here is what a deletion would look like for something that is not in the tree. As you recurse you create a new Node with the key deleted in the correct subtree. In this particular case the delete function will recurse to a Leaf then return a Leaf and on each step back up the stack return a newly constructed Node. This new path is represented as the blue path below. Since there is no structure to unwind the new path to the old path we re-create the search path in the result tree.
let at = delete x bt
To fix this issue, as mentioned wrap the function in an exception.
let delete k t =
let rec delete k = function
| Leaf -> raise Not_found
...
in
try delete k t with Not_found -> t
Related
I'm looking for a function with this signature:
chainTraversal :: k -> (k -> a -> Maybe (k, b)) -> Map k a -> Map k b
You give it an initial key to start at, a function and a map.
It will extract the element at the position k in the Map, and feed that element to the function. Based on this, the function will return another key to look at next.
It's some mix between a filter and a traversal, with the elements themselves giving the next position to open. The result is the list of elements that has been traversed. It can be shorter than the original map.
Edit: taking into account a comment.
Since all the lookups are done in the original Map:
foo :: k -> (k -> a -> Maybe (k, b)) -> Map k a -> Map k b
foo k f m = fromList $ unfoldr g k
where
g k = (\(k', b) -> (k', (k, b))) -- k ? k' ? you decide
<$> (f' k =<< (m `at` k))
f' k (k', a) = f k a -- or: f k' a ? you decide
or something like that.
You'll have to implement the at function in terms of one of the lookupNN functions of your choosing.
It's not a filter since it must stop on the first Nothing produced by f.
There is no existing function with that signature and behavior. You'll have to write it yourself.
let rec fold_inorder f acc t =
match t with
| Leaf -> acc
| Node (l, n, r) -> f (fold_inorder f acc l) (f n (fold_inorder f acc r))
I'm trying to print the infold of a tree as following :
fold_inorder (fun acc x -> acc # [x]) [] (Node (Node (Leaf,1,Leaf), 2, Node (Leaf,3,Leaf))) = [1;2;3]
I'm getting an error saying my [x] is
This expression has type 'a list
but an expression was expected of type 'a
The type variable 'a occurs inside 'a list
I'm really not sure what to do from here. Can anyone nudge me in the right direction?
In your definition of fold_inorder, what type do you expect f to have?
If I look at this call:
f n (fold_inorder f acc r)
it appears that the first parameter of f is a new value from a tree node and the second parameter is an accumulated value.
But in your test call you define f like this:
(fun acc x -> ...)
This suggests that the first parameter is the accumulated value and the second parameter is a new value from a tree node.
So, I have a tree with the definition:
type ('k, 'v) avlnode =
| Leaf
| Node of int * 'k * 'v * ('k, 'v) avlnode * ('k, 'v) avlnode
And a function to insert values to the given tree.
let rec set (n : ('k, 'v) avlnode) (key : 'k) (value : 'v) : ('k, 'v) avlnode =
match n with
| Leaf -> Node (0, key, value, Leaf, Leaf)
| Node (h, k, v, left, right) ->
if k = key then Node (h, k, value, left, right)
else if key < k then Node (h, k, v, set left key value, right)
else Node (h, k, v, left, set right key value)
What I'm trying to do is write a function to insert a list of values to the tree using Map. what I have for now is this piece of code.
let add_all (n : ('k, 'v) avlnode) (keys : ('k * 'v) list) : ('k, 'v) avlnode =
let new_set (key : 'k * 'v) : ('k, 'v) avlnode = set n (fst key) (snd key) in
let mutated_nodes = List.map new_set keys in
match List.tl mutated_nodes with [] -> Leaf | f :: l -> f
The problem with the function is that it inserts each value to the initial tree rather than a new mutated tree.
How do I write this function in order for me to have a tree with all the values in the list?
Just to elaborate on the comment of #Lee:
The type of List.map is: ('a -> 'b) -> 'a list -> 'b list. Just from the type alone you can see that it can only return a list of values. Each value in the output list is the result of applying a function to one of the values in the input list. There is no way List.map can return a tree, which is what you want.
To put this another way, List.map is useful only for the narrow purpose of transforming one list into another based on a simple rule that applies separately to each element of the list.
The fold functions List.fold_left and List.fold_right, on the other hand, are much more general functions that can perform almost any desired computation that needs to work with each of the elements of a list in turn. That's the situation you're in, so that's what you should use.
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.
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