1
$\begingroup$

My own code (for the following aim) which I think is not so good written is:

 Do[desired[k] = 0;
    Do[
       Do[
      If[list1[[i]] == list2[[j]], desired[k] += matrix[[i, j]]]

   , {i, 1, Length@list2}]
 , {j, 1, Length@list1}]
  , {k, 1, 5}]

Please see two below lists (8*5) (which are equal to each other):

list1 = {{1, 0, 0, 3, 0}, {1, 0, 0, 3, 0}, {3, 0, 0, 2, 0}, {3, 0, 0, 
1, 0}, {2, 0, 0, 3, 0}, {3, 0, 0, 3, 0}, {3, 0, 0, 3, 0}, {3, 0, 
0, 2, 0}};
list2 = {{1, 0, 0, 3, 0}, {1, 0, 0, 3, 0}, {3, 0, 0, 2, 0}, {3, 0, 0, 
1, 0}, {2, 0, 0, 3, 0}, {3, 0, 0, 3, 0}, {3, 0, 0, 3, 0}, {3, 0, 
0, 2, 0}};

Some elements of these matrices are equal, For instance: {1, 0, 0, 3, 0}, {1, 0, 0, 3, 0}. For the future, I take i index from the first list and j from the second list.

I have another matrix as 

matrix={{7, 6, 9, 9, 8, 8, 10, 10}, {6, 8, 10, 6, 6, 6, 6, 8}, {8, 9, 6, 8, 
  6, 9, 5, 8}, {5, 9, 7, 6, 7, 7, 5, 8}, {10, 5, 10, 8, 8, 5, 10, 
 6}, {10, 9, 5, 5, 10, 8, 8, 7}, {7, 6, 7, 10, 7, 9, 7, 8}, {6, 7, 6,
  5, 7, 8, 7, 10}}

It is an 8*8 matrix.

I am going to try sum over some elements of the matrix that their indices are obeyed by the equality of the rows of the two upper lists: (sum over matrix[[i,j]] in which i is from the first list and j from the second one).I mean

    (*{1,0,0,3,0}*)
     desired[1] = matrix[[1, 1]] + matrix[[1, 2]] + matrix[[2, 1]] +  matrix[[2,2]];
   (*{3,0,0,2,0} *)
    desired[2] = matrix[[3, 3]] + matrix[[3, 8]] + matrix[[8, 3]]+ matrix[[8, 8]];
   (*{3,0,0,1,0}*)
    desired[3] = matrix[[4, 4]];
   (*{2,0,0,3,0} *)
    desired[4] = matrix[[5, 5]];
   (*{3,0,0,3,0}*)
     desired[5] =matrix[[6, 6]] + matrix[[6, 7]] + matrix[[7, 6]] + matrix[[7, 7]];

for the last case ((*{3,0,0,2,0}*)) we do not need a new calculation because it was considered.

Is an efficient code? Also I put the {k, 1, 5} by hand. I saw that the k cannot exceed form 5.

|improve this question
$\endgroup$
  • $\begingroup$ Thinking about this further, I'm less sure I understood what you want before answering. Why are there two lists (list1 and list2)? Can they be different? What if list1 has a value which is absent from list2? $\endgroup$ – jjc385 Jul 5 '17 at 20:35
  • $\begingroup$ For more clear I just wrote twice. I wanted to show for index i and j $\endgroup$ – Unbelievable Jul 5 '17 at 20:37
  • $\begingroup$ Ok, let me ask you about a smaller case, where list1 and list2 are different. Suppose matrix={{a,b},{c,d}} and list1={x,y} while list2={y,z}. What is the desired output? Is it desired[1] = matrix[[2,1]]? $\endgroup$ – jjc385 Jul 5 '17 at 22:20
  • $\begingroup$ @jjc385, Yes, exactly. Your propose and its results is ok. $\endgroup$ – Unbelievable Jul 6 '17 at 9:15
3
$\begingroup$

Edit2: This answer only looks at the case where list2 is identical to list1, because that was the only example given in the question. It seems that Coolwater's answer handles multiple lists the way OP would like.

If I understand correctly, you first want to group the row indices of like elements of the first list. You can use GroupBy :

Thread[list1 -> Range@Length@list1];
GroupBy[%, First -> Last]

