Suppose $p_1,\ldots,p_d$ and $q_1,\ldots,q_d$ are positive real numbers such that

$$p_1+\cdots+p_d=q_1+\cdots+q_d=n$$

and

$$p_1 \log p_1+\cdots+p_d\log p_d=q_1 \log q_1+\cdots+q_d \log q_d $$

Then the following seems to hold

$$\frac{n!}{p_1!\cdots p_d!}=\frac{n!}{q_1!\cdots q_d!}$$

why?

**Edit**: JBL correctly notices that it doesn't always hold. I just didn't go far enough.
Still, it's surprising to me that it holds so frequently.

If we put a black disk at x,y if equality seems to hold (in machine precision) for x=n,y=d, and positive integer coefficients, it'll look like this

Red circle is JBL's example. Blue circle is n=18,d=3 which fails for (12,3,3) and (9,8,1).

docheck[n_, d_] := ( coefs = IntegerPartitions[n, {d}, Range[1, n]]; entropy[x_] := N[Total[# Log[#] & /@ x]]; groupedCoefs = GatherBy[coefs, entropy]; allEqual[list_] := And @@ (First[list] == # & /@ list); multinomials = Apply[Multinomial, groupedCoefs, {2}]; And @@ (allEqual /@ multinomials) ); vals = Table[docheck[#, d] & /@ Range[1, 30], {d, 1, 20}]; Graphics[Table[Disk[{n, d}, If[vals[[d, n]], .45, .1]], {d, 1, Length[vals]}, {n, 1, 30}]]

**Edit:**
Updated version that does exact checking and allows coefficients with 0 components. Still only one example of failure for d=3.

docheck[n_, d_] := (coefs = IntegerPartitions[n, {d}, Range[0, n]]; entropy[x_] := Exp[Total[If[# == 0, 0, # Log[#]] & /@ x]]; groupedCoefs = GatherBy[coefs, entropy]; allEqual[list_] := And @@ (First[list] == # & /@ list); multinomials = Apply[Multinomial, groupedCoefs, {2}]; And @@ (allEqual /@ multinomials)); maxn = 30; maxd = 20; vals = Table[docheck[#, d] & /@ Range[1, maxn], {d, 1, maxd}]; Graphics[Table[Disk[{n, d}, If[vals[[d, n]], .45, .1]], {d, 1, Length[vals]}, {n, 1, maxn}]]

2more comments