Curious properties of an iterative process under various moduli

-How high school and undergraduate students could present original research of mathematics using computer algebra system-

Satoshi Hashiba
Daisuke Minematsu
Ryohei Miyadera     
Koichi Tsukiyama
(Kwansei Gakuin)

miyadera1272000@yahoo.co.jp

1. Curious properties of an iterative process under various moduli.   
    For any natural number  K  we define the function dsfK  by  dsfK[n]= Mod[(Subscript[((Subscript[n, 1])^n), 1]) + (Subscript[((Subscript[n, 2])^n), 2]) + ⋯(Subscript[((Subscript[n, m])^n), m]), 
          K],where　{(Subscript[n, 1]), (Subscript[n, 2]), ⋯, (Subscript[n, m]) } is the list of digits of a natural number n.  Note that Mod[p,q] is the least nonnegative residue of p under modulo q.
    If we start with a natural number  n, and   repeatedly apply the function  dsfK,　then  we can generate a sequence of integers { (dsfK^m)[n],m = 1,2,⋯}.  This sequence has many interesting properties that are not known to most mathematicians.  
    By definition 1 ≤ dsfK[n] ≤ K, and hence it is obvious that for any natural number n  the sequence　 {(dsf^m)K[n],m = 1,2,⋯} eventually will enter into a loop.  
Mathematical result of this article is going to be published in a journal.  See T.Takahashi, R.Miyadera, D.Minematsu and S.Hashiba [3]. 
    We write Mathematica codes in blue and expalin about them. If you do not know about Mathematica, you can just skip the sentences written in blue.

Mathematica calculation 1.

A Mathematica dsfK function.  Note that have to assign some number to K before you make a dsfK function.

k  =  1500;Clear[dsf];dsf[x_] := 
        Block[{m = x, t}, 
          t = IntegerDigits[
              m]; 
Mod[(∑_(s = 1)^(Length[t]))Max[1, t[[s]]]^t[[s]], k]];

In the following calculation we can see how the sequence { (dsf1500^m)[1234],m = 1,2,⋯}enters into a loop.  We coloured the loop in green, red and cyan.  It is easy to see that the length of the loop is 9.

a = NestList[dsf, 1234, 40]

{1234,288,936,672,203,32,31,28,1220,10,2,4,256,285,1345,409,746,455,506,282,1224,265,285,1345,409,746,455,506,282,1224,265,285,1345,409,746,455,506,282,1224,265,285}

In the following function gc[n] return the number at which { (dsf1500^m)[n],m = 1,2,⋯} enters into a loop.  This sequence enters into a loop at 285.  Note that this function gc[n] depends on dsf[].  Therefore if you want to define gc[n], first you have to assign a number to K and define dsf[].

Clear[gc]; 
      gc[x_] := Block[{m = x, u, dat}, dat = {m}; m = dsf[m]; 
          While[! MemberQ[dat, m], dat = Append[dat, m]; m = dsf[m]]; 
          dat = Append[dat, m]; Last[dat]];

gc[1234]

We can also see the graph of { (dsf1500^m)[1234],m = 1,2,⋯}.  It is easy to spot a loop in the graph.

ListPlot[a, PlotStyle -> RGBColor[0, 1, 0], 
        PlotJoined -> True, Frame -> True, 
        PlotRange -> {0, 1500}]

In the following example we can see the { (dsf1564^m)[1234],m = 1,2,⋯}converges to 1.  Note that we have to define dsf[] again.

k  =  1564; Clear[dsf]; 
    dsf[x_] := Block[{m = x, t}, 
        t = IntegerDigits[
            m]; 
Mod[(∑_(s = 1)^(Length[t]))Max[1, t[[s]]]^t[[s]], k]];

a = NestList[dsf, 1234, 40]

We also can see the graph of { (dsf1564^m)[1234],m = 1,2,⋯}.

ListPlot[a, PlotStyle -> RGBColor[0, 1, 0], 
        PlotJoined -> True, Frame -> True, 
        PlotRange -> {0, 1564}]

Definition 1.  A dsfk function is called a black-hole function if  the sequence {(dsfK^m)[n],m = 1,2,⋯} converges to 1 for any natural number n.

Theorem 1.  There are only 10 blackhole-functions, namely dsfK for K = 1,2,3,5,11,37,1564,2042,3008,3385.

Proof. First we are going to prove that dsfK is a black-hole function for K = 1,2,3,5,11,37,1564,2042,3008,3385.  What we have to do is to calculate by Mathematica.  We omit the result of calculation.  
If K > 3434, then dsfK[3435]= Mod[(3^3) + (4^4) + (3^3) + (5^5),K]= Mod[3435,K] = 3435.  Therefore for K > 3435 there is no blackhole function.

Mathematica calculation 2.  Since we use Mathemtaica calculation to prove Theorem 1, the following calculation is essential to the proof of Theorem 1.

