# Efficient binarization of a list

I am generating a list of 1's, 2's, and 3's with different probabilities for each number. I then convert this list into three binarized lists, giving a list of the locations of each digit in the original list. There must be a more efficient way to do this? Perhaps changing the way I make the original list?

list = RandomChoice[{0.5, 0.3, 0.2} -> {1, 2, 3}, 20]
list1 = ReplacePart[ReplacePart[ReplacePart[list, Position[list, 2] -> 0],
Position[list, 3] -> 0], Position[list, 1] -> 1]
list2 = ReplacePart[ReplacePart[ReplacePart[list, Position[list, 1] -> 0],
Position[list, 3] -> 0], Position[list, 2] -> 1]
list3 = ReplacePart[ReplacePart[ReplacePart[list, Position[list, 1] -> 0],
Position[list, 2] -> 0], Position[list, 3] -> 1]

• Most answers assume one needs to generate list as the OP does, but he explicitly asks whether a different method of generation might be faster. I think there is (see below). Commented Feb 7, 2018 at 22:15
• Does "OP" stand for opening paragraph? Commented Feb 7, 2018 at 23:23
• @Michael B. Heaney No, 'original poster' (the person who started the thread) or 'original post'. Commented Feb 8, 2018 at 0:43

This is very fast and avoids an intermediate step of creating 1s, 2s and 3s:

mylist = RandomChoice[{.3, .2, .5} -> {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}}, 300];
Transpose[mylist]


The generation of the list and the result is about twice as fast as the generation of the list and the result in the fastest method described by others here.

As @CarlWolf points out, using a PackedArray speeds things too:

Timing[mylist =
DeveloperPackedArray[
RandomChoice[{.3, .2, .5} -> {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}},
10^8]];
Transpose[mylist];]


{4.04332, Null}

• For optimal efficiency with this method, you should include DeveloperToPackedArray in appropriate places. Otherwise it is far slower than the other packed array methods for large lists. Commented Feb 8, 2018 at 1:01
• Yes... PackedArrays will help... just as they'll help a number of other proposed solutions. Commented Feb 8, 2018 at 1:02
• I'm just pointing out that your statement that your answer is the fastest is not correct for long lists. Commented Feb 8, 2018 at 1:09
• $10,000,000$ samples in 1.5 seconds should be fast enough for anyone, though. Commented Feb 8, 2018 at 1:12
• I'm just surprised that the output of RandomChoice isn't a packed array by default... Commented Feb 8, 2018 at 11:18

Edit:

@CarlWoll brought to my attention that RandomChoice may produce unpacked arrays. This is why I update the timings. Previously, I stated that Carls' solutiuon need ten times as long as the first proposal below. This is not true for PackedArrays. Mea culpa.

list = DeveloperToPackedArray[RandomChoice[{0.5, 0.3, 0.2} -> {1, 2, 3}, 200000]];


Another very efficient possibility is

RepeatedTiming[
list1a = Subtract[1,Unitize[Subtract[list,1]]];
list2a = Subtract[1,Unitize[Subtract[list,2]]];
list3a = Subtract[1,Unitize[Subtract[list,3]]];
][[1]]


0.00069

This is still a bit faster than @Carl's proposal:

RepeatedTiming[
list1b = Unitize@Clip[list, {1, 1}, {0, 0}];
list2b = Unitize@Clip[list, {2, 2}, {0, 0}];
list3b = Unitize@Clip[list, {3, 3}, {0, 0}];
][[1]]


0.00217

Other notable ways to do it:

Using SparseArray (not so efficient):

{list1c,list2c,list3c} = Normal[SparseArray[
Transpose[{list,Range[Length[list]]}]->1,
{3,Length[list]}
]]; // RepeatedTiming // First


0.082

Another nice way is

{list1d, list2d, list3d} = Transpose[IdentityMatrix[3][[list]]]; // RepeatedTiming // First


0.0032

• Your list is unpacked, which is why Clip is slow. Commented Feb 7, 2018 at 21:51
• @CarlWoll I am sorry! I updated the timings in the meantime... Commented Feb 7, 2018 at 22:14
• My timings on OSX with M11.2 are much closer, with the Clip approach becoming faster with larger array sizes (e.g., 10^6 or 10^7). Commented Feb 7, 2018 at 22:40

There are many possibilities, but I like using Clip:

Unitize@Clip[list,{1,1},{0,0}]
Unitize@Clip[list,{2,2},{0,0}]
Unitize@Clip[list,{3,3},{0,0}]


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

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

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

If your lists consist of just integers, than a compiled version is possible, e.g.:

fc = Last @ Compile[{{d, _Integer, 1}, {t,_Integer}},
Table[Boole[CompileGetElement[d, i]==2], {i, Length@d}],
CompilationTarget->"C",
RuntimeOptions->"Speed"
];


Comparison:

lst = DeveloperToPackedArray @ RandomChoice[{.5,.2,.3}->{1,2,3}, 10^7];

r1 = fc[lst, 2]; //RepeatedTiming
r2 = BitXor[1, Unitize @ BitXor[2, lst]]; //RepeatedTiming

r1 === r2


{0.042, Null}

{0.0614, Null}

True

Update: On Wolfram Cloud, the timing comparison I get is the opposite of David's claim that "the result is about twice as fast as the generation of the list and the result in the fastest method described by others here"; that is, to my surprise, BitXor-based method is more than 2x faster than David's method. Using RandomVariate+ EmpiricalDistribution + WeightedData combination instead of RandomChoice improves the timings. Using IdentityMatrix[3] as suggested by @Carl, the timings for David's method improve significantly but they are still no better than the timings for BitXor-based methods.

