Jump to content

24 game/Solve: Difference between revisions

Rename Perl 6 -> Raku, alphabetize, minor clean-up
(→‎Minimal version: marked incorrect)
(Rename Perl 6 -> Raku, alphabetize, minor clean-up)
Line 3,029:
Player24([3,3,8,8]);
"8383/-/"</lang>
 
 
=={{header|Go}}==
Line 4,849 ⟶ 4,848:
 
E:\Temp></pre>
 
=={{header|Perl 6}}==
 
===With EVAL===
A loose translation of the Perl entry. Does not return every possible permutation of the possible solutions. Filters out duplicates (from repeated digits) and only reports the solution for a particular order of digits and operators with the fewest parenthesis (avoids reporting duplicate solutions only differing by unnecessary parenthesis). Does not guarantee the order in which results are returned.
 
Since Perl 6 uses Rational numbers for division (whenever possible) there is no loss of precision as is common with floating point division. So a comparison like (1 + 7) / (1 / 3) == 24 "Just Works"<sup>&trade;</sup>
 
<lang perl6>use MONKEY-SEE-NO-EVAL;
 
my @digits;
my $amount = 4;
 
# Get $amount digits from the user,
# ask for more if they don't supply enough
while @digits.elems < $amount {
@digits.append: (prompt "Enter {$amount - @digits} digits from 1 to 9, "
~ '(repeats allowed): ').comb(/<[1..9]>/);
}
# Throw away any extras
@digits = @digits[^$amount];
 
# Generate combinations of operators
my @ops = [X,] <+ - * /> xx 3;
 
# Enough sprintf formats to cover most precedence orderings
my @formats = (
'%d %s %d %s %d %s %d',
'(%d %s %d) %s %d %s %d',
'(%d %s %d %s %d) %s %d',
'((%d %s %d) %s %d) %s %d',
'(%d %s %d) %s (%d %s %d)',
'%d %s (%d %s %d %s %d)',
'%d %s (%d %s (%d %s %d))',
);
 
# Brute force test the different permutations
(unique @digits.permutations).race.map: -> @p {
for @ops -> @o {
for @formats -> $format {
my $string = sprintf $format, flat roundrobin(|@p; |@o);
my $result = EVAL($string);
say "$string = 24" and last if $result and $result == 24;
}
}
}
 
# Only return unique sub-arrays
sub unique (@array) {
my %h = map { $_.Str => $_ }, @array;
%h.values;
}</lang>
 
{{out}}
<pre>
Enter 4 digits from 1 to 9, (repeats allowed): 3711
(1 + 7) * 3 * 1 = 24
(1 + 7) * 3 / 1 = 24
(1 * 3) * (1 + 7) = 24
3 * (1 + 1 * 7) = 24
(3 * 1) * (1 + 7) = 24
3 * (1 / 1 + 7) = 24
(3 / 1) * (1 + 7) = 24
3 / (1 / (1 + 7)) = 24
(1 + 7) * 1 * 3 = 24
(1 + 7) / 1 * 3 = 24
(1 + 7) / (1 / 3) = 24
(1 * 7 + 1) * 3 = 24
(7 + 1) * 3 * 1 = 24
(7 + 1) * 3 / 1 = 24
(7 - 1) * (3 + 1) = 24
(1 + 1 * 7) * 3 = 24
(1 * 1 + 7) * 3 = 24
(1 / 1 + 7) * 3 = 24
(3 + 1) * (7 - 1) = 24
3 * (1 + 7 * 1) = 24
3 * (1 + 7 / 1) = 24
(3 * 1) * (7 + 1) = 24
(3 / 1) * (7 + 1) = 24
3 / (1 / (7 + 1)) = 24
(1 + 3) * (7 - 1) = 24
(1 * 3) * (7 + 1) = 24
(7 + 1) * 1 * 3 = 24
(7 + 1) / 1 * 3 = 24
(7 + 1) / (1 / 3) = 24
(7 - 1) * (1 + 3) = 24
(7 * 1 + 1) * 3 = 24
(7 / 1 + 1) * 3 = 24
3 * (7 + 1 * 1) = 24
3 * (7 + 1 / 1) = 24
3 * (7 * 1 + 1) = 24
3 * (7 / 1 + 1) = 24
 
