Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

best-of-rosettacode/24-game.pl

  • Loading branch information...
commit 677edbdc0f82834c9eece4d5ef8c28c4ca459253 1 parent f633530
@sergot sergot authored
Showing with 74 additions and 0 deletions.
  1. +74 −0 best-of-rosettacode/24-game.pl
View
74 best-of-rosettacode/24-game.pl
@@ -0,0 +1,74 @@
+=begin pod
+
+=head1 24 game
+
+ The 24 Game tests one's mental arithmetic.
+ Write a program that randomly chooses and displays four digits, each from one to nine, with repetitions allowed. The program should prompt for the player to enter an equation using just those, and all of those four digits. The program should check then evaluate the expression. The goal is for the player to enter an expression that evaluates to 24.
+ Only multiplication, division, addition, and subtraction operators/functions are allowed.
+ Division should use floating point or rational arithmetic, etc, to preserve remainders.
+ Brackets are allowed, if using an infix expression evaluator.
+ Forming multiple digit numbers from the supplied digits is disallowed. (So an answer of 12+12 when given 1, 2, 2, and 1 is wrong).
+ The order of the digits when given does not have to be preserved.
+ Note:
+ The type of expression evaluator used is not mandated. An RPN evaluator is equally acceptable for example.
+ The task is not for the program to generate the expression, or test whether an expression is even possible.
+
+=head1 More
+ http://rosettacode.org/wiki/24_game#Perl_6
+
+=head1 What's interesting here?
+
+=item grammar
+=item eval
+=item prompt
+=item roll
+=item casting
+
+=end pod
+
+grammar Exp24 {
+ token TOP { ^ <exp> $ }
+ token exp { <term> [ <op> <term> ]* }
+ token term { '(' <exp> ')' | \d }
+ token op { '+' | '-' | '*' | '/' }
+}
+
+my @digits = roll 4, 1..9; # to a gamer, that's a "4d9" roll
+say "Here's your digits: {@digits}";
+
+while my $exp = prompt "\n24-Exp? " {
+ unless is-valid($exp, @digits) {
+ say "Sorry, your expression is not valid!";
+ next;
+ }
+
+ my $value = eval $exp;
+ say "$exp = $value";
+ if $value == 24 {
+ say "You win!";
+ last;
+ }
+ say "Sorry, your expression doesn't evaluate to 24!";
+}
+
+sub is-valid($exp, @digits) {
+ unless ?Exp24.parse($exp) {
+ say "Expression doesn't match rules!";
+ return False;
+ }
+
+ unless $exp.comb(/\d/).sort.join == @digits.sort.join {
+ say "Expression must contain digits {@digits} only!";
+ return False;
+ }
+
+ return True;
+}
+
+=begin pod
+
+=head1 Features used
+
+=item C<type casting> - L<http://perlcabal.org/syn/S13.html#Type_Casting>
+
+=end pod
Please sign in to comment.
Something went wrong with that request. Please try again.