Раздел «Алгоритмы».BinaryHeapPerl:

Реализация бинарной кучи на Perl

Описание структуры BinaryHeap

Код

package Heap;

sub new {
        my $class       = shift;
        my $default_key = shift;
        if (not $default_key) {
               $default_key = 0;
        }
        my @data  = ();
        my $self  = {
                "data" => \@data,
                "size" => 0,
                "default_key" => $default_key
        };
        bless ($self, $class);
        return $self;
}
sub size {
   my $self = shift;
   return $self->{"size"};
}

sub insert {
        my $self = shift;
        my $data = $self->{"data"};
        my $x = shift;
        
        my $i = ++$self->{"size"};
        
        
        if (not defined $x->{"key"}) {
                warn "Inserted element has no 'key' attribute; 'key' set to $self->{default_key}";
                $x->{"key"} = $self->{"default_key"};
        }
        $x->{"index"} = $i;
        $data->[ $i ] = $x;
        $self->checkup ( $i );
        warn "Added new element $x->{_name} with key = $x->{key}";
}


sub delete {
        my $self = shift;
        my $data = $self->{"data"};
        my $x = shift;
        # warn "Start deleting $x->{_name}";
        my $i = $x->{"index"};
        if($i <= $self->{"size"} && $data->[$i] == $x ) {
                if($i == $self->{"size"}){
                        $data->[ $self->{"size"}] = undef;
                        $self->{"size"}--;
                        return;
                }
                $data->[$i] = $data->[ $self->{"size"}];
                $data->[ $self->{"size"}] = undef;
                $data->[$i]->{"index"} = $i;
                $self->{"size"}--;
                $self->checkdown ( $i );
        } else {
                warn "Deleting element $x->{_name} as $x->{index} (from 1..$self->{size})
                while there we have $data->[$i]->{_name}";
                return 0;
        }
}

sub extract_min {
        my $self = shift;
        my $data = $self->{"data"};
        
        return undef if  $self->{"size"} == 0  ;
        my $x = $data->[1];
        $data->[1] = $data->[ $self->{"size"}-- ];
        $self->checkdown ( 1 );
        return $x;
}

sub checkdown {
        my $self = shift;
        my $data = $self->{"data"};
        my $p = shift;
        my $c;
        
        while(1) {
                $c = 2*$p;
                return if($c > $self->{"size"});
                if( $c + 1 <= $self->{"size"} && $data->[$c+1]->{"key"} < $data->[$c]->{"key"}) {
                        $c++; 
                }
                
                if($data->[$c]->{"key"} < $data->[$p]->{"key"})
                {
                        swap($data, $c, $p);
                        $p = $c;
                        next;
                }
                return;
        }
}

sub checkup {
        my $self   = shift;
        my $data   = $self->{"data"};
        my $c      = shift;         # child 
        my $p;                     # parent
        while(1)
        {
                $p = int( $c / 2);   
                return if ($p == 0);
                if( $data->[$p]->{"key"} > $data->[$c]->{"key"})
                {
                        swap($data, $c, $p);
                        $c = $p;
                        next;
                }
                return;
        }
}

sub swap {
        my ($data, $a, $b) =  @_;
#         warn "swaping $data->[$a]->{_name} and $data->[$b]->{_name}";
        my $tmp;
        $tmp      = $data->[$a]; 
        $data->[$a]   = $data->[$b];
        $data->[$b]   = $tmp;
        $data->[$a]->{"index"} = $a;
        $data->[$b]->{"index"} = $b;
}

sub dump {
        my $self = shift;
        my $file_handle = shift;
        use Data::Dumper;
        $file_handle ||= *STDOUT;
        print $file_handle "HEAP : size = $self->{size}\n";
        print $file_handle Dumper($self);
}
1;
AlgorithmClasifyForm
Type: Код
Scope: Структуры данных
Strategy:  
Language: Perl
Complexity: Medium