PDL-VectorValued-1.0.15/0000755000175000017500000000000014204433466014356 5ustar moocowbovinesPDL-VectorValued-1.0.15/MANIFEST.SKIP0000644000175000017500000000041514204432223016242 0ustar moocowbovines\#$ ^\.git \.gz$ ^Utils/.*\.(?:c|pm|xs)$ ~$ \.bs$ \.o$ \.old$ \.cvsignore$ \bCVS\b pm_to_blib$ ^blib ^pdl-core$ ^xs-cookbook$ ^graveyard\. \bMakefile$ \btestme\.perl$ \bppgen\.perl$ \.dont$ \.html$ \.tmp$ ^#Makefile#$ \bMYMETA\b ^reversion\.sh$ ^svntag\.rc$ ^\.github/ PDL-VectorValued-1.0.15/META.json0000644000175000017500000000222514204433466016000 0ustar moocowbovines{ "abstract" : "Assorted utilities for vector-valued PDLs", "author" : [ "Bryan Jurish" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "PDL-VectorValued", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "PDL" : "0" } }, "runtime" : { "requires" : { "PDL" : "2.019", "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "repository" : { "type" : "git", "url" : "git://github.com/moocow-the-bovine/PDL-VectorValued.git", "web" : "https://github.com/moocow-the-bovine/PDL-VectorValued" } }, "version" : "v1.0.15", "x_serialization_backend" : "JSON::PP version 4.02" } PDL-VectorValued-1.0.15/VectorValued/0000755000175000017500000000000014204433466016761 5ustar moocowbovinesPDL-VectorValued-1.0.15/VectorValued/Version.pm0000644000175000017500000000123714204433206020737 0ustar moocowbovines## ## File: PDL::VectorValued::Version.pm ## Author: Bryan Jurish ## Description: Vector utilities for PDL: version ## + <=v1.0.3: this lives in a separate file so that both compile-time and runtime subsystems can use it ## + >=v1.0.4: use perl-reversion from Perl::Version to maintain shared $VERSION ##====================================================================== package PDL::VectorValued::Version; our $VERSION = '1.0.15'; #$PDL::VectorValued::VERSION = $VERSION; ##-- use perl-reversion from Perl::Version instead #$PDL::VectorValued::Dev::VERSION = $VERSION; ##-- use perl-reversion from Perl::Version instead 1; ##-- make perl happy PDL-VectorValued-1.0.15/VectorValued/Makefile.PL0000644000175000017500000000337714204432223020733 0ustar moocowbovinesuse ExtUtils::MakeMaker; ##-- put 'realclean_files' in a variable: avoid MakeMaker puking with: ## ERROR from evaluation of .../ccsutils/Makefile.PL: ## Modification of a read-only value attempted at /usr/share/perl/5.8/Carp/Heavy.pm line 45. our $realclean_files = '*~ *.tmp'; our $has_readme_pod = grep {-e $_ } (, , ); our $has_pdlpp = grep {-e $_ } (<*.pd>); WriteMakefile( NAME=>'PDL::VectorValued::Dev', VERSION_FROM => '../VectorValued.pm', LICENSE => 'perl', #PM => { (map {$_=>"\$(INST_LIBDIR)/CCS/$_"} <*.pm>), }, realclean=>{ FILES=>$realclean_files, }, DIR =>[ #'my_subdir', ], NO_MYMETA => 1, ); ##-- overrides sub MY::depend { package MY; my $inherited = shift->SUPER::depend(@_); if ($::has_readme_pod) { $inherited .= ( "\n\n" ."dist: README.txt\n" ."\n" ."create_distdir: README.txt\n" ."\n" ."distcheck: README.txt\n" ."\n" ."manicheck: README.txt\n" ."\n" ); } return $inherited; } sub MY::special_targets { package MY; my $inherited = shift->SUPER::special_targets(@_); #$inherited =~ s/^(\.SUFFIXES\s*:.*)$/$1 .pod .pm .man .txt .html;/ $inherited .= " .SUFFIXES: .pm .pod .rpod .man .txt .html .pm.html: \tpod2html --outfile \$@ \$< .pm.txt: \tpod2text \$< \$@ .pod.html: \tpod2html --outfile \$@ \$< .pod.txt: \tpod2text \$< \$@ .rpod.html: \tpod2html --outfile \$@ \$< .rpod.txt: \tpod2text \$< \$@ "; return $inherited; } sub MY::top_targets { package MY; my $inherited = shift->SUPER::top_targets(@_); return $inherited; } sub MY::postamble { if ($::has_pdlpp) { return pdlpp_postamble($package); ##-- for PDL::PP (sub-)modules } return ''; } PDL-VectorValued-1.0.15/VectorValued/Dev.pm0000644000175000017500000003422414204433206020032 0ustar moocowbovines## -*- Mode: CPerl -*- ## + CPerl pukes on '/esg'-modifiers.... bummer ## ## $Id$ ## ## File: PDL::VectorValued::Dev.pm ## Author: Bryan Jurish ## Description: Vector utilities for PDL: development ##====================================================================== package PDL::VectorValued::Dev; use PDL::Types; use strict; ##====================================================================== ## Export hacks #use PDL::PP; ##-- do NOT do this! use Exporter; our $VERSION = '1.0.15'; ##-- v1.0.4: use perl-reversion from Perl::Version instead our @ISA = qw(Exporter); our @EXPORT_OK = ( ## ##-- High-level macro expansion qw(vvpp_def vvpp_expand), ## ##-- Type utilities qw(vv_indx_sig vv_indx_typedef), ## ##-- Macro expansion subs qw(vvpp_pdlvar_basename), qw(vvpp_expand_cmpvec vvpp_cmpvec_code), qw(vvpp_expand_cmpval vvpp_cmpval_code), ); our %EXPORT_TAGS = ( all => [@EXPORT_OK], default => [@EXPORT_OK], ); our @EXPORT = @{$EXPORT_TAGS{default}}; ##====================================================================== ## pod: header =pod =head1 NAME PDL::VectorValued::Dev - development utilities for vector-valued PDLs =head1 SYNOPSIS use PDL; use PDL::VectorValued::Dev; ##--------------------------------------------------------------------- ## ... stuff happens =cut ##====================================================================== ## Description =pod =head1 DESCRIPTION PDL::VectorValued::Dev provides some developer utilities for vector-valued PDLs. It produces code for processing with PDL::PP. =cut ##====================================================================== ## PP Utiltiies =pod =head1 PDL::PP Utilities =cut ##-------------------------------------------------------------- ## undef = vvpp_def($name,%args) =pod =head2 vvpp_def($funcName,%args) Wrapper for pp_def() which calls vvpp_expand() on 'Code' and 'BadCode' values in %args. =cut our @_REAL_TYPES = map { $_->{ppsym} } # Older PDLs: # - no native complex types, did not have real key # Newer PDLs: # - native complex types, have real key grep { ! exists $_->{real} || $_->{real} } @PDL::Types::typehash{PDL::Types::typesrtkeys()}; sub vvpp_def { my ($name,%args) = @_; foreach (qw(Code BadCode)) { $args{$_} = vvpp_expand($args{$_}) if (defined($args{$_})); } $args{GenericTypes} = \@_REAL_TYPES unless exists $args{GenericTypes}; PDL::PP::pp_def($name,%args); } ##-------------------------------------------------------------- ## $pp_code = vvpp_expand($vvpp_code) =pod =head2 $pp_code = vvpp_expand($vvpp_code) Expand PDL::VectorValued macros in $vvpp_code. Currently known PDL::VectorValued macros include: MACRO_NAME EXPANSION_SUBROUTINE ---------------------------------------------------------------------- $CMPVEC(...) vvpp_expand_cmpvec(...) $CMPVAL(...) vvpp_expand_cmpval(...) $LB(...) vvpp_expand_lb(...) See the documentation of the individual expansion subroutines for details on calling conventions. You can add your own expansion macros by pushing an expansion manipulating the array @PDL::VectorValued::Dev::MACROS which is just a list of expansion subroutines which take a single argument (string for Code or BadCode) and should return the expanded string. =cut our @MACROS = ( \&vvpp_expand_cmpvec, \&vvpp_expand_cmpval, \&vvpp_expand_lb, ## ## ... more macros here ); sub vvpp_expand { my $str = shift; my ($macro_sub); foreach $macro_sub (@MACROS) { $str = $macro_sub->($str); } $str; } ##-------------------------------------------------------------- ## $pp_code = vvpp_expand_cmpvec($vvpp_code) sub vvpp_expand_cmpvec { my $str = shift; #$str =~ s{\$CMPVEC\s*\(([^\)]*)\)}{vvpp_cmpvec_code(eval($1))}esg; ##-- nope $str =~ s{\$CMPVEC\s*\((.*)\)}{vvpp_cmpvec_code(eval($1))}emg; ##-- single-line macros ONLY return $str; } ##-------------------------------------------------------------- ## $pp_code = vvpp_expand_cmpval($vvpp_code) sub vvpp_expand_cmpval { my $str = shift; $str =~ s{\$CMPVAL\s*\((.*)\)}{vvpp_cmpval_code(eval($1))}emg; ##-- single-line macros ONLY return $str; } ##-------------------------------------------------------------- ## $pp_code = vvpp_expand_lb($vvpp_code) sub vvpp_expand_lb { my $str = shift; $str =~ s{\$LB\s*\((.*)\)}{vvpp_lb_code(eval($1))}emg; ##-- single-line macros ONLY return $str; } ##====================================================================== ## PP Utilities: Types =pod =head1 Type Utilities =cut ##-------------------------------------------------------------- ## $sigtype = vv_indx_sig() =pod =head2 vv_indx_sig() Returns a signature type for representing PDL indices. For PDL E= v2.007 this should be C, otherwise it will be C. =cut sub vv_indx_sig { require PDL::Core; return defined(&PDL::indx) ? 'indx' : 'int'; } ##-------------------------------------------------------------- ## $sigtype = vv_indx_typedef() =pod =head2 vv_indx_typedef() Returns a C typedef for the C type if running under PDL E= v2.007, otherwise just a comment. You can call this from client PDL::PP modules as pp_addhdr(PDL::VectorValued::Dev::vv_indx_typedef); =cut sub vv_indx_typedef { require PDL::Core; if (defined(&PDL::indx)) { return "/*-- PDL_Indx built-in for PDL >= v2.007 --*/\n"; } return "typedef int PDL_Indx; /*-- PDL_Indx typedef for PDL <= v2.007 --*/\n"; } ##====================================================================== ## PP Utilities: Macro Expansion =pod =head1 Macro Expansion Utilities =cut ##-------------------------------------------------------------- ## vvpp_pdlvar_basename() =pod =head2 vvpp_pdlvar_basename($pdlVarString) Gets basename of a PDL::PP variable by removing leading '$' and anything at or following the first open parenthesis: $base = vvpp_pdlvar_basename('$a(n=>0)'); ##-- $base is now 'a' =cut sub vvpp_pdlvar_basename { my $varname = shift; $varname =~ s/^\s*\$\s*//; $varname =~ s/\s*\(.*//; return $varname; } ##-------------------------------------------------------------- ## vvpp_cmpvec_code() =pod =head2 vvpp_cmpvec_code($vec1,$vec2,$dimName,$retvar,%options) Returns PDL::PP code for lexicographically comparing two vectors C<$vec1> and C<$vec2> along the dimension named C<$dim>, storing the comparison result in the C variable C<$retvar>, similar to what: $retvar = ($vec1 <=> $vec2); "ought to" do. Parameters: =over 4 =item $vec1 =item $vec2 PDL::PP string forms of vector PDLs to be compared. Need not be physical. =item $dimName Name of the dimension along which vectors should be compared. =item $retvar Name of a C variable to store the comparison result. =item $options{cvar1} =item $options{cvar2} If specified, temporary values for C<$vec1> (rsp. C<$vec2>) will be stored in the C variable $options{cvar1} (rsp. C<$options{cvar2}>). If unspecified, a new locally scoped C variable C<_vvpp_cmpvec_val1> (rsp. C<_vvpp_cmpvec_val2>) will be declared and used. =back =for example The PDL::PP code for cmpvec() looks something like this: use PDL::VectorValued::Dev; pp_def('cmpvec', Pars => 'a(n); b(n); int [o]cmp()', Code => ( 'int cmpval;' .vvpp_cmpvec_code( '$a()', '$b()', 'n', 'cmpval' ) .$cmp() = cmpval' ); ); =cut sub vvpp_cmpvec_code { my ($vec1,$vec2,$dimName,$retvar,%opts) = @_; ## ##-- sanity checks my $USAGE = 'vvpp_cmpvec_code($vec1,$vec2,$dimName,$retvar,%opts)'; die ("Usage: $USAGE") if (grep {!defined($_)} @_[0,1,2,3]); ## ##-- get PDL variable basenames my $vec1Name = vvpp_pdlvar_basename($vec1); my $vec2Name = vvpp_pdlvar_basename($vec2); my $ppcode = "\n{ /*-- BEGIN vvpp_cmpvec_code --*/\n"; ## ##-- get C variables my ($cvar1,$cvar2); if (!defined($cvar1=$opts{var1})) { $cvar1 = '_vvpp_cmpvec_val1'; $ppcode .= " \$GENERIC(${vec1Name}) ${cvar1};\n"; } if (!defined($cvar2=$opts{var2})) { $cvar2 = '_vvpp_cmpvec_val2'; $ppcode .= " \$GENERIC(${vec2Name}) ${cvar2};\n"; } ## ##-- generate comparison code $ppcode .= ('' ." ${retvar}=0;\n" ." loop (${dimName}) %{\n" ." ${cvar1}=$vec1;\n" ." ${cvar2}=$vec2;\n" ." if (${cvar1} < ${cvar2}) { ${retvar}=-1; break; }\n" ." else if (${cvar1} > ${cvar2}) { ${retvar}= 1; break; }\n" ." %}\n" ."} /*-- END vvpp_cmpvec_code --*/\n" ); ## ##-- ... and return return $ppcode; } ##-------------------------------------------------------------- ## vvpp_cmpval_code() =pod =head2 vvpp_cmpval_code($val1,$val2) Returns PDL::PP expression code for lexicographically comparing two values C<$val1> and C<$val2>, storing the comparison result in the C variable C<$retvar>, similar to what: ($vec1 <=> $vec2); "ought to" do. Parameters: =over 4 =item $val1 =item $val2 PDL::PP string forms of values to be compared. Need not be physical. =back =cut sub vvpp_cmpval_code { my ($val1,$val2) = @_; ## ##-- sanity checks my $USAGE = 'vvpp_cmpval_code($val1,$val2)'; die ("Usage: $USAGE") if (grep {!defined($_)} @_[0,1]); ## ##-- generate comparison code my $ppcode = ('' ."/*-- BEGIN vvpp_cmpval_code --*/ " ." (($val1) < ($val2) ? -1 : (($val1) > ($val2) ? 1 : 0)) " ." /*-- END vvpp_cmpvec_code --*/" ); ## ##-- ... and return return $ppcode; } ##-------------------------------------------------------------- ## vvpp_lb_code() =pod =head2 vvpp_lb_code($find,$vals, $imin,$imax, $retvar, %options) Returns PDL::PP code for binary lower-bound search for the value $find() in the sorted pdl $vals($imin:$imax-1). Parameters: =over 4 =item $find Value to search for or PDL::PP string form of such a value. =item $vals PDL::PP string form of PDL to be searched. $vals should contain a placeholder C<$_> representing the dimension to be searched. =item $retvar Name of a C variable to store the result. On return, C<$retvar> holds the maximum value for C<$_> in C<$vals($imin:$imax-1)> such that C<$vals($_=$retvar) E= $find> and C<$vals($_=$j) E $find> for all C<$j> with C<$imin E= $j E $retvar>, or C<$imin> if no such value for C<$retvar> exists, C<$imin E= $retvar E $imax>. In other words, returns the least index $_ of a match for $find in $vals($imin:$imax-1) whenever a match exists, otherwise the greatest index whose value in $vals($imin:$imax-1) is strictly less than $find if that exists, and $imin if all values in $vals($imin:$imax-1) are strictly greater than $find. =item $options{lovar} =item $options{hivar} =item $options{midvar} =item $options{cmpvar} If specified, temporary indices and comparison values will be stored in in the C variables $options{lovar}, $options{hivar}, $options{midvar}, and $options{cmpvar}. If unspecified, new locally scoped C variables C<_vvpp_lb_loval> etc. will be declared and used. =item $options{ubmaxvar} If specified, should be a C variable to hold the index of the last inspected value for $_ in $vals($imin:$imax-1) strictly greater than $find. =back =cut sub vvpp_lb_code { my ($find,$vals,$imin,$imax,$retvar,%opts) = @_; ## ##-- sanity checks my $USAGE = 'vvpp_lb_code($find,$vals,$imin,$imax,$retvar,%opts)'; die ("Usage: $USAGE") if (grep {!defined($_)} @_[0..4]); ## ##-- get PDL variable basenames my $ppcode = "\n{ /*-- BEGIN vvpp_lb_code --*/\n"; ## ##-- get C variables my ($lovar,$hivar,$midvar,$cmpvar); if (!defined($lovar=$opts{lovar})) { $lovar = '_vvpp_lb_loval'; $ppcode .= " long $lovar;"; } if (!defined($hivar=$opts{hivar})) { $hivar = '_vvpp_lb_hival'; $ppcode .= " long $hivar;"; } if (!defined($midvar=$opts{midvar})) { $midvar = '_vvpp_lb_midval'; $ppcode .= " long $midvar;"; } if (!defined($cmpvar=$opts{cmpvar})) { $cmpvar = '_vvpp_lb_cmpval'; $ppcode .= " int $cmpvar;"; } my $ubmaxvar = $opts{ubmaxvar}; ## ##-- generate search code (my $val_mid = $vals) =~ s/\$_/${midvar}/; (my $val_lo = $vals) =~ s/\$_/${lovar}/; (my $val_hi = $vals) =~ s/\$_/${hivar}/; $ppcode .= join("\n", " $lovar = $imin;", " $hivar = $imax;", #($ubmaxvar ? " $ubmaxvar = -1;" : qw()), " while ($hivar - $lovar > 1) {", " $midvar = ($hivar + $lovar) >> 1;", " $cmpvar = ".vvpp_cmpval_code($find, $val_mid).";", " if ($cmpvar > 0) { $lovar = $midvar; }", ($ubmaxvar ? " else if ($cmpvar < 0) { $hivar = $midvar; $ubmaxvar = $midvar; }" : qw()), " else { $hivar = $midvar; }", " }", " if ( $val_lo == $find) $retvar = $lovar;", " else if ($hivar < $imax && $val_hi == $find) $retvar = $hivar;", " else if ($lovar >= $imin && $val_lo < $find) $retvar = $lovar;", " else $retvar = $imin;", "} /*-- END vvpp_lb_code --*/\n", ); ## ##-- ... and return return $ppcode; } 1; ##-- make perl happy ##====================================================================== ## pod: Functions: low-level =pod =head2 Low-Level Functions Some additional low-level functions are provided in the PDL::Ngrams::ngutils package. See L for details. =cut ##====================================================================== ## pod: Bugs =pod =head1 KNOWN BUGS =head2 Why not PDL::PP macros? All of these functions would be more intuitive if implemented directly as PDL::PP macros, and thus expanded directly by pp_def() rather than requiring vvpp_def(). Unfortunately, I don't currently have the time to figure out how to use the (undocumented) PDL::PP macro expansion mechanism. Feel free to add real macro support. =cut ##====================================================================== ## pod: Footer =pod =head1 ACKNOWLEDGEMENTS perl by Larry Wall. =head1 AUTHOR Bryan Jurish Emoocow@cpan.orgE PDL by Karl Glazebrook, Tuomas J. Lukka, Christian Soeller, and others. =head1 COPYRIGHT Copyright (c) 2007-2021, Bryan Jurish. All rights reserved. This package is free software. You may redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO perl(1), PDL::PP(3perl). =cut PDL-VectorValued-1.0.15/README.txt0000644000175000017500000000241214122124160016036 0ustar moocowbovines README for PDL::VectorValued ABSTRACT PDL::VectorValued - Assorted PDL utilities treating vectors as values REQUIREMENTS * PDL Tested version(s) 2.4.2, 2.4.3, 2.4.7_001, 2.4.9_015, 2.4.10, 2.019, 2.039 DESCRIPTION PDL::VectorValued provides some generalizations of builtin PDL functions to higher order PDLs which treat vectors in the source PDLs as "data values". BUILDING Build this module as you would any perl module, by doing something akin to the following: gzip -dc distname-XX.YY.tar.gz | tar -xof - cd distname-XX.YY/ perl Makefile.PL make make test # optional make install See perlmodinstall(1) for details. ACKNOWLEDGEMENTS * Perl by Larry Wall * PDL by Karl Glazebrook, Tuomas J. Lukka, Christian Soeller, and others. * Code for rlevec() and rldvec() derived from the PDL builtin functions rle() and rld() in $PDL_SRC_ROOT/Basic/Slices/slices.pd AUTHOR Bryan Jurish COPYRIGHT Copyright (c) 2007-2021, Bryan Jurish. All rights reserved. This package is free software, and entirely without warranty. You may redistribute it and/or modify it under the same terms as Perl itself. PDL-VectorValued-1.0.15/Utils/0000755000175000017500000000000014204433466015456 5ustar moocowbovinesPDL-VectorValued-1.0.15/Utils/Utils.pm0000644000175000017500000005264114204433451017116 0ustar moocowbovines# # GENERATED WITH PDL::PP! Don't modify! # package PDL::VectorValued::Utils; our @EXPORT_OK = qw(rlevec rldvec enumvec enumvecg rleseq rldseq vsearchvec cmpvec vv_qsortvec vv_qsortveci vv_union vv_intersect vv_setdiff v_union v_intersect v_setdiff vv_vcos ); our %EXPORT_TAGS = (Func=>\@EXPORT_OK); use PDL::Core; use PDL::Exporter; use DynaLoader; our $VERSION = '1.0.15'; our @ISA = ( 'PDL::Exporter','DynaLoader' ); push @PDL::Core::PP, __PACKAGE__; bootstrap PDL::VectorValued::Utils $VERSION; #line 21 "utils.pd" use strict; =pod =head1 NAME PDL::VectorValued::Utils - Low-level utilities for vector-valued PDLs =head1 SYNOPSIS use PDL; use PDL::VectorValued::Utils; ##--------------------------------------------------------------------- ## ... stuff happens =cut #line 45 "Utils.pm" =head1 FUNCTIONS =cut #line 67 "utils.pd" =pod =head1 Vector-Based Run-Length Encoding and Decoding =cut #line 67 "Utils.pm" #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" =head2 rlevec =for sig Signature: (c(M,N); indx [o]a(N); [o]b(M,N)) Run-length encode a set of vectors. Higher-order rle(), for use with qsortvec(). Given set of vectors $c, generate a vector $a with the number of occurrences of each element (where an "element" is a vector of length $M ocurring in $c), and a set of vectors $b containing the unique values. As for rle(), only the elements up to the first instance of 0 in $a should be considered. Can be used together with clump() to run-length encode "values" of arbitrary dimensions. Can be used together with rotate(), cat(), append(), and qsortvec() to count N-grams over a 1d PDL. See also: PDL::Slices::rle, PDL::Ufunc::qsortvec, PDL::Primitive::uniqvec =for bad rlevec does not process bad values. It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays. =cut #line 105 "Utils.pm" #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" *rlevec = \&PDL::rlevec; #line 112 "Utils.pm" #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" =head2 rldvec =for sig Signature: (int a(N); b(M,N); [o]c(M,N)) Run-length decode a set of vectors, akin to a higher-order rld(). Given a vector $a() of the number of occurrences of each row, and a set $c() of row-vectors each of length $M, run-length decode to $c(). Can be used together with clump() to run-length decode "values" of arbitrary dimensions. See also: PDL::Slices::rld. =for bad rldvec does not process bad values. It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays. =cut #line 144 "Utils.pm" #line 1059 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" sub PDL::rldvec { my ($a,$b,$c) = @_; if (!defined($c)) { # XXX Need to improve emulation of threading in auto-generating c my ($rowlen) = $b->dim(0); my ($size) = $a->sumover->max; my (@dims) = $a->dims; shift(@dims); $c = $b->zeroes($b->type,$rowlen,$size,@dims); } &PDL::_rldvec_int($a,$b,$c); return $c; } #line 163 "Utils.pm" #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" *rldvec = \&PDL::rldvec; #line 170 "Utils.pm" #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" =head2 enumvec =for sig Signature: (v(M,N); int [o]k(N)) Enumerate a list of vectors with locally unique keys. Given a sorted list of vectors $v, generate a vector $k containing locally unique keys for the elements of $v (where an "element" is a vector of length $M ocurring in $v). Note that the keys returned in $k are only unique over a run of a single vector in $v, so that each unique vector in $v has at least one 0 (zero) index in $k associated with it. If you need global keys, see enumvecg(). =for bad enumvec does not process bad values. It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays. =cut #line 202 "Utils.pm" #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" *enumvec = \&PDL::enumvec; #line 209 "Utils.pm" #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" =head2 enumvecg =for sig Signature: (v(M,N); int [o]k(N)) Enumerate a list of vectors with globally unique keys. Given a sorted list of vectors $v, generate a vector $k containing globally unique keys for the elements of $v (where an "element" is a vector of length $M ocurring in $v). Basically does the same thing as: $k = $v->vsearchvec($v->uniqvec); ... but somewhat more efficiently. =for bad enumvecg does not process bad values. It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays. =cut #line 242 "Utils.pm" #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" *enumvecg = \&PDL::enumvecg; #line 249 "Utils.pm" #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" =head2 rleseq =for sig Signature: (c(N); indx [o]a(N); [o]b(N)) Run-length encode a vector of subsequences. Given a vector of $c() of concatenated variable-length, variable-offset subsequences, generate a vector $a containing the length of each subsequence and a vector $b containing the subsequence offsets. As for rle(), only the elements up to the first instance of 0 in $a should be considered. See also PDL::Slices::rle. =for bad rleseq does not process bad values. It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays. =cut #line 281 "Utils.pm" #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" *rleseq = \&PDL::rleseq; #line 288 "Utils.pm" #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" =head2 rldseq =for sig Signature: (int a(N); b(N); [o]c(M)) Run-length decode a subsequence vector. Given a vector $a() of sequence lengths and a vector $b() of corresponding offsets, decode concatenation of subsequences to $c(), as for: $c = null; $c = $c->append($b($_)+sequence($a->type,$a($_))) foreach (0..($N-1)); See also: PDL::Slices::rld. =for bad rldseq does not process bad values. It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays. =cut #line 323 "Utils.pm" #line 1059 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" sub PDL::rldseq { my ($a,$b,$c) = @_; if (!defined($c)) { my $size = $a->sumover->max; my (@dims) = $a->dims; shift(@dims); $c = $b->zeroes($b->type,$size,@dims); } &PDL::_rldseq_int($a,$b,$c); return $c; } #line 340 "Utils.pm" #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" *rldseq = \&PDL::rldseq; #line 347 "Utils.pm" #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" =head2 vsearchvec =for sig Signature: (find(M); which(M,N); int [o]found()) =for ref Routine for searching N-dimensional values - akin to vsearch() for vectors. =for usage $found = ccs_vsearchvec($find, $which); $nearest = $which->dice_axis(1,$found); Returns for each row-vector in C<$find> the index along dimension N of the least row vector of C<$which> greater or equal to it. C<$which> should be sorted in increasing order. If the value of C<$find> is larger than any member of C<$which>, the index to the last element of C<$which> is returned. See also: PDL::Primitive::vsearch(). =for bad vsearchvec does not process bad values. It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays. =cut #line 389 "Utils.pm" #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" *vsearchvec = \&PDL::vsearchvec; #line 396 "Utils.pm" #line 392 "utils.pd" =pod =head1 Vector-Valued Sorting and Comparison The following functions are provided for lexicographic sorting of vectors, rsp. axis indices. As of PDL::VectorValued v1.0.12, vv_qsortvec() and vv_qsortveci() are just deprecated aliases for the builtin PDL functions of the same names. Older versions of this module used a dedicated implementation as a workaround for a bug in PDL-2.4.3, which has long since been fixed. =cut #line 414 "Utils.pm" #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" =head2 cmpvec =for sig Signature: (a(N); b(N); int [o]cmp()) Lexicographically compare a pair of vectors. =for bad cmpvec does not process bad values. It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays. =cut #line 439 "Utils.pm" #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" *cmpvec = \&PDL::cmpvec; #line 446 "Utils.pm" #line 422 "utils.pd" =head2 vv_qsortvec =for sig Signature: (a(n,m); [o]b(n,m)) =for ref Deprecated alias for L, which see for details. =head2 vv_qsortveci =for sig Signature: (a(n,m); indx [o]ix(m)) =for ref Deprecated alias for L, which see for details. =cut BEGIN { *vv_qsortvec = *PDL::vv_qsortvec = *PDL::qsortvec; *vv_qsortveci = *PDL::vv_qsortveci = *PDL::qsortveci; } #line 483 "Utils.pm" #line 463 "utils.pd" =pod =head1 Vector-Valued Set Operations The following functions are provided for set operations on sorted vector-valued PDLs. =cut #line 498 "Utils.pm" #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" =head2 vv_union =for sig Signature: (a(M,NA); b(M,NB); [o]c(M,NC); int [o]nc()) Union of two vector-valued PDLs. Input PDLs $a() and $b() B be sorted in lexicographic order. On return, $nc() holds the actual number of vector-values in the union. In scalar context, slices $c() to the actual number of elements in the union and returns the sliced PDL. =for bad vv_union does not process bad values. It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays. =cut #line 530 "Utils.pm" #line 1059 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" sub PDL::vv_union { my ($a,$b,$c,$nc) = @_; barf("PDL::VectorValued::vv_union(): dimension mismatch") if ($a->dim(-2) != $b->dim(-2)); my @adims = $a->dims; if (!defined($c)) { my $ctype = $a->type > $b->type ? $a->type : $b->type; $c = PDL->zeroes($ctype, @adims[0..($#adims-1)], $adims[$#adims] + $b->dim(-1)); } $nc = PDL->zeroes(PDL::long(), (@adims > 2 ? @adims[0..($#adims-2)] : 1)) if (!defined($nc)); &PDL::_vv_union_int($a,$b,$c,$nc); return ($c,$nc) if (wantarray); return $c->mv(-1,0)->slice("0:".($nc->sclr-1))->mv(0,-1); } #line 550 "Utils.pm" #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" *vv_union = \&PDL::vv_union; #line 557 "Utils.pm" #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" =head2 vv_intersect =for sig Signature: (a(M,NA); b(M,NB); [o]c(M,NC); int [o]nc()) Intersection of two vector-valued PDLs. Input PDLs $a() and $b() B be sorted in lexicographic order. On return, $nc() holds the actual number of vector-values in the intersection. In scalar context, slices $c() to the actual number of elements in the intersection and returns the sliced PDL. =for bad vv_intersect does not process bad values. It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays. =cut #line 588 "Utils.pm" #line 1059 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" sub PDL::vv_intersect { my ($a,$b,$c,$nc) = @_; barf("PDL::VectorValued::vv_intersect(): dimension mismatch") if ($a->dim(-2) != $b->dim(-2)); my @adims = $a->dims; my $NA = $adims[$#adims]; my $NB = $b->dim(-1); if (!defined($c)) { my $ctype = $a->type > $b->type ? $a->type : $b->type; $c = PDL->zeroes($ctype, @adims[0..($#adims-1)], $NA < $NB ? $NA : $NB); } $nc = PDL->zeroes(PDL::long(), (@adims > 2 ? @adims[0..($#adims-2)] : 1)) if (!defined($nc)); &PDL::_vv_intersect_int($a,$b,$c,$nc); return ($c,$nc) if (wantarray); return $c->mv(-1,0)->slice("0:".($nc->sclr-1))->mv(0,-1); } #line 610 "Utils.pm" #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" *vv_intersect = \&PDL::vv_intersect; #line 617 "Utils.pm" #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" =head2 vv_setdiff =for sig Signature: (a(M,NA); b(M,NB); [o]c(M,NC); int [o]nc()) Set-difference ($a() \ $b()) of two vector-valued PDLs. Input PDLs $a() and $b() B be sorted in lexicographic order. On return, $nc() holds the actual number of vector-values in the computed vector set. In scalar context, slices $c() to the actual number of elements in the output vector set and returns the sliced PDL. =for bad vv_setdiff does not process bad values. It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays. =cut #line 648 "Utils.pm" #line 1059 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" sub PDL::vv_setdiff { my ($a,$b,$c,$nc) = @_; barf("PDL::VectorValued::vv_setdiff(): dimension mismatch") if ($a->dim(-2) != $b->dim(-2)); my @adims = $a->dims; my $NA = $adims[$#adims]; my $NB = $b->dim(-1); if (!defined($c)) { my $ctype = $a->type > $b->type ? $a->type : $b->type; $c = PDL->zeroes($ctype, @adims[0..($#adims-1)], $NA); } $nc = PDL->zeroes(PDL::long(), (@adims > 2 ? @adims[0..($#adims-2)] : 1)) if (!defined($nc)); &PDL::_vv_setdiff_int($a,$b,$c,$nc); return ($c,$nc) if (wantarray); return $c->mv(-1,0)->slice("0:".($nc->sclr-1))->mv(0,-1); } #line 670 "Utils.pm" #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" *vv_setdiff = \&PDL::vv_setdiff; #line 677 "Utils.pm" #line 674 "utils.pd" =pod =head1 Sorted Vector Set Operations The following functions are provided for set operations on flat sorted PDLs with unique values. They may be more efficient to compute than the corresponding implementations via PDL::Primitive::setops(). =cut #line 693 "Utils.pm" #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" =head2 v_union =for sig Signature: (a(NA); b(NB); [o]c(NC); int [o]nc()) Union of two flat sorted unique-valued PDLs. Input PDLs $a() and $b() B be sorted in lexicographic order and contain no duplicates. On return, $nc() holds the actual number of values in the union. In scalar context, reshapes $c() to the actual number of elements in the union and returns it. =for bad v_union does not process bad values. It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays. =cut #line 723 "Utils.pm" #line 1059 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" sub PDL::v_union { my ($a,$b,$c,$nc) = @_; barf("PDL::VectorValued::v_union(): only 1d vectors are supported") if ($a->ndims > 1 || $b->ndims > 1); $nc = PDL->pdl(PDL::long(), $a->dim(0) + $b->dim(0)) if (!defined($nc)); if (!defined($c)) { my $ctype = $a->type > $b->type ? $a->type : $b->type; $c = PDL->zeroes($ctype, ref($nc) ? $nc->sclr : $nc); } &PDL::_v_union_int($a,$b,$c,$nc); return ($c,$nc) if (wantarray); return $c->reshape($nc->sclr); } #line 742 "Utils.pm" #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" *v_union = \&PDL::v_union; #line 749 "Utils.pm" #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" =head2 v_intersect =for sig Signature: (a(NA); b(NB); [o]c(NC); int [o]nc()) Intersection of two flat sorted unique-valued PDLs. Input PDLs $a() and $b() B be sorted in lexicographic order and contain no duplicates. On return, $nc() holds the actual number of values in the intersection. In scalar context, reshapes $c() to the actual number of elements in the intersection and returns it. =for bad v_intersect does not process bad values. It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays. =cut #line 779 "Utils.pm" #line 1059 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" sub PDL::v_intersect { my ($a,$b,$c,$nc) = @_; barf("PDL::VectorValued::v_intersect(): only 1d vectors are supported") if ($a->ndims > 1 || $b->ndims > 1); my $NA = $a->dim(0); my $NB = $b->dim(0); $nc = PDL->pdl(PDL::long(), $NA < $NB ? $NA : $NB) if (!defined($nc)); if (!defined($c)) { my $ctype = $a->type > $b->type ? $a->type : $b->type; $c = PDL->zeroes($ctype, ref($nc) ? $nc->sclr : $nc); } &PDL::_v_intersect_int($a,$b,$c,$nc); return ($c,$nc) if (wantarray); return $c->reshape($nc->sclr); } #line 800 "Utils.pm" #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" *v_intersect = \&PDL::v_intersect; #line 807 "Utils.pm" #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" =head2 v_setdiff =for sig Signature: (a(NA); b(NB); [o]c(NC); int [o]nc()) Set-difference ($a() \ $b()) of two flat sorted unique-valued PDLs. Input PDLs $a() and $b() B be sorted in lexicographic order and contain no duplicate values. On return, $nc() holds the actual number of values in the computed vector set. In scalar context, reshapes $c() to the actual number of elements in the difference set and returns it. =for bad v_setdiff does not process bad values. It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays. =cut #line 837 "Utils.pm" #line 1059 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" sub PDL::v_setdiff { my ($a,$b,$c,$nc) = @_; barf("PDL::VectorValued::v_setdiff(): only 1d vectors are supported") if ($a->ndims > 1 || $b->ndims > 1); my $NA = $a->dim(0); my $NB = $b->dim(0); $nc = PDL->pdl(PDL::long(), $NA) if (!defined($nc)); if (!defined($c)) { my $ctype = $a->type > $b->type ? $a->type : $b->type; $c = PDL->zeroes($ctype, $NA); } &PDL::_v_setdiff_int($a,$b,$c,$nc); return ($c,$nc) if (wantarray); return $c->reshape($nc->sclr); } #line 858 "Utils.pm" #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" *v_setdiff = \&PDL::v_setdiff; #line 865 "Utils.pm" #line 875 "utils.pd" =pod =head1 Miscellaneous Vector-Valued Operations =cut #line 877 "Utils.pm" #line 1058 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" =head2 vv_vcos =for sig Signature: (a(M,N);b(M);float+ [o]vcos(N)) Computes the vector cosine similarity of a dense vector $b() with respect to each row $a(*,i) of a dense PDL $a(). This is basically the same thing as: ($a * $b)->sumover / ($a->pow(2)->sumover->sqrt * $b->pow(2)->sumover->sqrt) ... but should be must faster to compute, and avoids allocating potentially large temporaries for the vector magnitudes. Output values in $vcos() are cosine similarities in the range [-1,1], except for zero-magnitude vectors which will result in NaN values in $vcos(). You can use PDL threading to batch-compute distances for multiple $b() vectors simultaneously: $bx = random($M, $NB); ##-- get $NB random vectors of size $N $vcos = vv_vcos($a,$bx); ##-- $vcos(i,j) ~ sim($a(,i),$b(,j)) =for bad vv_vcos() will set the bad status flag on the output piddle $vcos() if it is set on either of the input piddles $a() or $b(), but BAD values will otherwise be ignored for computing the cosine similarity. =cut #line 915 "Utils.pm" #line 1060 "/local/home/moocow/local/lib/perl5/x86_64-linux-gnu-thread-multi/PDL/PP.pm" *vv_vcos = \&PDL::vv_vcos; #line 922 "Utils.pm" #line 985 "utils.pd" ##--------------------------------------------------------------------- =pod =head1 ACKNOWLEDGEMENTS =over 4 =item * Perl by Larry Wall =item * PDL by Karl Glazebrook, Tuomas J. Lukka, Christian Soeller, and others. =item * Code for rlevec() and rldvec() derived from the PDL builtin functions rle() and rld() in $PDL_SRC_ROOT/Basic/Slices/slices.pd =back =cut ##---------------------------------------------------------------------- =pod =head1 KNOWN BUGS Probably many. =cut ##--------------------------------------------------------------------- =pod =head1 AUTHOR Bryan Jurish Emoocow@cpan.orgE =head1 COPYRIGHT =over 4 =item * Code for qsortvec() copyright (C) Tuomas J. Lukka 1997. Contributions by Christian Soeller (c.soeller@auckland.ac.nz) and 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. =item * All other parts copyright (c) 2007-2021, Bryan Jurish. All rights reserved. This package is free software, and entirely without warranty. You may redistribute it and/or modify it under the same terms as Perl itself. =back =head1 SEE ALSO perl(1), PDL(3perl) =cut #line 1003 "Utils.pm" # Exit with OK status 1; PDL-VectorValued-1.0.15/Utils/utils.pd0000644000175000017500000006446314204433206017150 0ustar moocowbovines##-*- Mode: CPerl -*- ##====================================================================== ## Header Administrivia ##====================================================================== #require "../VectorValued/Version.pm"; ##-- use perl-reversion from Perl::Version instead my $VERSION = '1.0.15'; pp_setversion($VERSION); require "../VectorValued/Dev.pm"; PDL::VectorValued::Dev->import(); ##------------------------------------------------------ ## PDL_Indx type my $INDX = vv_indx_sig(); pp_addhdr( vv_indx_typedef() ); ##------------------------------------------------------ ## pm additions pp_addpm({At=>'Top'},<<'EOPM'); use strict; =pod =head1 NAME PDL::VectorValued::Utils - Low-level utilities for vector-valued PDLs =head1 SYNOPSIS use PDL; use PDL::VectorValued::Utils; ##--------------------------------------------------------------------- ## ... stuff happens =cut EOPM ## /pm additions ##------------------------------------------------------ ##------------------------------------------------------ ## Exports: None #pp_export_nothing(); ##------------------------------------------------------ ## Includes / defines pp_addhdr(<<'EOH'); EOH ##====================================================================== ## C Utilities ##====================================================================== # (none) ##====================================================================== ## PDL::PP Wrappers ##====================================================================== ##====================================================================== ## Vector-Based Run-Length Encoding and Decoding ##====================================================================== pp_addpm(<<'EOPM'); =pod =head1 Vector-Based Run-Length Encoding and Decoding =cut EOPM ##------------------------------------------------------ ## rlevec() pp_def('rlevec', Pars => "c(M,N); $INDX \[o]a(N); [o]b(M,N)", Code =><<'EOC', PDL_Indx cn,bn=0, sn=$SIZE(N), matches; loop (M) %{ $b(N=>0)=$c(N=>0); %} $a(N=>0) = 1; for (cn=1; cncn) != $b(N=>bn)) { matches=0; break; } %} if (matches) { $a(N=>bn)++; } else { bn++; loop (M) %{ $b(N=>bn) = $c(N=>cn); %} $a(N=>bn) = 1; } } for (bn++; bnbn) = 0; loop (M) %{ $b(N=>bn) = 0; %} } EOC Doc =><<'EOD', Run-length encode a set of vectors. Higher-order rle(), for use with qsortvec(). Given set of vectors $c, generate a vector $a with the number of occurrences of each element (where an "element" is a vector of length $M ocurring in $c), and a set of vectors $b containing the unique values. As for rle(), only the elements up to the first instance of 0 in $a should be considered. Can be used together with clump() to run-length encode "values" of arbitrary dimensions. Can be used together with rotate(), cat(), append(), and qsortvec() to count N-grams over a 1d PDL. See also: PDL::Slices::rle, PDL::Ufunc::qsortvec, PDL::Primitive::uniqvec EOD ); ##------------------------------------------------------ ## rldvec() pp_def('rldvec', Pars => 'int a(N); b(M,N); [o]c(M,N)', PMCode=><<'EOC', sub PDL::rldvec { my ($a,$b,$c) = @_; if (!defined($c)) { # XXX Need to improve emulation of threading in auto-generating c my ($rowlen) = $b->dim(0); my ($size) = $a->sumover->max; my (@dims) = $a->dims; shift(@dims); $c = $b->zeroes($b->type,$rowlen,$size,@dims); } &PDL::_rldvec_int($a,$b,$c); return $c; } EOC Code =><<'EOC', int i,nrows,bn,cn=0, sn=$SIZE(N); for (bn=0; bnbn); for (i=0; icn) = $b(N=>bn); %} cn++; } } EOC Doc =><<'EOD' Run-length decode a set of vectors, akin to a higher-order rld(). Given a vector $a() of the number of occurrences of each row, and a set $c() of row-vectors each of length $M, run-length decode to $c(). Can be used together with clump() to run-length decode "values" of arbitrary dimensions. See also: PDL::Slices::rld. EOD ); ##------------------------------------------------------ ## enumvec() pp_def('enumvec', Pars => 'v(M,N); int [o]k(N)', Code =><<'EOC', int vn, kn, sn=$SIZE(N), matches; for (vn=0; vnkn) = kn-vn; ++kn; loop (M) %{ if ($v(N=>vn) != $v(N=>kn)) { matches=0; break; } %} } } EOC Doc =><<'EOD', Enumerate a list of vectors with locally unique keys. Given a sorted list of vectors $v, generate a vector $k containing locally unique keys for the elements of $v (where an "element" is a vector of length $M ocurring in $v). Note that the keys returned in $k are only unique over a run of a single vector in $v, so that each unique vector in $v has at least one 0 (zero) index in $k associated with it. If you need global keys, see enumvecg(). EOD ); ##------------------------------------------------------ ## enumvecg() pp_def('enumvecg', Pars => 'v(M,N); int [o]k(N)', Code =><<'EOC', int vn, vnprev, sn=$SIZE(N), ki; if (sn > 0) { $k(N=>0) = ki = 0; for (vnprev=0, vn=1; vnvnprev) != $v(N=>vn)) { ++ki; break; } %} $k(N=>vn) = ki; } } EOC Doc =><<'EOD', Enumerate a list of vectors with globally unique keys. Given a sorted list of vectors $v, generate a vector $k containing globally unique keys for the elements of $v (where an "element" is a vector of length $M ocurring in $v). Basically does the same thing as: $k = $v->vsearchvec($v->uniqvec); ... but somewhat more efficiently. EOD ); ##------------------------------------------------------ ## rleseq() pp_def('rleseq', Pars => "c(N); $INDX \[o]a(N); [o]b(N)", Code=><<'EOC', PDL_Indx j=0, sizeN=$SIZE(N); $GENERIC(c) coff; coff = $c(N=>0); $b(N=>0) = coff; $a(N=>0) = 0; loop (N) %{ if ($c() == coff+$a(N=>j)) { $a(N=>j)++; } else { j++; $b(N=>j) = coff = $c(); $a(N=>j) = 1; } %} for (j++; jj) = 0; $b(N=>j) = 0; } EOC Doc =><<'EOD', Run-length encode a vector of subsequences. Given a vector of $c() of concatenated variable-length, variable-offset subsequences, generate a vector $a containing the length of each subsequence and a vector $b containing the subsequence offsets. As for rle(), only the elements up to the first instance of 0 in $a should be considered. See also PDL::Slices::rle. EOD ); ##------------------------------------------------------ ## rldseq() pp_def('rldseq', Pars => 'int a(N); b(N); [o]c(M)', PMCode=><<'EOC', sub PDL::rldseq { my ($a,$b,$c) = @_; if (!defined($c)) { my $size = $a->sumover->max; my (@dims) = $a->dims; shift(@dims); $c = $b->zeroes($b->type,$size,@dims); } &PDL::_rldseq_int($a,$b,$c); return $c; } EOC Code =><<'EOC', size_t mi=0; loop (N) %{ size_t len = $a(), li; for (li=0; li < len; ++li, ++mi) { $c(M=>mi) = $b() + li; } %} EOC Doc =><<'EOD' Run-length decode a subsequence vector. Given a vector $a() of sequence lengths and a vector $b() of corresponding offsets, decode concatenation of subsequences to $c(), as for: $c = null; $c = $c->append($b($_)+sequence($a->type,$a($_))) foreach (0..($N-1)); See also: PDL::Slices::rld. EOD ); ##====================================================================== ## Vector Search ##====================================================================== ##------------------------------------------------------ ## vsearchvec() : binary search on a (sorted) vector list vvpp_def ('vsearchvec', Pars => 'find(M); which(M,N); int [o]found();', Code => (q( int carp=0; threadloop %{ long sizeM=$SIZE(M), sizeN=$SIZE(N), n1=sizeN-1; long nlo=-1, nhi=n1, nn; $GENERIC() findval, whichval, whichval1; int cmpval, is_asc_sorted; // //-- get sort direction $CMPVEC('$which(N=>n1)','$which(N=>0)','M','cmpval',var1=>'whichval1',var2=>'whichval'); is_asc_sorted = (cmpval > 0); // //-- binary search while (nhi-nlo > 1) { nn = (nhi+nlo) >> 1; $CMPVEC('$find()','$which(N=>nn)','M','cmpval', var1=>'findval',var2=>'whichval'); if (cmpval > 0 == is_asc_sorted) nlo=nn; else nhi=nn; } if (nlo==-1) { nhi=0; } else if (nlo==n1) { $CMPVEC('$find()','$which(N=>n1)','M','cmpval', var1=>'findval',var2=>'whichval'); if (cmpval != 0) carp = 1; nhi = n1; } else { nhi = nlo+1; } $found() = nhi; %} if (carp) warn("some values had to be extrapolated"); )), Doc=><<'EOD' =for ref Routine for searching N-dimensional values - akin to vsearch() for vectors. =for usage $found = ccs_vsearchvec($find, $which); $nearest = $which->dice_axis(1,$found); Returns for each row-vector in C<$find> the index along dimension N of the least row vector of C<$which> greater or equal to it. C<$which> should be sorted in increasing order. If the value of C<$find> is larger than any member of C<$which>, the index to the last element of C<$which> is returned. See also: PDL::Primitive::vsearch(). EOD ); ##====================================================================== ## Vector Sorting and Comparison ##====================================================================== pp_addpm(<<'EOPM'); =pod =head1 Vector-Valued Sorting and Comparison The following functions are provided for lexicographic sorting of vectors, rsp. axis indices. As of PDL::VectorValued v1.0.12, vv_qsortvec() and vv_qsortveci() are just deprecated aliases for the builtin PDL functions of the same names. Older versions of this module used a dedicated implementation as a workaround for a bug in PDL-2.4.3, which has long since been fixed. =cut EOPM ##------------------------------------------------------ ## cmpvec() : make vector comparison available in perl vvpp_def ('cmpvec', Pars => 'a(N); b(N); int [o]cmp()', Code => q($CMPVEC('$a()','$b()','N','$cmp()')), Doc=><<'EOD' Lexicographically compare a pair of vectors. EOD ); ##------------------------------------------------------ ## vv_qsortvec(), vv_qsortveci() : compatibility wrappers for PDL::Ufunc::qsortvec(), PDL::Ufunc::qsortveci() pp_addpm(<<'EOPM'); =head2 vv_qsortvec =for sig Signature: (a(n,m); [o]b(n,m)) =for ref Deprecated alias for L, which see for details. =head2 vv_qsortveci =for sig Signature: (a(n,m); indx [o]ix(m)) =for ref Deprecated alias for L, which see for details. =cut BEGIN { *vv_qsortvec = *PDL::vv_qsortvec = *PDL::qsortvec; *vv_qsortveci = *PDL::vv_qsortveci = *PDL::qsortveci; } EOPM pp_add_exported('vv_qsortvec'); pp_add_exported('vv_qsortveci'); ##====================================================================== ## Vector-Valued Set Operations ##====================================================================== pp_addpm(<<'EOPM'); =pod =head1 Vector-Valued Set Operations The following functions are provided for set operations on sorted vector-valued PDLs. =cut EOPM ##------------------------------------------------------ ## vv_union() : set union vvpp_def ('vv_union', Pars => 'a(M,NA); b(M,NB); [o]c(M,NC); int [o]nc()', PMCode=> (q( sub PDL::vv_union { my ($a,$b,$c,$nc) = @_; barf("PDL::VectorValued::vv_union(): dimension mismatch") if ($a->dim(-2) != $b->dim(-2)); my @adims = $a->dims; if (!defined($c)) { my $ctype = $a->type > $b->type ? $a->type : $b->type; $c = PDL->zeroes($ctype, @adims[0..($#adims-1)], $adims[$#adims] + $b->dim(-1)); } $nc = PDL->zeroes(PDL::long(), (@adims > 2 ? @adims[0..($#adims-2)] : 1)) if (!defined($nc)); &PDL::_vv_union_int($a,$b,$c,$nc); return ($c,$nc) if (wantarray); return $c->mv(-1,0)->slice("0:".($nc->sclr-1))->mv(0,-1); } )), Code => (q( PDL_Indx nai=0, nbi=0, nci=0, sizeNA=$SIZE(NA), sizeNB=$SIZE(NB), sizeNC=$SIZE(NC); $GENERIC() aval, bval; int cmpval; for ( ; nci < sizeNC; nci++) { if (nai < sizeNA && nbi < sizeNB) { $CMPVEC('$a(NA=>nai)','$b(NB=>nbi)','M','cmpval',var1=>'aval',var2=>'bval'); } else if (nai < sizeNA) { cmpval = -1; } else if (nbi < sizeNB) { cmpval = 1; } else { break; } // if (cmpval < 0) { //-- CASE: a < b loop (M) %{ $c(NC=>nci) = $a(NA=>nai); %} nai++; } else if (cmpval > 0) { //-- CASE: a > b loop (M) %{ $c(NC=>nci) = $b(NB=>nbi); %} nbi++; } else { //-- CASE: a == b loop (M) %{ $c(NC=>nci) = $a(NA=>nai); %} nai++; nbi++; } } $nc() = nci; )), Doc=><<'EOD' Union of two vector-valued PDLs. Input PDLs $a() and $b() B be sorted in lexicographic order. On return, $nc() holds the actual number of vector-values in the union. In scalar context, slices $c() to the actual number of elements in the union and returns the sliced PDL. EOD ); ##------------------------------------------------------ ## vv_intersect() : set intersection vvpp_def ('vv_intersect', Pars => 'a(M,NA); b(M,NB); [o]c(M,NC); int [o]nc()', PMCode=> (q( sub PDL::vv_intersect { my ($a,$b,$c,$nc) = @_; barf("PDL::VectorValued::vv_intersect(): dimension mismatch") if ($a->dim(-2) != $b->dim(-2)); my @adims = $a->dims; my $NA = $adims[$#adims]; my $NB = $b->dim(-1); if (!defined($c)) { my $ctype = $a->type > $b->type ? $a->type : $b->type; $c = PDL->zeroes($ctype, @adims[0..($#adims-1)], $NA < $NB ? $NA : $NB); } $nc = PDL->zeroes(PDL::long(), (@adims > 2 ? @adims[0..($#adims-2)] : 1)) if (!defined($nc)); &PDL::_vv_intersect_int($a,$b,$c,$nc); return ($c,$nc) if (wantarray); return $c->mv(-1,0)->slice("0:".($nc->sclr-1))->mv(0,-1); } )), Code => (q( PDL_Indx nai=0, nbi=0, nci=0, sizeNA=$SIZE(NA), sizeNB=$SIZE(NB), sizeNC=$SIZE(NC); $GENERIC() aval, bval; int cmpval; for ( ; nci < sizeNC && nai < sizeNA && nbi < sizeNB; ) { $CMPVEC('$a(NA=>nai)','$b(NB=>nbi)','M','cmpval',var1=>'aval',var2=>'bval'); // if (cmpval < 0) { //-- CASE: a < b nai++; } else if (cmpval > 0) { //-- CASE: a > b nbi++; } else { //-- CASE: a == b loop (M) %{ $c(NC=>nci) = $a(NA=>nai); %} nai++; nbi++; nci++; } } $nc() = nci; )), Doc=><<'EOD' Intersection of two vector-valued PDLs. Input PDLs $a() and $b() B be sorted in lexicographic order. On return, $nc() holds the actual number of vector-values in the intersection. In scalar context, slices $c() to the actual number of elements in the intersection and returns the sliced PDL. EOD ); ##------------------------------------------------------ ## vv_setdiff() : set difference vvpp_def ('vv_setdiff', Pars => 'a(M,NA); b(M,NB); [o]c(M,NC); int [o]nc()', PMCode=> (q( sub PDL::vv_setdiff { my ($a,$b,$c,$nc) = @_; barf("PDL::VectorValued::vv_setdiff(): dimension mismatch") if ($a->dim(-2) != $b->dim(-2)); my @adims = $a->dims; my $NA = $adims[$#adims]; my $NB = $b->dim(-1); if (!defined($c)) { my $ctype = $a->type > $b->type ? $a->type : $b->type; $c = PDL->zeroes($ctype, @adims[0..($#adims-1)], $NA); } $nc = PDL->zeroes(PDL::long(), (@adims > 2 ? @adims[0..($#adims-2)] : 1)) if (!defined($nc)); &PDL::_vv_setdiff_int($a,$b,$c,$nc); return ($c,$nc) if (wantarray); return $c->mv(-1,0)->slice("0:".($nc->sclr-1))->mv(0,-1); } )), Code => (q( PDL_Indx nai=0, nbi=0, nci=0, sizeNA=$SIZE(NA), sizeNB=$SIZE(NB), sizeNC=$SIZE(NC); $GENERIC() aval, bval; int cmpval; for ( ; nci < sizeNC && nai < sizeNA && nbi < sizeNB ; ) { $CMPVEC('$a(NA=>nai)','$b(NB=>nbi)','M','cmpval',var1=>'aval',var2=>'bval'); // if (cmpval < 0) { //-- CASE: a < b loop (M) %{ $c(NC=>nci) = $a(NA=>nai); %} nai++; nci++; } else if (cmpval > 0) { //-- CASE: a > b nbi++; } else { //-- CASE: a == b nai++; nbi++; } } for ( ; nci < sizeNC && nai < sizeNA ; nai++,nci++ ) { loop (M) %{ $c(NC=>nci) = $a(NA=>nai); %} } $nc() = nci; )), Doc=><<'EOD' Set-difference ($a() \ $b()) of two vector-valued PDLs. Input PDLs $a() and $b() B be sorted in lexicographic order. On return, $nc() holds the actual number of vector-values in the computed vector set. In scalar context, slices $c() to the actual number of elements in the output vector set and returns the sliced PDL. EOD ); ##====================================================================== ## Sorted Vector Set Operations ##====================================================================== pp_addpm(<<'EOPM'); =pod =head1 Sorted Vector Set Operations The following functions are provided for set operations on flat sorted PDLs with unique values. They may be more efficient to compute than the corresponding implementations via PDL::Primitive::setops(). =cut EOPM ##------------------------------------------------------ ## v_union() : flat set union vvpp_def ('v_union', Pars => 'a(NA); b(NB); [o]c(NC); int [o]nc()', PMCode=> (q( sub PDL::v_union { my ($a,$b,$c,$nc) = @_; barf("PDL::VectorValued::v_union(): only 1d vectors are supported") if ($a->ndims > 1 || $b->ndims > 1); $nc = PDL->pdl(PDL::long(), $a->dim(0) + $b->dim(0)) if (!defined($nc)); if (!defined($c)) { my $ctype = $a->type > $b->type ? $a->type : $b->type; $c = PDL->zeroes($ctype, ref($nc) ? $nc->sclr : $nc); } &PDL::_v_union_int($a,$b,$c,$nc); return ($c,$nc) if (wantarray); return $c->reshape($nc->sclr); } )), Code => (q( PDL_Indx nai=0, nbi=0, nci=0, sizeNA=$SIZE(NA), sizeNB=$SIZE(NB), sizeNC=$SIZE(NC); int cmpval; for ( ; nci < sizeNC; nci++) { if (nai < sizeNA && nbi < sizeNB) { cmpval = $CMPVAL('$a(NA=>nai)', '$b(NB=>nbi)'); } else if (nai < sizeNA) { cmpval = -1; } else if (nbi < sizeNB) { cmpval = 1; } else { break; } // if (cmpval < 0) { //-- CASE: a < b $c(NC=>nci) = $a(NA=>nai); nai++; } else if (cmpval > 0) { //-- CASE: a > b $c(NC=>nci) = $b(NB=>nbi); nbi++; } else { //-- CASE: a == b $c(NC=>nci) = $a(NA=>nai); nai++; nbi++; } } $nc() = nci; )), Doc=><<'EOD' Union of two flat sorted unique-valued PDLs. Input PDLs $a() and $b() B be sorted in lexicographic order and contain no duplicates. On return, $nc() holds the actual number of values in the union. In scalar context, reshapes $c() to the actual number of elements in the union and returns it. EOD ); ##------------------------------------------------------ ## v_intersect() : flat set intersection vvpp_def ('v_intersect', Pars => 'a(NA); b(NB); [o]c(NC); int [o]nc()', PMCode=> (q( sub PDL::v_intersect { my ($a,$b,$c,$nc) = @_; barf("PDL::VectorValued::v_intersect(): only 1d vectors are supported") if ($a->ndims > 1 || $b->ndims > 1); my $NA = $a->dim(0); my $NB = $b->dim(0); $nc = PDL->pdl(PDL::long(), $NA < $NB ? $NA : $NB) if (!defined($nc)); if (!defined($c)) { my $ctype = $a->type > $b->type ? $a->type : $b->type; $c = PDL->zeroes($ctype, ref($nc) ? $nc->sclr : $nc); } &PDL::_v_intersect_int($a,$b,$c,$nc); return ($c,$nc) if (wantarray); return $c->reshape($nc->sclr); } )), Code => (q( PDL_Indx nai=0, nbi=0, nci=0, sizeNA=$SIZE(NA), sizeNB=$SIZE(NB), sizeNC=$SIZE(NC); int cmpval; for ( ; nci < sizeNC && nai < sizeNA && nbi < sizeNB; ) { cmpval = $CMPVAL('$a(NA=>nai)','$b(NB=>nbi)'); // if (cmpval < 0) { //-- CASE: a < b nai++; } else if (cmpval > 0) { //-- CASE: a > b nbi++; } else { //-- CASE: a == b $c(NC=>nci) = $a(NA=>nai); nai++; nbi++; nci++; } } $nc() = nci; )), Doc=><<'EOD' Intersection of two flat sorted unique-valued PDLs. Input PDLs $a() and $b() B be sorted in lexicographic order and contain no duplicates. On return, $nc() holds the actual number of values in the intersection. In scalar context, reshapes $c() to the actual number of elements in the intersection and returns it. EOD ); ##------------------------------------------------------ ## v_setdiff() : flat set difference vvpp_def ('v_setdiff', Pars => 'a(NA); b(NB); [o]c(NC); int [o]nc()', PMCode=> (q( sub PDL::v_setdiff { my ($a,$b,$c,$nc) = @_; barf("PDL::VectorValued::v_setdiff(): only 1d vectors are supported") if ($a->ndims > 1 || $b->ndims > 1); my $NA = $a->dim(0); my $NB = $b->dim(0); $nc = PDL->pdl(PDL::long(), $NA) if (!defined($nc)); if (!defined($c)) { my $ctype = $a->type > $b->type ? $a->type : $b->type; $c = PDL->zeroes($ctype, $NA); } &PDL::_v_setdiff_int($a,$b,$c,$nc); return ($c,$nc) if (wantarray); return $c->reshape($nc->sclr); } )), Code => (q( PDL_Indx nai=0, nbi=0, nci=0, sizeNA=$SIZE(NA), sizeNB=$SIZE(NB), sizeNC=$SIZE(NC); int cmpval; for ( ; nci < sizeNC && nai < sizeNA && nbi < sizeNB ; ) { cmpval = $CMPVAL('$a(NA=>nai)','$b(NB=>nbi)'); // if (cmpval < 0) { //-- CASE: a < b $c(NC=>nci) = $a(NA=>nai); nai++; nci++; } else if (cmpval > 0) { //-- CASE: a > b nbi++; } else { //-- CASE: a == b nai++; nbi++; } } for ( ; nci < sizeNC && nai < sizeNA ; nai++,nci++ ) { $c(NC=>nci) = $a(NA=>nai); } $nc() = nci; )), Doc=><<'EOD' Set-difference ($a() \ $b()) of two flat sorted unique-valued PDLs. Input PDLs $a() and $b() B be sorted in lexicographic order and contain no duplicate values. On return, $nc() holds the actual number of values in the computed vector set. In scalar context, reshapes $c() to the actual number of elements in the difference set and returns it. EOD ); ##====================================================================== ## Miscellaneous Vector-Valued Operations ##====================================================================== pp_addpm(<<'EOPM'); =pod =head1 Miscellaneous Vector-Valued Operations =cut EOPM ##-------------------------------------------------------------- ## vv_vcos() my $vv_vcos_code = ' $GENERIC(vcos) anorm, bnorm, aval, vval; threadloop %{ /*-- initialize: bnorm --*/ bnorm = 0; loop(M) %{ #ifdef PDL_BAD_CODE if ($ISGOOD(b())) #endif bnorm += $b() * $b(); %} bnorm = sqrt(bnorm); if (bnorm == 0) { /*-- null-vector b(): set all vcos()=NAN --*/ loop (N) %{ $vcos() = NAN; %} } else { /*-- usual case: compute values for N-slice of b() --*/ loop (N) %{ anorm = 0; vval = 0; loop (M) %{ #ifdef PDL_BAD_CODE if ($ISGOOD(a())) { aval = $a(); anorm += aval * aval; if ($ISGOOD(b())) vval += aval * $b(); } #else aval = $a(); anorm += aval * aval; vval += aval * $b(); #endif %} /*-- normalize --*/ anorm = sqrt(anorm); if (anorm != 0) { /*-- usual case a(), b() non-null --*/ $vcos() = vval / (anorm * bnorm); } else { /*-- null-vector a(): set vcos()=NAN --*/ $vcos() = NAN; } %} } %} '; pp_def('vv_vcos', Pars => join('', "a(M,N);", ##-- logical (D,T) "b(M);", ##-- logical (D,1) "float+ [o]vcos(N);", ##-- logical (T) ), HandleBad => 1, Code => $vv_vcos_code, BadCode => $vv_vcos_code, CopyBadStatusCode => q{ if ( $ISPDLSTATEBAD(a) || $ISPDLSTATEBAD(b) ) { $SETPDLSTATEBAD(vcos); } }, Doc => q{ Computes the vector cosine similarity of a dense vector $b() with respect to each row $a(*,i) of a dense PDL $a(). This is basically the same thing as: ($a * $b)->sumover / ($a->pow(2)->sumover->sqrt * $b->pow(2)->sumover->sqrt) ... but should be must faster to compute, and avoids allocating potentially large temporaries for the vector magnitudes. Output values in $vcos() are cosine similarities in the range [-1,1], except for zero-magnitude vectors which will result in NaN values in $vcos(). You can use PDL threading to batch-compute distances for multiple $b() vectors simultaneously: $bx = random($M, $NB); ##-- get $NB random vectors of size $N $vcos = vv_vcos($a,$bx); ##-- $vcos(i,j) ~ sim($a(,i),$b(,j)) }, BadDoc=> q{ vv_vcos() will set the bad status flag on the output piddle $vcos() if it is set on either of the input piddles $a() or $b(), but BAD values will otherwise be ignored for computing the cosine similarity. }, ); ##====================================================================== ## Footer Administrivia ##====================================================================== ##------------------------------------------------------ ## pm additions: footer pp_addpm(<<'EOPM'); ##--------------------------------------------------------------------- =pod =head1 ACKNOWLEDGEMENTS =over 4 =item * Perl by Larry Wall =item * PDL by Karl Glazebrook, Tuomas J. Lukka, Christian Soeller, and others. =item * Code for rlevec() and rldvec() derived from the PDL builtin functions rle() and rld() in $PDL_SRC_ROOT/Basic/Slices/slices.pd =back =cut ##---------------------------------------------------------------------- =pod =head1 KNOWN BUGS Probably many. =cut ##--------------------------------------------------------------------- =pod =head1 AUTHOR Bryan Jurish Emoocow@cpan.orgE =head1 COPYRIGHT =over 4 =item * Code for qsortvec() copyright (C) Tuomas J. Lukka 1997. Contributions by Christian Soeller (c.soeller@auckland.ac.nz) and 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. =item * All other parts copyright (c) 2007-2021, Bryan Jurish. All rights reserved. This package is free software, and entirely without warranty. You may redistribute it and/or modify it under the same terms as Perl itself. =back =head1 SEE ALSO perl(1), PDL(3perl) =cut EOPM # Always make sure that you finish your PP declarations with # pp_done pp_done(); ##---------------------------------------------------------------------- PDL-VectorValued-1.0.15/Utils/Makefile.PL0000644000175000017500000000101214204432223017410 0ustar moocowbovinesuse PDL::Core::Dev; use ExtUtils::MakeMaker; require "../pdlmaker.plm"; PDL::Core::Dev->import(); $package = ['utils.pd','Utils','PDL::VectorValued::Utils']; %hash = pdlmaker_init($package); $hash{AUTHOR} = 'Bryan Jurish'; $hash{VERSION_FROM} = '../VectorValued.pm', $hash{PREREQ_PM}{PDL} = $hash{CONFIGURE_REQUIRES}{PDL} = 0; #push(@{$hash{LIBS}}, '-lm'); ##-- ? #$hash{INC} .= ''; #$hash{OBJECT} .= ''; $hash{DIR} = []; $hash{realclean}{FILES} .= '*~ *.tmp'; $hash{NO_MYMETA} = 1; WriteMakefile(%hash); PDL-VectorValued-1.0.15/t/0000755000175000017500000000000014204433466014621 5ustar moocowbovinesPDL-VectorValued-1.0.15/t/04_types.t0000644000175000017500000000152214054377310016453 0ustar moocowbovines# -*- Mode: CPerl -*- # t/04_types.t: test PDL::VectorValued type-wrappers use Test::More tests=>2; ##-- common subs my $TEST_DIR; BEGIN { use File::Basename; use Cwd; $TEST_DIR = Cwd::abs_path dirname( __FILE__ ); eval qq{use lib ("$TEST_DIR/$_/blib/lib","$TEST_DIR/$_/blib/arch");} foreach (qw(..)); do "$TEST_DIR/common.plt" or die("$0: failed to load $TEST_DIR/common.plt: $@"); } ##-- common modules use PDL; use PDL::VectorValued; #use PDL::VectorValued::Dev; ##-------------------------------------------------------------- ## data ## 1..2: types isok("isa(vv_indx,PDL::Type)", UNIVERSAL::isa(vv_indx,'PDL::Type')); if (defined(&PDL::indx)) { isok("vv_indx == PDL::indx (PDL >= v2.007)", vv_indx(), PDL::indx); } else { isok("vv_indx == PDL::long (PDL < v2.007)", vv_indx(), PDL::long); } print "\n"; # end of t/04_types.t PDL-VectorValued-1.0.15/t/00_basic.t0000644000175000017500000000013214054377310016360 0ustar moocowbovines##-*- Mode: CPerl -*- use Test::More tests=>2; use_ok 'PDL'; use_ok 'PDL::VectorValued'; PDL-VectorValued-1.0.15/t/01_rlevec.t0000644000175000017500000000607014204433002016553 0ustar moocowbovines# -*- Mode: CPerl -*- # t/01_rlevec.t: test rlevec/rldvec use Test::More tests => 17; ##-- common subs my $TEST_DIR; BEGIN { use File::Basename; use Cwd; $TEST_DIR = Cwd::abs_path dirname( __FILE__ ); eval qq{use lib ("$TEST_DIR/$_/blib/lib","$TEST_DIR/$_/blib/arch");} foreach (qw(..)); do "$TEST_DIR/common.plt" or die("$0: failed to load $TEST_DIR/common.plt: $@"); } ##-- common modules use PDL; use PDL::VectorValued; ##-- common vars my ($tmp); ##-------------------------------------------------------------- ## rlevec(), rldvec(): 2d ONLY ## 1..2: test rlevec() my $p = pdl([[1,2],[1,2],[1,2],[3,4],[3,4],[5,6]]); my ($pf,$pv) = rlevec($p); my $pf_expect = pdl(long,[3,2,1,0,0,0]); my $pv_expect = pdl([[1,2],[3,4],[5,6],[0,0],[0,0],[0,0]]); pdlok("rlevec():counts", $pf, $pf_expect); pdlok("rlevec():elts", $pv, $pv_expect); ## 3..3: test rldvec() my $pd = rldvec($pf,$pv); pdlok("rldvec()", $pd, $p); ## 4..4: test enumvec my $pk = enumvec($p); pdlok("enumvec()", $pk, pdl(long,[0,1,2,0,1,0])); ## 5..5: test enumvecg $pk = enumvecg($p); pdlok("enumvecg()", $pk, pdl(long,[0,0,0,1,1,2])); ##-------------------------------------------------------------- ## rleND, rldND: 2d ## 6..7: test rleND(): 2d ($pf,$pv) = rleND($p); pdlok("rleND():2d:counts", $pf, $pf_expect); pdlok("rleND():2d:elts", $pv, $pv_expect); ## 8..8: test rldND(): 2d $pd = rldND($pf,$pv); pdlok("rldND():2d", $pd, $p); ##-------------------------------------------------------------- ## rleND, rldND: Nd my $pnd1 = (1 *(sequence(long, 2,3 )+1))->slice(",,*3"); my $pnd2 = (10 *(sequence(long, 2,3 )+1))->slice(",,*2"); my $pnd3 = (100*(sequence(long, 2,3,2)+1)); my $p_nd = $pnd1->mv(-1,0)->append($pnd2->mv(-1,0))->append($pnd3->mv(-1,0))->mv(0,-1); my $pf_expect_nd = pdl(long,[3,2,1,1,0,0,0]); my $pv_expect_nd = zeroes($p_nd->type, $p_nd->dims); ($tmp=$pv_expect_nd->slice(",,0:3")) .= $p_nd->dice_axis(-1,[0,3,5,6]); ## 9..10: test rleND(): Nd my ($pf_nd,$pv_nd) = rleND($p_nd); pdlok("rleND():Nd:counts", $pf_nd, $pf_expect_nd); pdlok("rleND():Nd:elts", $pv_nd, $pv_expect_nd); ## 11..11: test rldND(): Nd my $pd_nd = rldND($pf_nd,$pv_nd); pdlok("rldND():Nd", $pd_nd, $p_nd); ##-------------------------------------------------------------- ## 12..12: test enumvec(): nd my $v_nd = $p_nd->clump(2); my $k_nd = $v_nd->enumvec(); pdlok("enumvec():Nd", $k_nd, pdl(long,[0,1,2,0,1,0,0])); ##-------------------------------------------------------------- ## 13..17: test rldseq(), rleseq() my $lens = pdl(long,[qw(3 0 1 4 2)]); my $offs = (($lens->xvals+1)*100)->short; my $seqs = zeroes(short, 0); $seqs = $seqs->append(sequence(short,$_)) foreach ($lens->list); $seqs += $lens->rld($offs); my $seqs_got = $lens->rldseq($offs); isok("rldseq():type", $seqs_got->type, $seqs->type); pdlok("rldseq():data", $seqs_got, $seqs); my ($len_got,$off_got) = $seqs->rleseq(); isok("rleseq():type", $off_got->type, $seqs->type); pdlok("rleseq():lens", $len_got->where($len_got), $lens->where($lens)); pdlok("rleseq():offs", $off_got->where($len_got), $offs->where($lens)); print "\n"; # end of t/01_rlevec.t PDL-VectorValued-1.0.15/t/02_cmpvec.t0000644000175000017500000000305514054377310016565 0ustar moocowbovines# -*- Mode: CPerl -*- # t/02_cmpvec.t: test cmpvec, vv_qsortvec, vsearchvec use Test::More tests=>8; ##-- common subs my $TEST_DIR; BEGIN { use File::Basename; use Cwd; $TEST_DIR = Cwd::abs_path dirname( __FILE__ ); eval qq{use lib ("$TEST_DIR/$_/blib/lib","$TEST_DIR/$_/blib/arch");} foreach (qw(..)); do "$TEST_DIR/common.plt" or die("$0: failed to load $TEST_DIR/common.plt: $@"); } ##-- common modules use PDL; use PDL::VectorValued; ##-------------------------------------------------------------- ## cmpvec ## 1..3: test cmpvec my $vdim = 4; my $v1 = zeroes($vdim); my $v2 = pdl($v1); $v2->set(-1,1); isok("cmpvec:1d:<", $v1->cmpvec($v2)<0); isok("cmpvec:1d:>", $v2->cmpvec($v1)>0); isok("cmpvec:1d:==", $v1->cmpvec($v1)->sclr, 0); ##-------------------------------------------------------------- ## vv_qsortvec, vv_qsortveci ##-- 4..5: qsortvec, qsortveci my $p2d = pdl([[1,2],[3,4],[1,3],[1,2],[3,3]]); pdlok("vv_qsortvec", $p2d->vv_qsortvec, pdl(long,[[1,2],[1,2],[1,3],[3,3],[3,4]])); pdlok("vv_qsortveci", $p2d->dice_axis(1,$p2d->vv_qsortveci), $p2d->vv_qsortvec); ##-------------------------------------------------------------- ## vsearchvec ##-- 6..8: vsearchvec my $which = pdl(long,[[0,0],[0,0],[0,1],[0,1],[1,0],[1,0],[1,1],[1,1]]); my $find = $which->slice(",0:-1:2"); pdlok("vsearchvec():match", $find->vsearchvec($which), pdl(long,[0,2,4,6])); isok("vsearchvev():<<", all(pdl([-1,-1])->vsearchvec($which)==0)); isok("vsearchvev():>>", all(pdl([2,2])->vsearchvec($which)==$which->dim(1)-1)); print "\n"; # end of t/02_cmpvec.t PDL-VectorValued-1.0.15/t/common.plt0000644000175000017500000000646314204432223016631 0ustar moocowbovines# -*- Mode: CPerl -*- # File: t/common.plt # Description: re-usable test subs; requires Test::More BEGIN { $| = 1; } # isok($label,@_) -- prints helpful label sub isok { local $Test::Builder::Level = $Test::Builder::Level + 1; my $label = shift; if (@_==1) { ok($_[0],$label); } elsif (@_==2) { is($_[0],$_[1], $label); } else { die("isok(): expected 1 or 2 non-label arguments, but got ", scalar(@_)); } } # skipok($label,$skip_if_true,@_) -- prints helpful label # skipok($label,$skip_if_true,\&CODE) -- prints helpful label sub skipok { local $Test::Builder::Level = $Test::Builder::Level + 1; my ($label,$skip_if_true) = splice(@_,0,2); if ($skip_if_true) { subtest $label => sub { plan skip_all => $skip_if_true; }; } else { if (@_==1 && ref($_[0]) && ref($_[0]) eq 'CODE') { isok($label, $_[0]->()); } else { isok($label,@_); } } } # skipordo($label,$skip_if_true,sub { ok ... },@args_for_sub) sub skipordo { local $Test::Builder::Level = $Test::Builder::Level + 1; my ($label,$skip_if_true) = splice(@_,0,2); if ($skip_if_true) { subtest $label => sub { plan skip_all => $skip_if_true; }; } else { $_[0]->(@_[1..$#_]); } } # ulistok($label,\@got,\@expect) # --> ok() for unsorted lists sub ulistok { local $Test::Builder::Level = $Test::Builder::Level + 1; my ($label,$l1,$l2) = @_; is_deeply([sort @$l1],[sort @$l2],$label); } # matchpdl($a,$b) : returns pdl identity check, including BAD sub matchpdl { my ($a,$b) = map {PDL->topdl($_)->setnantobad} @_[0,1]; return ($a==$b)->setbadtoval(0) | ($a->isbad & $b->isbad) | ($a->isfinite->not & $b->isfinite->not); } # matchpdl($a,$b,$eps) : returns pdl approximation check, including BAD sub matchpdla { my ($a,$b) = map {$_->setnantobad} @_[0,1]; my $eps = $_[2]; $eps = 1e-5 if (!defined($eps)); return $a->approx($b,$eps)->setbadtoval(0) | ($a->isbad & $b->isbad) | ($a->isfinite->not & $b->isfinite->not); } # cmp_dims($got_pdl,$expect_pdl) sub cmp_dims { my ($p1,$p2) = @_; return $p1->ndims==$p2->ndims && all(pdl(PDL::long(),[$p1->dims])==pdl(PDL::long(),[$p2->dims])); } # pdlok($label, $got, $want) sub pdlok { local $Test::Builder::Level = $Test::Builder::Level + 1; my ($label,$got,$want) = @_; $got = PDL->topdl($got) if (defined($got)); $want = PDL->topdl($want) if (defined($want)); isok($label, defined($got) && defined($want) && cmp_dims($got,$want) && all(matchpdl($want,$got))) or diag "got=$got\nwant=$want"; } # pdlok_nodims($label, $got, $want) # + ignores dimensions sub pdlok_nodims { local $Test::Builder::Level = $Test::Builder::Level + 1; my ($label,$got,$want) = @_; $got = PDL->topdl($got) if (defined($got)); $want = PDL->topdl($want) if (defined($want)); isok($label, defined($got) && defined($want) #&& cmp_dims($got,$want) && all(matchpdl($want,$got))); } # pdlapprox($label, $got, $want, $eps=1e-5) sub pdlapprox { local $Test::Builder::Level = $Test::Builder::Level + 1; my ($label,$got,$want,$eps) = @_; $got = PDL->topdl($got) if (defined($got)); $want = PDL->topdl($want) if (defined($want)); $eps = 1e-5 if (!defined($eps)); isok($label, defined($got) && defined($want) && cmp_dims($got,$want) && all(matchpdla($want,$got,$eps))); } print "loaded ", __FILE__, "\n"; 1; PDL-VectorValued-1.0.15/t/03_setops.t0000644000175000017500000000372614054377310016633 0ustar moocowbovines# -*- Mode: CPerl -*- # t/03_setops.t: test PDL::VectorValued set operations use Test::More tests=>12; ##-- common subs my $TEST_DIR; BEGIN { use File::Basename; use Cwd; $TEST_DIR = Cwd::abs_path dirname( __FILE__ ); eval qq{use lib ("$TEST_DIR/$_/blib/lib","$TEST_DIR/$_/blib/arch");} foreach (qw(..)); do "$TEST_DIR/common.plt" or die("$0: failed to load $TEST_DIR/common.plt: $@"); } ##-- common modules use PDL; use PDL::VectorValued; ##-------------------------------------------------------------- ## vv: data my $vtype = long; my $universe = pdl($vtype,[ [0,0],[0,1],[1,0],[1,1] ]); my $v1 = $universe->dice_axis(1,pdl([0,1,2])); my $v2 = $universe->dice_axis(1,pdl([1,2,3])); ## 1..3: vv_union my ($c,$nc) = $v1->vv_union($v2); pdlok("vv_union:list:c", $c, pdl($vtype, [ [0,0],[0,1],[1,0],[1,1],[0,0],[0,0] ])); isok("vv_union:list:nc", $nc, $universe->dim(1)); my $cc = $v1->vv_union($v2); pdlok("vv_union:scalar", $cc, $universe); ## 4..6: vv_intersect ($c,$nc) = $v1->vv_intersect($v2); pdlok("vv_intersect:list:c", $c, pdl($vtype, [ [0,1],[1,0],[0,0] ])); isok("vv_intersect:list:nc", $nc->sclr, 2); $cc = $v1->vv_intersect($v2); pdlok("vv_intersect:scalar", $cc, $universe->slice(",1:2")); ## 7..9: vv_setdiff ($c,$nc) = $v1->vv_setdiff($v2); pdlok("vv_setdiff:list:c", $c, pdl($vtype, [ [0,0], [0,0],[0,0] ])); isok("vv_setdiff:list:nc", $nc, 1); $cc = $v1->vv_setdiff($v2); pdlok("vv_setdiff:scalar", $cc, pdl($vtype, [[0,0]])); ##-------------------------------------------------------------- ## v: data my $all = sequence(20); my $amask = ($all % 2)==0; my $bmask = ($all % 3)==0; my $a = $all->where($amask); my $b = $all->where($bmask); ## 10: v_union pdlok("v_union", scalar($a->v_union($b)), $all->where($amask | $bmask)); ## 11: v_intersect pdlok("v_intersect", scalar($a->v_intersect($b)), $all->where($amask & $bmask)); ## 12: v_setdiff pdlok("v_setdiff", scalar($a->v_setdiff($b)), $all->where($amask & $bmask->not)); print "\n"; # end of t/03_setops.t PDL-VectorValued-1.0.15/t/05_vcos.t0000644000175000017500000000401614054377310016263 0ustar moocowbovines# -*- Mode: CPerl -*- # t/05_vcos.t: test PDL::VectorValued vector-cosine use Test::More tests=>6; ##-- common subs my $TEST_DIR; BEGIN { use File::Basename; use Cwd; $TEST_DIR = Cwd::abs_path dirname( __FILE__ ); eval qq{use lib ("$TEST_DIR/$_/blib/lib","$TEST_DIR/$_/blib/arch");} foreach (qw(..)); do "$TEST_DIR/common.plt" or die("$0: failed to load $TEST_DIR/common.plt: $@"); } ##-- common modules use PDL; use PDL::VectorValued; #use PDL::VectorValued::Dev; ##-- common vars use version; my $HAVE_PDL_2_014 = version->parse($PDL::VERSION) >= version->parse("2.014"); ##-------------------------------------------------------------- ## tests my $a = pdl([[1,2,3,4],[1,2,2,1],[-1,-2,-3,-4]]); my $b = pdl([1,2,3,4]); my $c_want = pdl([1,0.8660254,-1]); ##-- 1..2: vcos: basic pdlapprox("vv_vcos:flat", $a->vv_vcos($b), $c_want, 1e-4); pdlapprox("vv_vcos:threaded", $a->vv_vcos($b->slice(",*3")), $c_want->slice(",*3"), 1e-4); ##-- 3: vcos: nullvec: a my $a0 = $a->pdl; my $nan = $^O =~ /MSWin32/i ? ((99**99)**99) - ((99**99)**99) : 'nan'; (my $tmp=$a0->slice(",1")) .= 0; pdlapprox("vv_vcos:nullvec:a:nan", $a0->vv_vcos($b), pdl([1,$nan,-1]), 1e-4); ##-- 4: vcos: nullvec: b my $b0 = $b->zeroes; isok("vv_vcos:nullvec:b:all-nan", all($a->vv_vcos($b0)->isfinite->not)); ##-- 5-6: bad values my @chkbad = ( ##-- 5: a~bad ["vv_vcos:bad:a" => sub { my $abad = $a->pdl->setbadif($a->abs==2); my $abad_cwant = pdl([0.93094,0.64549,-0.93094]); pdlapprox("vv_vcos:bad:a", $abad->vv_vcos($b), $abad_cwant, 1e-4); }], ##-- 6: b~bad ["vv_vcos:bad:b" => sub { my $bbad = $b->pdl->setbadif($b->xvals==2); my $bbad_cwant = pdl([0.8366,0.6211,-0.8366]); pdlapprox("vv_vcos:bad:b", $a->vv_vcos($bbad), $bbad_cwant, 1e-4); }], ); my $skipbad = (!$PDL::Bad::Status ? "no bad-value support in PDL" : (!$HAVE_PDL_2_014 ? "PDL >= v2.014 only" : 0)); foreach my $badtest (@chkbad) { skipordo($badtest->[0], $skipbad, $badtest->[1]); } print "\n"; # end of t/05_vcos.t PDL-VectorValued-1.0.15/VectorValued.pm0000644000175000017500000001502414204433206017311 0ustar moocowbovines## $Id$ ## ## File: PDL::VectorValued.pm ## Author: Bryan Jurish ## Description: Vector utilities for PDL: perl side only ##====================================================================== package PDL::VectorValued; use strict; ##====================================================================== ## Export hacks use PDL; use PDL::Exporter; use PDL::VectorValued::Utils; our @ISA = qw(PDL::Exporter); our @EXPORT_OK = ( (@PDL::VectorValued::Utils::EXPORT_OK), ##-- inherited qw(vv_uniqvec), qw(rleND rldND), qw(vv_indx), ); our %EXPORT_TAGS = ( Func => [@EXPORT_OK], ##-- respect PDL conventions (hopefully) ); ## VERSION was formerly set by PDL::VectorValued::Version, now use perl-reversion from Perl::Version instead our $VERSION = '1.0.15'; ##====================================================================== ## pod: header =pod =head1 NAME PDL::VectorValued - Utilities for vector-valued PDLs =head1 SYNOPSIS use PDL; use PDL::VectorValued; ##--------------------------------------------------------------------- ## ... stuff happens =cut ##====================================================================== ## Description =pod =head1 DESCRIPTION PDL::VectorValued provides generalizations of some elementary PDL functions to higher-order PDLs which treat vectors as "data values". =cut ##====================================================================== ## pod: Functions =pod =head1 FUNCTIONS =cut ##---------------------------------------------------------------------- ## vv_uniqvec =pod =head2 vv_uniqvec =for sig Signature: (v(N,M); [o]vu(N,MU)) =for ref Drop-in replacement for broken uniqvec() which uses vv_qsortvec(). Otherwise copied from PDL::Primitive::primitive.pd. See also: PDL::VectorValued::Utils::vv_qsortvec, PDL::Primitive::uniqvec. =cut *PDL::vv_uniqvec = \&vv_uniqvec; sub vv_uniqvec { my($pdl) = shift; # slice is not cheap but uniqvec isn't either -- shouldn't cost too much. return $pdl if($pdl->nelem == 0 || $pdl->ndims <2 || $pdl->slice("(0)")->nelem < 2); my $srt = $pdl->mv(0,-1)-> clump($pdl->ndims - 1)-> mv(-1,0)->vv_qsortvec-> ##-- moo: Tue, 24 Apr 2007 17:17:39 +0200: use vv_qsortvec mv(0,-1); $srt=$srt->dice($srt->mv(0,-1)->ngoodover->which) if ($PDL::Bad::Status && $srt->badflag); ##use dice instead of nslice since qsortvec might be packing the badvals to the front of #the array instead of the end like the docs say. If that is the case and it gets fixed, #it won't bust uniqvec. DAL 14-March 2006 my $uniq = ($srt != $srt->rotate(-1)) -> mv(0,-1) -> orover->which; return $uniq->nelem==0 ? $srt->slice("0,:")->mv(0,-1) : $srt->dice($uniq)->mv(0,-1); } ##====================================================================== ## Run-Length Encoding/Decoding: n-dimensionl =pod =head1 Higher-Order Run-Length Encoding and Decoding The following functions generalize the builtin PDL functions rle() and rld() for higher-order "values". See also: PDL::VectorValued::Utils::rlevec(), PDL::VectorValued::Utils::rldvec(). =cut ##---------------------------------------------------------------------- ## rleND() =pod =head2 rleND =for sig Signature: (data(@vdims,N); int [o]counts(N); [o]elts(@vdims,N)) =for ref Run-length encode a set of (sorted) n-dimensional values. Generalization of rle() and rlevec(): given set of values $data, generate a vector $counts with the number of occurrences of each element (where an "element" is a matrix of dimensions @vdims ocurring as a sequential run over the final dimension in $data), and a set of vectors $elts containing the elements which begin a run. Really just a wrapper for clump() and rlevec(). See also: PDL::Slices::rle, PDL::Ngrams::VectorValued::Utils::rlevec. =cut *PDL::rleND = \&rleND; sub rleND { my $data = shift; my @vdimsN = $data->dims; ##-- construct output pdls my $counts = $#_ >= 0 ? $_[0] : zeroes(long, $vdimsN[$#vdimsN]); my $elts = $#_ >= 1 ? $_[1] : zeroes($data->type, @vdimsN); ##-- guts: call rlevec() rlevec($data->clump($#vdimsN), $counts, $elts->clump($#vdimsN)); return ($counts,$elts); } ##---------------------------------------------------------------------- ## rldND() =pod =head2 rldND =for sig Signature: (int counts(N); elts(@vdims,N); [o]data(@vdims,N);) =for ref Run-length decode a set of (sorted) n-dimensional values. Generalization of rld() and rldvec(): given a vector $counts() of the number of occurrences of each @vdims-dimensioned element, and a set $elts() of @vdims-dimensioned elements, run-length decode to $data(). Really just a wrapper for clump() and rldvec(). See also: PDL::Slices::rld, PDL::VectorValued::Utils::rldvec =cut *PDL::rldND = \&rldND; sub rldND { my ($counts,$elts) = (shift,shift); my @vdimsN = $elts->dims; ##-- construct output pdl my ($data); if ($#_ >= 0) { $data = $_[0]; } else { my $size = $counts->sumover->max; ##-- get maximum size for Nth-dimension for small encodings my @countdims = $counts->dims; shift(@countdims); $data = zeroes($elts->type, @vdimsN, @countdims); } ##-- guts: call rldvec() rldvec($counts, $elts->clump($#vdimsN), $data->clump($#vdimsN)); return $data; } ##====================================================================== ## pod: Functions: datatype utilities =pod =head1 Datatype Utilities =cut ##---------------------------------------------------------------------- ## vv_indx() =pod =head2 vv_indx =for sig Signature: vv_indx() =for ref Returns PDL::Type subclass used for indices. If built with PDL E v2.007, this should return C, otherwise C. =cut sub vv_indx { return defined(&PDL::indx) ? PDL::indx(@_) : PDL::long(@_); } 1; ##-- make perl happy ##====================================================================== ## pod: Functions: low-level =pod =head2 Low-Level Functions Some additional low-level functions are provided in the PDL::VectorValued::Utils package. See L for details. =cut ##====================================================================== ## pod: Footer =pod =head1 ACKNOWLEDGEMENTS perl by Larry Wall. =head1 AUTHOR Bryan Jurish Emoocow@cpan.orgE PDL by Karl Glazebrook, Tuomas J. Lukka, Christian Soeller, and others. =head1 COPYRIGHT Copyright (c) 2007-2021, Bryan Jurish. All rights reserved. This package is free software. You may redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO perl(1), PDL(3perl), PDL::VectorValued::Utils(3perl) =cut PDL-VectorValued-1.0.15/ChangeLog0000644000175000017500000001122314204433341016117 0ustar moocowbovines##-*- Mode: Change-Log; coding: utf-8; -*- ## ## Change log for perl distribution PDL::VectorValued v1.0.15 Sun, 20 Feb 2022 13:40:45 +0100 moocow * fix for PDL v2.075 - PDL::null() is no longer a valid input PDL, even for conversions v1.0.14 Fri, 12 Nov 2021 20:05:32 +0100 moocow * explicitly use PDL::Types from VectorValued/Dev; fixes https://github.com/moocow-the-bovine/PDL-VectorValued/issues/1 v1.0.13 Mon, 20 Sep 2021 17:30:18 +0200 moocow * cleaned up stale acknowledgements in docs v1.0.12 Sun, 19 Sep 2021 21:24:50 +0200 moocow * removed stale vv_qsortvec and vv_qsortveci cruft - original motivation (bug in PDL-2.4.3) is long since fixed - vv_* methods are now just deprecated glob-aliases for the corresponding builtin PDL core functions v1.0.11 Thu, 16 Sep 2021 20:42:46 +0200 moocow * replaced crufty $COMP(__X_size) with $SIZE(X) in Utils/utils.pd - at suggestion of Ed J, for upcoming PDL release * added github repo to CPAN metadata v1.0.10 Wed, 07 Apr 2021 09:52:45 +0200 moocow * applied Zaki Mughal's patch for PDL native complex types in PDL > 2.028 - https://github.com/zmughal/PDL-VectorValued/compare/skip-complex-types - fixes RT bug #134962 v1.0.9 Fri, 18 May 2018 09:44:25 +0200 moocow * added README.rpod to MANIFEST * only include README.txt in "realclean" targets if README.rpod is present v1.0.8 Tue, 15 May 2018 08:55:00 +0200 moocow * fixed some typos in POD documentation (RT ticket #125314) v1.0.7 Tue, 06 Jun 2017 10:21:58 +0200 moocow * added 'use lib "."' to Makefile.PL (RT bug #121661) v1.0.6 Mon, 06 Jun 2016 11:29:23 +0200 moocow * win32/NaN fixes for tests (RT bug #115076) v1.0.5 Thu, 17 Dec 2015 10:02:25 +0100 moocow * fixed wrongly succeeding bogus tests with unary ok() - tests now use Test::More and re-factored common test subroutines * pdlmaker.plm doesn't distribute generated PM files any more (PDL now does this for us) * added vector-cosine similarity vv_vcos() v1.0.4 Mon, 23 Nov 2015 12:10:32 +0100 moocow * shared $VERSION now via perl-reversion script from Perl::Version (debian libperl-version-perl) as suggested by Corion in thread http://www.perlmonks.org/?node_id=1148116 * may or may not help with weird errors building PDL::Ngrams with stale PDL::VectorValued, - new version of PDL::VectorValued will probably mask that bug anyways v1.0.3 Tue, 04 Aug 2015 12:19:25 +0200 moocow * enumvec() regression fix v1.0.2 Wed, 29 Jul 2015 10:05:34 +0200 moocow * enumvecg() fix v1.0.1 Tue, 28 Jul 2015 16:51:18 +0200 moocow * added enumvecg(): global vector id-enumerator v1.0.0 Mon, 27 Jul 2015 10:06:35 +0200 moocow * explicit 3-component versioning for more transparent version.pm compatiblity * added rleseq(), rldseq() for run-length encoding subsequence vectors v0.09002 Thu, 09 Apr 2015 10:31:50 +0200 moocow * tweaked bootstrap logic snafu with PDL::VectorValued::Dev including PDL::VectorValued::Version even though ::Dev is needed at module build time when ::Version is not yet present - this seemed to be causing a lot of UNKNOWN results on cpantesters v0.09001 Wed, 08 Apr 2015 10:58:04 +0200 moocow * added $CMPVAL() and $LB() macros * added v_{union,intersect,setdiff} set operations for flat, sorted, unique-valued PDLs - new implementation is much faster than builtin PDL::Primitive::intersect() [via PDL::Primitive::setops()] - for large-ish intersection (NA=2973, NB=221013) v_intersect($a,qsort($b)) is 2x faster than setops($a,'AND',$b), and v_intersect($a,$b) with all data pre-sorted $b is 42x faster than setops($a,'AND',$b) v0.08001 2014-11-05 moocow * fix annoying PAUSE messages about incompatible version numbers * improved handling of empty pdls v0.07002 Wed, 25 Sep 2013 10:16:54 +0200 moocow * PREREQ_PM{PDL}=CONFIGURE_REQUIRES{PDL}=0, for CPAN-testers friendliness * added support for PDL v2.007 PDL_Indx type (64-bit indices) * changed version convention X.BBCCC to jive with both pp_setversion() and version->parse() v0.06 2012-11-06 moocow * added enumvec(): enumerate repetitions in a sorted vector list v0.05 2012-01-02 moocow * pdlmaker.plm version: for CPAN-friendly docs v0.0401 2011-12-20 moocow * added 'generic' pdlmaker.plm : cpan-friendly pdl module hacks * still not playing too nicely with embedded pd->pm conversions (e.g. Utils/utils.pd -> Utils/utils.pm) v0.04 Wed, 30 Mar 2011 15:12:32 +0200 (moocow) + renamed qsortveci() to vv_qsortveci to avoid conflicts with pdl-2.4.7 (debian squeeze) v0.03 Mon, 16 Apr 2007 09:58:49 +0200 + added @PDL::VectorValued::Dev::MACROS v0.02 Tue, 10 Apr 2007 14:45:00 +0200 (moocow) + added setops: vv_union, vv_intersect, vv_setdiff v0.01 Fri, 06 Apr 2007 11:41:00 +0200 (moocow) + initial version PDL-VectorValued-1.0.15/Makefile.PL0000644000175000017500000000162614121705624016331 0ustar moocowbovinesuse ExtUtils::MakeMaker; #@MY::pdpm = qw(Utils/Utils.pm); require "./pdlmaker.plm"; pdlmaker_init(); WriteMakefile( NAME => 'PDL::VectorValued', VERSION_FROM => 'VectorValued.pm', ABSTRACT => 'Assorted utilities for vector-valued PDLs', AUTHOR => 'Bryan Jurish', LICENSE => 'perl', PREREQ_PM => { PDL => 2.019, 'Test::More' => 0, }, CONFIGURE_REQUIRES => { PDL => 0, }, realclean => { FILES => join(' ', qw(*~ *.tmp),(-e 'README.rpod' ? 'README.txt' : qw())), }, META_MERGE => { "meta-spec" => { version => 2 }, resources => { repository => { url => 'git://github.com/moocow-the-bovine/PDL-VectorValued.git', type => 'git', web => 'https://github.com/moocow-the-bovine/PDL-VectorValued', }, }, }, ); PDL-VectorValued-1.0.15/MANIFEST0000644000175000017500000000075614204433466015517 0ustar moocowbovinesChangeLog MANIFEST MANIFEST.SKIP README.rpod README.txt Makefile.PL pdlmaker.plm VectorValued.pm VectorValued/Dev.pm VectorValued/Version.pm VectorValued/Makefile.PL Utils/Makefile.PL Utils/utils.pd # Utils/Utils.pm Utils/Utils.pm t/common.plt t/00_basic.t t/01_rlevec.t t/02_cmpvec.t t/03_setops.t t/04_types.t t/05_vcos.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) PDL-VectorValued-1.0.15/META.yml0000644000175000017500000000117214204433466015630 0ustar moocowbovines--- abstract: 'Assorted utilities for vector-valued PDLs' author: - 'Bryan Jurish' build_requires: ExtUtils::MakeMaker: '0' configure_requires: PDL: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.34, 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-VectorValued no_index: directory: - t - inc requires: PDL: '2.019' Test::More: '0' resources: repository: git://github.com/moocow-the-bovine/PDL-VectorValued.git version: v1.0.15 x_serialization_backend: 'CPAN::Meta::YAML version 0.018' PDL-VectorValued-1.0.15/README.rpod0000644000175000017500000000242614122124147016175 0ustar moocowbovines=pod README for PDL::VectorValued =head1 ABSTRACT PDL::VectorValued - Assorted PDL utilities treating vectors as values =head1 REQUIREMENTS =over 4 =item * PDL Tested version(s) 2.4.2, 2.4.3, 2.4.7_001, 2.4.9_015, 2.4.10, 2.019, 2.039 =back =head1 DESCRIPTION PDL::VectorValued provides some generalizations of builtin PDL functions to higher order PDLs which treat vectors in the source PDLs as "data values". =head1 BUILDING Build this module as you would any perl module, by doing something akin to the following: gzip -dc distname-XX.YY.tar.gz | tar -xof - cd distname-XX.YY/ perl Makefile.PL make make test # optional make install See L(1) for details. =head1 ACKNOWLEDGEMENTS =over 4 =item * Perl by Larry Wall =item * PDL by Karl Glazebrook, Tuomas J. Lukka, Christian Soeller, and others. =item * Code for rlevec() and rldvec() derived from the PDL builtin functions rle() and rld() in $PDL_SRC_ROOT/Basic/Slices/slices.pd =back =head1 AUTHOR Bryan Jurish Emoocow@cpan.orgE =head1 COPYRIGHT Copyright (c) 2007-2021, Bryan Jurish. All rights reserved. This package is free software, and entirely without warranty. You may redistribute it and/or modify it under the same terms as Perl itself. =cut PDL-VectorValued-1.0.15/pdlmaker.plm0000644000175000017500000001223014204432223016653 0ustar moocowbovines## -*- Mode: CPerl -*- ## ## File: pdlmaker.plm ## Author: Bryan Jurish ## Description: hacks for CPAN-friendly PDL module distribution ## ## Usage: ## + optionally set the variable $MY::README (boolean); default is ## $MY::README = grep {-e $_} (,,) ## + read this file in top-level Makefile.PL: ## require "pdlmaker.plm"; ## + call pdlmaker_init([$pdfile, $pmbase, $module]) as for pdlpp_stdargs() ## - will actually call pdlpp_stdargs() and return that hash if called in list context ## + call WriteMakefile() as usual ## + omit the pdlpp_postamble() call from MY::postamble() ## (you still need to 'use PDL::Core::Dev' though) ## ## Effects: ## + clobbers sub ExtUtils::MakeMaker::WriteMakefile() ## - unlinks all @pdpm files before calling "real" WriteMakefile() ## + clobbers/appends MY::depend (appends) ## x- adds @pdpm dependencies to dist,distcheck,create_distdir ## - also adds README.txt dependencies if README.txt or README.rpod is present ## + clobbers/appends MY::special_targets (appends) ## - adds (pm|pod|rpod) -> (txt|html) rules ## + clobbers/appends MY::postamble (appends) ## - adds pdlpp_postamble($package) if $package is specified package MY; use ExtUtils::MakeMaker qw(); use ExtUtils::Manifest qw(); use Cwd qw(cwd abs_path); use File::Basename qw(dirname basename); use PDL::Core::Dev; require PDL; # for VERSION use strict; ##---------------------------------------------------------------------- sub pdlmaker_init { my $package = shift; my @pdpm = $package ? "$package->[1].pm" : qw(); my $cwd = cwd(); my $label = "pdlmaker_init [DIR=$cwd]"; #print STDERR "$label\n"; ##---------------------------- ## read manifest @pdpm (for user info message) my @manipm = qw(); if (-r 'MANIFEST') { my $mani = ExtUtils::Manifest::maniread(); my ($pd,$pm); foreach $pd (grep {/\.pd$/i} keys %$mani) { if ($mani->{$pd}) { ($pm=$mani->{$pd}) =~ s/^[\#\s]*(?:pm=)?//; if ($pm) { push(@manipm,$pm); next; } } ($pm=$pd)=~s/\.pd$/\.pm/i; push(@manipm,$pm); } print STDERR "Info: ignore any warnings about missing $_\n" foreach (@manipm); } elsif (0 && $package) { print STDERR "Info: ignore any warnings about missing $package->[1].pm\n"; ; } ##---------------------------- ## $MY::README if (!defined($MY::README)) { $MY::README = grep {-e $_} map {glob("README.$_")} qw(txt pod rpod); } ##---------------------------- ## unlink @pdpm files here foreach (@pdpm) { #print STDERR "$label: UNLINK $_\n"; unlink($_) if (-e $_); } ##---------------------------- ## @missed = ExtUtils::Manifest::manicheck() ## + ignore @pdpm files in manicheck my %manipm = (map {($_=>undef)} @manipm,@pdpm); my $_manicheck0 = \&ExtUtils::Manifest::manicheck; my $_manicheck1 = sub { grep {!exists($manipm{$_})} $_manicheck0->(@_); }; *ExtUtils::Manifest::manicheck = $_manicheck1; ##---------------------------- ## depend() ## + add @pdpm, README.txt my $depend0 = MY->can('depend') || sub {''}; my $depend = sub { my $inherited = $depend0->(@_) . shift->SUPER::depend(@_); my $deps = join(' ', ($MY::README ? 'README.txt' : qw()), #sort keys %manipm ); return $inherited if (!$deps); return $inherited .<(txt|html) my $special_targets0 = MY->can('special_targets') || sub {''}; my $special_targets = sub { my $inherited = $special_targets0->(@_) . shift->SUPER::special_targets(@_); $inherited .= <parse($PDL::VERSION) >= version->parse('2.058')); ##---------------------------- ## postamble() ## + add pdlpp postamble if available my $postamble0 = MY->can('postamble') || sub {''}; my $postamble = sub { my $inherited = $postamble0->(@_) . shift->SUPER::postamble(); if (defined($package) && UNIVERSAL::can('PDL::Core::Dev','pdlpp_postamble')) { $inherited .= PDL::Core::Dev::pdlpp_postamble($package); } $inherited; }; *MY::postamble = $postamble; ##--------------------------- ## returning list context? --> call pdlpp_stdargs() return ::pdlpp_stdargs($package,@_) if ($package && wantarray && UNIVERSAL::can('main','pdlpp_stdargs')); } ##---------------------------------------------------------------------- package main; *pdlmaker_init = \&MY::pdlmaker_init; 1; ##-- be happy