Computational Evidence for Lehmer's Totient Conjecture

By John Renze

In 1932, D. H. Lehmer considered the equation

k ϕ[N]  == N - 1

for positive integers N and k.  If N is prime, then the equation has a solution with k = 1.  He conjectured that these are the only solutions.

Conjecture:  Let N be a positive integer.  Then ϕ[N] divides N - 1 if and only if N is prime.

The conjecture remains open to this day.  Any composite solution n must be a Carmichael number, since (a^(N - 1)) ≡ (a^k)ϕ[N] ≡ 
        1 (mod N).  In particular, this means that n is square-free and must have at least three prime factors.  Lehmer showed that N must have at least seven prime factors.  The current best result of this type, due to Cohen and Hagis, is that N must have at least 14 prime factors and be greater than 10^22.  The code in this notebook carries out a search for a counter-example to Lehmer's conjecture and extends these limits.

For more on the background, see the MathWorld entry: Lehmer's Totient Problem.

Code

Let {(Subscript[p, 1]), (Subscript[p, 2]), …, (Subscript[p, d])} be a sequence of primes with (Subscript[p, 1]) < (Subscript[p, 2]) < … < (Subscript[p, d]).  The key quantity which this code tracks is \(TraditionalForm\`\(\(p\_1\) \(p\_2\) …p\_d\)\/\(\((p\_1 - 1)\) \((p\_2 - 1)\) \(…(p\_d - 1)\)\)\).  We refer to this quantity as the "Lehmer product" of {(Subscript[p, 1]), (Subscript[p, 2]), …, (Subscript[p, d])}.

LehmerProduct[plist_]:=LehmerProduct[plist] = 
        LehmerProduct[
            Most[plist]] (#/(# - 1) &[
              Last[plist]])
LehmerProduct[{}] := 1

A simple calculation reveals that if the Lehmer product of n-1 primes is greater than k, then no solution to Lehmer's equation begins with these primes.  The approach therefore is to inductively search for sequences of n-1 primes which have Lehmer product less than k.The new prime has to satisfy some basic congruence properties with respect to the previous primes.  In particular, newprime-1 cannot be a multiple of  any of the preceeding primes.  This eliminates a lot of cases.

CompatibleQ[newprime_, plist_] := 
      GCD[newprime - 1, Times @@ plist] == 1

This function takes a list of primes and returns a list of lists.  Each list is of length one longer than plist and begins with plist.  The Lehmer product of each list is less than k and can possibly reach k with the addition of n-1 more primes to the list.

AddOne[plist_, n_, k_, searchlimit_] := 
      Module[{dstart, d, sofar = LehmerProduct[plist]}, 
        dstart = Max[PrimePi[k/(k - sofar)], PrimePi[Last[plist]] + 1]; 
        d = PrimePi[
            Min[1 + 1/((k/sofar)^(1/n) - 1), (searchlimit/
                    Times @@ plist)^(1/n)]]; 
        If[d > dstart, 
          Map[Append[plist, #] &, 
            Select[Prime[Range[dstart, d - 1]], 
              CompatibleQ[#, plist] &]], {}]]
AddOne[{}, n_, k_, searchlimit_] := 
      Transpose@{Prime@
            Range[Max[2, PrimePi[k/(k - 1)]], 
              Min[1 + 1/(k^(1/n) - 1), (searchlimit)^(1/n) - 
                  1]]}

Two variable quadratic Diophantine equations are well understood.  Once we get down to adding the last two primes, we let Mathematica take over.  Most of the calculation time is spent on this function.

QEq[a_, b_] := 
      Reduce[a (x - 1) (y - 1) == b x y - 1 && 0 < x < y, {x, y}, 
        Primes]
LastTwo[plist_, k_] := 
      QEq[k Times @@ (# - 1 & /@ plist), Times @@ plist]

The function LehmerSearch is recursive using AddOne.  LehmerSearch[plist,n,k,searchlimit] returns a list of all solutions to the equation k ϕ[N]  == N - 1 where N  <  searchlimit and N has exactly n prime factors.  The solution is given in the form of a list of the first n-2 prime factors.  If a solution is found. QEq can be re-run to find the last two primes.

LehmerSearch::usage = "LehmerSearch[n] will return a list of all \
counter-examples to Lehmer's Totient Conjecture which have exactly n prime \
factors. LehmerSearch[n, searchlimit] will return a list of all \
counter-examples to Lehmer's Totient Conjecture which have exactly n prime \
factors and are less than searchlimit.";

LehmerSearch[plist_, n_, k_, 
        searchlimit_:  
          Infinity] := Sequence @@ 
            LehmerSearch[#, n - 1, k, searchlimit] & /@ 
        Reverse[AddOne[plist, n, k, searchlimit]]
LehmerSearch[plist_, 2, k_, searchlimit_] := 
      If[LastTwo[plist, k], {plist}, {}]
LehmerSearch[n_, 
        searchlimit_:  
          Infinity] := Sequence @@ LehmerSearch[{}, n, #, searchlimit] & /@ 
        Reverse[Range[2, 
            Floor[LehmerProduct[Prime[Range[3, n + 2]]]]]]

If 3 | N, then k cannot be even.  Lieuwens used this observation to show that if 3 | N, then n > 212.

LehmerSearch[{3}, n_, k_, searchlimit_] := {} /; EvenQ[k]

Calculuations

These calculations extend the limits given in the introduction.  We can now say that a counterexample to Lehmer's Totient Conjecture must have at least 15 prime factors an be greater than 10^26.

LehmerSearch[14] // Timing

Times @@ Prime[Range[3, 21]] > 10^26

LehmerSearch[#, 10^26] & /@ {15, 16, 17, 18} // Timing