# Changing the repeated number on a list

How do I change the repeated numbers in a list randomly such that the numbers are no longer repetitive? I have my list to be A={{3, 1}, {4, 1, 2}, {1, 4, 5}}. Here there are three 1's and and two 4's. I want one of 1's in the list to remain as 1 and the others to be changed into 2 and 3. The other numbers will change as well depending on the number smaller than it .

Example of outputs are A = {{5, 1}, {6, 2, 4}, {3, 7, 8}} or A = {{5, 3}, {6, 1, 4}, {2, 7, 8}} or A = {{5, 3}, {7, 2, 4}, {1, 6, 8}} and so on.

Right now the coding that I have is TakeList[Ordering@Ordering@Flatten@A, Length /@ A] (from this related Q/A) and the output for this is {{5, 1}, {6, 2, 4}, {3, 8, 7}}, but this coding chooses to remain the first repeated number and changes the others. Can I know if there is a way to change this so that it randomly remains one of the other repeated numbers and not only the first one?

• Before applying your function, you can reorder the list randomly, apply your function and reorder the result again. You can use order1=RandomSample@Range@Length@A to get a random order and A[[order1]] to reorder your input list and result[[Ordering@order1]] to reorder your result. Apr 1, 2021 at 18:39
• If you have {1, 1, 2} as a start shouldn't a possible outcome be {1, 3, 2}? Or should that 2 at the end of list automatically get turned into a 3? Apr 1, 2021 at 21:17

To assign random order-preserving numbers to identical elements, a simple modification of the method in OP is sufficient: add a small random number to each element in the input list and take the rankings:

ClearAll[rankings, jitter, randomizedrankings]

rankings = Ordering @* Ordering @* Flatten;

jitter[a_] :=  RandomReal[Min @ Differences[Union@Flatten@a]/10.] + # & /@ Flatten[a]

randomizedrankings = rankings @* jitter


Examples:

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

TakeList[rankings @ A, Length /@ A]

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

SeedRandom[1]
TakeList[randomizedrankings @ A, Length /@ A]

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

SeedRandom[77]
TakeList[randomizedrankings @ A, Length /@ A]

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


Update: To deal with input lists with arbitrary nesting structure, use InternalCopyListStructure instead of TakeList:

unFlatten = InternalCopyListStructure;


Examples:

SeedRandom[1]
unFlatten[A, randomizedrankings @ A]

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

SeedRandom[77]
unFlatten[A, randomizedrankings @ A]

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


Using the example list form MikeY's answer:

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

SeedRandom[1]
unFlatten[list, randomizedrankings @ list]

 {6, 7, 12, 1, 8, 10, {13, 3}, {11, 9, {2, 5, 4}}}


More verbose, but tolerates more deeply nested lists, and lists with big gap in numbers.

Two functions, a helper function that replaces a repeated digit with climbing list, starting at the digit's value.

replaceDigits[list_, n_] := Module[
{
cnt = Count[Flatten@list, n],
idx = 1,
rnge
},
rnge = Range[n, n + cnt - 1] // RandomSample;

list  /. n :> rnge[[idx++]]
];


and the main function that walks through the list.

Funk[list_] := Module[{idx = Min@list,
workingList = list},

While[idx <= Max@workingList,
workingList = replaceDigits[workingList, idx];
idx++
];
workingList
];


Try it, deep nesting:

list = {1, 2, 3, 1, 2, 3, {5, 1}, {3, 2, {1, 1, 1}}};
Funk[list];

(* {11, 9, 7, 6, 4, 5, {8, 10}, {12, 2, {3, 13, 1}}} *)


Big gaps:

A = {{3, 1}, {4, 1, 2}, {1, 4, 500}};
Funk[A];

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