5
$\begingroup$

I have this problem that I"m trying to work out: enter image description here

Here's my attemp:

me = 0.51109991
mp = 938.2723
mpe = mp/me
Solve[(2^n)*(3^mm)*(\[Pi]^p) == mpe, {n, mm, p}]

However Mathematica told me to use Reduce because there were calculations involving inverse functions and so I did. However I got this error message:

Reduce was unable to solve the system with inexact coefficients. The answer was obtained by solving a corresponding exact system and numericizing the result.

I'm just wondering what did I do wrong and how would I solve this problem properly?

$\endgroup$
  • $\begingroup$ BTW: UnitConvert[Quantity[1, "ProtonElectronMassRatio"]] gives the ratio directly. $\endgroup$ – J. M. will be back soon Feb 23 '16 at 9:59
6
$\begingroup$

Or

Minimize[{Abs[(2^n)*(3^mm)*(\[Pi]^p) - mpe], 
  n > 0 && mm > 0 && p > 0}, {n, mm, p}, Integers]

{0.327725, {n -> 1, mm -> 1, p -> 5}}

$\endgroup$
4
$\begingroup$

As an alternative, you can also visually solve it.

me = 0.51109991;
mp = 938.2723;
mpe = mp/me;
eq[n_, m_, p_] = 2^n*3^m*Pi^p;

Manipulate[
 Plot[{mpe, eq[n, m, p]}, {n, 0, 5}, GridLines -> Automatic], {m, 0, 2}, {p, 0, 10}]

enter image description here

{mpe, eq[1, 1, 5]} // N
{1835.79, 1836.12}
$\endgroup$
3
$\begingroup$

Just try all the integers less than 10 - it takes a fraction of a second,

me = 0.51109991;
mp = 938.2723;
data = Table[{Abs[(2^n)*(3^mm)*(π^p) - mp/me], {n, mm, p}}, {n, 0,
      10}, {mm, 0, 10}, {p, 0, 10}]~Flatten~2;

Now find the point with the smallest difference,

data[[First@Ordering@data]]
(* {0.327725, {1, 1, 5}} *)

and then check your result

mp/me
N@(2^1) 3^1 π^5
(* 1835.79 *)
(* 1836.12 *)

To four significant digits they are both 1836!

$\endgroup$
  • $\begingroup$ You can also find the point with MinimalBy[data, Position] $\endgroup$ – user36273 Feb 26 '16 at 19:23
  • $\begingroup$ @rewi what do you think it does? The result it gives is only accidentaly correct. $\endgroup$ – Kuba Feb 27 '16 at 13:41
  • $\begingroup$ @Kuba MinimalBy sorts the data for which the first element in the data packet is minimal {{0.327725,{1,1,5}}}. It's no matter whether one gives it in the form MinimalBy[data, First] or MinimalBy[data,_]. With MinimalBy[data,Last] MinimalBy sorts the data for which the last element in the data packet is minimal {{1834.79,{0,0,0}}}. The code snippet data[[First@Ordering@data]] can be replaced by MinimalBy[data, First]. The obtained result is not accidentaly or by chance. $\endgroup$ – user36273 Feb 27 '16 at 15:13
  • $\begingroup$ @rewi it is, First or Last makes sense but Position or "X" doesn't, it just add the head, which won't affect the order since it is the same, Sort in MMA works that way that now it will sort accordint to the first argument, that's why all your examples return "correct" one. $\endgroup$ – Kuba Feb 27 '16 at 15:16
  • $\begingroup$ @Kuba You're right. After I entered MinimalBy[data,Position], as I said, in hindsight I was unsure and placed anything in the second position and got every time the same result. That surprised me and I was confused. $\endgroup$ – user36273 Feb 27 '16 at 15:29
2
$\begingroup$

This tries reasonable combinations of i, m and p and calculates the significant figures in base 10:

me = 51109991/100000000;
mp = 9382723/10000;
mpe = mp/me;

SortBy[Flatten[Table[{i, m, p, N[Log10[mpe/Abs[2^i 3^m \[Pi]^p - mpe]], 2]},
   {i, Log2[mpe]}, {m, Log[3, 2^-i mpe]}, {p, Floor[Log[\[Pi], 2^-i 3^-m mpe]],
    Ceiling[Log[\[Pi], 2^-i 3^-m mpe]]}], 2], Minus@*Last]

Of course I choose all variables to be at least 1, and I choose i to be at most Log2[mpe] because otherwise the result will be too large. Similarly for m, but for p, there is one equation with one unknown, which I solve and round down and up, respectively.

In general its a good idea to define your symbols with fractions and precede in arbitrary precision until efficiency becomes crucial, which is not the case here.

$\endgroup$
2
$\begingroup$

There's always lattice reduction for problems like this. I'll just show the code since the method really goes outside the scope of the intended problem.

me = 0.51109991;
mp = 938.2723;
mpe = mp/me;
vals = Log[{2, 3, Pi, mpe}];
lat = Transpose[
   Append[IdentityMatrix[4], Rationalize[N[10^4*vals], 0]]];
lat[[4, 4]] *= 10^2;
redlat = LatticeReduce[lat];
-redlat[[-1, 1 ;; 3]]

(* Out[1560]= {1, 1, 5} *)

The nice feature is that this becomes a linear problem in the sense that lattice reduction uses linear algebra under the hood.

$\endgroup$
  • $\begingroup$ Nice work for this!!! $\endgroup$ – yode Feb 23 '16 at 20:05

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.