perl - 文件排对抗

Question

我有以下问题：来自file.dat具有以下格式化数据的文件 ( )

1 2 3 4
2 1 3 4 5
3 1 2
4 1 2
5 2 6 7
6 5 8
7 5 8
8 6 7 9
9 8

我想找到：

1. 如果一行的第一个元素出现在其他行中，并且后续行的第一个元素出现在考试中的行中；
2. 如果它存在，那么我想打印“我找到了链接 xy ”；
3. 如果“链接”存在，那么我想计算考试行中的其他元素出现在链接所在行中的次数并打印“我找到了 z 个三角形”。

例如在这种情况下，当程序比较第一行和第二行并发现“链接 1 2 ”存在然后还写“我找到 2 个三角形”（因为在每一行中都有数字 3 和 4） .

为此，我尝试编写以下程序：

use strict;
use warnings;
use diagnostics;
use Data::Dumper;

############ DATA ABSORTION

my $file = 'file.dat';
open my $fh, "<", $file or die "Cannot open $file: $!";

############ COLLECT THE DATAS IN A VECTOR as vector[i][j]

my @vector;

while (<$fh>) {

push @vector, [ split ];

}

############ START THE RESEARCH OF THE LINKS AND TRIANGLES BY MEANS OF FOR LOOPS

my @link;
my $triangles;

for (my $i=0 ; $i < scalar @vector; $i++){

$triangles=0;

for(my $j=0; $j < scalar @vector; $j++){

    for (my $k=$i+1; $k < scalar @vector; $k++){        

        for(my $l=0; $l < scalar @vector; $l++){

            if($vector[$i][0]==$vector[$k][$l] && $vector[$i][$j]==$vector[$k][0] && $l != 0 && $j != 0) {

                 @link=($vector[$i][0],$vector[$k][0]);

            print "I found the link @link\n";

                if($vector[$i][$j]==$vector[$k][$l] && $l != 0 && $j != 0 && $i != $k){

                $triangles++;


                }
            print "The number of triangles is $triangles\n\n";              
            }

        }
    }
  }
}

该程序打印正确数量的链接，但我发现如果行数低于文件中的列数，则程序不会读取整行，这可能是我的链接研究的问题。我认为问题出scalar @vector在 for 指令的上限（但我不明白为什么）。

第二个问题是它不计算我正在寻找的正确数量的三角形......有什么帮助吗？

Answer 1

[只回答第一个问题]

$j并$l假设迭代列索引，但你计算行数。正确的循环是：

for my $i (0 .. $#vector-1) {
for my $j (0 .. $#{ $vector[$i] }) {
for my $k ($i+1 .. $#vector) {
for my $l (0 .. $#{ $vector[$k] }) {

Answer 2

该程序可以满足您的要求。此外，当找到一个三角形时，它会打印每个三角形的三个角。

use strict;
use warnings;
use 5.010;

my $filename = 'file.dat';
open my $fh, '<', $filename or die qq{Cannot open "$filename": $!};

my %vector;
while (<$fh>) {
  my @fields = split;
  my $root = shift @fields;
  $vector{$root} = { map { $_ => 1} @fields };
}
my @roots = sort { $a <=> $b } keys %vector;

for my $i (0 .. $#roots) {
  my $aa = $roots[$i];
  for my $j ($i + 1 .. $#roots) {
    my $bb = $roots[$j];
    next unless $vector{$aa}{$bb} and $vector{$bb}{$aa};

    say "I found the link $aa $bb";

    my $triangles = 0;
    for my $cc ( keys %{$vector{$aa}} ) {
      next if $cc == $aa or $cc == $bb;
      if ($vector{$bb}{$cc}) {
        say "Triangle $aa - $bb - $cc";
        $triangles++;
      }
    }
    say "I have found $triangles triangle". ($triangles == 1 ? '' : 's');
    print "\n";

  }
}

您显示的数据中只有两个三角形：1-2-3 和 1-2-4。遵循您的算法会导致该程序不止一次地计算三角形，角的顺序不同。要仅计算每个不同的三角形一次，请更改行

next if $cc == $aa or $cc == $bb;

至

next if $cc <= $aa or $cc <= $bb;

输出

I found the link 1 2
Triangle 1 - 2 - 4
Triangle 1 - 2 - 3
I have found 2 triangles

I found the link 1 3
Triangle 1 - 3 - 2
I have found 1 triangle

I found the link 1 4
Triangle 1 - 4 - 2
I have found 1 triangle

I found the link 2 3
Triangle 2 - 3 - 1
I have found 1 triangle

I found the link 2 4
Triangle 2 - 4 - 1
I have found 1 triangle

I found the link 2 5
I have found 0 triangles

I found the link 5 6
I have found 0 triangles

I found the link 5 7
I have found 0 triangles

I found the link 6 8
I have found 0 triangles

I found the link 7 8
I have found 0 triangles

I found the link 8 9
I have found 0 triangles

Answer 3

这个问题有两个部分：

• 确定两行之间是否存在链接
• 确定他们共有的“独特”总数

---

使用 AoA 很好，但使用 HoH 会让生活更轻松：

my %links;

while ( <$fh> ) {

    chomp;
    my ( $from, @to ) = split;

    $links{$from}{$_}++ for @to;
}

然后，您可以检查链接是否存在：

print "Link $from $to\n" if exists $links{$from} && exists $links{$from}{$to};

找到共同的“三角形”也应该很容易：

use List::MoreUtils 'uniq';

sub get_triangles {

    my ( $from, $to ) = @_;

    for ( $from, $to ) {  # Bail out if link doesn't exist
        warn( "'$_' does not exist"), return unless exists $links{$_};
    }

    my @triangles = map {  exists $links{$from}  &&  exists $links{$to} }
                    uniq( values %{$links{$from}}, values %{$links{to}} );

    return @triangles;
}