Perl Weekly Challenge: Week 287
Challenge 1:
Strong Password
You are given a string,
$str.Write a program to return the minimum number of steps required to make the given string very strong password. If it is already strong then return 0.
Criteria:
- It must have at least 6 characters.
- It must contains at least one lowercase letter, at least one upper case letter and at least one digit.
- It shouldn't contain 3 repeating characters in a row.
Following can be considered as 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
I'm not sure if this is the most efficient solution but this is what I came up with.
Normally, arguments passed into a Raku script are immutable. In this case I wanted to be
able to modify $str so I declared it in the parameters of MAIN() like this:
Str $str is copy
In the body of MAIN() first we declare a variable to store the number of steps taken.
my $steps = 0;
Then a bunch of strings containing various sets of characters.
Digits...
my $digits = ('0' .. '9').join;
...lower-case letters...
my $lower = ('a' .. 'z').join;
...upper-case letters...
my $upper = ('A' .. 'Z').join;
...and all of the above.
my $all = $digits ~ $lower ~ $upper;
Then we have some strings containing combinations of the ones above.
All except digits...
my $nondigits = $lower ~ $upper;
...all except lower-case...
my $nonlower = $digits ~ $upper;
...and all except upper-case.
my $nonupper = $digits ~ $lower;
First we shall address criterion 3. We look for runs of characters that repeat 3 times.
while $str ~~ /(.)$0$0/ {
If we find such a character we determine which type it is (i.e. digit, lower-case or upper-case.) and assign the
string that does not contain that type to $chars.
my $chars = $0.Str ~~ $lower
?? $nonlower
!! $0.Str ~~ $upper
?? $nonupper
!! $digits;
Then we substitute the middle character from the run with a random character from $chars. To get a random
character we use the .pick(1) method from the List class. So first we need to convert $chars to a List of
characters with .comb(). Even if you only .pick() one character it is returned as a List so we get the character back out with .first().
$str = $str.subst($/, $/.substr(0, 2) ~ $chars.comb.pick(1).first);
We have undertaken a step so our counter is incremented.
$steps++;
}
Next is criterion 2. For this we just scan through $str for each of our classes of characters by interpolating
them into regular expressions as Lists with .comb(). If there is no match, a random character from that class
(using .pick() etc. as above) is appended to the end of $str. Each time we append a character, $steps is incremented.
if $str !~~ / @($digits.comb) / {
$str ~= $digits.comb.pick(1).first;
$steps++;
}
if $str !~~ / @($lower.comb) / {
$str ~= $lower.comb.pick(1).first;
$steps++;
}
if $str !~~ / @($upper.comb) / {
$str ~= $upper.comb.pick(1).first;
$steps++;
}
The last criterion is the first one. All we have to do for this one is to measure if $str is less than 6 characters long and if so, add the missing amount by .pick()ing random characters from the $all class. For
each character that is appended, $steps is incremented.
while $str.chars < 6 {
$str ~= $all.comb.pick(1).first;
$steps++;
}
When all criteria have been met, we print the number of $steps taken.
say $steps;
}
This is the Perl version.
sub pickOne($str) {
return substr $str, int(rand(length $str)), 1;
}
In Perl we don't have to worry about immutability.
my $str = shift;
my $steps = 0;
my $digits = join q{}, '0' .. '9';
my $lower = join q{}, 'a' .. 'z';
my $upper = join q{}, 'A' .. 'Z';
my $all = $digits . $lower . $upper;
my $nondigits = $lower . $upper;
my $nonlower = $digits . $upper;
my $nonupper = $digits . $lower;
while ($str =~ /((.)\g{-1}\g{-1})/) {
To find if a character is in a class we use the index() function. We could also use
smartmatch (~~) as we did in Raku but I am used to doing this way.
my $chars = (index($lower, $2) > -1)
? $nonlower
: (index($upper, $2) > -1)
? $nonupper
: $digits;
my $c = $1;
To include code in a substitution in Perl, you need the e adverb.
$str =~ s/$c/substr($c, 0, 2) . pickOne($chars)/e;
$steps++;
}
if ($str !~ / [$digits] /x) {
$str .= pickOne($digits);
$steps++;
}
if ($str !~ / [$lower] /x) {
$str .= pickOne($lower);
$steps++;
}
if ($str !~ / [$upper] /x) {
$str .= pickOne($upper);
$steps++;
}
while (length $str < 6) {
$str .= pickOne($all);
$steps++;
}
say $steps;
Perl doesn't have .pick() so we have to provide our own version which I called pickOne().
sub pickOne($str) {
return substr $str, int(rand(length $str)), 1;
}
Challenge 2:
Valid Number
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 with an optional sign '-' or '+' followed by digits.
Decimal Number:
A decimal number is defined with an optional sign '-' or '+' followed by one of the following definitions:
- Digits followed by a dot '.'.
- Digits followed by a dot '.' followed by digits.
- A dot '.' followed by digits.
Exponent:
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
Raku has a wonderful feature which I don't think any other language has called grammars. Think of them as regular expressions on steroids. This is the grammar that expresses the rules given in the spec:
grammar Number {
rule TOP { <number> }
rule number { <integer> | <decimal> }
rule integer { <sign>?<digit>+<exponent>? }
rule decimal { <sign>?<digit>+<decimalpoint><digit>* | <sign>?<decimalpoint><digit>+ }
rule exponent { <exponentsymbol><integer> }
token sign { <[+ -]> }
token digit { <[0 .. 9]> }
token decimalpoint { <[.]> }
token exponentsymbol { <[e E]> }
}
Now it is dead simple to determine if we have a valid number or not. We just have to create a Number object
and call its' .parse() method with $str. The result will be a Match object or Nil so we convert it into a boolean with .so and print it out with .say().
Number.parse($str).so.say;
For Perl I used the Parse::RecDescent module to provide the functionality of Raku grammars. So first I had to add this to the top of the script:
use Parse::RecDescent;
This is the grammar:
my $grammar = q{
The initial rule that Raku calls TOP is called startrule here.
startrule: number
I had problems because the behavior of Parse::RecDescent is different from Raku; if I understand this right, it always tries to make the shortest possible match whereas Raku prefers the longest match. So I wasn't able to
do a direct translation. For instance, I had to break up the decimal rule into two separate rules and place decimal before integer in the number rule.
my $grammar = q{
number: decimal1
| decimal2
| integer
decimal1: sign(?) digit(s) decimalpoint
decimal2: sign(?) decimalpoint digit(s)
integer: sign(?) digit(s) exponent(?)
decimalpoint: '.'
exponent: /[eE]/ integer
sign: /[-+]/
digit: /\d/
};
Now we create a new Parse::RecDescent object and call the startrule() method. By passing in $str by reference
this will return the portion of $str that is not matched.
my $number = Parse::RecDescent->new($grammar)->startrule(\$str);
So if the final length of $str is more than 0, the number is invalid and we print 'false' otherwise we print 'true'.
say 0+(length $str) ? 'false' : 'true';
UPDATE After I submitted this, I realized both my Perl and Raku solutions are a little bit wrong. According to the spec, decimal numbers should also be able to have exponents. The way I have constructed grammars, only integer numbers can. However my solution does give the correct answers for all the examples so I shall leave it as is for now.