view release on metacpan or  search on metacpan

t/algorithms.t  view on Meta::CPAN

    my ($tree_link, $target, $cmp) = @_
    my $node

    while $node = $$tree_link:
        no warnings
        my $relation = defined $cmp ? $cmp->($target, $node->{val}) \
                                    : $target <=> $node->{val}
        return ($tree_link, $node) if $relation == 0
        $tree_link = $relation > 0 ? \$node->{left} : \$node->{right}

    return ($tree_link, undef)

sub basic_tree_add:
    my ($tree_link, $target, $cmp) = @_
    my $found

    ($tree_link, $found) = basic_tree_find($tree_link, $target, $cmp)
    unless $found:
        $found = {left  => undef,
                  right => undef,
                  val   => $target}
        $$tree_link = $found

    return $found

sub basic_tree_del:
    my ($tree_link, $target, $cmp) = @_
    my $found

    ($tree_link, $found) = basic_tree_find($tree_link, $target, $cmp)
    return undef unless $found
    if ! defined $found->{left}:
        $$tree_link = $found->{right}
    elsif ! defined $found->{right}:
        $$tree_link = $found->{left}
    else:
        MERGE_SOMEHOW($tree_link, $found)

    return $found->{val}

sub MERGE_SOMEHOW:
    my ($tree_link, $found) = @_
    my $left_of_right = $found->{right}
    my $next_left

    $left_of_right = $next_left \
        while $next_left = $left_of_right->{left}

    $left_of_right->{left} = $found->{left}

    $$tree_link = $found->{right}


# ----------------------------------------------------------------------
#
# Now I will port the next subroutines meticulously from the listings in
# the book, respecting comments, whitespace, etc. Except in one place.
#
# ----------------------------------------------------------------------

# manhattan_intersection( @lines )
#   Find the intersection of strictly horizontal and vertical lines.
#   Requires basic_tree_add(), basic_tree_del(), and basic_tree_find(),
#   all defined in Chapter 3, Advanced Data Structures
sub manhattan_intersection:
    my @op # The coordinates are transformed here as operations.

    while @_:
        my @line = splice @_, 0, 4

        if $line[1] == $line[3]:        # Horizontal.
            push @op, [ @line, \&range_check_tree ]
        else:
            # Swap if upside down.
            @line = @line[0, 3, 2, 1] if $line[1] > $line[3]

            push @op, [ @line[0, 1, 2, 1], \&basic_tree_add ]
            push @op, [ @line[0, 3, 2, 3], \&basic_tree_del ]

    my $x_tree # The range check tree.
    # The x coordinate comparison routine.
    my $compare_x = sub { $_[0]->[0] <=> $_[1]->[0] }
    my @intersect # The intersections.

    # We don't reproduce the multi-line here because parens are not put correctly.
    foreach my $op in sort { $a->[1] <=> $b->[1] || $a->[4] == \&range_check_tree || $a->[0] <=> $b->[0] } @op:
        if $op->[4] == \&range_check_tree:
            push @intersect, $op->[4]->( \$x_tree, $op, $compare_x )
        else: # Add or delete.
            $op->[4]->( \$x_tree, $op, $compare_x )

    return @intersect


#
# The implementation of range_check_tree() in the book is buggy, I
# submitted the bug to the authors.
#

# range_check_tree( $tree_link, $horizontal, $compare )
#
#    Returns the list of tree nodes that are within the limits
#    $horizontal->[0] and $horizontal->[1]. Depends on the binary
#    trees of Chapter 3, Advanced Data Structures.
sub range_check_tree:
    my ( $tree, $horizontal, $compare ) = @_

    my @range         = ()     # The return value.
    my $node          = $$tree
    my $vertical_x    = $node->{val}
    my $horizontal_lo = [ $horizontal->[ 0 ] ]
    my $horizontal_hi = [ $horizontal->[ 2 ] ]

    return unless defined $$tree

    push @range, range_check_tree( \$node->{left}, $horizontal, $compare ) \
        if defined $node->{left}

    push @range, $vertical_x->[ 0 ], $horizontal->[ 1 ] \
         if $compare->( $horizontal_lo, $vertical_x ) <= 0 && \
            $compare->( $horizontal_hi, $vertical_x ) >= 0

    push @range, range_check_tree( \$node->{right}, $horizontal,
                                   $compare ) \
        if defined $node->{right}

    return @range

my @lines = (0, 0, 0, 1)
is_deeply [manhattan_intersection(@lines)], []

@lines = (0, 0, 1, 0)
is_deeply [manhattan_intersection(@lines)], []

@lines = (0, 0, 1, 0, 0, 1, 1, 1, 0, 2, 1, 2)
is_deeply [manhattan_intersection(@lines)], []

@lines = (0, 0, 0, 1, 1, 0, 1, 1, 2, 0, 2, 1)
is_deeply [manhattan_intersection(@lines)], []

@lines = (0, 1, 2, 1, 1, 0, 1, 2)
is_deeply [manhattan_intersection(@lines)], [1, 1]

# This is the example in the book.
@lines = ( 1, 6,  1, 3,  1, 2,  3, 2,  1, 1,  4, 1,
              2, 4,  7, 4,  3, 0,  3, 6,  4, 3,  4, 7,
              5, 7,  5, 4,  5, 2,  7, 2 )
# And this is the correct answer, check Figure 10-10, which is right.
is_deeply [manhattan_intersection(@lines)], [3, 1, 3, 2, 5, 4, 4, 4, 3, 4]