20

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]];
Mr.Wizard
  • 271,378
  • 34
  • 587
  • 1,371
Andy Ross
  • 19,320
  • 2
  • 61
  • 93
  • This is an interesting puzzle. It seems that Sort@DeleteDuplicates@Flatten is practically unbeatable. I tried. – rcollyer Apr 21 '12 at 22:19
  • @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. – Andy Ross Apr 22 '12 at 00:48
  • 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. – rcollyer Apr 22 '12 at 02:42
  • 1
    It's not fast, but it might give you a different approach to tweak If[Length[#] == {}, {#, #}, #] & /@ ArrayComponents[testData]; – Cameron Murray Mar 23 '13 at 02:58

5 Answers5

8

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  *)
kglr
  • 394,356
  • 18
  • 477
  • 896
7

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];
Simon Woods
  • 84,945
  • 8
  • 175
  • 324
  • The Thread approach has the advantage of not doing the double replace at the end. So, that likely gives some of the speed up. – rcollyer Apr 23 '12 at 15:39
  • @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. – Simon Woods Apr 23 '12 at 15:54
  • Likely that's due to the simpler structure, i.e. {{..}, {..}} would be easier to Flatten then {(_ |{_,_})..}. – rcollyer Apr 23 '12 at 15:57
6

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

kptnw
  • 1,406
  • 8
  • 15
  • 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. – Andy Ross Apr 22 '12 at 00:36
  • Note that I've updated my post to include some good test data that is more true-to-life. – Andy Ross Apr 22 '12 at 00:45
3

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
Mr.Wizard
  • 271,378
  • 34
  • 587
  • 1,371
1

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

eldo
  • 67,911
  • 5
  • 60
  • 168