1

次のデータを検討してください。

12 45 64  
12 45 76  
12 37 39 87
12 67 90  
12 39 60

この例では、10 個の異なる数字しかありません。大量のデータがある場合、Perl でどのように計算できますか?

12 から 45、45 から 64 へのリンクがありますが、12 から 64 へのリンクはありません。

45 から 12 へのルートがないため、12 の近傍は 4 (45, 37, 67, 39) であり、39 の場合は 2 (87, 60) です。

このデータのすべての値の近傍をカウントするにはどうすればよいですか?

編集

もう 1 つの要件は、それ自体に向けられた値を無視することです。たとえば、次のファイルがあるとします。

1 4 3
1 2 2
2 6 7

この例では、1 の近傍は (4, 2) でなければなりません。

4 の近傍は 3 でなければなりません

2 の近傍は 6 でなければなりません (2 ではありません)

つまり、一致と繰り返しを削除する必要があります。

4

4 に答える 4

3 
my $data = <<'END_DATA';
12 45 64 
12 45 76 
12 37 39 87 
12 67 90 
12 39 60
END_DATA

my @lines = split/\n+/, $data;

# map number the list of numbers following it in the sequence 
my %neighborhoods = (); 
for my $line ( @lines ) { 
    my @nums = split m/\s+/,$line;
    for my $i ( 0 .. $#nums - 1 ) { 
        $neighborhoods{$nums[$i]}{$nums[$i+1]} = 1; 
    }
} 

foreach my $num ( sort keys %neighborhoods ) { 
   print "num [$num] neighboorhood (" . 
         ( join "-", keys %{$neighborhoods{$num}} ) . 
         ") count [" . ( scalar keys %{$neighborhoods{$num}} ) . 
         "]\n"; 
}

出力：

num [12] neighboorhood (67-39-37-45) count [4]   
num [37] neighboorhood (39) count [1]
num [39] neighboorhood (60-87) count [2]
num [45] neighboorhood (64-76) count [2]
num [67] neighboorhood (90) count [1]
于 2012-12-15T22:01:02.120 に答える
3

Graph::Directedモジュールの使用:

use Graph::Directed qw( );

my $graph = Graph::Directed->new();
while (<>) {
   my @points = split;
   $graph->add_edge(@points[$_-1, $_])
      for 1..$#points;
}

for my $vertex ($graph->vertices()) {
   my @successors = grep $_ != $vertex, $graph->successors($vertex);
   print("$vertex has ".@successors." successors: @successors\n");
}

入力：

1 4 3
1 2 2
2 6 7

出力：

6 has 1 successors: 7
4 has 1 successors: 3
2 has 1 successors: 6
1 has 2 successors: 4 2
3 has 0 successors:
7 has 0 successors:
于 2012-12-15T22:21:06.067 に答える
3

私があなたを正しく理解していれば、グラフ上のすべてのノードの近傍にあるノードの数を数えたいと考えています。これはあなたが望むことだと思います。

ノードからノード自体へのベクトルは無視する必要があると説明したので、コードを変更しました。

use v5.10;
use warnings;

my %routes;

while (<DATA>) {
  my @nodes = /\d+/g;
  $routes{$_} //= {} for @nodes;
  while (@nodes >= 2) {
    my ($from, $to) = @nodes;
    $routes{$from}{$to}++ unless $from == $to;
    shift @nodes;
  }
}

for my $key (sort { $a <=> $b } keys %routes) {
  my $val = $routes{$key};
  printf "%d - neighbourhood size %d",
      $key,
      scalar keys %$val;
  printf " (%s)", join ', ', keys %$val if %$val;
  print "\n";
}

__DATA__
12 45 64  
12 45 76  
12 37 39 87  
12 67 90  
12 39 60
1 4 3
1 2 2
2 6 7

出力

1 - neighbourhood size 2 (4, 2)
2 - neighbourhood size 1 (6)
3 - neighbourhood size 0
4 - neighbourhood size 1 (3)
6 - neighbourhood size 1 (7)
7 - neighbourhood size 0
12 - neighbourhood size 4 (67, 39, 37, 45)
37 - neighbourhood size 1 (39)
39 - neighbourhood size 2 (60, 87)
45 - neighbourhood size 2 (64, 76)
60 - neighbourhood size 0
64 - neighbourhood size 0
67 - neighbourhood size 1 (90)
76 - neighbourhood size 0
87 - neighbourhood size 0
90 - neighbourhood size 0
于 2012-12-15T22:08:54.377 に答える
0

別のオプションは次のとおりです。

use strict;
use warnings;

my ( %hash, %seen );

while (<DATA>) {
    my @nums = split;

    for my $i ( 0 .. $#nums - 1 ) {
        push @{ $hash{ $nums[$i] } }, $nums[ $i + 1 ]
          if !$seen{ $nums[$i] }{ $nums[ $i + 1 ] }++;
    }
}

for my $num ( sort { $a <=> $b } keys %hash ) {
    print "$num has " . @{ $hash{$num} } . " neighbor(s): @{$hash{$num}}\n";
}

__DATA__
12 45 64  
12 45 76  
12 37 39 87
12 67 90  
12 39 60

出力：

12 has 4 neighbor(s): 45 37 67 39
37 has 1 neighbor(s): 39
39 has 2 neighbor(s): 87 60
45 has 2 neighbor(s): 64 76
67 has 1 neighbor(s): 90
于 2012-12-15T23:36:21.950 に答える