The trick for doing Stream - ocaml

I am currently trying to fully understand stream. The concept is not complicated. It is like a list, but the tail part is a thunk instead of concrete sub list.
I can write stream like this:
type 'a stream_t = Nil | Cons of 'a * (unit -> 'a stream_t)
let hd = function
| Nil -> failwith "hd"
| Cons (v, _) -> v
let tl = function
| Nil -> failwith "tl"
| Cons (_, g) -> g()
let rec take n = function
| Nil -> []
| Cons (_, _) when n = 0 -> []
| Cons (hd, g) -> hd::take (n-1) (g())
let rec filter f = function
| Nil -> Nil
| Cons (hd, g) ->
if f hd then Cons (hd, fun() -> filter f (g()))
else filter f (g())
So far so good and I can write a simple stream:
let rec from i = Cons (i, fun() -> from (i+1))
Now, if I was asked to do a primes stream, I feel very difficult. I want to use sieve algorithm. Without thinking of stream, I can do it easily. But for stream, I can't do.
I searched for the code:
(* delete multiples of p from a stream *)
let sift p = filter (fun n -> n mod p <> 0)
(* sieve of Eratosthenes *)
let rec sieve = function
| Nil -> Nil
| Cons (p, g) ->
let next = sift p (g()) in
Cons (p, fun () -> sieve next)
(* primes *)
let primes = sieve (from 2)
I can almost understand that it is working. But where is the trick?
Also how to do a stream of permutation of a list?

Related

Why this program dosen't halt when only need to iterating throught a finite stream?

I'm trying to get a list of primes of two digits by running these codes in LearnOcaml. The codes compile if I restrict the parameter of the listify method, which returns a list from a stream, to be less than 20. Otherwise, it either never halt or return "Exception: Js_of_ocaml__Js.Error _.". I don't think the code is semantically wrong. So I'm
wondering if anyone can help resolve the problem?
type 'a stream = Eos | StrCons of 'a*(unit -> 'a stream)
(*integers from n onwards*)
let rec nums_from n =
StrCons(n,fun () -> nums_from (n+1))
let rec filterStr (test : 'a -> bool) (s: 'a stream) =
match s with
|Eos -> Eos
|StrCons(q,w) -> if test q then StrCons(q,fun ()-> filterStr test (w ()))
else filterStr test (w ())
(*Remove all numbers mod p*)
let sift p =
filterStr (fun x -> x mod p <> 0)
(*Sieves*)
let rec sieves s =
match s with
|Eos ->Eos
|StrCons(x,g) -> StrCons(x, fun ()-> sieves (sift x (g ())))
(*primes*)
let allprimes = sieves (nums_from 2)
let rec listify s n=
if n =0 then [] else
match s with
|Eos -> []
|StrCons(q,w) -> q::(listify (w ()) (n-1))
let twodigitsprimes = filterStr (fun x -> x > 10&& x<100) allprimes
let twodigitsprimeslist= listify twodigitsprimes 21
It appears that filterStr is looping while trying to create the StrCons that represents the next element after the 21st. Since there are only 21 2-digit primes, this will loop forever.
Note that when listify is called with n = 0, the StrCons has already been constructed; it just isn't examined. But the StrCons for this case diverges (and OCaml is a strict language).
You can get things to work using this version of listify:
let rec listify s n =
if n = 0 then []
else
match s with
| Eos -> []
| StrCons (q, w) ->
if n = 1 then [q] else q :: listify (w ()) (n - 1)

number of 5-digits numbers with no repeating digits bigger than 12345

I'm a beginner in OCaml and algorithms.
I'm trying to get the number of 5 digits numbers with no repeating digits bigger than 12345.
Here is what I did in OCaml, I tried to make as tail recursive as possible, and I also used streams. But still, due to size, it stack overflowed:
type 'a stream = Eos | StrCons of 'a * (unit -> 'a stream)
let rec numberfrom n= StrCons (n, fun ()-> numberfrom (n+1))
let nats = numberfrom 1
let rec listify st n f=
match st with
|Eos ->f []
|StrCons (m, a) ->if n=1 then f [m] else listify (a ()) (n-1) (fun y -> f (m::y))
let rec filter (test: 'a-> bool) (s: 'a stream) : 'a stream=
match s with
|Eos -> Eos
|StrCons(q,w) -> if test q then StrCons(q, fun ()->filter test (w ()))
else filter test (w ())
let rec check_dup l=
match l with
| [] -> false
| h::t->
let x = (List.filter (fun x -> x = h) t) in
if (x == []) then
check_dup t
else
true;;
let digits2 d =
let rec dig acc d =
if d < 10 then d::acc
else dig ((d mod 10)::acc) (d/10) in
dig [] d
let size a=
let rec helper n aa=
match aa with
|Eos-> n
|StrCons (q,w) -> helper (n+1) (w())
in helper 0 a
let result1 = filter (fun x -> x<99999 && x>=12345 && (not (check_dup (digits2 x)))) nats
(* unterminating : size result1 *)
(*StackOverflow: listify result1 10000 (fun x->x) *)
I can't reproduce your reported problem. When I load up your code I see this:
# List.length (listify result1 10000 (fun x -> x));;
- : int = 10000
# List.length (listify result1 26831 (fun x -> x));;
- : int = 26831
It's possible your system is more resource constrained than mine.
Let me just say that the usual way to code a tail recursive function is to build the list up in reverse, then reverse it at the end. That might look something like this:
let listify2 st n =
let rec ilist accum st k =
match st with
| Eos -> List.rev accum
| StrCons (m, a) ->
if k = 1 then List.rev (m :: accum)
else ilist (m :: accum) (a ()) (k - 1)
in
if n = 0 then []
else ilist [] st n
You still have the problem that listify doesn't terminate if you ask for more elements than there are in the stream. It might be better to introduce a method to detect the end of the stream and return Eos at that point. For example, the filter function might accept a function that returns three possible values (the element should be filtered out, the element should not be filtered out, the stream should end).
The problem is that the size of your stream result1 is undefined.
Indeed, nats is an never-ending stream: it never returns Eos.
However, filtering a never-ending stream results in another never-ending stream
since a filtered stream only returns Eos after the underlying stream does so:
let rec filter (test: 'a-> bool) (s: 'a stream) : 'a stream=
match s with
| Eos -> Eos
| StrCons(q,w) -> if test q then StrCons(q, fun ()->filter test (w ()))
else filter test (w ())
Consequently, size result1 is stuck trying to reach the end of integers.
Note also that, in recent version of the standard library, your type stream is called Seq.node.

merging 2 lazy lists type conflict

Why my merge function complains about its type ?
Isn't my x a type 'a seq ?
type 'a seq = Stop | Cons of 'a * (unit -> 'a seq)
let rec linear start step= (*builds a seq starting with 'start'*)
Cons (start, fun () -> linear (start+step) step)
let rec take n seq = match seq with (*take first n elem from seq*)
| Stop -> []
| Cons (a, f) -> if n < 1 then [] else a::(take (n-1) (f ()))
let rec merge seq1 seq2 = match seq1, seq2 with
| Stop, _ -> seq2
| _, Stop -> seq1
| Cons(h1, tf1), _ as x ->
Cons(h1, fun () -> merge (x) (tf1 ()))
let l1 = linear 1 1
let l2 = linear 100 100
let l3 = interleave l1 l2
I would like to see the right result for
take 10 l3
int list = [1; 100; 2; 200; 3; 300; 4; 400; 5; 500]
Another way to write my function (which works) would be
let rec merge seq1 seq2 = match seq1 with
| Stop -> Stop
| Cons (h, tf) -> Cons(h, fun () -> merge seq2 (tf ()))
but I don't get it , why the first merge doesn't work.
Thanks.
Just write (_ as x) because here, your as x catches the whole pattern.
So, what you see as :
| Cons(h1, tf1), (_ as x) -> ...
is actually parsed as
| (Cons(h1, tf1), _) as x -> ...
And you could actually write :
| Cons(h1, tf1), x -> ...
Which is far better ;-)
Or even
| Cons(h1, tf1), _ -> Cons(h1, fun () -> merge seq2 (tf1 ()))

iterate with fold_right in Ocaml

fold_right gives me values starting from the tail of the list but I want to give a function to fold_right as a parameter such that this function would collect values starting from the head of the list .
I want iterto receive values starting with the head of the list.
Continous Passing is the keyword ... .Another way to ask the question would be how tofold_leftwith fold_right
let fold f ls acc = List.fold_right f ls acc
val iter : ('a -> unit) -> 'a t -> unit
let iter f my_type =
let rec iiter my_type return =
return (fold (fun x y -> f x) my_type ()) () in iiter my_type (fun x y -> ())
But when I call :
iter (fun a -> print_string a) ["hi";"how";"are";"you"];;
Output:
youarehowhi
I need
hihowareyou
This is quite simple, you must try to match the signatures for the behavior.
Iteration takes no input, and returns unit, while folding takes an input and returns an output of the same type. Now, if the input taken by folding is unit then you'll have a folding function which applies a function on each element of a collection by passing an additional unit and returning an unit, which basically corresponds to the normal iteration, eg:
# let foo = [1;2;3;4;5];;
# List.fold_left (fun _ a -> print_int a; ()) () foo;;
12345- : unit = ()
As you can see the fold function just ignores the first argument, and always returns unit.
let fold_left f init ls =
let res = List.fold_right (fun a b acc -> b (f acc a)) ls (fun a -> a)
in res init
now calling
fold_left (fun a b -> Printf.printf "%s\n" b) () ["how";"are";"you"];;
gives us
how
are
you
fold_left is like List.fold_left but constructed with List.fold_right (Not tail-recursive):
let fold_left f a l = List.fold_right (fun b a -> f a b) (List.rev l) a ;;
Is not a good idea, because fold_left is not tail-recursive and List.fold_left is tail-recursive. Is better to produce a fold_right (tail-recursive) as :
let fold_right f l a = List.fold_left (fun a b -> f b a) a (List.rev l) ;;
If you can't use List.rev :
let rev l =
let rec aux acc = function
| [] -> acc
| a::tl -> aux (a::acc) tl
in
aux [] l
;;
iter use fold_left :
let iter f op = ignore (fold_left (fun a b -> f b;a) [] op ) ;;
Test :
# fold_left (fun a b -> (int_of_string b)::a ) [] ["1";"3"];;
- : int list = [3; 1]
# rev [1;2;3];;
- : int list = [3; 2; 1]
# iter print_string ["hi";"how";"are";"you"];;
hihowareyou- : unit = ()
The continuation that you need to pass through fold in this case is a function that will, once called, iterate through the rest of the list.
EDIT: like so:
let iter f list = fold
(fun head iter_tail -> (fun () -> f head;; iter_tail ()))
list
()

How can I skip a term with List.Map in OCAML?

Suppose I have some code like this:
List.map (fun e -> if (e <> 1) then e + 1 else (*add nothing to the list*))
Is there a way to do this? If so, how?
I want to both manipulate the item if it matches some criteria and ignore it if it does not. Thus List.filter wouldn't seem to be the solution.
SML has a function mapPartial which does exactly this. Sadly this function does not exist in OCaml. However you can easily define it yourself like this:
let map_partial f xs =
let prepend_option x xs = match x with
| None -> xs
| Some x -> x :: xs in
List.rev (List.fold_left (fun acc x -> prepend_option (f x) acc) [] xs)
Usage:
map_partial (fun x -> if x <> 1 then Some (x+1) else None) [0;1;2;3]
will return [1;3;4].
Or you can use filter_map from extlib as ygrek pointed out.
Both Batteries and Extlib provide an equivalent of mapPartial: their extended List module sprovide a filter_map function of the type ('a -> 'b option) -> 'a list -> 'b list, allowing the map function to select items as well.
Another solution would be to use directly a foldl :
let f e l = if (e <> 1)
then (e + 1)::l
else l
in List.fold_left f [] list
But my preference is filter_map as Michael Ekstrand provided
Alternatively you can filter your list then apply the map on the resulted list as follows :
let map_bis predicate map_function lst =
List.map map_function (List.filter predicate lst);;
# val map_bis : ('a -> bool) -> ('a -> 'b) -> 'a list -> 'b list = <fun>
Usage :
# map_bis (fun e -> e<>1) (fun e -> e+1) [0;1;2;3];;
- : int list = [1; 3; 4]
You can also map values to singleton lists if you want to keep them or empty lists if you don't, and then concat the results.
List.concat (List.map (fun e -> if (e <> 1) then [e + 1] else []) my_list)
use
let rec process = function
| 1 :: t -> process t
| h :: t -> (h + 1) :: (process t)
| [] -> []
or tail recursive
let process =
let rec f acc = function
| 1 :: t -> f acc t
| h :: t -> f ((h + 1) :: acc) t
| [] -> List.rev acc in
f []
or with a composition of standard functions
let process l =
l |> List.filter ((<>)1)
|> List.map ((+)1)
The OCaml standard library has had List.filter_map since 4.08. This can therefore now be written as:
List.filter_map (fun e -> if e <> 1 then Some (e + 1) else None)