# How to combine lists with plus minus signs?

I have two lists of Mathematica expressions,

t1 = {(-2*wr20)/(7*Sqrt[15]) + (10*Sqrt[3]*wr40)/77 - (50*wr60)/(11*Sqrt[39]),
wr00 - (Sqrt[5]*wr20)/3};

t2 = {(2*wr20)/(7*Sqrt[15]) - (10*Sqrt[3]*wr40)/77 + (50*wr60)/(11*Sqrt[39]),
wr00 - (Sqrt[5]*wr20)/3};


where one of the terms is the same, the other differs by an overall sign, and they have the same ordering. What I want is to combine the two lists and output to latex using $$\pm$$ and $$\mp$$ signs, like $$\left\{\mp\frac{2 \text{wr20}}{7 \sqrt{15}}\pm\frac{10 \sqrt{3} \text{wr40}}{77}\mp\frac{50 \text{wr60}}{11 \sqrt{39}},\text{wr00}-\frac{\sqrt{5} \text{wr20}}{3}\right\}.$$ This is just a simplified example of large lists I'm dealing with. The terms that differ by overall signs are alway at the same positions in the lists. It will save a lot of space in the latex document by combining them. There is some discussion about $$\pm$$ signs, but none could solve my problem.

ClearAll[syntaticSigns, removeSigns, combineByAbs]

syntaticSigns = Map[(-1)^Boole[InternalSyntacticNegativeQ @ #] &] /@ MonomialList @ # &;

removeSigns = Abs[#] /. Abs -> Identity &;

combineByAbs = If[StringStartsQ["+"] @ #, StringDrop[#, 1], #] & /@ Values @
GroupBy[Join[##], Abs@*MonomialList,
StringJoin @ Riffle[Transpose[syntaticSigns[#]] /.
{ {-1, 1} -> "∓", {1, -1} -> "±", {-1, -1} -> "\[Minus]", {1, 1} -> "+"},
ToString[#, StandardForm] & /@ removeSigns[MonomialList @ First @ #]] &] &;


Examples:

combineByAbs[t1, t2]


ToExpression[combineByAbs[t1, t2]]


TeXForm @ ToExpression[combineByAbs[t1, t2]]


$$\left\{\left(\mp \frac{2 \text{wr20}}{7 \sqrt{15}}\pm \frac{10 \sqrt{3} \text{wr40}}{77}\right)\mp \frac{50 \text{wr60}}{11 \sqrt{39}},\text{wr00}-\frac{\sqrt{5} \text{wr20}}{3}\right\}$$

The following adds an additional "+" sign before the "+/-" and reorders the additive terms according to MMA rules. Is this acceptable?

t1 = {(-2*wr20)/(7*Sqrt[15]) + (10*Sqrt[3]*wr40)/
77 - (50*wr60)/(11*Sqrt[39]), wr00 - (Sqrt[5]*wr20)/3};
t2 = {(2*wr20)/(7*Sqrt[15]) - (10*Sqrt[3]*wr40)/
77 + (50*wr60)/(11*Sqrt[39]), wr00 - (Sqrt[5]*wr20)/3};

fun[x1_, x2_] := Plus @@ MapThread[
If[#1 === #2, #,
If[Positive[#1 /. c_?NumericQ  x_ -> c], PlusMinus[#1],
MinusPlus[#2]]
] &, {List @@ x1, List @@ x2}];
`

• It's a step forward. It would be better if you could remove the unwanted $+$ sign. Aug 2, 2021 at 15:08
• It produces output {[PlusMinus](-((2 wr20)/(7 Sqrt[15]))) + [PlusMinus](( 10 Sqrt[3] wr40)/77) + [PlusMinus](-((50 wr60)/(11 Sqrt[39]))), wr00 - (Sqrt[5] wr20)/3}. TeXForm gives the same form, so it's not really useful. Aug 3, 2021 at 0:28