Elementary number theory problem and FindInstance

Find $$\{ m,n \} \in \mathbb{Z}$$ such that $$m \neq n$$ and $$m^n = n^m$$.

This has (unordered) solutions $$\{ 2, 4 \}$$ and $$\{ -2, -4 \}$$, as can be easily checked.

I'm of course hoping for an analytic approach, but the direct method in Mathematica does not find any solutions:

FindInstance[m^n == n^m \[And] m != n, {m, n}, Integers]

I've tried several variants, including Solve, taking Log of both sides, and so on... and none worked.

Any suggestions?

First we assume m>0, n>0,then the equation is equivalent to Log[m]/m==Log[n]/n. We consider the function f[x]=Log[x]/x.

Solve[D[Log[x]/x, x] == 0, x, Reals]

{{x -> E}}

Plot[{Log[x]/x, 1/E, Log/4, Log/2}, {x, 0, 5}, AspectRatio -> 1] It is easy to see that f[x] increasing from $$0$$ to $$E$$ and decreasing from $$E$$ to $$\infty$$, so we need to set m>=E>=n in such equation.

Solve[{Log[m]/m == Log[n]/n, m >= E >= n}, PositiveIntegers]

{{m -> 4, n -> 2}}

• Oh... nice. Of course based on the Youtube video, but it was a good idea to map that to code. ($\checkmark$) Aug 21 '21 at 3:01
• By the monotonous, m=n is the only solution when {m,n}>E or 0<{m,n}<E ,that is why we only need to consider the case in answer. Aug 21 '21 at 5:34

Here's a weird way to do it with NMinimize - the stuff with Quiet/Check/Boole is to work around the 0^0 and 0^-x issue. I found NMinimize wouldn't avoid these cases even if you added m != n, m != 0, n != 0 to the constraints:

f[m_?NumericQ, n_?NumericQ] :=
Quiet[Check[0/Boole[m != n] + (m^n - n^m)^2, 10^20]]

{err, sol} = NMinimize[{f[m, n], m < 0, n < 0}, {n ∈ Integers, m ∈ Integers}]
With[{v = Values[sol]}, (f @@ v == 0 && Unequal @@ v)]

(* {0., {n -> -4, m -> -2}} True *)

Change m < 0, n < 0 to m > 0, n > 0 to get the positive solution.

• Thanks ($+1$) but I should have mentioned that I solved the problem numerically too. Of course I'm seeking an analytic method. Let's see if someone has a clever approach to this. Aug 20 '21 at 20:25
• @DavidG.Stork I'm not sure an analytic approach even exists - Diophantine equations are hard and usually boil down to just checking inputs - i.e numerical approaches. See here Aug 20 '21 at 20:35

With variable restrictions up to 100, FindInstance and Reduce do the job.

FindInstance[{m^n == n^m, m != n, 0 < m < 100, 0 < n < 100}, {m, n}, Integers]

(*   {{m -> 2, n -> 4}}   *)

Reduce[{m^n == n^m, m != n, -100 < m < 0, -100 < n < 0}, {m, n}, Integers]

(*   (m == -4 && n == -2) || (m == -2 && n == -4)   *)
• Hah... halfway between numerical search and algorithmic solution! ($+1$). Let's still wait a while to see if anyone finds an analytic approach. After all, there are Youtube clips on how to solve this problem, but they all involve creativity at the human level. Aug 20 '21 at 21:13

Yet an other answer. Plot3D of m^n - n^m == 0 shows, you can divide the (m,n)-area into four quadrants around {m,n} = {E,E}. Three of them can be easily solved. The fourth can be proofen to have only solutions for m == n.

Plot3D[{0, m^n - n^m}, {m, 1, 5}, {n, 1, 5}, PlotRange -> 1]

Reduce[{0 < n < E, m^n == n^m}, {m, n}, Integers]
(*   (m == 1 && n == 1) || (m == 2 && n == 2) || (m == 4 && n == 2)   *)

Reduce[{0 < m < E, m^n == n^m}, {m, n}, Integers]
(*   (m == 1 && n == 1) || (m == 2 && n == 2) || (m == 2 && n == 4)   *)

red1 = Reduce[{m^n == n^m, E < n, E < m}, {m, n}, Reals]
(*   m > E && n == E^-ProductLog[-1, -(Log[m]/m)]   *)

Reduce[E^-ProductLog[-1, -(Log[m]/m)] == m, m, Integers]
(*   m \[Element] Integers && m >= 3   *)

For all m >=3, E^-ProductLog[...] is equal m, therefore n == m.

• Helpful... thanks. ($+1$) Aug 21 '21 at 15:01