RabbitFarm

Part 1

You are given an array of strings @S. Write a script to group Anagrams together in any random order.

Solution

use strict;
use warnings;
my %letter_factor = (
    e => 2,
    t => 3,
    a => 5,
    o => 7,
    i => 11,
    n => 13,
    s => 17,
    h => 19,
    r => 23,
    d => 29,
    l => 31,
    c => 37,
    u => 41,
    m => 43,
    w => 47,
    f => 53,
    g => 59,
    y => 61,
    p => 67,
    b => 71,
    v => 73,
    k => 79,
    j => 83,
    x => 89,
    q => 97,
    z => 101  
);  

MAIN:{
    my $word;
    my %anagrams;
    while($word = ){
        chomp($word); 
        my @letters = split(//, $word);
        my $word_product = 1;
        map {$word_product *= $_} map{$letter_factor{$_}} @letters;
        push @{$anagrams{$word_product}} , $word if $anagrams{$word_product};  
        $anagrams{$word_product} = [$word] unless $anagrams{$word_product};  
    }  
    close(DATA);
    print "Organized anagrams:\n";
    for my $key (keys %anagrams){
        print "  "; 
        for my $word (@{$anagrams{$key}}){
            print "$word ";
        }
        print "\n";
    }   
}   

__DATA__
opt
bat
saw
tab
pot
top
was

Sample Run

$ perl ch-1.pl
Organized anagrams:
  saw was 
  bat tab 
  opt pot top 

Notes

• I am using the same mathematical trick that I have used for anagrams in the past, starting with Challenge 005. The By the Fundamental Theorem of Arithmetic every integer greater than 1 is either a prime number itself or can be represented as the unique product of prime numbers. We use that to our advantage by having a prime number associated with each letter. Each word is a product of these numbers and words with the same product are anagrams.

• In this way we build a hash keyed by word product whose values are list of anagrams. After constructing this data structure we then just print out the contents of all the lists.

• The choice of letters and prime numbers is based on the Lewand Ordering and it isn’t at all necessary but it does little harm so I left it in anyway.

Part 2

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.

Solution

use strict;
use warnings;

use Graph;
use LinkedList;

sub build_linked_list{ 
    my($tree) = @_;
    my $linked_list = new LinkedList(); 
    my @paths = build_paths($tree);
    my $root = $paths[0]->[0]; 
    my $next = $linked_list->insert($root, undef); 
    for my $path (@paths){
        for my $node (@{$path}){
            $next = $linked_list->insert($node, $next) if !$linked_list->in_list($node);    
        }
    } 
    return $linked_list;
}

sub build_paths {
   my ($graph) = @_;
   my @paths;
   local *_helper = sub{
      my $v = $_[-1];
      my @successors = $graph->successors($v);
      if(@successors){
         _helper(@_, $_) for @successors;
      } 
      else{
         unshift @paths, [@_];
      }
   };
   _helper($_) for $graph->source_vertices();
   return @paths;
}

MAIN:{
    my $Tree;
    $Tree = new Graph();
    $Tree->add_vertices(1, 2, 3, 4, 5, 6, 7);
    $Tree->add_edge(1, 2);
    $Tree->add_edge(1, 3);
    $Tree->add_edge(2, 4);
    $Tree->add_edge(2, 5);
    $Tree->add_edge(5, 6);
    $Tree->add_edge(5, 7);
    print build_linked_list($Tree)->stringify();
}

The LinkedList module used is of my own making. I am using a somewhat modified version of the LinkedList module I made for Challenge 059. Next is what that code looks like.

use strict;
use warnings;
package LinkedList{
    use boolean;
    use Tie::RefHash;
    use Class::Struct;
    package Node{
        use Class::Struct;

        struct(
            data => q/$/,
            next => q/Node/
        );
    }

    struct(
        head => q/Node/
    );

    sub stringify{
        my($self) = @_;
        my $s = "";
        my $next = $self->head()->next();
        while($next && $next->next()){
            $s .= " -> " if $s; 
            $s = $s . $next->data();
            $next = $next->next();
        }
        $s = $s . " -> " . $next->data() if $next->data();
        $s .= "\n"; 
        return $s;
    }

    sub insert{
        my($self, $data, $previous) = @_;
        if(!$previous){
            $previous=new Node(data => undef, next => undef);
            $self->head($previous);
        }
        my $next=new Node(data => $data, next => undef);
        $previous->next($next);
        return $next;
    }

    sub in_list{
        my($self, $k) = @_;
        my $previous = $self->head();
        my $next = $self->head()->next();
        tie my %node_value, "Tie::RefHash";
        while($next){
            return true if($next->data() == $k); 
            $next = $next->next(); 
        }
        return false;
    }
    true;
}

Sample Run

$ perl -I. ch-2.pl
1 -> 2 -> 4 -> 5 -> 6 -> 7 -> 3

Notes

• The Depth First Search (DFS) code for building the paths is the same as last week.

• After the DFS returns all the paths they are simply inserted into the list.

• My LinkedList module is one of my favorite uses of Class::Struct.

• My write up for Challenge 059 has some more notes on this LinkedList.pm.

References

Lewand Ordering

Fundamental Theorem of Arithmetic