We can use blackholehunter[K] to check if dsfK is a black-hole function or not.

2.1. A Mathematica function blackholehunter[K].  We are going to explain how to use this function to find a black-hole.  The fucntion blackholehunter[K] has a dsf[] function inside it, and hence you do not have to define dsf[] before you use this blackholehunter[K].

blackholehunter[s_] := 
      Block[{blackhole, ss = s}, 
        blackhole = {}; 
Clear[dsf]; 
        dsf = Compile[{{x, _Integer}}, 
            Block[{m = x, t}, 
              t = IntegerDigits[
                  m]; 
Mod[(∑_(k = 1)^(Length[t]))Max[1, t[[k]]]^t[[k]], 
                ss]]]; 
Clear[gc]; 
        gc = Compile[{{x, _Integer}}, 
            Block[{m = x, u, dat}, dat = {m}; m = dsf[m]; 
              While[! MemberQ[dat, m], dat = Append[dat, m]; m = dsf[m]]; 
              dat = Append[dat, m]; Last[dat]]]; 
data = 
          Table[gc[n], {n, 1, ss}]; 
gate = 
          Union[data]; 
dd = 
          Table[{gate[[n]], Count[data, gate[[n]]]}, {n, 1, 
              Length[gate]}]]

We are going to explain by examples.

blackholehunter[1565]

In the above calculation blackholehunter[1565] investigates { (dsf1565^m)[n],m = 1,2,⋯}for n = 1,2,3, ⋯,1565. blackholehunter[1565] shows that among the number {1,2,3, ⋯,1565} there are 158 numbers that enter into a loop at 1, 2 numbers that enter into a loop at 39, 32 numbers that enter into a loop at 59⋯.

blackholehunter[1564]

In the above calculation blackholehunter[1564] shows that any number n = 1,2,⋯,1564 enters into a loop at 1.  In other words any number n = 1,2,⋯,1564 converges to 1.  Therefore dsf1564 is a black-hole function.

Conclusion. If blackholehunter[K] has only one element of the type {{1,K}}, then dsfK[] is a black-hole function.

2.2. A Mathematica program to select certain number of candidates for black-hole functions.

It is easy to see that if K > 3434, then there is no blackhole function, but it is not a good way to calculate blackholehunter[K] for K  = 1,2,⋯,3434 to find black-hole functions, because it takes much time.
A better way is to choose a group of candidates of black-hole functions.  The following program makes the best of the fact that it is usually easier to find non-black-hole functions.  
For example the fact that {(dsf1500^m)[1234],m = 1,2,⋯} enters into a loop with the length of 9 is enough to prove that dsf1500 is not a black-hole function.  Therefore the following program calculates {(dsfK^m)[n],m = 1,2,⋯} for n = 2,3, ⋯ and if we find some n such that {(dsfK^m)[n],m = 1,2,⋯} enters into a loop whose length is bigger than 1, then we omit the dsfK from the candidates.

Clear[noblack, dsf]; 
    Timing[noblack = {}; 
      Do[
Clear[dsf]; 
        dsf[x_] := 
          Block[{m = x, t}, 
            t = IntegerDigits[
                m]; 
Mod[(∑_(k = 1)^(Length[t]))Max[1, t[[k]]]^t[[k]], 
              ss]]; 
Clear[lengthofloop]; 
        lengthofloop[n_] := 
          Block[{m = n, u, dat}, dat = {m}; m = dsf[m]; 
            While[! MemberQ[dat, m], dat = Append[dat, m]; m = dsf[m]]; 
            dat = Append[dat, m]; u = Flatten[Position[dat, Last[dat]]]; 
            u[[2]] - u[[1]]]; 
loop = 1; s = 2; 
        While[loop == 1 && s < 40, loop = lengthofloop[s]; s = s + 1]; 
        If[s < 39, noblack = Append[noblack, ss]], {ss, 2, 3434}]]

candidates = Complement[Table[n, {n, 2, 3434}], noblack]

2.3. A Mathematica program to select black-hole function from the list candidates.

2.3.1. One way is just calculate blackholehunter[] for all the elements of the list candidates and print out all the results .

Timing[Do[Print[blackholehunter[candidates[[k]]]],{k, 1, Length[candidates]}]]

2.3.2. Another way is calculate blackholehunter[K] for all the elements of the list candidates, and if blackholehunter[K] has only one element, then select K as a element of the list listofblackhole.

listofblackhole = {};Timing[Do[If[Length[blackholehunter[candidates[[k]]]]==1,listofblackhole=Append[listofblackhole,candidates[[k]]],],{k, 1, Length[candidates]}];listofblackhole]

Mathematica calculation 3.  We are going to use colours to describe how the numbers {1,2,3,⋯,k} converge to 1.  We going to give colours to numbers.

