7

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.

J. M.'s missing motivation
  • 124,525
  • 11
  • 401
  • 574
mf67
  • 1,293
  • 7
  • 10

2 Answers2

9

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]]
   {"****|*|*|*", "*|****|*|*", "*|*|****|*", "*|*|*|****", "***|**|*|*", "***|*|**|*",
    "***|*|*|**", "**|***|*|*", "**|*|***|*", "**|*|*|***", "*|***|**|*", "*|***|*|**",
    "*|**|***|*", "*|**|*|***", "*|*|***|**", "*|*|**|***", "**|**|**|*", "**|**|*|**",
    "**|*|**|**", "*|**|**|**"}
J. M.'s missing motivation
  • 124,525
  • 11
  • 401
  • 574
  • 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. – JimB Nov 15 '19 at 00:15
  • That offsetting trick is neat, thanks @Jim! I'll edit this answer in a little bit. – J. M.'s missing motivation Nov 15 '19 at 00:20
  • Is it possible to also get an "numeral output" i.e. {{4,1,1,1}, {1,4,1,1}...} etc.? – mf67 Nov 15 '19 at 23:23
  • @mf67, the part after the second /@ is the numerical version; e.g. Flatten[Permutations /@ IntegerPartitions[n, {k}], 1]. – J. M.'s missing motivation Nov 15 '19 at 23:46
  • Thanks. Very neat. (My lack of Mathematica knowledge is apparent.) – mf67 Nov 16 '19 at 16:56
2

★'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.

Edmund
  • 42,267
  • 3
  • 51
  • 143