When I compile my code is ok, but when I call and execute the function Quicksort, the program seems to be in infinite loop. What Can I do ?
I tested all the functions, but it seems the problem is in tQuicksort function.
I'm a beginner.
let h l =
match l with
| [] -> raise (Failure "head")
| x::xs -> x;;
let t l =
match l with
| [] -> raise (Failure "tail")
| x::xs -> xs;;
let rec trev l r =
match l with
| [] -> r
| x::xs -> trev xs (x::r);;
let rev l = trev l [];;
let rec tunir l1 l2 r =
match l1 with
| [] -> if l2 == [] then
rev r
else
tunir [] (t l2) ((h l2)::r)
| x1::xs1 -> tunir xs1 l2 (x1::r);;
let unir l1 l2 = tunir l1 l2 [];;
let rec tpart x l l1 l2 =
match l with
| [] -> if l1 == [] then
((x::[]), l2)
else
(l1, (x::l2))
| (lx:: lxs) -> if (h l) <= x then
tpart x (t l) ((h l)::l1) l2
else
tpart x (t l) l1 ((h l)::l2);;
let part x l = tpart x l [] [];;
let rec tnroelem l n =
match l with
| [] -> n
| x::xs -> tnroelem (t l) (n+1);;
let nroelem l = tnroelem l 0;;
let rec tunirL l r =
match l with
| [] -> rev r
| lx::lxs -> if lx == [] then tunirL lxs r
else tunirL((t lx)::lxs) ((h lx)::r);;
let unirL l = tunirL l [];;
let rec tquicksort lm l lM =
match l with
| [] -> unirL (unir (rev lm) lM)
| lx::lxs -> let (la, lb) = part (h l) (t l) in
if (nroelem la < nroelem lb) then tquicksort ((quicksort la)::lm) lb lM
else tquicksort lm la ((quicksort lb)::lM)
and quicksort l = tquicksort [] l [];;
let rec geraListaT n l =
if n == 0 then l
else geraListaT (n-1) (n::l);;
let geraLista n = geraListaT n [];;
let lista : int list = geraLista 9;;
List.iter (fun x->print_int x) (quicksort lista)
You are missing a case when you're attempting to quicksort lm l lM and l only has one element. In that case the branch taken is
| lx::lxs -> let (la, lb) = part (h l) (t l) in
if (nroelem la < nroelem lb)
then tquicksort ((quicksort la)::lm) lb lM
else tquicksort lm la ((quicksort lb)::lM)
And then no matter what the result of the if is, you perform a recursive call quicksort lm' l' lM' where l' also has only one element. This can be fixed by adding an extra case after the one for the empty list:
| lx::[] -> unirL (unir (rev (l :: lm)) lM)
Related
Write with OCaml Longest Common Sottosequence (Deep Search)
Consider a finite set S of strings and an integer K. Determine, if it exists, a string x of length greater than or equal to K subsequence of each string s∈S. The problem is solved by using an in-depth search.
I tried it with two strings without k, it works!
this bellow is my code:
(*trasfmorm string in list char*)
let explode s =
let rec exp i l =
if i < 0 then l
else exp (i - 1) (s.[i] :: l)
in
exp (String.length s - 1) []
(*print list of strings*)
let rec print_list_strings = function
| [] -> ()
| e::l ->
print_string e;
print_string "\n";
print_list_strings l
(*print list of char*)
let rec print_list_char = function
| [] -> print_string "\n"
| e::l ->
print_char e;
print_string " ";
print_list_char l
(*between the lists tell me which one is longer*)
let longest xs ys =
if List.length xs > List.length ys then xs
else ys
(*lcs deep*)
let rec lcs a b =
match a, b with
| [], _ | _, [] -> []
| x::xs, y::ys ->
if x = y then
x :: lcs xs ys
else
longest (lcs a ys) (lcs xs b)
(*
On input: "ABCBDAB", "ABCBDAB"
The LCS returned is "BDAB"
*)
let a = "ABCBDAB";;
let b = "ABCBDAB";;
let a = explode a;;
let b = explode b;;
print_list_char (lcs a b);;
But when I start to find the solution for s strings it seems impossible.
For the moment i write the code bellow:
(* function return n-elemt of a list *)
exception Nth
let rec nth n lista =
match (n, lista) with
| (_, []) -> raise Nth
| (0, t::_) -> t
| (n, t::c) -> nth (n-1) c;;
(* functione given input list of char output string *)
let rendi_stringa s =
String.of_seq (List.to_seq s)
(* delete first n-element of a string *)
let rec drop n = function
| [] -> []
| x::xs ->
if n <= 0 then x::xs
else drop (n-1) xs ;;
(*string into a char list*)
let explode s =
let rec exp i l =
if i < 0 then l
else exp (i - 1) (s.[i] :: l)
in
exp (String.length s - 1) []
(*read k-elemt and return a list*)
let rec leggi k =
if k=0 then []
else
let x = read_line() in
(x) :: leggi (k-1)
(*print element list*)
let rec print_list = function
| [] -> ()
| e::l ->
print_string e;
print_string "\n";
print_list l
(*funzione lista string esplosa--> lista di lista*)
let rec explode_list n lista =
if n = 0 then []
else
let x = List.hd lista in
[(explode x)] # explode_list (n-1) (List.tl lista)
(*n-esima raw e m-column of matrix*)
let pos tabla n m =
let lista = (List.nth tabla n) in
List.nth lista m;;
let subset tabella n =
let rec aux solution tot = function
| [] ->
if tot > 0 then raise NotFound
else solution
| x::rest ->
print_string x;
print_string "\n";
aux (x::solution) (tot-1) rest
in
aux [] n tabella
let subset tabella n =
let rec aux solution = function
| [] ->
if List.length solution < n then raise NotFound
else solution
| x::rest -> nuova_funzione (explode x) rest n
in
aux [] n tabella
let nuova_funzione lista_char lista_string n = function
| _, [] -> print_string "non posso piu fare niente, stringhe finite\n"
| [], _ -> print_string "ho finito confronto con la lista\n"
| [] , x::lt ->
if (lcs lista_char (explode x)) > n then
else
let longest xs ys =
if List.length xs > List.length ys then xs
else ys
(*lcs profonda*)
let rec lcs a b =
match a, b with
| [], _ | _, [] -> []
| x::xs, y::ys ->
if x = y then
x :: lcs xs ys
else
longest (lcs a ys) (lcs xs b)
(**)
(*let rec lcs stringhe num = function
| []
| List.length stringhe < num -> []
| *)
(*------------------------main--------------*)
print_string "how many strings?\n";;
let m = read_int();;
print_string "please write your strings\n";;
let lista = leggi m;;
print_string "strings wrote\n";;
print_list lista;;
explode (nth 0 c);;
let a = "ABCBDAB";;
let a = explode a;;
let b = "BDCABA";;
let b = explode b;;
let c = "BADACB";;
let c = explode c;;
My idea was to use Backtracking, but i'm stuck with logical idea, I have no idea to implement it even with pseudocode!
Any idea or advise?
This question already has answers here:
transpose of a list of lists
(3 answers)
Closed 12 months ago.
I'd like to write a function in OCaml, using only recursivity that can transform any list of list that look like: [[a1;...;an];[b1;...bn];...;[z1;...;zn]] into [[a1;b1;...;z1];...;[an;...;zn]] what I've done so far is quite complex, I insert element by element reconstructing a new list every time ... and I'm sure there is a simpler way ...
My code so far:
let inserer l e i =
let rec aux l e i j =
match l with
| [] -> failwith "erreur position inexistante"
| t::q when j = i ->
if List.length t = 0 then
[e]::q
else
let t1 = List.hd t in
let q1 = List.tl t in
let l1 = t1::e::q1 in
l1::q
| t::q -> t::(aux q e i (j+1))
in
aux l e i 0
let inserer_liste b m =
let rec aux b m i =
match b with
| [] -> m
| t::q ->
let tmp = inserer m t i in
aux q tmp (i+1)
in
aux b m 0
let transform u n =
let rec aux u m =
match u with
| []-> m
| b::q ->
let tmp = inserer_liste b m in
aux q tmp
in
aux u (List.init n (fun _ -> []))
let u = [[1;2;3]; [4;5;6]; [7;8;9]]
let l = transform u 3
I have a feeling that this transformation is way more natural if you transform an array of lists into a lists of arrays. You can transform into a list of lists afterwards.
let rec f a =
match a.(0) with
| [] -> []
| _ :: _ ->
let hd = Array.map List.hd a in
for i = 0 to Array.length a - 1 do
a.(i) <- List.tl a.(i)
done ;
hd :: (f a)
This consumes the input array, which can be solved by shadowing f in the following way :
let f a = f (Array.copy a)
let f_list l = List.map Array.to_list (f (Array.of_list l))
You could also reallocate a new array at each recursive call, but that would be slower, without any upside except maybe a bit nicer code.
f_list is more elegant this way :
let f_list l =
l |> Array.of_list |> f |> List.map Array.to_list
There is no error handling in my code : it assumes all list have the same length, but it should be to hard to add it.
Is there a simple way... Not that I know of but that doesn't say much.
Here's something I tried.
let lol =
[
[ 1; 2; 3; 4; ];
[ 5; 6; 7; 8; ];
[ 9; 10; 11; 12; ];
]
let ans =
List.fold_left
(
fun a e ->
match a with
| [] -> List.fold_right (fun e a -> [e]::a) e a
| _ -> List.fold_right2 (fun b c acc -> (c # [b])::acc) e a []
)
[]
lol
let () =
List.iter
(
fun l ->
List.iter (fun x -> Printf.printf "%d " x) l;
print_newline()
)
ans
After some thought I cam up with this
let lol =
[
[11; 12; 13; 14; 15; 16; 17; 18; 19; ];
[21; 22; 23; 24; 25; 26; 27; 28; 29; ];
[31; 32; 33; 34; 35; 36; 37; 38; 39; ];
[41; 42; 43; 44; 45; 46; 47; 48; 49; ];
]
let rec transpose ll =
match ll with
| [] -> []
| l -> (List.map List.hd l)::
(
try
transpose (List.map List.tl l)
with
| _ -> []
)
let ans = transpose lol
let () =
List.iter
(
fun l -> List.iter (fun x -> Printf.printf "%d " x) l; print_newline()
)
ans
I have to make a function that take a list and return the list but without the elements betweens the occurences.
For example: [1; 2; 3; 4; 2; 7; 14; 21; 7; 5] -> [1; 2; 7; 5]
I imagined that to make this I will take the head of the list, and then see
if there is another occurrence in the tail, so I browse the list and when I found the occurrence, I delete everything between them and I keep just one of them.
First I tried something like this:
let rec remove list = match list with
| [] -> []
| h::t -> if(List.mem h t) then
(*Here I would like to go through the list element by element to
find the occurence and then delete everything between*)
else
remove t
So for the part I don't succeed to do, I made a function which allows to slice a list between two given points, just like so:
let slice list i k =
let rec take n = function
| [] -> []
| h :: t -> if n = 0 then [] else h :: take (n-1) t
in
let rec drop n = function
| [] -> []
| h :: t as l -> if n = 0 then l else drop (n-1) t
in
take (k - i + 1) (drop i list);;
(*Use: slice ["a";"b";"c";"d";"e";"f";"g";"h";"i";"j"] 2 3;;*)
I also have this function that allows me to get the index of points in the list:
let index_of e l =
let rec index_rec i = function
| [] -> raise Not_found
| hd::tl -> if hd = e then i else index_rec (i+1) tl
in
index_rec 0 l ;;
(*Use: index_of 5 [1;2;3;4;5;6] -> return 4*)
But I don't really know how to combine them to get what I expect.
here is what I made :
let rec remove liste =
let rec aux l el = match l with
| [] -> raise Not_found
| x :: xs -> if el = x then try aux xs el with Not_found -> xs
else aux xs el in
match liste with
| [] -> []
| x :: xs -> try let r = x :: aux xs x in remove r with Not_found -> x :: remove xs;;
my aux function return the list which follow the last occurence of el in l. If you have any question or if you need more explanation just ask me in comment
A version that uses an option type to tell if an element appears further on in the list:
let rec find_tail ?(eq = (=)) lst elem =
match lst with
| x :: _ when eq x elem -> Some lst
| _ :: xs -> find_tail ~eq xs elem
| [] -> None
let rec remove ?(eq = (=)) lst =
match lst with
| [x] -> [x]
| x :: xs -> begin
match find_tail ~eq xs x with
| Some tail -> x :: remove ~eq (List.tl tail)
| None -> x :: remove ~eq xs
end
| [] -> []
Also lets you specify a comparison function (Defaulting to =).
I have a list like:
let lst = ["cat"; "dog"; "cow"; "dog"; "cat"; "horse"; "dog"];;
I want to count the number of same elements and have the output in a list of tuples (element, count) like:
[("cat", 2); ("dog", 3); ("cow", 1); ("horse", 1)]
I tried using List.fold_left but found that the folding function will be complex. Any suggestion?
If you don't care about performance, then it can be like this:
let count_dup l =
let scan_count x l = List.fold_left (fun (c,acc) y -> if x = y then c+1,acc else c,y::acc) (1,[]) l in
let rec count acc = function
| [] -> List.rev acc
| hd::tl -> let c,r = scan_count hd tl in count ((hd,c)::acc) r
in
count [] l
If you care about performance, but don't care about the order, then it is better that you sort the list first, then scan once.
let count_dup' l =
let sl = List.sort compare l in
match sl with
| [] -> []
| hd::tl ->
let acc,x,c = List.fold_left (fun (acc,x,c) y -> if y = x then acc,x,c+1 else (x,c)::acc, y,1) ([],hd,1) tl in
(x,c)::acc
let count l =
let hash = Hashtbl.create 10 in
List.iter (fun key -> if Hashtbl.mem hash key then Hashtbl.replace hash key ((Hashtbl.find hash key) + 1) else Hashtbl.add hash key 1) l;
Hashtbl.fold (fun k v ls -> (k, v) :: ls) hash []
A way to preserve order and performance:
let count lst =
let sorted = List.sort (compare) lst in
List.fold_right (fun ele acc -> match acc with
| [] -> [(ele, 1)]
| (ele', c)::t ->
if ele = ele'
then (ele, c+1)::t
else (ele,1)::(ele',c)::t) sorted []
The non-tail-recursive combinations function can be written like this:
let rec combinations l k =
if k <= 0 || k > List.length l then []
else if k = 1 then List.map (fun x -> [x]) l
else
let hd, tl = List.hd l, List.tl l in
combinations tl k |> List.rev_append (List.map (fun x -> hd::x) (combinations tl (k-1)))
Note that I use List.rev_append to at least given the append a tail recursive version
It means generate all the combinations if you want to get k elements out of the list.
I am just wondering is it possible to create a total tail-recursive version of combinations?
You could use continuation passing style:
let combos l k =
let rec aux l k cont =
if k <= 0 || k > List.length l then cont []
else if k = 1 then cont (List.map (fun x -> [x]) l)
else
let hd, tl = List.hd l, List.tl l in
aux tl k
(
fun res1 -> aux tl (k-1)
(
fun res2 -> cont (List.rev_append (List.map (fun x -> hd::x) res2) res1)
)
)
in aux l k (fun x -> x)
This way, you avoid calling something after the recursive call of aux at the price of creating an anonymous function that accounts for the "future computation" that shall be done after the "original recursive call".
Usually we do continuations-passing-style, as in phimuemue's answer. E.g.
let rec prefix_cps tree k =
match tree with
| Tip -> k []
| Node (left,n,right) ->
prefix_cps left (fun nleft ->
prefix_cps right (fun nright ->
k (n :: nleft # nright)))
let prefix_cps t = prefix_cps t (fun l -> l)
However, sometimes we can rearrange the input on the fly:
let rec prefix_tr t =
let rec loop queue = function
| Tip -> queue
| Node (l, n, Tip) -> loop (n::queue) l
| Node (l, k, Node (rl, n, rr)) ->
loop queue (Node (Node (l, k, rl), n, rr)) in
loop [] t