-1

I have this script :

use strict;
use warnings;
use diagnostics;
use Math::Vector::Real;
use constant DEG_PER_RAD => 45 / atan2(1, 1);

my ( $source, $out ) = qw/ OUT4 OUTABA12 /;

open my $in_fh,  '<', $source or die qq{Unable to open "$source" for input: $!\n};
open my $out_fh, '>', $out    or die qq{Unable to open "$out" for output: $!\n};

my @data;
push @data, V(split) while <$in_fh>;

my @aoa;
for my $i ( 0 .. $#data ) {
    for my $j ( 0 .. $#data ) {
        my $val1 = $data[$i];
        my $val2 = $data[$j];

        if ($val1 != $val2) {
            my $math = sqrt(($val1->[0] - $val2->[0])**2 +
                ($val1->[1] - $val2->[1])**2 +
                ($val1->[2] - $val2->[2])**2);
            if ($math < 2.2) {
                    push @aoa, [@$val1, @$val2, $math];
            }
        }
    }
}

for my $k ( 0 .. $#aoa-1 ) {
    my $aoadata1 = $aoa[$k];
    my $aoadata2 = $aoa[$k+1];
    my $vect1 = [ @{ $aoa[$k] }[0..2] ];
    my $vect2 = [ @{ $aoa[$k+1] }[0..2] ];
    my $vect3 = [ @{ $aoa[$k] }[3..5] ];
    my $vect4 = [ @{ $aoa[$k+1] }[3..5] ];
    my $math1 = [ @{ $aoa[$k] }[6] ];
    my $math2 = [ @{ $aoa[$k+1] }[6] ];
    my @matha = @$math1;
    my @mathb = @$math2;
    my @vecta = @$vect1;
    my @vectb = @$vect2;
    my @vectc = @$vect3;
    my @vectd = @$vect4;
            if ( @vecta != @vectb ) {
                print "180\n";
            }
}

Which starts with this input file, a list of coordinates :

18.474525 20.161419 20.33903
21.999333 20.220667 19.786734
18.333228 21.649157 21.125111
20.371077 19.675844 19.77649
17.04323 19.3106 20.148842
22.941106 19.105412 19.069893

which then produces this intermediate array :

18.474525 20.161419 20.33903 18.333228 21.649157 21.125111 1.68856523042908
18.474525 20.161419 20.33903 20.371077 19.675844 19.77649 2.03694472701863
18.474525 20.161419 20.33903 17.04323 19.3106 20.148842 1.67590865596249
21.999333 20.220667 19.786734 20.371077 19.675844 19.77649 1.71701911532778
21.999333 20.220667 19.786734 22.941106 19.105412 19.069893 1.62621988606553
18.333228 21.649157 21.125111 18.474525 20.161419 20.33903 1.68856523042908
20.371077 19.675844 19.77649 18.474525 20.161419 20.33903 2.03694472701863
20.371077 19.675844 19.77649 21.999333 20.220667 19.786734 1.71701911532778
17.04323 19.3106 20.148842 18.474525 20.161419 20.33903 1.67590865596249
22.941106 19.105412 19.069893 21.999333 20.220667 19.786734 1.62621988606553

which is a pair of coordinates, followed by another pair of coordinates from that list, followed by the distance between them.

What I've been trying to do is to get to the second half of the program to work - but I've no idea on how to work through the array like i need to.

If there is a row in the intermediate array who's first set of coordinates is unique from all other rows, it should simply print the first coordinate set in that row and 180. Such as the last row in the array- running

print "@vecta 180\n";

Should return, for that line:

22.941106 19.105412 19.069893 180

Otherwise, for each row of the intermediate array, I would like to see if the first 3 coordinates of a line match the first three coordinates of the second line, and if they do I need to take the second set of coordinates from the two lines, subtract the first identical set of coordinates on each of the two lines from them, and then find the angle between the two secondary coordinates after the subtraction. Something akin to this:

my $varvec1 = V( @$vect3 );
my $varvec2 = V( @$vect4 );
my $varnorm = V( @$vect1 );
my $nvect1 = $varvec1 - $varnorm ;
my $nvect2 = $varvec2 - $varnorm ;
my $degrees = atan2($nvect1, $nvect2) * DEG_PER_RAD;
print "$varnorm $degrees\n";

Running that on the first 3 rows of the intermediate should return:

