Convert an infinite tree into an infinite stream - ocaml

Description of the problem
I have a lazy infinite binary tree:
type 'a tree_node = TN of 'a * 'a inf_btree * 'a inf_btree
and 'a inf_btree = 'a tree_node Lazy.t
let rec ibt_map (f : 'a -> 'b) (t : 'a inf_btree) : 'b inf_btree =
let TN (x, ltree, rtree) = Lazy.force t in
lazy (TN (f x, ibt_map f ltree, ibt_map f rtree))
let rec example : int inf_btree =
lazy (TN (1,
ibt_map ((+) 1) example,
ibt_map ((+) 2) example
)
)
;;
and a lazy stream:
type 'a link_node = LN of 'a * 'a stream
and 'a stream = 'a link_node Lazy.t
Now I want to transform a tree into a stream, in such a way that it preserves the order of the elements in the tree. More precisely, I want elements close to the root to come early in the stream. However, if it's done depth-first then half the tree will never occur in the stream:
let df_tree_to_stream (t : 'a inf_btree) : 'a stream =
let TN (x, ltree, rtree) = Lazy.force t in
let substream1 = df_tree_to_stream ltree in
let substream2 = df_tree_to_stream rtree in
lazy (LN (x, substream1))
(* how to work in substream2 ??? *)
An attempted solution by alternation
We could try to merge the two streams so that they alternate, but then the order of the elements will not be preserved. In the given example, the tree looks like
1
3 2
5 6 4 3
.........
The order of the stream should be
1, 3, 2, 5, 6, 4, 3, ...
But if we simply alternate the streams returned by subtrees, then the tree rooted at 3 would have streams that start with 5 and 6. So this subtree transforms into the stream 3, 5, 6 ... The other subtree becomes 2, 4, 3 ... So the overall resulting stream would be
1, 3, 2, 5, 4, ...
We could instead manage the order of visitation of nodes in the tree by maintaining a queue.
Question
My question is, is there simpler a way? Can we get the desired order not using a queue and only using recursion?

It is unusual to try to get away from the tail recursive version, but yes you can hide the queue of the breadth first traversal in a call stack. For instance, you can define an interleave function that switches the left and right source with decreasing frequency:
let rec interleave first period count l r () =
if count = 0 then
if first then
interleave false period period r l ()
else
let period = 2 * period in
interleave true period period r l ()
else
match l () with
| Seq.Nil -> r ()
| Seq.Cons(y,l) ->
Seq.Cons(y, interleave first period (count-1) l r)
let interleave = interleave true 1 1
let rec to_seq tree () =
let lazy (TN(x,l,r)) = tree in
Seq.Cons(x, interleave (to_seq l) (to_seq r))

Related

OCaml Recursive function : sublist elements multiplied by their position in a list and then summed

I’m trying to create a function that takes an int list as an argument and returns the sum of the product between an int and its position in the list. To put in an example this : multSum [5; 11; 15] should return (5 * 1 + 11 * 2 + 15 * 3) = 72.
It should be written recursively and I’m trying while avoiding List.map or List.filter or any other prefabricated functions.
By dividing and reigning the query above, I have so far started by trying the following :
let rec tir f acc l =
match l with
|[] -> acc
|h::t -> tir f (f acc h) t ;;
val tir : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a = <fun>
then I moved to this :
let rec carto f a b =
match (a,b) with
|([],[])->([])
|(h1::t1,h2::t2)->(f h1 h2):: (carto f t1 t2)
|_->invalid_arg "carto";;
val carto : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list = <fun>
with the final idea to be able to do that :
let prod arg1 arg2 =
tir (+) 1 (carto ( * ) arg1 arg2);;
val prod : int list -> int list -> int = <fun>
But I am stuck now and I’m not sure of my orientation from here forward. I thought of trying to search for the index in a "l" and replace each index int in the acc, in order to make it work but I'm afraid I'm rather complicating things... Any help please ?
Edit 1 :
let rec multSum l =
let rec indices n xs = match xs with
| [] -> []
| h::t -> n::(indices (n+1) t)in
let rec tir f acc l =
match l with
|[] -> acc
|h::t -> tir f (f acc h) t in
let rec carto f a b =
match (a,b) with
|([],[])->([])
|(h1::t1,h2::t2)->(f h1 h2):: (carto f t1 t2)
|_->invalid_arg "carto" in
let prod arg1 arg2 =
tir (+) 0 (carto ( * ) arg1 arg2) in
prod l (indices 1 l);;
val multSum : int list -> int = <fun>
Building on your replies, surely these are 'fold' and 'map' rewritten. At least, I'm sure now that I was on the right track. I have come to put together the whole code as signaled above in Edit 1.
It seems to be working well... I know that I want a recursive function and here it is. But, do you think it could be done even shorter recursively of course?
#coredump is quite right about this looking like an ideal scenario for a fold, but the extra functions aren't really that necessary. We can just use a tuple to pass the index and sum information around, then when we're done, discard the index information from the tuple.
let sum_list_prod lst =
let (_, result) = List.fold_left
(fun (i, sum) x -> (i + 1, sum + i * x))
(1, 0)
lst
in
result
Edit: A simple implementation of a left fold to demonstrate the recursion going on here.
let rec foldl f init lst =
match lst with
| [] -> init
| first :: rest -> foldl f (f init first) rest
So working through a simple example with sum_list_prod:
sum_list_prod [2; 3; 4]
Calls the fold like so:
List.fold_left (fun (i, sum) x -> (i + 1, sum + i * x)) (1, 0) [2; 3; 4]
And as that evaluates:
List.fold_left (fun (i, sum) x -> (i + 1, sum + i * x)) (1, 0) [2; 3; 4]
List.fold_left (fun (i, sum) x -> (i + 1, sum + i * x)) (2, 2) [3; 4]
List.fold_left (fun (i, sum) x -> (i + 1, sum + i * x)) (3, 8) [4]
List.fold_left (fun (i, sum) x -> (i + 1, sum + i * x)) (4, 20) []
(4, 20)
And then we throw away the 4 because we don't need it anymore and are just left with 20.
Your tir functions looks like a fold; in fact has the exact same type as List.fold_left:
# List.fold_left;;
- : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a = <fun>
In the following snippets the prod function looks like a map2
# List.map2;;
- : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list = <fun>
You can use a fold and a map to compute the function you want, but you also need first to build a list of indices from the list of values. You could do this as follows:
let rec indices n xs = match xs with
| [] -> []
| h::t -> n::(indices (n+1) t);;
For example:
# indices 1 [5;1;3];;
- : int list = [1; 2; 3]
This is not recursive terminal, if you first computed the length of the list, how would you build the list in a recursive terminal way?
Then you should be able to call prod on a list xs and on a secondary list indices 1 xs. It is a bit wasteful because you need to build an auxiliary list, but it looks quite simple to me to understand, higher-order functions like map or fold do work on whole lists so there are fewer corner cases to consider.
But, it might be better to first write a direct recursive function for your particular problem before going the more abstract route.
The direct recursive function also requires no additional memory allocation. If you write a recursive terminal function you'll carry additional accumulator values:
the current position in the list, initially 1
the current sum of products, initially 0
Then, your function has the following skeleton:
let rec f xs index product = match xs with
| [] -> ...
| h::t -> ...
You can wrap it in a main function g:
let g xs = f xs 1 0;;

verifying size of binary trees?

I have a datatype in this way
datatype 'a bin_tree =
Leaf of 'a
| Node of 'a bin_tree (* left tree *)
* int (* size of left tree *)
* int (* size of right tree *)
* 'a bin_tree (* right tree *)
so an example for correct tree would be:
val tree1 =
Node(Node(Node(Leaf 47, 1, 1, Leaf 38),
2,1,
Leaf 55),
3,2,
Node(Leaf 27, 1, 1, Leaf 96))
and an example for violating tree would be
val tree1false =
Node(Node(Node(Leaf 47, 1, 1, Leaf 38),
2,1,
Leaf 55),
4,2,
Node(Leaf 27, 1, 1, Leaf 96))
How can I write a predicate test such that
- test tree1;
val it = true : bool
- test tree1false;
val it = false : bool
This is a recursive problem. Before solving recursive problems on trees, it is a good idea to have a firm grasp on recursion on lists. You could say that trees are generalisations of lists, or that lists are special-cases of trees: lists have one tail, trees can have any number of tails depending on the type of tree. So here is how you could reconstruct and solve the problem using lists:
If, instead of the typical list definition, you have a list that also memoizes its own length:
(* datatype 'a list = [] | :: of 'a * 'a list *)
datatype 'a lenlist = Nil | Cons of int * 'a * 'a lenlist
Then you can test that the stored length is in accordance with the actual number of values.
I'll start by creating a function that counts to illustrate the part of the function that performs recursion:
(* For regular built-in lists *)
fun count0 [] = 0
| count0 (x::xs) = 1 + count0 xs
(* Counting the memoized list type disregarding the n *)
fun count1 Nil = 0
| count1 (Cons (n, x, xs)) = 1 + count1 xs
The next part is that I'd like, in each recursive step, to test that the stored number n is also in accordance with the actual counting. What is the return type of this function? Well, the test function that you want should be 'a lenlist -> bool and the count function that I made is 'a lenlist -> int.
I will suggest that you make a testcount that kinda does both. But you can do so in many ways, e.g. by giving it "extra arguments", or by giving it "extra return values". I will demonstrate both, just to show that sometimes one is better than the other and experience will tell you which.
Here is a val testcount1 : 'a lenlist -> bool * int function:
fun testcount1 Nil = (true, 0)
| testcount1 (Cons (n, x, xs)) =
let val (good_so_far, m) = testcount1 xs
val still_good = good_so_far andalso n = m + 1
in (still_good, m + 1)
end
val goodList = Cons (4, #"c", Cons (3, #"o", Cons (2, #"o", Cons (1, #"l", Nil))))
val badList = Cons (3, #"d", Cons (2, #"e", Cons (1, #"r", Cons (0, #"p", Nil))))
Testing this,
- testcount1 goodList;
> val it = (true, 4) : bool * int
- testcount1 badList;
> val it = (false, 4) : bool * int
This shows that testcount1 returns whether the numbers add up and the list's actual length, which was necessary during recursion to test that the numbers add up in each step, but in the end is no longer necessary. You could wrap this testcount function up in a simpler test function that only cares about the bool:
fun test xs = #1 (testcount1 xs)
Here is another way to go about: There is something not so satisfying with the way testcount1 recurses. It keeps calculating the m + 1s even though it is able to determine that a list (e.g. at Cons (0, #"p", Nil)) is broken.
Here is an alternate val testcount2 : 'a lenlist * int -> bool that stores a number in an extra argument instead:
fun testcount2 (Nil, 0) = true
| testcount2 (Nil, _) = false
| testcount2 (Cons (n, x, xs), m) =
n = m andalso testcount2 (xs, m - 1)
This seems a lot neater to me: The function is tail-recursive, and it stops immediately when it senses that something is fishy. So it doesn't need to traverse the entire list if it's broken at the head. The downside is that it needs to know the length, which we don't know yet. But we can compensate by assuming that whatever is advertised is correct until it's clearly the case, or not.
Testing this function, you need to not only give it a goodList or a badList but also an m:
- testcount2 (goodList, 4);
> val it = true : bool
- testcount2 (badList, 4);
> val it = false : bool
- testcount2 (badList, 3);
> val it = false : bool
It's important that this function doesn't just compare n = m, since in badList, that'd result in agreeing that badList is 3 elements long, since n = m is true for each iteration in all Cons cases. This is helped in the two Nil cases that require us to have reached 0 and not e.g. ~1 as is the case for badList.
This function can also be wrapped inside test to hide the fact that we feed it an extra argument derived from the 'a lenlist itself:
fun size Nil = 0
| size (Cons (n, _, _)) = n
fun test xs = testcount2 (xs, size xs)
Some morals so far:
Sometimes it is necessary to create helper functions to solve your initial problem.
Those helper functions are not restricted to have the same type signature as the function you deliver (whether this is for an exercise in school, or for an external API/library).
Sometimes it helps to extend the type that your function returns.
Sometimes it helps to extend the arguments of your functions.
Just because your task is "Write a function foo -> bar", this does not mean that you cannot create this by composing functions that return a great deal more or less than foo or bar.
Now, for some hints for solving this on binary trees:
Repeating the data type,
datatype 'a bin_tree =
Leaf of 'a
| Node of 'a bin_tree (* left tree *)
* int (* size of left tree *)
* int (* size of right tree *)
* 'a bin_tree (* right tree *)
You can start by constructing a skeleton for your function based on the ideas above:
fun testcount3 (Leaf x, ...) = ...
| testcount3 (Leaf x, ...) = ...
| testcount3 (Node (left, leftC, rightC, right), ...) = ...
I've embedded som hints here:
Your solution should probably contain pattern matches against Leaf x and Node (left, leftC, rightC, right). And given the "extra argument" type of solution (which at least proved nice for lists, but we'll see) needed two Leaf x cases. Why was that?
If, in the case of lists, the "extra argument" m represents the expected length of the list, then what would an "extra argument" represent in the case of trees? You can't say "it's the length of the list", since it's a tree. How do you capture the part where a tree branches?
If this is still too difficult, consider solving the problem for lists without copy-pasting. That is, you're allowed to look at the solutions in this answer (but try not to), but you're not allowed to copy-paste code. You have to type it if you want to copy it.
As a start, try to define the helper function size that was used to produce test from testcount2, but for trees. So maybe call it sizeTree to avoid the name overlap, but other than that, try and make it resemble. Here's a skeleton:
fun sizeTree (Leaf x) = ...
| sizeTree (Node (left, leftC, rightC, right)) = ...
Sticking testcount3 and sizeTree together, once written, should be easy as tau.

I want to make function maptree with standard ML

I want to make function maptree with standard ML.
If function f(x) = x + 1;
then
maptree(f, NODE(NODE(LEAF 1,LEAF 2),LEAF 3));
should make result
NODE(NODE(LEAF 2,LEAF 3),LEAF 4))
I write the code like below.
datatype 'a tree = LEAF of 'a | NODE of 'a tree * 'a tree;
fun f(x) = x + 1;
fun maptree(f, NODE(X, Y)) = NODE(maptree(f, X), maptree(f, Y))
| maptree(f, LEAF(X)) = LEAF(f X);
but when I execute this code like this
maptree(f, (NODE(NODE(LEAF 1,LEAF 2),LEAF 3)));
result is not I want to
(NODE(NODE(LEAF 2,LEAF 3),LEAF 4)))
but
NODE(NODE(LEAF #,LEAF #),LEAF 4)).
Why this happened(not a number but #)?
# is used by the REPL when the data structure it prints is deeper than a pre-set value. If you increase that value, you'll get the result you excepted. I assume you're using SML/NJ, which calls that setting print.depth:
sml -Cprint.depth=20
- maptree(f, (NODE(NODE(LEAF 1,LEAF 2),LEAF 3)));
val it = NODE (NODE (LEAF 2,LEAF 3),LEAF 4) : int tree
You can find more options like these by executing sml -H. Look them up under the "compiler print settings" section:
compiler print settings:
print.depth (max print depth)
print.length (max print length)
print.string-depth (max string print depth)
print.intinf-depth (max IntInf.int print depth)
print.loop (print loop)
print.signatures (max signature expansion depth)
print.opens (print `open')
print.linewidth (line-width hint for pretty printer)
Some comments:
I would probably go with the definition
datatype 'a tree = Leaf | Node of 'a tree * 'a * 'a tree
so that trees with zero or two elements can also be expressed.
I would probably curry the tree map function
fun treemap f Leaf = Leaf
| treemap f (Node (l, x, r)) = Node (treemap f l, x, treemap f r)
since you can then partially apply it, e.g. like:
(* 'abstree t' returns t where all numbers are made positive *)
val abstree = treemap Int.abs
(* 'makeFullTree n' returns a full binary tree of size n *)
fun makeFullTree 0 = Leaf
| makeFullTree n =
let val subtree = makeFullTree (n-1)
in Node (subtree, n, subtree)
end
(* 'treetree t' makes an int tree into a tree of full trees! *)
val treetree = treemap makeFullTree
You may at some point want to fold a tree, too.

Addition of element in a list of record (OCaml)

I have a list of record :
list_clients = [{name = "c6"; number = 9}; {name = "c12"; number = 3}; {name = "c17"; number = 6};]
I would like to simply make the sum of all the "number" of each record.
What is the best way? I'm quite beginner with OCaml.
Use a fold:
List.fold_left (fun acc nxt -> nxt.number+acc) 0 list_clients
This takes every element in the list, grabs said element's 'number' field, and adds it to the total thus far, passing along the result.
A bit more explanation about Charles Marsh's answer.
List.fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a takes a function f, an element a and a list [b1; b2; ...; bn] and computes f (... (f (f a b1) b2) ...) bn. It allows you you to easily compute the sum of the elements of a list: List.fold_left (+) 0 l, its maximum element: List.fold_left max (List.hd l) l or anything where you need to go through every element of the list, aggregating it with the previous result.

SML Lazy sort of int list using streams

The question
1 Streams and lazy evaluation (40 points)
We know that comparison sorting requires at least O(n log n) comparisons where were are sorting n elements. Let’s say we only need the first f(n) elements from the sorted list, for some function f. If we know f(n) is asymptotically less than log n then it would be wasteful to sort the entire list. We can implement a lazy sort that returns a stream representing the sorted list. Each time the stream is accessed to get the head of the sorted list, the smallest element is found in the list. This takes linear time. Removing the f(n) elements from the list will then take O(nf(n)). For this question we use the following datatype definitions. There are also some helper functions defined.
(* Suspended computation *)
datatype 'a stream' = Susp of unit -> 'a stream
(* Lazy stream construction *)
and 'a stream = Empty | Cons of 'a * 'a stream'
Note that these streams are not necessarily infinite, but they can be.
Q1.1 (20 points) Implement the function lazysort: int list -> int stream'.
It takes a list of integers and returns a int stream' representing the sorted list. This should be done in constant time. Each time the stream' is forced, it gives either Empty or a Cons(v, s'). In the case of the cons, v is the smallest element from the sorted list and s' is a stream' representing the remaining sorted list. The force should take linear time. For example:
- val s = lazysort( [9, 8, 7, 6, 5, 4] );
val s = Susp fn : int stream'
- val Cons(n1, s1) = force(s);
val n1 = 4 : int
val s1 = Susp fn : int stream'
- val Cons(n2, s2) = force(s1);
val n2 = 5 : int
val s2 = Susp fn : int stream'
- val Cons(n3, s3) = force(s2);
val n3 = 6 : int
val s3 = Susp fn : int stream'
Relevant definitions
Here is what is given as code:
(* Suspended computation *)
datatype 'a stream' = Susp of unit -> 'a stream
(* Lazy stream construction *)
and 'a stream = Empty | Cons of 'a * 'a stream'
(* Lazy stream construction and exposure *)
fun delay (d) = Susp (d)
fun force (Susp (d)) = d ()
(* Eager stream construction *)
val empty = Susp (fn () => Empty)
fun cons (x, s) = Susp (fn () => Cons (x, s))
(*
Inspect a stream up to n elements
take : int -> 'a stream' -> 'a list
take': int -> 'a stream -> 'a list
*)
fun take 0 s = []
| take n (s) = take' n (force s)
and take' 0 s = []
| take' n (Cons (x, xs)) = x::(take (n-1) xs)
My attempt at a solution
I tried to do the following which get the int list and transforms it to int stream':
(* lazysort: int list -> int stream' *)
fun lazysort ([]:int list) = empty
| lazysort (h::t) = cons (h, lazysort(t));
But when calling force it does not return the minimum element. I have to search for the minimum, but I do not know how... I thought of doing insertion sort like following:
fun insertsort [] = []
| insertsort (x::xs) =
let fun insert (x:real, []) = [x]
| insert (x:real, y::ys) =
if x<=y then x::y::ys
else y::insert(x, ys)
in insert(x, insertsort xs)
end;
But I have to search for the minimum and to not sort the list and then put it as a stream...
Any help would be appreciated.
Each time the stream is accessed to get the head of the sorted list, the smallest element is found in the list.
You are on the correct path with the placement function (sort of... I don't know why you have real types instead of int when there will only be int streams . Your pattern would not match if you have not realized by now).
fun insertsort ([]:int list) = empty
| insertsort (h::t) =
let
fun insert (x:real, []) = [x] (* 1 *)
| insert (x:real, y::ys) = (* 2 *)
if x<=y then x::y::ys (* 3 *)
else y::insert(x, ys) (* 4 *)
in insert(x, insertsort xs) (* 5 *)
This is your helping inner magic for getting the smallest item each time.
Some hints/tips to make the above work
You should have only one argument
I don't think it matters to have less than or equal to (just less than should work .... have not really thought about that). Also you have to reach the bottom of the list first to tell which is the smallest so this is tail first. so that (* 1 *) is the first then each inside call of (* 2 *) till the outermost one.
That should be cons(x, insertsort xs) in (* 5 *) since you are returning a int stream' with the function.
I'm in your class and I think you're going about this the totally wrong way. I've solved the question, but I think it's a bit unethical for me to fully share the code with you. That said, here's a pointer:
you don't need to transform the int list into an int stream'. Firstly, this violates the rule that the initial call to lazysort must be done in constant time. Note that transforming it to an int stream' is done in linear time. What you need to do is provide an embedded sort function within the closure of the suspended stream you're returning (using a let block.) The first element of the stream would be the result of the sort function (done with the suspended closure.) The second element of the stream (which is just an int stream') should be a call to your lazysort function, because it returns an int stream'. Notice how this lets you avoid having to transform it. The sort function itself is quite simple, because you only need to find the smallest element and return the rest of the list without the element you found to be the smallest.