operator for approximate equality testing in Mathematica

I often need to check if expr1==expr2, where checking for symbolic equality is hard, but a numeric check suffices

To deal with such cases it would be neat to have TildeTilde work like Equal but instead of checking symbolic equality it would substitute unknowns with numeric val开发者_Go百科ues and check for numeric equality at several points.

Unknowns are things that "look like" variables in the expression. The ones I can think of have form x,x[1,2] and Subscript[x,2,3]. Any tips welcome!

edit

usually I do something like below, but it requires specifying variables, sometimes requires changing Chop tolerance, and "10 samples" seems arbitrary. An ideal tester would be a function that works like Equals and guarantees meaningful False answers. (to complement Equals which has meaningful True answers)

approxEqual[expr1_, expr2_, vars_] := 
  Chop[(expr1 - expr2 /. Thread[vars -> #]) & /@ 
     RandomReal[{-1, 1}, {10, Length[vars]}]] == Table[0, {10}];
expr1 = 1/Sqrt[2] Log[Cosh[q + x/Sqrt[2]] Sech[q - x/Sqrt[2]]];
expr2 = Sqrt[2] ArcTanh[Tanh[q] Tanh[x/Sqrt[2]]];
approxEqual[expr1, expr2, {q, x}]

As a side-note, apparently Maple uses this algorithm for such equality testing

This is somewhat straightforward if you use FindMaximum as a jumping-off point:

In[64]:= FindMaximum[expr1 - expr2, q, x]

During evaluation of In[64]:= FindMaximum::fmgz: Encountered a gradient that
is effectively zero. The result returned may not be a maximum; it may be a 
minimum or a saddle point. >>

Out[64]= {1.11022*10^-16, {q -> 1., x -> 1.}}

Thus:

approxEqual[lhs_, rhs_, tol_: 10^-10] :=
 Module[{vars},
  vars = DeleteDuplicates[
    Cases[{lhs,rhs}, s_Symbol /; Not[ValueQ[s]], Infinity]
  ];
  Chop[
    First[
     Quiet[FindMaximum[Abs[lhs - rhs], Evaluate[Sequence @@ vars]]]
    ], 
    tol] == 0
  ]

In[65]:= approxEqual[expr1, expr2]
Out[65]= True

In[66]:= approxEqual[expr1, expr2, 10^-20]
Out[66]= False

Obviously, in general this is subject to various numerical error issues that you can address with AccuracyGoal / PrecisionGoal / WorkingPrecision / etc. options to FindMaximum. You could also repeat FindMaximum for multiple starting points for the variables.

As an aside, note that TildeTilde, (i.e. ~~), is the infix operator for StringExpression.

HTH!

I really think it is worthwhile specifying patterns and ranges for the symbols you want to replace. The following code is a polished version of an equality test generator I have used for a while.
My take on this is to have numEqual=MakeEqualityTest[...] generate an equality test that you can then apply with e.g. lhs ~numEqual~rhs or whatever you prefer. Your question was a welcome chance to polish up some code I had around, and in the end it got too big to fit here, so i put it out at github (link is directly to browseable code).

Key features:

• Use Michael's depth first Cases trick for a reasonable auto-pattern
• Using Norm[#1-#2]& as a distance test to handle vectors, matrices, etc.
• The number of sampling points depends on the number of independent variables.
• A flexible system for specifying distributions (e.g. you can replace the symbols with complex numbers or matrices).

Example use:

numeq=MakeEqualityTester[];
(Cos[x]^2+Sin[x]^2)~numeq~1
Sqrt[x^2]~numeq~x

Out[5]= True
During evaluation of In[4]:= EqualityTest::notEqual: The expressions Sqrt[x^2] and x were not equal at the following point:
Out[6]= {x->-0.352399}

You can also call directly, via a utility function:

EqualityTest[1,Cos[x]^2+Sin[x]^2]
Out[7]= True

And here is an example of special symbols and distributions:

poseq=MakeEqualityTester[{
    Subscript[y,_]:>RandomReal[{10,11}],
    Automatic 
  },Tolerance-> 10^(-5)];
x ~poseq~ Sqrt[x^2]
Subscript[y,1] ~poseq~ Sqrt[Subscript[y,1]^2]

During evaluation of In[18]:= EqualityTest::notEqual: The expressions x and Sqrt[x^2] were not equal at the following point:
Out[19]= {x->-0.272029}
Out[20]= True