PDL-Filter-2.097/0000755000175000017500000000000014736667123013342 5ustar osboxesosboxesPDL-Filter-2.097/Filter.pm0000644000175000017500000000047614736667022015132 0ustar osboxesosboxespackage PDL::Filter; use strict; use warnings; our $VERSION = '2.097'; =head1 NAME PDL::Filter - Linear filtering routines for PDL =head1 DESCRIPTION This contains linear filtering routines. It contains the following packages: =over =item L =item L =back =cut 1; PDL-Filter-2.097/META.json0000644000175000017500000000250014736667123014760 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-Filter", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0", "PDL" : "2.096" } }, "runtime" : { "requires" : { "PDL" : "2.096" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/PDLPorters/PDL-Filter/issues" }, "homepage" : "http://pdl.perl.org/", "repository" : { "type" : "git", "url" : "git://github.com/PDLPorters/PDL-Filter.git", "web" : "https://github.com/PDLPorters/PDL-Filter" }, "x_IRC" : "irc://irc.perl.org/#pdl" }, "version" : "2.097", "x_serialization_backend" : "JSON::PP version 4.04" } PDL-Filter-2.097/MANIFEST.SKIP0000644000175000017500000000072714736320315015233 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-Filter-2.097/LinPred.pm0000644000175000017500000001545314736320315015232 0ustar osboxesosboxes=head1 NAME PDL::Filter::LinPred - Linear predictive filtering =head1 SYNOPSIS $x = PDL::Filter::LinPred->new( {NLags => 10, LagInterval => 2, LagsBehind => 2, Data => $dat}); ($pd,$corrslic) = $x->predict($dat); =head1 DESCRIPTION A filter by doing linear prediction: tries to predict the next value in a data stream as accurately as possible. The filtered data is the predicted value. The parameters are =over 8 =item NLags Number of time lags used for prediction =item LagInterval How many points each lag should be =item LagsBehind If, for some strange reason, you wish to predict not the next but the one after that (i.e. usually f(t) is predicted from f(t-1) and f(t-2) etc., but with LagsBehind => 2, f(t) is predicted from f(t-2) and f(t-3)). =item Data The input data, which may contain other dimensions past the first (time). The extraneous dimensions are assumed to represent epochs so the data is just concatenated. =item AutoCovar As an alternative to B, you can just give the temporal autocorrelation function. =item Smooth Don't do prediction or filtering but smoothing. =back The method B gives a prediction for some data plus a corresponding slice of the data, if evaluated in list context. This slice is given so that you may, if you wish, easily plot them atop each other. The rest of the documentation is under lazy evaluation. =head1 AUTHOR Copyright (C) Tuomas J. Lukka 1997. 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 package PDL::Filter::LinSmooth; use strict; use warnings; use PDL; use PDL::Basic; use PDL::Slices; use PDL::Primitive; @PDL::Filter::LinSmooth::ISA = qw/PDL::Filter::LinPred/; sub _ntotlags { my($this) = @_; return 2 * ( $this->{NLags} + $this->{LagsBehind} ); } # nlags == 3, lagsbehind == 1 -> totlags = 7 # # Symautocor: 6543210123456 # -> lags(nlags) -> # # 43210123456 # 54321012345 # 65432101234 # SMOOTH sub _mk_mat { my($this) = @_; local $PDL::Debug = 1; my $n = $this->{LagsBehind}; my $nl = $this->{NLags}; my $nl1 = $nl-1; my $auc = $this->{AutoCor}; my $autocov = PDL->zeroes(PDL::float, $nl*2,$nl*2); $this->{AutoCov} = $autocov; my $sal = $this->{SymAutoCor}->px->lags(0,1,$this->{NLags})->px; print "L,LB: $nl,$n\n"; my ($tmp,$tmp2); PDL::Graphics::PGPLOT::imag ($sal->copy); # First, the 2 diagonal slices ($tmp = $autocov->slice("$nl:-1,$nl:-1")->px) .= ($tmp2 = $autocov->slice("0:".($nl-1).",0:".($nl-1))->px) .= $sal->slice(($this->{NLags}+2*$this->{LagsBehind}-1).":". (-1-($this->{NLags}+2*$this->{LagsBehind}+1)))->px; # Then, the off-diagonal slices ($tmp = $autocov->slice("-1:$nl,$nl1:0")) .= ($tmp2 = $autocov->slice("0:$nl1,$nl:-1")) .= $sal->slice("0:$nl1"); # Invert it my $autocinv = inv($autocov); # print "$autocinv,$auc,$n\n"; $auc->slice("$n:-1"); $this->{AutoSliceUsed} = PDL->zeroes(PDL::float, 2*$nl); ($tmp = $this->{AutoSliceUsed}->slice("0:$nl1")) .= $auc->slice(($n+$nl-1).":$n"); ($tmp = $this->{AutoSliceUsed}->slice("-1:$nl")) .= $auc->slice(($n+$nl-1).":$n"); inner($autocinv->transpose,$this->{AutoSliceUsed},(my $tdw=PDL->null)); $this->{AutoCov} = $autocov; $this->{AutoCovInv} = $autocinv; $this->{Weights} = $tdw; } sub predict ($$) { my($this,$data) = @_; my $nl = $this->{NLags}; my $nl1 = $nl - 1; my $ldata = $data->lags(0,$this->{LagInterval},$this->{NTotLags}+1); print "PREDICT, weights: $this->{Weights}\n"; inner($ldata->transpose->slice("-$nl:-1"), $this->{Weights}->slice("-$nl:-1"), (my $pred1=PDL->null)); inner($ldata->transpose->slice("0:$nl1"), $this->{Weights}->slice("0:$nl1"), (my $pred2=PDL->null)); my $pred = $pred1 + $pred2; return wantarray ? ($pred,$ldata->slice(":,(".($nl+$this->{LagsBehind}).")"), $pred1, $pred2) : $pred ; } package PDL::Filter::LinPred; use PDL; use PDL::Basic; use PDL::Slices; use PDL::Primitive; use strict; sub _ntotlags { my($this) = @_; return $this->{NLags} + $this->{LagsBehind} + 1; } # Create the autocovariance matrix in Toeplitz form # FILTER sub _mk_mat { my($this) = @_; local $PDL::Debug = 1; my $n = $this->{LagsBehind}; my $nl = $this->{NLags}; my $nl1 = $nl-1; my $auc = $this->{AutoCor}; print "AUTOCOR: $auc\n"; my $sal = $this->{SymAutoCor}->lags(0,1,$this->{NLags})->px; my $autocov = $sal->slice(($this->{LagsBehind}-1).":".(-1-($this->{LagsBehind}+1))) ->copy()->px; $this->{AutoCov} = $autocov; $| = 1; print "AUTOCOV: \n\n\n"; $autocov->dump; print "FOOBAR\n"; # Invert it my $autocinv = inv($autocov); $this->{AutoSliceUsed} = $auc->slice("$n:-1"); inner($autocinv->transpose,$this->{AutoSliceUsed},(my $tdw=PDL->null)); $this->{AutoCov} = $autocov; $this->{AutoCovInv} = $autocinv; $this->{Weights} = $tdw; } sub chkdefault ($$) { my ($var,$def); return $def if !ref $var && $var == 0; return defined $var ? $var : $def; } sub new ($$) { my($type,$pars) = @_; my $this = bless {},$type; $this->{NLags} = chkdefault(delete $pars->{NLags}, 2); $this->{LagInterval} = chkdefault(delete $pars->{LagInterval}, 1); $this->{LagsBehind} = chkdefault(delete $pars->{LagsBehind}, 1); $this->{Smooth} = (delete $pars->{Smooth}); $this->{NDeleted} = $this->{LagInterval} * ($this->{NLags} + $this->{LagsBehind}) - 1; $this->{NTotLags} = $this->_ntotlags(); (my $data = delete $pars->{Data}) ; my ($auc,$auc1); if(defined $data) { my $atmp; my $n = $this->{NTotLags}; my $da = avg($data); # Compute autocovariance my $ldata = $data->lags(0,$this->{LagInterval},$n); # XXX This takes too much space.. define a special function. inner($ldata->slice(":,0"),$ldata, ($atmp=PDL->null)); sumover($atmp->transpose,($auc=PDL->null)); $auc /= $ldata->getdim(0) * $data->getdim(1); $auc -= $da ** 2; # print "AUC: $auc\n"; } elsif(defined ($auc1 = delete $pars->{AutoCovar})) { if($this->{LagInterval} != 1) { $auc = $auc1->slice("0:$this->{LagInterval}:-1"); } else { $auc = $auc1; } } else { barf "Nothing to compute autocovariance from!"; } $this->{AutoCor} = $auc; my $n = $this->{NTotLags}; $this->{SymAutoCor} = PDL->zeroes(PDL::float, $n * 2 - 1); my $tmp; ($tmp = $this->{SymAutoCor}->slice("0:".($n-2))) .= $auc->slice("-1:1"); ($tmp = $this->{SymAutoCor}->slice(($n-1).":-1")) .= $auc->slice("0:-1"); $this->_mk_mat(); $this; } sub predict ($$) { my($this,$data) = @_; my $ldata = $data->lags(0,$this->{LagInterval},$this->{NTotLags}); print "PREDICT, weights: $this->{Weights}\n"; inner($ldata->transpose->slice("$this->{LagsBehind}:-1"), $this->{Weights}, (my $pred=PDL->null)); return wantarray ? ($pred,$ldata->slice(":,(0)")) : $pred ; } 1; PDL-Filter-2.097/META.yml0000644000175000017500000000136714736667123014622 0ustar osboxesosboxes--- abstract: unknown author: - 'PerlDL Developers ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' PDL: '2.096' 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-Filter no_index: directory: - t - inc requires: PDL: '2.096' resources: IRC: irc://irc.perl.org/#pdl bugtracker: https://github.com/PDLPorters/PDL-Filter/issues homepage: http://pdl.perl.org/ repository: git://github.com/PDLPorters/PDL-Filter.git version: '2.097' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' PDL-Filter-2.097/Changes0000644000175000017500000000016014736667060014632 0ustar osboxesosboxes2.097 2025-01-06 - add licence information (#1) - thanks @sebastic 2.096 2025-01-04 - split out from PDL 2.095 PDL-Filter-2.097/MANIFEST0000644000175000017500000000040714736667123014474 0ustar osboxesosboxesChanges Filter.pm Linear.pm LinPred.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) PDL-Filter-2.097/Makefile.PL0000644000175000017500000000221714736666774015331 0ustar osboxesosboxesuse strict; use warnings; use ExtUtils::MakeMaker; use PDL::Core::Dev; my $package_name = "PDL::Filter"; (my $repo = $package_name) =~ s#::#-#g; $repo = "PDLPorters/$repo"; WriteMakefile( NAME => $package_name, VERSION_FROM => 'Filter.pm', AUTHOR => 'PerlDL Developers ', LICENSE => 'perl', CONFIGURE_REQUIRES => { 'ExtUtils::MakeMaker' => 0, 'PDL' => '2.096', }, PREREQ_PM => { 'PDL' => '2.096', }, PM => { 'Filter.pm' => '$(INST_LIBDIR)/Filter.pm', map +($_ => '$(INST_LIBDIR)/Filter/'.$_), , }, 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-Filter-2.097/Linear.pm0000644000175000017500000000414714736320315015105 0ustar osboxesosboxes=head1 NAME PDL::Filter::Linear - linear filtering for PDL =head1 SYNOPSIS $x = PDL::Filter::Linear->new( {Weights => $v, Point => 10}); $y = PDL::Filter::Gaussian->new(15,2); # 15 points, 2 std devn. ($pred,$corrslic) = $x->predict($dat); =head1 DESCRIPTION A wrapper for generic linear filters. Just for convenience. This should in the future use DataPresenter. Also, this class should at some point learn to do FFT whenever it is useful. =cut package PDL::Filter::Linear; use strict; use warnings; use PDL; use PDL::Basic; use PDL::Slices; use PDL::Primitive; sub new($$) { my($type,$pars) = @_; my $this = bless {},$type; barf("Must specify weights\n") unless defined $pars->{Weights}; $this->{Weights} = delete $pars->{Weights}; $this->{Point} = defined $pars->{Point} ? $pars->{Point} : 0; $this; } sub predict($$) { my($this,$data) = @_; my $ldata = $data->lags(0,1,$this->{Weights}->getdim(0)); inner($ldata->transpose,$this->{Weights}, (my $pred = PDL->null)); return wantarray ? ($pred,$ldata->slice(":,($this->{Point})")) : $pred ; } package PDL::Filter::Gaussian; use PDL; use PDL::Basic; use PDL::Slices; use PDL::Primitive; use strict; @PDL::Filter::Gaussian::ISA = qw/PDL::Filter::Linear/; sub new($$) { my($type,$npoints,$sigma) = @_; my $cent = int($npoints/2); my $x = PDL->zeroes(float, $npoints )->xvals - $cent; my $y = exp(-($x**2)/(2*$sigma**2)); # Normalize to unit total $y /= sum($y); return PDL::Filter::Linear::new($type,{Weights => $y, Point => $cent}); } # Savitzky-Golay (see Numerical Recipes) package PDL::Filter::SavGol; use PDL; use PDL::Basic; use PDL::Slices; use PDL::Primitive; use strict; @PDL::Filter::Gaussian::ISA = qw/PDL::Filter::Linear/; # XXX Doesn't work sub new($$) { my($type,$deg,$nleft,$nright) = @_; my $npoints = $nright + $nleft + 1; my $x = PDL->zeroes(float, $npoints )->xvals - $nleft; my $mat1 = PDL->zeroes(float, $npoints,$deg+1)->xvals; for(0..$deg-1) { (my $tmp = $mat1->slice(":,($_)")) .= ($x ** $_); } my $y; # Normalize to unit total return PDL::Filter::Linear::new($type,{Weights => $y, Point => $nleft}); } 1;