0

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個の三角形が見つかりました」と出力します。

たとえば、この場合、プログラムが最初の行と2番目の行を比較し、「リンク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、命令の上限にあると思います（しかし、理由はわかりません）。

2番目の問題は、私が探している三角形の正しい数がカウントされないことです...何か助けはありますか？

4

3 に答える 3

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] }) {
于 2013-03-04T14:41:23.977 に答える
1

このプログラムはあなたが必要とすることをします。さらに、三角形が見つかったときに、各三角形の3つの角を印刷します。

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の2つの三角形しかありません。アルゴリズムに従うと、このプログラムは、角が異なる順序で三角形を複数回カウントします。それぞれの異なる三角形を1回だけカウントするには、線を変更します

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
于 2013-03-04T15:34:24.280 に答える
0

この質問には2つの部分があります。

  • 2つの行の間にリンクが存在するかどうかを確認します
  • 彼らが共有する「ユニークな」数の合計を確立する

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;
}
于 2013-03-04T15:18:16.880 に答える