From 891286e60f06de6c8b19363fc3c3caf8839dc2b1 Mon Sep 17 00:00:00 2001
From: Dave Jacoby <jacoby.david@gmail.com>
Date: Sun, 4 Dec 2022 13:57:03 -0500
Subject: Challenge 193

---
 challenge-193/dave-jacoby/perl/ch-1.pl | 23 ++++++++++++++++++
 challenge-193/dave-jacoby/perl/ch-2.pl | 44 ++++++++++++++++++++++++++++++++++
 2 files changed, 67 insertions(+)
 create mode 100644 challenge-193/dave-jacoby/perl/ch-1.pl
 create mode 100644 challenge-193/dave-jacoby/perl/ch-2.pl

diff --git a/challenge-193/dave-jacoby/perl/ch-1.pl b/challenge-193/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..2e7eb0448e
--- /dev/null
+++ b/challenge-193/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,23 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ fc say postderef signatures state };
+
+for my $s ( 2 .. 5 ) {
+    my @binaries = all_binaries($s);
+    my $binaries = join ', ', @binaries;
+    say <<"END";
+    Input:  \$n = $s
+    Output: $binaries
+END
+
+}
+
+sub all_binaries ( $size, $b = '', $i = 0 ) {
+    return $b if length $b == $size;
+    my @output;
+    push @output, all_binaries( $size, $b . '0', $i + 1 );
+    push @output, all_binaries( $size, $b . '1', $i + 1 );
+    return @output;
+}
diff --git a/challenge-193/dave-jacoby/perl/ch-2.pl b/challenge-193/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..1ac2fbed6d
--- /dev/null
+++ b/challenge-193/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+my @examples = ( [ "adc", "wzy", "abc" ], [ "aaa", "bob", "ccc", "ddd" ] );
+
+my @alphabet = 'a' .. 'z';
+my $c        = 0;
+my %l2n      = map { $_ => $c++ } @alphabet;
+
+for my $e (@examples) {
+    my $output  = odd_string( $e->@* );
+    my $example = join ', ', map { qq{"$_"} } $e->@*;
+    say <<"END";
+    Input:  \@s =  ($example)
+    Output: "$output"
+END
+}
+
+sub odd_string ( @words ) {
+    my %results;
+    for my $word (@words) {
+        my @values;
+        for my $i ( 1 .. -1 + length $word ) {
+            my $l1 = substr $word, $i, 1;
+            my $l2 = substr $word, $i - 1, 1;
+            my $n1 = $l2n{$l1};
+            my $n2 = $l2n{$l2};
+            my $v  = $n1 - $n2;
+            push @values, $v;
+        }
+        my $string = join ', ', @values;
+        push $results{$string}->@*, $word;
+    }
+    for my $k ( keys %results ) {
+        my @v = $results{$k}->@*;
+        if ( 1 == scalar @v ) {
+            return $v[0];
+        }
+    }
+    return -1;
+}
-- 
cgit