Operations on contiguous elements in F# [duplicate] - list

I need to extract the sequence of equal chars in a text.
For example:
The string "aaaBbbcccccccDaBBBzcc11211" should be converted to a list of strings like
["aaa";"B";"bb";"ccccccc";"D";"a";"BBB";"z";"cc";"11";"2";"11"].
That's my solution until now:
let groupSequences (text:string) =
let toString chars =
System.String(chars |> Array.ofList)
let rec groupSequencesRecursive acc chars = seq {
match (acc, chars) with
| [], c :: rest ->
yield! groupSequencesRecursive [c] rest
| _, c :: rest when acc.[0] <> c ->
yield (toString acc)
yield! groupSequencesRecursive [c] rest
| _, c :: rest when acc.[0] = c ->
yield! groupSequencesRecursive (c :: acc) rest
| _, [] ->
yield (toString acc)
| _ ->
yield ""
}
text
|> List.ofSeq
|> groupSequencesRecursive []
groupSequences "aaaBbbcccccccDaBBBzcc11211"
|> Seq.iter (fun x -> printfn "%s" x)
|> ignore
I'm a F# newbie.
This solution can be better?

Here a completely generic implementation:
let group xs =
let folder x = function
| [] -> [[x]]
| (h::t)::ta when h = x -> (x::h::t)::ta
| acc -> [x]::acc
Seq.foldBack folder xs []
This function has the type seq<'a> -> 'a list list when 'a : equality, so works not only on strings, but on any (finite) sequence of elements, as long as the element type supports equality comparison.
Used with the input string in the OP, the return value isn't quite in the expected shape:
> group "aaaBbbcccccccDaBBBzcc11211";;
val it : char list list =
[['a'; 'a'; 'a']; ['B']; ['b'; 'b']; ['c'; 'c'; 'c'; 'c'; 'c'; 'c'; 'c'];
['D']; ['a']; ['B'; 'B'; 'B']; ['z']; ['c'; 'c']; ['1'; '1']; ['2'];
['1'; '1']]
Instead of a string list, the return value is a char list list. You can easily convert it to a list of strings using a map:
> group "aaaBbbcccccccDaBBBzcc11211" |> List.map (List.toArray >> System.String);;
val it : System.String list =
["aaa"; "B"; "bb"; "ccccccc"; "D"; "a"; "BBB"; "z"; "cc"; "11"; "2"; "11"]
This takes advantage of the String constructor overload that takes a char[] as input.
As initially stated, this implementation is generic, so can also be used with other types of lists; e.g. integers:
> group [1;1;2;2;2;3;4;4;3;3;3;0];;
val it : int list list = [[1; 1]; [2; 2; 2]; [3]; [4; 4]; [3; 3; 3]; [0]]

How about with groupby
"aaaBbbcccccccD"
|> Seq.groupBy id
|> Seq.map (snd >> Seq.toArray)
|> Seq.map (fun t -> new string (t))
If you input order matters, here is a method that works
"aaaBbbcccccccDaBBBzcc11211"
|> Seq.pairwise
|> Seq.toArray
|> Array.rev
|> Array.fold (fun (accum::tail) (ca,cb) -> if ca=cb then System.String.Concat(accum,string ca)::tail else string(ca)::accum::tail) (""::[])

This one is also based on recursion though the matching gets away with smaller number of checks.
let chop (txt:string) =
let rec chopInner txtArr (word: char[]) (res: List<string>) =
match txtArr with
| h::t when word.[0] = h -> chopInner t (Array.append word [|h|]) res
| h::t when word.[0] <> h ->
let newWord = word |> (fun s -> System.String s)
chopInner t [|h|] (List.append res [newWord])
| [] ->
let newWord = word |> (fun s -> System.String s)
(List.append res [newWord])
let lst = txt.ToCharArray() |> Array.toList
chopInner lst.Tail [|lst.Head|] []
And the result is as expected:
val text : string = "aaaBbbcccccccDaBBBzcc11211"
> chop text;;
val it : string list =
["aaa"; "B"; "bb"; "ccccccc"; "D"; "a"; "BBB"; "z"; "cc"; "11"; "2"; "11"]

