在 Perl 中识别矩阵中的子数组答案

【问题标题】：Identifying subarrays in matrices in Perl在 Perl 中识别矩阵中的子数组
【发布时间】：2012-10-05 17:28:50
【问题描述】：

我对 Perl 比较陌生，需要进行相对复杂的矩阵计算，不知道要使用什么数据结构。

不确定这是否是合适的论坛，但假设您在 Perl 的多维数组中有以下矩阵：

0.2    0.7    0.2 
0.6    0.8    0.7
0.6    0.1    0.8
0.1    0.2    0.9
0.6    0.3    0.0
0.6    0.9    0.2

我正在尝试识别此矩阵中对应于高于给定阈值的连续值的列段，例如0.5

例如，如果我们对这个矩阵设置阈值，我们有：

0    1    0 
1    1    1
1    0    1
0    0    1
1    0    0
1    1    0

如果我们现在关注第一列：

我们可以看到有两个连续的段：

0 1 1 0 1 1

第一个 track（一个序列）以索引 1 开始，以索引 2 结束
第二个 track（一个序列）以索引 4 开始，以索引 5 结束

我想检测原始矩阵中的所有此类轨迹，但我不知道如何进行或哪种 Perl 数据结构最适合此。

理想情况下，我想要一些易于索引的东西，例如假设我们使用变量tracks，我可以将第一列（索引0）的索引存储如下：

# First column, first track
$tracks{0}{0}{'start'} = 1; 
$tracks{0}{0}{'end'}   = 2;

# First column, second track
$tracks{0}{1}{'start'} = 4; 
$tracks{0}{1}{'end'}   = 5;

# ...

在 Perl 中我可以使用哪些好的数据结构和/或库来解决这个问题？

【问题讨论】：

你考虑过 PDL 库吗？
谢谢！ @soulSurfer2010 这是一个好主意，虽然我更喜欢使用标准 Perl 来做到这一点。
为什么要重新发明轮子？如果您觉得 PDL 太复杂，CPAN 上还有各种其他与矩阵相关的模块。
根据我的阅读，我会选择 PDL，相信我，但我不是系统管理员，让他们在系统中安装任何东西并不容易。我刚刚检查了我是否使用use PDL;，但编译器抱怨
安装和使用 Perl 模块不需要系统管理员的许可（除非你真的接近磁盘配额） -- stackoverflow.com/q/251705/168657

标签： perl matrix

【解决方案1】：

我只是给出算法答案，你可以用任何你喜欢的语言来编码。

将问题分解为子问题：

阈值：取决于您存储输入的方式，这可以像在 $n$ 维矩阵上的迭代一样简单，或者如果您的矩阵是稀疏的，则可以遍历树/列表。这是简单的一点。
查找连续片段的算法称为“游程编码”。它需要一个可能重复的序列，例如 1 0 0 1 1 1 1 0 1 并返回另一个序列，该序列告诉您下一个元素是什么，以及其中有多少。因此，例如上面的序列将是 1 1 0 2 1 4 0 1 1 1。编码是唯一的，所以如果你想反转它，你可以。

第一个 1 存在是因为原始输入以 1 开头，第一个 0 存在是因为 1 之后有一个 0，第四个数字是 2 因为有两个连续的零。如果你不想自己做，有无数的 rle-encoders。它的主要目的是压缩，如果你有大量相同的项目，它可以很好地实现这一目的。根据您的需要，您可能需要水平、垂直甚至对角运行它。

您可以在所有有关数据结构和算法的经典书籍中找到精确的算法。我建议先介绍 Cormen-Leiseron-Rivest-Stein：“算法简介”，然后是 Knuth。

一旦掌握了要点，您就可以安全地将阈值与 RLE“融合”，以避免对输入进行两次迭代。

【讨论】：

确实没有。 Perl 最初将被称为 Pearl，但被发现与现有的名为 PEARL 的语言发生冲突，因此将其重命名为 Perl。想想宝石，而不是你可能听说过的。无论如何，谁会因为它的名字的含义而拒绝一种语言？你应该好好尝试一下，然后自己决定。忽略反 Perl 的偏执 - 没有必要对编程语言产生偏见

【解决方案2】：

这似乎可以满足您的需求。我已经以您建议的形式表示了数据，因为理想的形式完全取决于您要对结果做什么

它的工作原理是从每一列计算 0 和 1 的列表，在每一端添加 barrier 值零（$prev 中一个，for 列表中一个），然后扫描1 到 0 之间变化的列表

