Merge pull request #9300 from jacoby/master

DAJ #249

3 files changed, 82 insertions, 0 deletions

diff --git a/challenge-249/dave-jacoby/blog.txt b/challenge-249/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..d526ba7bd9
--- /dev/null
+++ b/challenge-249/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2023/12/26/i-did-weekly-challenge-249.html
diff --git a/challenge-249/dave-jacoby/perl/ch-1.pl b/challenge-249/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..fa9ffc48d6
--- /dev/null
+++ b/challenge-249/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,38 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+my @examples = (
+
+    [ 3, 2, 3, 2, 2, 2 ],
+    [ 1, 2, 3, 4 ],
+);
+
+for my $example (@examples) {
+    my $input  = join ', ', $example->@*;
+    my @output = equal_pairs( $example->@* );
+    my $output = join ', ',
+        map { qq{($_)} } map { join ', ', $_->@* } @output;
+
+    say <<~"END";
+    Input:  \$ints = ($input)
+    Output: ($output)
+    END
+}
+
+sub equal_pairs (@input) {
+    my @output;
+    my %hash;
+    for my $i (@input) {
+        if ( $hash{$i} ) {
+            push @output, [ $i, $i ];
+            delete $hash{$i};
+        }
+        else {
+            $hash{$i} = 1;
+        }
+    }
+    return @output;
+}
diff --git a/challenge-249/dave-jacoby/perl/ch-2.pl b/challenge-249/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..171fe13288
--- /dev/null
+++ b/challenge-249/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,43 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+use Algorithm::Permute;
+
+my @examples = ( "IDID", "III", "DDI" );
+
+for my $e (@examples) {
+    my @output = di_string_match($e);
+    my $output = join "\n        ", sort
+        map { qq{($_)} }
+        map { join ', ', $_->@* } @output;
+
+    say <<~"END";
+    Input:  \$str = $e
+
+    Output: $output
+    END
+}
+
+sub di_string_match ($str) {
+    my @output;
+    my @s = 0 .. length $str;
+    my $p = Algorithm::Permute->new( [@s] );
+OUTER: while ( my @perm = $p->next ) {
+        for my $i ( 0 .. -1 + length $str ) {
+            my $l = substr $str, $i, 1;
+            if ( $l eq 'I' ) {
+                next OUTER unless $perm[$i] < $perm[ $i + 1 ];
+            }
+            elsif ( $l eq 'D' ) {
+                next OUTER unless $perm[$i] > $perm[ $i + 1 ];
+            }
+        }
+        push @output, \@perm;
+    }
+
+    return @output;
+}
+