Peter
Peter Campbell Smith

Pairs and ups and downs

Weekly challenge 249 — 25 December 2023

Week 249 - 25 Dec 2023

Task 2

Task — DI string match

You are given a string s, consisting of only the characters "D" and "I". Find a permutation of the integers [0 .. length(s)] such that for each character s[i] in the string:

s[i] == 'I' ⇒ perm[i] < perm[i + 1]
s[i] == 'D' ⇒ perm[i] > perm[i + 1]

Examples


Example 1
Input: $str = "IDID"
Output: (0, 4, 1, 3, 2)

Example 2
Input: $str = "III"
Output: (0, 1, 2, 3)

Example 3
Input: $str = "DDI"
Output: (3, 2, 0, 1)

Analysis

My first observation is that I think there is a solution for any string of Is and Ds, although to be safe I have allowed for my hypothesis being wrong.

I looked for an easy solution involving single pass along the string but I couldn't immediately come up with one. I also though about generating all the permutations of 0 .. length($str) and testing each against the required increment/decrement constraints, but that seemed quite tedious.

So my solution goes like this.

At any point in creating the desired permutation, left to right, the next number must be:

  • in the range 0 to length($str)
  • not already used in the permutation
  • greater or less than the preceding number depending on the relevant character in the string being D or I

That lends itself to a recursive sub get_next which adds one compliant number to the permutation and then recurses until the whole permutation is filled according to the task conditions.

The only wrinkle to this is that the first number in the permutation is not constrained by any D or I, so we need to try all possible numbers, ie 0 to length($str) in that first position.

Recursion in Perl is not very fast, and there is a warning built in if the recursion depth exceeds 100, but using no warnings 'recursion'; my solution, given a random string of 1000 Ds and Is, runs on my Raspberry Pi in a a couple of seconds without running out of memory.

Try it 

Try running the script with any input:



example: DIDDI

Script


#!/usr/bin/perl

use v5.26;    # The Weekly Challenge - 2023-12-25
use utf8;     # Week 249 task 2 - DI string match
use strict;   # Peter Campbell Smith
use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
no warnings 'recursion';

my (@di);

di_string_match('IDID');
di_string_match('III');
di_string_match('DDI');
di_string_match('DDIIDIDDIIIDDIDIIDIIIIDD');
di_string_match('DIDIDIDIDI');

sub di_string_match {
    
    my ($str, @nums, @perm, @new_nums, $i, $good);  
    
    # initialise
    $str = $_[0];
    say qq[\nInput:  \$str = '$str'];
    @di = split('', $str);
    $nums[$_] = 1 for 0 .. @di;

    # try all possible initial numbers
    for $i (0 .. @di) {
        @perm = ($i);
        @new_nums = @nums;
        @new_nums[$i] = -1;
        $good = get_next(1, \@new_nums, \@perm);
        last if $good;
    }
    
    say qq[Output: no valid permutation] unless $good;
}

sub get_next {

    my ($i, @perm, $this_di, $n, @nums, @new_nums, @new_perm, $good);
    
    $i = $_[0];                 # looking for $perm[$i];
    @nums = @{$_[1]};           # numbers still unused
    @perm = @{$_[2]};           # answer so far
    $this_di = $di[$i - 1];     # D or I at position $i

    # find numbers valid at this position
    for $n (0 .. @nums - 1) {
        
        # number already used
        next unless $nums[$n] >= 0;
        
        # number not < or > as required by D or I
        next if ($this_di eq 'D' and $n > $perm[$i - 1]);
        next if ($this_di eq 'I' and $n < $perm[$i - 1]);
        
        # good so far and if we've reached the end of $str we have an answer
        @new_perm = @perm;
        $new_perm[$i] = $n;
        if ($i == @di) {
            say qq[Output: (] . join(', ', @new_perm) . ')';
            return 1;
        }
        
        # else recurse to get next value in @perm
        @new_nums = @nums;
        $new_nums[$n] = -1;
        $good = get_next($i + 1, \@new_nums, \@new_perm);
        
        # finished
        return 1 if $good;
    }
    
    # no valid perm - but I don't think that can happen
    return 0;
}

Output


Input:  $str = 'IDID'
Output: (0, 2, 1, 4, 3)

Input:  $str = 'III'
Output: (0, 1, 2, 3)

Input:  $str = 'DDI'
Output: (2, 1, 0, 3)

Input:  $str = 'DDIIDIDDIIIDDIDIIDIIIIDD'
Output: (2, 1, 0, 3, 5, 4, 8, 7, 6, 9, 10, 13, 12, 11, 
15, 14, 16, 18, 17, 19, 20, 21, 24, 23, 22)

Input:  $str = 'DIDIDIDIDI'
Output: (1, 0, 3, 2, 5, 4, 7, 6, 9, 8, 10)

The content of this website which has been created by
Peter Campbell Smith is hereby placed in the public domain