# Pattern match list with 3-element arrays, and replace entries

list = {
{0, 1, 1}, {0, 1, 1}, {0, 1, 1},
{0, 1, 1}, {0, 1, 1}, {0, 1, 1},
{0, 1, 1}, {1, 1, 0}, {1, 1, 0},
{1, 0, 1}, {1, 0, 1}, {1, 0, 1},
{1, 0, 1} ,{1, 0, 1},{1, 0, 1}
};


The list always has two 1s and one zero. I want to replace the 0s (position 1, 2 or 3 within element) that change to 1 in next element, with minus 1. This would give list2 below.

list2 = {
{0, 1, 1}, {0, 1, 1}, {0, 1, 1},
{0, 1, 1}, {0, 1, 1}, {0, 1, 1},
{**-1**, 1, 1}, {1, 1, 0}, {1, 1, **-1**},
{1, 0, 1}, {1, 0, 1}, {1, 0, 1},
{1, 0, 1} ,{1, 0, 1},{1, 0, 1}
};


## 4 Answers

list = {{0, 1, 1}, {1, 1, 0}, {1, 1, 0}, {1, 0, 1}, {1, 0, 1}};

Join[Subtract @@@ Partition[list, 2, 1] /. {1 -> 0}, {{0, 0, 0}}] + list


{{-1, 1, 1}, {1, 1, 0}, {1, 1, -1}, {1, 0, 1}, {1, 0, 1}}

• Thanks that work perfectly! I am still deciphering fully how it works, but excellent idea to add the original list as the zeros don't change the minus one! Thanks again!
– SPIL
Commented Dec 7, 2016 at 14:49
• OK I think I've upvote/accepted now.
– SPIL
Commented Dec 7, 2016 at 16:27

A replacement-based approach, with minimal pre- and post-processing of the list:

list = {{0, 1, 1}, {1, 1, 0}, {1, 1, 0}, {1, 0, 1}, {1, 0, 1}};
Transpose@list /. {a___, 0, 1, b___} :> {a, -1, 1, b} // Transpose
(* {{-1, 1, 1}, {1, 1, 0}, {1, 1, -1}, {1, 0, 1}, {1, 0, 1}} *)

• Thanks that is useful, with minimal pre- and post-processing, there is less risk of something going awry.
– SPIL
Commented Dec 9, 2016 at 16:50
list = {{0, 1, 1}, {1, 1, 0}, {1, 1, 0}, {1, 0, 1}, {1, 0, 1}};


Using ArrayReduce (new in 12.2) and the operator form of SequenceReplace (new in 11.3)

ArrayReduce[SequenceReplace[{0, 1} :> Sequence[-1, 1]], list, 2]


{{-1, 1, 1}, {1, 1, 0}, {1, 1, 0}, {1, -1, 1}, {1, -1, 1}}

With ArrayReduce we don't need Map and the double transposition

Transpose @ Map[SequenceReplace[{0, 1} :> Sequence[-1, 1]], Transpose @ list]


{{-1, 1, 1}, {1, 1, 0}, {1, 1, -1}, {1, 0, 1}, {1, 0, 1}}

list = {{0, 1, 1}, {1, 1, 0}, {1, 1, 0}, {1, 0, 1}, {1, 0, 1}};


Using ReplaceAll and a Do loop:

Module[{l = list, n = Length@list},
Do[If[Unequal[l[[i]], l[[i + 1]]],
l[[i]] = ReplaceAll[l[[i]], {0 -> -1}];], {i, n - 1}];l]

(*{{-1, 1, 1}, {1, 1, 0}, {1, 1, -1}, {1, 0, 1}, {1, 0, 1}}*)