Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I have the need to trim each of a large number of potentially very long lists (10^6+ elements) to the length where the last occurrence of any distinct element happens, or said another way, where the next element is the first duplication of any prior element of that list.

Lists are simple integer elements, but will often be beyond machine precision.

For example, given a list {3, 24, 50, 41, 46, 21, 20, 3, 2, 5, 29, 28, 38, 22, 2} it should return 7.

I'm using: -Tr[Unitize[# - #2[[ ;; Length[#]]]] - 1] &[DeleteDuplicates[#], #] &[yourListHere] which is reasonably swift. Wondering if there's a better solution.

share|improve this question
1  
Your approach seem quite efficient –  belisarius Jan 31 at 12:15
    
This question feels familiar; does anyone recall a similar one? –  Mr.Wizard Jan 31 at 12:33
    
I'm thinking that Leonid may have posted something faster than DeleteDuplicates for large lists. If so then that could deliver some improvement. –  Mike Honeychurch Jan 31 at 22:06
    
@Mr.Wizard: perhaps you're thinking of the "duplicate limiter"? Different (and my initial attempt was equivalent to the method used by ubpdqn below). –  rasher Jan 31 at 23:45
    
@MikeHoneychurch: Hunting for that now - might you have a link? –  rasher Jan 31 at 23:51

5 Answers 5

Somewhat uninspiring, however:

