9
$\begingroup$

I have a list with contains entries that are length 8 sublists,i.e.

L1={{a1,b1,c1,d1,A1,B1,C1,D1},{a2,b2,c2,d2,A2,B2,C2,D2},...} and so on.

Now, in my problem two sublists are identical if the product of the first 4 entries of two sublists is identical. In this case I want to throw one of them out. My try at this was as follows:

Do[If[Product[L1[[i]][[k]], {k, 1, 4}] == Product[L1[[j]][[m]], {m, 1, 4}],
    Delete[L1,j], {i, 1, Length[L1]}, {j, i + 1, Length[L1]}];

but this doesn't work because in this way I'm changing L1 while I'm working with it. How can I improve my code / make it right? I don't see it right now...Thanks!

Improve this question
$\endgroup$
3
  • 5
    $\begingroup$ check out DeleteDuplicates, using the 2nd argument (test). There is a nice example you might want to apply/adapt in the Scope section in the documentation center. $\endgroup$
    – Pinguin Dirk
    Commented Aug 12, 2013 at 9:14
  • $\begingroup$ Also, I'm guessing that your example does not work because Delete[L1,j] does not do anything. Notice that L1=Delete[L1,j] is not a fix, you will get lost with indices. Maybe try L1[[j]]="" and at the end L1=L1/.""->Sequence[]. Just for sport because you should use something built in, like DeleteDuplicates/ $\endgroup$
    – Kuba
    Commented Aug 12, 2013 at 9:25
  • 2
    $\begingroup$ Please add a concrete working L1 (and the wanted result) for ease of testing. $\endgroup$
    – Yves Klett
    Commented Aug 12, 2013 at 9:31

4 Answers 4

Reset to default
17
$\begingroup$

There are a lot of questions on this site already about deleting duplicates and filtering lists. You'll probably learn a lot if you take the time to search for and read some of them. From several you could learn that the second argument of DeleteDuplicates is rarely a highly efficient way to approach a problem such as this and it is far better to use GatherBy where possible.

Compare the performance:

ss = Subsets[Range@16, {8}];

DeleteDuplicates[ss, Times @@ Take[#1, 4] == Times @@ Take[#2, 4] &] // Timing // First

First /@ GatherBy[ss, Times @@ Take[#, 4] &] // Timing // First

1.919

0.

The second method is so fast we must run it multiple times slow it down:

Do[First /@ GatherBy[ss, Times @@ Take[#, 4] &], {400}] // Timing // First

1.919

So we see that GatherBy is about 400 times faster on this size of problem. On larger sets it will be comparatively even faster as it has superior computational complexity.

For fun, as an additional optimization we can compute the product in a vectorized form (with tuning thanks to Michael E2) and extract our indices using Szabolcs's fine method from the second link below. This is roughly 850 times faster than DeleteDuplicates:

Do[
  With[{prod = Times @@ Take[ss\[Transpose], 4]},
    ss[[GatherBy[Range@Length@prod, prod[[#]] &][[All, 1]]]]
  ],
  {850}
] // Timing // First

1.903

Related examples:

How to represent a list as a cycle
How to efficiently find positions of duplicates?
DeleteDuplicates[] does not work as expected on floating point values
Sort+Union on a list
Intersection for lists of numeric data

Improve this answer
$\endgroup$
8
  • $\begingroup$ In Szabolcs' method, substituting prod = Times @@ (Take[ss\[Transpose], 4]), I get 1000 times faster. Would you confirm, please? $\endgroup$
    – Michael E2
    Commented Aug 12, 2013 at 11:33
  • $\begingroup$ @MichaelE2 That would be one heck of an improvement. Let me check! $\endgroup$
    – Mr.Wizard
    Commented Aug 12, 2013 at 11:36
  • $\begingroup$ I hope it's clear I meant 1000 times faster than DeleteDuplicates. :) $\endgroup$
    – Michael E2
    Commented Aug 12, 2013 at 11:37
  • $\begingroup$ @MichaelE2 heheh, ah, that sounds more likely. It's surely a better way to write that operation; I don't know what I was thinking (or rather wasn't). $\endgroup$
    – Mr.Wizard
    Commented Aug 12, 2013 at 11:38
  • $\begingroup$ @MichaelE2 I only got 850-900 times faster here but still nice. Thanks! $\endgroup$
    – Mr.Wizard
    Commented Aug 12, 2013 at 11:42
9
$\begingroup$

How about:

DeleteDuplicates[list, Times @@ Take[#1, 4] == Times @@ Take[#2, 4] &]
Improve this answer
$\endgroup$
0
8
$\begingroup$

If your L1 is long (length n) it may be reasonable to calculate each Product once rather than n-1 times like DeleteDuplicates does.

Let's calculate those products and then we can compare only the results.

l2 = {Times @@ #[[ ;; 4]], #} & /@ list; 
DeleteDuplicates[l2, #1[[ 1]] == #2[[ 1]] &][[;; , 2]]

We can see, it does matter:

n = 10^3;
L1 = RandomInteger[{1, 4}, {n, 7}];

DeleteDuplicates[L1, 
                 Times @@ Take[#1, 4] == Times @@ Take[#2, 4] &
                ] // AbsoluteTiming // First

0.203125

DeleteDuplicates[{Times @@ #[[ ;; 4]], #} & /@ L1 ,
                 #1[[ 1]] == #2[[ 1]] &
                ][[ ;; , 2]] // AbsoluteTiming // First

0.078125
Improve this answer
$\endgroup$
3
  • $\begingroup$ +1. Precomputing the products is a nice trick, especially in cases where the complexity is greater than linear, as you point out. Even if DeleteDuplicates gets thrashed by GatherBy. ;) $\endgroup$
    – Michael E2
    Commented Aug 12, 2013 at 11:53
  • $\begingroup$ @MichaelE2 Thank you. Do you know any source about why DeleteDuplicates is so slow? I can't recall any reason why it has to. Also this trick should have been done by DD itself :) $\endgroup$
    – Kuba
    Commented Aug 12, 2013 at 12:01
  • 2
    $\begingroup$ According to this answer (Leonid Shifrin), DeleteDuplicates is quadratic with an explicit comparison function. See also this discussion. I would think that it has to use a general purpose algorithm that does not assume the comparison is symmetric or transitive. The actual complexity depends on the number of duplicates, too. $\endgroup$
    – Michael E2
    Commented Aug 12, 2013 at 14:23
1
$\begingroup$

DeleteDuplicatesBy (versions 10+) is almost as fast as GatherBy:

ss = Subsets[Range@16, {8}];

DeleteDuplicatesBy[Times @@ Take[#, 4] &][ss]// RepeatedTiming // First

0.0058

First /@ GatherBy[ss, Times @@ Take[#, 4] &] // RepeatedTiming // First

0.0053

DeleteDuplicates[ss, Times @@ Take[#1, 4] == Times @@ Take[#2, 4] &] //
  RepeatedTiming // First

  2.83

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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