I have created a Perl program to calculate the amount of divisible numbers in numbers 3 to 10.
Example: the number 6 has 4 divisors 1, 2, 3 and 6.
This is how the program is suppose to work:
The program will calculated the number of divisors of 3 it will then print it to the report.txt file. Next, it will move on to calculate the number of divisors of 4 and print it to report.txt. The program will do this until it has calculated to the number 10 then it will close the program.
#!/usr/bin/perl
use warnings;
use strict;
my $num = 2; # The number that will be calculated
my $count = 1; # Counts the number of divisors
my $divisors; # The number of divisors
my $filename = 'report.txt';
open(my $fh, '>', $filename) or die "Could not open file '$filename' $!"; # open file "report.txt"
for (my $i=2; $i <= 10; $i++) {
while( $num % $i == 0) { # Checks if the number has a remainder.
$num++; # Adds 1 to $num so it will calculate the next number.
$count++; # counts the number of divisible numbers.
$num /= $i; # $num = $num / $i.
}
$divisors = $count; # The number of divisors are equal to $count.
print $fh "$divisors\n"; # The output will be repeated..
}
close $fh # Closes the file "report.txt"
I think the problem is that the for-loop keeps repeating this code:
print $fh "$divisors\n";
The output is:
2
2
2
2
2
2
2
2
2
but, I'm not sure exactly what I am missing.
Give your variables meaningful names. This helps in both making your code self-documenting, but also in that it helps you recognize when you're using a variable incorrectly. The variable name $i doesn't communicate anything, but $divisor says that you are testing if that number is a divisor.
As for why your code is looping, can't say. Here is a reformatted version of your code that does function though:
#!/usr/bin/perl
use warnings;
use strict;
use autodie;
for my $num (2..10) {
my $divisor_count = 0;
for my $divisor (1..$num) {
$divisor_count++ if $num % $divisor == 0;
}
print "$num - $divisor_count\n"
}
Output:
2 - 2
3 - 2
4 - 3
5 - 2
6 - 4
7 - 2
8 - 4
9 - 3
10 - 4
Related
I am very new to programming. I need to read a file line-by-line in perl. The text file has two columns and 100,000 rows all having numbers. I need to apply this formula (/16)*100 on each number and the result should be a separate file again with 2 columns and 100000 rows.
use strict;
use warnings;
my $filename = 'results_AH.txt';
open(my $fh, '<:encoding(UTF-8)', $filename)
or die "Could not open file '$filename' $!";
while (my $row = <$fh>) {
chomp $row;
print "$row\n";
}
print "done\n";
This is what I have. The file looks like (just a part). The calculation is to be done on both columns and each number.Please help :)
AH LHH
5 0
4 0
3 0
5 0
5 0
4 0
3 0
4 0
4 0
4 0
5 0
5 0
3 0
4 0
Hard-coding a filename is almost always a bad idea. If you read from <> then you can pass any filename on the command line. Also, it's more Perlish to read data into $_.
while (<>) {
# do stuff with $_
}
So what do we want to do? Well first let's split the data into individual columns and store them in an array.
my #numbers = split;
Notice that split() works on $_ and splits on whitespace by default.
Now we need to do your calculation. We can do it on all elements of #numbers using map().
my #new_numbers = map { $_ * 100 / 16 } #numbers;
And finally we want to print our results. That's as simple as:
print "#new_numbers\n";
I got file called numbers.txt which is basically line with 5 numbers:
they look like this:
1 2 3 4 5
What I'm trying to achieve is I want to read those numbers from the line (which already works), then in each iteration I want to add +1 to every number which was read from that file and print them on screen with print, so the final result should look like:
1 2 3 4 5
2 3 4 5 6
3 4 5 6 7
4 5 6 7 8
5 6 7 8 9
.
#!/usr/bin/perl
use strict;
use warnings;
open("handle", 'numbers.txt') or die('unable to open numbers file\n');
$/ = ' ';
OUT: for my $line (<handle>) {
for (my $a = 0; $a < 5; $a++) {
chomp $line;
$line += 1;
print "$line ";
next OUT;
}
}
close("handle");
Haven't done looping in perl for a while now and would be great if someone could provide working example.
Also, it would be great if you could provide more than one working example, just to be future proof ;)
Thanks
You can try this on for size.
#!/usr/bin/perl
use strict;
use warnings;
open("handle", 'numbers.txt') or die('unable to open numbers file\n');
for my $line (<handle>) {
chomp $line;
for my $number (split /\s+/, $line) {
for (my $a = $number; $a < $number+5; $a++) {
print "$a ";
}
print "\n";
}
}
close("handle");
You can dispense with $/=' ' and instead let the outer loop iterate on lines of the file.
For each line you want to iterate for each number which is separated by white space, thus the split /\s+/, $line which gives you a list of numbers for the inner loop.
For your output $a starts at the number read from the file.
This will do what you're after:
use strict;
use warnings;
while(<DATA>) {
chomp;
print "$_\n";
my #split = split;
my $count = 0;
for (1..4){
$count++;
foreach (#split){
my $num = $_ + $count;
print "$num ";
}
print "\n";
}
}
__DATA__
1 2 3 4 5
Here no need to use nested loop it's always program make slower.
#!/usr/bin/perl
use strict;
use warnings;
my #num = split(" ",(<DATA>)[0]);
foreach my $inc (0..$#num)
{
print map{$inc+$_," "}#num; # Add one by one in array element
print "\n";
}
__DATA__
1 2 3 4 5
Update Added another method, this one in line with the posted approach.
Increment each number in the string, changing the string in place. Repeat that. Below are two ways to do that. Yet another method reads individual numbers and prints following integer sequences.
(1) With regular expressions. It also fits in one-liner
echo "1 2 3 4 5" | perl -e '$v = <>; for (1..5) { print $v; $v =~ s/(\d+)/$1+1/eg; }'
This prints the desired output. But better put it in a script
use warnings;
use strict;
my $file = 'numbers.txt';
open my $fh, '<', $file or die "can't open $file: $!";
while (my $line = <$fh>) {
# Add chomp($line) if needed for some other processing.
for (1..5) {
print $line;
$line =~ s/(\d+)/$1+1/eg;
}
}
The /e modifier is crucial for this. It makes the replacement side of the regex be evaluated as code instead of as a double-quoted string. So you can actually execute code there and here we add to the captured number, $1+1, for each matched number as /g moves down the string. This changes the string so the next iteration of the for (1..5) increments those, etc. I match multiple digits, \d+, which isn't necessary in your example but makes far more sense in general.
(2) Via split + map + join, also repeatedly changing the line in place
while (my $line = <$fh>) {
for (1..5) {
print $line;
$line = join ' ', map { $_+1 } split '\s+', $line;
}
}
The split gets the list of numbers from $line and feeds it to map, which increments each, feeding its output list to join. The joined string is assigned back to $line, and this is repeated. I split by \s+ to allow multiple white space but this makes it very 'relaxed' in what input format it accepts, see perlrecharclass. If you know it's one space please change that to ' '.
(3) Take a number at a time and print the integer sequence starting from it.
open my $fh, '<', $file or die "can't open $file: $!";
local $/ = ' ';
while (my $num = <$fh>) {
print "$_ " for $num..$num+4;
print "\n";
}
The magical 4 can be coded by pre-processing the whole line to find the sequence length, say by
my $len = () = $line =~ /(\d+)/g;
or by split-ing into an array and taking its scalar, then using $len-1.
Additional comments.
I recommend the three-argument open, open my $fh, '<', $file
When you check a call print the error, die "Your message: $!", to see the reason for failure. If you decide to quit, if ($bad) { die "Got $bad" }, then you may not need $!. But when an external call fails you don't know the reason so you need the suitable error variable, most often $!.
Your program has a number of problems. Here is what's stopping it working
You are setting the record separator to a single space. Your input file contains "1 2 3 4 5\n", so the while loop will iterate five times setting $line to "1 ", "2 ", "3 ", "4 ", "5\n"
Your for loop is set up to iterate five times. It does chomp $line which removes the space after the number, then increments $line and prints it. Then you jump out of the for loop, having executed it only once, with next OUT. This results in each value in the file being incremented by one and printed, so you get 2 3 4 5 6
Removing the unnecessary next OUT, produces something closer
2 3 4 5 6 3 4 5 6 7 4 5 6 7 8 5 6 7 8 9 6 7 8 9 10
There are now five numbers being printed for each number in the input file
Adding print "\n" after the for loop help separate the lines
2 3 4 5 6
3 4 5 6 7
4 5 6 7 8
5 6 7 8 9
6 7 8 9 10
Now we need to print the number before it is incremented instead of afterwards. If we swap $line += 1 and print "$line " we get this
1 2 3 4 5
2 3 4 5 6
3 4 5 6 7
4 5 6 7 8
5
6 7 8 9
What is happening here is that the 5 is still followed be a newline, which now appears in the output. The chomp won't remove this because it removes the value of $/ from the end of a string. You've set that to a space, so it will remove only spaces. The fix is to replace chomp with a substitution s/\s+//g which removes *all whitespace from the string. You also need to do that only once so I've put it outside the for loop at the top
Now we get this
1 2 3 4 5
2 3 4 5 6
3 4 5 6 7
4 5 6 7 8
5 6 7 8 9
And this is your code as it ended up
use strict;
use warnings;
open( "handle", 'numbers.txt' ) or die('unable to open numbers file\n');
$/ = ' ';
for my $line (<handle>) {
$line =~ s/\s+//g;
for ( my $a = 0; $a < 5; $a++ ) {
print "$line ";
$line += 1;
}
print "\n";
}
close("handle");
There are a few other best practices that could improve your program
Use use warnings 'all'
Use lexical file handles, and the three-parameter form of open
Use local if you are changing Perl's built-in variables
Put $! into your die string so that you know why the open failed
Avoid the C-style for loop, and iterate over a list instead
Making these fixes as well looks like this. The output is identical to the above
use strict;
use warnings 'all';
open my $fh, '<', 'numbers.txt'
or die qq{Unable to open "numbers.txt" for input: $!};
local $/ = ' ';
for my $line ( <$fh> ) {
$line =~ s/\s+//g;
for my $a ( 0 .. 4 ) {
print "$line ";
++$line;
}
print "\n";
}
I am a brand new Perl novice, looking for help with my first ever Perl script
I have some huge files 30-50GB files and they are constructed like this - millions of columns and thousands of rows:
A B C D E 1 2 3 4 5 6 7 8 9 10
A B C D E 1 2 3 4 5 6 7 8 9 10
A B C D E 1 2 3 4 5 6 7 8 9 10
A B C D E 1 2 3 4 5 6 7 8 9 10
A B C D E 1 2 3 4 5 6 7 8 9 10
A B C D E 1 2 3 4 5 6 7 8 9 10
A B C D E 1 2 3 4 5 6 7 8 9 10
I would like to delete column "A", and column "C", then ever third of the number columns, so the "3" column and the "6" column, then "9" column until the end of the file. Space delimited.
My attempt is like this:
#!/usr/local/bin/perl
use strict;
use warnings;
my #dataColumns;
my $dataColumnCount;
if(scalar(#ARGV) != 2){
print "\nNo files supplied, please supply file name\n";
exit;
}
my $Infile = $ARGV[0];
my $Outfile = $ARGV[1];
open(INFO,$Infile) || die "Could not open $Infile for reading";
open(OUT,">$Outfile") || die "Could not open $Outfile for writing";
while (<INFO>) {
chop;
#dataColumns = split(" ");
$dataColumnCount = #dataColumns + 1;
#Now remove the first element of the list
shift(#dataColumns);
#Now remove the third element (Note that it is now the second - after removal of the first)
splice(#dataColumns,1,1); # remove the third element (now the second)
#Now remove the 6th (originally the 8th) and every third one thereafter
#NB There are now $dataColumnCount-1 columns
for (my $i = 5; $i < $dataColumnCount-1; $i = $i + 3 ) {
splice($dataColumns; $i; 1);
}
#Now join the remaining elements of the list back into a single string
my $AmendedLine = join(" ",#dataColumns);
#Finally print out the line into your new file
print OUT "$AmendedLine/n";
}
But I am getting a few weird errors:
It is saying it doesn't like my $1 in the for loop, I have added a 'my' which seems to make the error go away but nobody else's for code seems to contain a 'my' here so I am not sure what is going on.
Global symbol "$i" requires explicit package name at Convertversion2.pl line 36.
Global symbol "$i" requires explicit package name at Convertversion2.pl line 36.
Global symbol "$i" requires explicit package name at Convertversion2.pl line 36.
Global symbol "$i" requires explicit package name at Convertversion2.pl line 36.
The other error is this:
syntax error at Convertversion2.pl line 37, near "#dataColumns;"
syntax error at Convertversion2.pl line 37, near "1)"
I am not sure how to correct this error, I think I am almost there, but not sure what exactly what the syntax error is, is am unsure how to fix it.
Thank you in advance.
After I blogged about this question, a commenter pointed out that it is possible to reduce run time by 45% for my test case. I paraphrased his code a little bit:
my #keep;
while (<>) {
my #data = split;
unless (#keep) {
#keep = (0, 1, 0, 1, 1);
for (my $i = 5; $i < #data; $i += 3) {
push #keep, 1, 1, 0;
}
}
my $i = 0;
print join(' ', grep $keep[$i++], #data), "\n";
}
This runs in almost half the time my original solution took:
$ time ./zz.pl input.data > /dev/null
real 0m21.861s
user 0m21.310s
sys 0m0.280s
Now, it is possible to gain another 45% performance by using Inline::C in a rather dirty way:
#!/usr/bin/env perl
use strict;
use warnings;
use Inline C => <<'END_C'
/*
This code 'works' only in a limited set of circumstances!
Don't expect anything good if you feed it anything other
than plain ASCII
*/
#include <ctype.h>
SV *
extract_fields(char *line, AV *wanted_fields)
{
int ch;
IV current_field = 0;
IV wanted_field = -1;
unsigned char *cursor = line;
unsigned char *field_begin = line;
unsigned char *save_field_begin;
STRLEN field_len = 0;
IV i_wanted = 0;
IV n_wanted = av_len(wanted_fields);
AV *ret = newAV();
while (i_wanted <= n_wanted) {
SV **p_wanted = av_fetch(wanted_fields, i_wanted, 0);
if (!(*p_wanted)) {
croak("av_fetch returned NULL pointer");
}
wanted_field = SvIV(*p_wanted);
while ((ch = *(cursor++))) {
if (!isspace(ch)) {
continue;
}
field_len = cursor - field_begin - 1;
save_field_begin = field_begin;
field_begin = cursor;
current_field += 1;
if (current_field != wanted_field) {
continue;
}
av_push(ret, newSVpvn(save_field_begin, field_len));
break;
}
i_wanted += 1;
}
return newRV_noinc((SV *) ret);
}
END_C
;
And, here is the Perl part. Note that we split only once to figure out the indices of fields to keep. Once we know those, we pass the line and the (1-based) indices to the C routine to slice and dice.
my #keep;
while (my $line = <>) {
unless (#keep) {
#keep = (2, 4, 5);
my #data = split ' ', $line;
push #keep, grep +(($_ - 5) % 3), 6 .. scalar(#data);
}
my $fields = extract_fields($line, \#keep);
print join(' ', #$fields), "\n";
}
$ time ./ww.pl input.data > /dev/null
real 0m11.539s
user 0m11.083s
sys 0m0.300s
input.data was generated using:
$ perl -E 'say join(" ", "A" .. "ZZZZ") for 1 .. 100' > input.data
and it is about 225MB in size.
The code you show doesn't produce those errors. You have no $1 in there at all, and if you meant $i then your use of that variable is fine. The only syntax error is in the line splice($dataColumns; $i; 1) which has semicolons instead of commas, and uses $dataColumns instead of #dataColumns.
Apart from that
It is good practice to declare variables as close as possible to their point of use, not at the top of the program.
Capital letters are generally used for constants like package names. You should use lower case, digits and underscore for variables.
Are you aware you are setting $dataColumnCount to one more than the number of elements in #dataColumns?
It is frowned on more recently to use global file handles - you should use lexical variables instead.
I suggest this refactoring of your program. It uses autodie to avoid having to check the success of the open calls. It builds a list of array indices that need deleting as soon as it can: once the number of fields in each line is known after the first record is read. Then it deletes them from the end backwards to avoid having to do arithmetic on the indices as preceding elements are removed.
#!/usr/local/bin/perl
use strict;
use warnings;
use autodie;
if (#ARGV != 2) {
die "\nNo files supplied, please supply file names\n";
}
my ($infile, $outfile) = #ARGV;
open my $info, '<', $infile;
open my $out, '>', $outfile;
my #remove;
while (<$info>) {
my #data = split;
unless (#remove) {
#remove = (0, 2);
for (my $i = 7; $i < #data; $i += 3) {
push #remove, $i;
}
}
splice #data, $_, 1 for reverse #remove;
print $out join(' ', #data), "\n";
}
While the other answers above work perfectly, and mine probably doesn't present any advantage, this is a different way of achieving the same while avoiding split:
#!/usr/local/bin/perl
use strict;
use warnings;
use feature 'say';
my $dir='D:\\';
open my $fh,"<", "$dir\\test.txt" or die;
while (<$fh>) {
chomp;
my #fields = split ' ';
print "$fields[0] $fields[2] ";
for (my $i=7; $i <= $#fields; $i += 3){
print "$fields[$i] ";
}
print "\n";
}
close $fh;
Please let me know if this is useless.
How to write a logic using for loop or while loop for printing Armstrong numbers?
Someone kindly explain how to print Armstrong numbers between 1 to 1,00,00,000.
This the algorithm that I followed
step 1 : initializing variable min,max,n,sum,r,t
step 2 : my $n = <>;
step 3 : to find base of $n
step 4 : using for loop
( for (n = min; n < max ; n++ )
step 5 : some logic like
n=t,sum =0,r=t%10,t=n/10,
step 6 :
sum = sum + (n ^ base );
step 6 :
if ( sum == num ) print Armstrong numbers else not.
I tried to code this my code look like this
#!/usr/bin/perl
use strict;
use warnings;
use diagnostics;
my $n;
chomp($n);
my $min = 1;
my $max = 10000000
my $r;
my $sum;
my $t;
my $base = length($n);
print "base is $base\n";
for ($n = $min; $n <= $max; $n++) {
$t = $n;
$sum = 0;
while ($t != 0) {
$r = $t % 10;
$t = $t / 10;
{
$sum = $sum + ($base * $r);
}
if ($sum == $n) {
print "$n\n";
}
}
}
Several things:
It's bad practice to declare something with my until you need it.
You must remember that numbers are also strings, and can be manipulated by string functions like split.
C-like loops are discouraged in Perl because they're hard to read.
Constants should be ...well... constant.
Here's my attempt. I use split to split up my digits into an array of digits. This is a lot easier than dividing constantly by ten. I can get the number of digits by simply taking the scalar value of my #digits array.
I can then loop through #digits, taking each one to the power of $power and adding it to sum. I use the map command for this loop, but I could have used another for loop too.
#! /usr/bin/env perl
#
use strict;
use warnings;
use feature qw(say);
use constant {
MIN => 1,
MAX => 1_000_000,
};
for my $number ( (+MIN..+MAX) ) {
my #digits = split //, $number;
my $power = #digits;
my $sum = 0;
map { $sum += $_**$power } #digits;
if ( $sum == $number ) {
say "$number is an Armstrong number";
}
}
And my output:
1 is an Armstrong number
2 is an Armstrong number
3 is an Armstrong number
4 is an Armstrong number
5 is an Armstrong number
6 is an Armstrong number
7 is an Armstrong number
8 is an Armstrong number
9 is an Armstrong number
153 is an Armstrong number
370 is an Armstrong number
371 is an Armstrong number
407 is an Armstrong number
1634 is an Armstrong number
8208 is an Armstrong number
9474 is an Armstrong number
54748 is an Armstrong number
92727 is an Armstrong number
93084 is an Armstrong number
548834 is an Armstrong number
Took a bit over five seconds to run.
Instead of map, I could have done this loop:
for my $digit ( #digits ) {
$sum = $sum + ( $digit ** $power);
}
Did this one at university...
I dug out the one I made in C and converted it to perl for you (it may not be the best way to do this, but it is the way I did it):
#!/usr/bin/env perl
use strict;
use warnings;
my $min = 1;
my $max = 10000000;
for (my $number = $min; $number <= $max; $number++) {
my #digits = split('', $number);
my $sum = 0;
foreach my $digit (#digits) {
$sum += $digit**length($number);
}
if ($sum == $number) {
print "$number\n";
}
}
(Demo - 1 to 9999 due to execution time limit)
Your code seems to be right, but you have some kind of problems with your start. For example you dont read from STDIN or from #ARGV. Would you do that, you just have a small problem with your calculating of the exponential calculation. In most Programming Languages, the syntax for a exponential calculation is ** or a pow() function.
I really dont understand, for what this part is:
while ($t != 0) {
$r = $t % 10;
$t = $t / 10;
{
$sum = $sum + ($base * $r);
}
if ($sum == $n) {
print "$n\n";
}
}
For what is the naked block? Why do you use the modulus? .. Well i give you a small code for calculating the armstrong numbers with bases of 1..100, between 0 and 10million:
#!/usr/bin/perl
use strict;
use warnings;
foreach my $base (0..100) { # use the foreach loop as base
for my $num (0..10_000_000) { # and use numbers between this range
my $ce=0; # ce = calculated exp.
foreach my $num2 (split //,$num ) { # split each number for calc each
$ce += $num2 ** $base; # exp. and adding it (see algorithm)
}
if ($num == $ce) { # when the exp. num and the number
print "$base => $num\n"; # itself equals, its a armstrong number
} # print that
}
}
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?
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
[ 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] }) {
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;
}