f[list_] := Module[{t},
  t[_] = 0;
  LengthWhile[list, t[#]++ < 1&]
]

Defining original proposed function:

op[x_] := -Tr[Unitize[# - #2[[ ;; Length[#]]]] - 1] &[
    DeleteDuplicates[#], #] &[x]

Testing on:

test = RandomInteger[{-100000, 100000}, {1000, 10^6}];

then:

AbsoluteTiming[f /@ test][[1]]

yields:

5.947946

Compared with:

AbsoluteTiming[op /@ test][[1]]

yields: 15.700419

share|improve this answer
    
Nice style. +1. (I adjusted your Module.) –  Mr.Wizard Jan 31 at 13:35
    
@Mr.Wizard thank you. I actually very much like the creativity of the other answers and the incremental refinements. My testing on the other test cases is not as favourable but changing from RandomInteger[{-100000, 100000}, 100000] to RandomInteger[{-100000, 100000}, 1000000] favours f. I believe it scales better I guess I just posted an alternative approach that does not need to parse the whole list. –  ubpdqn Jan 31 at 13:43
    
Wow, this is brilliant. +1 –  RunnyKine Jan 31 at 14:48
    
I had used this obvious method early on, was quite slow. I'm thinking that there was a bug in my code, because re-testing it, it is faster (as I would expect) than mine. Thanks for posting this, inspiring a re-test! –  rasher Jan 31 at 23:31
    
@ubpdqn: Yes, timing my version (a bit different, seems to be trading blows timing wise) I get very inconsistent times, sometimes quite a bit faster, sometimes much slower. I'm going to steal Mr. Wizard's benchmarking code and investigate. –  rasher Jan 31 at 23:58

I can't think of anything faster than your method, except to refine it using these observations.

Adding my function as len3 to Coolwater's test:

Q = RandomInteger[{-100000, 100000}, 100000];

len[L_] := -Tr[Unitize[# - L[[ ;; Length[#]]]] - 1] &[DeleteDuplicates[L]]
len2[L_] := Length[#] - Tr[Unitize[L[[;; Length[#]]] - #]] &[DeleteDuplicates[L]]
len3[L_] :=
  Length[#] - Tr @ Unitize @ Subtract[L ~Take~ Length[#], #]& @ DeleteDuplicates @ L

AbsoluteTiming[Do[len[Q], {500}]]
AbsoluteTiming[Do[len2[Q], {500}]]
AbsoluteTiming[Do[len3[Q], {500}]]
{0.8720025, Null}

{0.8600012, Null}

{0.5600008, Null}

(Timings performed in version 7.)

share|improve this answer
    
A stupid observation, but for a more representative test one could randomize Q for each run –  belisarius Jan 31 at 13:44
    
@belisarius Not stupid, but since these three function each scan the full list (no early abort), and since all I wanted to show was relative timing, I preferred to keep Coolwater's test unchanged. –  Mr.Wizard Jan 31 at 13:46
    
I'm getting better results for your function doing that. As you wish. –  belisarius Jan 31 at 14:23
    
@belisarius I can't replicate that; would you please consider adding code and v9 timings to this answer? –  Mr.Wizard Jan 31 at 14:40
    
pastebin.com/uBjFN6Cx But sorry, I get fluctuating results –  belisarius Jan 31 at 16:07
up vote 3 down vote accepted

With my grey matter prodded by comments and answers from Mr. Wizard, Ymareth, and ubpdqn, I poked around at the distribution of duplicates, finding that more often than not they were toward the latter parts of the lists. This explains the wild variance in timings for my initial idea similar to ubpdqn's: if "lucky" the short-circuiting helps, but if not, you pay a dear price compared to the efficiency of the vectorized implementation.

With the idea of "rolling the dice" hinted at by Ymareth, I modified my routine to the following.

Module[{tlen = Length[#], dd, ldd, bounds},

   bounds = 
    DeleteDuplicates[Select[{25000, 50000, 100000, 500000, 1000000, tlen}, # <= tlen &]];

   Do[If[Length[dd = DeleteDuplicates[#[[1 ;; len]]]] != len, Break[]], {len, bounds}];

   If[(ldd = Length[dd]) == tlen, Return[tlen], -Tr[Unitize[#[[1 ;; ldd]] - dd] - 1]]] &[target]

The purely mathematical operation is so quick, the overhead of doing extra work in sniffing at early parts of the list to avoid doing the work on the whole list is surprisingly inconsequential. Lists with early surprises are caught quickly, and those with tail-heavy distribution of duplicates cost only slightly more time. Overall, the average result is at least an order of magnitude faster, often much more, than either my original bare method or using downvalues. I'll post some timing details when I have time.

Thanks to all for comments and replies, I'm quite pleased with the end result!

share|improve this answer
1  
Nice method. (Time for a self-accept perhaps?) You also just inspired me to apply a similar approach to another problem I am working on. Thanks! –  Mr.Wizard Feb 2 at 8:18
    
@Mr.Wizard: Thank you for the kind words. I'll accept it when the timer on that runs, barring some bolt-from-the-blue answer. –  rasher Feb 2 at 9:29

You don't need to subtract all elements by 1

Q = RandomInteger[{-100000, 100000}, 100000];
len[L_] := -Tr[Unitize[# - L[[ ;; Length[#]]]] - 1] &[DeleteDuplicates[L]]
len2[L_] := Length[#] - Tr[Unitize[L[[;; Length[#]]] - #]] &[DeleteDuplicates[L]]
AbsoluteTiming[Do[len[Q], {500}]]
(*{2.3010033, Null}*)
AbsoluteTiming[Do[len2[Q], {500}]]
(*{2.1420182, Null}*)
share|improve this answer

If the range of values is small then a duplicate may be early so scanning from the front may be more efficient...

f[list_List]:=Module[{dup, i=0},dup[___]=False; 
   Catch[Scan[If[dup[#],Throw[i], (dup[#]=True; i++)]&,list];0]];

AbsoluteTiming[ Do[f[RandomInteger[{-100000, 100000}, 100000]], {500}];]

4.101 seconds (M9,Win7,2.8Ghz Xeon).

AbsoluteTiming[Do[f[RandomInteger[{-1000, 1000}, 100000]], {500}];]

0.965 seconds.

share|improve this answer
    
Yes, I tried a similar technique with my LengthWhile experiments, and if one get's "lucky" it can be faster, but if "unlucky" (low probability of duplicates) it becomes a slug, hence my meanderings into vectorizing as much as possible. Thanks for the answer! –  rasher Jan 31 at 23:50
    
Possibly you could hedge your bets. If the list is long, so the overhead is low, start both on two kernels and take the first answer. –  Ymareth Feb 1 at 10:38

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.