# clean functional way to get first n rows that yield maximum rank

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.

-
You've seen TakeWhile[]? – J. M. Nov 25 '12 at 13:37
@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. – Leonid Shifrin Nov 25 '12 at 13:38
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.) – mathheadinclouds Nov 25 '12 at 14:06
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. – Daniel Lichtblau Nov 25 '12 at 20:17
Kguler's method, which modifies based on assessed rank deficiency, is also likely to be an effective approach in practice. – Daniel Lichtblau Nov 25 '12 at 20:20

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]]] &

-

This looks like a start:

firstFullRank[mat_?MatrixQ] := Module[{r = MatrixRank[mat]},
NestWhile[Most, mat, MatrixRank[#] == r &, 1, Infinity, -1]]

-
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. – Leonid Shifrin Nov 25 '12 at 13:53
@Leonid, also, the algorithm for MatrixRank[] has cubic complexity, so... – J. M. Nov 25 '12 at 13:57
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. – Leonid Shifrin Nov 25 '12 at 14:20
this solution works backwards, starting with the full matrix, and dropping rows from the back one by one. – mathheadinclouds Nov 25 '12 at 14:36
@mathheadinclouds, indeed. Is there any reason why proceeding backwards is not to your taste? – J. M. Nov 25 '12 at 14:58
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] &]

-
@J.M. I'll note that for a = RandomInteger[{0, 100}, {2000, 10}]; this is about 30 times faster than your solution ;-) – Sjoerd C. de Vries Nov 25 '12 at 14:23

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]]

-