diff options
| -rwxr-xr-x | challenge-335/mattneleigh/perl/ch-1.pl | 108 | ||||
| -rwxr-xr-x | challenge-335/mattneleigh/perl/ch-2.pl | 171 |
2 files changed, 279 insertions, 0 deletions
diff --git a/challenge-335/mattneleigh/perl/ch-1.pl b/challenge-335/mattneleigh/perl/ch-1.pl new file mode 100755 index 0000000000..df17a09b72 --- /dev/null +++ b/challenge-335/mattneleigh/perl/ch-1.pl @@ -0,0 +1,108 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use English; + +################################################################################ +# Begin main execution +################################################################################ + +my @word_lists = ( + [ "bella", "label", "roller" ], + [ "cool", "lock", "cook" ], + [ "hello", "world", "pole" ], + [ "abc", "def", "ghi" ], + [ "aab", "aac", "aaa" ] +); + +print("\n"); +foreach my $word_list (@word_lists){ + printf( + "Input: \@words = (%s)\nOutput: (%s)\n\n", + join( + ", ", + map( + "\"" . $_ . "\"", + @{$word_list} + ) + ), + join( + ", ", + map( + "\"" . $_ . "\"", + present_in_all_words(@{$word_list}) + ) + ) + ); +} + +exit(0); +################################################################################ +# End main execution; subroutines follow +################################################################################ + + + +################################################################################ +# Given an list of words, determine which letters are common to every word in +# the list. If a letter appears twice or more in each word, it will appear in +# the output that number of times; if there are no common letters among the +# supplied words, an empty list will be returned. +# Takes one argument: +# * The list of words to examine (e.g. ("bella", "label", "roller") ) +# Returns: +# * A sorted list of letters common to all words in the supplied list, +# including multiple instances of letters that appear more than once in all +# words (e.g. ("e", "l", "l") ) +################################################################################ +sub present_in_all_words{ + # Split all words into arrays of their component + # letters + my @words = map( + [ sort(split('', $_)) ], + @ARG + ); + + my @common; + my $letter; + my $word; + my $count; + my $i; + + # Loop while there are remaining letters from + # the first word + while(@{$words[0]}){ + # Extract the next letter from the first word + $letter = shift(@{$words[0]}); + $count = 0; + + # Examine all subsequent words + foreach $word (@words[1 .. $#words]){ + # Examine the remaining letters in the current + # word + for $i (0 .. $#$word){ + if($word->[$i] eq $letter){ + # This letter was a match- remove it from the + # current word, add to the count, and move on to + # the next word + splice(@{$word}, $i, 1); + $count++; + last; + } + } + } + + # If this letter was seen in all subsequent + # words, add it to the list of common letters + push(@common, $letter) + if($count == (scalar(@words) - 1)); + } + + # Return the sorted list of common letters + return(sort(@common)); + +} + + + diff --git a/challenge-335/mattneleigh/perl/ch-2.pl b/challenge-335/mattneleigh/perl/ch-2.pl new file mode 100755 index 0000000000..aba4c4a671 --- /dev/null +++ b/challenge-335/mattneleigh/perl/ch-2.pl @@ -0,0 +1,171 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use English; + +################################################################################ +# Begin main execution +################################################################################ + +my @games = ( + [ [0, 0], [2, 0], [1, 1], [2, 1], [2, 2] ], + [ [0, 0], [1, 1], [0, 1], [0, 2], [1, 0], [2, 0] ], + [ [0, 0], [1, 1], [2, 0], [1, 0], [1, 2], [2, 1], [0, 1], [0, 2], [2, 2] ], + [ [0, 0], [1, 1] ], + [ [1, 1], [0, 0], [2, 2], [0, 1], [1, 0], [0, 2] ] +); + +print("\n"); +foreach my $game (@games){ + my @output = game_analyzer(@{$game}); + my $winner; + + if($output[0] eq "D"){ + $winner = "A STRANGE GAME. THE ONLY WINNING MOVE IS NOT TO PLAY."; + } elsif($output[0] eq "P"){ + $winner = "Pending"; + } else{ + $winner = $output[0]; + } + + printf( + "Input: \@moves = (%s)\nOutput: %s\n\nGame Board:\n\n%s\n\n\n", + join( + ", ", + map( + "[ ". join(", ", @{$_}) . " ]", + @{$game} + ) + ), + $winner, + join( + "\n", + map( + "[ " . join(" ", @{$_}) . " ]", + @{$output[1]} + ) + ) + ); +} + +exit(0); +################################################################################ +# End main execution; subroutines follow +################################################################################ + + + +################################################################################ +# Analyze the outcome of a series of moves in a game of Tic Tac Toe, declaring +# the winner, if any, or whether the game was a draw or is not yet complete +# Takes one argument: +# * A list of moves in the game, starting with X's first move, then O's first +# move, etc. (e.g. ([0, 0], [2, 0], [1, 1], [2, 1], [2, 2]) ) +# Returns: +# * A ref to an array containing two fields: +# 0: A letter that indicates the outcome of the analysis: +# - "D" if the game is a draw +# - "O" if O has won the game +# - "P" if the outcome of the game is still pending +# - "X" if X has won the game +# 1: A ref to a two dimensional array of characters representing the game +# board as described by the supplied list of moves, where underscores +# represent unused squares +# (e.g. +# [ +# "X", +# [ +# [ "X", "_", "_" ], +# [ "_", "X", "_" ], +# [ "O", "O", "X" ] +# ] +# ] +# ) +################################################################################ +sub game_analyzer{ + + my @board = ( + [ "_", "_", "_" ], + [ "_", "_", "_" ], + [ "_", "_", "_" ] + ); + my $pending = 0; + + # Apply the supplied moves to the game board + # for illustrative purposes- we borrow the + # $pending variable for a moment to determine + # player identity + foreach my $move (@ARG){ + $board[$move->[0]][$move->[1]] = $pending ? "O" : "X"; + $pending ^= 1; + } + + $pending = 0; + + for my $n (0 .. 2){ + # Check for horizontal wins in row $n + if($board[$n][0] ne "_"){ + if(($board[$n][1] eq "_") || ($board[$n][2] eq "_")){ + $pending = 1; + } else{ + return($board[$n][0], \@board) + if( + ($board[$n][0] eq $board[$n][1]) + && + ($board[$n][0] eq $board[$n][2]) + ); + } + } else{ + $pending = 1; + } + + # Check for vertical wins in column $n + if($board[0][$n] ne "_"){ + if(($board[1][$n] eq "_") || ($board[2][$n] eq "_")){ + $pending = 1; + } else{ + return($board[0][$n], \@board) + if( + ($board[0][$n] eq $board[1][$n]) + && + ($board[0][$n] eq $board[2][$n]) + ); + } + } else{ + $pending = 1; + } + } + + # Check for diagonal wins- we will have already + # seen empty squares so we don't need to set the + # pending flag + if($board[0][0] ne "_"){ + return($board[0][0], \@board) + if( + ($board[0][0] eq $board[1][1]) + && + ($board[0][0] eq $board[2][2]) + ); + } + if($board[2][0] ne "_"){ + return($board[2][0], \@board) + if( + ($board[2][0] eq $board[1][1]) + && + ($board[2][0] eq $board[0][2]) + ); + } + + return( + $pending ? + "P" + : + "D", + \@board + ); + +} + + + |