# Conversion of Matrix of Characters to a Matrix of Zeros and Ones based on Column Frequency

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.

• Try Transpose[(# /.Thread[SortBy[Tally[#], Last][[All, 1]] -> {1, 0}]) & /@ Transpose[m]]. Oct 24, 2017 at 2:42

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


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

• Table[Boole[m[[i, j]] != com[[j]]], {i, nRow}, {j, nCol}] also works. Oct 24, 2017 at 4:50
• @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 :) Oct 24, 2017 at 4:57
ClearAll[f0, f1, f2]

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


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

• 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). Oct 24, 2017 at 16:53
• @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" Oct 24, 2017 at 22:36
• @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. ...
– kglr
Oct 24, 2017 at 22:51
• ... 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)
– kglr
Oct 24, 2017 at 22:51

(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


I propose the following method

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


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

• Very cute! ${}$ Oct 24, 2017 at 12:57

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},
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.

regole =
{First @ First @ Tally @ m[[All, #]] -> 0,
First @ Last @ Tally@m[[All, #]] -> 1 } &/@ Range[Dimensions[m][[2]]]

MapIndexed[m[[All, #]] /. regole[[#2]] &, Range[10]]