pwc 249

3 files changed, 75 insertions, 0 deletions

diff --git a/challenge-249/steve-g-lynn/blog.txt b/challenge-249/steve-g-lynn/blog.txt
new file mode 100644
index 0000000000..393fdab0ae
--- /dev/null
+++ b/challenge-249/steve-g-lynn/blog.txt
@@ -0,0 +1 @@
+https://thiujiac.blogspot.com/2023/12/pwc-249.html
diff --git a/challenge-249/steve-g-lynn/perl/ch-1.pl b/challenge-249/steve-g-lynn/perl/ch-1.pl
new file mode 100755
index 0000000000..b15d537721
--- /dev/null
+++ b/challenge-249/steve-g-lynn/perl/ch-1.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/env -S perl -wl
+
+use Data::Dumper qw(Dumper);
+
+local *equal_pairs = sub {
+    #-- return () if input is of odd length
+    ((scalar(@_) % 2) > 0) && (return ());
+    
+    #-- count number of occurrences of each element using a hash
+    local %_ = ();
+    map {$_{$_}++} @_;
+    
+    #-- if any element occurs an odd number of times, return ()
+    (grep {($_{$_} % 2) > 0} keys %_) && (return ());
+    
+    #-- loop thru %_ keys, returning pairs of such keys
+    map {
+        my $k=$_; 
+        my $num_pairs=( ($_{$k}) / 2 );
+        map {
+            [$k, $k]
+        } 1 .. $num_pairs;    
+    } 
+    keys %_;    
+};
+
+print Dumper &equal_pairs(3,2,3,2,2,2);
+#$VAR1 = [
+#          '3',
+#          '3'
+#        ];
+#$VAR2 = [
+#          '2',
+#          '2'
+#        ];
+#$VAR3 = [
+#          '2',
+#          '2'
+#        ];
+
+print Dumper &equal_pairs(1,2,3,4);
+# no printed output (empty array)
+
+1;
diff --git a/challenge-249/steve-g-lynn/perl/ch-2.pl b/challenge-249/steve-g-lynn/perl/ch-2.pl
new file mode 100755
index 0000000000..5f64069776
--- /dev/null
+++ b/challenge-249/steve-g-lynn/perl/ch-2.pl
@@ -0,0 +1,30 @@
+#!/usr/bin/env -S perl -wl
+
+local *DI_string_match = sub {
+    my $str = $_[0];
+    
+    #-- return 0 (error) if input is not D or I only
+    ($str =~ /^[DI]+$/) || (return 0);
+
+    #-- create sorted array of indices from which to generate output
+    my @tmp=(0 .. length($str));
+    
+    #-- loop through $str indices, 
+    # if a position i is 'D' pop @tmp (highest item) and assign to retval[i]
+    # if a position i is 'I' shift @tmp (lowest item) and assign to retval[i]
+
+    my @retval = (); #-- return value
+    map {
+        (substr($str,$_,1) eq 'D') && ($retval[$_] = pop @tmp);
+        (substr($str,$_,1) eq 'I') && ($retval[$_] = shift @tmp);
+    }
+    0 .. length($str)-1;
+    $retval[length($str)] = shift @tmp; #-- last item left
+    @retval;
+};
+
+print join ',',  &DI_string_match('IDID'); #0,4,1,3,2
+print join ',',  &DI_string_match('III'); #0,1,2,3
+print join ',',  &DI_string_match('DDI'); #3,2,0,1
+
+1;