5
$\begingroup$

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?

$\endgroup$
  • 7
    $\begingroup$ By not generating all permutations. These Project-Euler problems are designed so that direct brute-force approach does not work. $\endgroup$ – Henrik Schumacher Apr 30 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 Apr 30 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 Apr 30 at 18:18
10
$\begingroup$

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

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


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

enter image description here

See: Number of palindromic permutations

| improve this answer | |
$\endgroup$
  • $\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$ – Please Correct GrammarMistakes Apr 30 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 Apr 30 at 12:51
  • $\begingroup$ I have updated my question. $\endgroup$ – Please Correct GrammarMistakes May 1 at 1:50
1
$\begingroup$

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.

Clear["Global`*"];
ans = {};
Do[
  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]
ans
p1 = 2; p2 = 0; p3 = 1; p4 = 0; p5 = 0; c = 5;
Monitor[While[True,
    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];
c
CoefficientList[
  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}
| improve this answer | |
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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