18.474525 20.161419 20.33903 *Some Value* 
18.474525 20.161419 20.33903 *Some Value* 
18.474525 20.161419 20.33903 *Some Value* 

With the Some Value's being derived from the above angle calculation happening between the first line and the second line, the first line and the third line, and then the second line and the third line.

As a whole, the program would ideally give me:

 18.474525 20.161419 20.33903 *Some Value*
 18.474525 20.161419 20.33903 *Some Value*
 18.474525 20.161419 20.33903 *Some Value*
 21.999333 20.220667 19.786734 *Some Value*
 21.999333 20.220667 19.786734 *Some Value*
 18.333228 21.649157 21.125111 180
 20.371077 19.675844 19.77649 *Some Value*
 20.371077 19.675844 19.77649 *Some Value*
 17.04323 19.3106 20.148842 180
 22.941106 19.105412 19.069893 180

My main issue is running through the data correctly, I can set up the calculations and variable assignments. Can anyone help me out with this? Thanks in advance.

Edit - Response to Sobrique

When I implement the second part (Which I assume implements the first part as well) with the other suggestions you had as so:

my %seen;

for my $index ( 0 .. $#aoa ) {
    my $coord_key = join( ":", @{ $aoa[$index] }[ 0 .. 2 ] );
    if ( $seen{$coord_key} <= 1 ) {
        print V( @{$aoa[$index]}[0..2] ) . " 180\n";
    }
    else {
        last unless $aoa[ $index + 1 ]; #in case out of bounds
        my $varvec1 = V( @{ $aoa[$index] }[ 3 .. 5 ] );
        my $varvec2 = V( @{ $aoa[ $index + 1 ] }[ 3 .. 5 ] );
        my $varnorm = V( @{ $aoa[$index] }[ 0 .. 2 ] );
        my $nvect1  = $varvec1 - $varnorm;
        my $nvect2  = $varvec2 - $varnorm;
        my $degrees = atan2( $nvect1, $nvect2 ) * DEG_PER_RAD;
        print "$varnorm $degrees\n";

    }

I get:

Use of uninitialized value within %seen in numeric le (<=) at
    /Users/a7c/exe/distscript.pl line 64, <$in_fh> line 6 (#1)
    (W uninitialized) An undefined value was used as if it were already
    defined.  It was interpreted as a "" or a 0, but maybe it was a mistake.
    To suppress this warning assign a defined value to your variables.

    To help you figure out what was undefined, perl will try to tell you
    the name of the variable (if any) that was undefined.  In some cases
    it cannot do this, so it also tells you what operation you used the
    undefined value in.  Note, however, that perl optimizes your program
    anid the operation displayed in the warning may not necessarily appear
    literally in your program.  For example, "that $foo" is usually
    optimized into "that " . $foo, and the warning will refer to the
    concatenation (.) operator, even though there is no . in
    your program.

{18.474525, 20.161419, 20.33903} 180
{18.474525, 20.161419, 20.33903} 180
{18.474525, 20.161419, 20.33903} 180
{21.999333, 20.220667, 19.786734} 180
{21.999333, 20.220667, 19.786734} 180
{18.333228, 21.649157, 21.125111} 180
{20.371077, 19.675844, 19.77649} 180
{20.371077, 19.675844, 19.77649} 180
{17.04323, 19.3106, 20.148842} 180
{22.941106, 19.105412, 19.069893} 180

Which you definitely interpreted correctly. I'm not quite sure how to remove the non-numeric LE issue though, and the bottom results seems to be messed up because of it.

12
  • What happened to your code indentation? The question is nicely formatted, but there are some weird whitespaces in your code? Lazy? :)
    – simbabque
    Sep 17, 2015 at 12:46
  • @simbabque a big part of it is to keep track of which chuck of variable assignments is what. But yes, part of it is laziness. Good catch ;) Sep 17, 2015 at 12:48
  • perltidy is good for that.
    – Sobrique
    Sep 17, 2015 at 12:49
  • 1
    Got to ask - why are you assigning an anonymous array to a scalar, but then casting it back to an array. E.g. my $vect1 = [ @{ $aoa[$k] }[0..2] ]; my @vecta = @$vect1;?
    – Sobrique
    Sep 17, 2015 at 12:50
  • 1
    I have to say - I think that's honestly where your problem lies. You have code that's had additional complication added for no benefit - and now are having trouble unravelling it. I'm having difficulty following what your code is trying to do, even before understanding what you're trying to accomplish, which makes debugging it considerably more difficult.
    – Sobrique
    Sep 17, 2015 at 12:56

