How to get list of duplicates when using DeleteDuplicates?

Question

This might be easy, but can't find a way to use DeleteDuplicates to get also list of the actual duplicates.

Example:

lstA = {1, 2, 4, 4, 6, 7, 8, 8};
r = DeleteDuplicates[lstA]
(* {1, 2, 4, 6, 7, 8} *)

I also wanted to get list of the actual duplicates, which are {4,8} in this example. It would have been nice if DeleteDuplicates would also return those, but there is no option there for that. I do not know what many Mathematica functions do not return back more useful information when called. Many seem to return one piece of information only, and one has to call another function to get another piece of information.

For example, here DeleteDuplicates could had an API like this

{r,d}=DeleteDuplicates[lst]

and r will contain the list after duplicates are moved, but d would contain the actual list of duplicates. To make it even more useful, it can be

{r,d,p}=DeleteDuplicates[lst]

Where p will be the positions of the duplicates in the original list. Matlab seems to do it this way. Many functions there can return more than one piece of information at a time. This might be due to WL being functional programming language, and designed for cascading function calls, where each function only does one thing at a time. I am not sure now.

DeleteDuplicates.html

Answer 1

Perhaps one of the simplest ways is to use Tally:

p = {1, 2, 4, 4, 6, 7, 8, 8};

Cases[Tally @ p, {x_, n_ /; n > 1} :> x]

{4, 8}

A somewhat faster formulation:

