4
$\begingroup$

I have a matrix that I wish to delete columns from but for which I would like to retain the original column numbers. To keep track of the original columns numbers I create a new matrix of rules that give the {row,col} position in the original matrix to which I assign a value (either "A","G","C","T","-") depending on its value in the original matrix. I do not know beforehand which columns need to be deleted, nor which of these 5 values will appear at any position of the matrix, but I do know the criteria which determine whether or not a column of the matrix should be deleted.

Thus, using a subsample of the matrix as an example I have originally a matrix m, (all elements stored as single characters [with enclosing "" not shown]).

 m = {{G,T,T,A,A,C,G,A,C,-},
      {G,T,T,A,G,C,G,T,C,-},
      {C,A,A,T,T,C,G,T,C,G},
      {T,A,A,T,T,C,G,T,C,A},
      {C,A,T,A,C,C,C,G,A,A},
      {-,A,T,A,C,C,G,G,A,A}}

I then convert these entries into a matrix of rules, the keys being the {row,col} position in original matrix and the values are those values assigned to these positions. I do this by using the following commands:

 {row,col} = Dimensions[m]
 m2 = ArrayRules[m];
 m3 = Partition[m2,col];

at any element of m3 we have a two element list as a key and the original value at that position as a value. Thus, for a given position say 6th row, fist column the rule defined at m[[6,1]] would be {6,1}-> "-", whereas that of the 8th row 10th column would be {8,10}-> "A". This permits one to extract either the key (row,col} pairs or the value, its assigned value. The col value would then be used to label the columns in the new submatrix, when representing the matrix in as a grid.

Now, I wish to delete columns of this new matrix based on several criteria, yet still retain the original column number in matrix m.

Criteria 1: Delete any column that contains one or more "-" as a value.