Enter 4 digits from 1 to 9, (repeats allowed): 5 5 5 5
5 * 5 - 5 / 5 = 24
 
Enter 4 digits from 1 to 9, (repeats allowed): 8833
8 / (3 - 8 / 3) = 24
</pre>
 
===No EVAL===
Alternately, a version that doesn't use EVAL. More general case. Able to handle 3 or 4 integers, able to select the goal value.
 
<lang perl6>my %*SUB-MAIN-OPTS = :named-anywhere;
 
sub MAIN (*@parameters, Int :$goal = 24) {
my @numbers;
if +@parameters == 1 {
@numbers = @parameters[0].comb(/\d/);
USAGE() and exit unless 2 < @numbers < 5;
} elsif +@parameters > 4 {
USAGE() and exit;
} elsif +@parameters == 3|4 {
@numbers = @parameters;
USAGE() and exit if @numbers.any ~~ /<-[-\d]>/;
} else {
USAGE();
exit if +@parameters == 2;
@numbers = 3,3,8,8;
say 'Running demonstration with: ', |@numbers, "\n";
}
solve @numbers, $goal
}
 
sub solve (@numbers, $goal = 24) {
my @operators = < + - * / >;
my @ops = [X] @operators xx (@numbers - 1);
my @perms = @numbers.permutations.unique( :with(&[eqv]) );
my @order = (^(@numbers - 1)).permutations;
my @sol;
@sol[250]; # preallocate some stack space
 
my $batch = ceiling +@perms/4;
 
my atomicint $i;
@perms.race(:batch($batch)).map: -> @p {
for @ops -> @o {
for @order -> @r {
my $result = evaluate(@p, @o, @r);
@sol[$i⚛++] = $result[1] if $result[0] and $result[0] == $goal;
}
}
}
@sol.=unique;
say @sol.join: "\n";
my $pl = +@sol == 1 ?? '' !! 's';
my $sg = $pl ?? '' !! 's';
say +@sol, " equation{$pl} evaluate{$sg} to $goal using: {@numbers}";
}
 
sub evaluate ( @digit, @ops, @orders ) {
my @result = @digit.map: { [ $_, $_ ] };
my @offset = 0 xx +@orders;
 
for ^@orders {
my $this = @orders[$_];
my $order = $this - @offset[$this];
my $op = @ops[$this];
my $result = op( $op, @result[$order;0], @result[$order+1;0] );
return [ NaN, Str ] unless defined $result;
my $string = "({@result[$order;1]} $op {@result[$order+1;1]})";
@result.splice: $order, 2, [ $[ $result, $string ] ];
@offset[$_]++ if $order < $_ for ^@offset;
}
@result[0];
}
 
multi op ( '+', $m, $n ) { $m + $n }
multi op ( '-', $m, $n ) { $m - $n }
multi op ( '/', $m, $n ) { $n == 0 ?? fail() !! $m / $n }
multi op ( '*', $m, $n ) { $m * $n }
 