Pick[#, Unitize[#2 - 1], 1] & @@ Transpose[Tally @ p]

Taking the optimization to a rather excessive degree:

#[[SparseArray[#2, Automatic, 1]["AdjacencyLists"]]] & @@ Transpose[Tally @ p]

---

Though not as fast as the SparseArray optimized form of Tally, an alternative is to use Split after sorting. This is reasonably clean and fast:

Flatten[Split @ Sort @ p, {2}][[2]]

{4, 8}

For Integer data this method is twice as fast as any other listed here:

With[{s = Sort @ p},
 DeleteDuplicates @ 
   s[[ SparseArray[Unitize @ Differences @ s, Automatic, 1]["AdjacencyLists"] ]]
]

---

Timings

p = RandomInteger[1*^8, 1*^6];

Cases[Tally @ p, {x_, n_ /; n > 1} :> x] // Timing // First

Pick[#, Unitize[#2 - 1], 1] & @@ Transpose[Tally @ p] // Timing // First

#[[SparseArray[#2, Automatic, 1]["AdjacencyLists"]]] & @@ Transpose[Tally @ p] //
  Timing // First

Flatten[Split @ Sort @ p, {2}][[2]] // Timing // First

With[{s = Sort @ p},
 DeleteDuplicates @ 
   s[[ SparseArray[Unitize @ Differences @ s, Automatic, 1]["AdjacencyLists"] ]]
] // Timing // First

0.827

0.343

0.265

0.343

0.11

Answer 2

If you have to use DeleteDuplicates you can use Sow/Reap:

{#, Pick @@ Transpose[GatherBy[#2[[1]]][[;; , 1]]]} & @@ Reap[
   DeleteDuplicates[lstA, (Sow[{#1, SameQ[##]}]; SameQ[##]) &]]

{{1, 2, 4, 6, 7, 8}, {4, 8}}

---

Here's more general and faster approach:

myClone[list_, test_: Identity] := Composition[
       {#[[1]], #[[2]], Position[list, #] & /@ #[[2]]} &,
       {#[[;; , 1]], DeleteCases[#, {_}][[;; , 1]]} &,
       GatherBy[#, test] &
       ][list]

lstA = RandomInteger[10, 10]
myClone[lstA]

{5, 6, 3, 5, 10, 10, 8, 7, 0, 10}

{{5, 6, 3, 10, 8, 7, 0}, {5, 10}, {{{1}, {4}}, {{5}, {6}, {10}}}}

Answer 3

Similar to Kuba's solution, but more compact, using Reap's third argument to remove duplicates from the duplicates:

x = {1, 2, 3, 4, 5, 4, 4, 4, 5, 1};

Reap[DeleteDuplicates[x, If[SameQ[##], Sow@#1; True, False] &], _, Union@#2 &]

 {{1, 2, 3, 4, 5}, {{1, 4, 5}}}

Answer 4

I am posting a second answer because this is a different method unrelated to the first.
I wondered how I might approach this if Tally did not exist. I came up with using Ordering on a reverse-sorted list as a way to look for duplicates. It seems to work, and I think it's fairly interesting. By nature it sorts the list of duplicates rather than giving them in order of appearance as Tally does.

duplicates[p_] :=
  With[{sp = Sort @ p}, sp[[
     "AdjacencyLists" //
       SparseArray[Unitize[1 - Differences @ Ordering @ Reverse @ sp], Automatic, 1]
    ]]
  ] // DeleteDuplicates

duplicates[{1, 2, 4, 4, 6, 7, 8, 8}]

{4, 8}

It is competitively fast compared to my first answer:

p = RandomInteger[8*^6, 2*^6];

Cases[Tally@p, {x_, n_ /; n > 1} :> x] // Length // Timing

Pick[#, Unitize[#2 - 1], 1] & @@ Transpose[Tally@p] // Length // Timing

#[[SparseArray[#2, Automatic, 1]["AdjacencyLists"]]] & @@ Transpose[Tally@p] // 
  Length // Timing

duplicates[p] // Length // Timing

{1.70041, 212277}

{0.592804, 212277}

{0.608404, 212277}

{0.358802, 212277}

On lists with extreme duplication it is a bit slower:

p = RandomInteger[1*^6, 5*^6];

(* same timing code as before *)

{1.57561, 959792}

{0.904806, 959792}

{0.904806, 959792}

{0.982806, 959792}

Answer 5

Important: Union with one argument does exactly what I describe below. I don't know how I missed that for so long. Anyway I suppose it is still nice to be able to return a list of the positions of the duplicates. And there may be other cases where you know a result is sorted I guess.

Original answer

I have long been a bit frustrated about the fact that there is neither an option for Sort that deletes duplicates, nor an option for DeleteDuplicates that makes it assume its input is sorted. DeleteDuplicates probably first sorts its argument, but still even determining that a list is sorted is unnecessary overhead. I saw that in your question the numbers were sorted, so I have focussed on this case.

In my opinion, your questions and my own made for a good case to make a library with LibraryLink. Here is the code. It is a bit long, especially because similar code is used over and over.

#include "WolframLibrary.h"

static MTensor positions;
// static MTensor frequencies;

/* Return the version of Library Link */
DLLEXPORT mint WolframLibrary_getVersion( ) {
    return WolframLibraryVersion;
}

/* Initialize Library */
DLLEXPORT int WolframLibrary_initialize( WolframLibraryData libData) {
    return LIBRARY_NO_ERROR;
}

/* Uninitialize Library */
DLLEXPORT void WolframLibrary_uninitialize( WolframLibraryData libData) {
    return;
}

//DD is for delete duplicates
DLLEXPORT int sortedDD_T_T(WolframLibraryData libData, mint Argc, MArgument *Args, MArgument Res) {
    MTensor input; //not redundant as we access this two times, once for data and once for dimension
    MTensor result;

    int err = LIBRARY_NO_ERROR;

    mint *inputDataPtr;
    mint *resultDataPtr;

    mint inputDataLen;

    input = MArgument_getMTensor(Args[0]);

    inputDataPtr = libData->MTensor_getIntegerData(input);

    inputDataLen = * libData->MTensor_getDimensions(input);

    mint array[inputDataLen];
    mint *arrayPtr;
    arrayPtr = array;

//below is basically the first (0th) iteration
    mint max = *inputDataPtr;
    inputDataPtr++;
    *arrayPtr = max;
    arrayPtr++;

    mint val;
    mint resultDataLenCounter = 1;
    mint iiii;

    for(iiii = 1; iiii < inputDataLen; iiii++)
    {
        val = *inputDataPtr;
        inputDataPtr++;
        if( val != max)
        {
            *arrayPtr = val;
            arrayPtr++;
            resultDataLenCounter++;
            max = val;
        }
    }

    err = libData->MTensor_new(MType_Integer, 1, &resultDataLenCounter, &result);
    if(err) goto error_label;

    resultDataPtr = libData->MTensor_getIntegerData(result);

    arrayPtr = array;

    for(iiii = 0; iiii < resultDataLenCounter; iiii++){
        *(resultDataPtr++) = * (arrayPtr++);
    }

    libData->MTensor_disown(input);

    MArgument_setMTensor(Res, result);
    return err;

    error_label:
    libData->MTensor_disown(input);

    if(!err) err = 1;
    return err; 

}


//WP is for with positions

DLLEXPORT int sortedDDWP_T_T(WolframLibraryData libData, mint Argc, MArgument *Args, MArgument Res) {
    MTensor input; //not redundant as we access this two times, once for data and once for dimension
    MTensor result;

    int err = LIBRARY_NO_ERROR;

    mint *inputDataPtr;
    mint *resultDataPtr;
    mint *posDataPtr;

    mint inputDataLen;

    input = MArgument_getMTensor(Args[0]);

    inputDataPtr = libData->MTensor_getIntegerData(input);

    inputDataLen = * libData->MTensor_getDimensions(input);

    mint uqArray[inputDataLen];
    mint *uqArrayPtr;
    uqArrayPtr = uqArray;

    mint posArray[inputDataLen];
    mint *posArrayPtr;
    posArrayPtr = posArray;

    mint posLen;


//below is basically the first (0th) iteration
    mint max = *inputDataPtr;
    inputDataPtr++;
    *uqArrayPtr = max;
    uqArrayPtr++;

    mint val;
    mint resultDataLenCounter = 1;
    mint iiii;

    for(iiii = 1; iiii < inputDataLen; iiii++)
    {
        val = *inputDataPtr;
        inputDataPtr++;
        if( val != max)
        {
            *uqArrayPtr = val;
            uqArrayPtr++;
            resultDataLenCounter++;
            max = val;
        } 
        else 
        {
            *posArrayPtr = iiii;
            posArrayPtr++;
        }
    }

    posLen = inputDataLen - resultDataLenCounter;

    err = libData->MTensor_new(MType_Integer, 1, &resultDataLenCounter, &result);
    if(err) goto error_label;

    err = libData->MTensor_new(MType_Integer, 1, &posLen, &positions);
    if(err) goto error_label;

    resultDataPtr = libData->MTensor_getIntegerData(result);
    posDataPtr = libData->MTensor_getIntegerData(positions);

    uqArrayPtr = uqArray;
    posArrayPtr = posArray;

    for(iiii = 0; iiii < resultDataLenCounter; iiii++){
        *(resultDataPtr++) = * (uqArrayPtr++);
    }

    for(iiii = 0; iiii < posLen; iiii++){
        *(posDataPtr++) = *(posArrayPtr++);
    }

    libData->MTensor_disown(input);

    MArgument_setMTensor(Res, result);
    return err;

    error_label:
    libData->MTensor_disown(input);

    if(!err) err = 1;
    return err; 

}

DLLEXPORT int getPositions(WolframLibraryData libData, mint Argc, MArgument *Args, MArgument Res) {

    MArgument_setMTensor(Res, positions);
    // libData->MTensor_disown(positions);
    return 0;
}

for the steps ("instructions") for compiling and linking the code, please see my answer here.

(* libraryName = "libraryName"; *) (*this is the last line from the "instructions"*)

The following code loads the functions.

SortedDD is the function that simply deletes duplicates from a sorted list.

sortedDD = 
 LibraryFunctionLoad[libraryName, 
  "sortedDD_T_T", {{Integer, 1, "Shared"}}, {Integer, 1}]

sortedDDWP is the function that makes a list with duplicates deleted, as well of a list of positions of the duplicates.

sortedDDWP = 
 LibraryFunctionLoad[libraryName, 
  "sortedDDWP_T_T", {{Integer, 1, "Shared"}}, {Integer, 1}]

As we can only return one argument in LibraryLink, we have to work around this and get the positions with another function call. This is what getPos does.

getPos = LibraryFunctionLoad[libraryName, 
  "getPositions", {}, {Integer, 1}]

Performance

WARNING: One big problem with my code is that it crashes the kernel for large input. This is because of a stackoverflow that I intend to fix.

Now let's create some random numbers. I chose to generate a BinomialProcess, i.e., a process that increases by with probably 1/2 and otherwise stays the same. So a sequence could be normal = {0,1,1,1,2,2} and we expect about 50% duplicates.

nnnn = 1002000;
randomize :=
 Block[{rands},
  rands = RandomInteger[1, nnnn];
  normal = Accumulate[rands]
  ];

now let's compare with DeleteDuplicates

sortedDD@normal // Timing // First
DeleteDuplicates@normal // Timing // First

0.008401
0.018445

That is quite nice :). Now let's see what happens if we also generate the positions list

kkkk = 522000;
(
   mOut =
     {
      sortedDDWP[normal[[;; kkkk]]],
      getPos[]
      };
   ) // Timing // First

0.006506

and we have

mOut[[1]] == Delete[normal[[;; kkkk]], List /@ mOut[[2]]]

True

Notes about the C Code

If you read the C Code, you will that I make an array, only to copy the contents of that array into another array. Unfortunately I think there is no good way around this.

Answer 6

This uses a function which redefines itself, and MapIndexed to get the position data:

deldup[z_] := Module[{f},
  f[x_, _] := (f[x, q_] := (Sow[q, x]; Unevaluated@Sequence[]); x);
  Reap[MapIndexed[f, z], _, Rule]]

deldup[{1, 2, 3, 4, 2, 3, 2}]
(* {{1, 2, 3, 4}, {2 -> {{5}, {7}}, 3 -> {{6}}}} *)

Answer 7

Some variants with Reap/Sow or Tally:

fun1[u_] := {#[[1]], Pick[#[[1]], (# > 1) & /@ #[[2]]]} &@
  Transpose[Reap[Sow[1, #] & /@ u, _, {#1, Total@#2} &][[2]]]

or

fun2[u_] := {#[[1]], Pick[#[[1]], (# > 1) & /@ #[[2]]]} &@
  Transpose@Tally[u]

Answer 8

Another way to get the dupe-free list and the list of duplicates:

With[{grouped = Gather[lstA, SameQ], pattern = {x_, __} :> x},
    {Flatten@Replace[grouped, pattern, 1], Cases[grouped, pattern]}
]
(* {{1, 2, 4, 6, 7, 8}, {4, 8}} *)

Answer 9

delinit[v_List] := Module[{f}, f[x_] := (f[x] = x; Unevaluated[]); f/@v] deletes the initial instance of every term in v. All instances after the first are kept, in the order in which they come. This is the logical complement of DeleteDuplicates.

EDIT - deli does the same thing, but faster.

deli[v_List] := Delete[v,Transpose@List@Part[Range[Length@v][[#]],
     Most@FoldList[Plus,1,Length/@Split@v[[#]]]]]& @ Ordering@v

Answer 10

For fun of it: list = {1, 2, 4, 4, 8, 4, 6, 7, 8, 8};

DeleteDuplicates@Cases[Subsets[list, {2}], {a_, a_}][[;; , 1]]

{4, 8}

Answer 11

CustomDeleteDuplicates[lst_List] := 
 Module[{lstA = lst}, {lstA //. {s___, a_, a_, g___} -> {s, a, g}, 
   Complement[lstA, lstA //. {s___, a_, a_, g___} -> {s, 0, g}]}]

{{1, 2, 4, 6, 7, 8}, {4, 8}}

EDIT: As pointed out I have updated code that is working with all use cases. I have used patterns to find out duplicates to filter out as many repetitions as can be made. It will filter out all even pairs and last remaining in case of odd count will be dealt with next function acting on it.

CustomDeleteDuplicates[li_List] := 
 Block[{l = li}, {Flatten[l] //. {s___, a_, k___, a_, g___} -> {s, a, k, g}, 
   Complement[l,Pick[(l //. {s___, a_, k___, a_, g___} -> {s, k, g}), 
     Count[l, #] & /@ (l //. {s___, a_, k___, a_, g___} -> {s, k, g}),  1]]}]

{13, 12, 2, 15, 2, 6, 7, 2, 4, 7, 12, 15, 6, 15, 12, 14, 15, 10, 14, 1}

Gather[l]

{{13}, {12, 12, 12}, {2, 2, 2}, {15, 15, 15, 15}, {6, 6}, {7, 7}, {4}, {14, 14}, {10}, {1}}

CustomDeleteCases[l]

{{13, 12, 2, 15, 6, 7, 4, 14, 10, 1}, {2, 6, 7, 12, 14, 15}}

And an even simpler solution with ReplaceRepeated:

list = {13, 12, 2, 15, 2, 6, 7, 2, 4, 7, 12, 15, 6, 15, 12, 14, 15, 10, 14, 1};
{list, {}} //. {{a___, b_, c___, b_, d___}, {du___}} :> {{a, b, c, d}, Union@{du, b}}

 {{13, 12, 2, 15, 6, 7, 4, 14, 10, 1}, {2, 6, 7, 12, 14, 15}}

Answer 12

With Sow/Reap and Pick

listp = {1, 2, 4, 4, 6, 7, 8, 8};

(i) List duplicate values

Reap[Sow[1,listp],_,Pick[#1,Unitize[Length@#2-1],1]&][[2]]

{4, 8}

(ii) Delete all duplicates (see this question)

Reap[Sow[1,listp],_,Pick[#1,#2,{1}]&][[2]]

{1, 2, 6, 7}

(iii) Delete duplicates (from Reap Documentation, unsorted Union)

Reap[Sow[1,listp],_,#1&][[2]]

{1, 2, 4, 6, 7, 8}

Answer 13

list = {4, 1, 2, 4, 4, 6, 7, 8, 8};

List duplicate values

dups = SequenceCases[list, {a_, a_} :> a]

{4, 8}

Delete all duplicates

DeleteElements[list, dups]

{1, 2, 6, 7}

WolframLanguageData[#, {"VersionIntroduced", "DateIntroduced"}] & /@ {"SequenceCases", "DeleteElements"}

Answer 14

Probably not working in every case:

Select[Partition[Sort[lstA], 2, 1, 1], #[[1]] == #[[2]] &][[All, 1]]

(* {4, 8} *)

Answer 15

Using SubsetCases and Cases:

list = {4, 1, 2, 4, 4, 6, 7, 8, 8};

Cases[SubsetCases[list, {s_ ..}], x_ /; Length[x] > 1 :> First@x]

(*{4, 8}*)

Or using GroupBy and Repeated:

g = GroupBy[list, Repeated];

Keys@Select[KeyMap[Times @@ List @@ # &, g], Length@# > 1 &]

(*{4, 8}*)