Blogged!

3 files changed, 79 insertions, 0 deletions

diff --git a/challenge-115/dave-jacoby/blog.txt b/challenge-115/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..55c3204b83
--- /dev/null
+++ b/challenge-115/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2021/06/01/abc-acb-bac-bca-cab-cba-perl-weekly-challenge-115.html
\ No newline at end of file
diff --git a/challenge-115/dave-jacoby/perl/ch-1.pl b/challenge-115/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..61b51e40fc
--- /dev/null
+++ b/challenge-115/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,43 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ postderef say signatures state };
+no warnings qw{ experimental };
+
+use Algorithm::Permute;
+
+my @input;
+push @input, [ "abc", "dea", "cd" ];
+push @input, [ "ade", "cbd", "fgh" ];
+
+for my $i (@input) {
+    my $v = is_chain( $i->@* );
+    say join " | ", $i->@*;
+    say $v? 'We can form a circle' : 'We cannot for a circle';
+    say ' ';
+}
+
+sub is_chain ( @links ) {
+    my $p = Algorithm::Permute->new( [@links] );
+    while ( my @res = $p->next ) {
+        my $i = join '-', @res;
+        my $c = 1;
+        if ( f_char( $res[0] ) eq l_char( $res[-1] ) ) {
+            for my $i ( 1 .. -1 + scalar @res ) {
+                $c++ if l_char( $res[ $i - 1 ] ) eq f_char( $res[$i] );
+            }
+            return 1 if $c == scalar @links;
+        }
+    }
+
+    return 0;
+}
+
+sub f_char( $str ) {
+    return substr( $str, 0, 1 );
+}
+
+sub l_char( $str ) {
+    return substr( $str, -1 + length $str, 1 );
+}
diff --git a/challenge-115/dave-jacoby/perl/ch-2.pl b/challenge-115/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..63d6fed68b
--- /dev/null
+++ b/challenge-115/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,35 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ postderef say signatures state };
+no warnings qw{ experimental };
+
+use Algorithm::Permute;
+
+my @input;
+push @input, [ 1, 0, 2, 6 ];
+push @input, [ 1, 4, 2, 8 ];
+push @input, [ 4, 1, 7, 6 ];
+
+for my $i (@input) {
+    my @arr  = $i->@*;
+    my $join = join ', ', @arr;
+    my $len  = largest_even_number( @arr );
+    say <<"END";
+    INPUT:  ($join)
+    OUTPUT: $len
+END
+}
+
+sub largest_even_number( @digits ) {
+    my $max = -1;
+    my $p = Algorithm::Permute->new( [@digits] );
+    while ( my @res = $p->next ) {
+        my $i = join '', @res;
+        $i += 0;
+        next unless $i % 2 == 0;
+        $max = $i if $i > $max;
+    }
+    return $max;
+}