package SparseVector;
## No strict vars
use strict subs;
use Carp;

## Overload certain arithmetical operations
use overload (
	      '+'   => \&add,
	      '*'   => \&multiply,
	      '""'  => \&str,
	      '='   => \&copy,
	      '@{}' => \&array,
	      );

## Generate symbols (typeglobs) on the fly
use Symbol qw/gensym/;

## Constant zero
*ZERO=\0;

##################################################################
##
## Tie framework methods for overloading arrays
##
##################################################################

sub TIEARRAY {
    my $class = shift;
    return bless {size => 0, elements => { }}, $class;
}

sub FETCH($$) {
    my $self = shift;
    confess "wrong type" unless ref $self;
    my $idx = shift;
    confess "negative index" unless $idx >= 0;
    return exists $self->{elements}->{$idx} ?
	$self->{elements}->{$idx} :
	$ZERO;
}

sub STORE($$$) {
    my $self = shift;
    confess "wrong type" unless ref $self;
    my $idx = shift;
    confess "negative index" unless $idx >= 0;
    my $val = shift;
    
    $self->{size} = ($idx > $self->{size}) ? $idx : $self->{size};
    $self->{elements}->{$idx} = $val unless $val == $ZERO;
    return $val;
}

sub UNTIE($) {
    my $self = shift;
    confess "wrong type" unless ref $self;
    undef $self->{size};
    undef $self->{elements};
    undef $self;
}

sub FETCHSIZE($) {
    my $self = shift;
    confess "wrong type" unless ref $self;
    return $self->{size} + 1;
}

sub CLEAR($) {
    my $self = shift;
    confess "wrong type" unless ref $self;
    $self->{size} = 0;
    %{$self->{elements}} = ();
    return $self;
}

sub EXTEND($$) {
   my $self = shift;
   confess "wrong type" unless ref $self;
   my $count = shift;
   $self->{size} += $count;
}

##################################################################
##
## Overloaded operations framework
##
##################################################################
sub add($$$) {
    my($x, $y, $rev_info) = @_;
    my $z = SparseVector->TIEARRAY;
    foreach $i (&union(keys(%{$x->{elements}}), keys(%{$y->{elements}}))) {
	my $val = $x->FETCH($i) + $y->FETCH($i);
	unless($val == 0) {
	    $z->STORE($i, $val);
	}
    }
    return $z;
}

sub multiply($$$) {
    my($x, $y, $rev_info) = @_;
    if(ref $y) {
	#Dot product
	my $z = 0;
	foreach $i (&union(keys(%{$x->{elements}}), keys(%{$y->{elements}}))) {
	    my $val = $x->FETCH($i) * $y->FETCH($i);
	    unless($val == 0) {
		$z += $val;
	    }
	}
	return $z;
    } else {
	#Scalar product
	my $z = SparseVector->TIEARRAY;
	foreach $i (keys(%{$x->{elements}})) {
	    my $val = $x->FETCH($i) * $y;
	    unless($val == 0) {
		$z->STORE($i, $val);
	    }
	}
	return $z;
    }
}

## Deep copy
sub copy($$) {
    my($x, $y) = @_;
    unless (\$x == \$y) {
	$y->{size} = $x->{size};
	%{$y->{elements}} = %{$x->{elements}}
    }
}

## Custom string conversion
sub str {
    my $self = shift;
    my $elts = $self->{elements};
    my $size = $self->{size};
    my @indices = sort { $a <=> $b } keys(%$elts);
    my @out;
    foreach $idx (@indices) { 
	push @out, "$idx => $elts->{$idx}";
    }
    __PACKAGE__ . "(size => $size, elements=(" . join(", ", @out) . "))";
}

sub array($) {
    my $self = shift;
    my $sym = gensym;
    tie @{*$sym}, 'SparseVector';
    my $ob = tied @{*$sym};
    copy $self, $ob;
    return \@{*$sym};
}

## Utilities
sub union(@@) {
    my($a, $b) = @_;
    my %u = ();
    foreach $e ($a, $b) { $u{$e}++ }
    return keys(%u);
}

1;