RabbitFarm

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

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

Solution

:-initialization(main).

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

chars_product([], 1).
chars_product([H|T], Product):-
    letter_factor(H, Factor),
    chars_product(T, Product0), 
    Product is Factor * Product0.  

word_product(Word, Product):-
    atom_chars(Word, Chars),
    chars_product(Chars, Product).  

organize([]):-
    findall(Words, bagof(Word, word_product(Word-_), Words), WordsList),
    write(WordsList). 
organize([H|T]):-
    word_product(H, P),
    assertz(word_product(H-P)),
    organize(T). 

main:-
    Anagrams = [opt, bat, saw, tab, pot, top, was],
    organize(Anagrams), nl,
    halt.

Sample Run

$ gplc ch-1.p
$ ./ch-1
[[bat,tab],[opt,pot,top],[saw,was]]

Notes

This is a Prolog version of Perl code I wrote for the same problem. In translating the approach of using the Fundamental Theorem of Arithmetic I tried to make sure the result was idiomatic Prolog as much as I could. I think I pulled that off!?!? In Prolog there is sometimes an over temptation to end up writing a bunch of mostly functional code. That is, code that could just as easily be written in, say, Haskell or ML. The organize/1 predicate is pretty much that sort of functional code but it is very short and wraps Prolog concepts such as assertz/1, findall/3, and bagof/3.

• 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 assert/1 Word-Product pairs for all the given anagrams and once done use findall/3 with bagof/3 to collect the solutions for printing as desired. This method of collecting solutions is given a nice description here.

• The choice of letters and prime numbers is based on the Lewand Ordering and it isn’t at all necessary (it stems from an early, unnecessary, design decision) 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

:-initialization(main).
 
dfs(Node, Graph, [Node|Path]):- 
    dfs(Node, Graph, Path, []).
dfs(_, _, [], _).
dfs(Node, Graph, [AdjNode|Path], Seen) :-
    member(r(Node, Adjacent), Graph),
    member(AdjNode, Adjacent),
    \+ memberchk(AdjNode, Seen),
    dfs(AdjNode, Graph, Path, [Node|Seen]).

unseen_nodes(Nodes, NodeList, Unseen):-
    unseen_nodes(Nodes, NodeList, [], Unseen).
unseen_nodes([], _, Unseen, Unseen).
unseen_nodes([H|T], NodeList, UnseenAccum, Unseen):- 
    \+ memberchk(H, NodeList),
    unseen_nodes(T, NodeList, [H|UnseenAccum], Unseen).  
unseen_nodes([H|T], NodeList, UnseenAccum, Unseen):-
    memberchk(H, NodeList),
    unseen_nodes(T, NodeList, UnseenAccum, Unseen).  

paths_list(Paths, List):-
    paths_list(Paths, [], List).
paths_list([], List, List).
paths_list([H|T], ListAccum, List):-
    unseen_nodes(H, ListAccum, Unseen),
    append(ListAccum, Unseen, ListAccum0), 
    paths_list(T, ListAccum0, List).    

print_list([H|[]]):-
    format("~d~n", [H]).  
print_list([H|T]):-
    format("~d -> ", [H]),   
    print_list(T).

main:-
    findall(Path, dfs(1,[r(1,[2]),r(1,[3]),r(2,[4,5]),r(5,[6,7])], Path), Paths),
    paths_list(Paths, List),  
    print_list(List), halt.

Sample Run

$ gplc ch-2.p
-bash-5.0$ ./ch-2
1 -> 2 -> 4 -> 5 -> 6 -> 7 -> 3

Notes

• Some of this code is re-used from last week

• The idea of a (singly) Linked List in Prolog is fundamental. We might consider any ordinary list in this way since Prolog allows direct access to the head and tail of
  lists. This solution, therefore ends up being simpler than even the Perl solution to the same problem.

• The code above simply does a DFS of the given tree and then adds new nodes to a list in the order in which they are seen.

References

Challenge 094

Fundamental Theorem of Arithmetic

Lewand Ordering

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