Advertisement
cwchen

Functional Programming Demo in Perl

Feb 5th, 2016
186
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 1.60 KB | None | 0 0
  1. sub mygrep {
  2.     my $code = shift;
  3.     my @array;
  4.     for (@_) {
  5.         if ($code->($_)) {
  6.             push @array, $_;
  7.         }
  8.     }
  9.     return @array;
  10. }
  11.  
  12. sub myany {
  13.     my $code = shift;
  14.     for (@_) {
  15.         if ($code->($_)) {
  16.             return 1; # true
  17.         }
  18.     }
  19.     return; # false
  20. }
  21.  
  22. sub mymap {
  23.     my $code = shift;
  24.     my @result;
  25.     for (@_) {
  26.         push @result, $code->($_);
  27.     }
  28.     return @result;
  29. }
  30.  
  31. sub myreduce {
  32.     my $code = shift;
  33.     my $val = shift;
  34.     for (@_) {
  35.         local ($a, $b) = ($val, $_);
  36.         $val = $code->($val, $_);
  37.     }
  38.     return $val;
  39. }
  40.  
  41. sub mysort {
  42.     my $code = shift;
  43.     my @array = @_;
  44.     for my $i (0..$#array) {
  45.         for my $j (($i + 1)..$#array) {
  46.             local ($a, $b) = ($array[$i], $array[$j]);
  47.             if (!$code->($array[$i], $array[$j])) {
  48.                 ($array[$i], $array[$j]) = ($array[$j], $array[$i]);
  49.             }
  50.         }
  51.     }
  52.     return @array;
  53. }
  54.  
  55. my @array = (1, 2, 3, 4, 5);
  56. print "@array\n";
  57.  
  58. my @even = mygrep sub { $_ % 2 == 0 }, @array;
  59. my $any_even = (myany sub { $_ % 2 == 0 }, @array) ? "true" : "false";
  60. my @square = mymap sub { $_ ** 2 }, @array;
  61. print "@even\n";
  62. print "$any_even\n";
  63. print "@square\n";
  64.  
  65. my $sum = myreduce sub { $a + $b }, @array;
  66. my $product = myreduce sub { $a * $b }, @array;
  67. my $max = myreduce sub { $a > $b ? $a : $b }, @array;
  68. my $min = myreduce sub { $a > $b ? $b : $a }, @array;
  69. print $sum, "\n";
  70. print $product, "\n";
  71. print $max, "\n";
  72. print $min, "\n";
  73.  
  74. my @sorted = mysort sub { $a > $b }, @array;
  75. print "@sorted\n";
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement