In[]:=
<<MaTeX`;​​Framed
MaTeX[
]
,RoundingRadius20,FrameStyleDirective[Red,Thick]
Out[]=
Revisit IMO 2009 Short List N2
The following code are inspired by Dr Penn's video about this problem. The code is to efficiently find the instances of a’s and b’s satisfying the condition in the problem on a smaller yet adequate scale for the first question. I quickly sketch the proof here and please refer to the linked video for details.

Problem

Usually IMO problems are categorized as
◼
  • G: Geometry
    • ◼
  • A: Algebra
    • ◼
  • C: Combinatorics
    • ◼
  • N: Number Theory
    • Here N2 indicates that the question is the second entry in the list of problems under the number theory category.
    In[]:=
    MaTeX[
    ]
    //Framed
    Out[]=

    Analysis

    Let’s take a look at a few examples for balanced and unbalanced number in this particular context.
    ◼
  • All prime numbers 2, 3, 5, 7, 11, 13 ... are unbalanced (all with power = 1 = odd)
    • ◼
  • 4 and 6 are balanced because 4 = 2 x 2 and 6 = 2 x 3.
    Both can be written as a product of an even number of not necessarily distinct primes
    • ◼
  • 12 is unbalanced because 12 = 2 x 2 x 3, there are three primes in total and 3 is an odd number.
    • ◼
  • 8 and 27 are unbalanced because 8 = 2 x 2 x 2 and 27 = 3 x 3 x 3 but 8 x 27 = 216 is a balanced number because there are 6 primes in total.
    • FactorInteger is the built-in function in Wolfram Language to break an integer into primes components together with their multiplicities. For instance,
    In[]:=
    FactorInteger[12]
    Out[]=
    {{2,2},{3,1}}
    Add up the second item in each list and I have 2 + 1 = 3, which is an odd number. Again, I can tell that 12 is unbalanced with this method. The following test function is simply based on this feature
    balancedQ[1]=1(*bydefinitionintheproblem.1meansbalancedand0unbalanced*)
    Out[]=
    1
    In[]:=
    balancedQ[n_]:=Boole[EvenQ[Total[FactorInteger[n]〚All,2〛]]];
    I can show the balance quickly for the first 15 numbers. You can manually check the result for these small numbers.
    In[]:=
    TableForm[{balancedQ/@Range[15]},TableHeadings{{"Balanced?"},Range[15]}]
    Out[]//TableForm=
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    Balanced?
    1
    0
    0
    1
    0
    1
    0
    0
    1
    1
    0
    0
    0
    1
    1
    To test P(x) = (x + a)(x + b), I can use balancedQ function on each factor first and determine the product with the parity of sum of prime powers in each factor, (x + a) and (x + b) respectively. This is based on
    ◼
  • odd + odd = even
    (the product of two balanced numbers is balanced,
    e.g 16 x 63 = (2 x 3 x 3) x ( 3 x 3 x 7 ), total of prime power = 3 + 3 = 6 = even )
    • ◼
  • even + even = even
    (the product of two unbalanced numbers is balanced,
    e.g 8 x 27 with sum of prime 3 + 3 = even)
    • ◼
  • odd + even = odd
    (the product of a balanced numbers and a unbalanced number is unbalanced,
    e.g. 5 x 6 = 5 x (2 x 3) is unbalanced because sum of prime power is 1 + (1+1) = 3 = odd )
    • For P(1), P(2), ... P(50), I just need to find proper a and b such that in both {(a + 1), (a + 2), ..., (a + 50)} and {(b + 1), (b + 2), ..., (b + 50)}, for each k, I must have
    ◼
  • both (a + k) and (b + k) are balanced
    • or
    ◼
  • both (a + k) and (b + k) are unbalanced
    • When I apply balancedQ to each term, the function encodes each (a + k) and (b + k ) to either 0 and 1. And I can express the balance from (a + 1), (a + 2) to (a + 50) as a list of binaries (and convert the list to a decimal number later). For instance for a = 30 and b = 101
    In[]:=
    aList=Range[31,80](*(a+1),(a+2),...,(a+50)*);​​bList=Range[102,151](*(b+1),(b+2),...,(b+50)*);
    In[]:=
    aEncoded=balancedQ/@aList
    Out[]=
    {0,0,1,1,1,1,0,1,1,1,0,0,0,0,0,1,0,0,1,0,1,0,0,1,1,1,1,1,0,1,0,1,0,1,1,0,0,0,1,0,0,0,0,1,0,0,1,0,0,0}
    In[]:=
    bEncoded=balancedQ/@bList
    Out[]=
    {0,0,1,0,1,0,0,0,0,1,0,0,0,1,0,0,1,1,0,1,1,1,0,0,1,0,0,1,0,0,1,1,1,1,1,0,0,0,1,1,1,1,1,1,1,0,0,0,1,0}
    Notice the encoded list of a + k is different from that of b + k for some k. e.g. the fourth position in both lists are not the same, thus P(x) = (x + 30 )( x +101 ) is not balanced at P(4).So a = 30 and b =101 are not my solution. The other way to compare is just convert the two binary list to a decimal number:
    In[]:=
    power=50;
    In[]:=
    base=2^Range[0,power-1,1];
    In[]:=
    aEncoded.base
    Out[]=
    79468430656444
    In[]:=
    bEncoded.base
    Out[]=
    316417911759380
    Apparently these two numbers are not identical. I am going to find out if there exists such a and b in the first 100 million numbers. First encoding all numbers
    encodings=ParallelTable[balancedQ[i],{i,10^8}];
    Convert every 50 consecutive binaries in to a decimal number just like sliding window: 1~50, 2~51 and so on.
    slidingWindow=ListConvolve[base,encodings];
    I use Tally to list each distinct number together with their multiplicities
    In[]:=
    occurrenceCount=Tally[slidingWindow];
    Collect all multiplicities and to see if there are any value large or equal to 2.
    In[]:=
    Histogram[occurrenceCount[[All,2]],Automatic,{"Log","Count"},Ticks{Range[10],Automatic}]
    Out[]=
    Among the 100 million numbers, the bin on the right hand side of the histogram above says only 10 pairs of them can be chosen as (a,b) as solutions. They can be found by
    In[]:=
    sol=Cases[occurrenceCount,{_,_?(#>=2&)}]
    Out[]=
    {{630488566897300,2},{819948358608053,2},{513996810373483,2},{1027993620746966,2},{257419067696400,2},{514838135392801,2},{1029676270785602,2},{933452634728581,2},{741005362614538,2},{249057486261756,2}}
    For instance, I can find (a,b) based on the first result in the list above
    In[]:=
    Flatten[Position[slidingWindow,630488566897300]]-1
    Out[]=
    {18103404,82425204}
    It tells me that a = 18103404 and b = 82425204 I can check if the balance of the two lists are correspondingly identical for each element
    ◼
  • (a + 1), (a + 2), ..., (a + 50)
    • ◼
  • (b + 1), (b + 2), ..., (b + 50)
    • In[]:=
    balancedQ/@(Range[1,50]+18103404)
    Out[]=
    {1,0,0,0,1,1,1,1,0,1,0,1,1,0,1,1,0,1,0,0,0,0,1,1,1,1,0,0,0,1,0,0,0,0,1,0,0,1,1,0,1,0,1,0,0,1,0,1,0,0}
    In[]:=
    balancedQ/@(Range[1,50]+82425204)
    Out[]=
    {1,0,0,0,1,1,1,1,0,1,0,1,1,0,1,1,0,1,0,0,0,0,1,1,1,1,0,0,0,1,0,0,0,0,1,0,0,1,1,0,1,0,1,0,0,1,0,1,0,0}
    Therefore P(x) = ( x + 18103404 )(x + 82425204) is balanced for P(1) P (2) ... and P(50). All candidates for such (a,b) under 100 million are
    In[]:=
    Once[index=PositionIndex[slidingWindow]];​​TableForm[​​index/@sol[[All,1]]-1,​​TableHeadings{None,{"a","b"}}]//Framed

    Summary

    ◼
  • Use FactorInteger to find prime factors of an integer
    • ◼
  • Calculate the sum of power of primes and check its parity for being balanced or not
    • ◼
  • Use either binary or decimal number to encode any list of number from a + 1 to a + 50
    • ◼
  • Use Tally to list distinct elements with their multiplicity
    • ◼
  • Use Histogram and Cases to count and find the target values
    • ◼
  • Use a shorter length than 50 to save time and memory.
    e.g find a and b, less than 1 million, so that from P(1) to P(25) all balanced
    • ◼
  • SE link for the number spiral design

    • Functions used in Analysis