# How to calculate the number of partial derangements of a multiset in Mathematica?

I have found some helpful information on enumerating derangements at https://math.stackexchange.com/questions/4645664/the-number-of-partial-derangements-of-a-52-card-deck-ignoring-suits, https://sites.math.rutgers.edu/~zeilberg/mamarim/mamarimPDF/multider.pdf, and https://math.stackexchange.com/questions/147657/derangements-of-multisets.

I have designed a function to enumerate derangements of a multiset:

EnumerateMultisetDerangments // ClearAll
EnumerateMultisetDerangements[multiset_] :=
(*Length[ResourceFunction["MultisetDerangements"][multiset]]*)
Module[
{numberOfRepeatedElementsAssociation, numberOfRepeatedElementsValues},
numberOfRepeatedElementsAssociation = Counts[multiset];
numberOfRepeatedElementsValues = Values[numberOfRepeatedElementsAssociation];
Abs@
Integrate[
Product[LaguerreL[n, x], {n, numberOfRepeatedElementsValues}] Exp[-x],
{x, 0, Infinity}
]
]


I am interested in generalizing this program to the case of partial derangements. In other words, I'd like to construct a similar function to the one above: let's call it for example EnumerateMultisetPartialDerangements. How can I do this?

I've tried to understand the Python program given in an answer to The number of partial derangements of a 52-card deck (ignoring suits), but I couldn't figure it out.

This function lists all multiset partial derangements:

PartialDerangements // ClearAll
PartialDerangements[set_,
number_?(IntegerQ[#] && # \[Element] NonNegativeIntegers &)] :=
Select[Count[SameQ @@@ Transpose[{#, set}], False] === number &][
Permutations[set]]

MultisetPartialDerangements // ClearAll
MultisetPartialDerangements[set_, number_,
Optional[limit_,
All]] :=(*Module[{length,assoc,derangements,list1},length=Length[\
derangements=PartialDerangements[set,number];list1=Table[Lookup[assoc,\
Equal,{set,#}],True]==number&][Permutations[set]],limit]]*)
Take[Select[Count[MapThread[Equal, {set, #}], True] == number &][
Permutations[set]], limit]


I'd like my desired EnumerateMultisetPartialDerangements to return the value of Length@ EnumerateMultisetPartialDerangements[set], but without actually generating all the partial derangements. How can I do this?

I think the solution hinges on the integral of a product of Laguerre polynomials times $$\exp(-x)$$ from 0 to $$\infty$$.

I would also like a solution that is fast enough to reproduce the answer for https://math.stackexchange.com/questions/4645664/the-number-of-partial-derangements-of-a-52-card-deck-ignoring-suits in a reasonable amount of time for a standard deck of 52 cards with 0 to 52 fixed points. I have only been able to calculate this for 0 to 6 fixed points. This took 334.672 s.

It seems the person who calculated this for all values from 0 to 52 fixed points must have used a faster method. I think the thing that's slowing down the calculation is Subsets.

• I might be the only one but I'm not at all clear as to what you're asking. You ask about generalizing the first set of code to EnumerateMultisetPartialDerangements. Then you show code for a function that "lists all multiset partial derangements". But the code doesn't give any specific example. Are you asking help to debug code or write code? Clearly I'm not understanding.
– JimB
Commented Jul 6, 2023 at 23:43
• I don't want to list all the multiset partial derangements then, call Length to find the number of derangements of multisets. I want to calculate the number with a formula, like how you can use Binomial, instead of calling Length on Subsets. Commented Jul 7, 2023 at 0:25
• For more details, see math.stackexchange.com/questions/4731810/…. Commented Jul 7, 2023 at 0:26

### 1.

ClearAll[countPartialDerangements]

countPartialDerangements[lst_, nfixed_] := Count[Permutations[lst],
p_ /; Inner[SameQ, p, lst, BooleanCountingFunction[{nfixed}, Length@lst]]]


Examples:

lst = {green, blue, blue, green, green, green, red, blue, red};

Grid[{Prepend["fixed"] @ #,
Prepend["count"] @ Map[countPartialDerangements[lst, #] &] @ #} & @ Range[0, 9],
Dividers -> All]


### 2.

Using the function DerangementsCount from the docs LaguerreL > Applications:

ClearAll[DerangementsCount, vCounts, partialDerangementsCount]

DerangementsCount[nvec_List] := Integrate[
Exp[-x] Times @@ ((-1)^nvec LaguerreL[nvec, x]), {x, 0, ∞}]

vCounts[lst_, nfixed_] := Counts @ Map[Sort @* Values @* Counts] @
Subsets[lst, {Length @ lst - nfixed}]

partialDerangementsCount[lst_, nfixed_] := Total @
KeyValueMap[#2 DerangementsCount @ # &] @ vCounts[lst, nfixed]


Examples:

lst = {green, blue, blue, green, green, green, red, blue, red};

Grid[{Prepend["fixed"] @ #,
Prepend["count"] @ Map[partialDerangementsCount[lst, #] &] @ #} & @ Range[0, 9],
Dividers -> All]


• You could take the absolute value instead of multiplying by -1 to a power because you know the result will be nonnegative. Commented Jul 8, 2023 at 12:08
• Good point @PeterBurbery. (Copied that piece from the docs.)
– kglr
Commented Jul 8, 2023 at 12:32
• I tried to make this work with a set with 52 elements for a deck of cards but it slowed down because of Subsets. Is there a way to speed this up without the slowdown from Subsets? Thank you for providing a solution to the problem. Commented Jul 22, 2023 at 1:37
• @PeterBurbery, can' t think of a way to make either method faster to handle 52 - deck . Perhaps someone can translate to mma the code in this answer in the link you provided.
– kglr
Commented Jul 22, 2023 at 13:31