Question

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

第一个曲目（一系列的序列）以索引 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中，我可以使用哪些好的数据结构和/或库来解决这个问题？

Answer 1

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

将问题拆分为子问题：

阈值处理：根据您存储输入的方式，这可以像对$ n $维矩阵的迭代一样简单，如果矩阵稀疏则可以是树/列表遍历。这很容易。
查找连续段的算法称为“游程编码”。它需要一个可能重复的序列，如 1 0 0 1 1 1 1 0 1并返回另一个序列，告诉您下一个元素，以及它们中有多少元素。所以例如上面的序列将是1 1 0 2 1 4 0 1 1 1.编码是唯一的，所以如果你想要反转它你就可以了。

第一个是因为原始输入以1开始，并且第一个0在那里，因为在1之后存在0，第四个数字是2，因为有两个连续的零。如果您不想自己做，那就有数以万计的编码器。它的主要目的是压缩，如果你有很长的相同项目，它可以很好地用于此目的。根据您的需要，您可能需要水平，垂直甚至对角地运行它。

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

一旦掌握了要点，就可以安全地将阈值与RLE“融合”，以避免在输入上重复两次。

Answer 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

Answer 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和tracks数组中，索引表示当前列。

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

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

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

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

3 个答案: