RogerBW's Blog

I’ve been doing the Perl Weekly Challenges. The latest involved finding the last matching word in a string and permuting a string.

Define sub last_word($string, $regexp) that returns the last word matching $regexp found in the given string, or undef if the string does not contain a word matching $regexp.

For this challenge, a “word” is defined as any character sequence consisting of non-whitespace characters (\S) only. That means punctuation and other symbols are part of the word.

The $regexp is a regular expression. Take care that the regexp can only match individual words! See the Examples for one way this can break if you are not careful.

I won't include the examples here; they're in the test cases below. But looking at them, I think the expected solution is to try to do the whole thing in one big regexp. Let's not do that.

A basic test harness based on the examples (yeah, I should learn Test::More).

if (last_word('  hello world',                qr/[ea]l/) ne 'hello') {
  die 1;
}
if (last_word("Don't match too much, Chet!",  qr/ch.t/i) ne  'Chet!') {
  die 2;
}
if (defined(last_word("spaces in regexp won't match", qr/in re/))){
  die 3;
}
if (last_word( join(' ', 1..1e6),             qr/^(3.*?){3}/) ne '399933') {
  die 4;
}

sub last_word {
  my ($str,$re)=@_;

So what I'm going to do here is split up the input string at any whitespace, giving me a list of "words". (Because of the way Perl's split works, there's also an empty string at the start, which I get rid of with grep.) Then reverse that list, because I want the last matching word.

  my @list=reverse grep /\S/,split /\s+/,$str;
  my $r;

Now iterate through that reversed list, exiting when we find a match. If I hadn't reversed the list, I'd have to check every member of it, and doing that is likely to take longer than the reversal. (And if I were less lazy, I could simply count down the indices in @list and not do the reversal at all.)

  foreach (@list) {
    if ($_ =~ $re) {
      $r=$_;
      last;
    }
  }
  return $r;
}

In Raku, the hard bit is changing the regexps to be valid.

if (last_word('  hello world',                rx/<[ea]>l/) ne 'hello') {
  die 1;
}
if (last_word("Don't match too much, Chet!",  rx/:i ch.t/) ne  'Chet!') {
  die 2;
}
if (defined(last_word("spaces in regexp won't match", rx/:s in re/))) {
  die 3;
}
if (last_word(join(' ', 1..1e6),             rx/^(3.*?) ** 3/) ne '399933') {
  die 4;
}

The actual function is basically the same. I could have used comb, but I already had the split-grep set up from Perl so I kept it here.

sub last_word ($str,$re) {
  my @list=reverse grep /\S/,split /\s+/,$str;
  my $r;
  for @list {
    if ($_ ~~ $re) {
      $r=$_;
      last;
    }
  }
  return $r;
}

Given a word made up of an arbitrary number of x and y characters, that word can be rotated as follows: For the ith rotation (starting at i = 1), i % length(word) characters are moved from the front of the string to the end. Thus, for the string xyxx, the initial (i = 1) % 4 = 1 character (x) is moved to the end, forming yxxx. On the second rotation, (i = 2) % 4 = 2 characters (yx) are moved to the end, forming xxyx, and so on. See below for a complete example.

Your task is to write a function that takes a string of xs and ys and returns the maximum non-zero number of rotations required to obtain the original string. You may show the individual rotations if you wish, but that is not required.

Again, I've elided the example. Which is incorrect in its final line anyway.

Now obviously I could have done something clever to take advantage of the fact that we only have two sorts of character in this string, but it seemed easier to take the problem at face value. (If this were an Advent of Code problem, part 2 would be "OK, now do it to an eleventy billion character string".)

Again, a basic test harness based on the example.

if (rotate('xyxx') != 7) {
  die "wrong answer";
}

sub rotate {
  my $str=shift;

Break the string into individual character elements, and count them.

  my @s=split '',$str;
  my $k=scalar @s;
  my $n=0;
  while (1) {
    $n++;

Chop the characters out of the beginning, and push them onto the end.

    my @l=splice @s,0,($n % $k);
    push @s,@l;

Then check to see if we've reached the initial configuration again.

    if (join('',@s) eq $str) {
      last;
    }
  }
  return $n;
}

Raku works the same way, except that once more I ran into its list-handling peculiarities.

sub rotate ($str) {
  my @s=$str.comb(/./);
  my $k=@s.elems;
  my $n=0;
  while (1) {
    $n++;
    my @l=splice @s,0,($n % $k);

If I do push @s, @l here as in Perl, I end up with @s with one more item, an array consisting of the contents of @l. If I use @l.flat, which I'd have thought would solve the problem, I get instead a Seq consisting of the contents of @l. So instead I have to do it iteratively, which makes the process slower (never a good thing in Raku). There may be a magic function to say "just give me this list as the elements of the list", but I haven't yet found it.

    map {push @s,$_},@l;
    if (join('',@s) eq $str) {
      last;
    }
  }
  return $n;
}