2
$\begingroup$

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.

$\endgroup$

2 Answers 2

3
$\begingroup$
ClearAll[syntaticSigns, removeSigns, combineByAbs]

syntaticSigns = Map[(-1)^Boole[Internal`SyntacticNegativeQ @ #] &] /@ 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]

enter image description here

ToExpression[combineByAbs[t1, t2]]

enter image description here

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\}$

$\endgroup$
1
$\begingroup$

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}];
MapThread[fun, {t1, t2}]

enter image description here

$\endgroup$
2
  • $\begingroup$ It's a step forward. It would be better if you could remove the unwanted $+$ sign. $\endgroup$
    – Frank
    Aug 2, 2021 at 15:08
  • $\begingroup$ 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. $\endgroup$
    – Frank
    Aug 3, 2021 at 0:28

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.