I want to solve this problem:

The number 6 can be written as a palindromic sum in exactly eight different ways:

(1,1,1,1,1,1),(1,1,2,1,1),(1,2,2,1),(1,4,1),(2,1,1,2),(2,2,2),(3,3),(6) We shall define a twopal to be a palindromic tuple having at least one element with a value of 2. It >should also be noted that elements are not restricted to single digits. For example, (3,2,13,6,13,2,3) >is a valid twopal.

If we let t(n) be the number of twopals whose elements sum to n, then it can be seen that t(6)=4:

(1,1,2,1,1),(1,2,2,1),(2,1,1,2),(2,2,2) Similarly, t(20)=824.

In searching for the answer to the ultimate question of life, the universe, and everything, it can be >verified that t(42)=1999923, which happens to be the first value of t(n) that exceeds one million.

However, your challenge to the "ultimatest" question of life, the universe, and everything is to find the least value of n>42 such that t(n) is divisible by one million.

I quickly got the value of t(20) using the following method:

   Count[(Flatten[Permutations /@ Evaluate[IntegerPartitions[20, All]], 
        1]) // DeleteDuplicates, u_ /; u == Reverse[u] && MemberQ[u, 2]]

However, when I use the above method to solve t(42), I am prompted that the memory is insufficient. How can I avoid memory overflow errors?

  • 7
    $\begingroup$ By not generating all permutations. These Project-Euler problems are designed so that direct brute-force approach does not work. $\endgroup$ Commented Apr 30, 2020 at 9:29
  • 2
    $\begingroup$ You can get a smaller set of candidates before using Permutations. For example, (Select[Not[FreeQ[2]@#] && Count[Tally[#][[All, 2]], _?OddQ] <= 1 &]@ IntegerPartitions[20, All]) $\endgroup$
    – kglr
    Commented Apr 30, 2020 at 9:48
  • 3
    $\begingroup$ Note that except for the first few problems, PE problems are intentionally infeasible by a brute force approach. You usually have to rethink the problem mathematically first, to have it in a form that is computationally manageable. Here you are essentially asking that someone does this work for you. $\endgroup$
    – user72309
    Commented Apr 30, 2020 at 18:18

2 Answers 2


"when I use the above method to solve t(42), I am prompted that the memory is insufficient. How can I avoid memory overflow errors?"

twoPalCount = Total @* 
 Map[Multinomial @@ Floor[Values[Counts@#]/2] &] @*
 Select[Not[FreeQ[2]@#] && Count[Tally[#][[All, 2]], _?OddQ] <= 1 &] @*

{#, twoPalCount@#} & /@ Range[42] // Grid

enter image description here

See: Number of palindromic permutations

  • $\begingroup$ Thank you very much for your answer. The efficiency of your code has been improved a lot. But the question requires that the result can be divisible by one million. This number is too large, and the code still needs further improvement. $\endgroup$ Commented Apr 30, 2020 at 11:23
  • 3
    $\begingroup$ @PleaseCorrectGrammarMistakes, you might want to add the part "the question requires that the result can be divisible by one million" to your question from the link you provided. $\endgroup$
    – kglr
    Commented Apr 30, 2020 at 12:51
  • $\begingroup$ I have updated my question. $\endgroup$ Commented May 1, 2020 at 1:50

Reprint the answer of MuthuVeerappanR in the forum of Project-Euler.

The generating function of palindromic compositions with u marking the number of 2's is given by

$$\displaystyle P(z,u)=\sum_{n,k}p(n)z^nu^k=\frac{1+x+ux^2+x^3+x^4+\cdots}{1-x^2-u^2x^4-x^6-x^8-\cdots}=\frac{(u-1)x^2+(1-x)^{-1}}{2-(u^2-1)x^4-(1-x^2)^{-1}}$$

This gives, $\displaystyle T(z)=\sum_{n=0}^\infty t(n)z^n=P(z,1)-P(z,0)=\frac{z^2(1-z^2)}{1-3z^2-z^3+2z^4+2z^5}$.

From this we get the linear recursion that solves the problem.

ans = {};
  res = SeriesCoefficient[(1 + x + y x^2 + 
       Sum[Power[x, k], {k, 3, j}])/(1 - x^2 - y^2 x^4 - 
       Sum[Power[x, k], {k, 6, j, 2}]), {x, 0, j}];
  res = (res /. y -> 1) - (res /. y -> 0);
  ans = Join[ans, {res}];
  , {j, 0, 20}];
FindGeneratingFunction[ans, z]
p1 = 2; p2 = 0; p3 = 1; p4 = 0; p5 = 0; c = 5;
    temp = Mod[3 p2 + p3 - 2 p4 - 2 p5, 1000000];
    {p1, p2, p3, p4, p5} = {temp, p1, p2, p3, p4};
    If[temp == 0, Break[];];
    c += 1;
    ];, c];
  PolynomialMod[Power[z, 42], 
   Power[z, 5] - 3 Power[z, 3] - Power[z, 2] + 2 Power[z, 1] + 2], 
  z].{0, 0, 1, 0, 2}

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.