I'm not sure how to remove the cycles from a mutable list of type:
type 'a m_list = Nil | Cons of 'a * (('a m_list) ref)
E.g. if I had a list 3,2,2,1,2,1,2,1,..... I would want to get a 3,2,2,1.
What I can't figure out is the location of the initial cycling--I have a recursion that looks like this but I can't figure out how to wrap this into a recursive function; obviously here it would just checks the first few terms.
let remove list : unit =
if is_cyclic list then match list with
|Nil->()
|Cons(_,v)-> match (!v) with
|Nil->()
|Cons(_,x)->match (!x) with
|Nil->()
|Cons(_,y)->match (!y) with
|Nil->()
|Cons(_,p) -> if is_cyclic (!p) then p:=Nil else ()
I have an is_cyclic function that tells me whether an m_list has a cycle or not. I'd like to do this either destructively (updating the reference) or indestructively (creating a new list).
Thanks!
Based on Pascal Cuoq's answer to your previous question, you could try something like this:
let rec recurse list already_visited =
match list with
Nil -> ()
| Cons(h, t) ->
if List.memq !t already_visited
then t := Nil
else recurse !t (t :: already_visited)
let remove_cycles list = recurse list []
This traverses the list until it either reaches the end or visits an element twice. When the latter happens, it instead sets the last visited reference to Nil.
You may want to replace already_visited with another data structure if you have very large lists.
If you don't have enough memory to store each previously visited element, you could instead using a cycle detection algorithm to find an element in the cycle, then using that, find the end of the cycle and overwrite it's next reference.
To do this, modify is_cyclic to return a 'a mlist ref instead of a bool. Assuming that it could possibly return an element in the middle of the cycle, run through the original list and check whether each element is in the cycle. This will give you the first element in the cycle.
From there it's easy to find the end of the cycle - just loop through the cycle until you get back to the beginning.
Something like this:
let rec in_cycle x st cyc =
if cyc == x then true
else
match !cyc with Nil -> false
| Cons(_, t) when t == st -> false
| Cons(_, t) -> in_cycle x st t
let rec find_start l cyc =
if in_cycle l cyc cyc then l
else
match !l with Nil -> raise Not_found
| Cons(_, t) -> find_start t cyc
let rec find_end st cyc =
match !cyc with Nil -> raise Not_found
| Cons(_, t) ->
if t == st then cyc
else find_end st t
(* ... *)
let cyc = is_cyclic list in
let st = find_start list cyc in
let e = (find_end st cyc) in
match !e with Nil -> failwith "Error"
| Cons(v, _) -> e := Cons(v, ref Nil)
Related
In OCaml, I want to write a function that returns the element at a given index of a list. For example [4;5;6] 0 -> 4, [4;5;6] 1 -> 5. I know how to do this recursively, but can anyone show how to do this problem using fold_left or fold_right? Thank you so much!
Let's look at how you can print the elements in a list using fold_left.
let print lst =
List.fold_left
(fun i x -> Format.printf "%d: %d\n" i x; i + 1)
0 lst;
The initial index of 0 is passed in as the initial value. Each time through we have the side effect of printing a line, and then update the initial value to i + 1.
Result:
utop # print [1;4;6;2;7];;
0: 1
1: 4
2: 6
3: 2
4: 7
- : int = 5
This shows us nicely how the fold updates its accumulator as it iterates through a list.
But if we're going to search for a value at an index, let's use a tuple of a current index and an option type for the return value, in case we don't find the index we're looking for.
let at idx lst =
List.fold_left
(fun i x ->
match i with
| (_, Some _). -> i
| (idx', _) when idx = idx' -> (idx', Some x)
| (idx', _) -> (idx' + 1, None))
(0, None)
lst
We start with 0 and None as our initial value. For each item in the list we check to see if the option type value in the accumulator is Some _. We don't care about the value, but if it's not None we've found what we're looking for and do not need to update the accumulator.
If the accumulator does contain None and the current index is the same as the one we're looking for, update the accumulator with Some of the current value. The index does not need to be updated.
If the index is not the one we're looking for, increment the index and continue.
utop # at 3 [1;2;3;4;5];;
- : int * int option = (3, Some 4)
But since we don't need the first element in the tuple, we can use a let binding to name the result we are looking for and return that.
let at idx lst =
let (_, result) = List.fold_left
(fun i x ->
match i with
| (_, Some _) -> i
| (idx', _) when idx = idx' -> (idx', Some x)
| (idx', _) -> (idx' + 1, None))
(0, None)
lst
in
result
Now:
utop # at 3 [1;2;3;4;5];;
- : int option = Some 4
Taking a look at how List.fold_left can be implemented may be instructive.
let rec fold_left f init lst =
match lst with
| [] -> init
| x::xs -> fold_left f (f init x) xs
In at the Some _ condition in the accumulator tuple causes that accumulator value to propagate to the end of the fold without update.
Alternately we could use a local exception to break out of the fold immediately on finding the index we're looking for.
let at idx lst =
let exception Early_exit of int in
try
let (_, result) = List.fold_left
(fun i x ->
match i with
| (_, Some _) -> i
| (idx', _) when idx = idx' -> raise (Early_exit x)
| (idx', _) -> (idx' + 1, None))
(0, None)
lst
in
result
with Early_exit x -> Some x
Or perhaps a little bit more cleanly:
let at idx lst =
let exception Early_exit of int in
match List.fold_left
(fun i x ->
match i with
| (_, Some _) -> i
| (idx', _) when idx = idx' -> raise (Early_exit x)
| (idx', _) -> (idx' + 1, None))
(0, None)
lst with
| (_, result) -> result
| exception Early_exit x -> Some x
Of course, we now know that if the exception Early_exit wasn't raised, the index wasn't found, so the result would always be None.
let at idx lst =
let exception Early_exit of int in
match List.fold_left
(fun i x ->
match i with
| (_, Some _) -> i
| (idx', _) when idx = idx' -> raise (Early_exit x)
| (idx', _) -> (idx' + 1, None))
(0, None)
lst with
| _ -> None
| exception Early_exit x -> Some x
And testing:
utop # at 3 [1;2;3;4;5];;
- : int option = Some 4
But if we're using exceptions this way, we really don't need List.fold_left at all. We can just use List.iteri.
let at idx lst =
let exception Found of int in
try
List.iteri (fun i x -> if i = idx then raise (Found x)) lst;
None
with Found x -> Some x
Both kinds of fold let you access the elements of a list in order while maintaining some state that you can choose freely. The difference is that fold_left starts at the beginning of the list and works toward the end and fold_right starts at the end of the list and works back toward the beginning.
Since your index starts at the beginning of the list I'd say it will be easier to work with fold_left.
So, your problem is to figure out some kind of state that you can maintain so that by the time you've looked at the whole list, you know what the nth element of the list was.
You can basically figure out the state from the problem: you need to know what element of the list you're looking at (so you know when you come to the nth one). You need to remember the nth element (if you've seen it already) so that it's available when you reach the end of the list. If you haven't seen the nth element yet you need something of the same type to use as a placeholder (or you could use an option type).
You need a function that takes state like this (along with one element of the list) and produces the state that goes with the next element of the list. This is really not so different from writing a loop, except that you need to pass the state explicitly as a parameter and return the new state as a result.
You need some exit mechanism when the index element is found.
exception Value of int
let get_index_value_using_fold_left l i =
let index_value = ref 0 in
try
List.fold_left
(
fun a e ->
if !index_value = i
then
raise (Value e)
else
(
index_value := !index_value + 1;
a
)
) None l
with
| Value ans -> Some ans
let ans = get_index_value_using_fold_left [11;2;13;4;15;6;17;8;19;20;] 2
let () =
Option.iter (fun x -> Printf.printf "%d\n" x) ans
My data is ordered like this:
([(x1,y1,z1);(x2,y2,z2);(x3,y3,z3);........;(xn,yn,zn)], e:int)
Example: I try to create a list [x1;x2;x3;....;xn;e] where a value is found only once.
I began the following code but I encounter an issue with type.
let rec verifie_doublons_liste i liste = match liste with
| [] -> false
| head::tail -> i = head || verifie_doublons_liste i tail
let rec existence_doublon liste = match liste with
| [] -> false
| head::tail -> (verifie_doublons_liste head tail) ||
existence_doublon tail
let premier_du_triplet (x,y,z) = x
let deuxieme_du_triplet (x,y,z) = y
let troisieme_du_triplet (x,y,z) = z
let rec extract_donnees l = match l with
| [] -> []
| (x,y,z)::r -> (extract_donnees r)##(x::z::[])
let arrange donnees = match donnees with
| [],i -> i::[]
| (x,y,z)::[],i -> x::z::i::[]
| (x,y,z)::r,i -> (extract_donnees r)##(x::z::i::[])
Basically, you want to extract first elements in a list of tuples, and add the e elemnent at the end.
The easiest way is to use a List.map to extract the first elements
List.map premier_du_triplet
is a function that will take a list of 3-tuples and extract the first element of each.
then you can add the e element at the end using the "#" operator.
The more efficient and informative way would be to directly write a recursive function, say f that does just what you want.
When writing a recursive function, you need to ask yourself two things
what does it do in the simplest case (here, what does f [] do ?)
when you have a list in format head::tail, and you can already use f on the tail, what should you do to head and tail to obtain (f (head::tail)) ?
With this information, you should be able to write a recursive function that does what you want using pattern matching
here the simplest case is
| [] -> [e]
(you just add e at the end)
and the general case is
| h::t -> (premier_de_triplet h)::(f t)
I'm just a begginer in Ocaml, and I wanted to study the graph theory, but with implementations in Ocaml. And I've got a trouble to do something : I just wanted to list the connected components of a graph by using a Depth first search. So, I did :
#open "stack" ;;
let non_empty pile =
try push (pop pile) pile ; true with Empty -> false ;;
let connected_comp g =
let already_seen = make_vect (vect_length g) false in
let comp = [] in
let dfs s lst =
let totreat = new () in
already_seen.(s) <- true; push s totreat;
let rec add_neighbour l = match l with
| [] -> ()
| q::r when already_seen.(q) = false -> push q totreat; already_seen.(q) <- true; add_neighbour r
| q::r -> add_neighbour r
in
while non_empty totreat do
let s = pop totreat in
already_seen.(s) <- true;
(* we want to add s to the list lst *) s::lst;
add_neighbour g.(s);
done
in
let rec head_list l = match l with
| [] -> failwith "Empty list"
| p::q -> p
in
let rec aux comp t = match t with
| t when t = vect_length g -> comp
| t when already_seen.(t) = true -> aux comp (t+1)
| t -> aux ((dfs t [])::comp) (t+1) (* we want that dfs t [] return the list lst modified *)
in aux comp 0;;
And I obtain :
> | t -> (dfs t [])::comp ; aux comp (t+1) (* we want that dfs t [] return the list lst modified *)
> ^^^^^^^^^^^^^^^^
Warning : this expression is of type unit list,
but is used with the type unit.
connected_comp : int list vect -> unit list = <fun>
- : unit list = []
- : unit = ()
Of course, I'm not surprised. But what I want to do is that the function dfs return the list sent on argument (the lst list) but modified, and here it's not the case as the function is of type unit, cause it return nothing. But in Ocaml, as the language is made for returning the last expression I think, I don't know how to do. I could as well use recursive algorithm for the dfs function, as, through filtering, it would permit me to return the list, but I just wanted to learn about Ocaml, and so modified (even if it's not optimal) my algorithm.
Someone could help me, please ?
Edit : As we ask me, I will try to reduce my code and get to the point. So, I have the function dfs which correspond to a Depth first search (for a graph)
let dfs s lst =
let totreat = new () in
already_seen.(s) <- true; push s totreat;
let rec add_neighbour l = match l with
| [] -> ()
| q::r when already_seen.(q) = false -> push q totreat; already_seen.(q) <- true; add_neighbour r
| q::r -> add_neighbour r
in
while non_empty totreat do
let s = pop totreat in
already_seen.(s) <- true;
(* we want to add s to the list lst *) s::lst;
add_neighbour g.(s);
done
in
(alreadyseen is a vector of boolean, defined previously)
And my only problem is that I want that the function return the list lst modified (in the loop while), when, at this point, it's a unit function.
I tried to define lst as a reference, but then I don't know how to return it...
I hope it's more clear, I'm not familiar with all of this at the moment...
Thank you !
Here is a degraded version of your code that demonstrate one way to do what you want.
let non_empty _ = false
let dfs s lst =
let local_lst = ref lst in
while non_empty () do
(*do stuff here*)
let s = 1 in
local_lst := s::!local_lst;
(*do stuff here*)
done;
!local_lst
I first initialize a local mutable value local_lst to the list lst given as an argument. I then update this value in the while loop. And finally I return the value stored in local_lst.
I'm supposed to remove consecutive duplicates from an int list without using recursion and using only List.fold, map, filter, fold_left, fold_right.
I almost got it, but the problem with my code is that it checks if each element equals the 2nd element, and not the next element.
For example if let z = int list [3;1;4;5;5;1;1] my code will return [3;4;5] and not [3;1;4;5;1]. I'm not sure how to change it so filter uses a dynamically changing list parameter and not simply the original one (so it doesn't compare each element to the second element (1 in this case) each time):
let dupe (ls: int list) : int list =
List.filter (fun x -> if List.length ls = 0 then true else if x = List.hd (List.tl xs) then false else true) ls
The type of List.filter is this:
# List.filter;;
- : ('a -> bool) -> 'a list -> 'a list = <fun>
Notably, the filter function can see only one element of the list at a time. You need to see two consecutive elements to decide what to do, so I'd say List.filter won't do the job.
You're going to have to use map or one of the folds, I'd say. You can figure out which one(s) will work, with similar reasoning.
(I assume this is the sort of reasoning the assignment is supposed to illustrate. So I'm going to leave it there.)
Without rec
let remove = function
[] -> []
| x::tl ->
let (_,lxRes)=
List.fold_left (
fun (xPrec,lxRes) xCour ->
if xPrec=xCour then
(xCour,lxRes)
else
(xCour,lxRes#[xCour])
) (x+1,[]) (x::tl)
in
lxRes
Test:
# remove [3;1;4;5;5;1;1];;
- : int list = [3; 1; 4; 5; 1]
# remove [1;1];;
- : int list = [1]
# remove [1;1;1;1;2;2;3;4;5;5];;
- : int list = [1; 2; 3; 4; 5]
With rec (just for information)
let rec remove =
function
| [] -> []
| x::[] -> x::[]
| x::y::tl ->
if x=y then remove (y::tl)
else x::remove (y::tl)
Using just List.fold_left can be a little bit more concise than the previous answer. Of course, this will build up the list in reverse order, so we need to reverse the result.
let remove lst =
List.(
lst
|> fold_left
(fun acc x ->
match acc with
| [] -> [x]
| hd::_ when x = hd -> acc
| _ -> x::acc)
[]
|> rev
)
Of course, if you're not allowed to use List.rev we can reimplement it easily using List.fold_left, List.cons and Fun.flip.
let rev lst =
List.fold_left (Fun.flip List.cons) [] lst
This question uses the following "lazy list" (aka "stream") type:
type 'a lazylist = Cons of 'a * (unit -> 'a lazylist)
My question is: how to define a tail-recursive function lcycle that takes a non-empty (and non-lazy) list l as argument, and returns the lazylist corresponding to repeatedly cycling over the elements l. For example:
# ltake (lcycle [1; 2; 3]) 10;;
- : int list = [1; 2; 3; 1; 2; 3; 1; 2; 3; 1]
(ltake is a lazy analogue of List::take; I give one implementation at the end of this post.)
I have implemented several non-tail-recursive versions of lcycles, such as:
let lcycle l =
let rec inner l' =
match l' with
| [] -> raise (Invalid_argument "lcycle: empty list")
| [h] -> Cons (h, fun () -> inner l)
| h::t -> Cons (h, fun () -> inner t)
in inner l
...but I have not managed to write a tail-recursive one.
Basically, I'm running into the problem that lazy evaluation is implemented by constructs of the form
Cons (a, fun () -> <lazylist>)
This means that all my recursive calls happen within such a construct, which is incompatible with tail recursion.
Assuming the lazylist type as defined above, is it possible to define a tail-recursive lcycle? Or is this inherently impossible with OCaml?
EDIT: My motivation here is not to "fix" my implementation of lcycle by making it tail-recursive, but rather to find out whether it is even possible to implement a tail recursive version of lcycle, given the definition of lazylist above. Therefore, pointing out that my lcycle is fine misses what I'm trying to get at. I'm sorry I did not make this point sufficiently clear in my original post.
This implementation of ltake, as well as the definition of the lazylist type above, comes from here:
let rec ltake (Cons (h, tf)) n =
match n with
0 -> []
| _ -> h :: ltake (tf ()) (n - 1)
I don't see much of a problem with this definition. The call to inner is within a function which won't be invoked until lcycle has returned. Thus there is no stack safety issue.
Here's an alternative which moves the empty list test out of the lazy loop:
let lcycle = function
| [] -> invalid_arg "lcycle: empty"
| x::xs ->
let rec first = Cons (x, fun () -> inner xs)
and inner = function
| [] -> first
| y::ys -> Cons (y, fun () -> inner ys) in
first
The problem is that you're trying to solve a problem that doesn't exist. of_list function will not take any stack space, and this is why lazy lists are so great. Let me try to explain the process. When you apply of_list function to a non empty list, it creates a Cons of the head of the list and a closure, that captures a reference to the tail of the list. Afterwards it momentary returns. Nothing more. So it takes only few words of memory, and none of them uses stack. One word contains x value, another contains a closure, that captures only a pointer to the xs.
So then, you deconstruct this pair, you got the value x that you can use right now, and function next, that is indeed the closure that, when invoked, will be applied to a list and if it is nonempty, will return another Cons. Note, that previous cons will be already destroyed to junk, so new memory won't be used.
If you do not believe, you can construct an of_list function that will never terminate (i.e., will cycle over the list), and print it with a iter function. It will run for ever, without taking any memory.
type 'a lazylist = Cons of 'a * (unit -> 'a lazylist)
let of_list lst =
let rec loop = function
| [] -> loop lst
| x :: xs -> Cons (x, fun () -> loop xs) in
loop lst
let rec iter (Cons (a, next)) f =
f a;
iter (next ()) f