RogerBW's Blog

I’ve been doing the Perl Weekly Challenges. The latest involved grouping anagrams and more furkling with binary trees. (Note that this is open until 10 January 2021.)

TASK #1 › Group Anagrams

You are given an array of strings @S.

Write a script to group Anagrams together in any random order.

This uses code I've written recently, which I talk about in a post that's not gone up yet, but will some time soonish. Basically, my method of saying "is A an anagram of B" is to compute a hash of each word using prime numbers (each A multiplies the hash by 2, each B by 3, each C by 5, etc.): two words with the same hash are anagrams of each other.

While the problem explicitly allows for arbitrary orders, for purposes of testing I decided to sort the results – where it was necessary.

The hash function:

sub wh {
  my $w=shift;
  $w=lc($w);
  if ($w =~ /[^a-z]/) {
    return 0;
  }
  my $b=ord('a');

I could have a global constant for this, but I didn't.

  my @p=(2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101);
  my $n=1;
  foreach my $c (split '',$w) {
    $n*=$p[ord($c)-$b];
  }
  return $n;
}

and the overall processing:

sub ga {
  my @in=@_;

Each word-value is a key into the overall hash.

  my %g;
  foreach my $word (@in) {
    push @{$g{wh($word)}},$word;
  }

Then we transform this into a (sorted) list of (sorted) lists.

  my @out;
  foreach my $k (values %g) {
    push @out,[sort @{$k}];
  }
  @out=sort {$a->[0] cmp $b->[0]} @out;
  return \@out;
}

The other languages have the idea of a set, i.e. an unordered list with no duplicates. So in Raku I transform the result into a set of sets:

  return Set(map {Set($_)}, %g.values);

Python is a little more fiddly, because its sets are not hashable (i.e. I can't have a set of sets). But I can have a set of frozensets.

    r=set()
    for v in g.values():
        r.add(frozenset(v))

Ruby lets me have sets of sets, no problem.

    if !g.has_key?(h) then
      g[h]=Set.new;
    end
    g[h] << word

but in Rust, where I'd be happy to use a HashSet, it turns out that they also are not hashable. So I fell back on my Perl model and returned a vector of vectors.

    let mut r: Vec<Vec<String>>=vec![];
    for (_k,v) in g {
        let mut vv=v.clone();
        vv.sort();
        r.push(vv);
    }
    r.sort();
    return r;

(Would it be quicker to sort the input first? Hmm, probably not.)

TASK #2 › Binary Tree to Linked List

You are given a binary tree.

Write a script to represent the given binary tree as an object and flatten it to a linked list object. Finally print the linked list object.

I still don't get this obsession with linked lists. Yeah, sometimes they're useful, but very often they really aren't, and certainly they aren't the universal tool in modern languages that they were in C. Anyway, I coded to pass the test case, which turns out to be arranging the entries on the binary tree into the order met in a depth-first traversal; without a test case for the linked list form I didn't bother to use it.

(I'm also very uninterested in writing a parser to get an ASCII binary tree into standard array form, so I simply assume it's already there – just as for last week's challenge #2. If I were to do this conversion too, that would be a separate function. As would the linked list stuff.)

I'm not usually a great fan of recursion but for depth-first it seemed to work quite well. A setup function:

sub bt2ll {
  my $tree=shift;
  return recurse($tree,0,[]);
}

and the function that actually does the work, lightly modified from last week's to be recursive:

sub recurse {
  my ($tree,$start,$out)=@_;
  push @{$out},$tree->[$start];
  my $b=$start*2+1;
  foreach my $ba ($b,$b+1) {
    if ($ba <= $#{$tree} && defined $tree->[$ba]) {
      recurse($tree,$ba,$out);
    }
  }
  return $out;
}

Note that $out is the same variable in every invocation of the function, so pushing stuff onto it works wherever we are. In the other languages it's more work to pass a reference around, so I make use of the function return at lower levels. Raku:

sub recurse(@tree,$start) {
  my @out=(@tree[$start]);
  my $b=$start*2+1;
  for ($b,$b+1) -> $ba {
    if ($ba <= @tree.end && @tree[$ba]>=0) {
      for recurse(@tree,$ba) -> $t {
        push @out,$t;
      }
    }
  }
  return @out.flat;
}

and the others are basically similar to that.

Full code on github.