Kata de boliche en Perl

dobeslao/README

@@ -0,0 +1,43 @@
+Kata de boliche
+===============
+
+La estructura de datos utilizada para almacenar los resultados del juego, es un arreglo de arreglos, 
+con los resultados de dos posibles tiros o tres en el caso de que se haya producido Spare o Strike
+en los ultimos tiros.
+
+por ejemplo:
+@jugada = ( [t1,t2], [t1,t2],[t1,t2],[t1,t2],[t1,t2],[t1,t2],[t1,t2],[t1,t2],[t1,t2],[t1,t2,t3] );
+
+@gutter_balls = ( [0,0], [0,0], [0,0], [0,0], [0,0], [0,0], [0,0], [0,0], [0,0], [0,0] );
+
+@spares = ( [5,5], [5,5], [5,5], [5,5], [5,5], [5,5], [5,5], [5,5], [5,5], [5,5,5] )
+
+@strikes = ( [10,0], [10,0], [10,0], [10,0], [10,0], [10,0], [10,0], [10,0], [10,0], [10,10,10] );
+
+Calculando el puntaje
+=====================
+
+Una buena expliacación sobre el sistema de calificación, disipa las dudas sobre como calificar en el ultimo frame.
+
+http://slocums.homestead.com/gamescore.html
+
+Ejecución
+=========
+
+Opcionalmente puede activarse el modo de depuración, editando el archivo 'bowling_func.pl' y poniendo en uno la variable '$VERBOSE'.
+
+$ vi bowling_func.pl
+  $VERBOSE = 1;
+
+Para realizar la ejecución de pruebas, mediante los siguiente pasos:
+
+$ chmod +x bowling.t
+$ ./bowling.t
+
+alternativamente
+
+$ perl bowling.t
+
+si se desea observar un resumen de las pruebas puede realizarse con:
+
+$ prove bowling.t

dobeslao/bowling.t

@@ -0,0 +1,63 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::Simple tests => 14;
+
+require 'bowling_func.pl';
+
+# Gutter Balls
+my @gutter_balls = ( [0,0],[0,0],[0,0],[0,0],[0,0],[0,0],[0,0],[0,0],[0,0],[0,0] );
+ok ( bowling(@gutter_balls) eq '0', "Gutter balls (all zero)" );
+
+# One Pins
+my @one_pin = ( [1,1],[1,1],[1,1],[1,1],[1,1],[1,1],[1,1],[1,1],[1,1],[1,1] );
+ok ( bowling(@one_pin) eq '20', "One pin per pass" );
+
+# All Threes
+my @all_threes = ( [3,3],[3,3],[3,3],[3,3],[3,3],[3,3],[3,3],[3,3],[3,3],[3,3] );
+ok ( bowling(@all_threes) eq '60', "All Threes" );
+
+# One Spare
+my @one_spare = ( [4,6],[0,6],[0,0],[0,0],[0,0],[0,0],[0,0],[0,0],[0,0],[0,0,] );
+ok ( bowling(@one_spare) eq '16', "One Spare in all game" );
+
+# All Spares
+my @all_spares = ( [4,6],[4,6],[4,6],[4,6],[4,6],[4,6],[4,6],[4,6],[4,6],[4,6,4] );
+ok ( bowling(@all_spares) eq '140', "All Spares with first ball as 4" );
+
+# All Spares with fives
+my @giveme_five = ( [5,5],[5,5],[5,5],[5,5],[5,5],[5,5],[5,5],[5,5],[5,5],[5,5,5] );
+ok ( bowling(@giveme_five) eq '150', "All Spares with all fives" );
+
+# Alternated Spares and Strikes
+my @spares_strike = ( [10,0],[4,6],[10,0],[4,6],[10,0],[4,6],[10,0],[4,6],[10,0],[4,6,10] );
+ok ( bowling(@spares_strike) eq '200', "Alternated Spares and Strikes" );
+
+# Open Turkey
+my @open_turkey = ( [10,0],[10,0],[10,0],[0,0],[0,0],[0,0],[0,0],[0,0],[0,0],[0,0] );
+ok ( bowling(@open_turkey) eq '60', "Open turkey" );
+
+# A l33t game
+my @l33t_game = ( [1,4],[4,5],[6,4],[5,5],[10,0],[0,1],[7,3],[6,4],[10,0],[2,8,6] );
+ok ( bowling(@l33t_game) eq '133', "A l33t game" );
+
+# Scorecard
+my @scorecard = ( [10,0],[7,3],[9,0],[10,0],[0,8],[8,2],[0,6],[10,0],[10,0],[10,8,1] );
+ok ( bowling(@scorecard) eq '167', "Another scorecard" );
+
+# Scorecard twist
+my @scorecard_twist = ( [10,0],[7,3],[9,0],[10,0],[0,8],[8,2],[0,6],[10,0],[10,0],[7,2] );
+ok ( bowling(@scorecard_twist) eq '145', "Scorecard twist" );
+
+# One Strike
+my @first_strike = ( [10,0],[3,4],[0,0],[0,0],[0,0],[0,0],[0,0],[0,0],[0,0],[0,0,] );
+ok ( bowling(@first_strike) eq '24', "One strike in total score" );
+
+# Nine Strikes
+my @nine_strikes = ( [10,0],[10,0],[10,0],[10,0],[10,0],[10,0],[10,0],[10,0],[10,0],[0,0] );
+ok ( bowling(@nine_strikes) eq '240', "Nine Strikes followed by a gutter ball" );
+
+# Golden Game
+my @golden_game = ( [10,0],[10,0],[10,0],[10,0],[10,0],[10,0],[10,0],[10,0],[10,0],[10,10,10] );
+ok ( bowling(@golden_game) eq '300', "Perfect game aka Golden Game" );

