8
$\begingroup$

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]
Improve this question
$\endgroup$
3
  • 1
    $\begingroup$ 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). $\endgroup$ Commented Feb 7, 2018 at 22:15
  • $\begingroup$ Does "OP" stand for opening paragraph? $\endgroup$ Commented Feb 7, 2018 at 23:23
  • 1
    $\begingroup$ @Michael B. Heaney No, 'original poster' (the person who started the thread) or 'original post'. $\endgroup$ Commented Feb 8, 2018 at 0:43

6 Answers 6

Reset to default
9
$\begingroup$

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 = Developer`PackedArray[ RandomChoice[{.3, .2, .5} -> {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}}, 10^8]]; Transpose[mylist];]

{4.04332, Null}

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

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 = Developer`ToPackedArray[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

Improve this answer
$\endgroup$
3
  • 2
    $\begingroup$ Your list is unpacked, which is why Clip is slow. $\endgroup$ Commented Feb 7, 2018 at 21:51
  • 1
    $\begingroup$ @CarlWoll I am sorry! I updated the timings in the meantime... $\endgroup$ Commented Feb 7, 2018 at 22:14
  • 1
    $\begingroup$ 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). $\endgroup$ Commented Feb 7, 2018 at 22:40
8
$\begingroup$

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}

Addendum

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[Compile`GetElement[d, i]==2], {i, Length@d}], CompilationTarget->"C", RuntimeOptions->"Speed" ];

Comparison:

lst = Developer`ToPackedArray @ 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

Improve this answer
$\endgroup$
4
$\begingroup$

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=Developer`ToPackedArray@RandomChoice[{0.5, 0.3, 0.2}->{1, 2, 3}, n]}, BitXor[1, Unitize[BitXor[#, lst] & /@ {1, 2, 3}] ]] f2[n_]:= Module[{lst=Developer`ToPackedArray[ RandomVariate[ EmpiricalDistribution[WeightedData[Range[3], {.5, .3, .2}]], n]]}, BitXor[1, Unitize[BitXor[#, lst] & /@ {1, 2, 3}] ]] f3[n_]:= Transpose[Developer`ToPackedArray@RandomChoice[{.3, .2, .5} -> {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}}, n]] f4[n_]:= Transpose[Developer`ToPackedArray@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.)

Original answer:

{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 = Developer`ToPackedArray[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

Improve this answer
$\endgroup$
2
  • 1
    $\begingroup$ 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. $\endgroup$ Commented Feb 8, 2018 at 5:15
  • 1
    $\begingroup$ @Carl, thank you. Was about to post the timing for that version. $\endgroup$ Commented Feb 8, 2018 at 5:23
3
$\begingroup$

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
Improve this answer
$\endgroup$
3
$\begingroup$ 
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]];
Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.