7
$\begingroup$

My request is a follow-up on this question:

Replacing duplicates instead of deleting them

What if we want to replace duplicated values not with a single value but with newly created values distinct from each other?

list = {1, 1, 1, 5, 3, 2, 2};

My first attempt was:

list //. {h___, x_Integer, m___, x_Integer, t___} :> {h, x, m, 
   RandomInteger[{1, Length @ list}], t}

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

This functions sometimes, but most of the time not. Why?

Then I found the following preliminary solution:

xlist = list //. {h___, x_Integer, m___, x_Integer, t___} :> {h, x, m, "x", t}

{1, "x", "x", 5, 3, 2, "x"}

c = Complement[Range @ Length @ xlist, Select[NumberQ] @ xlist];
p = Flatten @ Position[xlist, "x"];
rlist = AssociationThread[p -> c]

<|2 -> 4, 3 -> 6, 7 -> 7|>

plist = AssociationThread[Range @ Length @ xlist -> xlist]

<|1 -> 1, 2 -> "x", 3 -> "x", 4 -> 5, 5 -> 3, 6 -> 2, 7 -> "x"|>

Expected result:

<|plist, rlist|> // Values

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

Questions:

  1. Why has ReplaceRepeated failed?

  2. The list cannot contain elements higher than list length. For example, this wouldn't function: list = {1, 1, 1, 5, 3, 999, 2}. How would you handle this case?

  3. Better / faster alternatives.

$\endgroup$
3
  • $\begingroup$ How is this different than mathematica.stackexchange.com/questions/288861/… ? $\endgroup$
    – lericr
    Aug 19, 2023 at 14:47
  • $\begingroup$ Your UniquePositions would yield {1, 2, 3, 5, 4, 6, 7} not preserving the original positions of as many unique elements as possible. In this case 3 and 2 before the last 7. $\endgroup$
    – eldo
    Aug 19, 2023 at 15:05
  • $\begingroup$ I wasn't really asking about my specific answer in that case, but thanks for the clarification. I understand the difference now. The problems are very similar, and a slight tweak to any of the answers offered on your previous question would solve this current question. $\endgroup$
    – lericr
    Aug 19, 2023 at 15:19

6 Answers 6

5
$\begingroup$
Clear["Global`*"];
list = {1, 1, 1, 5, 3, 2, 2}
pos = Position[list, #] & /@ DeleteDuplicates[list] // Map[Rest] // 
  Flatten
unseen = Complement[Range@Length@list, list][[1 ;; Length@pos]]

ReplacePart[list, Thread[pos -> unseen]]
$\endgroup$
2
  • $\begingroup$ Try it with ` {1, 1, 1, 5, 3, 999, 2}` (Question 2) $\endgroup$
    – eldo
    Aug 19, 2023 at 11:34
  • $\begingroup$ Sorry about that. I have updated the answer. Please check. Thanks. $\endgroup$
    – Syed
    Aug 19, 2023 at 11:56
6
$\begingroup$

Working upon a solution by @kglr:

ClearAll[replaceDuplicates]
replaceDuplicates := 
 Module[{f, i = 1, new = Complement[Range[1, Length[#]], #]}, 
   f[y_] := (f[y] := new[[i++]]; y); f /@ #] &

replaceDuplicates@{1, 1, 1, 5, 3, 2, 2}
(* {1, 4, 6, 5, 3, 2, 7} *)
$\endgroup$
5
$\begingroup$

Here is an alternative.

We scan every element of list staring at the beginning. We maintain a list "seen" with elements already scanned. Then we check if the new element is in "seen". If no we take this element. If yes, We take an element that is neither in "seen" not in "list".The new element is added to "seen";

list = {1, 1, 1, 5, 3, 2, 2};
seen = {};
(AppendTo[seen, 
    If[MemberQ[seen, #], 
     Complement[Range[Length[list]], Join[list, seen]][[1]], #]]; 
   seen[[-1]]) & /@ list

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

Then "ReplaceAll" does not work because you are using "RandomInteger".

$\endgroup$
5
$\begingroup$

Another way using GroupBy and Lookup to obtain the positions:

list = {1, 1, 1, 5, 3, 999, 2};

pos = Lookup[GroupBy[Rest /@ PositionIndex[#], x |-> Length[x] >= 1, Catenate], True] &@list

unseen = Take[Complement[Range@Length@#, #], Length@pos] &@list

Finally, using ReplacePart:

ReplacePart[#, AssociationThread[pos, unseen]] &@list

(*{1, 4, 6, 5, 3, 999, 2}*)
$\endgroup$
4
$\begingroup$

Just for fun;)

list = {1, 1, 1, 5, 3, 2, 2};

StringDrop[ToString@#,2]&/@(If[#[]=!=1,#[]=1;#,Unique["x"]]&)/@(ToExpression["x1"<>ToString[#]]&)/@list//Timing 
(*{0.000074,{1,4,6,5,3,2,7}}*)

The idea is to use Unique to generate a new label automatically. The key part is (If[#[]=!=1,#[]=1;#,Unique["x"]]&). But sadly Unique seems have a bug, see Unique[] problems

$\endgroup$
4
$\begingroup$

Update

As a 'pure' function, without using a scoping construct such as With:

ReplacePart[#1,Thread[#2->Take[#3,Length@#2]]]&@@{#,
  Replace[(PositionIndex[#]//Values),{x_,y___}:>y,2],Complement[Range@Length@#,#]
}&@list

(* {1, 4, 6, 5, 3, 2, 7} *)

With Through:

g[lst_List]:=ReplacePart[#1,Thread[#2->Take[#3,Length@#2]]]&@@Through[
  {#&,
   Replace[(PositionIndex[#]//Values),{x_,y___}:>y,2]&,
   Complement[Range@Length@#,#]&
  }@lst]
{#->g@#}&/@{list,listp,listg,listx, Range[5]}

{
  {{1, 1, 1, 5, 3, 2, 2} -> {1, 4, 6, 5, 3, 2, 7}}, 

  {{1, 2, 4, 4, 6, 7, 8, 8} -> {1, 2, 4, 3, 6, 7, 8, 5}}, 

  {{1, 1, 1, 5, 3, 999, 2} -> {1, 4, 6, 5, 3, 999, 2}}, 

  {{20, 20, 21, 21, 22, 22, 23, 23, 24, 24} -> {20, 1, 21, 2, 22, 3, 23, 4, 24, 5}}, 

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

(Original Answer)

f=With[{dupPos=Replace[(PositionIndex[#]//Values),{x_,y___}:>y,2]},
       {repList=(Complement[Range@Length@#,#])[[;;Length@dupPos]]},
       ReplacePart[#,Thread[dupPos->repList]]
      ]&;

Examples

    {#->f@#}&/@{list,listp,listg,listx}

    (* {

       {{1, 1, 1, 5, 3, 2, 2} -> {1, 4, 6, 5, 3, 2, 7}}, 

       {{1, 2, 4, 4, 6, 7, 8, 8} -> {1, 2, 4, 3, 6, 7, 8, 5}},
 
       {{1, 1, 1, 5, 3, 999, 2} -> {1, 4, 6, 5, 3, 999, 2}}, 

       {{20, 20, 21, 21, 22, 22, 23, 23, 24, 24} ->{20, 1, 21, 2, 22, 3, 23, 4, 24, 5}}

       } *)

Lists

listp = {1, 2, 4, 4, 6, 7, 8, 8};
listg={1, 1, 1, 5, 3, 999, 2};
list = {1, 1, 1, 5, 3, 2, 2};
listx=Riffle[Range[20,24],Range[20,24]];
$\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.