15
$\begingroup$

Take a ragged 2D array:

rArray={{4, 2, 1, 0}, {2, 2}, {0, 0, 3, 3, 3}, {4, 0}, {3, 4}}

I need to "deduplicate" this, where a duplicate is any element of a sublist where that element exists at the same position in a prior sublist, e.g., on the above example, the result would be

{{4, 2, 1, 0}, {2}, {0, 0, 3, 3, 3}, {}, {3, 4}}

Targets are numeric (integer, in fact).

I'm using the following:

keepFirst[lst_List] := Module[{u = Unique[], t},
  t = Flatten[PadRight[lst, Automatic, u], {{2}, {1}}];
  t = Block[{f}, f[a_] := (f[a] = u; a); Map[f, #]] & /@ t;
  DeleteCases[Flatten[t, {{2}, {1}}], u, {2}]];

Does what I need, reasonably quick, wondering if there's perhaps a cleaner/more efficient means.

(N.b: Above fn is output from a function I use to generate these for differing dimensions/etc. - in the 2D case, Flatten[...,{{2},{1}}] can obviously simplify to the slightly faster Transpose@... with minor speed increase.)

$\endgroup$
11
$\begingroup$

Another solution using memoization:

keepFirst[lst_List] := Module[{isFirst},
  isFirst[elem_, col_] := (isFirst[elem, col] = False; True);
  Pick[lst, MapIndexed[isFirst[#1, Last[#2]] &, lst, {2}]]
  ]
$\endgroup$
  • $\begingroup$ Nice idea- slightly slower in my tests using RandomInteger[100000, #] & /@ RandomInteger[{1, 10}, 100000]. +1 $\endgroup$ – ciao Aug 9 '15 at 22:14
  • $\begingroup$ Accepted, fits the "cleaner" part of the OP, quite elegant... $\endgroup$ – ciao Aug 10 '15 at 23:21
10
$\begingroup$

This is faster for the given array:

keepFirstK7[lst_List] := 
 Delete[lst, 
  Flatten[(GatherBy[Position[lst, #], Last] & /@ 
      DeleteDuplicates[Flatten@lst])[[All, All, 2 ;;]], 2]]

keepFirstK7@rArray

$\ $ {{4, 2, 1, 0}, {2}, {0, 0, 3, 3, 3}, {}, {3, 4}}


Another approach

keepFirstK[lst_List] := Block[{sowFirst},
  sowFirst[int_, count_] := (sowFirst[int, count] = int; Sow[int]);
  Flatten /@ 
   Part[Reap[Block[{cnt = 1}, sowFirst[#, cnt++] & /@ #]] & /@ lst, 
    All, 2]]

By using Flatten[..., 1] instead of Flatten /@ ... one would get rid of the empty lists.


Or simpler:

keepFirstN[lst_List] := Block[{nftn},
  nftn[int_, count_] := (nftn[int, count] = Nothing; int);
  Block[{cnt = 1}, nftn[#, cnt++] & /@ #] & /@ lst]
$\endgroup$
  • $\begingroup$ Try with RandomInteger[100000, #] & /@ RandomInteger[{1, 10}, 100000]... much slower. +1 though. $\endgroup$ – ciao Aug 9 '15 at 22:14
  • $\begingroup$ @ciao I added another approach, that is faster for arrays like RandomInteger[10, RandomInteger[1000]] &~Array~100000 $\endgroup$ – Karsten 7. Aug 10 '15 at 1:39
  • $\begingroup$ Mobile - will check on return... $\endgroup$ – ciao Aug 10 '15 at 2:20
  • 2
    $\begingroup$ I really like keepFirstN, even though it only works in V10.2 or later. But it can made simpler yet: keepFirstN[lst_List] := Block[{nftn}, nftn[val_, indx_] := (nftn[val, indx] = Nothing; val); MapIndexed[nftn[#1, #2] &, #] & /@ lst] $\endgroup$ – m_goldberg Aug 11 '15 at 0:37
  • 1
    $\begingroup$ No surprise that it is slower. MapIndex is known to be slow. I only brought it to your attention because of its simplicity. $\endgroup$ – m_goldberg Aug 11 '15 at 13:12
2
$\begingroup$

Uninspiring but thought I'd play:

func[lst_] := 
 Module[{res = Thread[{#, Range[Length@#]}] & /@ lst, f = Unique[]},
  (f[#] = 1) & /@ Flatten[res, 1];
  Cases[#, {x_, 1} :> x] & /@ Map[{#[[1]], f[#]++} &, res, {2}]]

so func[rArray]

yields:

{{4, 2, 1, 0}, {2}, {0, 0, 3, 3, 3}, {}, {3, 4}}

$\endgroup$
  • $\begingroup$ +1, but slower in my tests , e.g. with list RandomInteger[100000, #] & /@ RandomInteger[{1, 10}, 100000] $\endgroup$ – ciao Aug 9 '15 at 22:16
  • 1
    $\begingroup$ @ciao never been good efficiency...just wanted to play :) $\endgroup$ – ubpdqn Aug 9 '15 at 22:22
1
$\begingroup$

If one has some prior knowledge about the shape (maxL) and values (nVal) of the possible arrays, a compiled function can be used.

maxL = Max[Length /@ rArray]
nVal = Max@Flatten[rArray] + 1

keepFirstKC = 
 With[{hA = ConstantArray[0, {nVal + 1, maxL}], nothing = nVal + 1}, 
  Compile[{{lst, _Integer, 2}},
   Block[{testA = hA},
     Block[{cnt = 1}, 
        If[testA[[#, cnt]] == 0, testA[[#, cnt++]] = 1; #, 
           nothing] & /@ #] & /@ (lst + 1)] - 1, 
   CompilationTarget -> "C"
   ]]

keepFirstKF[lst_] := 
 DeleteCases[keepFirstKC@PadRight[lst, Automatic, nVal], nVal, {2}]

Depending on how speed is measured, using

deleteCases = With[{dc = nVal},
  Compile[{{intList, _Integer, 1}},
   DeleteCases[intList, dc], CompilationTarget -> "C"]
  ]

keepFirstKF[lst_] := 
 deleteCases /@ keepFirstKC[PadRight[lst, Automatic, nVal]]

can be faster.

$\endgroup$
1
$\begingroup$

sakra made good use of MapIndexed, but Pick is superfluous if we use Sequence directly, as done in the first method in Delete duplicate elements from a list

coldupe[lst_List] :=
  Module[{f},
    mem : f[elem_, _] := (mem = Sequence[]; elem);
    MapIndexed[f[#, Last[#2]] &, lst, {2}]
  ]

coldupe[rArray]
{{4, 2, 1, 0}, {2}, {0, 0, 3, 3, 3}, {}, {3, 4}}

And now I see that m_goldberg posted basically this in a comment two years ago.

$\endgroup$
  • 1
    $\begingroup$ What's up, Rip Van Winkle? ;=) and +1... $\endgroup$ – ciao Jul 30 '17 at 21:01

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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