Can I find all multisets of given size more efficiently?

Question

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.

Answer 1

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.

Answer 2

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

Answer 3

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
    | [] -> () 
  }

Answer 4

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.

Answer 5

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)