RogerBW's Blog

Perl Weekly Challenge 63: last words and string rotation 06 June 2020

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;
}

Add A Comment

Your Name
Your Email
Your Comment

Your submission will be ignored if any field is left blank, but your email address will not be displayed. Comments will be processed through markdown.

Search
Archive
Tags 1920s 1930s 1940s 1950s 1960s 1970s 1980s 1990s 2000s 2010s 3d printing action aeronautics aikakirja anecdote animation anime army astronomy audio audio tech base commerce battletech beer boardgaming book of the week bookmonth chain of command children chronicle church of no redeeming virtues cold war comedy computing contemporary cornish smuggler cosmic encounter coup covid-19 cycling dead of winter doctor who documentary drama driving drone ecchi economics espionage essen 2015 essen 2016 essen 2017 essen 2018 essen 2019 existential risk falklands war fandom fanfic fantasy feminism film firefly first world war flash point food garmin drive gazebo geodata gin gurps gurps 101 harpoon historical history horror hugo 2014 hugo 2015 hugo 2016 hugo 2017 hugo 2018 hugo 2019 hugo 2020 hugo-nebula reread humour in brief avoid instrumented life kickstarter learn to play leaving earth linux lovecraftiana mecha men with beards museum mystery naval non-fiction one for the brow opera perl perl weekly challenge photography podcast politics powers prediction privacy project woolsack pyracantha quantum rail ranting raspberry pi reading reading boardgames social real life restaurant reviews romance rpg a day rpgs science fiction scythe second world war security shipwreck simutrans smartphone south atlantic war squaddies stationery steampunk stuarts suburbia superheroes suspense television the resistance thirsty meeples thriller tin soldier torg toys trailers travel type 26 type 31 type 45 vietnam war war wargaming weather wives and sweethearts writing about writing x-wing young adult
Special All book reviews, All film reviews
Produced by aikakirja v0.1