laurent_r

These are some answers to the Week 194 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on December 11, 2022 at 23:59). This blog post offers some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 1: Digital Clock

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

The task is quite easy, but a little painful because of the number of cases to be tested.

Digital Clock in Raku

The highest-digit subroutine splits the input qstring into the hour and minute component and figures out in which component the missing digit (the question mark) is.

If the missing digit is in the hour component, and if the first digit is missing, then the subroutine returns 1 if the second digit if more than 3 and 2 otherwise. If the second digit is missing, then it returns 3 if the first digit is 2, and 9 otherwise.

If the missing digit is in the minute component, then the suboutine returns 5 if it is the first digit that is missing, and 9 if it is the second digit.

sub highest-digit ($in) {
    my ($h, $m) = $in.split(/\:/);
    # say $h, " ", $m;
    if $h ~~ /\?/ {
        my ($h1, $h2) = $h.comb('');
        if $h1 eq '?' {
            return $h2 > 3 ?? 1 !! 2;
        } elsif $h2 eq '?' {
            return $h1 == 2 ?? 3 !! 9;
        }
    } elsif $m ~~ /\?/ {
        my ($m1, $m2) = $m.comb('');
        return 5 if $m1 eq '?'; 
        return 9 if $m2 eq '?'; 
    }        
}

for <?5:00 ?3:00 1?:00 2?:00 12:?5 12:5? 14:?9> -> $t {
    say "$t => ", highest-digit($t);
}

This program displays the following output:

$ raku ./highest-digit.raku
?5:00 => 1
?3:00 => 2
1?:00 => 9
2?:00 => 3
12:?5 => 5
12:5? => 9
14:?9 => 5

Digital Clock in Perl

This is a port to Perl of the Raku program above. Please refer to the Raku section for explanations on the way the program works.

use strict;
use warnings;
use feature qw/say/;

sub highest_digit  {
    my ($h, $m) = split /\:/, $_[0];
    # say $h, " ", $m;
    if ($h =~ /\?/) {
        my ($h1, $h2) = split //, $h;
        if ($h1 eq '?') {
            return $h2 > 3 ? 1 : 2;
        } elsif ($h2 eq '?') {
            return $h1 == 2 ? 3 : 9;
        }
    } elsif ($m =~ /\?/) {
        my ($m1, $m2) = split //, $m;
        return 5 if $m1 eq '?'; 
        return 9 if $m2 eq '?'; 
    }        
}

for my $t (qw<?5:00 ?3:00 1?:00 2?:00 12:?5 12:5? 14:?9>) {
    say "$t => ", highest_digit($t);
}

This program displays the following output:

$ perl ./highest-digit.pl
?5:00 => 1
?3:00 => 2
1?:00 => 9
2?:00 => 3
12:?5 => 5
12:5? => 9
14:?9 => 5

Task 2: Frequency Equalizer

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.

Basically, to answer the question, we need to find out whether all the characters have the same frequency, except for one which occurs once more than the others.

Frequency Equalizer in Raku

We first build the %histo histogram of the letters of the input string. Then we store the sorted values (ascending order) in the @frequencies array and check whether all the values except the last (the largest) are equal and the last value is one more than the others.

sub remove-one ($st) {
    my %histo;
    %histo{$_}++ for $st.comb;
    my @frequencies = %histo.values.sort;
    my $largest = @frequencies.pop;
    return 1 if $largest - 1 == @frequencies.all;
    return 0;
}
for <abbc xyzyyxz xzxz> -> $test {
    say "$test.fmt("%-10s") => ", remove-one($test);
}

This program displays the following output:

$ raku ./freq-analyzer.raku
abbc       => 1
xyzyyxz    => 1
xzxz       => 0

Frequency Equalizer in Perl

We first build the %histo histogram of the letters of the input string. Then we store the sorted values (descending order) in the @frequencies array and check whether all the values except the first (the largest) are equal and the first value is one more than the others. Note that we cannot use an all junction in Perl, so we simply loop over the values (except the first) to check that they are all equal

use strict;
use warnings;
use feature qw/say/;

sub remove_one {
    my %histo;
    $histo{$_}++ for split //, shift;
    my @frequencies = sort { $b <=> $a } values %histo;
    my $largest = shift @frequencies;
    for my $count (@frequencies) {
        return 0 if $largest - 1 != $count;
    }
    return 1;
}
for my $test (<abbc xyzyyxz xzxz>) {
    printf "%-10s => %d\n", $test, remove_one($test);
}

This program displays the following output:

$ perl ./freq-analyzer.pl
abbc       => 1
xyzyyxz    => 1
xzxz       => 0

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on December 18, 2022. And, please, also spread the word about the Perl Weekly Challenge if you can.