Alternate case

You are given a string containing an equal number of uppercase and lowercase English letters. Write a script to find the minimum number of adjacent character swaps needed to turn the given string into an alternating case string.

Examples

Example 1
Input: $str = 'aAbB'
Output: 0

Example 2
Input: $str = 'AAbb'
Output: 1
Swap 1: 'AbAb'

Example 3
Input: $str = 'AAAbbb'
Output: 3
Swap 1: 'AAbAbb'
Swap 2: 'AbAAbb'
Swap 3: 'AbAbAb'

Example 4
Input: $str = 'aABb'
Output: 1
Swap 1: 'aAbB'

Example 5
Input: $str = 'bBBAaa'
Output: 2
Swap 1: 'BbBAaa'
Swap 2: 'BbBaAa'

Analysis

This is a distinctly tricky challenge - or at least it was for me.

My solution gets the same answers as the examples, but I am not entirely convinced that it will always find the best solution.

It works on the principle that whenever, scanning left to right, it finds a forbidden sequence like AA, it searches ahead for the next b, and moves it to the position after A, shifting the part of the string between A and b rightwards one place.

Doing that requires a number of swaps equal to the distance in the array between the two swapped characters.

So, for example, for ABCde it sees B as needing to be replaced, and it swaps it with d, that being the nearest rightwards lower case letter, to yield AdBCe. Then again it deals with BCe by swapping C and e, to give a final result of AdBeC.

My initial thinking was that this will always minimise swapping, but it doesn't in a case like Example 5, bBBAaa, and the reason is that it never considers swapping the first character in the string.

I solved that, rather messily, by reversing the string, repeating the same process, and choosing whichever of the two gives the fewer swaps. I have not been able to find a string for which this fails to find the least swaps, but neither can I prove that there isn't one.

Try it 

Your input:

#!/usr/bin/perl

# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

use v5.26;    # The Weekly Challenge - 2026-10-05
use utf8;     # Week 394 - task 1 - Alternate case
use warnings; # Peter Campbell Smith
binmode STDOUT, ':utf8';
use Encode;

alternate_case('aAbB');
alternate_case('AAbb');
alternate_case('AAAbbb');
alternate_case('aABb');
alternate_case('bBBAaa');
alternate_case('WEEKLYweeklyCHALLENGEchallenge');

sub alternate_case {
    
    my ($string, $uppers, $lowers, $length, @array, $prev, $j, $k, 
        @swaps, $m, $x, @reverse, $output);
    
    # initialise
    $string = $_[0];
    say qq[\nInput:  '$string'];
    
    # validate input
    $uppers = () = $string =~ m|[A-Z]|g;
    $lowers = () = $string =~ m|[a-z]|g;
    $length = $uppers + $lowers;
    if (abs($uppers - $lowers) > 1 or $uppers + $lowers != length($string)) {
        say qq[Output: invalid string ($uppers uppers, $lowers lowers)];
        return;
    }

    # try forwards and backwards
    for $m (1 .. 2) {
    
        # creat array of 1s (upper case) and 0s (lower)
        $array[$_] = is_upper(substr($string, $_, 1)) ? 1 : 0 
            for 0 .. length($string) - 1;
        $prev = $array[0];
        $swaps[$m] = 0;
        
        # loop over array, moving elements if needed
        J: for $j (1 .. $#array - 1) {
            if ($array[$j] == $prev) {
                for $k ($j + 1 .. $#array) {
                    if ($array[$k] != $prev) {
                        move(\@array, $k, $j);
                        $swaps[$m] += $k - $j;
                        last;
                    }
                }
            }
            $prev = $array[$j];
        }
        last if $m == 2;
        
        # try again with reversed string
        $string = reverse($string);
    }
    
    $j = $swaps[1] > $swaps[2] ? $swaps[2] : $swaps[1];
    say qq[Output: $j swap] . ($j == 1 ? '' : 's');
}

# 1 for upper case, 0 for lower
sub is_upper {
    return ord($_[0]) > ord('Z') ? 0 : 1;
}

# move element $k to position $j
sub move {
    
    my ($array, $j, $k, $x, $y, @old);
    
    ($array, $k, $j) = @_;
    
    # reassemble @array
    @old = @$array;
    @$array = ();
    push @$array, @old[0 .. $j - 1];
    push @$array, $old[$k];
    push @$array, @old[$j .. $k - 1];
    push @$array, @old[$k + 1 .. $#old];
}

39 lines of code

Output from script

Input:  'aAbB'
Output: 0 swaps

Input:  'AAbb'
Output: 1 swap

Input:  'AAAbbb'
Output: 3 swaps

Input:  'aABb'
Output: 1 swap

Input:  'bBBAaa'
Output: 2 swaps

Input:  'WEEKLYweeklyCHALLENGEchallenge'
Output: 51 swaps