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.

Improve this question
$\endgroup$
3
  • $\begingroup$ How is this different than mathematica.stackexchange.com/questions/288861/… ? $\endgroup$ Commented 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$ Commented 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$ Commented Aug 19, 2023 at 15:19

6 Answers 6

Reset to default
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]]
Improve this answer
$\endgroup$
2
  • $\begingroup$ Try it with ` {1, 1, 1, 5, 3, 999, 2}` (Question 2) $\endgroup$ Commented Aug 19, 2023 at 11:34
  • $\begingroup$ Sorry about that. I have updated the answer. Please check. Thanks. $\endgroup$ Commented 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} *)
Improve this answer
$\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".

Improve this answer
$\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}*)
Improve this answer
$\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

Improve this answer
$\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]];
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.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.