20
$\begingroup$

I have data that is given as a list of ordered pairs mixed with scalars. The pairs can contain infinite bounds. My goal is to convert the data into an index used in future computations.

data = {{1, ∞}, {-∞, 2}, 3, {2, 2}, {2, 3}};

This gives me all of the unique values present in data.

udata = Sort[DeleteDuplicates[Flatten@data], Less] ==> {-∞, 1, 2, 3, ∞}

Now I use Dispatch to create replacement rules based on the unique values.

dsptch = Dispatch[Thread[udata -> Range[Length[udata]]]];

Finally I replace the values with their indices and expand scalars a such that they are also pairs {a,a}. This results in a matrix of indices which is what I'm after.

Replace[data /. dsptch, a_Integer :> {a, a}, 1] ==> {{2, 5}, {1, 3}, {4, 4}, {3, 3}, {3, 4}}

NOTES:

  1. The number of unique values is generally small compared to the length of data but this doesn't have to be the case.

  2. Any real numbers are possible. The data I've shown simply gives a sense of the structural possibilities.

Question: Is there a way to create the final matrix of indices that is much faster than what I'm doing here?

Edit: To test the how potential solutions scale I recommend using the following data. It is fairly representative of a true-to-life case.

inf = {#, ∞} & /@ RandomChoice[Range[1000], 3*10^5]; neginf = {-∞, #} & /@ RandomChoice[Range[1000], 10^5]; int = Sort /@ RandomChoice[Range[1000], {10^5, 2}]; num = RandomChoice[Range[1000], 5*10^5]; testData = RandomSample[Join[inf, neginf, int, num]];
Improve this question
$\endgroup$
4
  • $\begingroup$ This is an interesting puzzle. It seems that Sort@DeleteDuplicates@Flatten is practically unbeatable. I tried. $\endgroup$ Commented Apr 21, 2012 at 22:19
  • $\begingroup$ @rcollyer I'm just hoping its interesting enough that someone can trounce my current approach. The biggest bottleneck the heavy use of replacements but I'm at a loss for finding a novel approach. $\endgroup$ Commented Apr 22, 2012 at 0:48
  • $\begingroup$ Realizing that overcoming Sort...Flatten was going to be next to impossible, I tried using Reap and Sow to simultaneously collect the unique terms and substitute in a function that would later return the index. Twice as slow as your method. Tried using an implementation of a binary tree, it can't handle $10^6$ terms, e.g. $10^5$ terms on par with your implementation running $10^6$ terms. So, I don't know exactly optimize the bottleneck any further. $\endgroup$ Commented Apr 22, 2012 at 2:42
  • 1
    $\begingroup$ It's not fast, but it might give you a different approach to tweak If[Length[#] == {}, {#, #}, #] & /@ ArrayComponents[testData]; $\endgroup$ Commented Mar 23, 2013 at 2:58

5 Answers 5

Reset to default
8
$\begingroup$

A modest improvement when you replace Replace[...] with Transpose@Thread:

 (udata = Sort[DeleteDuplicates[Flatten@testData], Less]; dsptch = Dispatch[Thread[udata -> Range[Length[udata]]]]; out1 = Replace[testData /. dsptch, a_Integer :> {a, a}, 1];) // AbsoluteTiming (* {2.1282128, Null} *) (udata = Sort[DeleteDuplicates[Flatten@testData], Less]; dsptch = Dispatch[Thread[udata -> Range[Length[udata]]]]; out2 = Transpose@Thread[testData /. dsptch];) // AbsoluteTiming (* {1.9421942, Null} *) out1==out2 (* True *)
Improve this answer
$\endgroup$
2
  • $\begingroup$ That Thread trick for converting the numbers to pairs is very useful +1. $\endgroup$ Commented Apr 23, 2012 at 18:01
  • $\begingroup$ @AndyRoss I have to agree with you on that. Definitely interesting and useful. $\endgroup$ Commented Apr 26, 2012 at 2:24
7
$\begingroup$

I get about a 20% speed up by using kguler's Thread trick to transform the data at the beginning, saving the Transpose until the end. There seems to be a slight advantage to working on data with dimensions {2,10^6} over data with dimensions {10^6,2}. I'm not sure why.

twobiglists=Thread[testData]; udata=Sort[DeleteDuplicates[Flatten@twobiglists],Less]; dsptch=Dispatch[Thread[udata->Range[Length[udata]]]]; result=Transpose[twobiglists/.dsptch];
Improve this answer
$\endgroup$
3
  • $\begingroup$ The Thread approach has the advantage of not doing the double replace at the end. So, that likely gives some of the speed up. $\endgroup$ Commented Apr 23, 2012 at 15:39
  • $\begingroup$ @rcollyer - I agree, Thread seems to be more efficient than a_:>{a,a} but also Flatten is about 3 times faster on the transformed data. $\endgroup$ Commented Apr 23, 2012 at 15:54
  • $\begingroup$ Likely that's due to the simpler structure, i.e. {{..}, {..}} would be easier to Flatten then {(_ |{_,_})..}. $\endgroup$ Commented Apr 23, 2012 at 15:57
6
$\begingroup$

This is a little faster approach:

first,transform data and udata a little, represent Infinity and -Infinity by "a1" and "a0" :

 data2 = Block [{DirectedInfinity = "a" <> ToString[# + 1] &}, data] =>{{1, "a2"}, {"a0", 2}, 3, {2, 2}, {2, 3}} udata2 = Block [{DirectedInfinity = "a" <> ToString[# + 1] &}, udata] =>{"a0", 1, 2, 3, "a2"}

second, rebuild dispatch table:

dsptch2 = Dispatch[Thread[udata2 -> Range[Length[udata2]]]];

third, Replace and Replace:

Replace[Replace[data2, dsptch2, {-1}], a_Integer :> {a, a}, 1] ==>{{2, 5}, {1, 3}, {4, 4}, {3, 3}, {3, 4}}

the main difference is the inner Replace, make some bigger test data:

l = Join[Range[ 100], {\[Infinity] , -\[Infinity] }]; l2 = Partition [RandomChoice[l, 10^6], 2]; data = Riffle[l2, Join[{\[Infinity] , -\[Infinity] }, Range[ 100]], 5];

now timing the inner Replace part alone:

c1 = data2 /. dsptch2; // Timing (*original approach*) c2 = Replace[data2, dsptch2, {-1}]; // Timing (*modified approach*) c1 == c2 =>{0.749, Null} =>{0.343, Null} =>True

we see the speed is doubled, now timing the whole:

(udata = Sort[DeleteDuplicates[Flatten@data], Less]; dsptch = Dispatch[Thread[udata -> Range[Length[udata]]]]; a1 = Replace[data /. dsptch, a_Integer :> {a, a}, 1];) // Timing (data2 = Block [{DirectedInfinity = "a" <> ToString[# + 1] &}, data]; udata = Sort[DeleteDuplicates[Flatten@data], Less]; udata2 = Block [{DirectedInfinity = "a" <> ToString[# + 1] &}, udata]; dsptch2 = Dispatch[Thread[udata2 -> Range[Length[udata2]]]]; a4 = Replace[Replace[data2, dsptch2, {-1}], a_Integer :> {a, a}, 1];) // Timing a4 == a1 =>{1.092, Null} =>{0.889, Null} =>True

a little faster...

Improve this answer
$\endgroup$
2
  • $\begingroup$ This approach seemed promising until I tried it with more representative data. data = RandomChoice[data, 10^6] where data is the original list I provided. $\endgroup$ Commented Apr 22, 2012 at 0:36
  • $\begingroup$ Note that I've updated my post to include some good test data that is more true-to-life. $\endgroup$ Commented Apr 22, 2012 at 0:45
3
$\begingroup$

Now incorporating Simon Woods's improvement and including his code in the timings.

Pardon the very late answer but hopefully it is useful to someone with a similar problem.

Test data:

SeedRandom[0] inf = {#, ∞} & /@ RandomChoice[Range[1000], 3*10^5]; neginf = {-∞, #} & /@ RandomChoice[Range[1000], 10^5]; int = Sort /@ RandomChoice[Range[1000], {10^5, 2}]; num = RandomChoice[Range[1000], 5*10^5]; testData = RandomSample[Join[inf, neginf, int, num]];

Data and time common to each method:

udata = Sort[DeleteDuplicates[Flatten@testData], Less]; // RepeatedTiming 
{0.247, Null}

Relative performance:

(* kglr *) (dsptch = Dispatch[Thread[udata -> Range[Length[udata]]]]; r0 = Transpose @ Thread[testData /. dsptch];) // RepeatedTiming (* Simon Woods *) (dsptch = Dispatch[Thread[udata -> Range[Length[udata]]]]; r1 = Transpose[Thread @ testData /. dsptch];) // RepeatedTiming (* Replace *) (dsptch = Dispatch@Thread[udata -> Range@Length@udata]; r2 = Replace[Thread @ testData, dsptch, {2}]\[Transpose];) // RepeatedTiming (* Association, for v10+ *) (asc = AssociationThread[udata -> Range@Length@udata]; r3 = (Lookup[asc, #] & /@ Thread @ testData)\[Transpose];) // RepeatedTiming 
{0.673, Null} {0.573, Null} {0.446, Null} {0.390, Null} 
r0 === r1 === r2 === r3 
True
Improve this answer
$\endgroup$
1
$\begingroup$

Using PositionIndex (new in 10.0) and SequenceReplace (new in
11.3)

data = {{1, \[Infinity]}, {-\[Infinity], 2}, 3, {2, 2}, {2, 3}}; udata = Sort[DeleteDuplicates[Flatten @ data], Less]; SequenceReplace[{a_Integer} :> {a, a}][data /. First /@ PositionIndex @ udata]

{{2, 5}, {1, 3}, 4, {3, 3}, {3, 4}}

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.