view release on metacpan or  search on metacpan

lib/Algorithm/BitVector.pm  view on Meta::CPAN

              '&'        =>    '_and',
              '^'        =>    '_xor',
              '<=>'      =>    '_compare',
              '<<'       =>    '_lshift',
              '>>'       =>    '_rshift',
              '<>'       =>    '_iter',
              'fallback' =>    1;

sub _readblock {
    my $blocksize = shift;
    my $bitvector = shift;
    my $block;
    my $more_to_read;
    my $i = 0;
    my $byte_as_bits;
    my $bitstring = '';
    while ( $i < $blocksize / 8 ) {
        $i++;
        my $num_bytes_read = sysread($bitvector->{FILEIN}, my $byte, 1);
        unless ($num_bytes_read) {
            if (length($bitstring) < $blocksize) { 
                $bitvector->{more_to_read} = 0;
                $more_to_read = 0;
            }
            return $bitstring;
        } else {
            my $bits_as_string = sprintf "%vb", $byte;
            $bits_as_string = '0' x (8 - length($bits_as_string)) . $bits_as_string;
            $bitstring .= $bits_as_string;
        }
    }
    my $file_pos = tell $bitvector->{FILEIN};
    # peek at the next byte; moves file position only if a
    # byte is read
    my $num_bytes_read = sysread($bitvector->{FILEIN}, my $next_byte, 1);
    if ($num_bytes_read) {
        # pretend we never read the byte
        sysseek $bitvector->{FILEIN}, $file_pos - 1, SEEK_CUR;
    } else {
        $bitvector->{more_to_read} = 0;
    }
    return $bitstring;
}

