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
This is the followup question of What's the grouping plan so that every two people are grouped together just once?
Basically, I implemented the Round robin algorithm.
By the algorithm, it can generate pairs list where each possible pair of elements are grouped together exactly once.
For example, we have a, b, c, d, then
On first day, we do
a b
c d
Then we group like [(a,c);(b,d)].
Then we round it clockwise like
a c
d b
Then we group like [(a,d);(c,b)].
Then we round it clockwise like
a d
b c
Then we group like [(a,b);(d,c)].
(Note, a is fixed all the time.)
Finally I can get
[(a,c);(b,d)]
[(a,d);(c,b)]
[(a,b);(d,c)]
Here are the ocaml code:
let split = List.fold_left (fun (l1, l2) x -> (l2, x::l1)) ([], [])
let round l1 l2 =
match List.rev l1, l2 with
| _, [] | [], _ -> raise Cant_round
| hd1::tl1, hd2::tl2 ->
hd2::(List.rev tl1), List.rev (hd1::List.rev tl2)
let rec robin fixed stopper acc = function
| _, [] | [], _ -> raise Cant_robin
| l1, (hd2::tl2 as l2) ->
if hd2 = stopper then acc
else robin fixed stopper ((List.combine (fixed::l1) l2)::acc) (round l1 l2)
let round_robin = function
| [] | _::[] -> raise Cant_round_robin
| hd::tl ->
let l1, l2 = in
match split tl with
| _, [] -> raise Cant_round_robin
| l1, (hd2::_ as l2) ->
robin hd hd2 ((List.combine (hd::l1) l2)::[]) (round l1 l2)
The code is quite straight forward following the algorithm. Is there a better implmentation?
let round_robin ~nplayers ~round i =
(* only works for an even number of players *)
assert (nplayers mod 2 = 0);
assert (0 <= round && round < nplayers - 1);
(* i is the position of a match,
at each round there are nplayers/2 matches *)
assert (0 <= i && i < nplayers / 2);
let last = nplayers - 1 in
let player pos =
if pos = last then last
else (pos + round) mod last
in
(player i, player (last - i))
let all_matches nplayers =
Array.init (nplayers - 1) (fun round ->
Array.init (nplayers / 2) (fun i ->
round_robin ~nplayers ~round i))
let _ = all_matches 6;;
(**
[|[|(0, 5); (1, 4); (2, 3)|];
[|(1, 5); (2, 0); (3, 4)|];
[|(2, 5); (3, 1); (4, 0)|];
[|(3, 5); (4, 2); (0, 1)|];
[|(4, 5); (0, 3); (1, 2)|]|]
*)
You don't need to compute the clockwise rotation by operating over actual data. You can represent it as picking indices in a fixed array (of things you rotate): after rotating the array t r times, the element at index i in the rotated array will be at index i+r in the original array, in fact (i+r) mod (Array.length t) to have wrap-around.
With this idea you could compute pairing without moving data around, simply incrementing a counter representing the number of rotations performed so far. In fact, you could probably even come up with a purely numerical solution that does not create any data structure (the array of things-to-rotate), and reasons on the various indices to apply this reasoning.
Although this question has been answered, but the correct answer is in an imperative way.
I finally found the following way to deal with round-robin algorithm simpler in functional way.
let round l1 l2 = let move = List.hd l2 in move::l1, (List.tl l2)#[move]
let combine m l1 l2 =
let rec comb i acc = function
|[], _ | _, [] -> acc
|_ when i >= m -> acc
|hd1::tl1, hd2::tl2 -> comb (i+1) ((hd1,hd2)::acc) (tl1,tl2)
in
comb 0 [] (l1,l2)
let round_robin l =
let fix = List.hd l in
let half = (List.length l)/2 in
List.fold_left (
fun (acc, (l1, l2)) _ -> (combine half (fix::l1) l2)::acc, round l1 l2
) ([], (List.tl l, List.rev l)) l |> fst |> List.tl
I have been struggling with something that looks like a simple algorithm, but can't find a clean way to express it in a functional style so far. Here is an outline of the problem: suppose I have 2 arrays X and Y,
X = [| 1; 2; 2; 3; 3 |]
Y = [| 5; 4; 4; 3; 2; 2 |]
What I want is to retrieve the elements that match, and the unmatched elements, like:
matched = [| 2; 2; 3 |]
unmatched = [| 1; 3 |], [| 4; 4; 5 |]
In pseudo-code, this is how I would think of approaching the problem:
let rec match matches x y =
let m = find first match from x in y
if no match, (matches, x, y)
else
let x' = remove m from x
let y' = remove m from y
let matches' = add m to matches
match matches' x' y'
The problem I run into is the "remove m from x" part - I can't find a clean way to do this (I have working code, but it's ugly as hell). Is there a nice, idiomatic functional way to approach that problem, either the removal part, or a different way to write the algorithm itself?
This could be solved easily using the right data structures, but in case you wanted to do it manually, here's how I would do it in Haskell. I don't know F# well enough to translate this, but I hope it is similar enough. So, here goes, in (semi-)literate Haskell.
overlap xs ys =
I start by sorting the two sequences to get away from the problem of having to know about previous values.
go (sort xs) (sort ys)
where
The two base cases for the recursion are easy enough to handle -- if either list is empty, the result includes the other list in the list of elements that are not overlapping.
go xs [] = ([], (xs, []))
go [] ys = ([], ([], ys))
I then inspect the first elements in each list. If they match, I can be sure that the lists overlap on that element, so I add that to the included elements, and I let the excluded elements be. I continue the search for the rest of the list by recursing on the tails of the lists.
go (x:xs) (y:ys)
| x == y = let ( included, excluded) = go xs ys
in (x:included, excluded)
Then comes the interesting part! What I essentially want to know is if the first element of one of the lists does not exist in the second list – in that case I should add it to the excluded lists and then continue the search.
| x < y = let (included, ( xex, yex)) = go xs (y:ys)
in (included, (x:xex, yex))
| y < x = let (included, ( xex, yex)) = go (x:xs) ys
in (included, ( xex, y:yex))
And this is actually it. It seems to work for at least the example you gave.
> let (matched, unmatched) = overlap x y
> matched
[2,2,3]
> unmatched
([1,3],[4,4,5])
It seems that you're describing multiset (bag) and its operations.
If you use the appropriate data structures, operations are very easy to implement:
// Assume that X, Y are initialized bags
let matches = X.IntersectWith(Y)
let x = X.Difference(Y)
let y = Y.Difference(X)
There's no built-in Bag collection in .NET framework. You could use Power Collection library including Bag class where the above function signature is taken.
UPDATE:
You can represent a bag by a weakly ascending list. Here is an improved version of #kqr's answer in F# syntax:
let overlap xs ys =
let rec loop (matches, ins, outs) xs ys =
match xs, ys with
// found a match
| x::xs', y::ys' when x = y -> loop (x::matches, ins, outs) xs' ys'
// `x` is smaller than every element in `ys`, put `x` into `ins`
| x::xs', y::ys' when x < y -> loop (matches, x::ins, outs) xs' ys
// `y` is smaller than every element in `xs`, put `y` into `outs`
| x::xs', y::ys' -> loop (matches, ins, y::outs) xs ys'
// copy remaining elements in `xs` to `ins`
| x::xs', [] -> loop (matches, x::ins, outs) xs' ys
// copy remaining elements in `ys` to `outs`
| [], y::ys' -> loop (matches, ins, y::outs) xs ys'
| [], [] -> (List.rev matches, List.rev ins, List.rev outs)
loop ([], [], []) (List.sort xs) (List.sort ys)
After two calls to List.sort, which are probably O(nlogn), finding matches is linear to the sum of the lengths of two lists.
If you need a quick-and-dirty bag module, I would suggest a module signature like this:
type Bag<'T> = Bag of 'T list
module Bag =
val count : 'T -> Bag<'T> -> int
val insert : 'T -> Bag<'T> -> Bag<'T>
val intersect : Bag<'T> -> Bag<'T> -> Bag<'T>
val union : Bag<'T> -> Bag<'T> -> Bag<'T>
val difference : Bag<'T> -> Bag<'T> -> Bag<'T>
How should I go about removing a given element from a list? As an example, say I have list ['A'; 'B'; 'C'; 'D'; 'E'] and want to remove the element at index 2 to produce the list ['A'; 'B'; 'D'; 'E']? I've already written the following code which accomplishes the task, but it seems rather inefficient to traverse the start of the list when I already know the index.
let remove lst i =
let rec remove lst lst' =
match lst with
| [] -> lst'
| h::t -> if List.length lst = i then
lst' # t
else
remove t (lst' # [h])
remove lst []
let myList = ['A'; 'B'; 'C'; 'D'; 'E']
let newList = remove myList 2
Alternatively, how should I insert an element at a given position? My code is similar to the above approach and most likely inefficient as well.
let insert lst i x =
let rec insert lst lst' =
match lst with
| [] -> lst'
| h::t -> if List.length lst = i then
lst' # [x] # lst
else
insert t (lst' # [h])
insert lst []
let myList = ['A'; 'B'; 'D'; 'E']
let newList = insert myList 2 'C'
Removing element at the specified index isn't a typical operation in functional programming - that's why it seems difficult to find the right implementation of these operations. In functional programming, you'll usually process the list element-by-element using recursion, or implement the processing in terms of higher-level declarative operations. Perhaps if you could clarfiy what is your motivation, we can give a better answer.
Anyway, to implement the two operations you wanted, you can use existing higher-order functions (that traverse the entire list a few times, because there is really no good way of doing this without traversing the list):
let removeAt index input =
input
// Associate each element with a boolean flag specifying whether
// we want to keep the element in the resulting list
|> List.mapi (fun i el -> (i <> index, el))
// Remove elements for which the flag is 'false' and drop the flags
|> List.filter fst |> List.map snd
To insert element to the specified index, you could write:
let insertAt index newEl input =
// For each element, we generate a list of elements that should
// replace the original one - either singleton list or two elements
// for the specified index
input |> List.mapi (fun i el -> if i = index then [newEl; el] else [el])
|> List.concat
However, as noted earlier - unless you have a very good reasons for using these functions, you should probably consider describing your goals more broadly and use an alternative (more functional) solution.
Seems the most idiomatic (not tail recursive):
let rec insert v i l =
match i, l with
| 0, xs -> v::xs
| i, x::xs -> x::insert v (i - 1) xs
| i, [] -> failwith "index out of range"
let rec remove i l =
match i, l with
| 0, x::xs -> xs
| i, x::xs -> x::remove (i - 1) xs
| i, [] -> failwith "index out of range"
it seems rather inefficient to
traverse the start of the list when I
already know the index.
F# lists are singly-linked lists, so you don't have indexed access to them. But most of the time, you don't need it. The majority of indexed operations on arrays are iteration from front to end, which is exactly the most common operation on immutable lists. Its also pretty common to add items to the end of an array, which isn't really the most efficient operation on singly linked lists, but most of the time you can use the "cons and reverse" idiom or use an immutable queue to get the same result.
Arrays and ResizeArrays are really the best choice if you need indexed access, but they aren't immutable. A handful of immutable data structures like VLists allow you to create list-like data structures supporting O(1) cons and O(log n) indexed random access if you really need it.
If you need random access in a list, consider using System.Collections.Generic.List<T> or System.Collections.Generic.LinkedList<T> instead of a F# list.
I know this has been here for a while now, but just had to do something like this recently and I came up with this solution, maybe it isn't the most efficient, but it surely is the shortest idiomatic code I found for it
let removeAt index list =
list |> List.indexed |> List.filter (fun (i, _) -> i <> index) |> List.map snd
The List.Indexed returns a list of tuples which are the index in the list and the actual item in that position after that all it takes is to filter the one tuple matching the inputted index and get the actual item afterwards.
I hope this helps someone who's not extremely concerned with efficiency and wants brief code
The following includes a bit of error checking as well
let removeAt index = function
| xs when index >= 0 && index < List.length xs ->
xs
|> List.splitAt index
|> fun (x,y) -> y |> List.skip 1 |> List.append x
| ys -> ys
Lets go thru it and explain the code
// use the function syntax
let removeAt index = function
// then check if index is within the size of the list
| xs when index >= 0 && index < List.length xs ->
xs
// split the list before the given index
// splitAt : int -> 'T list -> ('T list * 'T list)
// this gives us a tuple of the the list with 2 sublists
|> List.splitAt index
// define a function which
// first drops the element on the snd tuple element
// then appends the remainder of that sublist to the fst tuple element
// and return all of it
|> fun (x,y) -> y |> List.skip 1 |> List.append x
//index out of range so return the original list
| ys -> ys
And if you don't like the idea of simply returning the original list on indexOutOfRange - wrap the return into something
let removeAt index = function
| xs when index >= 0 && index < List.length xs ->
xs
|> List.splitAt index
|> fun (x,y) -> y |> List.skip 1 |> List.append x
|> Some
| ys -> None
I think this should be quite faster than Juliet's or Tomas' proposal but most certainly Mauricio's comment is hitting it home. If one needs to remove or delete items other data structures seem a better fit.
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