Проблема с вашим текущим алгоритмом заключается в том, что вы пытаетесь перетасовать свой путь из тупиковых ситуаций, в частности, когда ваши массивы @letters и @numbers (после начального перемешивания @numbers) дают одну и ту же ячейку больше чем единожды. Этот подход работает, когда матрица мала, потому что не требуется слишком много попыток найти подходящую перестановку. Тем не менее, это убийца, когда списки большие. Даже если бы вы могли более эффективно искать альтернативы - например, пытаясь перестановок, а не случайных перемешиваний - такой подход, вероятно, обречен.
Вместо того, чтобы перетасовывать целые списки, вы можете решить эту проблему, внеся небольшие изменения в существующую матрицу.
Например, давайте начнем с вашего примера матрицы (назовите ее M1). Случайно выберите одну ячейку для изменения (скажем, A1). На данный момент матрица находится в недопустимом состоянии. Наша цель состоит в том, чтобы исправить это в минимальном количестве правок - в частности, еще 3 правки. Вы реализуете эти 3 дополнительных правки, «обходя» матрицу, при этом каждый ремонт строки или столбца приводит к решению еще одной проблемы, пока вы не пройдете полный круг (ошибка ... полный прямоугольник).
Например, после изменения А1 с 0 на 1, есть 3 пути для следующего ремонта: А3, В1 и С1. Давайте решим, что первое редактирование должно исправить строки. Итак, мы выбираем А3. При втором редактировании мы исправим столбец, поэтому у нас есть выбор: B3 или C3 (скажем, C3). Окончательный ремонт предлагает только один выбор (C1), потому что нам нужно вернуться к столбцу нашего исходного редактирования. Конечный результат - новая действительная матрица.
Orig Change A1 Change A3 Change C3 Change C1
M1 M2
1 2 3 1 2 3 1 2 3 1 2 3 1 2 3
----- ----- ----- ----- -----
A | 0 0 1 1 0 1 1 0 0 1 0 0 1 0 0
B | 1 1 0 1 1 0 1 1 0 1 1 0 1 1 0
C | 1 0 0 1 0 0 1 0 0 1 0 1 0 0 1
Если путь редактирования ведет в тупик, вы возвращаетесь. Если все пути восстановления не пройдены, первоначальное редактирование может быть отклонено.
Этот подход будет быстро генерировать новые действительные матрицы. Это не обязательно приведет к случайным результатам: M1 и M2 будут по-прежнему тесно связаны друг с другом, и эта точка станет более очевидной при увеличении размера матрицы.
Как вы увеличиваете случайность? Вы упомянули, что большинство ячеек (99% и более) - это нули. Одна идея состояла бы в следующем: для каждого 1 в матрице установите его значение равным 0, а затем восстановите матрицу, используя метод 4-edit, описанный выше. По сути, вы будете перемещать все из них в новые случайные места.
Вот иллюстрация. Возможно, здесь есть дальнейшая оптимизация скорости, но этот подход позволил получить 10 новых матриц 600x600 с плотностью 0,5% за 30 секунд на моем компьютере с Windows. Не знаю, достаточно ли это быстро.
use strict;
use warnings;
# Args: N rows, N columns, density, N iterations.
main(@ARGV);
sub main {
my $n_iter = pop;
my $matrix = init_matrix(@_);
print_matrix($matrix);
for my $n (1 .. $n_iter){
warn $n, "\n"; # Show progress.
edit_matrix($matrix);
print_matrix($matrix);
}
}
sub init_matrix {
# Generate initial matrix, given N of rows, N of cols, and density.
my ($rows, $cols, $density) = @_;
my @matrix;
for my $r (1 .. $rows){
push @matrix, [ map { rand() < $density ? 1 : 0 } 1 .. $cols ];
}
return \@matrix;
}
sub print_matrix {
# Dump out a matrix for checking.
my $matrix = shift;
print "\n";
for my $row (@$matrix){
my @vals = map { $_ ? 1 : ''} @$row;
print join("\t", @vals), "\n";
}
}
sub edit_matrix {
# Takes a matrix and moves all of the non-empty cells somewhere else.
my $matrix = shift;
my $move_these = cells_to_move($matrix);
for my $cell (@$move_these){
my ($i, $j) = @$cell;
# Move the cell, provided that the cell hasn't been moved
# already and the subsequent edits don't lead to a dead end.
$matrix->[$i][$j] = 0
if $matrix->[$i][$j]
and other_edits($matrix, $cell, 0, $j);
}
}
sub cells_to_move {
# Returns a list of non-empty cells.
my $matrix = shift;
my $i = -1;
my @cells = ();
for my $row (@$matrix){
$i ++;
for my $j (0 .. @$row - 1){
push @cells, [$i, $j] if $matrix->[$i][$j];
}
}
return \@cells;
}
sub other_edits {
my ($matrix, $cell, $step, $last_j) = @_;
# We have succeeded if we've already made 3 edits.
$step ++;
return 1 if $step > 3;
# Determine the roster of next edits to fix the row or
# column total upset by our prior edit.
my ($i, $j) = @$cell;
my @fixes;
if ($step == 1){
@fixes =
map { [$i, $_] }
grep { $_ != $j and not $matrix->[$i][$_] }
0 .. @{$matrix->[0]} - 1
;
shuffle(\@fixes);
}
elsif ($step == 2) {
@fixes =
map { [$_, $j] }
grep { $_ != $i and $matrix->[$_][$j] }
0 .. @$matrix - 1
;
shuffle(\@fixes);
}
else {
# On the last edit, the column of the fix must be
# the same as the column of the initial edit.
@fixes = ([$i, $last_j]) unless $matrix->[$i][$last_j];
}
for my $f (@fixes){
# If all subsequent fixes succeed, we are golden: make
# the current fix and return true.
if ( other_edits($matrix, [@$f], $step, $last_j) ){
$matrix->[$f->[0]][$f->[1]] = $step == 2 ? 0 : 1;
return 1;
}
}
# Failure if we get here.
return;
}
sub shuffle {
my $array = shift;
my $i = scalar(@$array);
my $j;
for (@$array ){
$i --;
$j = int rand($i + 1);
@$array[$i, $j] = @$array[$j, $i] unless $i == $j;
}
}