Ceiling towers equal to positive integer​
​by Shenghui Yang
Let’s take a look at the AOPS post on its Facebook page today. The animation shows a general solution for any integer can be put on the right hand side of equation just like the lucky number 7.
The algorithm and the implementation contains solutions for both positive and negative
r
’s.
Use Fold to create such tower for arbitrary length. The number 5 in the code to control the levels of the tower. In general,
n
generate
n+1
levels.
In[]:=
Style[Fold[#2*Ceiling[#1]&,r,ConstantArray[r,5]]//TraditionalForm,16]
Out[]=
r⌈r⌈r⌈r⌈r⌈r⌉⌉⌉⌉⌉
In particular, I am only interested in the case from the original problem:
In[]:=
f[r_]:=rCeiling[rCeiling[rCeiling[rCeiling[rCeiling[r]]]]]
And later you see the algorithm, this specification really does not matter the code, only the numeric result.

Analysis

◼
  • The first step is to think about simplest cases when
    r
    is an positive integer
    • I can simply remove all ceiling function and partition the integers with these end points. Say I choose
    In[]:=
    Array[f,5]
    Out[]=
    {1,64,729,4096,15625}
    Candidates of the RHS of the equation, M, can be partition using following intervals. That is
    (n-1)≤M<
    4
    n
    (the left side is inclusive and the right hand side is strict). Also we notice that this function is non-decreasing.
    In[]:=
    LogPlot[f[r],{r,1.,5},GridLines{None,{1,64,729,4096,15625}}]
    Out[]=
    We usually need to choose a proper interval to analyze the solution for a jumpy cut-off function. For Floor and Ceiling functions, it is always convenient to assume the solution is of the form
    1+ϵ
    ,
    2+ϵ
    ,
    3+ϵ
    , and so on with
    0<=ϵ<1
    (left inclusive and right strict). We know
    ⌈r⌈r⌈r⌈r⌈r⌉⌉⌉⌉⌉
    returns an integer
    K
    , thus the origin equation can be convert to two simultaneous inequality for
    K
    . Once the range of
    K
    is determined, we test finitely many
    K
    ’s to see if the original equation is satisfied.
    For instance
    1<=r<2
    ,there are some integers less than 64 can have valid solution for r , other than 7.
    In[]:=
    Plot[f[r],{r,1.,1.5},GridLines{None,Range[1,20]},​​Ticks{Automatic,Range[7,20]},AxesLabel{"r",f[r]},LabelStyle14]
    Out[]=
    Let’s say this valid integer is
    M
    (number on the Y axis in the diagram above and have grid line intersecting with the curve
    f[r]
    ). The original tower is then
    (1+ϵ)*r⌈r⌈r⌈r⌈r⌈r⌉⌉⌉⌉⌉=(1+ϵ)*K=M
    .
    Solve for ϵ we have
    ϵ=-1+M/K
    which is between 0 (inclusive) and 1 (exclusive). Say
    M=7
    , the range for integer
    K
    is
    Ceiling[M/2]=Ceiling[3.5]=4
    to
    Floor[M/1]=7
    In[]:=
    Reduce[0<=-1+7/k<1,{k},PositiveIntegers]
    Out[]=
    k4||k5||k6||k7
    The denominator of the expression in the ceiling and floor functions are from the integer part of the solution
    r=x+ϵ
    . In general, the two denominators are
    x+1
    and
    x
    respectively.
    Convert the argument above into WL code and cache the result for convenience and quick reuse:
    In[]:=
    CeilingTowerSolutionP[m_]:=CeilingTowerSolutionP[m]=Module[​​{expr,intPart=Floor[Surd[m,6]]},​​expr=(f[m/Table[n,{n,Ceiling[m/(intPart+1)],Floor[m/intPart]}]]-m);If[Times@@expr==0,m/(Position[expr,0][[1,1]]+Ceiling[m/(intPart+1)]-1),False]​​]
    Let’s exam how many
    n
    no larger than 730 can be expressed as ceiling tower:
    In[]:=
    sol=Cases[CeilingTowerSolutionP/@Range[730],_?NumericQ];​​Short[sol]
    Out[]//Short=
    1,
    7
    6
    ,
    7
    5
    ,
    17
    12
    ,
    3
    2
    ,
    26
    17
    ,
    14
    9
    ,142,
    717
    241
    ,
    721
    242
    ,
    361
    121
    ,
    723
    242
    ,
    727
    243
    ,
    728
    243
    ,3
    So these integers
    n==r⌈r⌈r⌈r⌈r⌈r⌉⌉⌉⌉⌉
    have valid solution in terms of
    r
    :
    In[]:=
    f@sol
    Out[]=
    {1,7,14,17,18,26,28,30,32,33,36,40,48,51,52,59,60,63,64,127,128,131,132,139,140,143,144,147,152,163,164,165,168,173,176,177,181,182,190,193,194,206,214,215,216,219,248,249,253,261,274,275,278,284,287,288,289,292,293,302,306,307,311,312,333,337,338,346,347,351,352,356,357,366,370,371,375,376,377,402,403,412,416,417,421,478,481,482,491,492,496,497,501,502,503,512,515,516,517,521,522,523,526,527,536,537,541,564,568,569,570,573,574,575,588,589,590,594,595,599,600,610,614,615,616,620,621,622,625,635,662,663,667,668,669,673,674,675,688,689,690,694,695,696,700,701,702,715,716,717,721,722,723,727,728,729}
    Plot these values with their index:
    In[]:=
    Plot[f[r],{r,1,1.8},GridLines{sol,f[sol]},AxesLabel{"r",f[r]},LabelStyle14]
    Out[]=
    For possible negative solutions, I just use the similar argument but a different range for
    K
    . Extreme caution is required to handle floor and ceiling function with negative numbers because the direction of cutoff is different in terms of their absolute value. Also you should notice it only works with even number of
    r
    ’s. Otherwise the value of ceiling tower is also negative.
    In[]:=
    CeilingTowerSolutionN[m_]:=CeilingTowerSolutionN[m]=Module[​​{expr,intPart=Floor[Surd[m,6]]},​​expr=(f[m/Table[n,{n,Ceiling[-m/intPart],Floor[-m/(intPart+1)]}]]-m);If[Times@@expr==0,m/(Position[expr,0][[1,1]]+Ceiling[-m/intPart]-1),False]​​]
    Use the function for negative solutions:
    In[]:=
    sol2=Cases[CeilingTowerSolutionN/@Range[730],_?NumericQ];​​Short[sol2]
    Out[]//Short=
    -1,-
    11
    7
    ,-
    13
    8
    ,-
    17
    10
    ,-
    9
    5
    ,-
    21
    11
    ,84,-
    448
    151
    ,-
    449
    151
    ,-
    450
    151
    ,-
    227
    76
    ,-
    455
    152
    ,-3
    Exam the results
    In[]:=
    f@sol2
    Mark the solution points on the diagram:

    Generate Animation