Ответ 1
Проблема с вашим текущим алгоритмом заключается в том, что вы пытаетесь перетасовать свой путь из мертвых концов - в частности, когда массивы @letters и @numbers (после первоначального тасования @numbers) дают одну и ту же ячейку больше чем единожды. Этот подход работает, когда матрица мала, потому что не слишком много попыток найти жизнеспособный перетасовать. Тем не менее, это убийца, когда списки большие. Даже если вы могли бы охотиться за альтернативами более эффективно - например, пытаясь перестановки, а не случайные перетасовки - подход, вероятно, обречен.
Вместо того, чтобы перетасовывать целые списки, вы можете решить эту проблему, внеся небольшие изменения в существующую матрицу.
Например, начните с вашей примерной матрицы (назовите ее M1). Случайно выберите одну ячейку для изменения (скажем, A1). На этом этапе матрица находится в незаконном состоянии. Наша цель будет заключаться в том, чтобы исправить ее в минимальном количестве исправлений - в частности, еще 3 изменения. Вы реализуете эти 3 дополнительных редактирования путем "ходьбы" вокруг матрицы, каждый ремонт строки или столбца дает другую проблему, которая будет решена, пока вы не пройдете полный круг (err... полный прямоугольник).
Например, после изменения A1 от 0 до 1 существует 3 способа перехода для следующего ремонта: A3, B1 и C1. Позвольте решить, что первое редактирование должно исправить строки. Итак, мы выбираем A3. Во втором редактировании мы исправим столбец, поэтому у нас есть выбор: 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;
}
}