4

我对 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

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

0 1 1 0 1 1

  • 第一个轨道（一个序列）以索引1开始，以索引2结束
  • 第二个轨道（一个序列）以索引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 中我可以使用哪些好的数据结构和/或库来解决这个问题？

4

3 回答 3

2

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

将问题拆分为子问题：

  1. 阈值：取决于您存储输入的方式，这可以像在 $n$ 维矩阵上的迭代一样简单，或者如果您的矩阵是稀疏的，则可以进行树/列表遍历。这是容易的一点。

  2. 寻找连续片段的算法称为“游程编码”。它需要一个可能重复的序列，如 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“融合”，以避免对输入进行两次迭代。

于 2012-09-12T21:13:41.437 回答
1

这似乎做你想做的事。我以您建议的形式表示了数据，因为理想的形式完全取决于您要对结果做什么

它的工作原理是从每一列计算 0 和 1 的列表，在每一端添加零的障碍值（列表$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
于 2012-09-12T22:34:19.447 回答
1

为 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;
...;

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

于 2012-09-12T23:09:58.763 回答