my $txt = "\e[0;96m";
my $cmd = "\e[0;92m> {$*EXECUTABLE-NAME} {$*PROGRAM-NAME}";
sub USAGE {
say qq:to
'========================================================================'
{$txt}Supply 3 or 4 integers on the command line, and optionally a value
to equate to.
 
Integers may be all one group: {$cmd} 2233{$txt}
Or, separated by spaces: {$cmd} 2 4 6 7{$txt}
 
If you wish to supply multi-digit or negative numbers, you must
separate them with spaces: {$cmd} -2 6 12{$txt}
 
If you wish to use a different equate value,
supply a new --goal parameter: {$cmd} --goal=17 2 -3 1 9{$txt}
 
If you don't supply any parameters, will use 24 as the goal, will run a
demo and will show this message.\e[0m
========================================================================
}</lang>
{{out}}
When supplied 1399 on the command line:
<pre>(((9 - 1) / 3) * 9)
((9 - 1) / (3 / 9))
((9 / 3) * (9 - 1))
(9 / (3 / (9 - 1)))
((9 * (9 - 1)) / 3)
(9 * ((9 - 1) / 3))
(((9 - 1) * 9) / 3)
((9 - 1) * (9 / 3))
8 equations evaluate to 24 using: 1 3 9 9</pre>
 
=={{header|Phix}}==
Line 5,956 ⟶ 5,751:
[8, 7, 9, 7] : No solution found
[9, 4, 4, 5] : No solution found</pre>
 
 
=={{header|R}}==
Line 6,072 ⟶ 5,866:
 
In order to find just one solution effectively one needs to change <tt>for*/list</tt> to <tt>for*/first</tt> in the function <tt>find-solutions</tt>.
 
=={{header|Raku}}==
(formerly Perl 6)
 
===With EVAL===
A loose translation of the Perl entry. Does not return every possible permutation of the possible solutions. Filters out duplicates (from repeated digits) and only reports the solution for a particular order of digits and operators with the fewest parenthesis (avoids reporting duplicate solutions only differing by unnecessary parenthesis). Does not guarantee the order in which results are returned.
 
Since Perl 6 uses Rational numbers for division (whenever possible) there is no loss of precision as is common with floating point division. So a comparison like (1 + 7) / (1 / 3) == 24 "Just Works"<sup>&trade;</sup>
 
<lang perl6>use MONKEY-SEE-NO-EVAL;
 
my @digits;
my $amount = 4;
 
# Get $amount digits from the user,
# ask for more if they don't supply enough
while @digits.elems < $amount {
@digits.append: (prompt "Enter {$amount - @digits} digits from 1 to 9, "
~ '(repeats allowed): ').comb(/<[1..9]>/);
}
# Throw away any extras
@digits = @digits[^$amount];
 
# Generate combinations of operators
my @ops = [X,] <+ - * /> xx 3;
 
# Enough sprintf formats to cover most precedence orderings
my @formats = (
'%d %s %d %s %d %s %d',
'(%d %s %d) %s %d %s %d',
'(%d %s %d %s %d) %s %d',
'((%d %s %d) %s %d) %s %d',
'(%d %s %d) %s (%d %s %d)',
'%d %s (%d %s %d %s %d)',
'%d %s (%d %s (%d %s %d))',
);
 
# Brute force test the different permutations
(unique @digits.permutations).race.map: -> @p {
for @ops -> @o {
for @formats -> $format {
my $string = sprintf $format, flat roundrobin(|@p; |@o);
my $result = EVAL($string);
say "$string = 24" and last if $result and $result == 24;
}
}
}
 
# Only return unique sub-arrays
sub unique (@array) {
my %h = map { $_.Str => $_ }, @array;
%h.values;
}</lang>
 
{{out}}
<pre>
Enter 4 digits from 1 to 9, (repeats allowed): 3711
(1 + 7) * 3 * 1 = 24
(1 + 7) * 3 / 1 = 24
(1 * 3) * (1 + 7) = 24
3 * (1 + 1 * 7) = 24
(3 * 1) * (1 + 7) = 24
3 * (1 / 1 + 7) = 24
(3 / 1) * (1 + 7) = 24
3 / (1 / (1 + 7)) = 24
(1 + 7) * 1 * 3 = 24
(1 + 7) / 1 * 3 = 24
(1 + 7) / (1 / 3) = 24
(1 * 7 + 1) * 3 = 24
(7 + 1) * 3 * 1 = 24
(7 + 1) * 3 / 1 = 24
(7 - 1) * (3 + 1) = 24
(1 + 1 * 7) * 3 = 24
(1 * 1 + 7) * 3 = 24
(1 / 1 + 7) * 3 = 24
(3 + 1) * (7 - 1) = 24
3 * (1 + 7 * 1) = 24
3 * (1 + 7 / 1) = 24
(3 * 1) * (7 + 1) = 24
(3 / 1) * (7 + 1) = 24
3 / (1 / (7 + 1)) = 24
(1 + 3) * (7 - 1) = 24
(1 * 3) * (7 + 1) = 24
(7 + 1) * 1 * 3 = 24
(7 + 1) / 1 * 3 = 24
(7 + 1) / (1 / 3) = 24
(7 - 1) * (1 + 3) = 24
(7 * 1 + 1) * 3 = 24
(7 / 1 + 1) * 3 = 24
3 * (7 + 1 * 1) = 24
3 * (7 + 1 / 1) = 24
3 * (7 * 1 + 1) = 24
3 * (7 / 1 + 1) = 24
 
Enter 4 digits from 1 to 9, (repeats allowed): 5 5 5 5
5 * 5 - 5 / 5 = 24
 
Enter 4 digits from 1 to 9, (repeats allowed): 8833
8 / (3 - 8 / 3) = 24
</pre>
 
===No EVAL===
Alternately, a version that doesn't use EVAL. More general case. Able to handle 3 or 4 integers, able to select the goal value.
 
<lang perl6>my %*SUB-MAIN-OPTS = :named-anywhere;
 
sub MAIN (*@parameters, Int :$goal = 24) {
my @numbers;
if +@parameters == 1 {
@numbers = @parameters[0].comb(/\d/);
USAGE() and exit unless 2 < @numbers < 5;
} elsif +@parameters > 4 {
USAGE() and exit;
} elsif +@parameters == 3|4 {
@numbers = @parameters;
USAGE() and exit if @numbers.any ~~ /<-[-\d]>/;
} else {
USAGE();
exit if +@parameters == 2;
@numbers = 3,3,8,8;
say 'Running demonstration with: ', |@numbers, "\n";
}
solve @numbers, $goal
}
 
sub solve (@numbers, $goal = 24) {
my @operators = < + - * / >;
my @ops = [X] @operators xx (@numbers - 1);
my @perms = @numbers.permutations.unique( :with(&[eqv]) );
my @order = (^(@numbers - 1)).permutations;
my @sol;
@sol[250]; # preallocate some stack space
 
my $batch = ceiling +@perms/4;
 
my atomicint $i;
@perms.race(:batch($batch)).map: -> @p {
for @ops -> @o {
for @order -> @r {
my $result = evaluate(@p, @o, @r);
@sol[$i⚛++] = $result[1] if $result[0] and $result[0] == $goal;
}
}
}
@sol.=unique;
say @sol.join: "\n";
my $pl = +@sol == 1 ?? '' !! 's';
my $sg = $pl ?? '' !! 's';
say +@sol, " equation{$pl} evaluate{$sg} to $goal using: {@numbers}";
}
 
sub evaluate ( @digit, @ops, @orders ) {
my @result = @digit.map: { [ $_, $_ ] };
my @offset = 0 xx +@orders;
 
for ^@orders {
my $this = @orders[$_];
my $order = $this - @offset[$this];
my $op = @ops[$this];
my $result = op( $op, @result[$order;0], @result[$order+1;0] );
return [ NaN, Str ] unless defined $result;
my $string = "({@result[$order;1]} $op {@result[$order+1;1]})";
@result.splice: $order, 2, [ $[ $result, $string ] ];
@offset[$_]++ if $order < $_ for ^@offset;
}
@result[0];
}
 
multi op ( '+', $m, $n ) { $m + $n }
multi op ( '-', $m, $n ) { $m - $n }
multi op ( '/', $m, $n ) { $n == 0 ?? fail() !! $m / $n }
multi op ( '*', $m, $n ) { $m * $n }
 
my $txt = "\e[0;96m";
my $cmd = "\e[0;92m> {$*EXECUTABLE-NAME} {$*PROGRAM-NAME}";
sub USAGE {
say qq:to
'========================================================================'
{$txt}Supply 3 or 4 integers on the command line, and optionally a value
to equate to.
 
Integers may be all one group: {$cmd} 2233{$txt}
Or, separated by spaces: {$cmd} 2 4 6 7{$txt}
 
If you wish to supply multi-digit or negative numbers, you must
separate them with spaces: {$cmd} -2 6 12{$txt}
 
If you wish to use a different equate value,
supply a new --goal parameter: {$cmd} --goal=17 2 -3 1 9{$txt}
 
If you don't supply any parameters, will use 24 as the goal, will run a
demo and will show this message.\e[0m
========================================================================
}</lang>
{{out}}
When supplied 1399 on the command line:
<pre>(((9 - 1) / 3) * 9)
((9 - 1) / (3 / 9))
((9 / 3) * (9 - 1))
(9 / (3 / (9 - 1)))
((9 * (9 - 1)) / 3)
(9 * ((9 - 1) / 3))
(((9 - 1) * 9) / 3)
((9 - 1) * (9 / 3))
8 equations evaluate to 24 using: 1 3 9 9</pre>
 
=={{header|REXX}}==
10,333

edits

Cookies help us deliver our services. By using our services, you agree to our use of cookies.