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
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?
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 =).
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)
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 []
One more question about most elegant and simple implementation of element combinations in F#.
It should return all combinations of input elements (either List or Sequence).
First argument is number of elements in a combination.
For example:
comb 2 [1;2;2;3];;
[[1;2]; [1;2]; [1;3]; [2;2]; [2;3]; [2;3]]
One less concise and more faster solution than ssp:
let rec comb n l =
match n, l with
| 0, _ -> [[]]
| _, [] -> []
| k, (x::xs) -> List.map ((#) [x]) (comb (k-1) xs) # comb k xs
let rec comb n l =
match (n,l) with
| (0,_) -> [[]]
| (_,[]) -> []
| (n,x::xs) ->
let useX = List.map (fun l -> x::l) (comb (n-1) xs)
let noX = comb n xs
useX # noX
There is more consise version of KVB's answer:
let rec comb n l =
match (n,l) with
| (0,_) -> [[]]
| (_,[]) -> []
| (n,x::xs) ->
List.flatten [(List.map (fun l -> x::l) (comb (n-1) xs)); (comb n xs)]
The accepted answer is gorgeous and quickly understandable if you are familiar with tree recursion. Since elegance was sought, opening this long dormant thread seems somewhat unnecessary.
However, a simpler solution was asked for. Iterative algorithms sometimes seem simpler to me. Furthermore, performance was mentioned as an indicator of quality, and iterative processes are sometimes faster than recursive ones.
The following code is tail recursive and generates an iterative process. It requires a third of the amount of time to compute combinations of size 12 from a list of 24 elements.
let combinations size aList =
let rec pairHeadAndTail acc bList =
match bList with
| [] -> acc
| x::xs -> pairHeadAndTail (List.Cons ((x,xs),acc)) xs
let remainderAfter = aList |> pairHeadAndTail [] |> Map.ofList
let rec comboIter n acc =
match n with
| 0 -> acc
| _ ->
acc
|> List.fold (fun acc alreadyChosenElems ->
match alreadyChosenElems with
| [] -> aList //Nothing chosen yet, therefore everything remains.
| lastChoice::_ -> remainderAfter.[lastChoice]
|> List.fold (fun acc elem ->
List.Cons (List.Cons (elem,alreadyChosenElems),acc)
) acc
) []
|> comboIter (n-1)
comboIter size [[]]
The idea that permits an iterative process is to pre-compute a map of the last chosen element to a list of the remaining available elements. This map is stored in remainderAfter.
The code is not concise, nor does it conform to lyrical meter and rhyme.
A naive implementation using sequence expression. Personally I often feel sequence expressions are easier to follow than other more dense functions.
let combinations (k : int) (xs : 'a list) : ('a list) seq =
let rec loop (k : int) (xs : 'a list) : ('a list) seq = seq {
match xs with
| [] -> ()
| xs when k = 1 -> for x in xs do yield [x]
| x::xs ->
let k' = k - 1
for ys in loop k' xs do
yield x :: ys
yield! loop k xs }
loop k xs
|> Seq.filter (List.length >> (=)k)
Method taken from Discrete Mathematics and Its Applications.
The result returns an ordered list of combinations stored in arrays.
And the index is 1-based.
let permutationA (currentSeq: int []) (n:int) (r:int): Unit =
let mutable i = r
while currentSeq.[i - 1] = n - r + i do
i <- (i - 1)
currentSeq.[i - 1] <- currentSeq.[i - 1] + 1
for j = i + 1 to r do
currentSeq.[j - 1] <- currentSeq.[i - 1] + j - i
()
let permutationNum (n:int) (r:int): int [] list =
if n >= r then
let endSeq = [|(n-r+1) .. n|]
let currentSeq: int [] = [|1 .. r|]
let mutable resultSet: int [] list = [Array.copy currentSeq];
while currentSeq <> endSeq do
permutationA currentSeq n r
resultSet <- (Array.copy currentSeq) :: resultSet
resultSet
else
[]
This solution is simple and helper function costs constant memory.
My solution is less concise, less effective (altho, no direct recursion used) but it trully returns all combinations (currently only pairs, need to extend filterOut so it can return a tuple of two lists, will do little later).
let comb lst =
let combHelper el lst =
lst |> List.map (fun lstEl -> el::[lstEl])
let filterOut el lst =
lst |> List.filter (fun lstEl -> lstEl <> el)
lst |> List.map (fun lstEl -> combHelper lstEl (filterOut lstEl lst)) |> List.concat
comb [1;2;3;4] will return:
[[1; 2]; [1; 3]; [1; 4]; [2; 1]; [2; 3]; [2; 4]; [3; 1]; [3; 2]; [3; 4]; [4; 1]; [4; 2]; [4; 3]]
Ok, just tail combinations little different approach (without using of library function)
let rec comb n lst =
let rec findChoices = function
| h::t -> (h,t) :: [ for (x,l) in findChoices t -> (x,l) ]
| [] -> []
[ if n=0 then yield [] else
for (e,r) in findChoices lst do
for o in comb (n-1) r do yield e::o ]