I want to replace a sublist lista with another sublist listb from a list listo to achieve the following result:
let replace_sublist listo lista listb =
In listo , if there is a sublist = lista, then replace this sublist with listb.
I found a similar question implemented in python.
Link:
Replacing a sublist with another sublist in python
Any suggestion? Thanks.
type 'a strip_result =
| No_match
| Too_short
| Tail of 'a list
(** [try_strip li subli] tries to
remove the prefix [subli] from the list [li] *)
let rec try_strip li subli = match li, subli with
| _, [] -> Tail li
| [], _ -> Too_short
| hli::tli, hsub::tsub ->
if hli <> hsub then No_match
else try_strip tli tsub
let rec replace_sublist li from_sub to_sub =
match li with
| [] -> []
| head::tail ->
match try_strip li from_sub with
| Too_short -> li
| No_match -> head :: replace_sublist tail from_sub to_sub
| Tail rest -> to_sub # replace_sublist rest from_sub to_sub
let test =
(* simple replace *)
assert (replace_sublist [1;2;3;4] [2;3] [-2;-3] = [1;-2;-3;4]);
(* multiple replace *)
assert (replace_sublist [1;2;3;2;4] [2] [0] = [1;0;3;0;4]);
(* stop while partial match *)
assert (replace_sublist [1;2;3;4] [3;4;5] [0] = [1;2;3;4]);
(* stop at match *)
assert (replace_sublist [1;2;3;4] [3;4] [2;1] = [1;2;2;1]);
(* tricky repeating sublist case *)
assert (replace_sublist [2;2;3] [2;3] [0] = [2;0]);
()
(* tail-rec version: instead of concatenating elements before
the recursive call
head :: replace_sublist ...
to_sub # replace_sublist ...
keep an accumulator parameter `acc` to store the partial result,
in reverse order
replace (t :: acc) ...
replace (List.rev_append to_sub acc) ...
*)
let replace_sublist li from_sub to_sub =
let rec replace acc li = match li with
| [] -> List.rev acc
| head::tail as li ->
match try_strip li from_sub with
| Too_short -> List.rev (List.rev_append li acc)
| No_match -> replace (head :: acc) tail
| Tail rest -> replace (List.rev_append to_sub acc) rest
in replace [] li
PS: it is well-known that this algorithm can be improved by moving, after try_strip failed, not just to the next element in the list but by some number of elements that we know cannot start a new match. However, this number of elements to jump over is not something simple like List.length from_sub - 1, it needs to be precomputed from the pattern structure (it depends from the presence of "tricky repeating sublists"). This is the Knuth-Morris-Pratt algorithm.
You can do something like that :
let replace listo lista listb =
let rec loop listo lista listb accu =
match listo with
[] -> List.rev accu
| x :: xs ->
if xs = lista then List.rev_append (x :: accu) listb
else loop xs lista listb (x :: accu) in
loop listo lista listb []
First you need to find the sublist lista. Once you find this list, you can just revert the accumulator accu and then append the listb
This is essentially a substring search and replace. If your lists are long, you might want to use a fancy algorithm like Knuth-Morris-Pratt to avoid a quadratic number of comparisons.
(I was going to write some code, bug gasche already did an excellent job.)
Related
I have a list of lists, where each inner list has the same length, and I need to project that as its inverse (that is, I need the dimensions flipped).
In other words, take the first item of each sublist and put that in a new list, take the second item of each sublist and put it in a new list etc. Then return a list of all these new lists.
Example: if input is:
let ls = [[1;2;3];[4;5;6];[7;8;9];[0;0;0]];;
Then output is supposed to be:
val it : int list list = [[1; 4; 7; 0]; [2; 5; 8; 0]; [3; 6; 9; 0]]
I have working code, but it doesn't feel right. It traverses multiple times over the lists, needs to do a List.rev multiple times and has to check for empty on the inner lists:
let rec getInnerHeads acc skipped lst =
match lst with
| [] -> List.rev acc, List.rev skipped
| item::rest ->
match item with
| [] -> [], skipped
| innerHead::skip1 ->
getInnerHeads (innerHead::acc) (skip1::skipped) rest
let rec flipDimensions acc lst =
match lst with
| [] -> acc |> List.rev
| z when (z |> List.forall List.isEmpty) -> acc |> List.rev
| rest ->
let (elem, skip1Elems) = getInnerHeads [] [] rest
flipDimensions (elem::acc) skip1Elems
The only upside of above code is that it is rail-recursive (at least I think it is).
Anybody has a more efficient, or succinct, or both algorithm? I checked F# Snippets and SO, figured this would've been asked before, it seems so common, but I didn't find any examples.
Maybe something with List.unfold?
let transpose matrix =
let rec loop acc = function
| (_::_)::_ as m -> loop (List.map List.head m :: acc) (List.map List.tail m)
| _ -> List.rev acc
loop [] matrix
I have a list and I want to remove an element matching some criteria but remove only one element.
let items = [1;2;3]
let predicate x =
x >= 2
let result = items |> List.fold ...
// result = [1;3]
How to achieve method returning list with [1;3]?
You can use a generic recursive function
let rec removeFirst predicate = function
| [] -> []
| h :: t when predicate h -> t
| h :: t -> h :: removeFirst predicate t
or a tail recursive one (if you fear a stack overflow)
let removeFirst predicate list =
let rec loop acc = function
| [] -> List.rev acc
| h :: t when predicate h -> (List.rev acc) # t
| h :: t -> loop (h :: acc) t
loop [] list
let result =
items
|>List.scan (fun (removed, _) item ->
if removed then true, Some(item) //If already removed, just propagate
elif predicate item then true, None //If not removed but predicate matches, don't propagate
else false, Some(item)) //If not removed and predicate doesn't match, propagate
(false, None)
|>List.choose snd
The state is a tuple. The first element is a Boolean flag indicating whether we already have removed some item from the list. The second element is an option: Some when we want to emit the item, None otherwise.
The last line takes the second elements from the states and for each of them emits the wrapped value (in case of Some) or does nothing (in case of None).
Here is a short alternative, which in my testing was faster than the others proposed so far:
let removeFirst p xs =
match List.tryFindIndex p xs with
| Some i -> List.take i xs # List.skip (i+1) xs
| None -> xs
Aiming for an intuitive solution.
let removeAt index list =
let left, right = List.splitAt index list
left # (List.skip 1 right)
let removeFirst predicate list =
match List.tryFindIndex predicate list with
| Some index -> removeAt index list
| None -> list
For performance (long lists).
let removeFirst predicate list =
let rec finish acc rem =
match rem with
| [] -> acc
| x::xs -> finish (x::acc) xs
and find l p acc rem =
match rem with
| [] -> l
| x::xs ->
if p x then finish xs acc
else find l p (x::acc) xs
find list predicate [] list
I'm looking for data structure which answer to following question ?
How many elements in lists is lower than current. And I would like to count it for every element in list. Additionally, it must be consistent subsequence of list.
For example:
[1;2;3;-3;5;3]
The correct answer is:
[0; 1; 2; 0; 4; 0]
I'm not sure if I'm exactly understanding your question right because your 'correct answer' seems inconsistent with how you described the problem, but here is a possible solution to the described problem:
let xs = [1;2;3;-3;5;3] in
let comp x y =
if (x < y) then -1
else if (x > y) then 1
else 0
in
let sorted_xs = List.sort comp xs in
let index x =
let rec helper i xs =
match xs with
| [] -> failwith "Item not in list"
| hd::tl -> (
if (hd = x) then i
else helper (i+1) tl
)
in helper 0 sorted_xs
in
List.map index xs
I'm not sure whether that is exactly the problem that you're trying to solve, but that should at least give you the general idea.
The result of this is [1;2;3;0;5;3] which is the number of other items in the list that are lower than the item at that index.
*****UPDATE*****
This is the correct code based on what you described in the comments. Let me know if this makes sense.
let xs = [1;2;3;-5;6;7;10;-1;4] in
let transfer_item xs1 xs2 =
match xs1 with
| [] -> failwith "Invalid list"
| hd::tl -> (tl,hd::xs2)
in
let find_item xs i =
let rec helper xs count =
match xs with
| [] -> count
| hd::tl -> (
if (hd > i) then count
else helper tl (count+1)
)
in helper xs 0
in
let rec new_list xs ref_list =
match xs with
| [] -> []
| hd::tl -> (
let first = find_item ref_list hd in
let (xs, ref_list) = transfer_item xs ref_list in
first::(new_list xs ref_list)
)
in new_list xs []
You can easlily solve your problem using two recursive functions: one for iterating in the list, and one for checking the predecessors in the list. The following code is a possible implementation:
let rec countElementsLessThan list value =
match list with
| [] -> 0
| head :: tail -> if head < value
then 1 + (countElementsLessThan tail value)
else countElementsLessThan tail value
;;
(*******************************)
let rec count remaining alreadySeen result =
match remaining with
| [] -> result
| head :: tail -> let elementsLessThanHead = countElementsLessThan alreadySeen head in
count tail (head :: alreadySeen) (result # [elementsLessThanHead])
;;
(*******************************)
let rec printList list =
match list with
| [] -> print_newline ()
| head :: tail -> print_int head;
printList tail
;;
(*******************************)
let result = count [1;2;3;-3;5;3] [] [];;
printList result;;
Here, method count will iterate and store the already seen elements in a list called alreadySeen. Then, for every element being checked, we call an auxiliary method countElementsLessThan that will return the number of elements lower than the current element. Finally, we store the result in the result list, until every element of the remaining list is checked.
However, I'm not completely sure of having perfectly understood your question, since for me the example you provided should have been:
[1;2;3;-3;5;3] The correct answer is: [0; 1; 2; 0; 4; 3]
instead of:
[1;2;3;-3;5;3] The correct answer is: [0; 1; 2; 0; 4; 0]
I have some Run Length Encoding code that I wrote as an exercise
let rle s =
s
|> List.map (fun x -> (x, 1))
|> List.fold (fun acc x ->
match acc with
| [] -> [(x, 1)]
| h::(x, n) -> h::(x, n+1)
| h -> h::(x, 1)
)
|> List.map (fun (x, n) ->
match n with
| 1 -> x.ToString()
| _ -> x.ToString() + n.ToString()
)
The pattern h::(x, n) -> h::(x, n+1) fails to compile.
Does anyone know why?
RLE (for grins)
let rle (s: string) =
let bldr = System.Text.StringBuilder()
let rec start = function
| [] -> ()
| c :: s -> count (1, c) s
and count (n, c) = function
| c1 :: s when c1 = c -> count (n+1, c) s
| s -> Printf.bprintf bldr "%d%c" n c; start s
start (List.ofSeq s)
bldr.ToString()
let s1 = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
let s2 = "12W1B12W3B24W1B14W"
rle s1 = s2 |> printfn "%b" //"true"
It can't compile because the second argument for :: pattern match must be a list, but here it is a tuple. In general, you seem to just misunderstand head and tail. Head is the top element while tail is a list of following elements. Essentially swapping them does the trick:
|> List.fold (fun acc x ->
match acc with
| [] -> [(x, 1)]
| (x0, n)::t when x0=x -> (x0, n+1)::t
| t -> (x, 1)::t
)
[]
Note 1: As #pad noticed, List.fold requires one more argument, a "bootstrap" accumulator to start with. Obviously, it should be just an empty list, [].
Note 2: you can't directly match x. Instead, you bind it to x0 and compare x0 with x.
Note 3: matching empty list [] is not necessary as it would happily work with the last pattern.
This doesn't answer your question, but I was bored and wrote an implementation you might find a bit more instructive -- just step through it with the debugger in Visual Studio or MonoDevelop.
let rec private rleRec encoded lastChar count charList =
match charList with
| [] ->
// No more chars left to process, but we need to
// append the current run before returning.
let encoded' = (count, lastChar) :: encoded
// Reverse the encoded list so it's in the correct
// order, then return it.
List.rev encoded'
| currentChar :: charList' ->
// Does the current character match the
// last character to be processed?
if currentChar = lastChar then
// Just increment the count and recurse.
rleRec encoded currentChar (count + 1) charList'
else
// The current character is not the same as the last.
// Append the character and run-length for the previous
// character to the 'encoded' list, then start a new run
// with the current character.
rleRec ((count, lastChar) :: encoded) currentChar 1 charList'
let rle charList =
// If the list is empty, just return an empty list
match charList with
| [] -> []
| hd :: tl ->
// Call the implementation of the RLE algorithm.
// The initial run starts with the first character in the list.
rleRec [] hd 1 tl
let rleOfString (str : string) =
rle (List.ofSeq str)
let rec printRle encoded =
match encoded with
| [] ->
printfn ""
| (length, c) :: tl ->
printf "%i%O" length c
printRle tl
let printRleOfString = rleOfString >> printRle
Pasting the code into F# interactive and using the Wikipedia example for run-length encoding:
> printRleOfString "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW";;
12W1B12W3B24W1B14W
val it : unit = ()
Inspired by this question and answer, how do I create a generic permutations algorithm in F#? Google doesn't give any useful answers to this.
EDIT: I provide my best answer below, but I suspect that Tomas's is better (certainly shorter!)
you can also write something like this:
let rec permutations list taken =
seq { if Set.count taken = List.length list then yield [] else
for l in list do
if not (Set.contains l taken) then
for perm in permutations list (Set.add l taken) do
yield l::perm }
The 'list' argument contains all the numbers that you want to permute and 'taken' is a set that contains numbers already used. The function returns empty list when all numbers all taken.
Otherwise, it iterates over all numbers that are still available, gets all possible permutations of the remaining numbers (recursively using 'permutations') and appends the current number to each of them before returning (l::perm).
To run this, you'll give it an empty set, because no numbers are used at the beginning:
permutations [1;2;3] Set.empty;;
I like this implementation (but can't remember the source of it):
let rec insertions x = function
| [] -> [[x]]
| (y :: ys) as l -> (x::l)::(List.map (fun x -> y::x) (insertions x ys))
let rec permutations = function
| [] -> seq [ [] ]
| x :: xs -> Seq.concat (Seq.map (insertions x) (permutations xs))
Tomas' solution is quite elegant: it's short, purely functional, and lazy. I think it may even be tail-recursive. Also, it produces permutations lexicographically. However, we can improve performance two-fold using an imperative solution internally while still exposing a functional interface externally.
The function permutations takes a generic sequence e as well as a generic comparison function f : ('a -> 'a -> int) and lazily yields immutable permutations lexicographically. The comparison functional allows us to generate permutations of elements which are not necessarily comparable as well as easily specify reverse or custom orderings.
The inner function permute is the imperative implementation of the algorithm described here. The conversion function let comparer f = { new System.Collections.Generic.IComparer<'a> with member self.Compare(x,y) = f x y } allows us to use the System.Array.Sort overload which does in-place sub-range custom sorts using an IComparer.
let permutations f e =
///Advances (mutating) perm to the next lexical permutation.
let permute (perm:'a[]) (f: 'a->'a->int) (comparer:System.Collections.Generic.IComparer<'a>) : bool =
try
//Find the longest "tail" that is ordered in decreasing order ((s+1)..perm.Length-1).
//will throw an index out of bounds exception if perm is the last permuation,
//but will not corrupt perm.
let rec find i =
if (f perm.[i] perm.[i-1]) >= 0 then i-1
else find (i-1)
let s = find (perm.Length-1)
let s' = perm.[s]
//Change the number just before the tail (s') to the smallest number bigger than it in the tail (perm.[t]).
let rec find i imin =
if i = perm.Length then imin
elif (f perm.[i] s') > 0 && (f perm.[i] perm.[imin]) < 0 then find (i+1) i
else find (i+1) imin
let t = find (s+1) (s+1)
perm.[s] <- perm.[t]
perm.[t] <- s'
//Sort the tail in increasing order.
System.Array.Sort(perm, s+1, perm.Length - s - 1, comparer)
true
with
| _ -> false
//permuation sequence expression
let c = f |> comparer
let freeze arr = arr |> Array.copy |> Seq.readonly
seq { let e' = Seq.toArray e
yield freeze e'
while permute e' f c do
yield freeze e' }
Now for convenience we have the following where let flip f x y = f y x:
let permutationsAsc e = permutations compare e
let permutationsDesc e = permutations (flip compare) e
My latest best answer
//mini-extension to List for removing 1 element from a list
module List =
let remove n lst = List.filter (fun x -> x <> n) lst
//Node type declared outside permutations function allows us to define a pruning filter
type Node<'a> =
| Branch of ('a * Node<'a> seq)
| Leaf of 'a
let permutations treefilter lst =
//Builds a tree representing all possible permutations
let rec nodeBuilder lst x = //x is the next element to use
match lst with //lst is all the remaining elements to be permuted
| [x] -> seq { yield Leaf(x) } //only x left in list -> we are at a leaf
| h -> //anything else left -> we are at a branch, recurse
let ilst = List.remove x lst //get new list without i, use this to build subnodes of branch
seq { yield Branch(x, Seq.map_concat (nodeBuilder ilst) ilst) }
//converts a tree to a list for each leafpath
let rec pathBuilder pth n = // pth is the accumulated path, n is the current node
match n with
| Leaf(i) -> seq { yield List.rev (i :: pth) } //path list is constructed from root to leaf, so have to reverse it
| Branch(i, nodes) -> Seq.map_concat (pathBuilder (i :: pth)) nodes
let nodes =
lst //using input list
|> Seq.map_concat (nodeBuilder lst) //build permutations tree
|> Seq.choose treefilter //prune tree if necessary
|> Seq.map_concat (pathBuilder []) //convert to seq of path lists
nodes
The permutations function works by constructing an n-ary tree representing all possible permutations of the list of 'things' passed in, then traversing the tree to construct a list of lists. Using 'Seq' dramatically improves performance as it makes everything lazy.
The second parameter of the permutations function allows the caller to define a filter for 'pruning' the tree before generating the paths (see my example below, where I don't want any leading zeros).
Some example usage: Node<'a> is generic, so we can do permutations of 'anything':
let myfilter n = Some(n) //i.e., don't filter
permutations myfilter ['A';'B';'C';'D']
//in this case, I want to 'prune' leading zeros from my list before generating paths
let noLeadingZero n =
match n with
| Branch(0, _) -> None
| n -> Some(n)
//Curry myself an int-list permutations function with no leading zeros
let noLZperm = permutations noLeadingZero
noLZperm [0..9]
(Special thanks to Tomas Petricek, any comments welcome)
If you need distinct permuations (when the original set has duplicates), you can use this:
let rec insertions pre c post =
seq {
if List.length post = 0 then
yield pre # [c]
else
if List.forall (fun x->x<>c) post then
yield pre#[c]#post
yield! insertions (pre#[post.Head]) c post.Tail
}
let rec permutations l =
seq {
if List.length l = 1 then
yield l
else
let subperms = permutations l.Tail
for sub in subperms do
yield! insertions [] l.Head sub
}
This is a straight-forward translation from this C# code. I am open to suggestions for a more functional look-and-feel.
Take a look at this one:
http://fsharpcode.blogspot.com/2010/04/permutations.html
let length = Seq.length
let take = Seq.take
let skip = Seq.skip
let (++) = Seq.append
let concat = Seq.concat
let map = Seq.map
let (|Empty|Cons|) (xs:seq<'a>) : Choice<Unit, 'a * seq<'a>> =
if (Seq.isEmpty xs) then Empty else Cons(Seq.head xs, Seq.skip 1 xs)
let interleave x ys =
seq { for i in [0..length ys] ->
(take i ys) ++ seq [x] ++ (skip i ys) }
let rec permutations xs =
match xs with
| Empty -> seq [seq []]
| Cons(x,xs) -> concat(map (interleave x) (permutations xs))
If you need permutations with repetitions, this is the "by the book" approach using List.indexed instead of element comparison to filter out elements while constructing a permutation.
let permutations s =
let rec perm perms carry rem =
match rem with
| [] -> carry::perms
| l ->
let li = List.indexed l
let permutations =
seq { for ci in li ->
let (i, c) = ci
(perm
perms
(c::carry)
(li |> List.filter (fun (index, _) -> i <> index) |> List.map (fun (_, char) -> char))) }
permutations |> Seq.fold List.append []
perm [] [] s