## Perl Weekly Challenge 194: Digital Clock and Frequency Equalizer

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.

## Leave a comment