RogerBW's Blog

I’ve been doing the Weekly Challenges. The latest involved word breakdowns and perfect squares. (Note that this is open until 11 June 2023.)

Task 1: Common Characters

You are given a list of words.

Write a script to return the list of common characters (sorted alphabeticall) found in every word of the given list.

Some languages have sets with full function support. Some don't.

I took word2set from challenge 216 task #1. Python:

def word2set(word):
  r = set()
  for c in word.lower():
    if c >= 'a' and c <= 'z':
      r.add(c)
  return r

def commoncharacters(lst):
  c = word2set(lst[0])
  for w in lst[1:]:
    c = c.intersection(word2set(w))
  return sorted(list(c))

Probably this could be done with a reduce or equivalent, but that's not really part of my standard mental programming toolbox.

For languages like Perl, the set intersection is more a matter of looking through the keys of c and deleting any that don't appear in the set from the other word.

Task 2: Squareful

You are given an array of integers, @ints.

An array is squareful if the sum of every pair of adjacent elements is a perfect square.

Write a script to find all the permutations of the given array that are squareful.

For languages without permutation readily available, I borrowed code from challenge 154 task #1.

More interesting is the way that in some languages an array is a perfectly good set key and a thing that can be sorted; in others, rather less so. In some cases I changed the sequence into a base-X number (X being one higher than the highest value) for easier manipulation, then broke it down again for output.

I decided to make things a bit more interesting by having a squareness-tester that automatically extended itself as needed.

A shorthand function for squaring things:

sub squared($a) {
  return $a * $a;
}

Sequence decoder (base-X number to sequence):

sub decode($a0, $base) {
  my @eq;
  my $a = $a0;
  while ($a > 0) {
    unshift @eq, $a % $base;
    $a = int($a / $base);
  }
  return \@eq;
}

Sequence encoder (sequence to base-X number):

sub encode($sq, $base) {
  my $a = 0;
  foreach my $v (@{$sq}) {
    $a *= $base;
    $a += $v;
  }
  return $a;
}

The main function. Set up hashest (sets) to catch results, and for the self-extending squares list.

sub squareful($lst) {
  my %results;
  my %squares;

Determine the base for sequence encdding.

  my $base = max(@{$lst}) + 1;

For each possible permutation of input digits:

  my $p = Algorithm::Permute->new($lst);
  while (my @la = $p->next) {

Only one adjacent combination need not be squareful to disqualify this permutation.

    my $squareful = 1;

Go through the permutation by overlapping digit pairs.

    foreach my $i (0 .. $#la - 1) {
      my $cs = $la[$i] + $la[$i + 1];

What's the highest perfect square we already know about? (Taking the length of the hash and squaring it should be faster than retrieving its maximum value.)

      my $mx = squared(scalar keys %squares);

If the value under test is higher, extend the squares hash until it isn't.

      while ($cs > $mx) {
        $mx = squared((scalar keys %squares) + 1);
        $squares{$mx} = 1;
      }

If it's not a perfect square, bail out on this permutation.

      unless (exists $squares{$cs}) {
        $squareful = 0;
        last;
      }
    }

If this was a squareful permutation, code it up. (If the permutor produces duplicates, this will get rid of them.)

    if ($squareful) {
      $results{encode(\@la, $base)} = 1;
    }
  }

Now take those results, sort them, decode them, and stick them in the output list.

  return [map {decode($_, $base)} sort {$a <=> $b} keys %results];
}

Full code on github.