extraction new generated vectors in module with replaced parts

Question

We have four vectors:

Subscript[B, 1] = {{20}, {10}, {5}, {1}};
Subscript[B, 2] = {{1},{5},{10},{20}};
Subscript[B, 3] = {{1}, {10}, {5}, {20}};
Subscript[B, 4] = {{20},{1}, {5}, {10}};

We wrote a short code to find every vector which has followed numbers 10 and 20. After finding, replacing them and all component and other vectors remain unchanged. the wrong commands happen because: (in ReplacePart we could not able to give a suitable all a components, we just wrote ReplacePart[a]! also we could not able to see some changed vectors but with a new name not with name of Bi's because each defined variable in module, is temporary for example the name 'new' for new vectors): As a matter of fact we want to see:

 desire results
 Subscript[new, 1] = {{10}, {20}, {5}, {1}};
 Subscript[new, 2] = {{1}, {5}, {20}, {10}};


 the code:
Do[
   Do[
   If[(Subscript[B, i][[j]] == 20 \[And]Subscript[B, i][[j + 1]] == 10)     \[Or] 
      (Subscript[B, i][[j]] == 10 \[And] Subscript[B, i][[j + 1]] == 20),

 Module[ {a = Subscript[B, i]}, 
 ReplacePart[{a}, {j -> a[[j + 1]], j + 1 -> a[[j]]}]]]
 ,{j, 1, 3}]
 ,{i, 1, 4}]

Answer 1

Here's a minimally-changed working version of what you want, I think:

Do[
  Do[
    If[
      (Subscript[B, i][[j]] == {20} && Subscript[B, i][[j + 1]] == {10}) || (Subscript[B, i][[j]] == {10} && Subscript[B, i][[j + 1]] == {20})
      , Subscript[new, i] = Module[
          {a = Subscript[B, i]}
          , ReplacePart[a, {j -> a[[j + 1]], j + 1 -> a[[j]]}]]]
    , {j, 1, 3}
  , {i, 1, 4}]

First, Subscript[B, 1][[1]] has the value {20} rather than 20, so the conditionals in your If statement weren't matching. Once this is corrected, Module does output the correct vectors. I have the output of the Module now assigned to Subscript[new, i], as you wanted.

Now, I would make a few preliminary changes to simplify the code. First, the two Do loops can be made into one. Second, we can check for the sequences {10},{20} and {20},{10} directly by using spans of Part. Finally, we should not use Subscripts, as they act strange in Mathematica. These changes result in

b[1] = {{20}, {10}, {5}, {1}};
b[2] = {{1},{5},{10},{20}};
b[3] = {{1}, {10}, {5}, {20}};
b[4] = {{20},{1}, {5}, {10}};

Do[
  If[b[i][[j ;; j + 1]] == {{20}, {10}} || b[i][[j ;; j + 1]] == {{10}, {20}}
    , new[i] = Module[{a = b[i]}
        , ReplacePart[a, {j -> a[[j + 1]], j + 1 -> a[[j]]}]
        ]
    ]
  , {j, 1, 3}, {i, 1, 4}]

Update

Now, if we'd like to start playing around with a little bit more of Mathematica's clever functionality, we could come up with a pattern matching version that also uses Scan instead of Do. This version is sort of kluge-y, and it also has the side-effect of assigning new[3] and new[4] to b[3] and b[4], but we can fix that later.

Scan[(
    new[#] = b[#] /. {{x___, {20}, {10}, z___} :> {x, {10}, {20}, z}, {x___, {10}, {20}, z___} :> {x, {20}, {10}, z}}
  ) &, Range[4]]

This version takes the function defined in the first argument of Scan and applies it to every element of the second argument. So it takes the values 1, 2, 3, and 4 (the elements of Range[4]) and consecutively puts them in the Slot (#), at which time the right-hand side of the = is evaluated. In this right hand side, we find patterns that match {anything, {20},{10},anything} or {anything, {10},{20},anything} and replace them with the switched version. This is then assigned to new[i], which is why there is the side effect of assigning all of the new[i]s.