# 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 – Dr. belisarius Jan 31 '14 at 12:15
This question feels familiar; does anyone recall a similar one? – Mr.Wizard Jan 31 '14 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 '14 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 Jan 31 '14 at 23:45
@MikeHoneychurch: Hunting for that now - might you have a link? – ciao Jan 31 '14 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.) – Mr.Wizard Jan 31 '14 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 '14 at 13:43
Wow, this is brilliant. +1 – RunnyKine Jan 31 '14 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 Jan 31 '14 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 Jan 31 '14 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.)

-
A stupid observation, but for a more representative test one could randomize Q for each run – Dr. belisarius Jan 31 '14 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 '14 at 13:46
I'm getting better results for your function doing that. As you wish. – Dr. belisarius Jan 31 '14 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 '14 at 14:40
pastebin.com/uBjFN6Cx But sorry, I get fluctuating results – Dr. belisarius Jan 31 '14 at 16:07

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! – Mr.Wizard Feb 2 '14 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 Feb 2 '14 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}*)

-

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 Jan 31 '14 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 '14 at 10:38