######################### -*- Mode: Perl -*- #########################
##
## File          : $Basename: LSP.pm $
##
## Author        : Norbert Goevert
## Created On    : Wed Nov 11 15:56:08 1998
## Last Modified : Time-stamp: <2000-11-15 23:22:25 goevert>
##
## Description   : compute regression functions with the least square
##                 polynomials (LSP) approach
##
## $Id: LSP.pm 1.4 Wed, 15 Nov 2000 23:35:03 +0100 goevert $
## $ProjectHeader: LSP 2.6 Wed, 29 Nov 2000 09:57:57 +0100 goevert $
##
######################################################################


use strict;


=pod #---------------------------------------------------------------#

=head1 NAME

LSP - compute regression functions with the least square polynomials
      (LSP) approach

=head1 SYNOPSIS

  require LSP;
  $LSP = new LSP $relevancescale, $dimension, @polynomial;

  # adding new vectors
  $LSP->add_vector($vector, $judge [, $scalar]);

  # get the momental matrix
  $momental = $LSP->momental;

  # get the solution
  $solution = $LSP->solve;

  # compute probabilities
  $prob = $LSP->probability($vector [, $scale]);

=head1 DESCRIPTION

In the least square polynomials (LSP) approach predefined polynomial
structures are taken as function classes in order to derive a
regression function for given sample data.

Within the class LSP this approach has been implemented. Due to
efficiency additional classes for more special cases are provided:
LSP::Linear(3) for linear functions, LSP::Binary(3) for just
considering binary relevancescales and therefor providing solutions
just for the case I<relevance>. LSP::Binary::Linear(3) is a
combination of them. See their respective documentation for further
information.

=head1 METHODS

=over

=cut #---------------------------------------------------------------#


package LSP;


require Math::Matrix;
use Storable;


our $VERSION;
'$ProjectVersion: 2.6 $ ' =~ /(\d+)\.(\d+)/; $VERSION = sprintf '%d.%03d', $1, $2;


## public ############################################################

=pod #---------------------------------------------------------------#

=item $lsp = LSP->new($relevancescale, $dimension, @polynomial);

$relevancescale gives the number of different relevant values to be
considered. Most of the time you'll only want to consider 2 values,
namely I<relevant> and I<non-relevant>.

$dimension gives the number of features within your feature vectors.

The polynomial structure to use is given in the @polinomial vector.
For each component you've to provide one array reference. Within these
references you need one exponent for each dimension of your feature
vector. These must be given within the same ordering in which you'll
provide the features later when adding vectors. Example:

      ( [  0  ,     1     ,       2       ],
        [  1  ,     2     ,       3       ] )

describes a polynomial for feature vectors with dimension three; the
polynomial structure consuists of two components. The two components
are computed the following way:

  f1(x) =        x2       *  x3 * x3
  f2(x) =  x1 *  x2 * x2  *  x3 * x3 * x3

=cut #---------------------------------------------------------------#

sub new {

  my $proto = shift;
  my $class = ref($proto) || $proto;
  my $self  = {};

  my($relevancescale, $dimension, @polynomial) = @_;

  bless $self => $class;

  $self->{relevancescale} = $relevancescale;
  $self->{dimension}      = $dimension;
  $self->{components}     = scalar @polynomial || $dimension + 1;
  $self->{polynomial}     = [];
  if (@polynomial) {
    $self->{polynomial}   = \@polynomial;
    # check dimension
    foreach (@polynomial) {
      return $self->_fail("Component [ @$_ ] of wrong dimension.")
        if scalar @$_ != $self->{dimension};
    }
    # create function for components
    $self->_create_components;
  }

  $self->_init_momental;

  $self;
}


=pod #---------------------------------------------------------------#

=item $lsp->add_vector($vector, $judge [, $scalar]);

add feature vector $vector (array reference containing $dimension
elements) to the sample. $judge gives the relevance judgement for this
vector, also an array reference containing $relevancescale values.

If $scalar is given, $vector is added $scalar times.

=cut #---------------------------------------------------------------#

sub add_vector {

  my $self = shift;
  my($vector, $judge, $scalar) = @_;

  return $self->_fail("Wrong dimension of vector ( @$vector ).")
    if @$vector ne $self->{dimension};

  # compute values of polynomial components
  my $newvec = $self->_components($vector);

  my $vec_vy  = new Math::Matrix [ @$newvec, @$judge ];
  my $vec_v_t = (new Math::Matrix [ @$newvec ])->transpose;
  my $product = $vec_v_t->multiply($vec_vy);

  if (not defined $scalar or $scalar == 1) {
    $self->{momental}->add_to($vec_v_t->multiply($vec_vy));
  } else {
    $self->{momental}->add_to($vec_v_t->multiply($vec_vy)->scalarproduct($scalar));
  }
}


