Task — 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.

Examples

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.

Analysis

This is a reworking of my original solution.

There are 3 classes of strings where the removal of a single character leaves the frequency of all the remaining characters the same:

1. One character appears n times and any others appear n - 1 times (including n == 0, ie all the characters are the same)
2. One character appears once and all the others appear n times
3. All the characters are unique, ie all appear once

My solution first calculates the frequency of each character and then considers each of the above cases. If the string does not fall into one of these, then there is no solution.

I use a labelled for loop to consider the 3 cases. In each case, if the test succeeds I set $result and then do last CASE. If the test fails I do next CASE to consider any remaining cases.

Lastly, if $result has not been set, there is no solution.

I have coded this as a for loop over the 3 cases, as I thought that was clearer, but it coulkd equally be done with three nested if clauses.

Finally, although the above is an efficient solution, perhaps a more convincing, if slower, solution would be simply to delete each character in turn, and see if the remaiing characters all appear equally often.

Try it 

Try running the script with any input:

Your $s =

example: aaabbbc

⤡

#!/usr/bin/perl

# Peter Campbell Smith - 2022-12-06
# PWC 194 task 2

use v5.28;
use utf8;
use warnings;

my (@tests, $test, @chars, $char, %freq, $max_freq, $max_char, $result, $case, $seen_one);

@tests = ('aabbbcc', 'deeffgg', 'hijklm', 'xxyyyz', 'uuvvvwww', 'uuuuuvvvwww', 't', 'tttt');

for $test (@tests) {
    %freq = ();
    $max_freq = 0;
    return unless $test;
    
    # create $freq{'x'} as frequency of 'x' in string
    @chars = split(//, $test);
    for $char (@chars) {
        $freq{$char} ++;
    }
    
    # find the maximum frequency and the (or one of the) characters having that frequency
    for $char (keys %freq) {
        if ($freq{$char} > $max_freq) {
            $max_freq = $freq{$char};
            $max_char = $char;
        }
    }
    
    $result = '';
    CASE: for $case (1 .. 3 ) {
        
        # case 1: for each char that isn't $max_char, the frequency must be $max_freq - 1
        if ($case == 1) {
            for $char (sort keys %freq) {
                next CASE if ($char ne $max_char and $freq{$char} != $max_freq - 1);
            }
            $result = qq[1 as removal of one '$max_char' leaves the remaining frequencies equal];
            last CASE;
        
        # case 2: one char has freq == 1 and the rest have the same freq
        } elsif ($case == 2) {
            next CASE if $max_freq == 1;
            $seen_one = '';
            for $char (sort keys %freq) {
                if ($freq{$char} == 1 and $seen_one eq '') {
                    $seen_one = $char;
                } else {
                    next CASE if ($freq{$char} != $max_freq);
                }
            }
            next CASE unless $seen_one;
            $result = qq[1 as removal of '$seen_one' leaves the remaining frequencies equal];
            last CASE;
            
        # case 3: all chars have freq 1
        } else {
            for $char (sort keys %freq) {
                last CASE if $freq{$char} != 1;
            }
            $result = qq[1 as removal of any character leaves the remaining frequencies equal];
        }
    }
    $result = qq[0 as no single removal leaves the remaining frequencies equal] unless $result;
    
    # report result
    say qq[\nInput:  $test\nOutput: $result];

}

Output

Input:  aabbbcc
Output: 1 as removal of one 'b' leaves the remaining frequencies equal

Input:  deeffgg
Output: 1 as removal of 'd' leaves the remaining frequencies equal

Input:  hijklm
Output: 1 as removal of any character leaves the remaining frequencies equal

Input:  xxyyyz
Output: 0 as no single removal leaves the remaining frequencies equal

Input:  uuvvvwww
Output: 0 as no single removal leaves the remaining frequencies equal

Input:  uuuuuvvvwww
Output: 0 as no single removal leaves the remaining frequencies equal

Input:  t
Output: 1 as removal of one 't' leaves the remaining frequencies equal

Input:  tttt
Output: 1 as removal of one 't' leaves the remaining frequencies equal