5
$\begingroup$

I have a code that generates various tables like

T1 = {{-1., 0.880673, 0.880673}, {-0.9, 0.870404, 0.870404}, {-0.8, 
0.839598, 0.839598}, {-0.7, 0.788252, 0.788252}, {-0.6, 0.716371, 
0.716371}, {-0.5, 0.62399, 0.62399}, {-0.4, -0.066081, 
1.08857}, {-0.3, -0.515704, 1.27288}, {-0.2, -0.922929, 
1.37822}, {-0.1, -1.30305, 1.43556}, {0., 
1.45392, -1.53348}, {0.1, -1.30305, 1.43556}, {0.2, -0.922929, 
1.37822}, {0.3, -0.515704, 1.27288}, {0.4, -0.066081, 
1.08857}, {0.5, 0.62399, 0.62399}, {0.6, 0.716371, 
0.716371}, {0.7, 0.788252, 0.788252}, {0.8, 0.839598, 
0.839598}, {0.9, 0.870404, 0.870404}, {1., 0.880673, 0.880673}};

For each {a,b,c}, I want to swap the second item~(b) with the third one~(c) if b>c. In the above table, this procedure should apply only to {0.,1.45392,-1.53348} which can be done using

 {T1[[11, 2]], T1[[11, 3]]} = {T1[[11, 3]], T1[[11, 2]]}

As I am dealing with larger tables like above with different numbers of elements and orders, I am looking for a solution that automatically checks the criteria and swap the elements if it was needed.

$\endgroup$

6 Answers 6

5
$\begingroup$

You want to do the same thing to every item in T1, each of those items happens to be a list of 3 numbers. Wanting to do the same thing to every item in a list often suggests using Map.

