view release on metacpan or  search on metacpan

t/algorithms.t  view on Meta::CPAN

    # mentres el quadrat del nombre mŽs gran
    # dels primers sigui mŽs petit que el nombre
    # mŽs gran de la llista, esborra els mœltiples
    # del primer mŽs gran a la llista de nombres
    while @nombres && ($primers[-1] ** 2) <= $nombres[-1]:
        @nombres = grep:
	        $_ % $primers[-1]
	    @nombres
	   push(@primers, shift(@nombres))


    return join(',', @primers, @nombres)
    
is eratostenes(2), "2"
is eratostenes(3), "2,3"
is eratostenes(5), "2,3,5"
is eratostenes(6), eratostenes(5)
is eratostenes(49), "2,3,5,7,11,13,17,19,23,29,31,37,41,43,47" 
is eratostenes(50), eratostenes(49)

# ----------------------------------------------------------------------

sub bubblesort:
    my $array = shift
    for my $i = $#$array; $i; $i--:
        for my $j = 1; $j <= $i; $j++:
            if $array->[$j-1] > $array->[$j]:
                @$array[$j, $j-1] = @$array[$j-1, $j]

my @a = 1..10
bubblesort \@a
is_deeply \@a, [sort { $a <=> $b } @a]

@a = (1,2,3,2,-1)
bubblesort \@a
is_deeply \@a, [sort { $a <=> $b } @a]

@a = reverse 50..100
bubblesort \@a
is_deeply \@a, [sort { $a <=> $b } @a]

# ----------------------------------------------------------------------


# These subroutines are ports to Acme::Pythonic from the ones in
# "Mastering Algorithms with Perl" except the last one, which I fixed
# myself. The one in the book is buggy.

sub basic_tree_find:
    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 )