NUMBERS LESS THAN 10000 WHOSE FACTORS f ALL HAVE THE SAME order of 2 mod f In the ASCII-character notation used in the discussion below, "^" denotes exponentiation. If, for k > 2, the order of 2 mod p^(k-1) is m, then the order of 2 mod p^k must be less than or equal to pm. This is simply beause p divides the ratio (2^(pm)-1)/(2^m-1) since it equals the sum of p-divisible terms (2^((p-1)m)-1) + (2^((p-2)m)-1) + ... + p. In fact, this upper bound is reached for all prime powers less than 10000. This is verified at the end of the calculation below. So no prime square or higher power can be a factor of a number less than 10000 whose factors f all have the same order of 2 mod f. It remains to check products up to 10000 of first powers of different primes p that have the same order of 2 mod p. Only odd numbers need to be considered, so no prime factor greater than 10000/3 will occur in this search. One or more prime factors in each product will be less than 100, so the order of 2 mod p shared by all the prime factors must also be less than 100, since the order of 2 mod p is less than p. The Mathematica expression Do[If[PowerMod[2, m, Prime[n]] == 1, Return[m], Continue[]], {m, Sqrt[t]}] gives the order of 2 mod the n'th prime, but gives "Null" if the result would be greater than the square root of t. In[1] is a function whose value is a table of the values of this expression for primes up to t/3. Out[2] is such a table for t=10000. Out[3] is a list of sublists in which the i'th sublist contains the positions at which i occurs in Out[2]. It is thus a table of the indices n for which the order of 2 mod the n'th prime is i. Out[4] selects from Out[3] the cases for which two or more indices are listed for a given i. Out[5] gives the primes corresponding to those indices. Each sublist in the list thus contains primes whose "order of 2 mod" is the same, and includes all primes with that order less than 10000/3. Out[6] gives the product of the first two primes in each sublist, and Out[7] gives the same set of numbers in ascending order. Products involving the third prime in a sublist, where there is one, are not listed, but all are easily seen to be greater than 10000. Thus we have found all the numbers less than 10000, and a few of those greater than that, whose factors f all have the same order of 2 mod f. Out[8] lists the order of 2 mod prime powers p^k. Here only primes greater than 2 and less than 100 are included, and the ceiling of 100 is not imposed on the orders of 2. This shows that no two powers less than 10000 of the same prime have the same order of 2 mod p^k, as discussed above. Brian Treadway 31 May 1996 Mathematica 2.2 for HP9000 Series 700 Copyright 1988-93 Wolfram Research, Inc. -- Terminal graphics initialized -- In[1]:= TwOrdP[t_] := Table[Do[If[PowerMod[2, m, Prime[n]] == 1, Return[m], Continue[]], {m, Sqrt[t]}], {n, PrimePi[t/3]}] In[2]:= TwOrdP[10000] Out[2]= {Null, 2, 4, 3, 10, 12, 8, 18, 11, 28, 5, 36, 20, 14, 23, 52, 58, 60, > 66, 35, 9, 39, 82, 11, 48, 100, 51, Null, 36, 28, 7, Null, 68, Null, > Null, 15, 52, Null, 83, Null, Null, Null, 95, 96, Null, 99, Null, 37, > Null, 76, 29, Null, 24, 50, 16, Null, Null, Null, 92, 70, 94, Null, > Null, Null, Null, Null, 30, 21, Null, Null, 88, Null, Null, Null, Null, > Null, Null, 44, Null, Null, Null, Null, 43, 72, 73, Null, Null, 76, > Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, > Null, Null, Null, Null, Null, Null, Null, Null, Null, 25, Null, Null, > Null, Null, 45, 64, Null, Null, Null, Null, Null, 48, Null, 22, Null, > Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, > Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, > Null, Null, 55, Null, Null, Null, 91, Null, Null, Null, Null, Null, 68, > Null, Null, Null, Null, Null, Null, Null, 92, Null, Null, Null, Null, > Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, 29, Null, > Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, > Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, > Null, Null, Null, Null, Null, 60, Null, Null, Null, Null, Null, Null, > Null, Null, Null, 84, Null, Null, Null, Null, Null, Null, Null, Null, > Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, > Null, Null, Null, Null, Null, Null, Null, Null, 52, Null, Null, Null, > Null, 92, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, > Null, Null, Null, Null, 74, Null, Null, Null, 25, Null, Null, Null, > Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, > Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, > Null, Null, Null, Null, Null, Null, Null, Null, Null, 29, Null, Null, > 44, Null, Null, Null, Null, 51, Null, Null, Null, Null, Null, Null, > Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, > Null, Null, Null, Null, Null, Null, 47, Null, Null, Null, Null, Null, > Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, > Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, 81, > Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, 79, > Null, Null, Null, Null, Null, Null, Null, Null, 26, Null, Null, Null, > Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, > Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, > Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, > Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, > Null, 55, Null, Null, Null, Null, Null, Null, Null, Null, Null, Null, > Null, Null, Null, Null, Null, Null, Null, Null} In[3]:= Table[Position[%, i], {i, 100}] Out[3]= {{}, {{2}}, {{4}}, {{3}}, {{11}}, {}, {{31}}, {{7}}, {{21}}, {{5}}, > {{9}, {24}}, {{6}}, {}, {{14}}, {{36}}, {{55}}, {}, {{8}}, {}, {{13}}, > {{68}}, {{124}}, {{15}}, {{53}}, {{110}, {279}}, {{399}}, {}, > {{10}, {30}}, {{51}, {185}, {316}}, {{67}}, {}, {}, {}, {}, {{20}}, > {{12}, {29}}, {{48}}, {}, {{22}}, {}, {}, {}, {{83}}, {{78}, {319}}, > {{115}}, {}, {{349}}, {{25}, {122}}, {}, {{54}}, {{27}, {324}}, > {{16}, {37}, {255}}, {}, {}, {{152}, {452}}, {}, {}, {{17}}, {}, > {{18}, {216}}, {}, {}, {}, {{116}}, {}, {{19}}, {}, {{33}, {162}}, {}, > {{60}}, {}, {{84}}, {{85}}, {{275}}, {}, {{50}, {88}}, {}, {}, {{390}}, > {}, {{378}}, {{23}}, {{39}}, {{226}}, {}, {}, {}, {{71}}, {}, {}, > {{156}}, {{59}, {170}, {260}}, {}, {{61}}, {{43}}, {{44}}, {}, {}, > {{46}}, {{26}}} In[4]:= Cases[%,{{_},{_}..}] Out[4]= {{{9}, {24}}, {{110}, {279}}, {{10}, {30}}, {{51}, {185}, {316}}, > {{12}, {29}}, {{78}, {319}}, {{25}, {122}}, {{27}, {324}}, > {{16}, {37}, {255}}, {{152}, {452}}, {{18}, {216}}, {{33}, {162}}, > {{50}, {88}}, {{59}, {170}, {260}}} In[5]:= Prime[%] Out[5]= {{{23}, {89}}, {{601}, {1801}}, {{29}, {113}}, > {{233}, {1103}, {2089}}, {{37}, {109}}, {{397}, {2113}}, {{97}, {673}}, > {{103}, {2143}}, {{53}, {157}, {1613}}, {{881}, {3191}}, {{61}, {1321}}, > {{137}, {953}}, {{229}, {457}}, {{277}, {1013}, {1657}}} In[6]:= Table[%[[i, 1]] * %[[i, 2]], {i, Length[%]}] Out[6]= {{2047}, {1082401}, {3277}, {256999}, {4033}, {838861}, {65281}, > {220729}, {8321}, {2811271}, {80581}, {130561}, {104653}, {280601}} In[7]:= Sort[%] Out[7]= {{2047}, {3277}, {4033}, {8321}, {65281}, {80581}, {104653}, > {130561}, {220729}, {256999}, {280601}, {838861}, {1082401}, {2811271}} In[8]:= Table[Table[Do[If[PowerMod[2, m, Prime[n]^k] == 1, Return[m], Continue[]], {m, 10000}], {k, Log[Prime[n], 10000]}], {n, 2, PrimePi[100]}] Out[8]= {{2, 6, 18, 54, 162, 486, 1458, 4374}, {4, 20, 100, 500, 2500}, > {3, 21, 147, 1029}, {10, 110, 1210}, {12, 156, 2028}, {8, 136, 2312}, > {18, 342, 6498}, {11, 253}, {28, 812}, {5, 155}, {36, 1332}, {20, 820}, > {14, 602}, {23, 1081}, {52, 2756}, {58, 3422}, {60, 3660}, {66, 4422}, > {35, 2485}, {9, 657}, {39, 3081}, {82, 6806}, {11, 979}, {48, 4656}}