I have the method which makes permutations:
def permutations[T](lst: List[T]): List[List[T]] = lst match {
case Nil => List(Nil)
case x :: xs => permutations(xs) flatMap { perm =>
(0 to xs.length) map { num =>
(perm take num) ++ List(x) ++ (perm drop num)
}
}
}
Firstly, it take a recursive call with pair - head, tail for List("a","b", "c"):
c - Nil
b - c
a - bc
and permute before and after parts. As result, I have all permutations from three later. My question is next: why recursive call doesn't return the intermediate statement like "bc", "cb", "c" and return valid set from three later.
Well, in each iteration you necessarily return only lists with the same size as the input list, because you return permutations of the form (perm take num) ++ List(x) ++ (perm drop num), which would always contain all of the elements in perm plus the x element.
Therefore, recursively - if each cycle returns only values of the same size as its input (including the end case of Nil), then the end result must only contain permutations of the same size.
To fix this, you can add the perm without x to each cycle's result, but you'll have to add distinct to get rid of duplications:
def permutations[T](lst: List[T]): List[List[T]] = lst match {
case Nil => List(Nil)
case x :: xs => permutations(xs) flatMap { perm =>
((0 to xs.length) flatMap { num =>
List(perm, (perm take num) ++ List(x) ++ (perm drop num))
}).distinct
}
}
Related
Lets assume I've got an unsorted List containing a, a, b, b, a, c and I want this sequence sorted so that the gaps between equal elements are as large as possible. So in case of this sample sequence a possible output could be b, a, c, a, b, a. In my application it wouldn't be that important that the gaps are at its exact average maximum, but there shouldn't be two equal elements next to each other whenever possible. So my indention is to maximize the smallest gaps.
I'd start from measuring frequency per each unique element:
scala> val l = List("a", "a", "b", "b", "a", "c")
l: List[String] = List(a, a, b, b, a, c)
scala> val in = l.toSet[String].map(x => x -> l.count(x==)).toList.sortBy(_._2).reverse
in: List[(String, Int)] = List((a,3), (b,2), (c,1))
So now you can generate more-less scattered list:
def shuffle[T](l: List[T]) = {
def fill(n: Int, l: List[List[T]], s: T) =
l.take(n + 1).reduce(_ ++ List(s) ++ _) ++ l.drop(n + 1).flatten
val in = l.toSet[T].map(x => x -> l.count(x==)).toList.sortBy(_._2).reverse
val initial = in.head._2 -> List.fill(in.head._2)(in.head._1)
in.tail.foldLeft(initial){case ((size, acc), (value, count)) =>
count -> fill(count, acc.grouped(acc.size / size).toList, value)
}._2
}
scala> shuffle(l)
res32: List[String] = List(a, b, c, a, b, a)
Every next iteration here is based on previous one with higher frequency: elements just inserted into list (from previous iteration) as broad as possible. So it may not be so effective if frequency is dropping down significantly between iterations as high frequent elements may not be "scrumbled" enough.
This algorithm isn't trying to maximise every distance - it's trying to reduce probabilty of grouped elements appearance to the minimum. Just random shuffling should do the simillar thing if you're fine with less precise result as it produces groups with still small but a bit higher probability here:
scala> scala.util.Random.shuffle(l)
res34: List[String] = List(a, b, c, b, a, a)
As the commenter said, there is no unique solution because it depends on your cost function. My idea would be along the following line, looking only for right neighbours and assigning them a score of list.size if there is no other equal element:
def maxGaps[A](in: List[A]): List[A] = {
if (in.isEmpty) return in
def noPairs(xs: List[A]): Boolean =
xs.sliding(2, 1).forall { case List(a, b) => a != b }
val (good, bad) = in.permutations.partition(noPairs)
val candidates = if (good.nonEmpty) good else bad
val maxDist = in.size
def calcScore(xs: List[A], accum: Int = 0): Int =
xs match {
case head :: tail =>
val i = tail.indexOf(head)
val j = if (i < 0) maxDist else i
calcScore(tail, accum + j)
case Nil => accum
}
candidates.maxBy(calcScore(_))
}
maxGaps("aabbac".toList) // abacab
I am trying to write a function in sml that takes a list as its first argument and a number as its second. The result should be: greaterT [3,5,2,4,7]3; val it = [5,4,7] : int list
This is my work so far but doesn't work yet.
fun greaterT ([],k) = []
| greaterT (a::x,k)
if a <= k
then x = []
else greaterT(x,k);
You are getting into problems because the then branch of the if expression is trying to do something which doesn't make sense:
x = []
You can't re-assign values to already bound identifiers in Standard ML, although you can achieve mutability using refs, but they're not needed in this case.
In your case, what the required function conceptually does, is to look at the first element of a list, decide whether to keep it in the final result by comparing it with k and then recurse on the rest of list:
fun greaterT ([], k) = []
| greaterT (a :: rest, k) =
if a <= k then
a :: greaterT (rest, k)
else
greaterT (rest, k)
The above isn't a good solution, though, because the first recursive call isn't in a tail position, so the compiler can't optimize the generated code (for reasons I won't discuss here; there are plenty of questions about tail-call optimizations on StackOverflow).
So, a better version would use an extra parameter in which it accumulates elements that satisfy the <= predicate.
fun greaterTailRec ([], k, result) = List.rev result
| greaterTailRec (a :: rest, k) =
if a <= k then
greaterTailRec (rest, k, result)
else
greaterTailRec (rest, k, a :: result)
fun greaterT (list, k) = greaterTailRec (list, k, [])
We can go a step further and generalize greaterTailRec by replacing the specifics, which in this particular case is the comparison call <=, to a more general call to a function that takes an element of the list as argument and returns a bool. Thus, we'll end up with a generally useful function called filter:
fun filter predicate list =
let
fun recur ([], result) = List.rev result
| recur (a :: rest, result) =
if predicate a then
recur (rest, a :: result)
else
recur (rest, result)
in
recur (list, [])
end
fun greaterT (list, k) =
filter (fn a => a >= k) list
The filter helper function is already defined on the List structure, so your initial function can be more concisely expressed as:
fun greaterT (list, k) =
List.filter (fn a => a >= k) list
I am trying to implement radix sort in SML via a series of helper functions. The helper function I am having trouble with is called sort_nth_digit, it takes a digit place to be sorted by and a list to sort (n and L respectively). The way I am doing this is to find the first two elements of the list (for now we can assume there are at least 3), compare them by digit n, then concatenating them back onto the list in the proper order. The list should be sorted in ascending order. Now, the problem: The function compiles but I get the following:
HW4.sml:40.5-44.30 Warning: match nonexhaustive
(0,L) => ...
(n,nil) => ...
(n,a :: b :: L) => ...
val sort_nth_digit = fn : int -> int list -> int list
Additionally, when you pass arguments, you don't get an answer back which I believe indicates infinite recursion?
Q:How is the match nonexhaustive and why am I recursing infinitely:
fun sort_nth_digit 0 L = []
| sort_nth_digit n [] = []
| sort_nth_digit n (a::b::L) = if ((nth_digit a n) < (nth_digit b n)) then a::b::(sort_nth_digit n L)
else
b::a::(sort_nth_digit n L)
Thanks for the help in advance! (*My first post on stackoverflow ^.^ *)
Nonexhasutive match fix:
fun sort_nth_digit 0 L = []
| sort_nth_digit n [] = []
| sort_nth_digit n (a::[]) = a::[]
| sort_nth_digit n (a::b::L) = if ((nth_digit a n) < (nth_digit b n)) then a::b::(sort_nth_digit n L)
else
b::a::(sort_nth_digit n L)
Input that results in no output, console just sits at this line:
- sort_nth_digit 1 [333,222,444,555,666,444,333,222,999];
Code for nth_digit & anonymous helper pow:
fun nth_digit x 0 = 0
| nth_digit x n = if (num_digits x) < n then 0
else
let
fun pow x 1 = x
| pow x y= x * pow x (y-1)
in
(*Finding the nth digit of x: ((x - x div 10^n) * 10^n div 10^n-1))*)
(x - ((x div pow 10 n) * pow 10 n)) div (pow 10 (n-1)) (*Me*)
end
If anyone thinks it would be useful to have access to the rest of my code I can provide it via github as an eclipse project (you can just pull the .sml file if you don't have eclipse set up for sml)
The match is not exhaustive because it does not cover the case of a list with only one element (and inductively, any list with an odd number of elements).
I'm not sure what you mean by "not getting an answer". This function does not diverge (recurse infinitely), unless your nth_digit helper does. Instead, you should get a Match exception when you feed it a list with odd length, because of the above.
Given a set of possible values and a number of "digits," I want to find every unique, unordered grouping of values. For example, say you have an alphabet of A, B, C. All the combinations of 3 digits would be:
AAA
AAB
ABB
BBB
BBC
BCC
CCC
CCA
CAA
ABC
The specific problem I'm trying to solve is a bit simpler. I'm doing a BlackJack game as an exercise in F# (I've posted about this before). The way I'm calculating hand values is with a list of lists of cards' possible values. All cards except the Ace have a single item in the list, but the Aces can be either 1 or 11. The implementation I came up with in that post generates a lot of redundancy. For example, 3 aces would create a list like [3; 13; 13; 13; 23; 23; 23; 33]. Right now I'm taking the final list and running it through Distinct(), but it feels like a bit of a hack.
Tying this all together, the Aces' potential values (1, 11) constitutes the alphabet, and the number of aces in the hand determines the number of digits. In this case, I would want the algorithm to come up with the following pattern:
1, 1
1, 11
11,11
Something tells me Dynamic Programming may come into play here, but my lack of appropriate terminology is leaving me a bit stuck. Any help would be appreciated.
Edit
For what it's worth, I'm aware that there are much simpler solutions to the specific problem, but being an exercise in functional programming, generality is one of my goals.
Hmm, in your case it is enough to (1) count the Aces (let the count be N) and then (2) generate the possible total value as list comprehension of
{ i * 11 + (N - i) * 1 } | 0 <= i <= N }
... however you'd express that in F#. No need to do actual permutations, combinatorics etc.
This problem is a good brain teaser. It should be code golf. :)
let rec permute list count =
seq {
match list with
| y::ys when count > 0 ->
for n in permute list (count - 1) do
yield Seq.map (fun li -> y::li) n
yield Seq.concat (permute ys count)
| y::ys -> yield Seq.singleton []
| [] -> ()
}
Ace Example
permute ["1";"11"] 2
|> Seq.concat
|> Seq.iter (printfn "%A")
["1"; "1"]
["1"; "11"]
["11"; "11"]
ABC Example
permute ["A";"B";"C"] 3
|> Seq.concat
|> Seq.iter (printfn "%A");;
["A"; "A"; "A"]
["A"; "A"; "B"]
["A"; "A"; "C"]
["A"; "B"; "B"]
["A"; "B"; "C"]
["A"; "C"; "C"]
["B"; "B"; "B"]
["B"; "B"; "C"]
["B"; "C"; "C"]
["C"; "C"; "C"]
y::li is where all the concating work happens. You could replace it with y + li if all you wanted was strings. You also have to yield Seq.singleton an "" insted of []
Performance Update:
This problem memoizes nicely and gives much better performance memoized for none trivial cases.
let memoize2 f =
let cache = Dictionary<_,_>()
fun x y ->
let ok, res = cache.TryGetValue((x, y))
if ok then
res
else
let res = f x y
cache.[(x, y)] <- res
res
// permute ["A";"B";"C"] 400 |> Seq.concat |> Seq.length |> printf "%A"
// Real: 00:00:07.740, CPU: 00:00:08.234, GC gen0: 118, gen1: 114, gen2: 4
let rec permute =
memoize2(fun list count ->
seq {
match list with
| y::ys when count > 0 ->
for n in permute list (count - 1) do
yield Seq.map (fun li -> y::li) n |> Seq.cache
yield Seq.concat (permute ys count)
| y::ys -> yield Seq.singleton []
| [] -> ()
} |> Seq.cache)
I also memoized kvb solution and it performs 15% faster than mine.
// permute ["A";"B";"C"] 400 |> Seq.length |> printf "%A"
// Real: 00:00:06.587, CPU: 00:00:07.046, GC gen0: 87, gen1: 83, gen2: 4
let rec permute =
memoize2 (fun list n ->
match n with
| 0 -> Seq.singleton []
| n ->
seq {
match list with
| x::xs ->
yield! permute list (n-1) |> Seq.map (fun l -> x::l)
yield! permute xs n
| [] -> ()
} |> Seq.cache)
Here's a semi-faithful translation of Thomas Pornin's answer to F#. Note that I don't expect this to be particularly more performant than the naive approach using distinct, but it's definitely neater:
let rec splits l = function
| [] -> Seq.empty
| x::xs -> seq {
yield [],x,xs
for l,y,ys in splits xs do
yield x::l,y,ys
}
let rec combs s = function
| 0 -> Seq.singleton []
| n -> seq {
for _,x,rest in splits s do
for l in combs (x::rest) (n-1) do
yield x::l
}
Or, a variation on gradbot's solution instead:
let rec permute list = function
| 0 -> Seq.singleton []
| n -> seq {
match list with
| x::xs ->
yield! permute list (n-1) |> Seq.map (fun l -> x::l)
yield! permute xs n
| [] -> ()
}
You can do it recursively. I am writing this in Java; my F# is not good enough:
static void genCombInternal(int num, int[] base,
int min, int max, Collection<int[]> dst)
{
if (num == 0) {
dst.add(base);
return;
}
for (int i = min; i <= max; i ++) {
int[] nb = new int[base.length + 1];
System.arraycopy(base, 0, nb, 0, base.length);
nb[base.length] = i;
genCombInternal(num - 1, nb, i, max, dst);
}
}
static Collection<int[]> genComb(int num, int min, int max)
{
Collection<int[]> d = new ArrayList<int[]>();
genCombInternal(num, new int[0], min, max, d);
return d;
}
This code is completely untested. If it works, then calling genComb(num, min, max) should generate all your "combinations" of num integers in the range min to max (inclusive), such that no two returned combinations are equal save for ordering.
This is very close to the code which generates "true" combinations. The trick is in the allowed integers at each step: if you change i into i+1 in the recursive call, then you should get the mathematical combinations.
Given your "alphabet" of {1,11}, then you basically want to generate all "words" of length n, where n is the number of aces, such that all of the 1's (0 or more) are to the left and all of the 11's are to the right. The ordering does not matter, this is just a simple approach to iterate through the combinations that you care about.
In Python:
n = 3 # number of aces
hands = []
for i in range(0,n+1):
hands.append([1] * (n-i) + [11] * i)
Or even simpler in Python:
hands = [[1]*(n-i) + [11]*i for i in range(0,n+1)]
To get the total score per hand:
scores = [sum(hand) for hand in hands]
A note on Python syntax in case you are unfamiliar, brackets [] denote a list and [1]*x means create a new list that is the concatenation of x copies of [1]; that is,
[1] * x == [1,1,1]
if x = 3
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