# Constructor:
sub new { 
    my ($class, %args) = @_;
    my @params = keys %args;
    croak "\nYou have used a wrong name for a keyword argument " .
          "--- perhaps a misspelling\n" 
          if _check_for_illegal_params(@params) == 0;
    my $self = {
        filename                          =>   $args{filename},
        size                              =>   $args{size},
        intVal                            =>   $args{intVal},
        bitlist                           =>   $args{bitlist},
        bitstring                         =>   $args{bitstring},
        hexstring                         =>   $args{hexstring},
        textstring                        =>   $args{textstring},
    };
    bless $self, $class;
    if ( $self->{filename} )  {
        die "When using the `filename' option in the constructor call, you cannot use any " .
            "other option at the same time: $!" 
            if $self->{intVal} or $self->{size} or $self->{bitlist} 
               or $self->{bitstring} or $self->{hexstring} or $self->{textstring};
        open $self->{FILEIN}, "< $self->{filename}" 
                            or die "unable to open file $self->{filename}: $!";
        $self->{more_to_read} = 1;
        return $self;
    } elsif ( defined $self->{intVal} )  {
        die "When using the `intVal' option in the constructor call, you CANNOT use `filename', " .
            "`bitlist', 'bitstring', `hexstring', or `textstring' options: $!" 
            if $self->{filename}  or $self->{bitlist} or $self->{bitstring} 
               or $self->{hexstring} or $self->{textstring};
        if ($self->{intVal} == 0 && ! defined $self->{size}) {
            $self->{bitlist} = [0];
            $self->{size} = 1;
        } else {
            my @bitarray;
#            if (ref($self->{intVal}) eq 'Math::BigInt') {
            if (ref($self->{intVal}) eq 'Math::BigInt' && ! defined $self->{size}) {
                my $bitlist_str = $self->{intVal}->as_bin();
                $bitlist_str =~ s/^0b//;
                @bitarray = split //, $bitlist_str;
            } elsif (ref($self->{intVal}) eq 'Math::BigInt' && defined $self->{size}) {   #new<<<<<<<<<<<<<
                my $bitlist_str = $self->{intVal}->as_bin();
                $bitlist_str =~ s/^0b//;
                croak "\nThe value specified for size must be at least as large as for the " .
                      "smallest bitvector possible for the intVal integer: $!" 
                      if $self->{size} < length $bitlist_str;
                @bitarray = split //, $bitlist_str;
                my $n = $self->{size} - @bitarray;
                my $extended_bitlist_str = '0' x $n . $bitlist_str;
                @bitarray = split //, $extended_bitlist_str;
            } else {
                my $bitlist_str = sprintf "%b", $self->{intVal};
                if (defined $self->{size}) {
                    croak "\nThe value specified for size must be at least as large as for the " .
                          "smallest bitvector possible for the intVal integer: $!" 
                          if $self->{size} < length $bitlist_str;
                    my $n = $self->{size} - length $bitlist_str;
                    my $extended_bitlist_str = '0' x $n . $bitlist_str;
                    @bitarray = split //, $extended_bitlist_str;
                } else {
                    @bitarray = split //, $bitlist_str;
                }
            }
            $self->{bitlist} = \@bitarray;
            $self->{size} = scalar @{$self->{bitlist}};
        }
    } elsif (defined $self->{size}) {
        die "When using the `size' option in the constructor call, you CANNOT use `filename', " .
            "`bitlist', 'bitstring', `hexstring', or `textstring' options: $!" 
            if $self->{filename} or $self->{intVal} or $self->{bitlist} 
               or $self->{bitstring} or $self->{hexstring} or $self->{textstring};
        my $bitstring = "0" x $self->{size};   
        my @bitlist_from_bitstring  = split '', $bitstring;
        $self->{bitlist} = \@bitlist_from_bitstring;
    } elsif ($self->{bitlist}) {
        die "When using the `bitlist' option in the constructor call, you cannot use any " .

lib/Algorithm/BitVector.pm  view on Meta::CPAN

    if ( $bv1->{size} < $bv2->{size} ) {
        $bv3 = $bv1->_resize_pad_from_left($bv2->{size} - $bv1->{size});
        $bv4 = $bv2;
    } elsif ( $bv1->{size} > $bv2->{size} ) {
        $bv3 = $bv1;
        $bv4 = $bv2->_resize_pad_from_left($bv1->{size} - $bv2->{size});
    } else {
        $bv3 = $bv1;
        $bv4 = $bv2;
    }
    my $result_bv = Algorithm::BitVector->new( size => $bv3->{size} );
    foreach my $i (0..@{$result_bv->{_vector}}-1) {
        # The binary bitwise `&' operator may assume 32-bit wide fields:
        $result_bv->{_vector}->[$i] = ($bv3->{_vector}->[$i] & $bv4->{_vector}->[$i] ) & 0x0000FFFF;
    }
    return $result_bv;
}

##  Take a bitwise 'XOR' of the bitvector on which the method is invoked with
##  the argument bitvector.  Return the result as a new bitvector.  If the two
##  bitvectors are not of the same size, pad the shorter one with zeros from the
##  left.
sub _xor {
    my ($bv1, $bv2) = @_;    
    croak "Abort: The xor operator invoked with either undefined " .
        "or wrong types of operands: $!"
        unless UNIVERSAL::isa( $bv1, 'Algorithm::BitVector') and
        UNIVERSAL::isa( $bv2, 'Algorithm::BitVector');
    my ($bv3, $bv4);
    if ( $bv1->{size} < $bv2->{size} ) {
        $bv3 = $bv1->_resize_pad_from_left($bv2->{size} - $bv1->{size});
        $bv4 = $bv2;
    } elsif ( $bv1->{size} > $bv2->{size} ) {
        $bv3 = $bv1;
        $bv4 = $bv2->_resize_pad_from_left($bv1->{size} - $bv2->{size});
    } else {
        $bv3 = $bv1;
        $bv4 = $bv2;
    }
    my $result_bv = Algorithm::BitVector->new( size => $bv3->{size} );
    foreach my $i (0..@{$result_bv->{_vector}}-1) {
        # The binary bitwise `^' operator may assume 32-bit wide fields:
        $result_bv->{_vector}->[$i] = ($bv3->{_vector}->[$i] ^ $bv4->{_vector}->[$i] ) & 0x0000FFFF;
    }
    return $result_bv;
}

# For the overloading of the iterator '<>' operator:
sub _iter {
    my $self = shift;
    my $pos = 0;
    $self->{_iterator} = BitVecIterator->new($self, $pos) unless $self->{_iter_called};
    &{$self->{_iterator}->next()};
}

{
    # This inner class needed for implementing iterator overloading:
    package BitVecIterator;
    sub new {
        my $self = [ $_[1], $_[2] ];
        bless $self, $_[0];
        $_[1]->{_iter_called} = 1;
        return $self;
    }
    sub next {
        my $self = shift;
        my $bitvec = $self->[0];
        # The anonymous subroutine that follows is a closure over the variables
        # incorporated in it:
        return sub { 
            if ($self->[1] >= $bitvec->{size}) {
                delete $bitvec->{_iter_called};
                return;
            }
            my $bit = $bitvec->get_bit($self->[1]); 
            $self->[1] =  $self->[1] + 1;
            return $bit;
        } 
    }
}

# for the overloading of the numification operator:
sub _int {
    my $self = shift;
    return $self->int_value();
}

##  Divides an even-sized bitvector into two and returns the two halves as a
##  list of two bitvectors.
sub divide_into_two {
    my $self = shift;
    die "Abort: The divide_into_two() method invoked on an object that is " .
        "not of type Algorithm::BitVector"
        unless UNIVERSAL::isa( $self, 'Algorithm::BitVector');
    die "The bitvector to be divided must have even number of bits: $!"
        if $self->{size} % 2;
    my @outlist1 = ();
    foreach my $i (0..$self->{size} / 2 - 1) {
        push @outlist1, $self->get_bit($i);
    }
    my @outlist2 = ();
    foreach my $i ( ($self->{size} / 2) .. ($self->{size} - 1) ) {
        push @outlist2, $self->get_bit($i);
    }
    return Algorithm::BitVector->new( bitlist => \@outlist1 ), 
           Algorithm::BitVector->new( bitlist => \@outlist2 );
}

##  Permute a bitvector according to the indices shown in the second argument list.
##  Return the permuted bitvector as a new bitvector.
sub permute {
    my $self = shift;
    die "Abort: The permute() method invoked on an object that is " .
        "not of type Algorithm::BitVector"
        unless UNIVERSAL::isa( $self, 'Algorithm::BitVector');
    my $permute_list = shift;
    die "Bad permutation index in your permutation list" 
        if max(@$permute_list) > $self->{size} - 1;
    my @outlist = ();
    foreach my $index (@$permute_list) { 
        push @outlist, $self->get_bit($index);