<|{1, 0, 0, 3, 0} -> {1, 2}, {3, 0, 0, 2, 0} -> {3, 8}, {3, 0, 0, 1, 0} -> {4}, {2, 0, 0, 3, 0} -> {5}, {3, 0, 0, 3, 0} -> {6, 7}|>

Then you can generate all combinations of matrix indices from each group:

Tuples[#, 2] & /@ %

<|{1, 0, 0, 3, 0} -> {{1, 1}, {1, 2}, {2, 1}, {2, 2}}, {3, 0, 0, 2, 0} -> {{3, 3}, {3, 8}, {8, 3}, {8, 8}}, {3, 0, 0, 1, 0} -> {{4, 4}}, {2, 0, 0, 3, 0} -> {{5, 5}}, {3, 0, 0, 3, 0} -> {{6, 6}, {6, 7}, {7, 6}, {7, 7}}|>

Finally you can perform the sum over the specified matrix elements:

Sum[Extract[matrix, inds], {inds, #}] & /@ %

<|{1, 0, 0, 3, 0} -> 27, {3, 0, 0, 2, 0} -> 30, {3, 0, 0, 1, 0} -> 6, {2, 0, 0, 3, 0} -> 8, {3, 0, 0, 3, 0} -> 32|>

Values@%

{27, 30, 6, 8, 32}

This agrees with your expected result:

 Array[ desired, 5 ]

{27, 30, 6, 8, 32}

All together, for easier copying:

Thread[list1 -> Range@Length@list1];
GroupBy[%, First -> Last]
Tuples[#, 2] & /@ %
Sum[Extract[matrix, inds], {inds, #}] & /@ %
Values@%

Edit: Coolwater's answer below taught me about PositionIndex, which much more compactly gives exactly the same output as the first two lines of my code. So my code can be replaced with:

PositionIndex[list1]
Tuples[#, 2] & /@ %
Sum[Extract[matrix, inds], {inds, #}] & /@ %
Values@%
|improve this answer
$\endgroup$
  • $\begingroup$ THANK YOU SO MUCH FOR YOUR ANSWER AND EXPLANATION $\endgroup$ – Unbelievable Jul 5 '17 at 21:44
  • $\begingroup$ I think the final sort of your results is better. However the @Coolwater's answer is very professional and compacted. $\endgroup$ – Unbelievable Jul 6 '17 at 13:39
  • $\begingroup$ How the Tuples[#, 2] & /@ recognizes that it must applied on {1, 2} or {3,8} and not {1, 0, 0, 3, 0} and so on. You Map Tuples on the result of the previous procedure. but this procedure does not have just {1, 2} or {3,8}. It contains {1, 0, 0, 3, 0} and so on. My problem is how program know that where it must be apply!!!!! $\endgroup$ – Unbelievable Jul 6 '17 at 14:00
  • $\begingroup$ @Irreversible Map (/@) has special behavior on Associations. The keys (in this case, the 5-element lists from list1) are ignored -- they are only labels -- and the specified function (in this case, Tuples[#, 2] & /@) is only mapped to the values. If you don't like having the keys, you can apply Values@% (which gets rid of the keys) before applying Tuples, rather than at the end. $\endgroup$ – jjc385 Jul 6 '17 at 14:22
  • $\begingroup$ Yes you are right. PositionIndex[list1][[1]]={1,2} $\endgroup$ – Unbelievable Jul 6 '17 at 15:10
3
$\begingroup$ 
Total[Extract[matrix, {##}] & @@@ MapThread[Tuples@*List,
        Lookup[{##}, Union[Keys[#], Keys[#2]], {}]], {2}] &[
                   PositionIndex[list1], PositionIndex[list2]]

{27, 8, 6, 30, 32}

If you only need the sum of them replace the last List by {1, 2}

|improve this answer
$\endgroup$
  • $\begingroup$ I am trying to understand steps of your procedures. Specially I am not familiar to some commands you used. but it seems amazing. $\endgroup$ – Unbelievable Jul 5 '17 at 21:42
  • $\begingroup$ Even if it did take some work to understand your answer, I think you understood OP's request better than I did. +1, especially for showing me PositionIndex and Lookup. $\endgroup$ – jjc385 Jul 5 '17 at 22:39
  • 1
    $\begingroup$ Also, perhaps DeleteDuplicates@Join would put the results in a more natural order than Union, though admittedly the desired order is somewhat ill-defined for unequal lists. $\endgroup$ – jjc385 Jul 5 '17 at 22:41

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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