# RogerBW's Blog

 Perl Weekly Challenge 94: Binary Anagrams 05 January 2021 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![]; 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. Posted by RogerBW at 12:00pm on 13 January 2021 1. I'm presumably not the first to invent that prime multiplication technique; at least, several other people used it. Some players did take the naïve approach of generating all possible permutations of letters, though this is much slower. In between the two is the most common approach of sorting the letters into order, then doing string comparisons – slower than the prime numbers, but it will work on any valid string and doesn't require huge numeric variables. 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. Search 10 per page 20 per page 50 per page 100 per page Archive Tags 1920s 1930s 1940s 1950s 1960s 1970s 1980s 1990s 2000s 2010s 3d printing action advent of code aeronautics aikakirja anecdote animation anime army astronomy audio audio tech aviation base commerce battletech beer boardgaming book of the week bookmonth chain of command children chris chronicle church of no redeeming virtues cold war comedy computing contemporary cornish smuggler cosmic encounter coup covid-19 crime cthulhu eternal cycling dead of winter doctor who documentary drama driving drone ecchi economics espionage essen 2015 essen 2016 essen 2017 essen 2018 essen 2019 essen 2022 existential risk falklands war fandom fanfic fantasy feminism film firefly first world war flash point flight simulation food garmin drive gazebo genesys geocaching geodata gin gkp gurps gurps 101 gus harpoon historical history horror hugo 2014 hugo 2015 hugo 2016 hugo 2017 hugo 2018 hugo 2019 hugo 2020 hugo 2022 hugo-nebula reread in brief avoid instrumented life javascript julian simpson julie enfield kickstarter kotlin learn to play leaving earth linux liquor lovecraftiana lua mecha men with beards mpd museum music mystery naval noir non-fiction one for the brow opera parody paul temple perl perl weekly challenge photography podcast politics postscript powers prediction privacy project woolsack pyracantha python quantum rail raku ranting raspberry pi reading reading boardgames social real life restaurant reviews romance rpg a day rpgs ruby rust science fiction scythe second world war security shipwreck simutrans smartphone south atlantic war squaddies stationery steampunk stuarts suburbia superheroes suspense television the resistance the weekly challenge 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