4
$\begingroup$

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?

$\endgroup$
2
  • 1
    $\begingroup$ 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. $\endgroup$
    – Ben Izd
    Apr 1, 2021 at 18:39
  • $\begingroup$ 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? $\endgroup$
    – MikeY
    Apr 1, 2021 at 21:17

2 Answers 2

6
$\begingroup$

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}}}
$\endgroup$
4
$\begingroup$

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}} *)
$\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.