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.
Comments on this post are now closed. If you have particular grounds for adding a late comment, comment on a more recent post quoting the URL of this one.