11
$\begingroup$

I have a matrix of characters that I wish to convert to a matrix of 0' s and 1' s. Although the matrix is large[17, 4301], I subsample this for purposes of my question. The matrix is:

 m = {{"T", "T", "A", "A", "G", "G", "C", "C", "C", "C"}, {"T", "T", 
"A", "A", "G", "A", "T", "C", "C", "C"}, {"T", "T", "A", "A", "G",
 "G", "C", "C", "C", "C"}, {"T", "T", "A", "A", "G", "A", "C", 
"C", "T", "C"}, {"T", "T", "A", "A", "G", "A", "C", "C", "C", 
"C"}, {"T", "T", "A", "A", "G", "A", "T", "C", "C", "C"}, {"T", 
"T", "A", "A", "G", "A", "T", "C", "C", "C"}, {"T", "T", "A", "A",
 "G", "G", "C", "C", "C", "C"}, {"T", "T", "A", "A", "G", "G", 
"C", "C", "C", "C"}, {"T", "T", "A", "A", "G", "G", "C", "C", "C",
 "C"}, {"T", "T", "A", "A", "G", "G", "C", "C", "C", "C"}, {"T", 
"T", "A", "A", "G", "A", "T", "C", "C", "C"}, {"C", "T", "A", "A",
 "G", "G", "C", "C", "C", "C"}, {"C", "T", "A", "A", "G", "G", 
"C", "C", "C", "C"}, {"T", "T", "T", "A", "G", "G", "C", "C", "C",
 "A"}, {"T", "A", "A", "G", "A", "G", "C", "T", "C", "A"}, {"T", 
"T", "A", "A", "G", "G", "C", "C", "T", "A"}};

 Dimensions[m]

 {17, 10}

If we look at the columns of matrix m, we observe that there are always just two different letters in each column.

 m2 = Table[Tally[m[[All, i]]], {i, 1, Last[Dimensions[m]]}]

 {{{"T", 15}, {"C", 2}}, {{"T", 16}, {"A", 1}}, {{"A", 16}, {"T", 
 1}}, {{"A", 16}, {"G", 1}}, {{"G", 16}, {"A", 1}}, {{"G", 
 11}, {"A", 6}}, {{"C", 13}, {"T", 4}}, {{"C", 16}, {"T", 
 1}}, {{"C", 15}, {"T", 2}}, {{"C", 14}, {"A", 3}}}

How can I convert matrix m so that for each column the letter that has more entries is converted to a 0 (zero) and the letter with the fewer entries in that column is converted to a 1?

That is for say m[[All,1]], all entries but m[[1,13]] and m[[1,14]] would be 0 (zero), whereas m[[1,13]] and m[[1,14]] would both be converted to 1 (one). Similarly, m[[2,16]] would be converted to a 1, while all other entries (rows) in column m[[All,2]] would be converted to a zero.

Although the number of rows for this particular example is odd, so there can not be a tie, should the matrix have an even number of rows ties are resolved by arbitrarily converting first letter to appear in a column to a zero and the other letter to a one.

Seems as if there should be a simple answer, but it is eluding me. Any help would be appreciated. Thanks.

