Misaddressed letters problem with mathematica

[raulitopomper]

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

 

[Bill Simpson]

If you provide a URL for where you found that formula then perhaps someone can help you solve this.

 

[raulitopomper]

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

 

[Simon_Tyler]

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):

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

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)
$$A(n) = \frac{\Gamma (2,-1) \Gamma (n+1)-\Gamma (n+1,-1)}{2 \Gamma (2,-1)-\Gamma (3,-1)}$$

If you don't want to use the closed form solution, you can implement the recursion using

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" 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

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

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

In[7]:= And@@Table[B[n]==A[n], {n, 1, 200}]
Out[7]= True

 

[Subutai]

Or you could use the formula N(n)=floor(n!/e+1/2). Check wikipedia on derangements.

 

[Simon_Tyler]

That's if you want to treat the question as more than a simple Mathematica example!