Pairs and ups and downs
Weekly challenge 249 — 25 December 2023
Week 249: 25 Dec 2023
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]
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)
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:
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.
#!/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; }
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)
Any content of this website which has been created by Peter Campbell Smith is in the public domain