Misaddressed letters problem with mathematica

Hi I'm trying to solve this famous problem with Mathematica:

"How many ways can a math professor incorrectly address Christmas cards so that no card gets to the originally intended recipient"

I found a recurrence formula but don`t know how to implement it in Mathematica, this is the formula:
N(n)=(n-1)[N(n-2)+(n-2)[N(n-3)+(n-3)[N(n-4)+(n-4)[...]]]]

thank you
 
1,058
23
If you provide a URL for where you found that formula then perhaps someone can help you solve this.
 
I found the solution by my self, anyway I found the way to do it! just have to realize that
(n-2)[N(n-3)+(n-3)[N(n-4)+(n-4)[...]]]]=N(n-1)
in any case, would it be any way to introduce in mathematica a recurrence formula with a for or do loop?? so in case a large number of products or sums appear it can be done? thanks
 
Given your observation, it turns into a 2-term recurrence that Mathematica can solve in terms of incomplete Euler Gamma functions (I use A instead of N, since N is a built-in symbol):
Code:
In[1]:= RSolve[A[n]==(n-1)(A[n-2]+A[n-1]),A[n],n]
Out[1]= {{A[n]->C[1] n!+(2 C[2] n! (-E+Gamma[1+n,-1]/Gamma[1+n]))/E}}
C[1] and C[2] are related to the initial conditions. From the problem stated it should be that A[1]=0, A[2]=1 so that
Code:
In[2]:= RSolve[A[n]==(n-1)(A[n-2]+A[n-1])&&A[1]==0&&A[2]==1,A[n],n]
Out[2]= {{A[n]->(Gamma[1+n] Gamma[2,-1]-Gamma[1+n,-1])/(2 Gamma[2,-1]-Gamma[3,-1])}}
or, using traditional notation (TraditionalForm)
[TEX]A(n) = \frac{\Gamma (2,-1) \Gamma (n+1)-\Gamma (n+1,-1)}{2 \Gamma (2,-1)-\Gamma (3,-1)}[/TEX]

If you don't want to use the closed form solution, you can implement the recursion using
Code:
In[3]:= A[1]=0;A[2]=1;A[n_]:=A[n]=(n-1)(A[n-2]+A[n-1])
Where I have used http://en.wikipedia.org/wiki/Memoization" [Broken] to prevent the exponential growth in the calculation of the lower terms.

You can check that it give the same results as the closed form solution
Code:
In[4]:= ASoln[n_]:=(Gamma[2,-1] Gamma[n+1]-Gamma[n+1,-1])/(2 Gamma[2,-1]-Gamma[3,-1])
In[5]:= And@@Table[A[i]==ASoln[i],{i,1,200}]//FunctionExpand//FullSimplify
Out[5]= True
the above is a tiny bit slow because the simplification of the incomplete gamma functions is slow.

Finally, your original formula can be implemented as
Code:
B[0] = 1;
In[6]:= B[n_]:=B[n]=Sum[Product[(n-j), {j, 1, i}] B[n-i-1], {i, 1, n}]
The product term in the above is just the Pochhammer symbol - or rising factorial.

You can test it with
Code:
In[7]:= And@@Table[B[n]==A[n], {n, 1, 200}]
Out[7]= True
 
Last edited by a moderator:
Or you could use the formula N(n)=floor(n!/e+1/2). Check wikipedia on derangements.
 
That's if you want to treat the question as more than a simple Mathematica example!
 

The Physics Forums Way

We Value Quality
• Topics based on mainstream science
• Proper English grammar and spelling
We Value Civility
• Positive and compassionate attitudes
• Patience while debating
We Value Productivity
• Disciplined to remain on-topic
• Recognition of own weaknesses
• Solo and co-op problem solving
Top