first commit

perl/Examples/Chap6/PowSeries.pm

@@ -0,0 +1,179 @@
+
+
+###
+### 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);