File Coverage

blib/lib/Statistics/SparseVector.pm

Criterion	Covered	Total	%
statement	117	140	83.5
branch	21	28	75.0
condition	4	6	66.6
subroutine	22	27	81.4
pod	18	23	78.2
total	182	224	81.2

package Statistics::SparseVector;

##---------------------------------------------------------------------------##
##  Author:
##      Hugo WL ter Doest       [e-mail]
##  Description: module for sparse bitvectors
##               method names equal that of Bit::Vector
##
##---------------------------------------------------------------------------##
##  Copyright (C) 1998, 1999 Hugo WL ter Doest [e-mail]
##
##  This library is free software; you can redistribute it and/or modify
##  it under the terms of the GNU General Public License as published by
##  the Free Software Foundation; either version 2 of the License, or
##  (at your option) any later version.
##
##  This library  is distributed in the hope that it will be useful,
##  but WITHOUT ANY WARRANTY; without even the implied warranty of
##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
##  GNU General Public License for more details.
##
##  You should have received a copy of the GNU Library General Public
##  License along with this program; if not, write to the Free Software
##  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
##---------------------------------------------------------------------------##


use strict;
use vars qw($VERSION
	    @ISA
	    @EXPORT
	    @EXPORT_OK);
use overload
'++'     =>    \&increment,
'='      =>    \&Clone,
'""'     =>    \&stringify;
require Exporter;
require AutoLoader;

@ISA = qw(Exporter AutoLoader);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(

);
$VERSION = '0.2';


# Preloaded methods go here.

# necessary for overloading ""
# in turn required by Data::Dumper that wants to stringify variables
sub stringify {
    my($self) = @_;

    return($self);
}


# create a new bitvector
# all bits are `off'
sub new {
    my($this, $n) = @_;

    # for calling $self->new($someth):
    my $class = ref($this) || $this;
    my $self = {};
    bless $self, $class;
    $self->{N} = $n;
#    $self->{VECTOR} = {};
    return($self);
}


# create a copy of a bitvector and return it
sub Clone {
    my($self) = @_;

    my($new);

    $new = Statistics::SparseVector->new($self->{N});
    bless $new, ref($self);
    for (keys %{$self->{VECTOR}}) {
	$new->{VECTOR}{$_} = $self->{VECTOR}{$_};
    }
    return($new);
}


# is called right before Perl destroys a bitvector
# this happens automatically if a vector has zero references
sub DESTROY {
    my($self) = @_;
}


# creates a new vector from a bitstring
# checks for whitespace separators
sub new_vec {
    my($this, $n, $vector, $vectype) = @_;

    my($i,
       @ints,
       $int,
       $self,
       $sep);

    $sep = '';
    if ($vector =~ /\s+/) {
	$sep = '\s+';
    }
    @ints = split(/$sep/, $vector);
    if ($#ints+1 != $n) {
	die "inconsistent call to new_vec\n";
    }
    $self = $this->new($n);
    $i = 0;
    while (@ints) {
	$int = shift(@ints);
	if ($int > 0) {
	    $self->{VECTOR}{$i} = ($vectype eq "binary") ? 1 : $int;
	}
	$i++;
    }
    return($self);
}


# the value at position $col
sub weight {
    my($self, $col) = @_;

    return($self->{VECTOR}{$col});
}


# we assume a bit is `on' if its value is defined
sub bit_test {
    my($self, $i) = @_;

    return(defined($self->{VECTOR}{$i}));
}


# turning off a bit is making its value undefined
sub Bit_Off {
    my($self, $i) = @_;

    undef $self->{VECTOR}{$i};
}


# turns on a bit
sub Bit_On {
    my($self, $i) = @_;

    $self->{VECTOR}{$i} = 1;
}


# increment integer at position $i by one
sub Inc {
    my($self, $i) = @_;

    $self->{VECTOR}{$i}++;
}


# flips a bit, i.e. makes it undef if it is defined,
# and makes it defined if it is undefined
sub bit_flip {
    my($self, $i) = @_;

    if (defined($self->{VECTOR}{$i})) {
	undef $self->{VECTOR}{$i};
    }
    else {
	$self->{VECTOR}{$i} = 1;
    }
}


# increases the integer value of the bitvector by one
sub increment {
    my($self) = @_;

    my($carry, $i);

    $carry = 0;
    $i = 0;
    do {
	if (defined($self->{VECTOR}{$i})) {
	    undef $self->{VECTOR}{$i};
	    $carry = 1;
	}
	else {
	    $self->{VECTOR}{$i} = 1;
	    $carry = 0;
	}
	$i++;
    } until (($carry == 0) || ($i == $self->{N}));
}


