# Improving code for comparing and modifying nested matrices

I have a matrix such as:

 tT = {{a, b, c}, {d, e, f}, {g, h, i}};
a = {{0, 0, 1}, {0, 1, 0}, {1, 0, 0}};
b = {{1, 0, 0}, {0, 0, 0}, {0, 1, 0}};
c = {{0, 0, 0}, {1, 0, 1}, {0, 0, 0}};
d = {{1, 0, 0}, {0, 1, 0}, {0, 1, 0}};
e = {{0, 1, 0}, {1, 0, 0}, {1, 0, 0}};
f = {{0, 1, 0}, {1, 0, 0}, {0, 0, 1}};
g = {{1, 0, 0}, {0, 0, 0}, {0, 0, 1}};
h = {{0, 0, 0}, {0, 1, 0}, {0, 0, 0}};
i = {{1, 0, 0}, {0, 0, 0}, {1, 0, 0}};


That the picture of matrix is same as:

In the first step, I want to compare elements of tT11 with the elements of tT12, also compare between elements of tT11 with the elements of tT13. Moreover, compare between elements of tT12 with the elements of tT13. After that tT21 with tT22 and tT23 and so on.

If at least one of the corresponding elements of tT11 and tT12 are simultaneously equal to 1, I want to put a zero instead for all elements in tT12. Also, I want to make the same comparison, between elements of tT11 with the elements of tT13 with the same condition. (moreover, tT12 and tT13). Also the corresponding element in other rows. I write below line:

Do[
If[tT[[r, n, k, q]] == tT[[r, m, k, q]]==1,
Do[tT[[r, m, x, y]] = 0,{x,1,3},{y,1,3}]],
{r, 1, 3}, {n, 1, 2}, {k, 1, 3}, {q, 1, 3}, {m, n + 1, 3}]


Actually, my desire is to get the result that I bring it below: I am going to generalize this goal to a much larger matrix and this matrix (tT 3*3) is just an example. How can I modify above written process (code) for more efficiency. How can I replace other commands instead of two Do loops. My desired result is:

Thank you so much for your attention.

• By "If simultaneously, just one of the element of tT11 and tT12 equal to 1 ...",do you mean "one and only one" or "at least one"? Commented Jun 2, 2014 at 14:39
• at least one. ok I will correct the sentence. Commented Jun 2, 2014 at 14:40
• @mostafa See a closely related post How to Flatten Array of Arrays of the highest order in a simple way?. Commented Jun 2, 2014 at 21:14
• @mostafa I don't really understand why T23_33 is equal to 0 in your example. (same goes with T33_31)
– Öskå
Commented Jun 3, 2014 at 12:22
• What is T23_33? Commented Jun 3, 2014 at 13:46

## 3 Answers

Pattern matching approach:

Clear[replaceWithZero]
replaceWithZero[l_List] :=
With[{allZero = ConstantArray[0, {3, 3}]},
l //. {a___, x_, b___, y_, c___} /;
x != allZero && y != allZero && MemberQ[x + y, 2, {2}] :> {a, x, b, allZero, c}];

replaceWithZero /@ tT // MatrixForm


Update: scaling this function up to take matrices of any size:

Clear[compareWithin]
compareWithin[mat_List] := Module[{replaceWithZero, innerDimension},
innerDimension = Take[Dimensions[mat], -2];
replaceWithZero[l_List] :=
With[{allZero = ConstantArray[0, innerDimension]},
l //. {a___, x_, b___, y_, c___} /;
x != allZero && y != allZero && MemberQ[x + y, 2, {2}] :> {a, x, b, allZero, c}];
replaceWithZero /@ mat]

With[{mat = RandomInteger[1, {5, 5, 3, 2}]},
MatrixForm /@ {mat,
compareWithin[mat] /.
x_List /; MatchQ[Flatten@x, {0 ..}] :>
Map[Style[#, Red] &, x, {2}]}] // Row


I think I have a no-loops approach to your problem. First, I am using the fact that you only want to compare tT11 with tT12 and tT13, not with any of the matrices on the other rows of the super matrix. So create a function that operates on a single list of matrices, and then Map that function onto your matrix of matrices, tT.

myfun[a : {__?MatrixQ}] /; Length[a] > 1 &&  (SameQ @@ Dimensions /@ a) :=
With[{len = Length[First[a]],
places = Last /@ Subsets[Range[Length[a]], {2}],
maxes = Max /@ Plus @@@ Subsets[a, {2}]},
MapIndexed[
If[Max[Pick[maxes, places, First@#2]] > 1,
ConstantArray[0, {len, len}], #1] &, a]]

myfun /@ tT // MatrixForm


The rationale of my approach is that if you want to replace the submatrix depending on whether any of its elements is a 1 that matches up with a 1 in the earlier submatrix. In other words, if any of the elements of the element-by-element sum of the two matrices is greater than 1. Since Max is Listable, you can test whether the Max of the sum of the two matrices exceeds 1. If it is, you then need to work out which submatrix to zero out, which can be worked out as the second element of the corresponding Subset of a simple range or integers. If the sum of any of the subsets where the second element is the matrix of interest (determined using Pick) has a maximum element above 1, then zero out the matrix.

This function should work for any number of matrices in each row of the super matrix, and for any dimension of the submatrices, as long as all the matrices in each row have the same dimensions. I don't think the submatrices even need to be square.

The 'Do' works correctly but unfortunately, '1' is missed in the first of that:

Do[
If[tT[[r, n, k, q]] == tT[[r, m, k, q]]==1,
Do[tT[[r, m, x, y]] = 0,
{x,1,3},{y,1,3}]],
{r, 1, 3}, {n, 1, 2}, {k, 1, 3}, {q, 1, 3}, {m, n + 1, 3}]


Although, as I know, it is not so optimum code. I wish to eliminate 'Do' in 'Do'.