Challenge 54

2 files changed, 81 insertions, 0 deletions

diff --git a/challenge-054/dave-jacoby/perl/ch-1.pl b/challenge-054/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..72b875296e
--- /dev/null
+++ b/challenge-054/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use utf8;
+use feature qw{ fc postderef say signatures state switch };
+no warnings qw{ experimental };
+
+use Carp;
+use JSON;
+
+my $json = JSON->new->canonical->allow_nonref;
+
+my $permutation = return_permutation( 3, 4 );
+say $json->encode($permutation);
+
+sub return_permutation ( $n, $k ) {
+    $n = int $n;
+    $k = int $k;
+    croak 'n < 1' unless $n >= 1;
+    croak 'k < 1' unless $k >= 1;
+    my $src->@* = 1 .. $n;
+    my @permutations = permute_array($src);
+    my @output;
+
+    if ( $permutations[ $k - 1 ] ) {
+        push @output, $permutations[ $k - 1 ]->@*;
+    }
+
+    return wantarray ? @output : \@output;
+}
+
+sub permute_array ( $array ) {
+    return $array if scalar $array->@* == 1;
+    my @response = map {
+        my $i        = $_;
+        my $d        = $array->[$i];
+        my $copy->@* = $array->@*;
+        splice $copy->@*, $i, 1;
+        my @out = map { unshift $_->@*, $d; $_ } permute_array($copy);
+        @out
+    } 0 .. scalar $array->@* - 1;
+    return @response;
+}
diff --git a/challenge-054/dave-jacoby/perl/ch-2.pl b/challenge-054/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..9db105e114
--- /dev/null
+++ b/challenge-054/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,37 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use utf8;
+use feature qw{ postderef say signatures state switch };
+no warnings qw{ experimental recursion };
+binmode( STDOUT, ":utf8" ) ;
+
+use Carp;
+use JSON;
+
+my $json = JSON->new->canonical->pretty->allow_nonref;
+
+my $n = 23;
+my @output = collatz($n);
+say join ' → ', @output;
+
+exit;
+
+sub collatz ( $n ) {
+    $n = int $n;
+    croak if $n < 1;
+    my @sec;
+    if ( $n == 1 ) {
+        push @sec, 1;
+    }
+    elsif ( $n % 2 == 1 ) {    #odd
+        my $o = ( 3 * $n ) + 1;
+        push @sec, $n, collatz($o);
+    }
+    elsif ( $n % 2 == 0 ) {    #even
+        my $o = $n / 2;
+        push @sec, $n, collatz($o);
+    }
+    return wantarray ? @sec : \@sec;
+}