Criteria 2: Having deleted the columns containing "-" values, delete any of the remaining columns that either have 3 or 4 distinct values (leaving columns with only two distinct values, neither of which is a "-".

Criteria 3: Delete any columns in the original matrix for which all row entries are the same.

Criteria 4: Delete any column with two values but one is a singleton (ie represented only once in the column).

Thus, for the matrix m above, the new matrix would delete columns 1 and 10 (because they contain a "-" (col 1) or more than one "-" (col 10). Column 5 is deleted as it has 4 different values (A,G,T,C). Column 6 is deleted because all elements have the value "C". Column 7 is deleted because although it contains 2 values only, one of them is expressed as a singleton (all "G" or "C", but only 1 "C"). No singletons are allowed. Column 8 is deleted because it has 3 different values ("A","T","G") Cols 2, 3, 4, 9 are retained as they each contain just exactly 2 distinct elements (neither singletons) to become the four columns of the resultant matrix. A peek at the key for any element gives the original column number as the second element of an ordered pair forming the key.

Thus, the values for the new resultant matrix say m4 would again be rules, whose keys are as before {row, col} (original) and the new/same values as follows (again showing only the values of the key->value pair without the enclosing ""):

 m4 = {{T,T,A,C},
       {T,T,A,C},
       {A,A,T,C},
       {A,A,T,C},
       {A,T,A,A},   
       {A,T,A,A}} 

Thus, each column of the new matrix is formed from those columns of the original matrix satisfying the four criteria above (all have entries with only two different characters, neither a "-" and neither represented as a singleton.

The original column numbers would then be obtained from the second element of the ordered pair {row col} specified by Keys. These would be displayed vertically (above or below) for each column and used to refer to original column numbers as column labels and not the new column numbers generated by the resultant matrix.

Retaining the original column numbers is critical because they represent the original column positions in the original matrix, information that would be lost looking solely at the column numbers in the resultant submatrix.

Is there a way to structure a set of DeleteCases commands to do this?

I have syntax problems for my DeleteCases corresponding to each of the criteria that I haven't been able to code my way past.

Most examples in other posts and those that I can find elsewhere require one to know which columns are to be deleted beforehand, which is not possible here. Likewise, I can find no other code that will permit the original column numbers (labels/positions) to be retained for labeling in a grid. Hence, my storing this information as part of the key in the key->value pair for each element (row,col position) of the original matrix.

I would be interested in any other approaches to this problem that would be the quickest, as the original matrices are large (rows = hundreds x col = thousands) and hence many deletions would be necessary for subsequent analysis to begin. Any help would be much appreciated.

$\endgroup$
3
$\begingroup$
m = {{"G", "T", "T", "A", "A", "C", "G", "A", "C", "-"},
    {"G", "T", "T", "A", "G", "C", "G", "T", "C", "-"},
    {"C", "A", "A", "T", "T",  "C", "G", "T", "C", "G"},
    {"T", "A", "A", "T", "T", "C", "G", "T", "C", "A"}, 
    {"C", "A", "T", "A", "C", "C", "C", "G", "A",  "A"}, 
    {"-", "A", "T", "A", "C", "C", "G", "G", "A", "A"}};

mindexed = MapIndexed[#2 -> # &, m, {2}]

enter image description here

criterion1 = FreeQ[{"-", _}] @* Tally @* Values;
criterion23 = Not@*(MemberQ[{1, 3, 4}, #] &) @* Length @* Tally @* Values;
criterion4 = (Or[Length@# != 2, FreeQ[{_, 1}]@#] &) @* Tally @* Values;

result = Fold[Select[#2]@# &, Transpose[mindexed], {criterion1, criterion23, criterion4}]


MatrixForm @ Transpose @ result

enter image description here

MatrixForm @ Transpose @ Values @ result

enter image description here

MatrixForm[Transpose@Keys@result, TableDirections -> {Column, Row, Row}]

enter image description here

Grid[Transpose[result] /. Rule -> (Column[{#2, #}, Alignment -> Center] &), 
  Dividers -> All]

enter image description here

You can use Cases or DeleteCases instead of Select:

result2 = Fold[Cases[_?#2]@# &, 
   Transpose[mindexed], {criterion1, criterion23, criterion4}];

result3 = Fold[DeleteCases[Except[_?#2]]@# &, 
   Transpose[mindexed], {criterion1, criterion23, criterion4}];

result == result2 == result3
 True
| improve this answer | |
$\endgroup$
  • $\begingroup$ I was thinking more along the lines of: columnlabels = Flatten[Last[ Flatten[Partition[Last[Transpose[Keys@result]], Length[Last[Transpose[Keys@result]]]], {3}]]]; newcolumnlabels = Rotate[StringTake["00000" <> ToString[#], -5], [Pi]/2] & /@ columnlabels; Grid[Join[{newcolumnlabels}, Map[Column[#, Alignment -> Center] & /@ Transpose[{Values@#}] &]@ Transpose@result], Dividers -> All] but what you write also works, thanks. $\endgroup$ – Stuart Poss May 5 at 20:34
  • 1
    $\begingroup$ I selected this answer for 2 reasons. 1) timing not much different between several answers so timing differences inconsequential for my purpose, 2) I learned quite a bit about symbolic computation and composition of functions by studying this answer. Thanks to all for help and education. $\endgroup$ – Stuart Poss May 5 at 20:44
5
$\begingroup$

This can be done in stages. It's easier to delete rows rather than columns, so we will temporarily work with the transpose:

arr = Transpose[{{"G", "T", "T", "A", "A", "C", "G", "A", "C", "-"},
                 {"G", "T", "T", "A", "G", "C", "G", "T", "C", "-"},
                 {"C", "A", "A", "T", "T", "C", "G", "T", "C", "G"},
                 {"T", "A", "A", "T", "T", "C", "G", "T", "C", "A"},
                 {"C", "A", "T", "A", "C", "C", "C", "G", "A", "A"},
                 {"-", "A", "T", "A", "C", "C", "G", "G", "A", "A"}}];

Apply the first criterion:

a1 = DeleteCases[arr, v_ /; MemberQ[v, "-"]]
   {{"T", "T", "A", "A", "A", "A"},
    {"T", "T", "A", "A", "T", "T"},
    {"A", "A", "T", "T", "A", "A"},
    {"A", "G", "T", "T", "C", "C"},
    {"C", "C", "C", "C", "C", "C"},
    {"G", "G", "G", "G", "C", "G"},
    {"A", "T", "T", "T", "G", "G"},
    {"C", "C", "C", "C", "A", "A"}}

The second and third criteria can be applied simultaneously:

a2 = DeleteCases[a1, v_ /; Length[Union[v]] != 2]
   {{"T", "T", "A", "A", "A", "A"},
    {"T", "T", "A", "A", "T", "T"},
    {"A", "A", "T", "T", "A", "A"},
    {"G", "G", "G", "G", "C", "G"},
    {"C", "C", "C", "C", "A", "A"}}

Finally, apply the last criterion:

a3 = DeleteCases[a2, v_ /; MemberQ[Tally[v][[All, -1]], 1]]
   {{"T", "T", "A", "A", "A", "A"},
    {"T", "T", "A", "A", "T", "T"},
    {"A", "A", "T", "T", "A", "A"},
    {"C", "C", "C", "C", "A", "A"}}

and transpose back to the desired format:

Transpose[a3]
   {{"T", "T", "A", "C"},
    {"T", "T", "A", "C"},
    {"A", "A", "T", "C"},
    {"A", "A", "T", "C"},
    {"A", "T", "A", "A"},
    {"A", "T", "A", "A"}}

In fact, all the criteria can be brought together in a single DeleteCases[] call:

Transpose[DeleteCases[arr, v_ /;
                      (MemberQ[v, "-"] || Length[Union[v]] != 2 ||
                       MemberQ[Tally[v][[All, -1]], 1])]]

(I really wish you hadn't deleted the quote marks in your original post; putting them back in for writing this answer was annoying.)


If, like in kglr's answer, you also want to track column indices, this can be done with minimal changes to the code above, where we exploit the fact that DeleteCases[] also works on associations:

assoc = AssociationThread[Range[Length[arr]], arr];

filt = DeleteCases[assoc, v_ /; (MemberQ[v, "-"] || Length[Union[v]] != 2 || 
                                 MemberQ[Tally[v][[All, -1]], 1])]
   <|2 -> {"T", "T", "A", "A", "A", "A"}, 
     3 -> {"T", "T", "A", "A", "T", "T"}, 
     4 -> {"A", "A", "T", "T", "A", "A"}, 
     9 -> {"C", "C", "C", "C", "A", "A"}|>

The column indices can then be retrieved using Keys[filt], and the array itself can be reconstituted with Transpose[Values[filt]].

| improve this answer | |
$\endgroup$
  • $\begingroup$ Sorry about that. One can easily get the quotes by simply postfixing on //InputForm to the original expression $\endgroup$ – Stuart Poss May 5 at 6:48
  • 1
    $\begingroup$ @Stuart No, not once you removed them. We only have the code you posted, not your original expression. Try it, with the code you posted... $\endgroup$ – MarcoB May 5 at 14:16
  • $\begingroup$ You are right. I guess it worked for me because I did it within the notebook for which the character strings were already defined. $\endgroup$ – Stuart Poss May 5 at 18:19
  • $\begingroup$ Copying and Pasting your expressions one after another. Definition of a1 works fine. def of a3 throws a warning for Union, which can be made to go away by wrapping v in Tally[v] with a list Tally[{v}]. Likewise, def of a3 generates a warning at Tally and for Part, but gives result. Transpose[a3} likewise using ver. 12.1; Putting them all together in one line does not give the answer, but generates errors: "Union: nonattomic expression expected at position 1 in Union[0.]." and "Transpose: First two levels of {} can not be transposed. Not sure why this occurs. $\endgroup$ – Stuart Poss May 5 at 19:22
  • $\begingroup$ @Stuart The code here assumes the contents of the list are only "A", "T", "C", "G", and "-". Perhaps your actual matrix has something else in it. That you got a Union: nonatomic expression expected at position 1 in Union[0.]. error would indicate you had something else. $\endgroup$ – J. M.'s technical difficulties May 6 at 0:50
3
$\begingroup$

Since you're only deleting and testing columns, my approach here would be to group only by columns (and associating it with their index), and then test those. One way to do that is

MapIndexed[First[#2] -> #1 &, Transpose[m]]

The First is because MapIndexed includes the position via the second argument as a single-element list, e.g. {3}, even if we're working wit ha list of lists.

For ease with pattern-matching and extraction (though I don't know if it actually has any effect on performance), I'm going to get rid of the -> and use just a list.

columns = MapIndexed[{First[#2], #1} &, Transpose[m]]

(You could also use Transpose[{Table[i, {i,1,Length[Transpose[m]]}], Transpose[m]}], or MapThread[List, {Table[i, {i,1,Length[Transpose[m]]}], Transpose[m]}]; I don't know if either of these is faster.)

Then you can DeleteCases easily! (Also, by the way, I'm assuming you're working with strings "A", "-", etc. If not, you can do so with m = Map[ToString, m, {2}].)

Method 1 (DeleteCases)

columns = DeleteCases[columns, _?(MemberQ[Last[#],"-"] &), 1]
columns = DeleteCases[columns, _?(Length[DeleteDuplicates[Last[#]]]!=2 &), 1]
(*Note that the above takes care of both criteria 2 and 3 at once!*)
columns = DeleteCases[columns, _?(MemberQ[Tally[Last[#]], 1, {2}] &), 1]

Notice, though, that we're doing tests for each pattern. So it might be better to use something which applies tests, such as Select or Pick, especially for large data.

Method 2 (Select)

columns = Select[columns,
    (!MemberQ[Last[#],"-"] && Length[DeleteDuplicates[Last[#]]]==2 && !MemberQ[Tally[Last[#]], 1, {2}]) &]

Note that Mathematica short-circuits &&, so it makes sense to evaluate the "easiest" things first in the && expression.

We could also get rid of that pesky Last everywhere by creating a selector list (one which is True in every position you want to keep, and False elsewhere), and then using Pick. I don't know if that would be better or worse in terms of performance, but it would look like:

Method 3.1 (Pick)

(*The same as the function in Select, but without the Last around every # *)
selector = (!MemberQ[#,"-"] && Length[DeleteDuplicates[#]]==2 && !MemberQ[Tally[#], 1, {2}]) & /@ Transpose[m]
columns = Pick[columns, selector]

It might also make sense to instead use Tally on every list in the first place and just match these tallies to create the selector.

Method 3.2 (Pick, Tally)

selector = MatchQ[{{Except["-"],Except[1]},{Except["-"],Except[1]}}] /@ Tally /@ Transpose[m]
columns = Pick[columns, selector]

It might also instead make sense to get a bunch of indices for which this pattern is matched, and then use Part to extract those indices.

Method 4 (Part, Tally)

indices = Flatten@Position[Tally /@ Transpose[m], {{Except["-"],Except[1]},{Except["-"],Except[1]}}, 1]
columns = Part[columns, indices]

(One could also somehow mark off the ones that contain "-" before Tally and then use the (maybe?) higher performance pattern {{_, Except[1]}, {_, Except[1]}}, but that might be a tiny bit more complicated to construct.)

I don't know which of these will deliver usable performance given the size of your matrix, but hopefully at least one of them will! (I tested them, and they all at least work on your test case.) Let me know if you have any questions, or if the implementation of any of these is unclear! :)

Edit: oops, I see this got similar answers while I was writing this. However, there are still some novelties in this answer, so I'll leave it!

| improve this answer | |
$\endgroup$

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.