# LengthWhile until first duplication

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.

• Your approach seem quite efficient Commented Jan 31, 2014 at 12:15
• This question feels familiar; does anyone recall a similar one? Commented Jan 31, 2014 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. Commented Jan 31, 2014 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).
– ciao
Commented Jan 31, 2014 at 23:45
• @MikeHoneychurch: Hunting for that now - might you have a link?
– ciao
Commented Jan 31, 2014 at 23:51

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

• Nice style. +1. (I adjusted your Module.) Commented Jan 31, 2014 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. Commented Jan 31, 2014 at 13:43
• Wow, this is brilliant. +1 Commented Jan 31, 2014 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!
– ciao
Commented Jan 31, 2014 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.
– ciao
Commented Jan 31, 2014 at 23:58

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!

• 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! Commented Feb 2, 2014 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.
– ciao
Commented Feb 2, 2014 at 9:29

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

• A stupid observation, but for a more representative test one could randomize Q for each run Commented Jan 31, 2014 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. Commented Jan 31, 2014 at 13:46
• I'm getting better results for your function doing that. As you wish. Commented Jan 31, 2014 at 14:23
• @belisarius I can't replicate that; would you please consider adding code and v9 timings to this answer? Commented Jan 31, 2014 at 14:40
• pastebin.com/uBjFN6Cx But sorry, I get fluctuating results Commented Jan 31, 2014 at 16:07

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


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.

• 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!
– ciao
Commented Jan 31, 2014 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. Commented Feb 1, 2014 at 10:38