2 Answers 2

2

So for the first part:

If there is a row in the intermediate array who's first set of coordinates is unique from all other rows, it should simply print the first coordinate set in that row and 180. Such as the last row in the array

I'm being a bit lazy and assuming that joining with : is sufficient. It should be for purely numeric stuff. Otherwise you can implement a more specific array equivalence test.

use Data::Dumper;
print Dumper \@aoa;

my %seen;

foreach my $row (@aoa) {
    my $coord_key = join (":", @$row[0..2] );
    print $coord_key,"\n";
    $seen{$coord_key}++; 
}

foreach my $row ( @aoa ) { 
   my $coord_key = join (":", @$row[0..2] );
   print "Unique:  @$row[0..2] 180\n" unless $seen{$coord_key} > 1;
}

This will spit out:

Unique:  18.333228 21.649157 21.125111 180
Unique:  17.04323 19.3106 20.148842 180
Unique:  22.941106 19.105412 19.069893 180

Which I think is the desired result?

For the second part - I'm getting lost again, but I think you should be able to do something similar.

Something like this perhaps?

for my $index ( 0 .. $#aoa ) {
    my $coord_key = join( ":", @{ $aoa[$index] }[ 0 .. 2 ] );
    if ( $seen{$coord_key} <= 1 ) {
        print "Unique:  @{$aoa[$index]}[0..2] 180\n";
    }
    else {
        last unless $aoa[ $index + 1 ]; #in case out of bounds
        my $varvec1 = V( @{ $aoa[$index] }[ 3 .. 5 ] );
        my $varvec2 = V( @{ $aoa[ $index + 1 ] }[ 3 .. 5 ] );
        my $varnorm = V( @{ $aoa[$index] }[ 0 .. 2 ] );
        my $nvect1  = $varvec1 - $varnorm;
        my $nvect2  = $varvec2 - $varnorm;
        my $degrees = atan2( $nvect1, $nvect2 ) * DEG_PER_RAD;
        print "$varnorm $degrees\n";

    }
}

Which gives:

{18.474525, 20.161419, 20.33903} 114.61436195896
{18.474525, 20.161419, 20.33903} 130.002084392181
{18.474525, 20.161419, 20.33903} 130.002084392181
{21.999333, 20.220667, 19.786734} 109.204553032216
{21.999333, 20.220667, 19.786734} 128.968855749228
Unique:  18.333228 21.649157 21.125111 180
{20.371077, 19.675844, 19.77649} 143.673572115941
{20.371077, 19.675844, 19.77649} 143.673572115941
Unique:  17.04323 19.3106 20.148842 180
Unique:  22.941106 19.105412 19.069893 180

Looks like you're printing $varnorm which implicitly includes {}. You can either amend:

print "Unique:  @{$aoa[$index]}[0..2] 180\n";

To:

print V( @{$aoa[$index]}[0..2] ) . " 180\n";

Or:

print "$varnorm $degrees\n";

to;

print "@{ $aoa[$index] }[ 0 .. 2 ] $degrees\n";

Or maybe stick 'em together with join ( "\t", to tabulate or something.

Edit: For array comparisons - the approach I've suggested is pretty basic, and will be tripped up by a few things.

You could instead do something like:

foreach my $row (@aoa) {
    $seen{$row->[0]}{$row->[1]}{$row->[2]}++;
}

And:

if ( $seen{$aoa[$index][0]}{$aoa[$index][1]}{$aoa[$index][2]} <= 1 ) { 
       #....
}

But that'll also apply numeric tests to floating point numbers - which might cause you problems due to float precision. If that does cause you problems then sprintf to stringify your float to a known precision may help.

