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.
Related
How to create a tuple list from one single list, like so:
[1; 2; 4; 6] -> [(1, 2); (4, 6)]
I want to do it using function List.fold_left since I'm trying to learn that currently but don't know how... Is there a way? Or should I leave it like that?
This is a working code that doesn't use List.fold_left:
let rec create_tuple acc l = match l with
| [] -> acc
| x :: y :: l' -> create_tuple (acc # [(x, y)]) l'
| _ -> acc
List.fold_left reads elements one by one. There is no direct way to make it read elements two by two.
It really is pointless complication (great for teaching, though), but if you absolutely want to use List.fold_left here, your accumulator needs to somehow record the state of the traversal:
either you have read an even number of elements so far,
or you have read an odd number and then you have to record what was the last element you read, so that, upon reading the following one, you can pair them.
Here is a way to do it. I use an algebraic datatype to represent the state.
(* This is the type that we’ll use for the accumulator;
the option component is the state of the traversal.
(None, acc) means that we have read an even number of elements so far;
(Some x, acc) means that we have read an odd number of elements so far,
the last of which being x. *)
type 'a accumulator = 'a option * ('a * 'a) list
let folder (state, acc) x =
match state with
| None -> (Some x, acc)
| Some y -> (None, (y,x)::acc)
let create_pairs l =
let (_, acc) = List.fold_left folder (None, []) l in
List.rev acc
Also notice how I avoid the complexity bug that I outlined in a comment: I add elements in reverse order (i.e. at the head of the accumulating list), and at the very end I reverse that list.
#Maëlan's answer is beautiful, but what if we want to get triples rather than pairs? Is there a way we can use List.fold_left to handle this more generically?
let chunks n lst =
let (_, _, acc) = List.fold_left
(fun (counter, chunk, lst') x ->
if counter = n - 1 then
(0, [], List.rev (x :: chunk) :: lst')
else
(counter + 1, x :: chunk, lst'))
(0, [], [])
lst
in
List.rev acc
Using this, chunks 2 [1; 2; 4; 6] returns [[1; 2]; [4; 6]]. We can map this to the result you're looking for with a very simple function that takes a list with two elements and creates a tuple with two elements.
chunks 2 [1; 2; 4; 6] |> List.map (fun [x; y] -> (x, y))
And we get:
[(1, 2), (4, 6)]
This could be used to implement a triples function.
let create_triples lst =
chunks 3 lst |> List.map (fun [x; y; z] -> (x, y, z));;
And now create_triples [1; 2; 3; 4; 5; 6; 7; 8; 9] returns [(1, 2, 3); (4, 5, 6); (7, 8, 9)].
I tried this question(using List.fold_left) and this is the best I could come up with:
type 'a node = First of 'a | Second of ('a * 'a)
let ans =
List.fold_left
(
fun a e ->
match a with
| [] -> (First e)::a
| (First f)::tl -> Second(f, e)::tl
| (Second n)::tl -> (First e)::(Second n)::tl
)
[]
[1; 2; 3; 4; 5; 6; ]
let () =
List.iter
(
fun e ->
match e with
| First f ->
print_endline(string_of_int f)
| Second (f, s) ->
Printf.printf "(%d, %d)" f s
)
(List.rev ans)
Just to make my answer all there...
type 'a node = One of 'a | Two of ('a * 'a)
let ans =
(List.map
(
fun e ->
match e with
| One _ -> failwith "Should only be Two's"
| Two (f, s) -> (f, s)
)
(List.filter
(
fun e ->
match e with
| One _ -> false
| Two _ -> true
)
(List.rev
(List.fold_left
(
fun a e ->
match a with
| [] -> (One e)::[]
| (One o)::tl -> (Two (o, e))::tl
| (Two t)::tl -> (One e)::(Two t)::tl
)
[]
(List.init 10 (fun x -> x + 1))
)
)
)
)
let () =
List.iter
(fun (f, s) -> Printf.printf "(%d, %d) " f s)
ans
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;;
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)
Say we have such a lazy list:
type 'a lazy_list_t = Cons of 'a * (unit -> 'a lazy_list_t)
Does it make sense to have a function like the iter in regular list:
val iter : ('a -> unit) -> 'a list -> unit
List.iter f [a1; ...; an] applies function f in turn to a1; ...; an. It is equivalent to begin f a1; f a2; ...; f an; () end.
Or is it possible to produce iter_lazy like
val iter_lazy: ('a -> unit) -> 'a lazy_list -> unit
No, it does not make much sense.
First, and you probably noticed it, all your list are infinite (you do not have an empty element). So, only examples of inhabitant of your type are somehow using a recursive function, eg. :
let omega =
let rec f n = Cons (n, fun () -> f (n + 1)) in
f 0
This implements the infinite stream [ 0, 1, 2, 3, ...
If you WANT a diverging program you could implement :
let rec iter f (Cons (n, g)) = f n; iter f (g ())
but if you do iter print_int omega it will result output all integers which will take some time.
So itering is not an option. What would work is "mapping", you can implement the function :
val map: ('a -> 'b) -> 'a lazy_list_t -> 'b lazy_list
let rec map f (Cons (x, g)) = Cons (f x, fun () -> map f (g ()))
Notice how the recursive call to map is "protected" by the "fun () ->" so it will not trigger "right away" but only each time the tail of your lazy list is forced.
You can use this to lazily compute on infinite streams, eg :
let evens = map ((*) 2) omega
computes the stream [0; 2; 4; 6; 8; ...
Note, that you could use it to implement some sort of "iter" by mapping a function that does a side_effect eg.
let units = map print_int evens
will output right away the number "0" and outputs the stream [(); (); (); ... and each time you force one of the "tail" of this stream it will output the corresponding number (it can happen multiple times). Example:
(* Force the tail *)
val tl : 'a lazy_list_t -> 'a lazy_list_t
let tl (Cons (_, g)) = g ()
let () = begin
tl units; (* ouputs "2" *)
tl (tl units); (* outputs "24" *)
tl units; (* outputs "2" *)
end
(I haven't tried the code so there may be some typos).
I have a list of integers named t that has an even length n = List.length t. I want to get two lists, the partition of t from index 0 to (n / 2 - 1), and the partition of t from index (n / 2) to (n-1). In other words, I want to split the list t in two parts, but I cannot find anything that does that in the List module (there is List.filter, but it does not filter by index, it takes a function instead).
An example of what I want to do:
let t = [8 ; 66 ; 4 ; 1 ; -2 ; 6 ; 4 ; 1] in
(* Split it to get t1 = [ 8 ; 66 ; 4 ; 1] and t2 = [-2 ; 6 ; 4 ; 1] *)
For now,I have something like this
let rec split t1 t2 n =
match t1 with
| hd :: tl when (List.length tl > n) -> split tl (hd :: t2) n;
| hd :: tl when (List.length tl = n) -> (t1,t2);
| _ -> raise (Failure "Unexpected error");;
let a = [1;2;3;4;7;8];;
let b,c = split a [] (List.length a / 2 - 1);;
List.iter (fun x -> print_int x) b;
print_char '|';
List.iter (fun x -> print_int x) c;
Output is:
478|321, the order has been reversed!
Calculating the length of the list requires walking the list, so it takes time that's linear in the length of the list. Your attempt calculates the length of the remaining list at each step, which makes the total running time quadratic. But you actually don't need to do that! First you calculate the total length of the list. After that, the place to cut is halfway from the beginning, which you can locate by incrementing a counter as you go through the list.
As for the reversal, let's look at what happens to the first element of the list. In the first call to split, the accumulator t2 is the empty list, so h gets put at the end of the list. The next element will be placed before that, and so on. You need to put the first element at the head of the list, so prepend it to the list built by the recursive call.
let rec split_at1 n l =
if n = 0 then ([], l) else
match l with
| [] -> ([], []) (*or raise an exception, as you wish*)
| h :: t -> let (l1, l2) = split_at1 (n-1) t in (h :: l1, l2);;
let split_half1 l = split_at1 (List.length l / 2) l;;
This operates in linear time. A potential downside of this implementation is that the recursive call it makes is not a tail call, so it will consume a large amount of stack on large lists. You can fix this by building the first half as an accumulator that's passed to the function. As we saw above, this creates a list in reverse order. So reverse it at the end. This is a common idiom when working with lists.
let rec split_at2 n acc l =
if n = 0 then (List.rev acc, l) else
match l with
| [] -> (List.rev acc, [])
| h :: t -> split_at2 (n-1) (h :: acc) t;;
let split_half2 l = split_at2 (List.length l / 2) [] l;;