# fills the set
sub Fill {
    my($self) = @_;

    my $i;

    for ($i = 0; $i < $self->{N}; $i++) {
	$self->{VECTOR}{$i} = 1;
    }
}


# clears the vector
sub Empty {
    my($self) = @_;

    undef $self->{VECTOR};
}


# returns a bitstring
sub to_Bin {
    my($self, $sep) = @_;

    my($s, $i);

    $s = "";
    for ($i = 0; $i < $self->{N}; $i++) {
	if (defined($self->{VECTOR}{$i})) {
	    $s = "1$sep" . $s;
	}
	else {
	    $s = "0$sep" . $s;
	}
    }
    return($s);
}


# returns a bitstring
sub to_Int {
    my($self) = @_;

    my($s, $i);

    $s = "";
    for ($i = 0; $i < $self->{N}; $i++) {
	if (defined($self->{VECTOR}{$i})) {
	    $s .= "$self->{VECTOR}{$i} ";
	}
	else {
	    $s .= "0 ";
	}
    }
    return($s);
}


# returns a comma-separated list of features that are on
sub to_Enum {
    my($self) = @_;

    return(join(',', keys(%{$self->{VECTOR}})));
}


# expects a comma-separated list of numbers
sub new_Enum {
    my($this, $n, $s) = @_;

    my($self);

    $self = $this->new($n);
    for (split(/,/,$s)) {
	$self->{VECTOR}{$_} = 1
    }
    return($self);
}


# returns the length of the vector
sub Size {
    my($self) = @_;

    return($self->{N});
}


# NOTA BENE: THIS ROUTINE HAS BUGS
# $len1 >= 0, $len2 >= 0, $vec2->Size() >= $off2 >= 0
# $vec1->Size() >= $off1 >= 0
# $vec1 may be undefined
# $len1 + $off1 < $vec->Size()
sub Interval_Substitute {
    my($vec2, $vec1, $off2, $len2, $off1, $len1) = @_;

    my($i,
       $oldvec2);

    # save  $vec2 in $oldvec2
    $oldvec2 = $vec2->Clone();
    # determine the new length for $vec2
    if ($off2 == $vec2->Size()) {
	# we are appending bits from source $vec1
	$vec2->{N} += $len1;
    }
    else {
	# we are inserting bits from $vec1
	$vec2->{N} += $len1 - $len2;
    }
    # target $vec2 changes only from $off2
    # copy the new bits from the source $vec1
    if (defined($vec1)) { # we have source bits
	for ($i = $off2; $i < $off2 + $len1; $i++) {
	    if (defined($vec1->{VECTOR}{$i - $off2 + $off1})) {
		$vec2->{VECTOR}{$i} = $vec1->{VECTOR}{$i - $off2 + $off1};
	    }
	    else {
		undef $vec2->{VECTOR}{$i};
	    }
	}
    }
    # append the rest of $oldvec2
    # index $i runs for $oldvec2, we correct for $vec2
    for ($i = $off2 + $len2; $i < $oldvec2->{N}; $i++) {
	if (defined($oldvec2->{VECTOR}{$i})) {
	    $vec2->{VECTOR}{$i-$len2+$len1} = $oldvec2->{VECTOR}{$i};
	}
	else {
	    undef $vec2->{VECTOR}{$i-$len2+$len1};
	}
    }
    undef $oldvec2;
#    print "$vec2->to_Bin()\n"
}


# removes a column from the vector
sub delete_column {
    my($self, $col) = @_;

    my($i);

    for ($i = 0; $i < $self->{N} - 1; $i++) {
	if ($i >= $col) {
	    $self->{VECTOR}{$i} = $self->{VECTOR}{$i + 1};
	}
    }
    undef $self->{VECTOR}{$self->{N}-1};
    $self->{N}--;
}


sub insert_column {
    my($self, $pos, $val) = @_;

    my($i);

    $self->{N}++;
    for ($i = $self->{N}-1; $i > $pos; $i--) {
	$self->{VECTOR}{$i} = $self->{VECTOR}{$i - 1};
    }
    $self->{VECTOR}{$pos} = $val;
}


# returns an array of indices of set bits
sub indices {
    my($self) = @_;

    return(grep(defined($self->{VECTOR}{$_}), keys(%{$self->{VECTOR}})));
#    return(keys(%{$self->{VECTOR}}));
}


# the sum of the values
sub Norm {
    my($self) = @_;

    my($n);

    $n = 0;
    for (values(%{$self->{VECTOR}})) {
	if (defined($_)) {
	    $n += $_;
	}
    }
    return($n);
}


# Autoload methods go after =cut, and are processed by the autosplit program.

1;

__END__