Colours.  We are going to give colours to numbers.  The following chart of colours corresponds to the numbers {1,2,3,⋯,k}.

Show[
      Graphics[Evaluate[
          Table[{Hue[n/100], Disk[{n, 1}, 0.5]}, {n, 1, 100}]]], 
      AspectRatio -> Automatic]

We are going to see how {(dsf1564^m)[n],m = 1,2,⋯}converges to 1.  First we have to define dsf[].  We make a square of 1564 = 34×23.

1. This version shows the whole process of the convergence of {(dsf1564^m)[n],m = 1,2,⋯}.  We omit the ourput of this program, because it will take much disk space.

k  =  1564; Clear[dsf]; 
    dsf[x_] := Block[{m = x, t}, 
        t = IntegerDigits[
            m]; 
Mod[(∑_(s = 1)^(Length[t]))Max[1, t[[s]]]^t[[s]], k]];

b = Range[k]; 
    Do[
b = Map[dsf, b]; 
s = 
        34; 
bb = k; 
Show[
        Graphics[
          Evaluate[
Table[
              Table[{Hue[N[Part[b, (y + (s)*x)]/k]], 
                  Disk[{y, -x}, 0.6]}, 
{y, 1, s}], {x, 
                0, bb/(s) - 1}]]], AspectRatio -> Automatic], {tt, 
        1, 38}]

2. This version shows a part of the whole process of the convergence of {(dsf1564^m)[n],m = 1,2,⋯}.  The output is {(dsf1564^m)[n],m = 4,8,12, 16,⋯}.

k  =  1564; Clear[dsf]; 
    dsf[x_] := Block[{m = x, t}, 
        t = IntegerDigits[
            m]; 
Mod[(∑_(s = 1)^(Length[t]))Max[1, t[[s]]]^t[[s]], k]];

b = Range[k]; 
    Do[
b = Map[dsf, b]; 
s = 
        34; 
bb = k; 
If[IntegerQ[tt/4], 
        Show[Graphics[
            Evaluate[
Table[
                Table[{Hue[N[Part[b, (y + (s)*x)]/k]], 
                    Disk[{y, -x}, 0.6]}, 
{y, 1, 
                    s}], {x, 0, bb/(s) - 1}]]], 
          AspectRatio -> Automatic], ], {tt, 1, 40}]

1-2.  Some courious properties of blackhole functions.  In this section let dsfK be a black-hole function.  Let  U = {0,1,2,⋯,K-1}.  The list  U is the range of dsfK function.  We are going to study  (dsfK^m)[U] for m = 1, 2, ⋯.  By the properties of black-hole functions (lim_(m -> ∞)) (dsfK^m)[U]= {1}.

Theorem 2.  The number of elements in (dsfK^m)[U] decreases as m → ∞, and after certain steps it decreases linearly.

Proof. We can prove the fact for K = 1,2,3,5,11,37,1564,2042,3008,3385.  What we have to do is to calculate by Mathematica.  We omit the result of calculation.

Example 1.  When K = 3008, then the number of (dsfK^m)[U] decreases like the following.

Mathematica calculation 4.  We are going to use colours to describe how the numbers {1,2,3,⋯,k} converge to 1.  We going to give colours to numbers.

Clear[countnumbers, gc, dsf]; 
    countnumbers[ss_] := 
      Block[{dsf, s = ss}, Clear[dsf]; 
        dsf[n_] := 
          Block[{m = n, t}, 
            t = IntegerDigits[
                m]; 
Mod[(∑_(k = 1)^(Length[t]))Max[1, t[[k]]]^t[[k]], 
              s]]; 
l = {}; 
        data0 = Table[n, {n, 0, s}]; 
k = 3; 
        h = 2; 
While[
          k > h, 
data1 = 
            Union[Map[dsf, data0]]; 
k = 
            Length[data0]; 
h = 
            Length[data1]; 
l = 
            Append[l, Length[data1]]; 
data0 = data1]; 
        Print[l]; ListPlot[l]]

countnumbers[3008]

Mathematica calculation 5.  We do the same thing for all the members of listofblackhole = {2,3,5,11,37,1564,2042,3008,3385}.

listofblackhole = {2, 3, 5, 11, 37, 1564, 2042, 3008, 
        3385}

Do[Print[countnumbers[listofblackhole[[k]]]],{k,1,Length[listofblackhole]}]

Remark. Our research was inspired by R.Cosen and W.Kennedy[1].Without their book our research was impossible.

References.

R. Cowen and J. W.Kennedy   [1].Discovering Mathematics with Mathematica,rudition Books   2001.
T.Takahashi, R.Miyadera, D.Minematsu and S.Hashiba [2].  How high school and undergraduate students could present original research of mathematics using computer algebra system, Symbolic and Algebraic Maripulation Japan Society for Symbolic and Algebraic Computation to appear.