# Finding which given functions are equal to each others

I have about 50 piece functions (generally trigonometric functions). I want to find out which ones are equal to each other after some simplifications such as FullSimplify,TrigReduce, ExpToTrig etc.

For a simple example;

        v[1] = Tan[x]
v[2] = Sin[x]/Cos[x]
v[3] = 1/Cos[x] + (Sin[x] - 1)/Cos[x]
v[4] = 1/Sin[x] + (Cos[x] - 1)/Sin[x]
v[5] = Cot[x]
v[6] = (I (E^(-I x) - E^(I x)))/(E^(-I x) + E^(I x))
v[7] = -((I (E^(-I x) + E^(I x)))/(E^(-I x) - E^(I x)))


I want to reach the result v[1]= v[2]=v[6] and v[4]=v[5]=v[7] instead of True or False.

I can delete the duplicates using Table[v[i], {i, 1, 7}] // ExpToTrig // TrigReduce // DeleteDuplicates. But I can' t show which one are equal. It's very tedious to test one by one as follows: (for many functions)

TrueQ[v[1] == v[3] // TrigReduce]


Another possibility is to use Reduce

The above table gives the conditions for equality.

Generated using:

ClearAll[x];
v = {Tan[x], Sin[x]/Cos[x], 1/Cos[x] + (Sin[x] - 1)/Cos[x],
1/Sin[x] + (Cos[x] - 1)/Sin[x],
Cot[x], (I (E^(-I x) - E^(I x)))/(E^(-I x) + E^(I x)),
-((I (E^(-I x) + E^(I x)))/(E^(-I x) - E^(I x)))};

res = Last@
Reap@Do[Do[
Sow@{"v(" <> ToString@m <> ") == v(" <> ToString@n <> ")",
Reduce[v[[m]] == v[[n]], x]}, {n, m + 1, Length@v}], {m, 1,
Length@v}]

Grid[Flatten[res, 1], Frame -> All]


You could modify the Reduce call above if you want to say add Reals for example. You can also add a range on x in the Reduce call to restrict the range.

It shows that v1=v2=v3 and v4=v5 with no conditions.

### GroupBy

GroupBy[Range[7], FullSimplify @* v]


or

GroupBy[Range[7], ExpToTrig @* v]

<|Tan[x] -> {1, 2, 3, 6}, Cot[x] -> {4, 5, 7}|>

Values @ GroupBy[Range[7], FullSimplify @*v, Apply[Equal] @* Map[Inactive[v]]]


Alternatively,

Equal @@@ Values @ GroupBy[Range @ 7, FullSimplify @* v, Map[Defer @ v]]


### Gather/ GatherBy

Gather[Range @ 7, PossibleZeroQ[v @ # - v @ #2] &]


or

GatherBy[Range @ 7, FullSimplify @* v]

{{1, 2, 3, 6}, {4, 5, 7}}


I'd check equivalences using PossibleZeroQ. Then the equivalence classes can be bundled using some Graph functionality.

Set up the functions list.

vv = {Tan[x],
Sin[x]/Cos[x],
1/Cos[x] + (Sin[x] - 1)/Cos[x],
1/Sin[x] + (Cos[x] - 1)/Sin[x],
Cot[x],
(I (E^(-I x) - E^(I x)))/(E^(-I x) + E^(I x)),
-((I (E^(-I x) + E^(I x)))/(E^(-I x) - E^(I x)))};
len = Length[vv];


Make lists of the pairs and the pair differences.

pairs = Subsets[Range[len], {2}];
diffs = Apply[Subtract, Subsets[vv, {2}], {1}];


Find which pairs are equivalent.

equivs = Pick[pairs, Map[PossibleZeroQ, diffs]]

(* Out[741]= {{1, 2}, {1, 3}, {1, 6}, {2, 3},
{2, 6}, {3, 6}, {4, 5}, {4, 7}, {5, 7}} *)


Now create lists of equivelent elements.

gg = Graph[Range[len], equivs];
ConnectedComponents[gg]

(* Out[743]= {{1, 2, 3, 6}, {4, 5, 7}} *)


You have to Hold or HoldForm the v[i] or they will evaluate to their defined function expressions.

Equal @@@
Gather[Table[With[{i = i}, HoldForm@v[i]], {i, 1, 7}],
TrueQ@Simplify[ReleaseHold[#1 - #2] == 0] &]


Using RelationGraph + ConnectedComponents as a variation on Daniel's approach:

rg = RelationGraph[FullSimplify[v @ # == v @ #2 && # =!= #2] &, Range @ 7,
VertexLabels -> {i_ :> Defer[v][i]}]

Show[rg, PlotLabel -> Style[Equal @@@ Map[Defer[v]] /@ ConnectedComponents @ rg, 16]]


Try this:

DeleteDuplicates@ExpToTrig@Table[v[i], {i, 1, 7}]
(*{Tan[x], Cot[x]}*)


Also:

Reduce[v[1] === v[2] === ExpToTrig[v[6]]]
(*True*)
Reduce[v[4] === v[5] === ExpToTrig[v[7]]]
(*False*)

• I want to reach the result v[1]= v[2]=v[6] and v[4]=v[5]=v[7] instead of (*{Tan[x], Cot[x]}*) or True or False. Mar 31 at 22:23