From 8239453f12e809ad63d6cf110b385054ebdc728a Mon Sep 17 00:00:00 2001
From: "E. Choroba" <choroba@matfyz.cz>
Date: Fri, 30 Aug 2019 23:26:20 +0200
Subject: Add solutions to 023 by E. Choroba

---
 challenge-023/e-choroba/perl5/ch-1.pl | 42 +++++++++++++++++++++++++++++++++++
 challenge-023/e-choroba/perl5/ch-2.pl | 23 +++++++++++++++++++
 2 files changed, 65 insertions(+)
 create mode 100755 challenge-023/e-choroba/perl5/ch-1.pl
 create mode 100755 challenge-023/e-choroba/perl5/ch-2.pl

diff --git a/challenge-023/e-choroba/perl5/ch-1.pl b/challenge-023/e-choroba/perl5/ch-1.pl
new file mode 100755
index 0000000000..6eb1ba0f44
--- /dev/null
+++ b/challenge-023/e-choroba/perl5/ch-1.pl
@@ -0,0 +1,42 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use feature qw{ say };
+
+use List::Util qw{ sum };
+
+# Recursive implementation.
+
+sub fds {
+    my ($seq, $order) = @_;
+    my @r = map $seq->[$_] - $seq->[$_ - 1], 1 .. $#$seq;
+    return @r if $order == 1;
+
+    return fds(\@r, $order - 1)
+}
+
+# Faster, uses memoizing and formulas for the given order.
+
+{   my %cache;
+    sub binomial {
+        my ($n, $k) = @_;
+        return $cache{$n}{$k} if $cache{$n}{$k};
+        my $r = 1;
+        $r *= $_ for 2 .. $n;
+        $r /= $_ for 2 .. $k, 2 .. ($n - $k);
+        return $cache{$n}{$k} = $r
+    }
+}
+
+sub fds2 {
+    my ($seq, $order) = @_;
+    my @coefficients = map binomial($order, $_), 0 .. $order;
+    $coefficients[2 * $_] *= -1 for -($order + 1) / 2 .. -1;
+    return map {
+        my $i = $_;
+        sum(map $seq->[$i + $_] * $coefficients[$_], 0 .. $order)
+    } 0 .. $#$seq - $order
+}
+
+my $order = pop;
+say join ' ', fds2([@ARGV], $order);
diff --git a/challenge-023/e-choroba/perl5/ch-2.pl b/challenge-023/e-choroba/perl5/ch-2.pl
new file mode 100755
index 0000000000..c95b5157eb
--- /dev/null
+++ b/challenge-023/e-choroba/perl5/ch-2.pl
@@ -0,0 +1,23 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use feature qw{ say };
+use List::Util qw{ any };
+
+sub prime_decomposition {
+    my ($n) = @_;
+    my %primes;
+    for my $i (2 .. $n) {
+        next if any { 0 == $i % $_ } keys %primes;
+
+        $primes{$i} = 0;
+        until ($n % $i) {
+            ++$primes{$i};
+            $n /= $i;
+        }
+        last if 1 == $n;
+    }
+    return map +($_) x $primes{$_}, sort { $a <=> $b } keys %primes
+}
+
+say join ' ', prime_decomposition(shift);
-- 
cgit