Map[If[#[[2]]>#[[3]],{#[[1]],#[[3]],#[[2]]},#]&,T1]

accomplishes what you want.

If all those # and & seem confusing then you can do the same thing another way.

myswap[{a_,b_,c_}]:= If[b>c,{a,c,b},{a,b,c}]
Map[myswap,T1]

There are almost always multiple different ways of accomplishing anything in Mathematica. A few of those can sometimes seem to be almost completely incomprehensible, even to moderately experienced users and that you might wonder how in the world you would ever have found that on your own and how you might ever modify that for another problem that you need to solve. I suggest picking ways that seem understandable to you and that you can more likely remember and that you might likely be able to use again in the future for other problems. Once you have more experience then you can try remembering more of the strange solutions and perhaps even practice coming up with some of these for yourself.

$\endgroup$
2
  • $\begingroup$ Perfect! Thanks! $\endgroup$
    – Shasa
    Jul 10, 2021 at 12:57
  • 1
    $\begingroup$ For cases like this, I would suggest @@@ (or Apply with level spec {1}) instead of Map. Because then, #[[1]] becomes #, #[[2]] becomes #2, etc. (and # becomes {##}), which I find a lot more readable $\endgroup$
    – Lukas Lang
    Jul 11, 2021 at 7:28
5
$\begingroup$

Another solution using Replace and Condition (/;)

Replace[{a_,b_,c_}/;b>c:>{a,c,b}] /@ T1

Or, using the level specification of Replace:

Replace[T1, {a_,b_,c_}/;b>c:>{a,c,b}, 1]
$\endgroup$
3
$\begingroup$

You can do this with Ifand Map (although there might also be some other more elegant ways):

If[#[[2]] > #[[3]], {#[[1]], #[[3]], #[[2]]}, #] & /@ T1

(* {{-1., 0.880673, 0.880673}, {-0.9, 0.870404, 0.870404}, {-0.8, 
  0.839598, 0.839598}, {-0.7, 0.788252, 0.788252}, {-0.6, 0.716371, 
  0.716371}, {-0.5, 0.62399, 0.62399}, {-0.4, -0.066081, 
  1.08857}, {-0.3, -0.515704, 1.27288}, {-0.2, -0.922929, 
  1.37822}, {-0.1, -1.30305, 1.43556}, {0., -1.53348, 
  1.45392}, {0.1, -1.30305, 1.43556}, {0.2, -0.922929, 
  1.37822}, {0.3, -0.515704, 1.27288}, {0.4, -0.066081, 
  1.08857}, {0.5, 0.62399, 0.62399}, {0.6, 0.716371, 0.716371}, {0.7, 
  0.788252, 0.788252}, {0.8, 0.839598, 0.839598}, {0.9, 0.870404, 
  0.870404}, {1., 0.880673, 0.880673}} *)
$\endgroup$
1
  • $\begingroup$ +1. Thank you! This indeed does the trick. I've just accepted the previous answer as it came first. $\endgroup$
    – Shasa
    Jul 10, 2021 at 12:59
3
$\begingroup$
 list =
  {{-1., 0.880673, 0.880673}, {-0.9, 0.870404, 0.870404}, 
   {-0.8, 0.839598, 0.839598}, {-0.7, 0.788252, 0.788252}, 
   {-0.6, 0.716371, 0.716371}, {-0.5, 0.62399, 0.62399}, 
   {-0.4, -0.066081, 1.08857}, {-0.3, -0.515704, 1.27288}, 
   {-0.2, -0.922929, 1.37822}, {-0.1, -1.30305, 1.43556}, 
   {0., 1.45392, -1.53348}, {0.1, -1.30305, 1.43556}, 
   {0.2, -0.922929, 1.37822}, {0.3, -0.515704, 1.27288}, 
   {0.4, -0.066081, 1.08857}, {0.5, 0.62399, 0.62399}, 
   {0.6, 0.716371, 0.716371}, {0.7, 0.788252, 0.788252}, 
   {0.8, 0.839598, 0.839598}, {0.9, 0.870404, 0.870404}, 
   {1., 0.880673, 0.880673}};

1.

Get position(s) of elements to swap

p = Position[list, {_, b_, c_} /; b > c]

{{11}}

Using ReplaceAt (new in 13.1)

ReplaceAt[list, {a_, b_, c_} :> {a, c, b}, p]

returns

{{-1., 0.880673, 0.880673}, {-0.9, 0.870404, 0.870404}, 
   {-0.8, 0.839598, 0.839598}, {-0.7, 0.788252, 0.788252}, 
   {-0.6, 0.716371, 0.716371}, {-0.5, 0.62399, 0.62399}, 
   {-0.4, -0.066081, 1.08857}, {-0.3, -0.515704, 1.27288}, 
   {-0.2, -0.922929, 1.37822}, {-0.1, -1.30305, 1.43556}, 
   {0., -1.53348, 1.45392}, {0.1, -1.30305, 1.43556}, 
   {0.2, -0.922929, 1.37822}, {0.3, -0.515704, 1.27288}, 
   {0.4, -0.066081, 1.08857}, {0.5, 0.62399, 0.62399}, 
   {0.6, 0.716371, 0.716371}, {0.7, 0.788252, 0.788252}, 
   {0.8, 0.839598, 0.839598}, {0.9, 0.870404, 0.870404}, 
   {1., 0.880673, 0.880673}};

2.

Using MapApply (new in 13.1)

MapApply[If[#2 > #3, {#1, #3, #2}, {##}] &, list]

(* same output *)

$\endgroup$
2
$\begingroup$
list =
  {{-1., 0.880673, 0.880673}, {-0.9, 0.870404, 0.870404}, 
   {-0.8, 0.839598, 0.839598}, {-0.7, 0.788252, 0.788252}, 
   {-0.6, 0.716371, 0.716371}, {-0.5, 0.62399, 0.62399}, 
   {-0.4, -0.066081, 1.08857}, {-0.3, -0.515704, 1.27288}, 
   {-0.2, -0.922929, 1.37822}, {-0.1, -1.30305, 1.43556}, 
   {0., 1.45392, -1.53348}, {0.1, -1.30305, 1.43556}, 
   {0.2, -0.922929, 1.37822}, {0.3, -0.515704, 1.27288}, 
   {0.4, -0.066081, 1.08857}, {0.5, 0.62399, 0.62399}, 
   {0.6, 0.716371, 0.716371}, {0.7, 0.788252, 0.788252}, 
   {0.8, 0.839598, 0.839598}, {0.9, 0.870404, 0.870404}, 
   {1., 0.880673, 0.880673}};

Using ReplaceAll:

list /. s_?VectorQ /; Subtract @@ Rest[s] > 0 :> Permute[s, Cycles[{{3, 2}}]]

{{-1., 0.880673, 0.880673}, {-0.9, 0.870404, 0.870404}, 
{-0.8, 0.839598, 0.839598}, {-0.7, 0.788252, 0.788252}, 
{-0.6, 0.716371, 0.716371}, {-0.5, 0.62399, 0.62399}, 
{-0.4, -0.066081, 1.08857}, {-0.3, -0.515704, 1.27288}, 
{-0.2, -0.922929, 1.37822}, {-0.1, -1.30305, 1.43556}, 
{0., -1.53348, 1.45392}, {0.1, -1.30305, 1.43556}, 
{0.2, -0.922929, 1.37822}, {0.3, -0.515704, 1.27288}, 
{0.4, -0.066081, 1.08857}, {0.5, 0.62399, 0.62399}, 
{0.6, 0.716371, 0.716371}, {0.7, 0.788252, 0.788252}, 
{0.8, 0.839598, 0.839598}, {0.9, 0.870404, 0.870404}, 
{1., 0.880673, 0.880673}};
$\endgroup$
1
$\begingroup$
T1 = {{-1., 0.880673, 0.880673}, {-0.9, 0.870404, 0.870404}, {-0.8, 
    0.839598, 0.839598}, {-0.7, 0.788252, 0.788252}, {-0.6, 0.716371, 
    0.716371}, {-0.5, 0.62399, 0.62399}, {-0.4, -0.066081, 
    1.08857}, {-0.3, -0.515704, 1.27288}, {-0.2, -0.922929, 
    1.37822}, {-0.1, -1.30305, 1.43556}, {0., 
    1.45392, -1.53348}, {0.1, -1.30305, 1.43556}, {0.2, -0.922929, 
    1.37822}, {0.3, -0.515704, 1.27288}, {0.4, -0.066081, 
    1.08857}, {0.5, 0.62399, 0.62399}, {0.6, 0.716371, 
    0.716371}, {0.7, 0.788252, 0.788252}, {0.8, 0.839598, 
    0.839598}, {0.9, 0.870404, 0.870404}, {1., 0.880673, 0.880673}};

res = MapAt[
  SubsetMap[RotateLeft, #, {2, 3}] &
  , T1
  , Position[T1, _?(#[[2]] > #[[3]] &), 1, Heads -> False]
  ]

To visualize, define g:

g = {#[[1]], 
    If[#[[2]] > #[[3]], Style[#[[2]], Red], Style[#[[2]], Blue]], 
    If[#[[3]] < #[[2]], Style[#[[3]], Blue], Style[#[[3]], Red]]} &;

MatrixForm /@ {g /@ T1, g /@ res}

enter image description here


$\endgroup$

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.