Re: Check if line is straight

[wind]

I'm a little late to the party on this one, but wanted to share my solution anyway since it covers all cases.

The only trick to this problem is realizing that you need the following three equations:

• Formula for a line: y = m x + b
• Perpendicular line: Y = M x + B where M = -1 / m
• Dist between 2 points: dist = sqrt(dX ^ 2 + dY ^ 2)

Assuming you want a third point to be within a specified uncertainty that is either constant or relative to the segment length, than the following would work:

use Test::More tests => 3*(2*6 + 1);

use strict;
use warnings;

local $" = ',';

# Slope 1
{
    my $matcher = path_matcher({
        p1 => [0,0],
        p2 => [100,100],
    });
    # Points on edge of tolerance
    for ([0,20], [20,0], [40,60], [60,40], [80,100], [100,80]) {
        ok($matcher->(@$_), "slope 1: match [@$_]");
    }
    # Out of bounds
    for ([0,21], [21,0], [40,61], [61,40], [80,101], [101,80], [-1,20]
+) {
        ok(!$matcher->(@$_), "slope 1: not match [@$_]");
    }
}

# Slope 0
{
    my $matcher = path_matcher({
        p1 => [0,50],
        p2 => [100,50],
    });
    # Boundary cases
    for ([0,60], [0,40], [50,60], [50,40], [100,60], [100,40]) {
        ok($matcher->(@$_), "slope 0: match [@$_]");
    }
    # Out of bounds
    for ([0,61], [0,39], [50,61], [50,39], [100,61], [100,39], [-1,60]
+) {
        ok(!$matcher->(@$_), "slope 0: not match [@$_]");
    }
}

# Slope INF
{
    my $matcher = path_matcher({
        p1 => [50,0],
        p2 => [50,100],
    });
    # Boundary cases
    for ([40,0], [60,0], [40,50], [60,50], [40,100], [60,100]) {
        ok($matcher->(@$_), "slope INF: match [@$_]");
    }
    # Out of bounds
    for ([39,0], [61,0], [39,50], [61,50], [39,100], [61,100], [40,-1]
+) {
        ok(!$matcher->(@$_), "slope INF: not match [@$_]");
    }
}

###
### Begin Actual functionality

sub path_matcher {
    my ($args_ref) = @_;
    my $p1 = delete $args_ref->{p1} || [delete @$args_ref{qw(x1 y1)}];
    my $p2 = delete $args_ref->{p2} || [delete @$args_ref{qw(x2 y2)}];
    my $sigma = delete $args_ref->{sigma} // '10%';
    
    die "Unknown parameters" if keys %$args_ref;
    die "Points must be defined" if grep {! defined} (@$p1, @$p2);
    
    # Order by x and y
    ($p1, $p2) = sort {$a->[0] <=> $b->[0] || $a->[1] <=> $b->[1]} ($p
+1, $p2);

    my ($x1, $y1) = @$p1;
    my ($x2, $y2) = @$p2;

    # Solve y = m x + b
    my $dX = $x2 - $x1;
    my $dY = $y2 - $y1;
    my $m = $dX == 0 ? undef : $dY / $dX;
    my $b = $dX == 0 ? undef : $y1 - $m * $x1;
    
    # Sigma as a percentage of segment length
    if ($sigma =~ s/%//) {
        my $length = sqrt($dX ** 2 + $dY ** 2);
        $sigma *= $length / 100;
    }
    
    # Perpendicular M
    # M = -1 / m;
    # Y = M x + B
    my $M = ! defined $m ? 0 : $m == 0 ? undef : -1 / $m;
    
    # Anonymous sub to match multiple points.
    return sub {
        my ($x, $y) = @_;
        
        # Calculate [X,Y]: closest point on segment to [x,y]
        my ($X, $Y);
        
        # Vertical Line (constant x)
        if (! defined $m) {
            $X = $x1;
            $Y = $y;
            $Y = $y1 if $Y < $y1;
            $Y = $y2 if $Y > $y2;
        # Horizontal Line (constant y)
        } elsif ($m == 0) {
            $X = $x;
            $X = $x1 if $X < $x1;
            $X = $x2 if $X > $x2;
            $Y = $y1;
        # Regular line
        } else {
            my $B = $y - $M * $x;
            $X = ($B - $b) / ($m - $M);
            $Y = $m * $X + $b;
            ($X,$Y) = ($x1, $y1) if $X < $x1;
            ($X,$Y) = ($x2, $y2) if $X > $x2;
        }
        
        my $dist = sqrt(($x-$X) ** 2 + ($y-$Y) ** 2);
        
        return $dist <= $sigma;
    };
}