add shared_letters and shared_letters_by_position for mastermind style string comparisons

1 files changed, 41 insertions, 1 deletions

diff --git a/lib/Games/Word.pm b/lib/Games/Word.pm
index de51ad0..948828e 100644
--- a/lib/Games/Word.pm
+++ b/lib/Games/Word.pm
@@ -2,7 +2,8 @@
 package Games::Word;
 require Exporter;
 @ISA = qw/Exporter/;
-@EXPORT_OK = qw/random_permutation is_permutation all_permutations/;
+@EXPORT_OK = qw/random_permutation is_permutation all_permutations
+                shared_letters shared_letters_by_position/;
 
 use strict;
 use warnings;
@@ -48,6 +49,45 @@ sub all_permutations {
     return @ret;
 }
 
+sub shared_letters {
+    my @a = sort split //, shift;
+    my @b = sort split //, shift;
+
+    my @letters = ();
+    my ($a, $b) = (pop @a, pop @b);
+    while (defined $a && defined $b) {
+        if ($a eq $b) {
+            push @letters, $a;
+            ($a, $b) = (pop @a, pop @b);
+        }
+        elsif ($a lt $b) {
+            $a = pop @a;
+        }
+        else {
+            $b = pop @b;
+        }
+    }
+
+    return @letters;
+}
+
+sub shared_letters_by_position {
+    my @a = split //, shift;
+    my @b = split //, shift;
+
+    my @letters = ();
+    while (my ($a, $b) = (pop @a, pop @b)) {
+        if ($a eq $b) {
+            push @letters, $a;
+        }
+        else {
+            push @letters, undef;
+        }
+    }
+
+    return wantarray ? @letters : grep { defined } @letters;
+}
+
 =head1 NAME
 
 Games::Word - ???