Formal power series/Perl

From Rosetta Code
Formal power series/Perl is part of Formal power series. You may find other members of Formal power series at Category:Formal power series.

This is an alternative Perl implementation of a Formal Power Series. Unlike the one one the main Formal Power Series page, the one *does* implement lazy lists which look and are accessed exactly like normal perl arrays.

It's also a bit more object oriented, and probably more extensible.

 
use strict;
use warnings;
package FPS;
use Math::BigRat;
 
sub TIEARRAY {
my $class = shift;
return bless {@_}, $class;
}
 
sub FETCH {
my ($self, $i) = @_;
my $terms = ( $self->{terms} ||= [] );
return $terms->[$i]
if $i <= $#$terms and defined $terms->[$i];
return 0 if __PACKAGE__ eq ref $self;
$terms->[$i] = $self->coeff($i);
}
 
sub new {
my $class = shift;
tie my(@self), $class, @_;
bless \@self, $class;
}
 
sub new_from_list {
my ($class, @terms) = @_;
tie my(@self), $class, terms => \@terms;
bless \@self, $class;
}
 
sub _become {
my ($self, $other, @terms) = @_;
for( $self, $other ) {
$_ = tied @$_ if UNIVERSAL::isa($_, 'ARRAY');
}
%$self = %$other;
$self->{terms} = \@terms if @terms;
bless $self, ref $other;
}
 
sub _fixargs {
my ($x, $y, $swap) = @_;
$y = FPS->new_from_list($y)
unless UNIVERSAL::isa($y, 'FPS');
$swap ? ($y, $x) : ($x, $y);
}
 
for my $onearg (qw(invert differentiate integrate)) {
my $uc = ucfirst $onearg;
my $pack = 'FPS::'.$uc;
no strict 'refs';
*{"FPS::$onearg"} = sub {
$pack->new( x => shift );
};
@{$pack.'::ISA'} = 'FPS';
}
 
for my $twoarg (qw(sum difference product)) {
my $uc = ucfirst $twoarg;
my $pack = 'FPS::'.$uc;
no strict 'refs';
*{"FPS::$twoarg"} = sub {
my ($x, $y) = &_fixargs;
$pack->new( x => $x, y => $y );
};
@{$pack.'::ISA'} = 'FPS';
}
 
sub FPS::Invert::coeff {
my ($self, $i) = @_;
my $x = $self->{x};
if( $i == 0 ) {
my $x0 = $x->[0];
die "Cannot invert power series with zero constant term."
unless $x0;
(Math::BigRat->new(1) / $x0);
} else {
my $y = $self->{terms};
my $sum = 0;
for my $j (1 .. $i) {
$sum += $x->[$j] * $y->[$i - $j];
}
-$y->[0] * $sum;
}
}
 
sub FPS::Differentiate::coeff {
my ($self, $i) = @_;
($i + 1) * $self->{x}[$i];
}
 
sub FPS::Integrate::coeff {
my ($self, $i) = @_;
return 0 if $i == 0;
($self->{x}[$i-1]) / Math::BigRat->new($i);
}
 
sub FPS::Sum::coeff {
my ($self, $i) = @_;
$self->{x}[$i] + $self->{y}[$i];
}
 
sub FPS::Difference::coeff {
my ($self, $i) = @_;
$self->{x}[$i] - $self->{y}[$i];
}
 
sub FPS::Product::coeff {
my ($self, $i) = @_;
my ($x, $y) = @{$self}{'x','y'};
my $sum = 0;
$sum += $x->[$_] * $y->[$i-$_] for 0..$i;
$sum;
}
 
sub quotient {
my ($x, $y) = &_fixargs;
$x * FPS::Invert->new(x => $y);
}
 
sub stringify {
my $self = shift;
my $str = $self->[0];
for my $i (1..10) {
my $c = $self->[$i];
next unless $c;
$str .= ($c < 0) ? (" - " . (-$c)) : (" + ".$c);
$str .= " x^$i";
}
$str;
};
 
use overload qw(
+ sum - difference * product / quotient
"" stringify);
 
my $sin = FPS->new;
my $cos = 1 - $sin->integrate;
$sin->_become( $cos->integrate );
my $tan = $sin / $cos;
my $exp = FPS->new();
$exp->_become( $exp->integrate, 1 );
 
print "sin(x) ~= $sin\n";
print "cos(x) ~= $cos\n";
print "tan(x) ~= $tan\n";
print "exp(x) ~= $exp\n";
 
print "sin^2 + cos^2 - 1 = ", $sin*$sin + $cos*$cos - 1, "\n";
print "cos*cos - cos^2 = ", $cos*$cos - $cos**2, "\n";
 
print "1/1/cos(x) - cos(x) = ", $cos->invert->invert - $cos, "\n";
print "1 - exp(x) / exp(x) = ", 1 - $exp / $exp, "\n";
 
__END__
 
Output:
sin(x) ~= 0 + 1 x^1 - 1/6 x^3 + 1/120 x^5 - 1/5040 x^7 + 1/362880 x^9
cos(x) ~= 1 - 1/2 x^2 + 1/24 x^4 - 1/720 x^6 + 1/40320 x^8 - 1/3628800 x^10
tan(x) ~= 0 + 1 x^1 + 1/3 x^3 + 2/15 x^5 + 17/315 x^7 + 62/2835 x^9
exp(x) ~= 1 + 1 x^1 + 1/2 x^2 + 1/6 x^3 + 1/24 x^4 + 1/120 x^5 + 1/720 x^6 + 1/5040 x^7 + 1/40320 x^8 + 1/362880 x^9 + 1
/3628800 x^10
sin^2 + cos^2 - 1 = 0
1/1/cos(x) - cos(x) = 0
1 - exp(x) / exp(x) = 0