Эффективные и условные кортежи или подмножества

Question

Отступая от следующего вопроса:

Выбор с помощью дел

Мне нужно создать случайный набор (1 000 000 единиц будет достаточно)

Subsets[Flatten[ParallelTable[{i, j}, {i, 1, 96}, {j, 1, 4}], 1], {4}]

Далее, мне нужно отклонить любые четверки с неуникальными первыми элементами, такими как {{1,1},{1,2},{2,3},{6,1}}.

Но вышеописанное невозможно на ноутбуке.Как я мог просто рисовать равномерно один миллион комплектов, не убивая мою машину?

Answer 1

При условии, что у вас есть базовый набор, который вам необходим для генерации 4-элементных подмножеств,

baseSet = Flatten[Table[{i, j}, {i, 1, 96}, {j, 1, 4}], 1];

вы можете использовать RandomSample следующим образом:

RandomSample[baseSet, 4]

Это дает вамдлина 4 случайное подмножество baseSet.Генерация миллиона из них занимает 2,5 секунды на моей очень старой машине:

Timing[subsets = Table[RandomSample[baseSet, 4], {1000000}];]

Не все из того, что мы получаем, будут разными подмножествами, поэтому нам нужно удалить дубликаты, используя Union:

subsets = Union[subsets];

После этого у меня все еще остается 999 971 элемент в пробном прогоне благодаря гораздо большему числу возможных подмножеств (Binomial[Length[baseSet], 4] == 891 881 376)

Answer 2

Это также должно сработать, и оно работает быстрее, чем предложение Сабольча.

(t=Table[{RandomInteger[{1, 96}], RandomInteger[{1, 4}]}, {10^6}, {4}]); //Timing

Я не видел необходимости удалять дублирующиеся подмножества, так как мы производим выборку, а не пытаемся создать всю совокупность.(Но вы можете легко удалить дубликаты, если хотите.)

Кстати, в этом случае Table работает быстрее, чем ParallelTable.

Answer 3

Я полагаю, что небольшое изменение метода Дэвида даст форму без дубликатов, запрошенную в оригинальном сообщении.

set = 
  With[{r = Range@96},
    {RandomSample[r, 4], RandomInteger[{1, 4}, 4]}\[Transpose] ~Table~ {1*^6}
  ];

Это, конечно, не дает 10 ^ 6 уникальных образцов, но Сабольч показал, как это можно сделать, и цена не велика.