dobeslao/bowling_func.pl

@@ -0,0 +1,74 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+sub isStrike {
+	my @roll = @_;
+	return $roll[0] == 10;
+}
+
+sub isSpare {
+	my @roll = @_;
+	return getFrameScore(@roll) == 10;
+}
+
+sub getFrameScore {
+	my @roll = @_;
+	return $roll[0] + $roll[1];
+}
+
+sub getSpareBonus {
+	my @nextroll = @_;
+	return $nextroll[0];
+}
+
+sub getStrikeBonus {
+	my @nextroll = @_;
+	return $nextroll[0];
+}
+
+sub bowling {
+	my @line = @_;
+	my $score = 0;
+
+	my $VERBOSE = 0;
+
+	for my $frame (0..$#line) {
+
+		my @roll = @{$line[$frame]};
+		my @nextroll = $frame == $#line ? @roll [$#roll-1..$#roll] : @{$line[$frame+1]};
+
+		if (isStrike(@roll)) {
+			if ($VERBOSE) { print "Strike\n"; }
+
+			$score += 10; 
+			$score += getStrikeBonus(@nextroll);
+			$score += isStrike(@nextroll) && $frame < $#line-1 ? getStrikeBonus(@{$line[$frame+2]}) 
+									   : getStrikeBonus(@nextroll [1..1]);
+		}
+		elsif (isSpare(@roll)) {
+			if ($VERBOSE) { print "Spare\n"; }
+
+			if ($frame == $#line) { $nextroll[0] = $nextroll[1]; }
+			$score += 10 + getSpareBonus(@nextroll);
+		}
+		else {
+			if ($VERBOSE) { print "Roll\n"; }
+
+			$score += getFrameScore(@roll);
+		}
+
+		if ($VERBOSE) {
+			print "Game: " . ($frame+1) . " - ";
+			print "Score: " . $score . "\n";
+			foreach my $roll (0..$#{$line[$frame]}) {
+				print "Throw [$frame][$roll] = $line[$frame][$roll]\n";
+			}
+		}
+	}
+
+	return $score;
+}
+1;
+__END__