迭代程序擦除原始集合中的数据

Question

我想研究一种算法，其中给定一个数字列表，我必须计算一个系数，该系数由数据列表中建立的三角形数与最小数目有数字的邻居;例如，给定的文件的前两行：

1 2 3 4 5 6 9 
2 1 3 
... 

1. 如果一排的第一个元素出现在其它行，并且如果随后的行的第一个元素出现在该行中取入考试，那么我找到了一个链接;
2. 如果“链接”存在，那么我想指望在考试采取行中的其他元素有多少次出现在排在链路存在并打印“我已经z实测三角形”。

例如，在这种情况下，当程序比较所述第一排和第二排，并发现“链路1 2”的存在，发现有1个三角形由顶点1,2,3制成。 在算法中，我必须用每行中元素的最小数目 - 2来分割三角形的数量+ 1（在这种情况下，最小数字来自第二行，值为3-2 = 1）。我正在寻找的系数是（1 + 1）/ 1 = 2;

1 2 1 

，其中在第一两列我发现，使一个链接，然后在第三列中的系数的值的元件;：

作为输出文件将被写入

这里是我到目前为止已经编写的代码：

use strict; 
use warnings; 
use 5.010; 
use List::Util; 

my $filename = "data"; 
open my $fh, '<', $filename or die "Cannot open $filename: $!"; 

my $output_file = "output_example"; 
open my $fi, ">", $output_file or die "Error during $output_file opening: $!"; 

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]; 
    my $n_element_a = scalar (keys %{$vector{$aa}})-1; 

    for my $j ($i+1 .. $#roots) { 
     my $minimum; 
     my $bb = $roots[$j]; 
     my $n_element_b = scalar (keys %{$vector{$bb}})-1; 
     next unless $vector{$aa}{$bb} and $vector{$bb}{$aa}; 
     if ($n_element_a < $n_element_b){ 
      $minimum = $n_element_a; 
     }else { 
      $minimum = $n_element_b; 
     } 

     my $triangles = 0; 
     for my $cc (keys %{$vector{$aa}}) { 
      next if $cc == $aa or $cc == $bb; 
      if ($vector{$bb}{$cc}) { 
       $triangles++; 
      } 
     } 

     my $coeff; 
     my @minimum_list;   
     if ($minimum == 0){ 
      $coeff = ($triangles +1)/($minimum+0.00000000001); 
     } else { 
      $coeff = ($triangles +1)/($minimum); 
     } 
     say $fi "$aa $bb $coeff"; 
    } 
} 
__DATA__ 
1 2 3 4 5 6 9 
2 1 3 
3 1 2 
4 1 5 
5 1 4 
6 1 7 8 
8 6 7 
9 1 10 11 
10 9 11 12 14 
11 9 10 12 13 
12 10 13 14 
13 11 12 
14 10 12 15 
15 14 

我把整个数据集结尾。输出文件给出：

__OUTPUT__ 
1 2 2 
1 3 2 
1 4 2 
1 5 2 
1 6 0.5 
1 9 0.5 
2 3 2 
4 5 2 
6 8 2 
9 10 1 
9 11 1 
10 11 1 
10 12 1 
10 14 1 
11 13 2 
12 13 1 
12 14 1 
14 15 100000000000 

现在我想找个系数的最低值，确定目前这种低价值的链接（一个或多个），删除在原始数据集此元素上重复同样的程序“新”数据集。

例如，在这种情况下，出现最小值的链接是1 6和1 9，系数为0.5。所以现在程序应该在文件数据中删除以“1”开始的行中的元素“6”，反之亦然，并且与9相同。因此现在“新”数据集将是：

1 2 3 4 5 
2 1 3 
3 1 2 
4 1 5 
5 1 4 
6 7 8 
8 6 7 
9 10 11 
10 9 11 12 14 
11 9 10 12 13 
12 10 13 14 
13 11 12 
14 10 12 15 
15 14 

我所寻找的是：

1. 我怎么能删除，从包含在data文件中的数据集呈现系数最小的值的元素？

2. 我怎样才能迭代过程N次？

---

要找到输出文件的最低我想在程序结束这些行补充：

my $file1 = "output_example"; 
open my $fg, "<", $file1 or die "Error during $file1 opening: $!"; 

my @minimum_vector; 
while (<$fg>) { 
    push @minimum_vector, [ split ]; 
} 

my $minima=$minimum_vector[0][2]; 
for my $i (0 .. $#minimum_vector){ 
    if($minima >= $minimum_vector[$i][2]){ 
     $minima=$minimum_vector[$i][2]; 
    } 
} 
say $minima; 
close $file1; 

但它给我一个错误与$minima因为我觉得我无法从我刚刚创建的相同文件（在本例中为output_example文件）中读取。它运行，如果我编译在一个不同的程序。

Answer 1

迭代的最佳方式可能是将代码分解为子例程。这也有助于澄清代码并准确追踪可能出现问题的地方。

use strict; 
use warnings; 
use 5.010; 
use List::Utils qw/min/; 

sub load_initial_data { 
    # open and read file, load it into an arrayref and return it. 
} 

sub find_coefficients { 
    my $data = shift; 
    my @results; 
    foreach my $row (@$data) { 
     # do stuff to calculate $aa, $bb, $coeff 
     push @results, [$aa, $bb, $coeff]; 
    } 
    return \@results; 
} 

sub filter_data { 
    my $data = shift; 
    my $coefficients = shift; 
    my $min = min map { $_->[2] } @$coefficients; 
    my @deletions = grep { $min == $_->[2] } @$coefficients; 
    foreach my $del (@deletions) { 
     delete($data->{$del->[0]}{$del->[1]}); 
    } 
} 

# doing the actual work: 
my $data = load_initial_data(); 
my $coeffs; 
foreach my $pass (0 .. $N) { 
    $coeffs = find_coefficients($data); 
    $data = filter_data($data, $coeffs); 
    # You could write $data and/or $coeffs out to a file here 
    # if you need to keep the intermediate stages 
}