From a9192e616b43c223f2f6fc0d39a243fad515a030 Mon Sep 17 00:00:00 2001 From: jluehrs2 Date: Fri, 1 Feb 2008 19:32:16 -0500 Subject: add shared_letters and shared_letters_by_position for mastermind style string comparisons --- lib/Games/Word.pm | 42 +++++++++++++++++++++++++++++++++++++++++- 1 file changed, 41 insertions(+), 1 deletion(-) 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 - ??? -- cgit v1.2.3-54-g00ecf