truncating terms in symbolic expression basing on their values

Question

I need to simplify big symbolic solution of equations system by truncating terms that are orders of magnitude less then others in subexpressions like a + b. The solution is big fraction with sum of terms in numerator and denominator like

a b + c ( d - f + g + ...

where every symbol has value (real number). Is it possible to apply rule like this to solution:

replace a + b by a, if Abs[a] >> Abs[b] (say, 1000 times more), by b, if Abs[a] << Abs[b], or leave it as a + b in other cases.

Repeated application of such a rule should result in symbolic expression that is much simpler then exact solution, but is good enough approximation for concrete values of symbols. I am new to Mathematica, searched for similar questions but didn't find any.

Minimal working example: solving eq gives solution that should be simplified by truncating terms basing on parameters alpha and beta below:

v1 = α1 a - β1 b;
v2 = α2 a;
v3 = α3 c;
eq = {-v1 - v2 == 0, v1 + v3 == 0, a + b + c == p};
Solve[eq, {a, b, c}]

α1 = 1000; β1 = 1000; α2 = 1; α3 = 1;

Answer 1

The following code will do what you ask, given the assumptions that

• you want to simplify a symbolic sum of terms,
• your experimental data is encoded in a list of replacements which will cause each of the terms in the sum to give a number upon replacement, and
• you have a specified tolerance for which terms get neglected - i.e., terms in a sum smaller than tolerance * the biggest term in the sum should get neglected.

Doing this is fairly simple. I ensure the head of the first argument is Plus, since it would be catastrophic if the head were, say, Times. I turn my input into a list of terms. I run the function Thread[Abs[#] > tolerance Max[Abs[#]]]&, which will give True for the terms I want to keep, on the numerical values. I then Pick the terms that gave True.

sumNeglecter[terms, replacements_, tolerance_] := If[MatchQ[terms, _Plus],
    Pick[
      terms, 
      Thread[Abs[#] > tolerance Max[Abs[#]]] &[List @@ terms /. replacements]
    ]
    ,terms]
sumNeglecter[a + b + c + 2 b^c, {a -> 10^6, b -> 10^4, c -> 1}, 0.01]
(*output: a + 2 b^c *)

If what you want to simplify is a fraction, you can easily implement this for the numerator and denominator separately:

termNeglecter[terms_, replacements_, tolerance_] := Piecewise[{
  {sumNeglecter[terms, replacements, tolerance], MatchQ[terms, _Plus]},
  {sumNeglecter[Numerator[terms], replacements, tolerance]/
    sumNeglecter[Denominator[terms], replacements, tolerance], 
    MatchQ[terms, a_/b_]}
  }, terms]

Finally, you can Map this over all levels of your expression if you really require a thorough job:

Map[ termNeglecter[#, replacements, tolerance]&, {terms}, \[Infinity]][[1]]

Beware, though, of

• Situations where you have many very small terms that together should not be neglected. For example,

  termNeglecter[Sum[u[k]/k, {k, 1, 10000}], {u[_] -> 1}, 0.1]
  

  is about 3.45 times than the original.

• Situations where you have cancellations. For example, in

  termNeglecter[a - a^b + b, {a -> 10, b -> 1}, 0.1]
  

  the dominant term is b.

• Situations where nonlinearity is important. 100^1.01 is not within 1% of 100, though the exponent is within 1% of 1.

Answer 2

Here is a simple general solution I've managed to come up with. Since all the terms are created by Solve, I might as well define them as a list (if You use Flatten with Your Solve result, You should get them in the same form):

data = {a -> 1234, b -> 1.05, c -> 345, d -> -10890, e -> 0.03, f -> 4234, g -> 3.65, 
 h -> 543, i -> -11456, j -> -0.76};

Let's say that the fraction You get as a solution has a following form:

abc = (a + b + c + d + e)/(f + g + h + i + j);

We can now write a function that will do the simplification:

f1[fraction_] := Module[{qwe, qay},
 qwe = (Numerator[fraction] /. {x_ + y_ /; ((Abs[x]/Abs[y] /. data) > 1000) :> x,
    x_ + y_ /; ((Abs[x]/Abs[y] /. data) < 1000) :> y});
 qay = Denominator[fraction] /. {x_ + y_ /; ((Abs[x]/Abs[y] /. data) > 1000) :> x, 
  x_ + y_ /; ((Abs[x]/Abs[y] /. data) < 1000) :> y};
 qwe/qay
];

Now if I call it with abc:

f1[abc]

I get:

(a + c + d)/(f + h + i)

In this particular case abc/.data yields 1.39451 while f1[abc]/.data yields 1.39407.