$\endgroup$
  • $\begingroup$ Try Transpose[(# /.Thread[SortBy[Tally[#], Last][[All, 1]] -> {1, 0}]) & /@ Transpose[m]]. $\endgroup$ – J. M.'s discontentment Oct 24 '17 at 2:42
6
$\begingroup$
{nRow,nCol}=Dimensions[m];
com = Flatten@Commonest[m] ;
Table[ m[[i,j]] = If[m[[i,j]]==com[[j]], 0, 1] , {i,nRow},{j,nCol}];

And now

MatrixForm[m]

Mathematica graphics

ps. Thanks to JM hint, it is also possible to shorten this more by using Boole instead of the If above

Table[ Boole[ m[[i,j]] != com[[j]] ] , {i,nRow},{j,nCol} ];
| improve this answer | |
$\endgroup$
  • 3
    $\begingroup$ Table[Boole[m[[i, j]] != com[[j]]], {i, nRow}, {j, nCol}] also works. $\endgroup$ – J. M.'s discontentment Oct 24 '17 at 4:50
  • $\begingroup$ @J.M. nice. Boole is something have not used myself for long time. In Mathematica, there is always at least 10 ways to do the same thing :) $\endgroup$ – Nasser Oct 24 '17 at 4:57
8
$\begingroup$
ClearAll[f0, f1, f2]

f0 = ArrayComponents[{#, First@Commonest@#}, 3, {x_, y_} :> Unitize[x /. y -> 0]] &

enter image description here

f0 @ m // MatrixForm // TeXForm

$\left( \begin{array}{cccccccccc} 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 & 0 & 1 & 1 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 & 0 & 1 & 0 & 0 & 1 & 0 \\ 0 & 0 & 0 & 0 & 0 & 1 & 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 & 0 & 1 & 1 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 & 0 & 1 & 1 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 & 0 & 1 & 1 & 0 & 0 & 0 \\ 1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 \\ 1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 \\ 0 & 0 & 1 & 0 & 0 & 0 & 0 & 0 & 0 & 1 \\ 0 & 1 & 0 & 1 & 1 & 0 & 0 & 1 & 0 & 1 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & 1 \\ \end{array} \right)$

Also:

f1 = Transpose[Replace[#, {Commonest[#, 1][[1]] -> 0, _ :> 1}, {1}] & /@ Transpose[#]] &;

f2 = Transpose[Unitize[# - Commonest[#][[1]]] & /@ ArrayComponents[Transpose @ # ]] &;

f0 @ m == f1 @ m == f2 @ m

True

| improve this answer | |
$\endgroup$
  • $\begingroup$ Thank you all. This approach is the fastest of the several methods presented, being nearly twice as fast as the others. However, it is the most difficult to understand, with that presented in solution #4 being easiest (for me at least, as I too don't understand the _ :> 1 construction here). $\endgroup$ – Stuart Poss Oct 24 '17 at 16:53
  • $\begingroup$ @Stuart, kglr is using it within a Replace[], so you read {Commonest[#, 1][[1]] -> 0, _ :> 1} as "replace the Commonest[] entry in that column with 0, and everything else with 1" $\endgroup$ – J. M.'s discontentment Oct 24 '17 at 22:36
  • $\begingroup$ @Stuart, to elaborate on J.M's comment, Blank (_) stands for any Mathematica expression. When a list of rules is used for replacement in Replace, the rules are tried in order, and the result of the first one that applies is returned. ... $\endgroup$ – kglr Oct 24 '17 at 22:51
  • $\begingroup$ ... So, when the first rule Commonest[#, 1][[1]] -> 0 applies to an element that element is replaced with 1, if it doesn't, the second rule (_:>1) is applied and this rule replaces any element with 1. (See Replace >> Details and Options) $\endgroup$ – kglr Oct 24 '17 at 22:51
5
$\begingroup$

(Turns out @kglr beat me to it with a nicer implementation of the same idea. I'll leave this up for the time being, as it might help us simple folk understand what all the _ :> 1 stuff is about.)

Get your replacement rules for each column:

rr = {#[[1]] -> 0, #[[2]] -> 1} & /@ (Commonest[#, 2] & /@ Transpose[m])

{{"T" -> 0, "C" -> 1}, {"T" -> 0, "A" -> 1}, {"A" -> 0, "T" -> 1}, {"A" -> 0, "G" -> 1}, {"G" -> 0, "A" -> 1}, {"G" -> 0, "A" -> 1}, {"C" -> 0, "T" -> 1}, {"C" -> 0, "T" -> 1}, {"C" -> 0, "T" -> 1}, {"C" -> 0, "A" -> 1}}

Apply them:

Transpose @ MapThread[ReplaceAll, {Transpose[m], rr}] // MatrixForm

enter image description here

| improve this answer | |
$\endgroup$
5
$\begingroup$

I propose the following method

Inner[Boole@*Unequal, m, First@Commonest[m], List] // MatrixForm

enter image description here

The inner part (Boole@*Unequal) was inspired by J.M. comment.

| improve this answer | |
$\endgroup$
4
$\begingroup$

Here's a method that generates a SparseArray[]:

SparseArray[Thread[Flatten[
            MapIndexed[Function[{c, i},
                                Map[Join[#, i] &,
                                    Position[c, x_ /; x =!= First[Commonest[c]], {1},
                                             Heads -> False]]],
                       Transpose[m]], 1] -> 1]]

Here is another possibility:

SparseArray[Thread[Flatten[MapIndexed[PadRight[
            Map[First, Most[ArrayRules[
                SparseArray[#, Automatic, First[Commonest[#]]]]]], 
            {Automatic, 2}, #2] &, 
            Transpose[m]], 1] -> 1], Dimensions[m]]

Use Normal[] if you want a list instead.

| improve this answer | |
$\endgroup$
2
$\begingroup$
regole = 
  {First @ First @ Tally @ m[[All, #]] -> 0, 
   First @ Last @ Tally@m[[All, #]] -> 1 } &/@ Range[Dimensions[m][[2]]]

MapIndexed[m[[All, #]] /. regole[[#2]] &, Range[10]]
| 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.