That's a way
In[147]:= Clear[fidellisTerm, fidellisOver, fidellisMin]
fidellisTerm[x_Symbol, l1_List, y_Symbol, l2_List] :=
Inner[Times, Overscript[x, #]& /@ l1, Subscript[y, #]& /@ l2, Plus] /; AtomQ[x] && AtomQ[y] && Length[l1] == Length[l2] &&
VectorQ[l1, IntegerQ]
fidellisOver[x_] := Last[Last[Extract[x, Position[x, _Overscript]]]] /; !FreeQ[x, Overscript]
fidellisMin[x_] := Plus @@ First[GroupBy[SortBy[List @@ x, fidellisOver], fidellisOver]]
fidellisMin[x_, y_] := Block[{ex = fidellisMin[x], ey = fidellisMin[y], i0},
i0 = {fidellisOver[ex]} \[Intersection] {fidellisOver[ey]};
If[i0 =!= {},
Print["Both terms contain the minimal overscript ", i0], (* else *)
fidellisMin[x + y]
]
]
In[153]:= fidellisMin[fidellisTerm[\[Upsilon], {6}, \[Zeta], {{5}}],
fidellisTerm[\[Upsilon], {3, 9}, \[Zeta], {{9}, {15}}]]
Out[153]=
\!\(\*OverscriptBox[\(\[Upsilon]\), \(3\)]\)
\!\(\*SubscriptBox[\(\[Zeta]\), \({9}\)]\)
In[154]:= fidellisMin[fidellisTerm[\[Upsilon], {3}, \[Zeta], {{5}}],
fidellisTerm[\[Upsilon], {3, 9}, \[Zeta], {{9}, {15}}]]
During evaluation of In[154]:= Both terms contain the minimal overscript {3}
In[155]:= fidellisMin[
fidellisTerm[\[Upsilon], {6, 2, 7}, \[Zeta], {{9}, {15}, {12}}],
fidellisTerm[\[Upsilon], {8, 7, 4}, \[Zeta], {{81}, {83}, {69}}]]
Out[155]=
\!\(\*OverscriptBox[\(\[Upsilon]\), \(2\)]\)
\!\(\*SubscriptBox[\(\[Zeta]\), \({15}\)]\)
In[156]:= fidellisMin[
fidellisTerm[\[Upsilon], {6, 2}, \[Zeta], {{9}, {9, 15}}],
fidellisTerm[\[Upsilon], {3, 9,
8}, \[Zeta], {{9}, {9, 15}, {12, 81}}]]
Out[156]=
\!\(\*OverscriptBox[\(\[Upsilon]\), \(2\)]\)
\!\(\*SubscriptBox[\(\[Zeta]\), \({9, 15}\)]\)
In[157]:= fidellisMin[
fidellisTerm[\[Upsilon], {6, 3, 5,
8}, \[Zeta], {{9}, {9, 15}, {9, 15}, {12, 81}}],
fidellisTerm[\[Upsilon], {4, 10, 7, 2,
9}, \[Zeta], {{9}, {9, 15}, {12}, {1}, {15}}]]
Out[157]=
\!\(\*OverscriptBox[\(\[Upsilon]\), \(2\)]\)
\!\(\*SubscriptBox[\(\[Zeta]\), \({1}\)]\)
In[158]:= fidellisMin[
fidellisTerm[\[Upsilon], {6, 3, 5,
2}, \[Zeta], {{9}, {9, 15}, {9, 15}, {12, 81}}],
fidellisTerm[\[Upsilon], {4, 10, 7, 2,
9}, \[Zeta], {{9}, {9, 15}, {12}, {1}, {15}}]]
During evaluation of In[158]:= Both terms contain the minimal overscript {2}
the result section looks awkward in the editor; for your convenience as a picture:
- the fact that your terms (
fidellisTerm[]
) are Plus
connected has been used in fidellisMin[x_]
as well as in fidellisMin[x_, y_]
- consider not to redefine built-in symbols because that can be confusing because all notebooks run by default in the same context in a Mathematica session