7
$\begingroup$
  1. I allow them to be chosen more than once (e.g. allow {1,1}).

    (A subset means every element is chosen once or less)

  2. Also I neglect the order (e.g. {1,2} is the same as {2,1}).

    (In other word, I need either {1,2} or {2,1}, not both.)


Let's say the set s = {a, b}. (whose Length is $n$)

  • Subsets gives {{}, {a}, {b}, {a, b}}. (length: $2^n$)

  • Tuples[s, n] gives {{a, a}, {a, b}, {b, a}, {b, b}}. (length: $n^n$)

  • Permutations gives {{a, b}, {b, a}}. (length: $n!$)

  • What I want is {{}, {a}, {b}, {a,a}, {a,b}, {b,b}}.

    There's no {b,a}. (Besides, it's OK to generate {b,a} instead of {a,b})

    (length: I can't work out the exact formula now, but I guess it's between $2^n$ and $n^n$)


I didn't find anything identical, but I know that I can make Tuples from $0$ to $n$, then DeleteDuplicatesBy[Sort]. However it's kind of silly, as most of the tuples will be deleted.

Full code: Table[Tuples[s, i], {i, 0, n}] // Flatten[#, 1] & // DeleteDuplicatesBy[Sort]

Is there a neat way to do that?

$\endgroup$
5
  • $\begingroup$ Try: Flatten[Tuples[{a, b}, #] & /@ Range[0, 2], 1] $\endgroup$ Commented Mar 20, 2022 at 8:28
  • 1
    $\begingroup$ @DanielHuber Thanks, but it generates more than I want: either {a, b} or {b, a}, not both. (I now split the goal into an ordered list to emphasize that.) $\endgroup$
    – Y.D.X.
    Commented Mar 20, 2022 at 8:44
  • $\begingroup$ Well with an addition we may also deal with this, but it is getting a bit cryptical: Union[Sort /@ Flatten[Tuples[{a, b}, #] & /@ Range[0, 2], 1]] $\endgroup$ Commented Mar 20, 2022 at 9:58
  • $\begingroup$ @DenialHuber This is similar to the “Full code” in the question. There I use Table instead of Range, x // f instead of f[x]. $\endgroup$
    – Y.D.X.
    Commented Mar 20, 2022 at 10:04
  • $\begingroup$ Related: equivalent-nested-loop-structure, fastest-way-to-generate-a-a-a $\endgroup$
    – chyanog
    Commented Jul 4, 2022 at 13:00

3 Answers 3

9
$\begingroup$

You want an increasing sequence. https://mathematica.stackexchange.com/a/235768/72111

That is, for $$1\leq a_1 \leq a_2\leq \cdots \leq a_{n}\leq m$$

We set $$b_k=a_k+k$$ then $$2\leq b_1< b_2<\cdots<b_n\leq m+n$$ It means that $(b_1,b_2,\cdots,b_n)$ is the $n$ subsets of Range[2,m+n]

m = 5;
n = 3;
list = Subsets[Range[2, m + n], {n}]
result = Subtract[#, Range[n]] & /@ list
{a,b,c,d,e}[[#]] & /@ result

{{a, a, a}, {a, a, b}, {a, a, c}, {a, a, d}, {a, a, e}, {a, b, b}, {a, b, c}, {a, b, d}, {a, b, e}, {a, c, c}, {a, c, d}, {a, c, e}, {a, d, d}, {a, d, e}, {a, e, e}, {b, b, b}, {b, b, c}, {b, b, d}, {b, b, e}, {b, c, c}, {b, c, d}, {b, c, e}, {b, d, d}, {b, d, e}, {b, e, e}, {c, c, c}, {c, c, d}, {c, c, e}, {c, d, d}, {c, d, e}, {c, e, e}, {d, d, d}, {d, d, e}, {d, e, e}, {e, e, e}}

$\endgroup$
2
  • $\begingroup$ Save me! My problem is even simpler than it. (n == m) $\endgroup$
    – Y.D.X.
    Commented Mar 20, 2022 at 10:00
  • $\begingroup$ Sum[Binomial[m + n - 1, n], {n, 0, m}] // FullSimplify $\endgroup$
    – cvgmt
    Commented Mar 22, 2022 at 9:43
4
$\begingroup$

I will use the answer by @cvgmt to get a handle on the number of elements in the list of "subsets".

Setting m == n and ignoring the alphabetical symbols, here are the lengths for the $n = 0, \ldots, 12$:

Length /@
  Table[
    Table[
      Subtract[#, Range[i]] & /@ Subsets[Range[2, 2 i], {i}],
      {i, 0, n}
    ] // Flatten[#, 1] &,
    {n, 0, 12}
  ]

(* {1, 2, 5, 15, 50, 176, 638, 2354, 8789, 33099, 125477, 478193, 1830271} *)

This sequence is identified as A024718 by Sequence Machine at sequencedb.net. The associated formula for the $n$-th term is

(1/2)*(1 + Sum[Binomial[2*k, k], {k, 0, n}])

(* 1/2 (1 - I/Sqrt[3] - 
   Binomial[2 (1 + n), 1 + n] * Hypergeometric2F1[1, 3/2 + n, 2 + n, 4]) *)
$\endgroup$
2
  • 1
    $\begingroup$ I can't access the sequencedb.net with HTTPS. Is it HTTP? (same sequence on OEIS) $\endgroup$
    – Y.D.X.
    Commented Mar 21, 2022 at 1:47
  • $\begingroup$ @Y.D.X. You are correct. I fixed it. Thank you. $\endgroup$
    – mef
    Commented Mar 21, 2022 at 8:38
3
$\begingroup$
ascendingPositions = Position[Nest[Range, Range @ #, # - 1], _,  Heads -> False] &;

subsetsWithDupes = Extract[#, Map[List] @ ascendingPositions @ Length @ #] &;

Examples:

subsetsWithDupes[{a, b}]
 {{a, a}, {a}, {b, a}, {b, b}, {b}, {}}
subsetsWithDupes[{a, b, c}]
{{a, a, a}, {a, a}, {a}, {b, a, a}, {b, a}, {b, b, a}, {b, b, b},
 {b, b}, {b}, {c, a, a}, {c, a}, {c, b, a}, {c, b, b}, {c, b},
 {c, c, a}, {c, c, b}, {c, c, c}, {c, c}, {c}, {}}
subsetsWithDupes[{a, b, c, d}]

enter image description here

Count[Nest[Range, Range@#, # - 1], _, All] & /@ Range[12]
{2, 6, 20, 70, 252, 924, 3432, 12870, 48620, 184756, 705432, 2704156}
FindSequenceFunction[%, n]
 Binomial[2 n, n]
$\endgroup$
2
  • $\begingroup$ Great idea. Could you explain Position[#, _, Heads -> False]& in ascendingPositions? I can even work out its result step by step, but I have no idea what it really does. $\endgroup$
    – Y.D.X.
    Commented Mar 21, 2022 at 1:37
  • $\begingroup$ @Y.D.X., Position >> Details: With the default option setting Heads->True, Position includes heads of expressions and their parts. Heads >> Details: Heads->False never includes heads as part of any level of an expression. $\endgroup$
    – kglr
    Commented Mar 22, 2022 at 8:10

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.