File Coverage

blib/lib/Math/Vector/Real/Polyline.pm

Criterion	Covered	Total	%
statement	12	86	13.9
branch	0	24	0.0
condition	0	6	0.0
subroutine	4	12	33.3
pod	4	6	66.6
total	20	134	14.9

package Math::Vector::Real::Polyline;

our $VERSION = '0.01';

use strict;
use warnings;

use Math::Vector::Real;

our $debug = 0;

sub as_string;
use overload '""' => \&as_string;

sub new {
    my $class = shift;
    my $self = [map V(@$_), @_];
    bless $self, $class;
}

sub dist2_to_point {
    my $self = shift;
    my $p = V(shift);
    return unless @$self;
    my $min_d2 = $self->[0]->dist2($p);

    for my $i (1..$#$self) {
        my $d2 = $p->dist2_to_segment($self->[$i-1], $self->[$i]);
        $min_d2 = $d2 if $d2 < $min_d2;
    }

    $min_d2;
}

sub dist2_to_segment {
    my ($self, $a, $b) = @_;
    my $min_d2 = $self->[0]->dist2($a);
    for my $i (1..$#$self) {
        my $d2 = Math::Vector::Real->dist2_between_segments($a, $b,
                                                            $self->[$i - 1], $self->[$i]);
        $min_d2 = $d2 if $d2 < $min_d2;
    }
    $min_d2;
}

sub _dist2_to_polyline_brute_force {
    my ($self, $other, $min_d2) = @_;

    for my $i (1..$#$self) {
        my $s0 = $self->[$i - 1];
        my $s1 = $self->[$i];
        for my $j (1..$#$other) {
            my $d2 = Math::Vector::Real->dist2_between_segments($s0, $s1,
                                                                $other->[$j-1], $other->[$j]);
            $min_d2 = $d2 if $d2 < $min_d2;
        }
    }
    $min_d2;
}

my $cutoff = 5;

sub _dump_queue {
    my $min_d2 = shift;
    printf "Queue size: %d, min_d2: %f\n", scalar(@_), $min_d2;
    for (@_) {
        my $a = Math::Vector::Real::Polyline->new(@{$_->[0]});
        my $b = Math::Vector::Real::Polyline->new(@{$_->[1]});
        my $d2 = $_->[2];
        print "  a: $a b: $b d2: $d2\n";
    }
}

sub dist2_to_polyline {
    my $self = shift;
    my $other = shift;
    return unless @$self and @$other;
    return $other->dist2_to_point($self->[0]) if @$self == 1;
    return $self->dist2_to_point($other->[0]) if @$other == 1;

    my $min_d2 = $self->[0]->dist2($other->[0]);
    my @queue = [$self, $other, 0];

    while (@queue) {
        $debug and _dump_queue($min_d2, @queue);
        my ($a, $b, $bb_d2) = @{pop @queue};
        last if $bb_d2 >= $min_d2;

        if (@$a <= $cutoff or @$b <= $cutoff) {
            $min_d2 = _dist2_to_polyline_brute_force($a, $b, $min_d2);
        }
        else {
            my $a_half = int(@$a / 2);
            my $a0 = [@{$a}[0..$a_half]];
            my $a1 = [@{$a}[$a_half..$#$a]];
            my $b_half = int(@$b / 2);
            my $b0 = [@{$b}[0..$b_half]];
            my $b1 = [@{$b}[$b_half..$#$b]];
            for my $pair ([$a0, $b0], [$a0, $b1], [$a1, $b0], [$a1, $b1]) {
                my $bb_d2 = Math::Vector::Real->dist2_between_boxes(Math::Vector::Real->box(@{$pair->[0]}),
                                                                    Math::Vector::Real->box(@{$pair->[1]}));
                next if $bb_d2 > $min_d2;
                $pair->[2] = $bb_d2;
                my $i;

                for ($i = $#queue; $i >= 0; $i--) {
                    my $pivot = $queue[$i];
                    last if $bb_d2 <= $pivot->[2];
                    $queue[$i + 1] = $pivot
                }
                $queue[$i + 1] = $pair;
            }
        }
    }
    return $min_d2;
}

sub dist_to_polyline { sqrt(&dist2_to_polyline) }

sub as_string {
    my $self = shift;
    return '['.join('-', @$self).']';
}

1;
__END__