LengthWhile until first duplication

Question

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.

Answer 1

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

Answer 2

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!

Answer 3

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

Answer 4

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

Answer 5

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.