4
  • Thanks! You definitely interpreted my question correctly, I tried to be as clear as I could but I'm sorry for the haziness that was left. Sep 17, 2015 at 14:04
  • However, I did update my question with the interpretation of your answer I implemented, and the resulting error from my implementation. I greatly appreciate your answer though. Sep 17, 2015 at 14:05
  • This worked given your test data. undefined value means that for some reason, there was no array element with that index. Try: if ( defined $seen{$coord_key} or $seen{$coord_key} <= 1 ) { but that shouldn't happen - try printing print Dumper \%seen and manually inspect for weirdness.
    – Sobrique
    Sep 17, 2015 at 14:24
  • how would those edits be tied into the earlier answer? Sorry, but I know little about the methods you're employing here. Sep 17, 2015 at 16:20
1

This is a duplicate post that I mistakenly added to your original question instead of to this new one. I think it's correct

I've used the facilities of the Math::Vector::Real module as I described in a comment

  • I leave the vectors as objects and avoid accessing their their contents directly

  • I calculate the distance between $vec1 and $vec2 as abs($vec2 - $vec1)

  • I use the class's stringify ability to display it instead of extracting the individual values in my code

I have also changed the intermediate data format. The distance is no longer kept because it's not necessary, and the array @groups now contains an array for each group of vector pairs that have a common first vector. Each group is of the form

[ $vec1, $vec2, $vec2, $vec2, ... ]

and I use the first function from List::Util to find the group that each new vector pair belongs in. If an existing group is found with a matching first value then the second vector is just pushed onto the end of the group; otherwise a new group is created that looks like [ $vec1, $vec2 ]

Once the @groups array is built, it is processed again to generate the output

  • If there are only two values in the group then they are $vec1 and $vec2 of a unique point. $vec1 is printed with 180

  • If there are more than two elements then a line of output is generated for every pair of $vec2 values, each containing the value $vec1 together with the angle between the two delta formed by $vec1 and each $vec2 in the pair


use strict;
use warnings;

use Math::Vector::Real qw/ V /;
use List::Util qw / first /;

use constant DEG_PER_RAD => 45 / atan2(1, 1);

my ( $source, $out ) = qw/ OUT4  OUTABA12 /;

open my $in_fh,  '<', $source or die qq{Unable to open "$source" for input: $!\n};

my @data = map V(split), <$in_fh>;

my @groups;

for my $vec1 ( @data ) {
    for my $vec2 ( @data ) {

        next if abs($vec2 - $vec1) > 2.2 or $vec2 == $vec1;

        my $group = first { $_->[0] == $vec1 } @groups;

        if ( $group ) {
            push @$group, $vec2;
        }
        else {
            push @groups, [ $vec1, $vec2 ];
        }
    }
}

open my $out_fh, '>', $out or die qq{Unable to open "$out" for output: $!\n};
select $out_fh;

for my $group ( @groups ) {

    my ($vec1, @vec2) = @$group;

    if ( @vec2 == 1 ) {
        print "$vec1 180\n";
        next;
    }

    for my $i ( 0 .. $#vec2-1 ) {
        for my $j ( $i+1 .. $#vec2 ) {
            my ($vec2a, $vec2b) = @vec2[$i, $j];
            my $angle = atan2( $vec2a - $vec1, $vec2b - $vec1 ) * DEG_PER_RAD;
            print "$vec1 $angle\n";
        }
    }

}

output

{18.474525, 20.161419, 20.33903} 114.61436195896
{18.474525, 20.161419, 20.33903} 115.382649331314
{18.474525, 20.161419, 20.33903} 130.002084392181
{21.999333, 20.220667, 19.786734} 109.204553032216
{18.333228, 21.649157, 21.125111} 180
{20.371077, 19.675844, 19.77649} 143.673572115941
{17.04323, 19.3106, 20.148842} 180
{22.941106, 19.105412, 19.069893} 180
3
  • @jcklasseter: "It looks like the end angles may be in radians? They should be higher. I may just have to recheck my data though. But I'm pretty sure it shouldn't be that low. I very well could be wrong" You're correct -- they weren't in radians but they were wrong. I was calculating the angle between the two vec2 vectors instead of forming two new vectors relative to vec1 first. I now get something very like Sobrique's answer but he has two instances of 130.002084392181 and two of 143.673572115941 and only you can adjudicate there
    – Borodin
    Sep 17, 2015 at 18:41
  • -That worked perfectly, and makes a lot of sense. Thanks for the help! Sep 17, 2015 at 19:21
  • @jcklasseter: I'm pleased that it makes sense to you. It is always difficult to choose meaningful language when I'm trying to help with vignettes of someone's daily work like this. It is too easy to write in terms of the programming problem while making no sense in practice
    – Borodin
    Sep 19, 2015 at 23:14

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.