在perl中随机化矩阵,保持行和列总数相同

Question

我有一个矩阵,我想随机化几千次,同时保持行和列总数相同:

     1 2 3 
   A 0 0 1 
   B 1 1 0 
   C 1 0 0      

有效随机矩阵的一个例子是:

     1 2 3
   A 1 0 0
   B 1 1 0
   C 0 0 1

我的实际矩阵要大得多(大约600x600项),所以我真的需要一种计算效率高的方法.

我的初始(低效)方法包括使用Perl Cookbook shuffle改组数组

我在下面粘贴了我当前的代码.如果在while循环中找不到解决方案,我已经有了额外的代码来启动一个新的洗牌数字列表.该算法适用于小矩阵,但只要我开始按比例放大,就需要永远找到符合要求的随机矩阵.

有没有更有效的方法来完成我正在寻找的东西？非常感谢!

#!/usr/bin/perl -w
use strict;

my %matrix = ( 'A' => {'3'  => 1 },
           'B' => {'1'  => 1,
               '2'  => 1 },
           'C' => {'1'  => 1 }
    );

my @letters = ();
my @numbers = ();

foreach my $letter (keys %matrix){
    foreach my $number (keys %{$matrix{$letter}}){
    push (@letters, $letter);
    push (@numbers, $number);
    }
}

my %random_matrix = ();

&shuffle(\@numbers);
foreach my $letter (@letters){
    while (exists($random_matrix{$letter}{$numbers[0]})){
    &shuffle (\@numbers);
    }
    my $chosen_number = shift (@numbers);
    $random_matrix{$letter}{$chosen_number} = 1;
}

sub shuffle {
    my $array = shift;
    my $i = scalar(@$array);
    my $j;
    foreach my $item (@$array )
    {
        --$i;
        $j = int rand ($i+1);
        next if $i == $j;
        @$array [$i,$j] = @$array[$j,$i];
    }
    return @$array;
}

Answer 1

你当前算法的问题在于你试图将你的方式从死胡同中移开 - 特别是当你@letters和@numbers数组(在最初的shuffle之后@numbers)不止一次产生同一个单元格时.当矩阵很小时,这种方法很有效,因为它不需要太多的尝试来找到可行的重新洗牌.然而,当名单很大时,这是一个杀手.即使您可以更有效地寻找替代方案 - 例如,尝试排列而不是随机改组 - 这种方法可能注定失败.

您可以通过对现有矩阵进行少量修改来解决问题,而不是对整个列表进行混洗.

例如,让我们从您的示例矩阵开始(称之为M1).随机选择一个单元格进行更改(例如,A1).此时矩阵处于非法状态.我们的目标是将其修改为最少的编辑次数 - 特别是3次编辑.你通过在矩阵周围"行走"来实现这3个额外的编辑,每行修复一行或一列产生另一个问题,直到你走完整圆(错误...全矩形).

例如,在将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编辑方法修复矩阵.实际上,您将把所有这些移动到新的随机位置.

这是一个例子.这里可能还有进一步的速度优化,但这种方法在我的Windows机器上30秒左右产生了10个新的600x600矩阵,密度为0.5%.不知道那是否足够快.

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

Answer 2

第1步:首先,我将矩阵初始化为零,并计算所需的行和列总数.

第2步:现在选择一个随机行,加权必须在该行中的1的计数(因此,具有计数300的行比具有权重5的行更可能被选中).

步骤3:对于此行,选择一个随机列,按该列中的1的计数加权(除了忽略任何可能已经包含1的单元格 - 稍后将更多).

步骤4:在此单元格中放置一个并减少相应行和列的行数和列数.

步骤5:返回步骤2,直到没有行具有非零计数.

但问题是这个算法可能无法终止,因为你可能有一行你需要放一个,而一个列需要一个,但是你已经在那个单元中放了一个,所以你得到'卡住了".我不确定这种情况发生的可能性有多大,但如果频繁发生我也不会感到惊讶 - 足以让算法无法使用.如果这是一个问题,我可以想到两种方法来解决它:

a)递归地构造上述算法并允许回溯失败.

b)如果没有其他选项,则允许单元格包含大于1的值并继续运行.然后在最后你有一个正确的行和列数,但有些单元格可能包含大于1的数字.你可以通过找到如下所示的分组来解决这个问题:

2 . . . . 0
. . . . . .
. . . . . .
0 . . . . 1

并将其更改为:

1 . . . . 1
. . . . . .
. . . . . .
1 . . . . 0

如果你有很多零,应该很容易找到这样的分组.我认为b)可能会更快.

我不确定这是最好的方法,但它可能比改组阵列更快.我会跟踪这个问题,看看其他人想出了什么.