r21984 - in /trunk/libmath-combinatorics-perl: Changes META.yml lib/Math/Combinatorics.pm
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Fri Jun 20 17:28:07 UTC 2008
Author: gregoa
Date: Fri Jun 20 17:28:07 2008
New Revision: 21984
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=21984
Log:
trunk (and branches/upstream 0.09) still contained 0.08
Modified:
trunk/libmath-combinatorics-perl/Changes
trunk/libmath-combinatorics-perl/META.yml
trunk/libmath-combinatorics-perl/lib/Math/Combinatorics.pm
Modified: trunk/libmath-combinatorics-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmath-combinatorics-perl/Changes?rev=21984&op=diff
==============================================================================
--- trunk/libmath-combinatorics-perl/Changes (original)
+++ trunk/libmath-combinatorics-perl/Changes Fri Jun 20 17:28:07 2008
@@ -20,3 +20,6 @@
o Corrections to documentation examples
0.07 o Fixed syntax error under 5.8.7
+0.08 o Eh?
+0.09 o Optimized re-implemention of derange() by Carlos Rica
+ <carlos at red-libertaria.net>
Modified: trunk/libmath-combinatorics-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmath-combinatorics-perl/META.yml?rev=21984&op=diff
==============================================================================
--- trunk/libmath-combinatorics-perl/META.yml (original)
+++ trunk/libmath-combinatorics-perl/META.yml Fri Jun 20 17:28:07 2008
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Math-Combinatorics
-version: 0.08
+version: 0.09
version_from: lib/Math/Combinatorics.pm
installdirs: site
requires:
Modified: trunk/libmath-combinatorics-perl/lib/Math/Combinatorics.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmath-combinatorics-perl/lib/Math/Combinatorics.pm?rev=21984&op=diff
==============================================================================
--- trunk/libmath-combinatorics-perl/lib/Math/Combinatorics.pm (original)
+++ trunk/libmath-combinatorics-perl/lib/Math/Combinatorics.pm Fri Jun 20 17:28:07 2008
@@ -183,6 +183,10 @@
http://mathworld.wolfram.com/StirlingNumberoftheSecondKind.html
http://mathworld.wolfram.com/Word.html
+ * Other combinatorics stuff
+ http://en.wikipedia.org/wiki/Catalan_number
+ http://en.wikipedia.org/wiki/Stirling_number
+
=head1 SEE ALSO
L<Set::Scalar>
@@ -206,7 +210,7 @@
our @ISA = qw(Exporter);
our @EXPORT = qw( combine derange factorial permute );
-our $VERSION = '0.08';
+our $VERSION = '0.09';
=head1 EXPORTED FUNCTIONS
@@ -214,10 +218,9 @@
Usage : my @combinations = combine($k, at n);
Function: implements nCk (n choose k), or n!/(k!*(n-k!)).
- returns all unique unorderd combinations of k items from
- set n. items in n are assumed to be character data, and
- are copied into the return data structure (see "Returns"
- below).
+ returns all unique unorderd combinations of k items from set n.
+ items in n are assumed to be character data, and are
+ copied into the return data structure (see "Returns" below).
Example : my @n = qw(a b c);
my @c = combine(2, at n);
print join "\n", map { join " ", @$_ } @c;
@@ -225,15 +228,14 @@
# b c
# a c
# a b
- Returns : a list of arrays, where each array contains a unique
- combination of k items from n
+ Returns : a list of arrays, where each array contains a unique combination
+ of k items from n
Args : a list of items to be combined
- Notes : data is internally assumed to be alphanumeric. this is
- necessary to efficiently generate combinations of large
- sets. if you need combinations of non-alphanumeric data,
- or on data C<sort {$a cmp $b}> would not be appropriate,
- use the object-oriented API. See L</new()> and the
- B<compare> option.
+ Notes : data is internally assumed to be alphanumeric. this is necessary
+ to efficiently generate combinations of large sets. if you need
+ combinations of non-alphanumeric data, or on data
+ C<sort {$a cmp $b}> would not be appropriate, use the
+ object-oriented API. See L</new()> and the B<compare> option.
Identical items are assumed to be non-unique. That is, calling
C<combine(1,'a','a') yields two sets: {a}, and {a}. See
@@ -274,12 +276,11 @@
Note : k should really be parameterizable. this will happen
in a later version of the module. send me a patch to
make that version come out sooner.
- Notes : data is internally assumed to be alphanumeric. this is
- necessary to efficiently generate combinations of large sets.
- if you need combinations of non-alphanumeric data, or on data
+ Notes : data is internally assumed to be alphanumeric. this is necessary
+ to efficiently generate combinations of large sets. if you need
+ combinations of non-alphanumeric data, or on data
C<sort {$a cmp $b}> would not be appropriate, use the
- object-oriented API. See L</new()>, and the B<compare>
- option.
+ object-oriented API. See L</new()>, and the B<compare> option.
=cut
@@ -293,6 +294,111 @@
push @result, [@derange];
}
+ return @result;
+}
+
+=head2 next_derangement()
+
+ Usage : my @derangement = $c->next_derangement();
+ Function: get derangements for @data.
+ Returns : returns a permutation of items from @data (see L</new()>),
+ where none of the items appear in their natural order. repeated calls
+ retrieve all unique derangements of @data elements. a returned empty
+ list signifies all derangements have been iterated.
+ Args : none.
+
+=cut
+
+sub next_derangement {
+ my $self = shift;
+ my $data = $self->data();
+
+ my $cursor = $self->_permutation_cursor();
+ my $values = @$cursor;
+ if($self->{pin}){
+ $self->{pin} = 0;
+
+ my $i;
+ for ($i = 1; $i < $values; $i += 2) {
+ $$cursor[$i - 1] = $i;
+ $$cursor[$i] = $i - 1;
+ }
+ if ($values % 2 != 0) {
+ $$cursor[$values - 1] = $values - 3;
+ $$cursor[$values - 2] = $values - 1;
+ }
+ goto RESULT;
+ }
+ else {
+ my $values = @$cursor;
+ my $i;
+ my @found; # stores for each element if it has been found previously
+ for ($i = 0; $i < $values; $i++) { $found[$i] = 0 }
+ my $e;
+ my $elemfound = 0;
+ for ($i = $values - 1; $i > -1; $i--) {
+ $found[$$cursor[$i]] = 1;
+ if ($i > $values - 3) { # $values-1 or $values-2
+ if ($i == $values - 2) {
+ #print "i=$i (values-2)\n";##
+ $e = $$cursor[$i + 1];
+ if ($e > $$cursor[$i] && $e != $i
+ && $$cursor[$i] != $i + 1) {
+ $$cursor[$i + 1] = $$cursor[$i];
+ $$cursor[$i] = $e;
+ #print "!\n";##
+ goto RESULT;
+ }
+ }
+ next;
+ }
+ for ($e = $$cursor[$i] + 1; $e < $values; $e++) {
+ if ($found[$e] && $e != $i) {
+ $elemfound = 1;
+ last;
+ }
+ }
+ last if ($elemfound);
+ }
+ if ($elemfound) {
+ $$cursor[$i] = $e;
+ $found[$e] = 0;
+ $i++;
+ my $j;
+ my @elems;
+ for ($j = 0; $j < $values; $j++) {
+ if ($found[$j]) { push(@elems, $j) }
+ }
+ for ($j = 0; $j < @elems; $j++) {
+ if ($elems[$j] != $i) {
+ # if the next is the last and it will be wrong:
+ if ($j + 2 == @elems
+ && $elems[$j + 1] == $i + 1) {
+ # interchange them:
+ $$cursor[$i] = $elems[$j + 1];
+ $$cursor[$i + 1] = $elems[$j];
+ last;
+ }
+ $$cursor[$i] = $elems[$j];
+ }
+ elsif ($j + 1 < @elems) {
+ # use the next element:
+ $$cursor[$i] = $elems[$j + 1];
+ $elems[$j + 1] = $elems[$j];
+ }
+ else { die() }
+ $i++;
+ }
+ goto RESULT;
+ }
+ return ();
+ }
+ RESULT:
+ # map cursor to data array
+ my @result;
+ foreach my $c (@$cursor){
+ push @result, $${ $data->[$c] };
+ }
return @result;
}
@@ -379,16 +485,13 @@
);
Function: build a new Math::Combinatorics object.
Returns : a Math::Combinatorics object
- Args : count - required for combinatoric functions/methods.
- number of elements to be present in returned set(s).
- data - required for combinatoric B<AND> permutagenic
- functions/methods. this is the set elements are
- chosen from. B<NOTE>: this array is modified in
- place; make a copy of your array if the order matters
- in the caller's space.
- frequency - optional vector of data frequencies. must be the same
- length as the B<data> constructor argument. These two
- constructor calls here are equivalent:
+ Args : count - required for combinatoric functions/methods. number of elements to be
+ present in returned set(s).
+ data - required for combinatoric B<AND> permutagenic functions/methods. this is the
+ set elements are chosen from. B<NOTE>: this array is modified in place; make
+ a copy of your array if the order matters in the caller's space.
+ frequency - optional vector of data frequencies. must be the same length as the B<data>
+ constructor argument. These two constructor calls here are equivalent:
$a = 'a';
$b = 'b';
@@ -396,11 +499,9 @@
Math::Combinatorics->new( count=>2, data=>[\$a,\$a,\$a,\$a,\$a,\$b,\$b] );
Math::Combinatorics->new( count=>2, data=>[\$a,\$b], frequency=>[5,2] );
- so why use this? sometimes it's useful to have
- multiple identical entities in a set (in set theory
- jargon, this is called a "bag", See L<Set::Bag>).
- compare - optional subroutine reference used in sorting elements
- of the set. examples:
+ so why use this? sometimes it's useful to have multiple identical entities in
+ a set (in set theory jargon, this is called a "bag", See L<Set::Bag>).
+ compare - optional subroutine reference used in sorting elements of the set. examples:
#appropriate for character elements
compare => sub { $_[0] cmp $_[1] }
@@ -477,10 +578,9 @@
Usage : my @combo = $c->next_combination();
Function: get combinations of size $count from @data.
- Returns : returns a combination of $count items from @data
- (see L</new()>). repeated calls retrieve all unique
- combinations of $count elements. a returned empty list
- signifies all combinations have been iterated.
+ Returns : returns a combination of $count items from @data (see L</new()>).
+ repeated calls retrieve all unique combinations of $count elements.
+ a returned empty list signifies all combinations have been iterated.
Note : this method may only be used if a B<frequency> argument is B<NOT>
given to L</new()>, otherwise use L</next_multiset()>.
Args : none.
@@ -562,40 +662,6 @@
}
#warn 4;
return @result;
-}
-
-=head2 next_derangement()
-
- Usage : my @derangement = $c->next_derangement();
- Function: get derangements for @data.
- Returns : returns a permutation of items from @data (see L</new()>),
- where none of the items appear in their natural order. repeated calls
- retrieve all unique derangements of @data elements. a returned empty
- list signifies all derangements have been iterated.
- Args : none.
-
-=cut
-
-sub next_derangement {
- my $self = shift;
- my $data = $self->data();
-
- while ( my @perm = $self->next_permutation() ) {
- my $ok = 1;
- my $i = 0;
- foreach my $x ( @perm ) {
- if ( $x eq $${ $data->[$i] } ) {
- $ok = 0;
- last;
- }
- $i++;
- }
-
- next unless $ok;
- return @perm;
- }
-
- return ();
}
=head2 next_multiset()
@@ -641,9 +707,8 @@
Usage : my @permu = $c->next_permutation();
Function: get permutations of elements in @data.
Returns : returns a permutation of items from @data (see L</new()>).
- repeated calls retrieve all unique permutations of @data
- elements. a returned empty list signifies all permutations
- have been iterated.
+ repeated calls retrieve all unique permutations of @data elements.
+ a returned empty list signifies all permutations have been iterated.
Note : this method may only be used if a B<frequency> argument is B<NOT>
given to L</new()>, otherwise use L</next_string()>.
Args : none.
@@ -747,8 +812,7 @@
=head2 sum()
Usage : my $sum = sum(1,2,3); # returns 6
- Function: sums a list of integers. non-integer list elements are
- ignored
+ Function: sums a list of integers. non-integer list elements are ignored
Returns : sum of integer items in arguments passed in
Args : a list of integers
Note : this function is used internally by combine()
@@ -977,3 +1041,4 @@
}
1;
+
More information about the Pkg-perl-cvs-commits
mailing list