|
|
Prev | Next | sparse_hes_pattern_xam.pm | Headings |
package sparse_hes_pattern_xam;
sub sparse_hes_pattern_xam() {
# check for standard perl programming conventions
use strict;
use warnings;
#
# load the Cppad Swig library
use pm_cppad;
#
# initilaize return variable
my $ok = 1;
# ---------------------------------------------------------------------
# number of dependent and independent variables
my $n = 3;
#
# create the independent variables ax
my $x = new pm_cppad::vec_double($n);
for(my $i = 0; $i < $n ; $i++) {
$x->set($i, $i + 2.0);
}
my $ax = pm_cppad::independent($x);
#
# create dependent variables ay with ay[i] = ax[j] * ax[i]
# where i = mod(j + 1, n)
my $ay = new pm_cppad::vec_a_double($n);
for(my $j = 0; $j < $n ; $j++) {
my $i = $j+1;
if( $i >= $n ) {
$i = $i - $n;
}
my $ay_i = $ax->get($i) * $ax->get($j);
$ay->set($i, $ay_i);
}
#
# define af corresponding to f(x)
my $af = new pm_cppad::a_fun($ax, $ay);
#
# Set select_d (domain) to all true, initial select_r (range) to all false
my $select_d = new pm_cppad::vec_bool($n);
my $select_r = new pm_cppad::vec_bool($n);
for(my $i = 0; $i < $n; $i++) {
$select_d->set($i, 1);
$select_r->set($i, 0);
}
#
# only select component 0 of the range function
# f_0 (x) = x_0 * x_{n-1}
$select_r->set(0, 1);
#
# loop over forward and reverse mode
for(my $mode = 0; $mode < 2; $mode++) {
my $pat_out = new pm_cppad::sparse_rc();
if( $mode == 0 ) {
$af->for_hes_sparsity($select_d, $select_r, $pat_out);
}
if( $mode == 1 ) {
$af->rev_hes_sparsity($select_d, $select_r, $pat_out);
}
#
# check that result is sparsity pattern for Hessian of f_0 (x)
$ok = $ok && $pat_out->nnz() == 2 ;
my $row = $pat_out->row();
my $col = $pat_out->col();
for(my $k = 0; $k < 2; $k++) {
my $r = $row->get($k);
my $c = $col->get($k);
if( $r <= $c ) {
$ok = $ok && $r == 0;
$ok = $ok && $c == $n-1;
}
if( $r >= $c ) {
$ok = $ok && $r == $n-1;
$ok = $ok && $c == 0;
}
}
}
#
return( $ok );
}