PDL-Fit-2.100/0000755000175000017500000000000014742173763012617 5ustar osboxesosboxesPDL-Fit-2.100/LM.pm0000644000175000017500000002267714725560236013477 0ustar osboxesosboxes=head1 NAME PDL::Fit::LM -- Levenberg-Marquardt fitting routine for PDL =head1 DESCRIPTION This module provides fitting functions for PDL. Currently, only Levenberg-Marquardt fitting is implemented. Other procedures should be added as required. For a fairly concise overview on fitting see Numerical Recipes, chapter 15 "Modeling of data". =head1 SYNOPSIS use PDL::Fit::LM; $ym = lmfit $x, $y, $sigma, \&expfunc, $initp, {Maxiter => 300}; =head1 FUNCTIONS =cut package PDL::Fit::LM; use strict; use warnings; use PDL::Core; use PDL::Exporter; use PDL::Options; use PDL::MatrixOps qw(lu_decomp lu_backsub inv); # for matrix inversion our @EXPORT_OK = qw(lmfit tlmfit); our %EXPORT_TAGS = (Func=>\@EXPORT_OK); our @ISA = qw( PDL::Exporter ); =head2 lmfit =for ref Levenberg-Marquardt fitting of a user supplied model function =for example ($ym,$finalp,$covar,$iters) = lmfit $x, $y, $sigma, \&expfunc, $initp, {Maxiter => 300, Eps => 1e-3}; where $x is the independent variable and $y the value of the dependent variable at each $x, $sigma is the estimate of the uncertainty (i.e., standard deviation) of $y at each data point, the fourth argument is a subroutine reference (see below), and $initp the initial values of the parameters to be adjusted. Options: =for options Maxiter: maximum number of iterations before giving up Eps: convergence criterion for fit; success when normalized change in chisquare smaller than Eps The user supplied sub routine reference should accept 4 arguments =over 4 =item * a vector of independent values $x =item * a vector of fitting parameters =item * a vector of dependent variables that will be assigned upon return =item * a matrix of partial derivatives with respect to the fitting parameters that will be assigned upon return =back As an example take this definition of a single exponential with 3 parameters (width, amplitude, offset): sub expdec { my ($x,$par,$ym,$dyda) = @_; my ($width,$amp,$off) = map {$par->slice("($_)")} (0..2); my $arg = $x/$width; my $ex = exp($arg); $ym .= $amp*$ex+$off; my (@dy) = map {$dyda->slice(",($_)")} (0..2); $dy[0] .= -$amp*$ex*$arg/$width; $dy[1] .= $ex; $dy[2] .= 1; } Note usage of the C<.=> operator for assignment In scalar context returns a vector of the fitted dependent variable. In list context returns fitted y-values, vector of fitted parameters, an estimate of the covariance matrix (as an indicator of goodness of fit) and number of iterations performed. =cut sub PDL::lmfit { my ($x,$y,$sig,$func,$c,$opt) = @_; # not using $ia right now $opt = {iparse( { Maxiter => 200, Eps => 1e-4}, ifhref($opt))}; my ($maxiter,$eps) = map {$opt->{$_}} qw/Maxiter Eps/; # initialize some variables my ($isig2,$chisq) = (1/($sig*$sig),0); #$isig2="inverse of sigma squared" my ($ym,$al,$cov,$bet,$oldbet,$olda,$oldal,$ochisq,$di) = map {null} (0..10); my ($aldiag,$codiag); # the diagonals for later updating # this will break broadcasting my $dyda = zeroes($x->type,$x->getdim(0),$c->getdim(0)); my $alv = zeroes($x->type,$x->getdim(0),$c->getdim(0),$c->getdim(0)); my ($iter,$lambda) = (0,0.001); do { if ($iter>0) { $cov .= $al; # local $PDL::debug = 1; $codiag .= $aldiag*(1+$lambda); my ($lu, $perm, $par) = lu_decomp($cov); $bet .= lu_backsub($lu,$perm,$par, $bet); # print "changing by $da\n"; $c += $bet; # what we used to call $da is now $bet } &$func($x,$c,$ym,$dyda); $chisq = ($y-$ym)*($y-$ym); $chisq *= $isig2; $chisq = $chisq->sumover; # calculate chi^2 $dyda->transpose->outer($dyda->transpose,$alv->mv(0,2)); $alv *= $isig2; $alv->sumover($al); # calculate alpha (($y-$ym)*$isig2*$dyda)->sumover($bet); # calculate beta if ($iter == 0) {$olda .= $c; $ochisq .= $chisq; $oldbet .= $bet; $oldal .= $al; $aldiag = $al->diagonal(0,1); $cov .= $al; $codiag = $cov->diagonal(0,1)} $di .= abs($chisq-$ochisq); # print "$iter: chisq, lambda, dlambda: $chisq, $lambda,",$di/$chisq,"\n"; if ($chisq < $ochisq) { $lambda *= 0.1; $ochisq .= $chisq; $olda .= $c; $oldbet .= $bet; $oldal .= $al; } else { $lambda *= 10; $chisq .= $ochisq; $c .= $olda; # go back to previous a $bet .= $oldbet; # and beta $al .= $oldal; # and alpha } } while ($iter++==0 || $iter < $maxiter && $di/$chisq > $eps); barf "iteration did not converge" if $iter >= $maxiter && $di/$chisq > $eps; # return inv $al as estimate of covariance matrix return wantarray ? ($ym,$c,inv($al),$iter) : $ym; } *lmfit = \&PDL::lmfit; =pod An extended example script that uses lmfit is included below. This nice example was provided by John Gehman and should help you to master the initial hurdles. It can also be found in the F directory. use PDL; use PDL::Math; use PDL::Fit::LM; use strict; ### fit using pdl's lmfit (Marquardt-Levenberg non-linear least squares fitting) ### ### `lmfit' Syntax: ### ### ($ym,$finalp,$covar,$iters) ### = lmfit $x, $y, $sigma, \&fn, $initp, {Maxiter => 300, Eps => 1e-3}; ### ### Explanation of variables ### ### OUTPUT ### $ym = pdl of fitted values ### $finalp = pdl of parameters ### $covar = covariance matrix ### $iters = number of iterations actually used ### ### INPUT ### $x = x data ### $y = y data ### $sigma = ndarray of y-uncertainties for each value of $y (can be set to scalar 1 for equal weighting) ### \&fn = reference to function provided by user (more on this below) ### $initp = initial values for floating parameters ### (needs to be explicitly set prior to use of lmfit) ### Maxiter = maximum iterations ### Eps = convergence criterion (maximum normalized change in Chi Sq.) ### Example: # make up experimental data: my $xdata = pdl sequence 5; my $ydata = pdl [1.1,1.9,3.05,4,4.9]; # set initial prameters in a pdl (order in accord with fit function below) my $initp = pdl [0,1]; # Weight all y data equally (else specify different uncertainties in a pdl) my $sigma = 1; # Use lmfit. Fourth input argument is reference to user-defined # subroutine ( here \&linefit ) detailed below. my ($yf,$pf,$cf,$if) = lmfit $xdata, $ydata, $sigma, \&linefit, $initp; # Note output print "\nXDATA\n$xdata\nY DATA\n$ydata\n\nY DATA FIT\n$yf\n\n"; print "Slope and Intercept\n$pf\n\nCOVARIANCE MATRIX\n$cf\n\n"; print "NUMBER ITERATIONS\n$if\n\n"; # simple example of user defined fit function. Guidelines included on # how to write your own function subroutine. sub linefit { # leave this line as is my ($x,$par,$ym,$dyda) = @_; # $m and $c are fit parameters, internal to this function # call them whatever make sense to you, but replace (0..1) # with (0..x) where x is equal to your number of fit parameters # minus 1 my ($m,$c) = map { $par->slice("($_)") } (0..1); # Write function with dependent variable $ym, # independent variable $x, and fit parameters as specified above. # Use the .= (dot equals) assignment operator to express the equality # (not just a plain equals) $ym .= $m * $x + $c; # Edit only the (0..1) part to (0..x) as above my (@dy) = map {$dyda -> slice(",($_)") } (0..1); # Partial derivative of the function with respect to first # fit parameter ($m in this case). Again, note .= assignment # operator (not just "equals") $dy[0] .= $x; # Partial derivative of the function with respect to next # fit parameter ($y in this case) $dy[1] .= 1; # Add $dy[ ] .= () lines as necessary to supply # partial derivatives for all floating parameters. } =cut # the OtherPar is the sub routine ref =head2 tlmfit =for ref broadcasted version of Levenberg-Marquardt fitting routine mfit =for example tlmfit $x, $y, float(1)->dummy(0), $na, float(200), float(1e-4), $ym=null, $afit=null, \&expdec; =for sig Signature: tlmfit(x(n);y(n);sigma(n);initp(m);iter();eps();[o] ym(n);[o] finalp(m); OtherPar => subref) a broadcasted version of C by using perl broadcasting. Direct broadcasting in C seemed difficult since we have an if condition in the iteration. In principle that can be worked around by using C but .... Send a broadcasted C version if you work it out! Since we are using perl broadcasting here speed is not really great but it is just convenient to have a broadcasted version for many applications (no explicit for-loops required, etc). Suffers from some of the current limitations of perl level broadcasting. =cut broadcast_define 'tlmfit(x(n);y(n);sigma(n);initp(m);iter();eps();[o] ym(n);[o] finalp(m)), NOtherPars => 1', over { $_[7] .= $_[3]; # copy our parameter guess into the output $_[6] .= PDL::lmfit $_[0],$_[1],$_[2],$_[8],$_[7],{Maxiter => $_[4], Eps => $_[5]}; }; 1; =head1 BUGS Not known yet. =head1 AUTHOR This file copyright (C) 1999, Christian Soeller (c.soeller@auckland.ac.nz). 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 # return true 1; PDL-Fit-2.100/Polynomial.pm0000644000175000017500000001016314725560236015275 0ustar osboxesosboxes=head1 NAME PDL::Fit::Polynomial - routines for fitting with polynomials =head1 DESCRIPTION This module contains routines for doing simple polynomial fits to data =head1 SYNOPSIS $x = sequence(20)-10; $coeff_orig = cdouble(30,-2,3,-2); # order used in this module $y = 30-2*$x+3*$x**2-2*$x**3; # or: $y = polyval($coeff_orig->slice("-1:0"), $x->r2C); $y += ($x->grandom - 0.5) * 100; ($yfit, $coeff) = fitpoly1d($x,$y,4); use PDL::Graphics::Simple; $w = pgswin(); $xi = zeroes(100)->xlinvals(-10,9); $yi = polyval($coeff->r2C->slice("-1:0"), $xi->r2C); $w->plot(with=>'points',$x,$y, with=>'points',$x,$yfit, with=>'line',$xi,$yi); $yfit = fitpoly1d $data,2; # Least-squares line fit ($yfit, $coeffs) = fitpoly1d $x, $y, 4; # Fit a cubic =head1 FUNCTIONS =head2 fitpoly1d =for ref Fit 1D polynomials to data using min chi^2 (least squares) =for usage Usage: ($yfit, [$coeffs]) = fitpoly1d [$xdata], $data, $order, [Options...] =for sig Signature: (x(n); y(n); [o]yfit(n); [o]coeffs(order)) Uses a standard matrix inversion method to do a least squares/min chi^2 polynomial fit to data. Order=2 is a linear fit (two parameters). Returns the fitted data and optionally the coefficients (in ascending order of degree, unlike L). One can broadcast over extra dimensions to do multiple fits (except the order can not be broadcasted over - i.e. it must be one fixed scalar number like "4"). The data is normalised internally to avoid overflows (using the mean of the abs value) which are common in large polynomial series but the returned fit, coeffs are in unnormalised units. =for example $yfit = fitpoly1d $data,2; # Least-squares line fit ($yfit, $coeffs) = fitpoly1d $x, $y, 4; # Fit a cubic $fitimage = fitpoly1d $image,3 # Fit a quadratic to each row of an image $myfit = fitpoly1d $line, 2, {Weights => $w}; # Weighted fit =for options Options: Weights Weights to use in fit, e.g. 1/$sigma**2 (default=1) =cut package PDL::Fit::Polynomial; use strict; use warnings; use PDL::Core; use PDL::Basic; use PDL::Exporter; use PDL::Options ':Func'; use PDL::MatrixOps; # for inv(), using this instead of call to Slatec routine our @EXPORT_OK = qw( fitpoly1d ); our %EXPORT_TAGS = (Func=>\@EXPORT_OK); our @ISA = qw( PDL::Exporter ); sub PDL::fitpoly1d { my $opthash = ref($_[-1]) eq "HASH" ? pop(@_) : {} ; my %opt = parse( { Weights=>ones(1) }, $opthash ) ; barf "Usage: fitpoly1d [\$x,] \$y, \$order\n" if @_<2 or @_ > 3; my ($x, $y, $order) = @_; if ($#_ == 1) { ($y, $order) = @_; $x = $y->xvals; } my $wt = $opt{Weights}; # Internally normalise data # means for each 1D data set my $xmean = (abs($x)->average)->dummy(0); # dummy for correct broadcasting my $ymean = (abs($y)->average)->dummy(0); (my $tmp = $ymean->where($ymean == 0)) .= 1 if any $ymean == 0; ($tmp = $xmean->where($xmean == 0)) .= 1 if any $xmean == 0; my $y2 = $y / $ymean; my $x2 = $x / $xmean; # Do the fit my $pow = sequence($order); my $M = $x2->dummy(0) ** $pow; my $C = $M->transpose x ($M * $wt->dummy(0)) ; my $Y = $M->transpose x ($y2->dummy(0) * $wt->dummy(0)); # Fitted coefficients vector ## $a1 = matinv($C) x $Y; ## print "matinv: \$C = $C, \$Y = $Y, \$a1 = $a1\n"; my $a1 = inv($C) x $Y; # use inv() instead of matinv() to avoid Slatec dependency ## print "inv: \$C = $C, \$Y = $Y, \$a1 = $a1\n"; # Fitted data my $yfit = ($M x $a1)->clump(2) * $ymean; # Remove first dim=1, un-normalise return wantarray ? ($yfit, $a1->clump(2) * $ymean / ($xmean ** $pow)) : $yfit; } *fitpoly1d = \&PDL::fitpoly1d; =head1 BUGS May not work too well for data with large dynamic range. =head1 SEE ALSO L =head1 AUTHOR This file copyright (C) 1999, Karl Glazebrook (kgb@aaoepp.aao.gov.au). 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 1; PDL-Fit-2.100/META.json0000644000175000017500000000246414742173763014246 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-Fit", "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-Fit/issues" }, "homepage" : "http://pdl.perl.org/", "repository" : { "type" : "git", "url" : "git://github.com/PDLPorters/PDL-Fit.git", "web" : "https://github.com/PDLPorters/PDL-Fit" }, "x_IRC" : "irc://irc.perl.org/#pdl" }, "version" : "2.100", "x_serialization_backend" : "JSON::PP version 4.04" } PDL-Fit-2.100/MANIFEST.SKIP0000644000175000017500000000104114725560236014505 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$ \.inlinewith \.inlinepdlpp \.pptest \.lck$ \.m$ \.o$ \.out$ \.patch$ \.so$ \.tar\.gz$ \b_eumm/ ^Gaussian/Gaussian\..* \b[\._]Inline ^\.\#.* ^\.exists ^\.git \.gitignore$ ^blib/ ^pm_to_blib$ ~$ ^xt/ ^\.github/ ^\.cirrus\.yml cover_db/ ^nytprof(/|\.out) \.gc(ov|no|da)$ pp-\w*\.c$ PDL-Fit-2.100/t/0000755000175000017500000000000014742173763013062 5ustar osboxesosboxesPDL-Fit-2.100/t/linfit.t0000644000175000017500000000366514725560236014542 0ustar osboxesosboxesuse strict; use warnings; use Test::More; use PDL::Fit::Linfit; use PDL::LiteF; use Test::PDL; { # Simple Test Case: # Generate data from a set of functions my $xvalues = sequence(100); my $data = 3*$xvalues + 2*cos($xvalues) + 3*sin($xvalues*2); # Fit functions are the linear, cos, and sin2x functions used in # the data generation step above: my $fitFuncs = cat $xvalues, cos($xvalues), sin($xvalues*2); # Perform the fit, Coefs should equal 3,2,3 my ($yfit, $coeffs) = PDL::linfit1d($data, $fitFuncs); my @coefs = $coeffs->list; is_pdl $coeffs, pdl([3,2,3]); } { # More Complex Example my $noPoints = 501; my @expectedCoefs = qw( 0.988375918186647 -0.000278823311771375 0.161669997297754 0.0626069008452451); my $noCoefs = 4; my $i; my ($deltaT,$Amp,$lin,$HOper,$AmpHO,$Amphalf,$Ampfull); my @PulsedB; my @Pulse; my $psum = 0; my $pi = 3.1415926; my $Pwidth = 2000; my $pave; $deltaT = 4; # 4 nS increments $Amp = 2.8; # 2.8V amplitude of pulse $lin = .2; $HOper = 200; # HO period $AmpHO=.1; $Amphalf = .5; $Ampfull = .2; # generate waveform: for(my $i = 0; $i < $noPoints; $i++){ $PulsedB[$i]= -$lin*1e-3*$i*$deltaT + $Amphalf*sin($pi/$Pwidth*$i*$deltaT) + $Ampfull*sin(2*$pi/$Pwidth*$i*$deltaT) + $AmpHO*sin(2*$pi/$HOper*$i*$deltaT); $Pulse[$i] = $Amp*exp($PulsedB[$i]/20*2.3025851); $psum += $Pulse[$i]; # used to get DC value # printf(" %4d %g %g\n",$i,$PulsedB[$i],$Pulse[$i]); } $pave = $psum/$noPoints; # printf("DC Value = %g\n",$pave); # Make PDL from waveform: my $data = PDL->new(\@Pulse); my @functions; # setup matrix contains functions to fit for ($i=0; $i<$noPoints; $i++) { $functions[0][$i] = $pave; $functions[1][$i] = $i; $functions[2][$i] = sin($pi*$i/($noPoints-1)); $functions[3][$i] = sin(2*$pi*$i/($noPoints-1)); } my $fitFuncs = PDL->new(\@functions); my ($yfit, $coeffs) = linfit1d($data, $fitFuncs); my @coefs = $coeffs->list; is_pdl $coeffs, pdl( \@expectedCoefs ); } done_testing; PDL-Fit-2.100/t/poly.t0000644000175000017500000000121414725560236014224 0ustar osboxesosboxesuse strict; use warnings; use Test::More; use PDL::LiteF; use PDL::Fit::Polynomial; my $x = sequence(20)-10; my $y = 30-2*$x+3*$x**2-2*$x**3; # Random numbers, generated by grandom($y)*100 # Hard-wired to avoid OS seed variations barfing test my $rand = pdl qw/65.735917 -40.510143 -122.07767 -19.591344 -139.76362 106.44639 -0.30094068 -5.3129683 49.815455 97.247868 -9.3130775 19.585472 8.5260268 -194.49596 73.822799 25.628967 133.36015 -2.6611465 9.0335632 -0.82946383/; $y += $rand; #points $x,$y; my $yfit = fitpoly1d($x,$y,4); #hold; line $x, $yfit; ok(max(abs($y-$yfit)) < 220); # need to add 10 for windows done_testing; PDL-Fit-2.100/t/lm.t0000644000175000017500000000642214725560236013657 0ustar osboxesosboxesuse strict; use warnings; use Test::More; use PDL::LiteF; use PDL::IO::Misc 'rcols'; use PDL::Fit::LM; my ($t,$count,$sigma)=rcols(\*DATA,0,1,2); my $initp = pdl(10,900,80,27,225); my $gnuplot_pf_unweighted = pdl(7.96, 282.5, 70.0, 28.5, 117.7); my $gnuplot_pf_weighted = pdl(5.53, 290.7, 46.6, 33.3, 162.7); my ($yf,$pf,$cf,$if) = lmfit($t, $count, 1, \&const_2exp, $initp); ok(all(abs(log10($pf/$gnuplot_pf_unweighted))<0.02),"Unweighted fit"); ($yf,$pf,$cf,$if) = lmfit($t, $count, $sigma, \&const_2exp, $initp); ok(all(abs(log10($pf/$gnuplot_pf_weighted))<0.02),"Weighted fit"); done_testing; sub const_2exp{ #constant plus 2 exponentials my ($x,$par,$ym,$dyda) = @_; my ($a1,$a2,$a3,$a4,$a5) = map { $par->slice("($_)") } (0..4); $ym .= $a1 + $a2*exp(-$x/$a4) + $a3*exp(-$x/$a5); my (@dy) = map {$dyda -> slice(",($_)") } (0..4); $dy[0] .= 1; $dy[1] .= exp(-$x/$a4); $dy[2] .= exp(-$x/$a5); $dy[3] .= $a2 * $x * exp(-$x/$a4)/$a4/$a4; $dy[4] .= $a3 * $x * exp(-$x/$a5)/$a5/$a5; } __DATA__ # $Id: silver.dat,v 1.1.1.1 1998/04/15 19:16:42 lhecking Exp $ # This sample data was distributed with Gnuplot, which contains the following notice: # Copyright (C) 1986 - 1993, 1998, 2004, 2007 Thomas Williams, Colin Kelley # Permission to use, copy, and distribute this software and its # documentation for any purpose with or without fee is hereby granted, # provided that the above copyright notice appear in all copies and that # both that copyright notice and this permission notice appear in # supporting documentation. 10.000000 280.000000 16.733201 20.000000 191.000000 13.820275 30.000000 152.000000 12.328828 40.000000 150.000000 12.247449 50.000000 104.000000 10.198039 60.000000 77.000000 8.774964 70.000000 69.000000 8.306624 80.000000 60.000000 7.745967 90.000000 60.000000 7.745967 100.000000 51.000000 7.141428 110.000000 41.000000 6.403124 120.000000 34.000000 5.830952 130.000000 35.000000 5.916080 140.000000 34.000000 5.830952 150.000000 24.000000 4.898979 160.000000 24.000000 4.898979 170.000000 19.000000 4.358899 180.000000 21.000000 4.582576 190.000000 20.000000 4.472136 200.000000 18.000000 4.242641 210.000000 21.000000 4.582576 220.000000 15.000000 3.872983 230.000000 19.000000 4.358899 240.000000 12.000000 3.464102 250.000000 20.000000 4.472136 260.000000 20.000000 4.472136 270.000000 18.000000 4.242641 280.000000 18.000000 4.242641 290.000000 20.000000 4.472136 300.000000 12.000000 3.464102 310.000000 26.000000 5.099020 320.000000 17.000000 4.123106 330.000000 8.000000 2.828427 340.000000 6.000000 2.449490 350.000000 8.000000 2.828427 360.000000 10.000000 3.162278 370.000000 20.000000 4.472136 380.000000 14.000000 3.741657 390.000000 8.000000 2.828427 400.000000 10.000000 3.162278 410.000000 9.000000 3.000000 420.000000 8.000000 2.828427 430.000000 10.000000 3.162278 440.000000 13.000000 3.605551 450.000000 9.000000 3.000000 460.000000 5.000000 2.236068 470.000000 7.000000 2.645751 480.000000 11.000000 3.316625 500.000000 7.000000 2.645751 510.000000 9.000000 3.000000 520.000000 12.000000 3.464102 530.000000 4.000000 2.000000 540.000000 7.000000 2.645751 550.000000 10.000000 3.162278 560.000000 9.000000 3.000000 580.000000 8.000000 2.828427 590.000000 9.000000 3.000000 600.000000 5.000000 2.236068 PDL-Fit-2.100/Fit.pm0000644000175000017500000000052514742173603013672 0ustar osboxesosboxespackage PDL::Fit; use strict; use warnings; our $VERSION = '2.100'; =head1 NAME PDL::Fit - various fitting implementations for PDL =head1 DESCRIPTION This distribution contains the following packages: =over =item L =item L =item L =item L =back =cut 1; PDL-Fit-2.100/GENERATED/0000755000175000017500000000000014742173763014115 5ustar osboxesosboxesPDL-Fit-2.100/GENERATED/PDL/0000755000175000017500000000000014742173763014534 5ustar osboxesosboxesPDL-Fit-2.100/GENERATED/PDL/Fit/0000755000175000017500000000000014742173763015256 5ustar osboxesosboxesPDL-Fit-2.100/GENERATED/PDL/Fit/Gaussian.pm0000644000175000017500000001041714742173763017371 0ustar osboxesosboxes# # GENERATED WITH PDL::PP from gaussian.pd! Don't modify! # package PDL::Fit::Gaussian; our @EXPORT_OK = qw(fitgauss1d fitgauss1dr ); our %EXPORT_TAGS = (Func=>\@EXPORT_OK); use PDL::Core; use PDL::Exporter; use DynaLoader; our @ISA = ( 'PDL::Exporter','DynaLoader' ); push @PDL::Core::PP, __PACKAGE__; bootstrap PDL::Fit::Gaussian ; #line 4 "gaussian.pd" =head1 NAME PDL::Fit::Gaussian - routines for fitting gaussians =head1 DESCRIPTION This module contains some custom gaussian fitting routines. These were developed in collaboration with Alison Offer, they do a reasonably robust job and are quite useful. Gaussian fitting is something I do a lot of, so I figured it was worth putting in my special code. Note it is not clear to me that this code is fully debugged. The reason I say that is because I tried using the internal linear eqn solving C routines called elsewhere and they were giving erroneous results. So steal from this code with caution! However it does give good fits to reasonable looking gaussians and tests show correct parameters. KGB 29/Oct/2002 =head1 SYNOPSIS use PDL; use PDL::Fit::Gaussian; ($cen, $pk, $fwhm, $back, $err, $fit) = fitgauss1d($x, $data); ($pk, $fwhm, $back, $err, $fit) = fitgauss1dr($r, $data); =head1 FUNCTIONS =head2 fitgauss1d =for ref Fit 1D Gassian to data ndarray =for example ($cen, $pk, $fwhm, $back, $err, $fit) = fitgauss1d($x, $data); =for usage ($cen, $pk, $fwhm, $back, $err, $fit) = fitgauss1d($x, $data); =for signature xval(n); data(n); [o]xcentre();[o]peak_ht(); [o]fwhm(); [o]background();int [o]err(); [o]datafit(n); [t]sig(n); [t]ytmp(n); [t]yytmp(n); [t]rtmp(n); Fits a 1D Gaussian robustly free parameters are the centre, peak height, FWHM. The background is NOT fit, because I find this is generally unreliable, rather a median is determined in the 'outer' 10% of pixels (i.e. those at the start/end of the data ndarray). The initial estimate of the FWHM is the length of the ndarray/3, so it might fail if the ndarray is too long. (This is non-robust anyway). Most data does just fine and this is a good default gaussian fitter. The values of the error code $err correspond to: =over 4 =item 0: successful fit =item 1: internal problem with memory allocation =item 2: insufficient number of data points =item 3: fit did not converge =back SEE ALSO: fitgauss1dr() for fitting radial gaussians =head2 fitgauss1dr =for ref Fit 1D Gassian to radial data ndarray =for example ($pk, $fwhm2, $back, $err, $fit) = fitgauss1dr($r, $data); =for usage ($pk, $fwhm2, $back, $err, $fit) = fitgauss1dr($r, $data); =for signature xval(n); data(n); [o]peak_ht(); [o]fwhm(); [o]background();int [o]err(); [o]datafit(n); [t]sig(n); [t]ytmp(n); [t]yytmp(n); [t]rtmp(n); Fits a 1D radial Gaussian robustly free parameters are the peak height, FWHM. Centre is assumed to be X=0 (i.e. start of ndarray). The background is NOT fit, because I find this is generally unreliable, rather a median is determined in the 'outer' 10% of pixels (i.e. those at the end of the data ndarray). The initial estimate of the FWHM is the length of the ndarray/3, so it might fail if the ndarray is too long. (This is non-robust anyway). Most data does just fine and this is a good default gaussian fitter. The values of the error code $err correspond to: =over 4 =item 0: successful fit =item 1: internal problem with memory allocation =item 2: insufficient number of data points =item 3: fit did not converge =back SEE ALSO: fitgauss1d() to fit centre as well. =cut use strict; use warnings; #line 152 "Gaussian.pm" *fitgauss1d = \&PDL::fitgauss1d; *fitgauss1dr = \&PDL::fitgauss1dr; #line 224 "gaussian.pd" =head1 BUGS May not converge for weird data, still pretty good! =head1 AUTHOR This file copyright (C) 1999, Karl Glazebrook (kgb@aaoepp.aao.gov.au), Gaussian fitting code by Alison Offer (aro@aaocbn.aao.gov.au). 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 #line 182 "Gaussian.pm" # Exit with OK status 1; PDL-Fit-2.100/META.yml0000644000175000017500000000135614742173763014075 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-Fit no_index: directory: - t - inc requires: PDL: '2.094' resources: IRC: irc://irc.perl.org/#pdl bugtracker: https://github.com/PDLPorters/PDL-Fit/issues homepage: http://pdl.perl.org/ repository: git://github.com/PDLPorters/PDL-Fit.git version: '2.100' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' PDL-Fit-2.100/Changes0000644000175000017500000000044514742173713014110 0ustar osboxesosboxes2.100 2025-01-16 - install Fits.pm so Debian packaging is happy 2.099 2025-01-13 - document return values for fitgauss1d{,r} (#1) - thanks @d-lamb 2.098 2025-01-06 - add licence information 2.097 2024-12-09 - reissue with corrected package name 2.096 2024-12-09 - split out from PDL 2.095 PDL-Fit-2.100/Linfit.pm0000644000175000017500000000725414725560236014406 0ustar osboxesosboxes=head1 NAME PDL::Fit::Linfit - routines for fitting data with linear combinations of functions. =head1 DESCRIPTION This module contains routines to perform general curve-fits to a set (linear combination) of specified functions. Given a set of Data: (y0, y1, y2, y3, y4, y5, ...ynoPoints-1) The fit routine tries to model y as: y' = beta0*x0 + beta1*x1 + ... beta_noCoefs*x_noCoefs Where x0, x1, ... x_noCoefs, is a set of functions (curves) that the are combined linearly using the beta coefs to yield an approximation of the input data. The Sum-Sq error is reduced to a minimum in this curve fit. B =over 1 =item $data This is your data you are trying to fit. Size=n =item $functions 2D array. size (n, noCoefs). Row 0 is the evaluation of function x0 at all the points in y. Row 1 is the evaluation of of function x1 at all the points in y, ... etc. Example of $functions array Structure: $data is a set of 10 points that we are trying to model using the linear combination of 3 functions. $functions = ( [ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ], # Constant Term [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 ], # Linear Slope Term [ 0, 2, 4, 9, 16, 25, 36, 49, 64, 81] # quadradic term ) =back =head1 SYNOPSIS $yfit = linfit1d $data, $funcs =head1 FUNCTIONS =head2 linfit1d =for ref 1D Fit linear combination of supplied functions to data using min chi^2 (least squares). =for usage Usage: ($yfit, [$coeffs]) = linfit1d [$xdata], $data, $fitFuncs, [Options...] =for sig Signature: (xdata(n); ydata(n); $fitFuncs(n,order); [o]yfit(n); [o]coeffs(order)) Uses a standard matrix inversion method to do a least squares/min chi^2 fit to data. Returns the fitted data and optionally the coefficients. One can broadcast over extra dimensions to do multiple fits (except the order can not be broadcasted over - i.e. it must be one fixed set of fit functions C. The data is normalised internally to avoid overflows (using the mean of the abs value) which are common in large polynomial series but the returned fit, coeffs are in unnormalised units. =for example # Generate data from a set of functions $xvalues = sequence(100); $data = 3*$xvalues + 2*cos($xvalues) + 3*sin($xvalues*2); # Make the fit Functions $fitFuncs = cat $xvalues, cos($xvalues), sin($xvalues*2); # Now fit the data, Coefs should be the coefs in the linear combination # above: 3,2,3 ($yfit, $coeffs) = linfit1d $data,$fitFuncs; =for options Options: Weights Weights to use in fit, e.g. 1/$sigma**2 (default=1) =cut package PDL::Fit::Linfit; use strict; use warnings; use PDL::Core; use PDL::Basic; use PDL::Exporter; use PDL::Options ':Func'; use PDL::MatrixOps qw(inv); our @EXPORT_OK = qw( linfit1d ); our %EXPORT_TAGS = (Func=>\@EXPORT_OK); our @ISA = qw( PDL::Exporter ); sub PDL::linfit1d { my $opthash = ref($_[-1]) eq "HASH" ? pop(@_) : {} ; my %opt = parse( { Weights=>ones(1) }, $opthash ) ; barf "Usage: linfit1d incorrect args\n" if $#_<1 or $#_ > 3; my ($x, $y, $fitfuncs) = @_; if ($#_ == 1) { ($y, $fitfuncs) = @_; $x = $y->xvals; } my $wt = $opt{Weights}; # Internally normalise data my $ymean = (abs($y)->sum)/($y->nelem); $ymean = 1 if $ymean == 0; my $y2 = $y / $ymean; # Do the fit my $M = $fitfuncs->transpose; my $C = $M->transpose x ($M * $wt->dummy(0)) ; my $Y = $M->transpose x ($y2->dummy(0) * $wt->dummy(0)); # Fitted coefficients vector my $c = inv($C) x $Y; # Fitted data my $yfit = ($M x $c)->clump(2) * $ymean; # Remove first dim=1, un-normalise return $yfit if !wantarray; return ($yfit, $c->clump(2) * $ymean); # Un-normalise } *linfit1d = *linfit1d = \&PDL::linfit1d; 1; PDL-Fit-2.100/MANIFEST0000644000175000017500000000076714742173763013762 0ustar osboxesosboxesChanges examples/lmfit.pl Fit.pm Gaussian/gauss.c Gaussian/gaussian.pd Gaussian/Makefile.PL Gaussian/t/gauss.t Linfit.pm LM.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP Polynomial.pm t/linfit.t t/lm.t t/poly.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) GENERATED/PDL/Fit/Gaussian.pm mod=PDL::Fit::Gaussian pd=Gaussian/gaussian.pd (added by pdlpp_mkgen) PDL-Fit-2.100/Makefile.PL0000644000175000017500000000253514742050743014566 0ustar osboxesosboxesuse strict; use warnings; use ExtUtils::MakeMaker; use PDL::Core::Dev; # create GENERATED subdir with *.pm files during 'make dist' (to make metacpan.org happy) my $preop = '$(PERLRUNINST) -MPDL::Core::Dev -e pdlpp_mkgen $(DISTVNAME)'; my $package_name = 'PDL::Fit'; (my $repo = $package_name) =~ s#::#-#g; $repo = "PDLPorters/$repo"; WriteMakefile( NAME => $package_name, VERSION_FROM => 'Fit.pm', AUTHOR => 'PerlDL Developers ', LICENSE=> "perl", CONFIGURE_REQUIRES => { 'ExtUtils::MakeMaker' => 0, 'PDL' => '2.094', }, PREREQ_PM => { 'PDL' => '2.094', }, PM => { (map {($_ => '$(INST_LIBDIR)/Fit/'.$_)} <[LP]*.pm>),'Fit.pm'=>'$(INST_LIBDIR)/Fit.pm' }, dist => { COMPRESS => 'gzip', SUFFIX => 'gz', PREOP => $preop }, 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-Fit-2.100/examples/0000755000175000017500000000000014742173763014435 5ustar osboxesosboxesPDL-Fit-2.100/examples/lmfit.pl0000644000175000017500000000534214725560236016105 0ustar osboxesosboxesuse PDL; use PDL::Math; use PDL::Fit::LM; use strict; ### fit using pdl's lmfit (Marquardt-Levenberg non-linear least squares fitting) ### ### `lmfit' Syntax: ### ### ($ym,$finalp,$covar,$iters) ### = lmfit $x, $y, $sigma, \&fn, $initp, {Maxiter => 300, Eps => 1e-3}; ### ### Explanation of variables ### ### OUTPUT ### $ym = pdl of fitted values ### $finalp = pdl of parameters ### $covar = covariance matrix ### $iters = number of iterations actually used ### ### INPUT ### $x = x data ### $y = y data ### $sigma = ndarray of y-uncertainties for each value of $y (can be set to scalar 1 for equal weighting) ### \&fn = reference to function provided by user (more on this below) ### $initp = initial values for floating parameters ### (needs to be explicitly set prior to use of lmfit) ### Maxiter = maximum iterations ### Eps = convergence criterion (maximum normalized change in Chi Sq.) ### Example: # make up experimental data: my $xdata = pdl sequence 5; my $ydata = pdl [1.1,1.9,3.05,4,4.9]; # set initial prameters in a pdl (order in accord with fit function below) my $initp = pdl [0,1]; # Weight all y data equally (else specify different uncertainties in a pdl) my $sigma = 1; # Use lmfit. Fourth input argument is reference to user-defined # subroutine ( here \&linefit ) detailed below. my ($yf,$pf,$cf,$if) = lmfit $xdata, $ydata, $sigma, \&linefit, $initp; # Note output print "\nXDATA\n$xdata\nY DATA\n$ydata\n\nY DATA FIT\n$yf\n\n"; print "Slope and Intercept\n$pf\n\nCOVARIANCE MATRIX\n$cf\n\n"; print "NUMBER ITERATIONS\n$if\n\n"; # simple example of user defined fit function. Guidelines included on # how to write your own function subroutine. sub linefit { # leave this line as is my ($x,$par,$ym,$dyda) = @_; # $m and $c are fit parameters, internal to this function # call them whatever make sense to you, but replace (0..1) # with (0..x) where x is equal to your number of fit parameters # minus 1 my ($m,$c) = map { $par->slice("($_)") } (0..1); # Write function with dependent variable $ym, # independent variable $x, and fit parameters as specified above. # Use the .= (dot equals) assignment operator to express the equality # (not just a plain equals) $ym .= $m * $x + $c; # Edit only the (0..1) part to (0..x) as above my (@dy) = map {$dyda -> slice(",($_)") } (0..1); # Partial derivative of the function with respect to first # fit parameter ($m in this case). Again, note .= assignment # operator (not just "equals") $dy[0] .= $x; # Partial derivative of the function with respect to next # fit parameter ($c in this case) $dy[1] .= 1; # Add $dy[ ] .= () lines as necessary to supply # partial derivatives for all floating parameters. } PDL-Fit-2.100/Gaussian/0000755000175000017500000000000014742173763014371 5ustar osboxesosboxesPDL-Fit-2.100/Gaussian/gaussian.pd0000644000175000017500000001444014741064154016523 0ustar osboxesosboxesuse strict; use warnings; pp_addpm({At=>'Top'},<<'EOD'); =head1 NAME PDL::Fit::Gaussian - routines for fitting gaussians =head1 DESCRIPTION This module contains some custom gaussian fitting routines. These were developed in collaboration with Alison Offer, they do a reasonably robust job and are quite useful. Gaussian fitting is something I do a lot of, so I figured it was worth putting in my special code. Note it is not clear to me that this code is fully debugged. The reason I say that is because I tried using the internal linear eqn solving C routines called elsewhere and they were giving erroneous results. So steal from this code with caution! However it does give good fits to reasonable looking gaussians and tests show correct parameters. KGB 29/Oct/2002 =head1 SYNOPSIS use PDL; use PDL::Fit::Gaussian; ($cen, $pk, $fwhm, $back, $err, $fit) = fitgauss1d($x, $data); ($pk, $fwhm, $back, $err, $fit) = fitgauss1dr($r, $data); =head1 FUNCTIONS =head2 fitgauss1d =for ref Fit 1D Gassian to data ndarray =for example ($cen, $pk, $fwhm, $back, $err, $fit) = fitgauss1d($x, $data); =for usage ($cen, $pk, $fwhm, $back, $err, $fit) = fitgauss1d($x, $data); =for signature xval(n); data(n); [o]xcentre();[o]peak_ht(); [o]fwhm(); [o]background();int [o]err(); [o]datafit(n); [t]sig(n); [t]ytmp(n); [t]yytmp(n); [t]rtmp(n); Fits a 1D Gaussian robustly free parameters are the centre, peak height, FWHM. The background is NOT fit, because I find this is generally unreliable, rather a median is determined in the 'outer' 10% of pixels (i.e. those at the start/end of the data ndarray). The initial estimate of the FWHM is the length of the ndarray/3, so it might fail if the ndarray is too long. (This is non-robust anyway). Most data does just fine and this is a good default gaussian fitter. The values of the error code $err correspond to: =over 4 =item 0: successful fit =item 1: internal problem with memory allocation =item 2: insufficient number of data points =item 3: fit did not converge =back SEE ALSO: fitgauss1dr() for fitting radial gaussians =head2 fitgauss1dr =for ref Fit 1D Gassian to radial data ndarray =for example ($pk, $fwhm2, $back, $err, $fit) = fitgauss1dr($r, $data); =for usage ($pk, $fwhm2, $back, $err, $fit) = fitgauss1dr($r, $data); =for signature xval(n); data(n); [o]peak_ht(); [o]fwhm(); [o]background();int [o]err(); [o]datafit(n); [t]sig(n); [t]ytmp(n); [t]yytmp(n); [t]rtmp(n); Fits a 1D radial Gaussian robustly free parameters are the peak height, FWHM. Centre is assumed to be X=0 (i.e. start of ndarray). The background is NOT fit, because I find this is generally unreliable, rather a median is determined in the 'outer' 10% of pixels (i.e. those at the end of the data ndarray). The initial estimate of the FWHM is the length of the ndarray/3, so it might fail if the ndarray is too long. (This is non-robust anyway). Most data does just fine and this is a good default gaussian fitter. The values of the error code $err correspond to: =over 4 =item 0: successful fit =item 1: internal problem with memory allocation =item 2: insufficient number of data points =item 3: fit did not converge =back SEE ALSO: fitgauss1d() to fit centre as well. =cut use strict; use warnings; EOD pp_addhdr(<<'EOF'); #define NPAR 3 void lqsortD (double* xx, int a, int b); int marquardt (int npoints, int npar, double*x, double *y, double* sig, double par[NPAR], double* r, double a[NPAR][NPAR]); EOF for my $name ('fitgauss1d','fitgauss1dr') { pp_def($name, Pars => 'xval(n); data(n); '.($name eq 'fitgauss1dr' ? '' : '[o]xcentre();'). '[o]peak_ht(); [o]fwhm(); [o]background();int [o]err(); [o]datafit(n); [t]sig(n); [t]ytmp(n); [t]yytmp(n); [t]rtmp(n);', GenericTypes => ['D'], Code => ' int i, nb; double ymax, xmax, xmin, val, xval, xcenguess, bkg, par[NPAR], a[NPAR][NPAR]; ymax = -1e-30; xmax = -1e-30; xmin = 1e30; $err() = 0; loop(n) %{ val = $data(); xval = $xval(); $ytmp() = val; $sig() = 1.0; /* Room for expansion */ if (val>ymax) /* Various max and mins */ ymax = val; if (xval>xmax) xmax = xval; if (xval 0.9*fabs(xmax-xmin) ) { $yytmp(n=>nb) = $ytmp(); nb++; } %} /* Estimate background and xcentroid */ bkg = 0; xcenguess = 0.0; if (nb>0) { lqsortD( $P(yytmp), 0, nb-1 ); i = (nb-1)/2; bkg = $yytmp( n=>i ); /* Median */ } val = 0.0; xcenguess = 0.0; loop(n) %{ $ytmp() -= bkg; xcenguess += $ytmp() * $xval(); val += $ytmp(); %} xcenguess /= val; par[2] = xcenguess; par[1] = ymax-bkg; par[0] = (xmax-xmin)/3; /* 1/3 of given box */ /* fprintf (stderr, "gauss...1 %f %f %f\n", par[0], par[1], par[2]); */ /* Do the fit */ '.($name eq 'fitgauss1dr' ? ' par[2] = 0.0; $err() = marquardt ($SIZE(n), 2, $P(xval), $P(ytmp), $P(sig), par, $P(rtmp), a); ' : ' $err() = marquardt ($SIZE(n), 3, $P(xval), $P(ytmp), $P(sig), par, $P(rtmp), a); $xcentre() = par[2]; ') .' $fwhm() = (fabs(par[0]))*2.0*sqrt(log(2.0)); /* Ret Values */ $peak_ht() = par[1]; $background() = bkg; loop(n) %{ val = ( (double) $xval() - par[2] ) / par[0]; $datafit() = par[1] * exp (- val * val) + bkg; %} ', Doc=>undef ); } pp_addpm(<<'EOD'); =head1 BUGS May not converge for weird data, still pretty good! =head1 AUTHOR This file copyright (C) 1999, Karl Glazebrook (kgb@aaoepp.aao.gov.au), Gaussian fitting code by Alison Offer (aro@aaocbn.aao.gov.au). 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 EOD pp_done(); PDL-Fit-2.100/Gaussian/t/0000755000175000017500000000000014742173763014634 5ustar osboxesosboxesPDL-Fit-2.100/Gaussian/t/gauss.t0000644000175000017500000000361014725560236016137 0ustar osboxesosboxesuse strict; use warnings; use Test::More; use PDL; use PDL::Fit::Gaussian; sub nint{int($_[0]->at+0.5)}; my $g1 = pdl qw[ 2.1990459 1.9464173 2.1565406 2.1672124 2.2701938 1.82992 1.914893 2.1466146 1.8822749 2.0293979 2.0101469 2.210302 2.6183602 4.3191846 7.8333737 11.525845 13.069404 11.364827 7.2853706 4.3667506 2.2601078 2.0051197 1.802916 2.1735853 1.7985277 1.9498281 1.7745239 1.7534224 2.6137111 1.8443813 2.0064845 2.1981632 2.0572412 1.8928303 2.0703847 2.0121833 1.9967828 2.3846479 1.8907906 2.1486651]; my $g2 = pdl qw[ 13.013418 11.397573 7.4494489 4.5594057 2.5728955 2.0687907 2.1953927 2.2819689 1.7046446 2.3276816 2.0130417 1.72691 1.8260466 2.0842572 2.2455532 1.9223378 1.695866 1.5893454 1.9787549 1.6941413 1.8576307 2.3780392 2.2588472 2.2080773 1.8754143 2.019966 1.9363813 2.1414206 2.0062853 2.0867273 2.0158617 1.6481802 1.9686077 2.2979197 2.2963699 2.1171346 1.8859732 2.1277667 2.0716804 1.9251175]; my $x1 = xvals($g1); my $x2 = xvals($g2); { #test fitgauss1d specifying all output ndarrays in the call my ($xc, $pk, $fwhm, $back, $err, $fit); fitgauss1d($x1, $g1,$xc=null,$pk=null,$fwhm=null,$back=null,$err=null,$fit=null); ok( nint($xc)==16 && nint($pk)==11 && nint($fwhm)==4 && nint($back)==2 && nint($err)==0 && sum(abs($g1-$fit))<10,"fitgauss1d output=null"); } { #test fitgauss1d specifying only the input ndarrays my ($xc, $pk, $fwhm, $back, $err, $fit) = fitgauss1d($x1, $g1); ok( nint($xc)==16 && nint($pk)==11 && nint($fwhm)==4 && nint($back)==2 && nint($err)==0 && sum(abs($g1-$fit))<10,"fitgauss1d normal"); } { #test fitgauss1dr specifying only the input ndarrays my ($pk, $fwhm, $back, $err, $fit) = fitgauss1dr($x2,$g2); ok(nint($pk)==11 && nint($fwhm)==4 && nint($back)==2 && nint($err)==0 && sum(abs($g2-$fit))<10,"fitgauss1dr normal"); } done_testing; PDL-Fit-2.100/Gaussian/gauss.c0000644000175000017500000002551514725563013015657 0ustar osboxesosboxes/*LINTLIBRARY*/ /* gauss.c This code provides gaussian fitting routines. Copyright (C) 1997 Karl Glazebrook and Alison Offer Real code Note it is not clear to me that this code is fully debugged. The reason I say that is because I tried using the linear eqn solving routines called elsewhere and they were giving erroneous results. So steal from this code with caution! However it does give good fits to reasonable looking gaussians and tests show correct parameters. KGB 29/Oct/2002 */ #include #include #include #define NPAR 3 #define MAXITER 1000 /* Malloc 2D ptr array e.g. a[nx][ny] */ static double **malloc2D (int nx, int ny) { int i; double **p; p = (double**) malloc( nx*sizeof(double*) ); /* 1D array of ptrs p[i] */ if (p==NULL) return NULL; for (i=0;i1) { for (irow=1; irow<=icol-1; irow++) { sum = x[irow-1][icol-1]; for (isum=1; isum<=irow-1; isum++) sum -= x[irow-1][isum-1]*x[isum-1][irow-1]; x[irow-1][icol-1] = sum; } } /* L - matrix plus diagonal element of U matrix */ xmax = 0; ipivot = icol; for (irow=icol; irow<=n; irow++) { sum = x[irow-1][icol-1]; if (icol>1) { for(isum=1; isum<=icol-1; isum++) sum -= x[irow-1][isum-1] * x[isum-1][icol-1]; } if (fabs(sum)>xmax) { xmax = sum; ipivot = irow; } x[irow-1][icol-1] = sum; } /* if xmax is very small replace by epsilon to avoid dividing by zero */ if (fabs(xmax)j][j] is L-matrix (diagonal elements are unity) iorder is the permutation of the rows b is the input vector, d is the solution vector */ static void lineq (int n, int ndim, double x[NPAR][NPAR], double b[NPAR], double d[NPAR], int iorder[NPAR]) { int i,isum; double sum; /* solving X.b = d ==> (L.U).b = d or L.(U.b) = d first re-order the vector */ for (i=1; i<=n; i++) d[i-1] = b[iorder[i-1]-1]; /* first find (U.b) */ for(i=2; i<=n; i++) { sum = d[i-1]; for (isum=1; isum<=i-1; isum++) sum -= x[i-1][isum-1] * d[isum-1]; d[i-1] = sum; } /* Now fill out d (solution of X.b) by back substitution */ d[n-1] /= x[n-1][n-1]; for (i=n-1; i>=1; i--){ sum = d[i-1]; for (isum=i+1; isum<=n; isum++) sum -= x[i-1][isum-1] * d[isum-1]; d[i-1] = sum / x[i-1][i-1]; } } /* ======================================================================== My C version of Alison's subroutine to fit a non-linear functions using the Levenberg-Marquardt algorithm input: npoints = number of data points npar = number of parameters in fit par = initial estimates of parameters sigma = errors on data (sigma^2) output: par = output parameters r = residuals (y(i) - yfit(i)) a = estimated covariance matrix of std errs in fitted params. */ int marquardt (int npoints, int npar, double*x, double *y, double* sig, double par[NPAR], double* r, double a[NPAR][NPAR]) { int i,k, done, decrease, niter; int iorder[NPAR]; double *yfit, **d, **d2, tmp; double par2[NPAR], delta[NPAR], b[NPAR], aprime[NPAR][NPAR]; double lambda, chisq, chisq2, eps=0.001, lamfac=2.0; /* Memory allocation */ yfit = (double*) malloc( npoints*sizeof(double)); if (yfit==NULL) return(1); d = malloc2D( npoints, NPAR); if (d==NULL) { free(yfit); return(1); } d2 = malloc2D( npoints, NPAR); if (d2==NULL) { free(yfit); free2D(d,npoints,NPAR); return(1); } /* Not enough points */ if (npoints < npar) { free(yfit); free2D(d,npoints,NPAR); free2D(d2,npoints,NPAR); return(2); } lambda = 0.001; done = 0; decrease = 0; niter = 1; /* Get the value for the initial fit and the value of the derivatives for the current estimate of the parameters */ funct(npoints, npar, x, yfit, d, par); /* Calculate chi^2 */ chisq = 0; for (k=0; kMAXITER) { free(yfit); free2D(d,npoints,NPAR); free2D(d2,npoints,NPAR); return(3); } } /* Success!!! - compute residual and covariance matrix then return first calculating inverse of aprime */ for (i=0; i