Robbie Hatley's solutions, in Perl, for The Weekly Challenge #287.

3 files changed, 218 insertions, 0 deletions

diff --git a/challenge-287/robbie-hatley/blog.txt b/challenge-287/robbie-hatley/blog.txt
new file mode 100644
index 0000000000..154d20b5cf
--- /dev/null
+++ b/challenge-287/robbie-hatley/blog.txt
@@ -0,0 +1 @@
+https://hatley-software.blogspot.com/2024/09/robbie-hatleys-solutions-to-weekly_18.html
\ No newline at end of file
diff --git a/challenge-287/robbie-hatley/perl/ch-1.pl b/challenge-287/robbie-hatley/perl/ch-1.pl
new file mode 100755
index 0000000000..345c39b1de
--- /dev/null
+++ b/challenge-287/robbie-hatley/perl/ch-1.pl
@@ -0,0 +1,141 @@
+#!/usr/bin/env perl
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 287-1,
+written by Robbie Hatley on Tue Sep 17, 2024.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 287-1: Strong Password
+Submitted by: Mohammad Sajid Anwar
+You are given a string, $str. Write a program to return the
+minimum number of steps required to make the given string a
+"strong password". If the string is already a "strong password",
+then return 0.
+
+The definition of "strong password" is as follows:
+- It must have at least 6 characters.
+- It must contain at least one lowercase letter
+- It must contain at least one uppercase letter
+- It must contain at least one digit
+- It mustn't contain 3 repeating characters in a row
+
+Each of the following is considered one "step":
+- Insert one character
+- Delete one character
+- Replace one character with another
+
+Example 1:  Input: $str = "a"          Output: 5
+Example 2:  Input: $str = "aB2"        Output: 3
+Example 3:  Input: $str = "PaaSW0rd"   Output: 0
+Example 4:  Input: $str = "Paaasw0rd"  Output: 1
+Example 5:  Input: $str = "aaaaa"      Output: 2
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+I'll start by writing subs to do these two things:
+ - Determine the least-abundant type of character in a given string.
+ - Make a strong password out of any string.
+
+That last sub will involve doing the following:
+1. For each identical triplet, insert a character of least-abundant type between 2nd & 3rd chars of triplet,
+   making sure that it doesn't match what's to its left or right.
+2. While we don't have all required types, tack a least-abundant character to the end,
+   making sure that it doesn't match the character to its left.
+3. While length < 6, tack a symbol to the end,
+   making sure that it doesn't match the character to its left.
+4. Increment a step counter each time we insert a character.
+5. Return strong password and number of steps required to strengthen it.
+
+--------------------------------------------------------------------------------------------------------------
+IO NOTES:
+Input is via either built-in variables or via @ARGV. If using @ARGV, provide one argument which must be a
+single-quoted array of double-quoted strings, in proper Perl syntax, like so:
+./ch-1.pl '("Fkkg4e u)888hE dkiI?", "She ate 7 hot dogs.", "#)^*")'
+
+Output is to STDOUT and will be each weak password followed by strengthened password and number-of-steps.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, VARIABLES, AND SUBS:
+
+use v5.36;
+no warnings 'qw';
+
+# What is the least-abundant type of character in a given string?
+sub least :prototype($) ($p) {
+   my %types = ('L' => 0, 'U' => 0, 'D' => 0);
+   for my $c (split '', $p) {
+      $c =~ m/[a-z]/ and ++$types{'L'} and next;
+      $c =~ m/[A-Z]/ and ++$types{'U'} and next;
+      $c =~ m/[0-9]/ and ++$types{'D'} and next;
+   }
+   my @sorted = sort {$types{$a}<=>$types{$b}} keys %types;
+   return $sorted[0];
+}
+
+# Morph any string into a "strong password":
+sub make_strong :prototype($) ($p) {
+   # Start by making a "count of steps" counter and initializing it to zero:
+   my $c = 0;
+   # Now, make four arrays of different types of characters, for strengthening our password:
+   my %types =
+   (
+      'L' => [qw( a b c d e f g h i j k l m n o p q r s t u v w x y z )], # Lower
+      'U' => [qw( A B C D E F G H I J K L M N O P Q R S T U V W X Y Z )], # Upper
+      'D' => [qw( 0 1 2 3 4 5 6 7 8 9                                 )], # Digits
+      'O' => [qw( ~ ! @ # $ % ^ & * + - = : ; \ | / ?                 )], # Other
+   );
+   # Next, get rid of any triplets.
+   # (I'm using a 3-part loop here because a ranged foreach won't work because the size of $p changes.)
+   foreach ( my $i = 0 ; $i <= length($p) - 3 ; ++$i ) {
+      my $first  = substr($p, $i+0, 1);
+      my $second = substr($p, $i+1, 1);
+      my $third  = substr($p, $i+2, 1);
+      # Are the next three characters all equal? If so, we have a triplet here and we need to break it up:
+      if ($second eq $first && $third eq $first) {
+         # Insert a least-abundant character between second and third characters of triplet:
+         my $least = least($p);
+         my $insert = $types{$least}->[int rand scalar @{$types{$least}}];
+         redo if $insert eq $second || $insert eq $third;
+         substr($p, $i+1, 1, $second.$insert);
+         ++$c;
+      }
+   }
+   # Now, as long as we don't have all three required types of characters, keep tacking-on the least abundant:
+   while ( $p !~ m/[a-z]/ || $p !~ m/[A-Z]/ || $p !~ m/[0-9]/ ) {
+      # Tack a least-abundant character to the end:
+      my $least = least($p);
+      my $insert = $types{$least}->[int rand scalar @{$types{$least}}];
+      redo if $insert eq substr($p, -1, 1);
+      $p .= $insert;
+      ++$c;
+   }
+   # Finally, while our password is still less than 6 characters long, tack-on some symbols to lengthen it:
+   while ( length($p) < 6 ) {
+      my $insert = $types{'O'}->[int rand scalar @{$types{'O'}}];
+      redo if $insert eq substr($p, -1, 1);
+      $p .= $insert;
+      ++$c;
+   }
+   return ($p,$c);
+}
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @passwords = @ARGV ? eval($ARGV[0]) : ('a', 'aB2', 'PaaSW0rd', 'Paaasw0rd', 'aaaaa');
+# Expected outputs:                        5     3         0           1          2
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+for my $p (@passwords) {
+   say '';
+   say "Original password   = $p";
+   my ($s,$c) = make_strong($p);
+   say "Strong   password   = $s";
+   say "Steps to strengthen = $c";
+}
diff --git a/challenge-287/robbie-hatley/perl/ch-2.pl b/challenge-287/robbie-hatley/perl/ch-2.pl
new file mode 100755
index 0000000000..7a2a90c48f
--- /dev/null
+++ b/challenge-287/robbie-hatley/perl/ch-2.pl
@@ -0,0 +1,76 @@
+#!/usr/bin/env perl
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 287-2,
+written by Robbie Hatley on Mon Sep 16, 2024.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 287-2: Valid Number
+Submitted by: Mohammad Sajid Anwar
+You are given a string, $str. Write a script to find if it is a
+valid number. Conditions for a valid number:
+- An integer number followed by an optional exponent.
+- A decimal number followed by an optional exponent.
+
+An "integer number" is defined as an optional sign '-' or '+'
+followed by digits.
+
+A "decimal number" is defined as an optional sign '-' or '+'
+followed by one of the following:
+- Digits followed by a dot '.'.
+- Digits followed by a dot '.' followed by digits.
+- A dot '.' followed by digits.
+
+An "exponent" is defined with an exponent notation 'e' or 'E'
+followed by an integer number.
+
+Example 1:  Input: $str = "1"        Output: true
+Example 2:  Input: $str = "a"        Output: false
+Example 3:  Input: $str = "."        Output: false
+Example 4:  Input: $str = "1.2e4.2"  Output: false
+Example 5:  Input: $str = "-1."      Output: true
+Example 6:  Input: $str = "+1E-8"    Output: true
+Example 7:  Input: $str = ".44"      Output: true
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+To solve this problem, I made regular expressions for "integer", "decimal", and "exponent", then tacked them
+together to make a regular expression for "number", then just tested inputs against that regular expression.
+
+--------------------------------------------------------------------------------------------------------------
+IO NOTES:
+Input is via either built-in variables or via @ARGV. If using @ARGV, provide one argument which must be a
+single-quoted array of double-quoted strings, in proper Perl syntax, like so:
+./ch-2.pl '("-37.8F17", "-37.8E17", ".99e-72.3", ".99e-72", "+a.99e72", "+8.99e72", "I ate salmon")'
+
+Output is to STDOUT and will be each input string followed by a statement saying whether it's a number.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, AND SUBS:
+
+use v5.36;
+sub is_number ($x) {
+   my $int_pat = '(\+|-)?\d+';
+   my $dec_pat = '(\+|-)?((\d+)\.|(\.\d+)|(\d+\.\d+))';
+   my $exp_pat = "(e|E)$int_pat";
+   my $num_pat = qr#(^$int_pat($exp_pat)?$)|(^$dec_pat($exp_pat)?$)#;
+   $x =~ m/$num_pat/;
+}
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @strings = @ARGV ? eval($ARGV[0]) : ("1", "a", ".", "1.2e4.2", "-1.", "+1E-8", ".44");
+# Expected outputs:                      t    f    f      f         t       t       t
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+for my $x (@strings) {
+   my $isnum = is_number($x) ? 'True.' : 'False.';
+   say "String = \"$x\"  Is number? $isnum";
+}