# Replace duplicate list values with unique elements

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"];


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

• How is this different than mathematica.stackexchange.com/questions/288861/… ? Aug 19, 2023 at 14:47
• 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.
– eldo
Aug 19, 2023 at 15:05
• 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. Aug 19, 2023 at 15:19

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]]


• Try it with  {1, 1, 1, 5, 3, 999, 2} (Question 2)
– eldo
Aug 19, 2023 at 11:34
– Syed
Aug 19, 2023 at 11:56

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


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

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


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

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



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


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]];
`