Changing the repeated number on a list

Question

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?

Answer 1

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 Internal`CopyListStructure instead of TakeList:

unFlatten = Internal`CopyListStructure;

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

Answer 2

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