Perl Weekly Challenge 194.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 194.
Task 1: Digital Clock
Submitted by: Mohammad S Anwar
You are given time in the format hh:mm with one missing digit.
Write a script to find the highest digit between 0-9 that makes it valid time.
Example 1
Input: $time = '?5:00'
Output: 1
Since 05:00 and 15:00 are valid time and no other digits can fit in the missing
place.
Example 2
Input: $time = '?3:00'
Output: 2
Example 3
Input: $time = '1?:00'
Output: 9
Example 4
Input: $time = '2?:00'
Output: 3
Example 5
Input: $time = '12:?5'
Output: 5
Example 6
Input: $time = '12:5?'
Output: 9
A simple solution consists of testing each digit 0..9, substituting it for the missing digit and testing it for validity. The last one that passes the test is the correct one. This yields a one-liner:
perl -E '
for $x(@ARGV){for(0..9){($y=$x)=~s/\?/$_/;$y=~/(\d\d):(\d\d)/;$1<=23 and $2<=59 and $r=$_}say "$x->$r"}
' ?5:00 ?3:00 1?:00 2?:00 12:?5 12:5?
Results:
?5:00->1
?3:00->2
1?:00->9
2?:00->3
12:?5->5
12:5?->9
The full code makes a few tests and go from 9 to 0 to reduce the amount of required tests.
1 # Perl weekly challenge 194
2 # Task 1: Digital Clock
3 #
4 # See https://wlmb.github.io/2022/12/05/PWC194/#task-1-digital-clock
5 use v5.36;
6 #Perl @PerlWChallenge 194 Task 1: Digital Clock
7
8 L: for my $in(@ARGV){
9 for(reverse(0..9)){
10 my $y=$in;
11 $y=~s/\?/$_/;
12 say("Wrong format $in"), next L unless $y=~/(\d\d):(\d\d)/;
13 say("$in -> $_"), next L if $1<=23 and $2<=59
14 }
15 say "$in -> No solution";
16 }
17
Example:
./ch-1.pl ?5:00 ?3:00 1?:00 2?:00 12:?5 12:5? 3?:59
Results:
?5:00 -> 1
?3:00 -> 2
1?:00 -> 9
2?:00 -> 3
12:?5 -> 5
12:5? -> 9
3?:59 -> No solution
Task 2: Frequency Equalizer
Submitted by: Mohammad S Anwar
You are given a string made of alphabetic characters only, a-z.
Write a script to determine whether removing only one character
can make the frequency of the remaining characters the same.
Example 1:
Input: $s = 'abbc'
Output: 1 since removing one alphabet 'b' will give us 'abc' where
each alphabet frequency is the same.
Example 2:
Input: $s = 'xyzyyxz'
Output: 1 since removing 'y' will give us 'xzyyxz'.
Example 3:
Input: $s = 'xzxz'
Output: 0 since removing any one alphabet would not give us string
with same frequency alphabet.
If the frequencies can be equalized, all letters should appear the same number of times, say x, except one that appears exactly one extra time, x+1. If there are N letters, then the sum of all the frequencies should be Nx+1, and the sum of their squares should be Nx2+2x+1. The string may be equalized if and only if both conditions hold. This yields the following one-liner:
perl -MPDL -E 'for(@ARGV){my %f;$f{$_}++ for(split ""); $v=pdl(@v=values %f); $s=$v->sum;
$x=($s-1)/@v; $t=($v*$v)->sum; say "$_ -> ", $s%@v==1&&$t==@v*$x**2+2*$x+1?1:0}
' abbc xyzyyxz xzxz xyyyzzz
Results:
abbc -> 1
xyzyyxz -> 1
xzxz -> 0
xyyyzzz -> 0
I used the Perl Data Language to shorten the code. The last example shows that both conditions are required, as it is made up of three letters with length 7, and 7%3=1.
A version without PDL is:
perl -MList::Util=sum -E 'for(@ARGV){my %f;$f{$_}++ for(split ""); @v=values %f; $s=sum @v;
$x=($s-1)/@v; $t=sum map {$_*$_} @v; say "$_ -> ", $s%@v==1&&$t==@v*$x**2+2*$x+1?1:0}
' abbc xyzyyxz xzxz xyyyzzz
Results:
abbc -> 1
xyzyyxz -> 1
xzxz -> 0
xyyyzzz -> 0
The full code is:
1 # Perl weekly challenge 194
2 # Task 2: Frequency Equalizer
3 #
4 # See https://wlmb.github.io/2022/12/05/PWC194/#task-2-frequency-equalizer
5 use v5.36;
6 use PDL;
7 for(@ARGV){
8 my %frequencies;
9 $frequencies{$_}++ for(split "");
10 my $vals=pdl(my @vals=values %frequencies);
11 my $N=@vals;
12 my $sum=$vals->sum;
13 my $x=($sum-1)/$N;
14 my $t=($vals**2)->sum;
15 say "$_ -> ", $sum%$N==1 && $t==$N*$x**2 + 2*$x + 1? 1 :0
16 }
Example:
./ch-2.pl abbc xyzyyxz xzxz xyyyzzz
Results:
abbc -> 1
xyzyyxz -> 1
xzxz -> 0
xyyyzzz -> 0
And without PDL:
1 # Perl weekly challenge 194
2 # Task 2: Frequency Equalizer. Without PDL
3 #
4 # See https://wlmb.github.io/2022/12/05/PWC194/#task-2-frequency-equalizer
5 use v5.36;
6 use List::Util qw(sum);
7 for(@ARGV){
8 my %frequencies;
9 $frequencies{$_}++ for(split "");
10 my @vals=values %frequencies;
11 my $N=@vals;
12 my $sum=sum @vals;
13 my $x=($sum-1)/$N;
14 my $t=sum map {$_*$_} @vals;
15 say "$_ -> ", $sum%$N==1 && $t==$N*$x**2 + 2*$x + 1? 1 :0
16 }
Example:
./ch-2a.pl abbc xyzyyxz xzxz xyyyzzz
Results:
abbc -> 1
xyzyyxz -> 1
xzxz -> 0
xyyyzzz -> 0
Errata
I realized, after reading other’s work, that I made a mistake. Strings such as xyyyzzz can be equalized by dropping the x. The same is true of strings such as xx…x with two or more repeated letterrs and no other. Thus I have to account for those possibilities. In the first case the number of letters is congruent with 1 module the number of distinct letters minus one. In the latter, there is only one distinct letter and it appears more than once. Thus, a slightly more complicated solution is:
perl -MPDL -E 'for(@ARGV){my %f;$f{$_}++ for(split ""); $v=pdl(@v=values %f); $s=$v->sum;
$x=($s-1)/@v; $t=($v*$v)->sum; say "$_ -> ", $s%(@v-1)==1 || (@v==1&&$s>1) ||
$s%@v==1&&$t==@v*$x**2+2*$x+1?1:0}' abbc yzyyxz xzxz xyyyzzz x xx
Results:
abbc -> 1
yzyyxz -> 0
xzxz -> 0
xyyyzzz -> 1
x -> 0
xx -> 1