view release on metacpan or  search on metacpan

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

package Algorithm::LBFGS;

use strict;
use warnings;

use XSLoader;

our $VERSION = '0.16';
XSLoader::load('Algorithm::LBFGS', $VERSION);

# constructor
sub new {
    my $class = shift;
    my %param = @_;
    my $self = bless { param => create_lbfgs_param() }, $class;
    $self->set_param(%param);
    return $self;
}

# destructor
sub DESTROY {
    my $self = shift;
    destroy_lbfgs_param($self->{param});
}

# set parameters
sub set_param {
    my $self = shift;
    my %param = @_;
    set_lbfgs_param($self->{param}, $_, $param{$_}) for keys %param;
}

# get parameters
sub get_param {
    my $self = shift;
    my $name = shift;
    return set_lbfgs_param($self->{param}, $name, undef);
}

# verbose monitor
my $verbose_monitor = sub {
    my ($x, $g, $fx, $xnorm, $gnorm, $step, $k, $ls, $user_data) = @_;
    ($fx, $xnorm, $gnorm, $step) = 
        map { sprintf("%g", $_) } ($fx, $xnorm, $gnorm, $step);
    my $hr = "=" x 79;
    my $s = ":";
    print <<MSG;
Iteration $k
$hr  
  f(x)             $s $fx
  || x ||          $s $xnorm
  || grad f(x) ||  $s $gnorm
  line search step $s $step
  evaluations num  $s $ls

MSG
    return 0;
};

# logging monitor
my $logging_monitor = sub {
    my ($x, $g, $fx, $xnorm, $gnorm, $step, $k, $ls, $user_data) = @_;
    push @$user_data, {
        x => $x, g => $g, fx => $fx, xnorm => $xnorm, gnorm => $gnorm,
	step => $step, k => $k, ls => $ls, user_data => $user_data
    };    
    return 0;
};

# do optimization
sub fmin {
    my $self = shift;
    my ($lbfgs_eval, $x0, $lbfgs_prgr, $user_data) = @_;
    if (defined($lbfgs_prgr)) {
        $lbfgs_prgr = $verbose_monitor if ($lbfgs_prgr eq 'verbose');