4
$\begingroup$

I have a matrix A and want the matrix consisting of the first n rows of A, having the same rank as A, where n is minimal.

More generally, I want the shortest "start piece" of a list, such that some criterion on the start piece gives True.

For the more general problem, I wrote myTake below, but I'm very dissatisfied with the procedural nature of my implementation.

myTake[list_, crit_] := Catch[
    Do[With[{candidate = list[[Range[i]]]}, 
        If[crit[candidate], Throw[candidate]]]
    , {i, Length[list]}]; 
"fail"
];
firstFullRank[matrix_] := With[{fullRank = MatrixRank[matrix]}, 
    myTake[matrix, MatrixRank[#] == fullRank &]
];
firstFullRank[{{1,0,0},{0,1,0},{2,3,0},{1,2,3},{9,8,7}}]

(gives {{1, 0, 0}, {0, 1, 0}, {2, 3, 0}, {1, 2, 3}})

In short, I'm looking for a fast and functional one liner implementation of myTake and/or firstFullRank

Edit

Please assume that the matrix has lots of rows (> 1000) and not many columns (<10), and that the result has significantly fewer rows than the full matrix. Is there a way to do this functionally without using Range[Length[matrix]] or (even worse) a table of all start pieces.

Improve this question
$\endgroup$
8
  • 1
    $\begingroup$ You've seen TakeWhile[]? $\endgroup$
    – J. M.'s missing motivation ♦
    Commented Nov 25, 2012 at 13:37
  • 1
    $\begingroup$ @J.M. TakeWhile by itself is not quite what is being asked, since the criteria must be applied to the taken list as a whole, not individual elements. $\endgroup$
    – Leonid Shifrin
    Commented Nov 25, 2012 at 13:38
  • $\begingroup$ The question should probably be split into 2 questions. [1] make myTake more functional [2] efficient implementation of firstFullRank. (using myTake for firstFullRank is not efficient.) $\endgroup$
    – mathheadinclouds
    Commented Nov 25, 2012 at 14:06
  • 2
    $\begingroup$ Forget functional one liner unless this is for a beauty contest. Compute the rank r, then use a divide-and-conquer approach to narrow down to the minimal number of rows. Start at r, double until rank of submatrix equals r (or you have surpassed half the size). Then go either upwards or downwards halfway from present to prior upper/lower value, depending on whether rank of present is less than or equal to r respectively. $\endgroup$
    – Daniel Lichtblau
    Commented Nov 25, 2012 at 20:17
  • $\begingroup$ Kguler's method, which modifies based on assessed rank deficiency, is also likely to be an effective approach in practice. $\endgroup$
    – Daniel Lichtblau
    Commented Nov 25, 2012 at 20:20

4 Answers 4

Reset to default
4
$\begingroup$ 
frstFllRnk = Module[{r = MatrixRank[#], k},  k = r; 
     While[MatrixRank[#[[;; k]]] < r, k++]; #[[;; k]]] &

frstFllRnk2 = Module[{r = MatrixRank[#], k, d},  k = r; 
   While[(d = r - MatrixRank[#[[;; k]]]) > 0, k += d]; #[[;; k]]] &
Improve this answer
$\endgroup$
2
$\begingroup$

This looks like a start:

firstFullRank[mat_?MatrixQ] := Module[{r = MatrixRank[mat]}, 
                               NestWhile[Most, mat, MatrixRank[#] == r &, 1, Infinity, -1]]
Improve this answer
$\endgroup$
6
  • 1
    $\begingroup$ This may be OK for smaller matrices, but due to copying a list at every step, has generally the quadratic complexity in the matrix size (or list size in general). This problem is unavoidable in the OP's formulation though, since the crit function demands partial lists at every step, so +1. $\endgroup$
    – Leonid Shifrin
    Commented Nov 25, 2012 at 13:53
  • $\begingroup$ @Leonid, also, the algorithm for MatrixRank[] has cubic complexity, so... $\endgroup$
    – J. M.'s missing motivation ♦
    Commented Nov 25, 2012 at 13:57
  • $\begingroup$ I certainly agree. My comment was rather aimed at the OP's general request for the better myTake function, which can be sort of read off from your code. $\endgroup$
    – Leonid Shifrin
    Commented Nov 25, 2012 at 14:20
  • $\begingroup$ this solution works backwards, starting with the full matrix, and dropping rows from the back one by one. $\endgroup$
    – mathheadinclouds
    Commented Nov 25, 2012 at 14:36
  • $\begingroup$ @mathheadinclouds, indeed. Is there any reason why proceeding backwards is not to your taste? $\endgroup$
    – J. M.'s missing motivation ♦
    Commented Nov 25, 2012 at 14:58
1
$\begingroup$ 
a = RandomInteger[{0, 3}, {10, 3}]

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

b = First@Select[Take[a, #] & /@ Range[Length[a]], MatrixRank[#] == MatrixRank[a] &, 1]

{{1, 0, 1}, {1, 0, 0}, {0, 2, 2}}

MatrixRank[b]

3

MatrixRank@a

3

The answer to the general problem can be written as:

ClearAll[firstSameRank];
firstSameRank[mat_?MatrixQ, crit_Function] := 
      First@Select[Take[mat, #] & /@ Range[Length[mat]], crit, 1]

or, with an optimization pointed out by RM:

ClearAll[firstSameRank];
firstSameRank[mat_?MatrixQ, crit_Function] :=
 With[{k = MatrixRank[mat]}, First@Select[Take[mat, #] & /@ Range[k, Length@mat], crit, 1]]

A call:

firstSameRank[a, MatrixRank[#] == MatrixRank[a] &]
Improve this answer
$\endgroup$
1
  • $\begingroup$ @J.M. I'll note that for a = RandomInteger[{0, 100}, {2000, 10}]; this is about 30 times faster than your solution ;-) $\endgroup$
    – Sjoerd C. de Vries
    Commented Nov 25, 2012 at 14:23
0
$\begingroup$

My apologies for not splitting this into two questions: Doing this with a one liner and doing it efficiently are really two different things, especially if there are lots of linearly dependent rows (which is the case in my application.)

A nice way to rewrite myTake (inspired by Sjoerd) is this

myTake[li_, crit_] := With[{
    index = Select[Range[Length[li]], crit[li[[Range[#]]]] &, 1][[1]]
}, li[[Range[index]]]];

It should be more efficient than Sjoerd's solution, because it avoids making a table of all the start pieces. Avoiding usage of Range[..] altogether seems impossible unless one wants to resort to Do or ++ or throw (correct?)

As for the solving the more special problem efficiently, in case that the matrix has lots of linearly dependent rows, one can avoid ever calling MatrixRank on matrices with more than rank rows by accumulating only those rows that increase the rank, like so:

firstRank[mat_, rank_] := Catch[Module[{step, n = Length[mat]},
    step[idx_] := Module[{r, last},
        last = Last[idx];
        r = MatrixRank[mat[[idx]]];
        If[r == rank, Throw[mat[[Range[last]]]]];
        If[r == Length[idx], 
            Do[step[Append[idx, i]], {i, last + 1, n - rank + r + 1}]
        ]
    ];
    Do[step[{i}], {i, n - rank + 1}];
    "fail"
]];
firstFullRank[mat_] := firstRank[mat, MatrixRank[mat]]
Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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