Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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:

enter image description here

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:
enter image description here

Thank you so much for your attention.

share|improve this question
    
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"? –  belisarius Jun 2 at 14:39
    
at least one. ok I will correct the sentence. –  mostafa Jun 2 at 14:40
    
@mostafa See a closely related post How to Flatten Array of Arrays of the highest order in a simple way?. –  Artes Jun 2 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å Jun 3 at 12:22
    
What is T23_33? –  mostafa Jun 3 at 13:46

2 Answers 2

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

enter image description here

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.

share|improve this answer

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

Mathematica graphics


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

Mathematica graphics

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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