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 want to implement the following algorithm in Mathematica.

  1. Get element along main diagonal of a matrix.

  2. If the element along the main diagonal is positive, then return the positions of the elements in the corresponding column that are negative.

    If the element along the main diagonal is negative, then return the positions of the elements in the corresponding column that are positive. The positions returned are the positions in the table.

    If neither of the two conditions above are true, do nothing.

Here is example of what I want

Given the matrix

{{1, 1, 1}, {2, -2, 2}, {-3, 3, 3}}

the algorithm should produce

{{3, 1}, {1, 2}, {3, 2}}

In the above, the first element of each pair is the row of an off-diagonal element, the second element of the pair is its column)

I'm currently trying to do this with a For-loop, but I can't get it to work. Besides, because Mathematica is so good with lists, I'm sure that a functional solution is possible.

share|improve this question
    
It should be done column by column or non sorted answer is ok too? :) Anyway, you can SortBy[.., #[[2]]&] my result if you want. –  Kuba Apr 28 at 21:49

3 Answers 3

up vote 5 down vote accepted

You can do something like:

m = {{1, 1, 1}, {2, -2, 2}, {-3, 3, 3}};
d = Sign@Diagonal@m
Position[(m\[Transpose] d)\[Transpose], _?Negative]
{{1, 2}, {3, 1}, {3, 2}}

Which looks way better in MMA:

enter image description here

share|improve this answer
    
Unless I'm misinterpreting the OP, "corresponding col" means the absolute value of the diagonal (matches OP example), where results w/b {{1, 3}, {2, 1}, {2, 3}, {3, 1}}. Perhaps OP can clarify. If it's just the same col, this is so trivial s/b closed... –  rasher Apr 28 at 22:05
    
@Kuba I have tested and I agree. What you wrote looks correct. Since -1 is in position (1,1), then the only positive value in the column is in position (2,1). So it makes sense. –  olliepower Apr 28 at 22:06
1  
@rasher I'm not sure why you find it basic. To be honest I consider my answer quite neat :p –  Kuba Apr 28 at 22:08
1  
@olliepower: No, no, I'm most certainly NOT singling you out. That would be pretty uncool in general, and you've asked some quite interesting questions. I meant in general, over the past few months (probably Rasberry Pi related) there seems to be a influx of "hey, do my work/search the docs for me" questions. Sorry if you thought I was poking you, not intended. –  rasher Apr 28 at 22:31
1  
@rasher but this is a good sign actually. The more questions asked, it means M (opps, I mean Wolfram) language is getting popular! Which is a good thing (tm). If you check that other language (starts with M and ends up with B), almost all the question are along the line: "do it for me". So, this is a good sign if this starts to happen here too. (ps. nothing to do with this question, this was a nice question actually) –  Nasser Apr 28 at 23:01

I can't beat the elegance of Kuba's clean method so I'll focus on performance.

  • Although it has little effect on performance it is worth noting that Sign is extraneous.
  • Position is a general function that is quite slow compared to purely numeric methods.

I use SparseArray Properties to quickly find all non-background elements in a numeric array:

fn = SparseArray[
       UnitStep[(#\[Transpose] Diagonal[#])\[Transpose]],
       Automatic, 1
     ]["NonzeroPositions"] &;

This is well over an order of magnitude faster than Position on packed data:

m = RandomInteger[{-9, 9}, {2000, 2000}];

First @ Timing[r1 = Position[(m\[Transpose] (Sign@Diagonal@m))\[Transpose], _?Negative]]

First @ Timing[r2 = fn[m]]

r1 === r2
1.591

0.063

True
share|improve this answer
    
nice solution. May be one should use SparseArray for more things if they are faster for packed data. –  Nasser Apr 29 at 3:36

Nothing close as nice as Kuba solution.

Clear[x, n, p, mat];
mat = {{1, 1, 1}, {2, -2, 2}, {-3, 3, 3}}

r = MapIndexed[Function[{x, n},
    Which[x < 0,
     p = Position[mat[[All, First@n]], x_ /; x > 0]; p = DeleteCases[p, n]; 
      (Append[#, First@n] & /@ p),

     x > 0, p = Position[mat[[All, First@n]], x_ /; x < 0]; p = DeleteCases[p, n]; 
      (Append[#, First@n] & /@ p)]]
   , Diagonal[mat]];

Flatten[r, 1]

(* {{3, 1}, {1, 2}, {3, 2}} *)

for

mat = {{-1, -1, 1}, {2, -2, 2}, {-3, 3, 3}};

Mathematica graphics

(*{{2, 1}, {3, 2}}*)

for

 mat = {{-1, -1, 1, 0}, {2, -2, 2, 5}, {-3, 3, 3, 4}, {2, 2, 2, 2}};

Mathematica graphics

 {{2, 1}, {4, 1}, {3, 2}, {4, 2}}
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.