=pod #---------------------------------------------------------------#

=item $momental  = $lsp->momental

return the momental matrix, an Object of class Math::Matrix(3).

=cut #---------------------------------------------------------------#

sub momental {

  my $self = shift;

  return $self->{momental};
}


=pod #---------------------------------------------------------------#

=item $solution = $lsp->solve

return the solution of the momental matrix, an Object of class
Math::Matrix(3).

=cut #---------------------------------------------------------------#

sub solve {

  my $self = shift;

  $self->{solution} = $self->{momental}->solve;

  return $self->{solution};
}


=pod #---------------------------------------------------------------#

=item $prob = $lsp->probability($vector [, $scale]);

computes the probability with respect to the derived regression
function.

=cut #---------------------------------------------------------------#

sub probability {

  my $self = shift;
  my($vector, $scale) = @_;

  $scale = 0 unless defined $scale;

  my $newvec = $self->_components($vector);
  my $coefficients = $self->{solution}->column($scale)->transpose;

  my $sum = 0;
  foreach my $i (0 .. $#{$coefficients->[0]}) {
    $sum += $coefficients->[0]->[$i] * $newvec->[$i];
  }

  $sum;
}


=pod #---------------------------------------------------------------#

=item $lsp->save($file);

save $lsp object to file $file. Only works in case the solution has
been computed already. The object can later be retrieved with the load
constructor (see below).

=cut #---------------------------------------------------------------#

sub save {

  my $self = shift;
  my $file = shift;

  return undef unless $self->{solution};

  my @solution;
  foreach (@{$self->{solution}}) {
    push @solution, [ map { pack 'd', $_ } @$_ ];
  }
  store( [ $self->{relevancescale},
           $self->{dimension},
           $self->{components},
           $self->{polynomial},
           \@solution
         ],
         $file
       )
    or die "Couldn't store LSP object to file `$file': $!\n";
}


=pod #---------------------------------------------------------------#

=item $lsp = LSP->load($file);

Load constructor: restore an LSP object from file $file.

=cut #---------------------------------------------------------------#

sub load {

  my $proto = shift;
  my $class = ref $proto || $proto;

  my $self = {};
  my $file = shift;

  my $solution;

  # polynomial structure
  my $lsp = retrieve $file
    or die "Couldn't retrieve LSP object from file `$file': $!\n";

  ( $self->{relevancescale},
    $self->{dimension},
    $self->{components},
    $self->{polynomial},
    $solution
  ) = @$lsp;

  my @solution;
  foreach (@$solution) {
    push @solution, [ map { unpack 'd', $_ } @$_ ];
  }
  $self->{solution} = Math::Matrix->new(@solution);

  bless $self => $class;
  print ref($self), "\n";

  if ($self->can('_create_function')) {
    $self->_create_function;
  } else {
    $self->_create_components;
  }

  $self;
}


## private ###########################################################

sub _init_momental {

  my $self = shift;

  my @row = (0) x ($self->{components} + $self->{relevancescale});
  my @matrix;
  foreach (1 .. $self->{components}) {
    push @matrix, [ @row ];
  }

  $self->{momental} = new Math::Matrix @matrix;
}


sub _create_components {

  my $self = shift;

  my $string = "sub {\n\n  my \$v = shift;\n  [ ";

  foreach (@{$self->{polynomial}}) {
    my $comp = '';
    foreach my $i (0 .. $#{$_}) {
      next unless $_->[$i];
      if ($_->[$i] == 1) {
        $comp .= " * \$v->[$i]";
      } else {
        $comp .= " * \$v->[$i]**$_->[$i]";
      }
    }
    $comp =~ s/^ \* //;
    $comp = '1' unless $comp;
    $string .= "$comp,\n    ";
  }
  $string =~ s/,\n    $//;
  $string .= "\n  ];\n}\n";

  #print $string;

  $self->{_components} = eval $string;
}


sub _components {

  my $self = shift;

  return &{$self->{_components}}(@_);
}


sub _fail {

  my $self = shift;
  $@ = shift;

  return undef;
}


=pod #---------------------------------------------------------------#

=back

=head1 BUGS

Yes. Please let me know! In addition: The save method depends on the
internal data representation of an Math::Matrix object.

=head1 SEE ALSO

LSP::Linear(3),
LSP::Binary(3),
LSP::Binary::Linear(3),
Math::Matrix(3),
perl(1).

=head1 AUTHOR

Norbert GE<ouml>vert E<lt>F<goevert@ls6.cs.uni-dortmund.de>E<gt>

=cut #---------------------------------------------------------------#


1;
__END__
