оператор для проверки приближенного равенства в Mathematica

Question

Мне часто нужно проверять, если expr1==expr2, где проверка на символическое равенство трудна, но достаточна числовая проверка

Чтобы справиться с такими случаями, было бы замечательно, чтобы TildeTilde работал как Equal но вместо проверки символьного равенства он будет заменять неизвестные числовыми значениями и проверять числовое равенство в нескольких точках.

Неизвестные - это вещи, которые "выглядят как" переменные в выражении.Те, о которых я могу думать, имеют форму x, x[1,2] и Subscript[x,2,3].Любые советы приветствуются!

edit

обычно я делаю что-то вроде ниже, но это требует указания переменных, иногда требует изменения допуска Чопа, и "10 образцов" кажется произвольным.Идеальным тестером была бы функция, которая работает как Equals и гарантирует значимые False ответы.(чтобы дополнить Equals, который имеет содержательные True ответы)

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}]

В качестве дополнительного примечания, очевидно, Maple использует этот алгоритм для такого тестирования на равенство

Answer 1

Это несколько просто, если вы используете FindMaximum в качестве отправной точки:

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.}}

Таким образом:

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

Очевидно, что в общем случае это связано с различными проблемами с числовыми ошибками, которые вы можете решить с помощью опций AccuracyGoal / PrecisionGoal / WorkingPrecision / и т. Д. До FindMaximum. Вы также можете повторить FindMaximum для нескольких начальных точек для переменных.

В дополнение отметим, что TildeTilde (т.е. ~~) является инфиксным оператором для StringExpression.

НТН!

Answer 2

Я действительно думаю, что стоит указать шаблоны и диапазоны для символов, которые вы хотите заменить. Следующий код является отработанной версией генератора тестов на равенство, который я использовал некоторое время.
Мое предположение состоит в том, чтобы numEqual=MakeEqualityTest[...] сгенерировал тест на равенство, который вы затем можете применить, например, lhs ~numEqual~rhs или что вы предпочитаете. Ваш вопрос был желанным шансом откорректировать некоторый код, который у меня был, и в конце он стал слишком большим, чтобы поместиться здесь, поэтому я поместил его на github (ссылка непосредственно на просматриваемый код).

Основные характеристики:

• Сначала используйте уловку глубины Майкла Cases для разумного автоматического паттерна
• Использование Norm[#1-#2]& в качестве дистанционного теста для обработки векторов, матриц и т. Д.
• Количество точек отбора проб зависит от количества независимых переменных.
• Гибкая система указания распределений (например, вы можете заменить символы комплексными числами или матрицами).

Пример использования:

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}

Вы также можете позвонить напрямую через служебную функцию:

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

А вот пример специальных символов и распределений:

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