diff options
| -rw-r--r-- | challenge-094/duncan-c-white/README | 82 | ||||
| -rwxr-xr-x | challenge-094/duncan-c-white/perl/ch-1.pl | 65 | ||||
| -rwxr-xr-x | challenge-094/duncan-c-white/perl/ch-2.pl | 232 |
3 files changed, 329 insertions, 50 deletions
diff --git a/challenge-094/duncan-c-white/README b/challenge-094/duncan-c-white/README index 895ec1ea71..cc13605728 100644 --- a/challenge-094/duncan-c-white/README +++ b/challenge-094/duncan-c-white/README @@ -1,72 +1,54 @@ -Task 1: "Max Points +Task 1: "Group Anagrams -You are given set of co-ordinates @N. +You are given an array of strings @S. -Write a script to count maximum points on a straight line when given co-ordinates plotted on 2-d plane. +Write a script to group sets of Anagrams (containing the same letters), the order of the anagram-sets doesn't matter. -Example 1: +An Anagram is a word or phrase formed by rearranging the letters of a different word or phrase, typically using all the original letters exactly once. - | - | x - | x - | x - + _ _ _ _ +Example 1: - Input: (1,1), (2,2), (3,3) - Output: 3 + Input: ("opt", "bat", "saw", "tab", "pot", "top", "was") + Output: [ ("bat", "tab"), + ("saw", "was"), + ("top", "pot", "opt") ] Example 2: - | - | - | x x - | x - | x x - + _ _ _ _ _ - - Input: (1,1), (2,2), (3,1), (1,3), (5,3) - Output: 3 + Input: ("x") + Output: [ ("x") ] " -My notes: hmm.. I can't see an obvious way to do this cleanly. Some thought needed. -Perhaps try every pair of points, make a line, then check all remaining points to -see if they're on that same line? Sounds like quite a lot of work. Also, how does -one element of @N store an (X,Y) point? +My notes: yippee! Good old "Programming Pearls" by Jon Bentley tackled a very similar problem, using SIGNATURES (the sorted bag of letters +contained in a word) - all anagrams with the same signature form part of the same anagram group. Ideal data structure time: +"if only we could have a data structure mapping from a signature to a list of all the words with that signature". -Task 2: "Sum Path +Ok, let's build that then: a HoA. -You are given binary tree containing numbers 0-9 only. -Write a script to sum all possible paths from root to leaf. +Task 2: "Binary Tree to Linked List -Example 1: +You are given a binary tree. - Input: - 1 - / - 2 - / \ - 3 4 +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. - Output: 13 - as sum two paths (1->2->3) and (1->2->4) +Example: -Example 2: + Input: + + 1 + / \ + 2 3 + / \ + 4 5 + / \ + 6 7 - Input: - 1 - / \ - 2 3 - / / \ - 4 5 6 + Output: - Output: 26 - as sum three paths (1->2->4), (1->3->5) and (1->3->6) + 1 -> 2 -> 4 -> 5 -> 6 -> 7 -> 3 " -My notes: interesting. No notes on how to represent binary tree, or how -to input it from the command line, but I think we did this in an earlier task. -Oh yes, challenge 56 was also about path summing over binary trees, but that time -we were looking for a specific path sum, whereas now we're summing all the path sums.. -so let's reuse most of that mechanism. +My notes: again with the binary trees - no notes on representation, so I'll reuse the one I've used before. +I think the "flatten to a linked list object" means "perform a pre-order traversal producing a list". diff --git a/challenge-094/duncan-c-white/perl/ch-1.pl b/challenge-094/duncan-c-white/perl/ch-1.pl new file mode 100755 index 0000000000..96870a80c0 --- /dev/null +++ b/challenge-094/duncan-c-white/perl/ch-1.pl @@ -0,0 +1,65 @@ +#!/usr/bin/perl +# +# Task 1: "Group Anagrams +# +# You are given an array of strings @S. +# +# Write a script to group sets of Anagrams (containing the same letters), the order of the anagram-sets doesn't matter. +# +# An Anagram is a word or phrase formed by rearranging the letters of a different word or phrase, typically using all the original letters exactly once. +# +# Example 1: +# +# Input: ("opt", "bat", "saw", "tab", "pot", "top", "was") +# Output: [ ("bat", "tab"), +# ("saw", "was"), +# ("top", "pot", "opt") ] +# +# Example 2: +# +# Input: ("x") +# Output: [ ("x") ] +# " +# +# My notes: yippee! Good old "Programming Pearls" by Jon Bentley tackled a +# very similar problem, using SIGNATURES (the sorted bag of letters contained +# in a word) - all anagrams with the same signature by definition form part +# of the same anagram group. Time for a Perfect Data Structure: +# +# "this problem would be trivial if only we could build a data structure +# mapping from a signature to a list of all the words with that signature". +# +# Ok, let's build that then: a HoA. +# + +use strict; +use warnings; +use feature 'say'; +use Getopt::Long; +use Data::Dumper; + +my $debug = 0; +die "Usage: anagram-groups [--debug] W1 W2...Wn\n" unless + GetOptions( "debug" => \$debug ) && + @ARGV>1; +my @w = @ARGV; + +my %perfect; # hash from signature to an array ref - words with that signature +foreach my $w (@w) +{ + # signature = sorted letters in $w + my $sig = join('', sort split( //, $w )); + + say "$w $sig" if $debug; + + my $aref = ($perfect{$sig} //= []); + + # add word to perfect{sig} + push @$aref, $w; +} + +# dispose of signatures (no longer need the keys - unusual) +my @v = values %perfect; + +# each element of @v is an arrayref of words: print each word comma-separated +say join(',',@$_) for @v; diff --git a/challenge-094/duncan-c-white/perl/ch-2.pl b/challenge-094/duncan-c-white/perl/ch-2.pl new file mode 100755 index 0000000000..ce9cdca3a8 --- /dev/null +++ b/challenge-094/duncan-c-white/perl/ch-2.pl @@ -0,0 +1,232 @@ +#!/usr/bin/perl +# +# 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. +# +# Example: +# +# Input: +# +# 1 +# / \ +# 2 3 +# / \ +# 4 5 +# / \ +# 6 7 +# +# Output: +# +# 1 -> 2 -> 4 -> 5 -> 6 -> 7 -> 3 +# " +# +# My notes: again with the binary trees - no notes on representation, so I'll reuse the one I've used before. +# I think the "flatten to a linked list object" means "perform a pre-order traversal producing a list". +# Challenges 56 and 93 had tasks about traversing binary trees, so let's reuse most of that mechanism. +# +# Notes from challenge 56: First obvious question is: how do we represent a binary tree. +# Let's go with.. a traditional Perl OO self-printing package inline in the main program. +# Second question: we'll need to parse a binary tree from the command line, +# so what text format do we want to represent a parsable binary tree on the command line? +# +# let's go with: +# (5,(4,(11,l7,l2),n),(8,l13,(9,n,1))) +# +# where: +# (N,L,R) represents a node with value N, left tree L and right tree R; +# lN represents a leaf with value N +# n represents nil +# +# let's go with that form.. of course, you'll need to single quote the command line arguments +# as () are treated specially by Unix shells. +# +# In our form, the Example is: +# +# Invoke as: ./ch-2.pl '(1,(2,l4,(5,l6,l7)),l3)' +# Expected Output: 1 2 4 5 6 7 3 +# +use strict; +use warnings; +use feature 'say'; +use Getopt::Long; +use Function::Parameters; +use Data::Dumper; + + +my $debug=0; +die "Usage: flatten-tree-list [--debug] bin-tree\n" unless GetOptions( "debug" => \$debug ) && @ARGV==1; +my $treestr = shift; + + +package BinTree; + +# Part 1 of the problem: being able to represent a Bin Tree, +# and parsing a string representation of one. + +use overload '""' => \&as_string; + +# +# my $bintree = BinTree->node( $n, $l, $r ); +# create a BinTree node with number $n, left tree $l and right tree $r. +# +method node($class: $n, $l, $r ) +{ + return bless [ + 'node', $n, $l, $r + ], $class; +} + +# +# my $bintree = BinTree->leaf( $n ); +# create a BinTree leaf with number $n. +# +method leaf($class: $n ) +{ + return bless [ + 'leaf', $n + ], $class; +} + +# +# my $bintree = BinTree->nil(); +# create a BinTree nil. +# +method nil($class:) +{ + return bless [ + 'nil' + ], $class; +} + +# +# my $bintree = BinTree->parse( $str ); +# Build a new BinTree by parsing the whole of $str. +# An example binary tree string might be: +# (5,(4,(11,l7,l2),n),(8,l13,(9,n,1))) +# die if $str is not a valid representation of the a BinTree. +# +method parse( $str ) +{ + $str =~ s/\s+//; + my( $bintree, $leftover ) = BinTree->parse_rec( $str ); + die "BinTree->parse( $str ): '$leftover' left over at end\n" if $leftover; + return $bintree; +} + +# +# my( $bintree, $leftover ) = BinTree->parse_rec( $str ); +# Build a new BinTree by parsing $str, telling us what suffix of $str is leftover (in $leftover). +# die if $str is not a valid representation of the a BinTree. +# +method parse_rec( $str ) +{ + return ( BinTree->nil(), $str ) if $str =~ s/^n//; + return ( BinTree->leaf($1), $str ) if $str =~ s/^l(\d+)//; + + # node: format (\d+,tree,tree) + die "BinTree->parse_rec( $str ): 'n', 'l', or '(' expected\n" unless $str =~ s/^\(//; + + # what's left: \d+,tree,tree) + die "BinTree->parse_rec( $str ): digit expected\n" unless $str =~ s/^(\d+)//; + my $n = $1; + + # what's left: ,tree,tree) + die "BinTree->parse( $str ): ',' expected (after number)\n" unless $str =~ s/^,//; + + # what's left: tree,tree) + my( $l, $leftover ) = BinTree->parse_rec( $str ); + + # what's left: ,tree) + die "BinTree->parse( $leftover ): ',' expected (after left sub tree)\n" unless $leftover =~ s/^,//; + + # what's left: tree) + my( $r, $rest ) = BinTree->parse_rec( $leftover ); + + die "BinTree->parse( $str ): ')' expected\n" unless $rest =~ s/\)//; + + return ( BinTree->node( $n, $l, $r ), $rest ); +} + +# +# my( $kind, @pieces ) = $bintree->breakapart(); +# Break the given $bintree apart into it's "kind" (node,left or nil), +# and it's array of pieces.. +# +method breakapart() +{ + die "bintree->breakapart: given bintree not an array; actually ", Dumper($self) unless ref($self) eq "BinTree"; + return @$self; +} + +# +# my $str = $bintree->as_string(); +# return the given $bintree as a nice printable string. +# +sub as_string($) +{ + my( $self ) = @_; + + die "bintree->as_string: given bintree not an array; actually ", Dumper($self) unless ref($self) eq "BinTree"; + my @x = @$self; + my $kind = shift @x; + if( $kind eq "node" ) + { + my( $n, $l, $r ) = @x; + $l = $l->as_string(); + $r = $r->as_string(); + return "($n,$l,$r)"; + } elsif( $kind eq "leaf" ) + { + my( $n ) = @x; + return "l$n"; + } elsif( $kind eq "nil" ) + { + return "n"; + } else + { + die "bintree->as_string: given bintree has impossible kind $kind\n"; + } +} + + +package main; + +my $bintree = BinTree->parse( $treestr ); +say "tree is $bintree"; + +# Part 2 of the problem: produce a list, pre-order traversal +my @l; +preorder( $bintree, \@l ); +say join(',',@l); + + +# +# preorder( $bintree, $aref ); +# Traverse $bintree in pre-order fashion (visiting the number in a node, +# then everything in the left subtree, then everything in the right +# subtree), appending every leaf and node value onto @$aref. +# +fun preorder( $bintree, $aref ) +{ + my( $kind, @pieces ) = $bintree->breakapart(); + if( $kind eq "node" ) + { + my( $n, $l, $r ) = @pieces; + push @$aref, $n; + preorder( $l, $aref ); + preorder( $r, $aref ); + + } elsif( $kind eq "leaf" ) + { + my( $n ) = @pieces; + push @$aref, $n; + } elsif( $kind eq "nil" ) + { + } else + { + die "bintree->preorder: given bintree has impossible kind $kind: ", Dumper($bintree); + } +} |