24 game/Solve: Difference between revisions
Content added Content deleted
Thundergnat (talk | contribs) (→Minimal version: marked incorrect) |
Thundergnat (talk | contribs) (Rename Perl 6 -> Raku, alphabetize, minor clean-up) |
||
Line 3,029: | Line 3,029: | ||
Player24([3,3,8,8]); |
Player24([3,3,8,8]); |
||
"8383/-/"</lang> |
"8383/-/"</lang> |
||
=={{header|Go}}== |
=={{header|Go}}== |
||
Line 4,849: | Line 4,848: | ||
E:\Temp></pre> |
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>™</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}}== |
=={{header|Phix}}== |
||
Line 5,956: | Line 5,751: | ||
[8, 7, 9, 7] : No solution found |
[8, 7, 9, 7] : No solution found |
||
[9, 4, 4, 5] : No solution found</pre> |
[9, 4, 4, 5] : No solution found</pre> |
||
=={{header|R}}== |
=={{header|R}}== |
||
Line 6,072: | Line 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>. |
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>™</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}}== |
=={{header|REXX}}== |