PDL-Opt-Simplex-2.097/0000755000175000017500000000000014736677232014300 5ustar osboxesosboxesPDL-Opt-Simplex-2.097/META.json0000644000175000017500000000252414736677232015724 0ustar osboxesosboxes{ "abstract" : "unknown", "author" : [ "PerlDL Developers " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.44, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "PDL-Opt-Simplex", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0", "PDL" : "2.094" } }, "runtime" : { "requires" : { "PDL" : "2.094" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/PDLPorters/PDL-Opt-Simplex/issues" }, "homepage" : "http://pdl.perl.org/", "repository" : { "type" : "git", "url" : "git://github.com/PDLPorters/PDL-Opt-Simplex.git", "web" : "https://github.com/PDLPorters/PDL-Opt-Simplex" }, "x_IRC" : "irc://irc.perl.org/#pdl" }, "version" : "2.097", "x_serialization_backend" : "JSON::PP version 4.04" } PDL-Opt-Simplex-2.097/Simplex.pm0000644000175000017500000001673114736675112016262 0ustar osboxesosboxespackage PDL::Opt::Simplex; use strict; use warnings; use PDL; use PDL::Exporter; our @ISA = qw/PDL::Exporter/; our @EXPORT_OK = qw/simplex make_simplex/; our %EXPORT_TAGS = ( Func => [@EXPORT_OK] ); our $VERSION = '2.097'; *simplex = \&PDL::simplex; sub make_simplex { my ($init, $initsize) = @_; my ( $nd, $nd2, @otherdims ) = ( $init->dims, 1 ); pop @otherdims if @otherdims; # drop the spurious "1" return unless $nd2 == $nd + 1 or $nd2 == 1; return $init if $nd2 == $nd + 1; my $simp = PDL->zeroes( $nd, $nd + 1, @otherdims ); # Constructing a tetrahedron: # At step n (starting from zero) # take vertices 0..n and move them 1/(n+1) to negative dir on axis n. # Take vertex n+1 and move it n/(n+1) to positive dir on axis n my $uppertri = $simp->copy; ones($nd * ($nd+1) / 2)->tritosquare($uppertri->slice(",:-2")->t); my $iseq = sequence($nd); my $pjseq = $iseq / ( $iseq + 1 ); $simp .= $init - $initsize * $pjseq * $uppertri; $simp->slice(",1:")->diagonal(0,1) += $initsize * (1-$pjseq); $simp; } sub PDL::simplex { my ( $init, $initsize, $minsize, $maxiter, $sub, $logsub, $t ) = @_; my $simp = make_simplex($init, $initsize) // return; my $nd = $simp->dim(0); my $vals = $sub->($simp); my $ssize; while ($maxiter--) { $ssize = ( $simp - $simp->slice(":,0") )->magnover->maxover; $logsub->( $simp, $vals, $ssize ) if $logsub; last unless $ssize > $minsize; my $valsn = !$t ? $vals : $vals - $t * log( $vals->random + 0.00001 ); my $minind = $valsn->minimum_ind; my $maxind = $valsn->maxover_n_ind(2); my $maxind0 = $maxind->at(0); my @worstvals = $valsn->index($maxind)->list; my $bestval = $valsn->at($minind); my $ssum = ($simp->t->sumover - (my $worst = $simp->slice(":,($maxind0)"))) / $nd; my $new = 2 * $ssum - $worst; my $val = $sub->($new)->at(0); $val += $t * log( rand() + 0.00001 ) if $t; my $removetop = 0; if ( $val < $bestval ) { my $newnew = $new + $ssum - $worst; my $val2 = $sub->($newnew); if ( $val2->at(0) < $val ) { # CASE1 Reflection and Expansion $new = $newnew; $val = $val2; } # else CASE2 Reflection $removetop = 1; } elsif ( $val < $worstvals[1] ) { # CASE3 Reflection $removetop = 1; } else { my $newnew = 0.5 * ($ssum + $worst); my $val2 = $sub->($newnew); if ( $val2->at(0) < $worstvals[0] ) { # CASE4 Contraction $new = $newnew; $val = $val2; $removetop = 1; } } if ($removetop) { $worst .= $new; $vals->slice( "($maxind0)" ) .= $val; } else { # CASE5 Multiple Contraction $simp .= 0.5 * ($simp->slice(":,$minind") + $simp); my $idx = which( sequence($nd+1) != $minind ); $vals->index($idx) .= $sub->($simp->dice_axis(1,$idx)); } } my $mmind = $vals->minimum_ind; return ( $simp->slice(":,$mmind"), $ssize, $vals->index($mmind) ); } 1; __END__ =head1 NAME PDL::Opt::Simplex -- Simplex optimization routines =head1 SYNOPSIS use PDL::Opt::Simplex; ($optimum,$ssize,$optval) = simplex($init,$initsize,$minsize, $maxiter, sub {evaluate_func_at($_[0])}, sub {display_simplex($_[0])} ); # more involved: use PDL; use PDL::Opt::Simplex; my $count = 0; # find value of $x that returns a minimum sub f { my ($vec) = @_; $count++; my $x = $vec->slice('(0)'); # The parabola (x+3)^2 - 5 has a minimum at x=-3: return (($x+3)**2 - 5); } sub log { my ($vec, $vals, $ssize) = @_; # $vec is the array of values being optimized # $vals is f($vec) # $ssize is the simplex size, or roughly, how close to being converged. my $x = $vec->slice('(0)'); # each vector element passed to log() has a min and max value. # ie: x=[6 0] -> vals=[76 4] # so, from above: f(6) == 76 and f(0) == 4 print "$count [$ssize]: $x -> $vals\n"; } my ($optimum, $ssize, $optval) = simplex(pdl(30), 3, 1e-6, 100, \&f, \&log); print "ssize=$ssize opt=$optimum -> minimum=$optval\n"; =head1 DESCRIPTION This package implements the commonly used simplex optimization algorithm. The basic idea of the algorithm is to move a "simplex" of N+1 points in the N-dimensional search space according to certain rules. The main benefit of the algorithm is that you do not need to calculate the derivatives of your function. C<$init> is a 1D vector holding the initial values of the N fitted parameters, C<$optimum> is a vector holding the final values. C<$optval> is the evaluation of the final values. C<$initsize> is the size of C<$init>. It is only used if your supplied C<$init> is a single point in your search space, to construct the simplex ("cloud") of N+1 points the algorithm uses, being the distance away from your single C<$init> point along each dimension. This is done by the exportable function C, e.g.: pdl> use PDL::Opt::Simplex pdl> p $t = make_simplex(pdl(0,0,0), pdl(0.12,0.12,0.12)) [ [ 0 -0.06 -0.08] [ 0.12 -0.06 -0.08] [ 0 0.06 -0.08] [ 0 0 0.04] ] pdl> use PDL::Graphics::TriD pdl> spheres3d $t # spheres not points so can easily see C<$minsize> is the convergence criterion, e.g. C<$minsize> = 1e-6; the algorithm will terminate when all the values of C<$ssize> are less than C<$minsize>. The sub is assumed to understand more than 1 dimensions and broadcasting. Its signature is C. An example would be sub evaluate_func_at { my($xv) = @_; my ($x1, $x2) = $xv->using(0,1); return $x1**4 + ($x2-5)**4 + $x1*$x2; } Here C<$xv> is a vector holding the current values of the parameters being fitted which are then sliced out explicitly as C<$x1> and C<$x2>. C<$ssize> gives a very very approximate estimate of how close we might be - it might be miles wrong. It is the largest Euclidean distance between the first vertex and any other. If it is not very small, the algorithm has not converged. =head1 FUNCTIONS =head2 simplex =for ref Simplex optimization routine Mutates its C<$init> input if given as a full simplex (dims C). =for usage ($optimum,$ssize,$optval) = simplex($init,$initsize,$minsize, $maxiter, sub {evaluate_func_at($_[0])}, sub {display_simplex($_[0])} ); See module C for more information. =head1 CAVEATS Do not use the simplex method if your function has local minima. It will not work. Use genetic algorithms or simulated annealing or conjugate gradient or momentum gradient descent. They will not really work either but they are not guaranteed not to work ;) (if you have infinite time, simulated annealing is guaranteed to work but only after it has visited every point in your space). =head1 SEE ALSO =over =item L - Use names for Simplex-optimized values =item L - A PDL implementation of Particle Swarm =item L - Use names for Particle Swarm-optimized values =item L - Ron Shaffer's chemometrics web page and references therein (archive from 1998) =back The demonstration (Examples/Simplex/tsimp.pl and tsimp2.pl). =head1 AUTHOR Copyright(C) 1997 Tuomas J. Lukka. All rights reserved. There is no warranty. You are allowed to redistribute this software / documentation under certain conditions. For details, see the file COPYING in the PDL distribution. If this file is separated from the PDL distribution, the copyright notice should be included in the file. =cut PDL-Opt-Simplex-2.097/MANIFEST.SKIP0000644000175000017500000000072714725571474016203 0ustar osboxesosboxes\.DS_Store %$ -stamp$ .*/TAGS$ .*Version_check$ .*\#$ .*\.0$ .*\.orig$ .*\.rej$ \.swp$ .exe$ /\.\#.* /pm_to_blib$ /tmp.* MANIFEST\.bak$ MANIFEST\.old META\.json META\.yml Makefile$ Makefile\.aperl Makefile\.old \.(tmp|new|diff|ori)$ \.BAK$ \.bck$ \.bs \.bundle$ \.lck$ \.m$ \.o$ \.out$ \.patch$ \.so$ \.tar\.gz$ \b_eumm/ ^\.\#.* ^\.exists ^\.git \.gitignore$ ^blib/ ^pm_to_blib$ ~$ ^xt/ ^\.github/ ^\.cirrus\.yml cover_db/ ^nytprof(/|\.out) \.gc(ov|no|da)$ pp-\w*\.c$ PDL-Opt-Simplex-2.097/t/0000755000175000017500000000000014736677232014543 5ustar osboxesosboxesPDL-Opt-Simplex-2.097/t/simplex.t0000644000175000017500000000247514725571474016420 0ustar osboxesosboxesuse strict; use warnings; use Test::More; use PDL::LiteF; use PDL::Opt::Simplex; use Test::PDL -atol => 1e-3; sub test_simplex { local $Test::Builder::Level = $Test::Builder::Level + 1; my ($init, $initsize, $dis, $nolog) = @_; my $log_called = 0; my $logsub = sub {$log_called++}; my ( $opt, $ssize, $optval ) = simplex( $init->copy, $initsize, 1e-4, 1e4, sub { # f = x^2 + (y-1)^2 + 1 sumover( ( $_[0] - $dis )**2 ) + 1; }, $nolog ? () : $logsub, ); is_pdl $opt, $dis, 'optimum' or diag "got=$opt"; is_pdl $ssize, pdl(0), 'ssize' or diag "got=$ssize"; is_pdl $optval, pdl(1), 'optval' or diag "got=$optval"; ok $log_called, 'log called' if !$nolog; my @init_dims = $init->dims; my @exp_dims = ($init_dims[0], 1, @init_dims[2..$#init_dims]); is_deeply [$opt->dims], \@exp_dims, 'dims optimum right'; } test_simplex(pdl(2,2), 0.01, pdl([[0,1]])); test_simplex(pdl(2,2), pdl(0.01,0.01), pdl([[0,1]])); test_simplex(pdl(2,2), pdl(0.01,0.01), pdl([[0,1]]), 1); test_simplex(pdl(2,2,2), pdl(0.01,0.01,0.01), pdl([[0,1,2]])); test_simplex(my $p = pdl(q[-1 -1; -1.1 -1; -1.1 -0.9]), pdl(0.01,0.01), pdl([[0,1]])); test_simplex($p, undef, pdl([[-1,1]])); my $s = make_simplex(pdl(0,0,0), pdl(0.12,0.12,0.12)); is_pdl $s, pdl '0 -0.06 -0.08; 0.12 -0.06 -0.08; 0 0.06 -0.08; 0 0 0.04'; done_testing; PDL-Opt-Simplex-2.097/META.yml0000644000175000017500000000140614736677232015552 0ustar osboxesosboxes--- abstract: unknown author: - 'PerlDL Developers ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' PDL: '2.094' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.44, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: PDL-Opt-Simplex no_index: directory: - t - inc requires: PDL: '2.094' resources: IRC: irc://irc.perl.org/#pdl bugtracker: https://github.com/PDLPorters/PDL-Opt-Simplex/issues homepage: http://pdl.perl.org/ repository: git://github.com/PDLPorters/PDL-Opt-Simplex.git version: '2.097' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' PDL-Opt-Simplex-2.097/Changes0000644000175000017500000000013014736675763015574 0ustar osboxesosboxes2.097 2025-01-06 - add licence information 2.096 2024-12-09 - split out from PDL 2.095 PDL-Opt-Simplex-2.097/MANIFEST0000644000175000017500000000040714736677232015432 0ustar osboxesosboxesChanges Demo.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP Simplex.pm t/simplex.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) PDL-Opt-Simplex-2.097/Makefile.PL0000644000175000017500000000222314736671344016247 0ustar osboxesosboxesuse strict; use warnings; use ExtUtils::MakeMaker; use PDL::Core::Dev; my $package_name = "PDL::Opt::Simplex"; (my $repo = $package_name) =~ s#::#-#g; $repo = "PDLPorters/$repo"; WriteMakefile( NAME => $package_name, VERSION_FROM => 'Simplex.pm', AUTHOR => 'PerlDL Developers ', LICENSE=> "perl", CONFIGURE_REQUIRES => { 'ExtUtils::MakeMaker' => 0, 'PDL' => '2.094', }, PREREQ_PM => { 'PDL' => '2.094', }, PM => { 'Simplex.pm' => '$(INST_LIBDIR)/Simplex.pm', 'Demo.pm' => '$(INST_LIB)/PDL/Demos/Simplex.pm', }, META_MERGE => { "meta-spec" => { version => 2 }, resources => { homepage => 'http://pdl.perl.org/', bugtracker => {web=>"https://github.com/$repo/issues"}, repository => { url => "git://github.com/$repo.git", type => 'git', web => "https://github.com/$repo", }, x_IRC => 'irc://irc.perl.org/#pdl', }, }, ); sub MY::postamble { my $oneliner = PDL::Core::Dev::_oneliner(qq{exit if \$ENV{DESTDIR}; use PDL::Doc; eval { PDL::Doc::add_module(shift); }}); qq|\ninstall :: pure_install\n\t$oneliner \$(NAME)\n|; } PDL-Opt-Simplex-2.097/Demo.pm0000644000175000017500000000603014725571474015520 0ustar osboxesosboxespackage PDL::Demos::Simplex; sub init {' use PDL::Opt::Simplex; '} sub done {' undef $w; '} sub info {('simplex','Simplex optimisation (Req.: PDL::Graphics::Simple)')} my @demos = ( [comment => q| This demo illustrates the PDL::Opt::Simplex module. You must have PDL::Graphics::Simple installed to run it. The simplex algorithm finds the optimum "point" (coordinates) in a space you define, which can have any number (called "n" here) of dimensions. The algorithm takes either a fully-formed cloud of n+1 points, or a single starting point, in which case it constructs the cloud for you using the "initsize" parameter. It also takes a function that will take a series of points in your space, and returns the "value" at each of those points. From that, it works out which point of the simplex to move to be closer to the optimum point, which has the lowest value of your function. It also takes other, less important parameters, which you'll see, including a "logging" function which you can use to report progress, or plot data. |], [act => q| # Load the necessary modules, set up a plotting window. use PDL::Graphics::Simple; use PDL::Opt::Simplex; $w = pgswin(); # Try a simple ellipsoid; the multiplier makes the algorithm prioritise # the first (X) dimension, as you'll see on the plot. $w->plot(with=>'lines', [0], [1], {xrange=>[-15,5],yrange=>[-15,5]}); my $mult = pdl 4,1; sub func { (($mult * $_[0]) ** 2)->sumover } sub logs { $w->oplot(with=>'lines', $_[0]->glue(1,$_[0]->slice(",0"))->using(0,1)); } simplex(pdl(-10,-10), 0.5, 0.01, 30, \&func, \&logs ); |], [act => q| # Now the first of two examples contributed by Alison Offer. # These values are for both. $minsize = 1.e-6; # convergence: if simplex points are this far apart, stop $maxiter = 100; # max number of iterations: if done these many, stop # Now we minimise polynomial: (x-3)^2 + 2*(x-3)*(y-2.5) + 3*(y-2.5)^2 $w->plot(with=>'lines', [0], [1], {xrange=>[-1,5],yrange=>[-1,4]}); # reset $init = pdl [ 0 , 1 ]; $initsize = 2; ($optimum,$ssize,$optval) = simplex($init,$initsize,$minsize,$maxiter, sub { my ($x, $y) = $_[0]->using(0,1); ($x-3)**2 + 2*($x-3)*($y-2.5) + 3*($y-2.5)**2; }, \&logs ); |], [act => q| # Now to minimise least squares Gaussian fit to data + noise: # 32 *exp (-((x-10)/6)^2) + noise $factor = 3; # noise factor # data : gaussian + noise $j = sequence(20); srandom(5); $data = 32*exp(-(($j-10)/6)**2) + $factor * (random(20) - 0.5); $init = pdl [ 33, 9, 12 ]; $initsize = 2; # The plotting will flatten, i.e. ignore, the third dimension in the vectors. $w->plot(with=>'lines', [0], [1], {xrange=>[30,36],yrange=>[7,12]}); # reset ($optimum,$ssize,$optval) = simplex($init,$initsize,$minsize,$maxiter, sub { my ($x, $y, $z) = map $_[0]->slice($_), 0..2; (($data - $x*exp(-(($j-$y)/$z)**2))**2)->sumover; }, \&logs ); |], [comment => q| That concludes the demo of PDL::Opt::Simplex. There are other optimisation modules for PDL, including PDL::Opt::GLPK, PDL::Opt::NonLinear, PDL::Opt::QP, PDL::Opt::ParticleSwarm. |], ); sub demo { @demos } 1;