File row confrontation - perl

Question

I have the following problem: from a file (file.dat) with the following formatted datas
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
I want to find:
if the first element of a row appears in the other rows and if the first element of the subsequent rows appear in the row taken in exam;
if it exists then I want to print "I have found the link x y";
if the "link" exists, then I want to count how many times the other elements in the row taken in exam appear in the row where the link is present and print "I have found z triangles".
For example in this case when the program compare the first row and the second row and find that "the link 1 2" exists and then write also "I have find 2 triangles" (because in each rows there are the numbers 3 and 4).
For this purpose I have tried to write the following program:
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";
}
}
}
}
}
The program print the right number of links but I found that if the number of rows is lower of the number of colums in the file, the program doesn't read the full row and this could be a problem for my link research. I think the problem is due at the scalar #vector upper limit in the for instrunctions (but I don't understand why).
The second problem is that it does't count the right number o triangles that I'am looking for... Any helps?

Answer 1

This program does what you require. In addition it prints the three corners of each triangle when one is found.
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";
}
}
There are only two triangles in the data you show: 1-2-3 and 1-2-4. Following your algorithm results in this program counting triangles more than once, with the corners in different orders. To count each distinct triangle only once, change the line
next if $cc == $aa or $cc == $bb;
to
next if $cc <= $aa or $cc <= $bb;
output
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 2

[ Only answers first question ]
$j and $l are suppose to iterate over the column indexes, but you count rows. The correct loops are:
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 3

This question has two parts:
Establish if a link exists between two rows
Establish the total 'unique' numbers they share in common
Using an AoA is fine, but using a HoH makes life a little easier:
my %links;
while ( <$fh> ) {
chomp;
my ( $from, #to ) = split;
$links{$from}{$_}++ for #to;
}
You can then check to see if the link exists:
print "Link $from $to\n" if exists $links{$from} && exists $links{$from}{$to};
And finding common "triangles" should be easy as well:
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;
}