Add Perl solution to challenge 005

Remove one-letter solutions from challenge 004 task 2

4 files changed, 124 insertions, 0 deletions

diff --git a/challenge-005/paulo-custodio/README b/challenge-005/paulo-custodio/README
new file mode 100644
index 0000000000..87dc0b2fbd
--- /dev/null
+++ b/challenge-005/paulo-custodio/README
@@ -0,0 +1 @@
+Solution by Paulo Custodio
diff --git a/challenge-005/paulo-custodio/perl/ch-1.pl b/challenge-005/paulo-custodio/perl/ch-1.pl
new file mode 100644
index 0000000000..874695ca27
--- /dev/null
+++ b/challenge-005/paulo-custodio/perl/ch-1.pl
@@ -0,0 +1,32 @@
+#!/usr/bin/perl
+
+# Challenge 005
+# 
+# Challenge #1
+# Write a program which prints out all anagrams for a given word. For more information about Anagram, please check this wikipedia page.
+# create a hash of all words in dictionary where key is sorted list of letters
+# therefore two anagrams have the same key
+
+
+use strict;
+use warnings;
+use 5.030;
+
+# get input
+my($word) = @ARGV;
+my $word_key = word_key($word);
+
+# read dictionary and print words that match key set
+open(my $fh, "<", "words.txt") or die "open words.txt: $!\n";
+while (<$fh>) {
+	chomp;
+	next if /\W/;
+	say lc($_) if $word_key eq word_key($_);
+}
+
+sub word_key {
+	my($word) = @_;
+	$word =~ s/\W//g;
+	my @letters = sort split //, lc($word);
+	return join '', @letters;
+}
diff --git a/challenge-005/paulo-custodio/perl/ch-2.pl b/challenge-005/paulo-custodio/perl/ch-2.pl
new file mode 100644
index 0000000000..f7b14b70c7
--- /dev/null
+++ b/challenge-005/paulo-custodio/perl/ch-2.pl
@@ -0,0 +1,39 @@
+#!/usr/bin/perl
+
+# Challenge 005
+# 
+# Challenge #2
+# Write a program to find the sequence of characters that has the most anagrams.
+#
+# create a hash of all words in dictionary where key is sorted list of letters
+# therefore two anagrams have the same key
+
+use strict;
+use warnings;
+use 5.030;
+
+
+# read dictionary, count number of keys, i.e. anagrams
+my %anagrams;
+my $max_anagrams = 0;
+open(my $fh, "<", "words.txt") or die "open words.txt: $!\n";
+while (<$fh>) {
+	chomp;
+	next if /\W/;
+	next if length($_) < 2;
+	my $num_anagrams = ++$anagrams{word_key($_)};
+	$max_anagrams = $num_anagrams if $max_anagrams < $num_anagrams;
+}
+
+# output all sequences with $max_anagrams
+say "Maximum of $max_anagrams anagrams";
+for (sort keys %anagrams) {
+	say $_ if $anagrams{$_} == $max_anagrams;
+}
+
+sub word_key {
+	my($word) = @_;
+	$word =~ s/\W//g;
+	my @letters = sort split //, lc($word);
+	return join '', @letters;
+}
diff --git a/challenge-005/paulo-custodio/test.pl b/challenge-005/paulo-custodio/test.pl
new file mode 100644
index 0000000000..622b090524
--- /dev/null
+++ b/challenge-005/paulo-custodio/test.pl
@@ -0,0 +1,52 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+use 5.030;
+
+# build list of words for testing
+ok 0==system("aspell -d en dump master | aspell -l en expand > words.txt");
+
+is capture("perl perl/ch-1.pl binary"), <<END;
+binary
+brainy
+END
+
+is capture("perl perl/ch-1.pl live"), <<END;
+evil
+levi
+live
+veil
+vile
+END
+
+is capture("perl perl/ch-1.pl casper"), <<END;
+capers
+crapes
+parsec
+pacers
+recaps
+scrape
+spacer
+casper
+END
+
+
+is capture("perl perl/ch-2.pl"), <<END;
+Maximum of 8 anagrams
+aceprs
+aels
+aelst
+aerst
+egor
+END
+
+done_testing;
+
+sub capture {
+	my($cmd) = @_;
+	my $out = `$cmd`;
+	$out =~ s/[ \t\v\f\r]*\n/\n/g;
+	return $out;
+}