每次发现更改时，都会记录轨道开始或结束。如果$start 未定义，则当前索引记录为段的开始，否则当前段以比当前索引小一结束。使用 start 和 end 键构建哈希，并推送到 @segments 数组。

最后一组嵌套循环以您在问题中显示的形式转储计算数据

use strict;
use warnings;

use constant THRESHOLD => 0.5;

my @data = (
  [ qw/ 0.2    0.7    0.2 / ],
  [ qw/ 0.6    0.8    0.7 / ],
  [ qw/ 0.6    0.1    0.8 / ],
  [ qw/ 0.1    0.2    0.9 / ],
  [ qw/ 0.6    0.3    0.0 / ],
  [ qw/ 0.6    0.9    0.2 / ],
);

my @tracks;

for my $colno (0 .. $#{$data[0]}) {

  my @segments;
  my $start;
  my $prev = 0;
  my $i = 0;

  for my $val ( (map { $_->[$colno] > THRESHOLD ? 1 : 0 } @data), 0 ) {
    next if $val == $prev;
    if (defined $start) {
      push @segments, { start => $start, end=> $i-1 };
      undef $start;
    }
    else {
      $start = $i;
    }
  }
  continue {
    $prev = $val;
    $i++;
  }

  push @tracks, \@segments;
}

# Dump the derived @tracks data
#
for my $colno (0 .. $#tracks) {
  my $col = $tracks[$colno];
  for my $track (0 .. $#$col) {
    my $data = $col->[$track];
    printf "\$tracks[%d][%d]{start} = %d\n", $colno, $track, $data->{start};
    printf "\$tracks[%d][%d]{end} = %d\n", $colno, $track, $data->{end};
  }
  print "\n";
}

输出

$tracks[0][0]{start} = 1
$tracks[0][0]{end} = 2
$tracks[0][1]{start} = 4
$tracks[0][1]{end} = 5

$tracks[1][0]{start} = 0
$tracks[1][0]{end} = 1
$tracks[1][1]{start} = 5
$tracks[1][1]{end} = 5

$tracks[2][0]{start} = 1
$tracks[2][0]{end} = 3

【讨论】：

【解决方案3】：

对 Perl 对多维数组的糟糕支持感到遗憾，我很快发现自己正在拼凑自己的一个小解决方案。该算法与 Borodins 的思想颇为相似，但结构略有不同：

sub tracks {
  my ($data) = @_; # this sub takes a callback as argument
  my @tracks;      # holds all found ranges
  my @state;       # is true if we are inside a range/track. Also holds the starting index of the current range.
  my $rowNo = 0;   # current row number
  while (my @row = $data->()) { # fetch new data
    for my $i (0..$#row) {
      if (not $state[$i] and $row[$i]) {
        # a new track is found
        $state[$i] = $rowNo+1; # we have to pass $rowNo+1 to ensure a true value
      } elsif ($state[$i] and not $row[$i]) {
        push @{$tracks[$i]}, [$state[$i]-1, $rowNo-1]; # push a found track into the @tracks array. We have to adjust the values to revert the previous adjustment.
        $state[$i] = 0; # reset state to false
      }
    }
  } continue {$rowNo++}
  # flush remaining tracks
  for my $i (0..$#state) {
    push @{$tracks[$i]}, [$state[$i]-1, $rowNo-1] if $state[$i]
  }
  return @tracks;
}

@state 兼作指示我们是否在轨道内的标志和轨道起始索引的记录。在 state 和 tracking 数组中，索引表示当前列。

作为数据源，我使用了一个外部文件，但这可以很容易地插入任何东西，例如一个预先存在的数组。唯一的约定是，当没有更多数据可用时，它必须返回任意序列的真假值和空列表。

my $limit = 0.5
my $data_source = sub {
  defined (my $line = <>) or return (); # return empty list when data is empty
  chomp $line;
  return map {$_ >= $limit ? $_ : 0} split /\s+/, $line; # split the line and map the data to true and false values
};

将您复制粘贴的数据作为输入，我得到以下打印输出（省略打印代码）：

[ [1 2], [4 5] ]
[ [0 1], [5 5] ]
[ [1 3] ]

根据你的结构，这将是

$tracks[0][0][0] = 1;
$tracks[0][0][1] = 2;

$tracks[0][1][0] = 4;
...;

如果将其修改为哈希，则可以合并更多数据，例如原始值。

【讨论】：