6
$\begingroup$

How can I visualise/represent "Stars and Bars" in Mathematica?

Say I have $n$ balls and $k$ slots to fill (or not to fill) with balls, e.g. when $n=4$ and $k=4$,

**|*||*, ***|||*, ...

There are two cases to consider: a) no slots are allowed to be empty and b) a slot/several slots are allowed to be empty.

I thought that a representation with tuples would be good, e.g. {2, 1, 0, 1} and {3, 0, 0, 1} for the two samples above.

I tried with Tuples but did not get anywhere. Does anyone have a solution?

TIA.

$\endgroup$
8
$\begingroup$

Here's one possibility:

With[{n = 4, k = 4}, 
     StringJoin[Riffle[Table["*", {#}] & /@ #, "|"]] & /@ FrobeniusSolve[Table[1, {k}], n]]
   {"|||****", "||*|***", "||**|**", "||***|*", "||****|", "|*||***", "|*|*|**", "|*|**|*",
    "|*|***|", "|**||**", "|**|*|*", "|**|**|", "|***||*", "|***|*|", "|****||", "*|||***",
    "*||*|**", "*||**|*", "*||***|", "*|*||**", "*|*|*|*", "*|*|**|", "*|**||*", "*|**|*|",
    "*|***||", "**|||**", "**||*|*", "**||**|", "**|*||*", "**|*|*|", "**|**||", "***|||*",
    "***||*|", "***|*||", "****|||"}

In a comment, Jim shows that you can use IntegerPartitions[] + Permutations[] instead:

With[{n = 4, k = 4}, 
     StringJoin[Riffle[Table["*", {#}] & /@ #, "|"]] & /@ 
     Flatten[Permutations /@ IntegerPartitions[n + k, {k}] - 1, 1]]

which should yield the same result as above.


The OP also wanted to consider the case where empty slots are not allowed; a slight modification of Jim's suggestion does this. Using a different example:

With[{n = 7, k = 4}, 
     StringJoin[Riffle[Table["*", {#}] & /@ #, "|"]] & /@ 
     Flatten[Permutations /@ IntegerPartitions[n, {k}], 1]]
   {"****|*|*|*", "*|****|*|*", "*|*|****|*", "*|*|*|****", "***|**|*|*", "***|*|**|*",
    "***|*|*|**", "**|***|*|*", "**|*|***|*", "**|*|*|***", "*|***|**|*", "*|***|*|**",
    "*|**|***|*", "*|**|*|***", "*|*|***|**", "*|*|**|***", "**|**|**|*", "**|**|*|**",
    "**|*|**|**", "*|**|**|**"}
$\endgroup$
  • $\begingroup$ Are you sure about removing dupes? With[{n = 4, k = 4}, StringJoin[Riffle[Table["*", {#}] & /@ #, "|"]] & /@ (-Table[1, {k}] + # & /@ Flatten[Permutations[#] & /@ IntegerPartitions[n + k, {k}], 1])] doesn't seem to require the removal of dupes and is just slightly faster. $\endgroup$ – JimB Nov 15 at 0:15
  • $\begingroup$ That offsetting trick is neat, thanks @Jim! I'll edit this answer in a little bit. $\endgroup$ – J. M. will be back soon Nov 15 at 0:20
  • $\begingroup$ Is it possible to also get an "numeral output" i.e. {{4,1,1,1}, {1,4,1,1}...} etc.? $\endgroup$ – mf67 Nov 15 at 23:23
  • $\begingroup$ @mf67, the part after the second /@ is the numerical version; e.g. Flatten[Permutations /@ IntegerPartitions[n, {k}], 1]. $\endgroup$ – J. M. will be back soon Nov 15 at 23:46
  • $\begingroup$ Thanks. Very neat. (My lack of Mathematica knowledge is apparent.) $\endgroup$ – mf67 Nov 16 at 16:56
2
$\begingroup$

★'s and |'s with string manipulations. Use Method to switch between "Positivity" (default) and "Nonnegativity".

ClearAll[starsAndBars]
Options[starsAndBars] = {Method -> "Positivity"};
starsAndBars[n_Integer?Positive, k_Integer?Positive, opts : OptionsPattern[starsAndBars]] :=
 Module[{ip = Switch[OptionValue[Method], "Positivity", {k}, "Nonnegativity", {1, k}]},
  StringReplace[{", " -> "|", "0" -> "", num : NumberString :> StringRepeat["★", FromDigits@num]}]@
   StringTake[
    ToString /@
     Flatten[
      Permutations@*Flatten@{#, ConstantArray[0, k - Length@#]} & /@ IntegerPartitions[n, ip]
      , 1]
    , {2, -2}]
  ]

Under "Positivity"

starsAndBars[4, 3] 
{★★|★|★,★|★★|★,★|★|★★}

Under "Nonnegativity"

starsAndBars[4, 3, Method -> "Nonnegativity"] 
{★★★★||,|★★★★|,||★★★★,★★★|★|,★★★||★,
 ★|★★★|,★||★★★,|★★★|★,|★|★★★,★★|★★|,
 ★★||★★,|★★|★★,★★|★|★,★|★★|★,★|★|★★}

Empty set under "Positivity" with no solutions.

starsAndBars[4, 5, Method -> "Positivity"]
{}

Hope this helps.

$\endgroup$
  • $\begingroup$ I would replace Flatten[Permutations @* Flatten @ {#, ConstantArray[0, k - Length @ #]} & /@ IntegerPartitions[n, ip], 1] with Flatten[Permutations /@ PadRight[IntegerPartitions[n, ip], {Automatic, k}], 1]. $\endgroup$ – J. M. will be back soon Nov 15 at 3:43
  • $\begingroup$ @J.M.willbebacksoon That is a good suggestion. Thanks. $\endgroup$ – Edmund Nov 16 at 12:56

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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