When you're folding, you'll need to carry along both the previous value and the accumulator holding the temporary results. The previous value is wrapped as option to account for the first iteration. Afterwards, the final result is extracted and reversed.
"aaaBbbcccccccDaBBBzcc11211"
|> Seq.map string
|> Seq.fold (fun state ca ->
Some ca,
match state with
| Some cb, x::xs when ca = cb -> x + ca::xs
| _, xss -> ca::xss )
(None, [])
|> snd
|> List.rev
// val it : string list =
// ["aaa"; "B"; "bb"; "ccccccc"; "D"; "a"; "BBB"; "z"; "cc"; "11"; "2"; "11"]

Just interesting why everyone publishing solutions based on match-with? Why not go plain recursion?
let rec groups i (s:string) =
let rec next j = if j = s.Length || s.[i] <> s.[j] then j else next(j+1)
if i = s.Length then []
else let j = next i in s.Substring(i, j - i) :: (groups j s)
"aaaBbbcccccccDaBBBzcc11211" |> groups 0
val it : string list = ["aaa"; "B"; "bb"; "ccccccc"; "D"; "a"; "BBB"; "z"; "cc"; "11"; "2"; "11"]

As someone other here:
Know thy fold ;-)
let someString = "aaaBbbcccccccDaBBBzcc11211"
let addLists state elem =
let (p, ls) = state
elem,
match p = elem, ls with
| _, [] -> [ elem.ToString() ]
| true, h :: t -> (elem.ToString() + h) :: t
| false, h :: t -> elem.ToString() :: ls
someString
|> Seq.fold addLists ((char)0, [])
|> snd
|> List.rev

Related

OCaml Longest common sequences (deep search)

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?

How to transform this int list list to a math expression containing + and *?

