180 lines
3.3 KiB
Perl
180 lines
3.3 KiB
Perl
|
|
|
|
###
|
|
### PowSeries.pm
|
|
###
|
|
|
|
## Chapter 6 section 7
|
|
|
|
package PowSeries;
|
|
use base 'Exporter';
|
|
@EXPORT_OK = qw(add2 mul2 partial_sums powers_of term_values
|
|
evaluate derivative multiply recip divide
|
|
$sin $cos $exp $log_ $tan);
|
|
use Stream ':all';
|
|
|
|
sub tabulate {
|
|
my $f = shift;
|
|
&transform($f, upfrom(0));
|
|
}
|
|
my @fact = (1);
|
|
sub factorial {
|
|
my $n = shift;
|
|
return $fact[$n] if defined $fact[$n];
|
|
$fact[$n] = $n * factorial($n-1);
|
|
}
|
|
|
|
|
|
$sin = tabulate(sub { my $N = shift;
|
|
return 0 if $N % 2 == 0;
|
|
my $sign = int($N/2) % 2 ? -1 : 1;
|
|
$sign/factorial($N)
|
|
});
|
|
|
|
|
|
$cos = tabulate(sub { my $N = shift;
|
|
return 0 if $N % 2 != 0;
|
|
my $sign = int($N/2) % 2 ? -1 : 1;
|
|
$sign/factorial($N)
|
|
});
|
|
|
|
|
|
## Chapter 6 section 7
|
|
|
|
sub add2 {
|
|
my ($s, $t) = @_;
|
|
return unless $s && $t;
|
|
node(head($s) + head($t),
|
|
promise { add2(tail($s), tail($t)) });
|
|
}
|
|
sub mul2 {
|
|
my ($s, $t) = @_;
|
|
return unless $s && $t;
|
|
node(head($s) * head($t),
|
|
promise { mul2(tail($s), tail($t)) });
|
|
}
|
|
sub partial_sums {
|
|
my $s = shift;
|
|
my $r;
|
|
$r = node(head($s), promise { add2($r, tail($s)) });
|
|
}
|
|
sub powers_of {
|
|
my $x = shift;
|
|
iterate_function(sub {$_[0] * $x}, 1);
|
|
}
|
|
sub term_values {
|
|
my ($s, $x) = @_;
|
|
mul2($s, powers_of($x));
|
|
}
|
|
sub evaluate {
|
|
my ($s, $x) = @_;
|
|
partial_sums(term_values($s, $x));
|
|
}
|
|
|
|
|
|
## Chapter 6 section 7
|
|
|
|
# Get the n'th term from a stream
|
|
sub nth {
|
|
my $s = shift;
|
|
my $n = shift;
|
|
return $n == 0 ? head($s) : nth(tail($s), $n-1);
|
|
}
|
|
|
|
# Calculate the approximate cosine of x
|
|
sub cosine {
|
|
my $x = shift;
|
|
nth(evaluate($cos, $x), 20);
|
|
}
|
|
sub is_zero_when_x_is_pi {
|
|
my $x = shift;
|
|
my $c = cosine($x/6);
|
|
$c * $c - 3/4;
|
|
}
|
|
|
|
|
|
## Chapter 6 section 7.1
|
|
|
|
sub derivative {
|
|
my $s = shift;
|
|
mul2(upfrom(1), tail($s));
|
|
}
|
|
|
|
|
|
## Chapter 6 section 7.2
|
|
|
|
$exp = tabulate(sub { my $N = shift; 1/factorial($N) });
|
|
|
|
|
|
## Chapter 6 section 7.2
|
|
|
|
$log_ = tabulate(sub { my $N = shift;
|
|
$N==0 ? 0 : (-1)**$N/-$N });
|
|
|
|
|
|
## Chapter 6 section 7.3
|
|
|
|
sub multiply {
|
|
my ($S, $T) = @_;
|
|
my ($s, $t) = (head($S), head($T));
|
|
node($s*$t,
|
|
promise { add2(scale(tail($T), $s),
|
|
add2(scale(tail($S), $t),
|
|
node(0,
|
|
promise {multiply(tail($S), tail($T))}),
|
|
))
|
|
}
|
|
);
|
|
}
|
|
|
|
|
|
## Chapter 6 section 7.3
|
|
|
|
sub scale {
|
|
my ($s, $c) = @_;
|
|
return if $c == 0;
|
|
return $s if $c == 1;
|
|
transform { $_[0]*$c } $s;
|
|
}
|
|
|
|
|
|
## Chapter 6 section 7.3
|
|
|
|
sub sum {
|
|
my @s = grep $_, @_;
|
|
my $total = 0;
|
|
$total += head($_) for @s;
|
|
node($total,
|
|
promise { sum(map tail($_), @s) }
|
|
);
|
|
}
|
|
sub multiply {
|
|
my ($S, $T) = @_;
|
|
my ($s, $t) = (head($S), head($T));
|
|
node($s*$t,
|
|
promise { sum(scale(tail($T), $s),
|
|
scale(tail($S), $t),
|
|
node(0,
|
|
promise {multiply(tail($S), tail($T))}),
|
|
)
|
|
}
|
|
);
|
|
}
|
|
|
|
|
|
## Chapter 6 section 7.3
|
|
|
|
# Only works if head($s) = 1
|
|
sub recip {
|
|
my ($s) = shift;
|
|
my $r;
|
|
$r = node(1,
|
|
promise { scale(multiply($r, tail($s)), -1) });
|
|
}
|
|
sub divide {
|
|
my ($s, $t) = @_;
|
|
multiply($s, recip($t));
|
|
}
|
|
|
|
$tan = divide($sin, $cos);
|