ClearAll[f1,f2,f3,f4]
f1[n_]:= Module[{lst=DeveloperToPackedArray@RandomChoice[{0.5, 0.3, 0.2}->{1, 2, 3}, n]},
BitXor[1, Unitize[BitXor[#, lst] & /@ {1, 2, 3}] ]]
f2[n_]:= Module[{lst=DeveloperToPackedArray[ RandomVariate[
EmpiricalDistribution[WeightedData[Range[3], {.5, .3, .2}]], n]]},
BitXor[1, Unitize[BitXor[#, lst] & /@ {1, 2, 3}] ]]
f3[n_]:= Transpose[DeveloperToPackedArray@RandomChoice[{.3, .2, .5} ->
{{1, 0, 0}, {0, 1, 0}, {0, 0, 1}}, n]]
f4[n_]:= Transpose[DeveloperToPackedArray@RandomChoice[{.3, .2, .5} ->
IdentityMatrix[3], n]]

funcs = {f1, f2, f3, f4};
timings = Prepend[Table[Prepend[Table[First[RepeatedTiming[funcs[[j]][i]]],
{j, 1, 4}], i], {i, {200000, 10^6}}], {"n", "f1","f2","f3", "f4"}];
Grid[timings, Dividers -> All] // TeXForm


$\begin{array}{|c|c|c|c|c|} \hline \text{n} & \text{f1} & \text{f2} & \text{f3} & \text{f4} \\ \hline 200000 & 0.0069 & 0.0061 & 0.016 & 0.0063 \\ \hline 1000000 & 0.0359 & 0.032 & 0.0885 & 0.035 \\ \hline \end{array}$

(I cannot time larger lists because the required computation exceeds the memory limit of the free cloud accounts.)

{l1, l2, l3} = BitXor[1, Unitize[BitXor[#, list] & /@ {1, 2, 3}] ]

TeXForm @ {list, l1, l2, l3}


$\left( \begin{array}{cccccccccccccccccccc} 1 & 1 & 1 & 1 & 1 & 2 & 3 & 1 & 2 & 1 & 1 & 1 & 2 & 3 & 2 & 1 & 1 & 1 & 3 & 2 \\ 1 & 1 & 1 & 1 & 1 & 0 & 0 & 1 & 0 & 1 & 1 & 1 & 0 & 0 & 0 & 1 & 1 & 1 & 0 & 0 \\ 0 & 0 & 0 & 0 & 0 & 1 & 0 & 0 & 1 & 0 & 0 & 0 & 1 & 0 & 1 & 0 & 0 & 0 & 0 & 1 \\ 0 & 0 & 0 & 0 & 0 & 0 & 1 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & 0 & 0 & 0 & 0 & 1 & 0 \\ \end{array} \right)$

Timings: Using Henrik's setup, this is twice as fast as Henrik's method.

list = DeveloperToPackedArray[RandomChoice[{0.5, 0.3, 0.2} -> {1, 2, 3}, 200000]];

RepeatedTiming[{l1, l2, l3} = BitXor[1, Unitize[BitXor[#, list] & /@ {1, 2, 3}] ]][[1]]


0.0013

RepeatedTiming[list1a = Subtract[1, Unitize[Subtract[list, 1]]];
list2a = Subtract[1, Unitize[Subtract[list, 2]]];
list3a = Subtract[1, Unitize[Subtract[list, 3]]];][[1]]


0.0025

RepeatedTiming[list1b = Unitize@Clip[list, {1, 1}, {0, 0}];
list2b = Unitize@Clip[list, {2, 2}, {0, 0}];
list3b = Unitize@Clip[list, {3, 3}, {0, 0}];][[1]]


0.0027

And @@ (Equal @@@
Transpose[{{list1a, list2a,  list3a}, {list1b, list2b,  list3b}, {l1, l2, l3}}])


True

• As I mentioned in a comment to @DavidGStork's answer, using IdentityMatrix[3] instead of {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}} improves the speed of his answer significantly. Commented Feb 8, 2018 at 5:15
• @Carl, thank you. Was about to post the timing for that version.
– kglr
Commented Feb 8, 2018 at 5:23

Using ReplaceAll (/.) and delayed rules for pattern matching, this can be done much more directly:

l1 = list /. (x_?NumericQ :> If[x == 1, 1, 0])
l2 = list /. (x_?NumericQ :> If[x == 2, 1, 0])
l3 = list /. (x_?NumericQ :> If[x == 3, 1, 0])


The ?NumericQ is primarily there to avoid catching List in the replacement as well.

You could also map a suitable replacement function over the list:

l1 = If[# == 1, 1, 0] & /@ list
l2 = If[# == 2, 1, 0] & /@ list
l3 = If[# == 3, 1, 0] & /@ list

list1e = Boole[# == 1] & /@ list;
list2e = Boole[# == 2] & /@ list;
list3e = Boole[# == 3] & /@ list;


another option is using Piecewise. For example:

fun[x_] := Piecewise[{{1, x == 1}}, 0]
SetAttributes[fun, Listable]
list1c = fun[list];


or the combination Reap/Scan:

list1d = Reap[Scan[If[# == 1, Sow[1], Sow[0]] &, list]][[2, 1]];