Given this list :
let mylist = [[1;2;3];[4];[5];[6];[7];[8;9]]
I need to transform it to : "1*2*3+4+5+6+7+8*9"
This is the solution I came up with :
let rec printexpr = function
| [] -> ""
| [x] -> print_inner_list x
| x::t -> print_inner_list x ^ "+" ^printexpr t
and print_inner_list = function
| [] -> ""
| [x] -> string_of_int x
| x::y -> string_of_int x ^ "*" ^ print_inner_list y
I'd like to come up with another solution that is shorter using String.concat and List.concat (if necessary).
My "idea" is to use
String.concat "+" mylist
So that it "becomes" something like this :
[[1;2;3]+[4]+[5]+[6]+[7]+[8;9]]
and then call String.concat "*" on the inner list of length >=2
so I get this :
[[1*2*3]+[4]+[5]+[6]+[7]+[8*9]]
And List.concat to get 1*2*3+4+5+6+7+8*9
But this is not how string.concat works, so I'm not sure how to implement this
EDIT : NEW SOLUTION
let rec convertListToString = function
| [] -> []
| x::y -> [List.map string_of_int x] # convertListToString y
let mylist = [[1;2;3];[4];[5];[6];[7];[8;9]]
let _ = String.concat "+" (List.concat (List.map (fun x -> [String.concat "*" x ]) (convertListToString test)))
(* STEP BY STEP *)
(* [[1; 2; 3]; [4]; [5]; [6]; [7]; [8; 9]] *)
(convertListToString mylist)
(* string list list =
[["1"; "2"; "3"]; ["4"]; ["5"]; ["10"; "11"]; ["6"]; ["7"]; ["8"; "9"]] *)
List.map (fun x -> [String.concat "*" x ]) (convertListToString mylist);;
(* string list list = [["1*2*3"]; ["4"]; ["5"]; ["6"]; ["7"]; ["8*9"]] *)
(List.concat (List.map (fun x -> [String.concat "*" x ]) (convertListToString mylist)));;
(* string list = ["1*2*3"; "4"; "5"; "6"; "7"; "8*9"] *)
String.concat "+" (List.concat (List.map (fun x -> [String.concat "*" x ]) (convertListToString mylist)))
(* string = "1*2*3+4+5+6+7+8*9" *)
EDIT2 : NEW SOLUTION
let rec convertListToString = function
| [] -> []
| x::y -> string_of_int x :: convertListToString y
let mylist = [[1;2;3];[4];[5];[10;11];[6];[7];[8;9]]
let _ = String.concat "+" (List.map (fun x -> String.concat "*" (convertListToString x)) mylist)
One possibility for printing complex data types is to use the Format module
which has one built-in combinator pp_print_list that creates a printer for a list of elements from a printer for one element.
(* Format names are a bit too verbose *)
let int, list = Format.(pp_print_int, pp_print_list)
(* The separator will be either "+" or "*" *)
let const x ppf () = Format.fprintf ppf x
let factor ppf l =
(* a factor is a list of int separated by a "*" *)
list ~pp_sep:(const "*") int ppf l
let expr ppf l =
(*an expression is a list of factors separated by "+"*)
list ~pp_sep:(const "+") factor ppf l
Then it is possible to use Format.asprintf to build a string from this printer:
let s = Format.asprintf "%a" expr [[1;2;3];[4];[5];[6];[7];[8;9]]
Say you have a function soi that changes an int to a string. Then you can use List.map to map this function over a list of ints, thus changing a list of ints into a list of strings. So you have a function that changes a list of ints to a list of strings.
If you compose this function with String.concat you have a function that changes a list of ints into a string. (You can use "+" as your separator.)
If you map this function over your original input, you end up with a list of strings.
So you have a function that changes a list of list of int into a list of string.
If you compose this function with String.concat you end up with one string. (You can use "*" as your separator.)
You can use String.concat to join strings and List.map to change the lists into string lists:
let mylist = [[1;2;3];[4];[5];[6];[7];[8;9]];;
let f xs =
String.concat
"+"
(List.map
(fun x -> String.concat
"*"
(List.map (fun i -> string_of_int i) x))
xs);;
# f mylist;;
- : string = "1*2*3+4+5+6+7+8*9"
You can also write this using some higher order helper functions:
let mylist = [[1;2;3];[4];[5];[6];[7];[8;9]]
let convcat sep conv xs = String.concat sep (List.map conv xs)
let convplus = convcat "+" string_of_int
let convmul = convcat "*" convplus
let res = convmul mylist;;
val mylist : int list list = [[1; 2; 3]; [4]; [5]; [6]; [7]; [8; 9]]
val convcat : string -> ('a -> string) -> 'a list -> string = <fun>
val convplus : int list -> string = <fun>
val convmul : int list list -> string = <fun>
val res : string = "1+2+3*4*5*6*7*8+9"

Convert a char list list into a char string list in OCAML

I have an example:
val lst1 : char list list =
[['l'; 'a'; 'n'; 'e']; ['p'; 'l'; 'a'; 'n'; 'e'; 't']; ['m'; 'o'; 'o'; 't'];
[]; []; ['s'; 'm'; 'o'; 'o'; 't'; 'h']; ['h'; 'a'; 'n'; 'g']; [];
[]; ['c'; 'h'; 'a'; 'n'; 'g'; 'e']; ['w'; 'e'; 'n'; 't']; []; []; etc.]
What is a trick to convert this list into something like:
["lane";"planet";...]?
Thank you.
Here is a very compact implementation:
let to_str_list =
List.map (fun cs -> String.concat "" (List.map (String.make 1) cs))
It looks like this when your call it:
# to_str_list [['h';'e';'l';'l';'o'];['w';'o';'r';'l';'d']];;
- : string list = ["hello"; "world"]
Update
If you want to suppress empty strings at the outer level you can do something like this:
let to_str_list css =
List.map (fun cs -> String.concat "" (List.map (String.make 1) cs)) css |>
List.filter ((<>) "")
It looks like this when you call it:
# to_str_list [['h';'e';'l';'l';'o']; []; ['w';'o';'r';'l';'d']];;
- : string list = ["hello"; "world"]
This should do it,
let to_string l =
let rec loop buf = function
| [] -> Buffer.contents buf
| x :: tl -> Buffer.add_char buf x; loop buf tl
in
loop (Buffer.create 100) l
let to_str_lst l = List.map to_string l
Alternate version of to_string without rec -
let to_string l =
List.fold_left
(fun acc e -> Buffer.add_char acc e; acc)
(Buffer.create 100)
l
|> Buffer.contents
Sample usage in utop:
to_str_lst [['h';'e';'l';'l';'o']; ['w';'o';'r';'l';'d']];;
returns
- : string list = ["hello"; "world"]

How to take product of two list in OCaml?

I have two lists :
let a = ["a";"b"];
let b = ["c";"d"];
I want an output list c such as :
c = ["a";"c";"a";"d";"b";"c";"b";"d"];
How to do it in ocaml as lists are immutable? I am new to it.
You would return a new list. If you really are interested in the cartesian product of the lists, then this should be enough:
let cartesian l l' =
List.concat (List.map (fun e -> List.map (fun e' -> (e,e')) l') l)
# cartesian ["a";"b"] ["c";"d"];;
- : (string * string) list = [("a", "c"); ("a", "d"); ("b", "c"); ("b", "d")]
If you need that strange flat structure instead, you can use an additional list concatenation.
let flat_cartesian l l' =
List.concat (List.concat (
List.map (fun e -> List.map (fun e' -> [e;e']) l') l))
If you do not want to use concatenation, because this is not a tail recursive operation, you can use the following (which should be more efficient):
let product l1 l2 =
List.rev (
List.fold_left
(fun x a ->
List.fold_left
(fun y b ->
b::a::y
)
x
l2
)
[]
l1
)
;;
For the cartesian product, just change
b::a::y
into
(a,b)::y
I would break the problem into two sub problems:
Firstly consider a function appendeach with takes a value and a list and returns the result of adding that value infront of each item in the list
let rec appendeach x lst = match lst with [] -> []
| hd::tl -> x::hd::(appendeach x tl);;
Then consider a function product with takes two lists and calls appendeach for each item in the first list and the whole second list
let rec product lst1 lst2 = match lst1 with [] -> [] |
hd::tl -> (appendeach hd lst2)#(product tl lst2);;
Here's an implementation for any number of lists, based on Python's itertools.product.
The lists all have to be the same type, because the products we return will themselves be (necessarily homogenous) lists.
let product pools =
let result = ref [[]] in
List.iter (fun pool ->
result := List.concat_map (fun y ->
List.map (fun x ->
List.append x [y]
) !result
) pool
) pools;
!result
product [["a";"b"]; ["1";"2"]; ["$";"%"]];;
- : string list list =
[["a"; "1"; "$"]; ["b"; "1"; "$"]; ["a"; "2"; "$"]; ["b"; "2"; "$"];
["a"; "1"; "%"]; ["b"; "1"; "%"]; ["a"; "2"; "%"]; ["b"; "2"; "%"]]
If you then need a flattened list you can wrap it in List.concat as per the other answers:
List.concat (product [["a";"b"]; ["1";"2"]]);;
- : string list = ["a"; "1"; "b"; "1"; "a"; "2"; "b"; "2"]
A very imperative (java-like or C-like) solution so I'm not sure it will help; in functional languages like OCaml is usually expected recursion rather than loops. But it works:
let cartesianProduct list1 list2 =
let product = ref [] in
for i = 0 to List.length list1 -1 do
for j = 0 to List.length list2 -1 do
product:= !product#[List.nth list1 i]#[List.nth list2 j]
done;
done;
!product;;

string to list of char

I want to write a function that taking a string and return a list of char. Here is a function, but I think it is not do what I want ( I want to take a string and return a list of characters).
let rec string_to_char_list s =
match s with
| "" -> []
| n -> string_to_char_list n
Aside, but very important:
Your code is obviously wrong because you have a recursive call for which all the parameters are the exact same one you got in. It is going to induce an infinite sequence of calls with the same values in, thus looping forever (a stack overflow won't happen in tail-rec position).
The code that does what you want would be:
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) []
Source:
http://caml.inria.fr/pub/old_caml_site/FAQ/FAQ_EXPERT-eng.html#strings
Alternatively, you can choose to use a library: batteries String.to_list or extlib String.explode
Try this:
let explode s = List.init (String.length s) (String.get s)
Nice and simple:
let rec list_car ch =
match ch with
| "" -> []
| ch -> String.get ch 0 :: list_car (String.sub ch 1 (String.length ch - 1));;
How about something like this:
let string_to_list str =
let rec loop i limit =
if i = limit then []
else (String.get str i) :: (loop (i + 1) limit)
in
loop 0 (String.length str);;
let list_to_string s =
let rec loop s n =
match s with
[] -> String.make n '?'
| car :: cdr ->
let result = loop cdr (n + 1) in
String.set result n car;
result
in
loop s 0;;
As of OCaml 4.07 (released 2018), this can be straightforwardly accomplished with sequences.
let string_to_char_list s =
s |> String.to_seq |> List.of_seq
Here is an Iterative version to get a char list from a string:
let string_to_list s =
let l = ref [] in
for i = 0 to String.length s - 1 do
l := (!l) # [s.[i]]
done;
!l;;
My code, suitable for modern OCaml:
let charlist_of_string s =
let rec trav l i =
if i = l then [] else s.[i]::trav l (i+1)
in
trav (String.length s) 0;;
let rec string_of_charlist l =
match l with
[] -> ""
| h::t -> String.make 1 h ^ string_of_charlist t;;