Jump to content

24 game/Solve: Difference between revisions

m
→‎{{header|Perl 6}}: Fix up bit rotted example
m (→‎{{header|Perl 6}}: Fix up bit rotted example)
Line 3,730:
 
=={{header|Perl 6}}==
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.
{{broken|Perl 6}}
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).
 
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>myuse @digitsMONKEY-SEE-NO-EVAL;
 
my @digits;
my $amount = 4;
 
Line 3,741 ⟶ 3,742:
# 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]>/);
}
Line 3,748 ⟶ 3,749:
 
# Generate combinations of operators
my @opops = [X,] <+ - * /> xx 3;
my @ops = map {my $a = $_; map {my $b = $_; map {[$a,$b,$_]}, @op}, @op}, @op;
 
# Enough sprintf formats to cover most precedence orderings
Line 3,763:
 
# Brute force test the different permutations
for unique permutations @digits.permutations -> @p {
for @ops -> @o {
for @formats -> $format {
my $string = sprintf $format, flat roundrobin(|@p[0],; |@o[0],);
my $result = @p[1], @o[1], @p[2], @o[2], @p[3]EVAL($string);
my $result = try { EVAL($string) };
say "$string = 24" and last if $result and $result == 24;
}
}
}
 
# Perl 6 translation of Fischer-Krause ordered permutation algorithm
sub permutations (@array) {
my @index = ^@array;
my $last = @index[*-1];
my (@permutations, $rev, $fwd);
loop {
push @permutations, [@array[@index]];
$rev = $last;
--$rev while $rev and @index[$rev-1] > @index[$rev];
return @permutations unless $rev;
$fwd = $rev;
push @index, @index.splice($rev).reverse;
++$fwd while @index[$rev-1] > @index[$fwd];
@index[$rev-1,$fwd] = @index[$fwd,$rev-1];
}
}
Line 3,795 ⟶ 3,777:
my %h = map { $_.Str => $_ }, @array;
%h.values;
}</lang>
}
</lang>
 
{{out}}
<pre>
Enter 4 digits from 1 to 9, (repeats allowed): 3711
3(1 *+ (7) +* 13 * 1) = 24
3(1 *+ (7) +* 13 / 1) = 24
3(1 * (73) * (1 + 17) = 24
3 * (7 / 1 + 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
3 / (1 / (7 + 1)) = 24
3 * (1 + 1 * 7) = 24
(3 * 1) * (1 + 7) = 24
Line 3,816 ⟶ 3,790:
(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
3 / (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 * (7 / 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 + 73) * 3(7 /- 1) = 24
(1 * 3) * (7 + 1) * 3 = 24
(7 + 1) * 1 * 3 = 24
(7 + 1) / 1 * 3 = 24
Line 3,825 ⟶ 3,814:
(7 * 1 + 1) * 3 = 24
(7 / 1 + 1) * 3 = 24
(1 + 3) * (7 -+ 1 * 1) = 24
(1 * 3) * (7 + 1 / 1) = 24
(13 * 3)(7 * (1 + 71) = 24
(13 +* (7) */ 31 *+ 1) = 24
(1 + 7) * 3 / 1 = 24
(1 + 7) * 1 * 3 = 24
(1 + 7) / 1 * 3 = 24
(1 + 7) / (1 / 3) = 24
(1 * 7 + 1) * 3 = 24
(1 + 1 * 7) * 3 = 24
(1 * 1 + 7) * 3 = 24
(1 / 1 + 7) * 3 = 24
 
Enter 4 digits from 1 to 9, (repeats allowed): 5 5 5 5
10,339

edits

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