Dominoes: Difference between revisions

Content added Content deleted
m (→‎{{header|Perl}}: make compatible with recent releases of Perl)
(→‎{{header|Perl}}: eliminate use of globals, no 'eval', any size grid, added extra credit)
Line 321: Line 321:


=={{header|Perl}}==
=={{header|Perl}}==
{{libheader|ntheory}}
<syntaxhighlight lang="perl">#!/usr/bin/perl
<syntaxhighlight lang="perl">use v5.36;


sub find ($rows, $cols, $x, $y, $try, $orig) {
use strict; # https://rosettacode.org/wiki/Dominoes
state $solution;
use warnings;
⚫
my $sum = $rows + $cols;
use feature 'bitwise';
⚫
my $gap = qr/(.{$sum}) (.{$sum})/s;


⚫
if( $x > $y ) {
⚫
my $gap = qr/(.{15}) (.{15})/s;
⚫
$x = 0;
$solution = $orig |. $try and return if ++$y == $rows; # solved!
⚫
}

⚫
while ( $try =~ /(?=(?|$x $gap $y|$y $gap $x))/gx ) { # vertical
⚫
my $new = $try;
⚫
substr $new, $-[0], 2*($rows+$cols)+3, " $1+$2 ";
⚫
find($rows, $cols, $x + 1, $y, $new, $orig );
⚫
}

⚫
while ( $try =~ /(?=$x $y|$y $x)/g ) { # horizontal
my $new = $try;
⚫
substr $new, $-[0], 3, ' + ';
find($rows, $cols, $x + 1, $y, $new, $orig );
⚫
}

$solution
}


# NB: not 'blank' lines, need to be full-width white-space
# NB: not 'blank' lines, need to be full-width white-space
my $grid = <<END;
my $grid1 = <<END;
0 5 1 3 2 2 3 1
0 5 1 3 2 2 3 1
Line 345: Line 365:
6 4 5 1 5 4 1 4
6 4 5 1 5 4 1 4
END
END
eval { find( 0, 0, $grid ) };


$grid = <<END;
$grid2 = <<END;
0 0 0 1 1 1 0 2
0 0 0 1 1 1 0 2
Line 362: Line 381:
3 6 4 6 5 6 6 6
3 6 4 6 5 6 6 6
END
END
eval { find( 0, 0, $grid ) };


my $grid3 = <<END;
sub find
{
0 0 1 1
my ($x, $y, $try) = @_;
0 2 2 2
⚫
if( $x > $y )
{
$x = 0;
1 2 0 1
END
if( ++$y > 6 ) # solved
{
print "\nfound:\n\n", $grid |. $try;
die;
}
⚫
}
⚫
while( $try =~ /(?=(?|$x$gap$y|$y$gap$x))/g ) # vertical
{
⚫
my $new = $try;
⚫
substr $new, $-[0], 33, " $1+$2 ";
⚫
find( $x + 1, $y, $new );
⚫
}
⚫
while( $try =~ /(?=$x $y|$y $x)/g ) # horizontal
{
⚫
my $new = $try;
⚫
substr $new, $-[0], 3, ' + ';
⚫
find( $x + 1, $y, $new );
⚫
}
}</syntaxhighlight>
⚫
{{out}}
<pre>


say find(7, 8, 0, 0, $grid1, $grid1 ) . "\n=======\n\n";
found:
say find(7, 8, 0, 0, $grid2, $grid2 ) . "\n=======\n\n";
say find(3, 4, 0, 0, $grid3, $grid3 ) . "\n=======\n\n";


use constant PI => 2*atan2(1,0);
⚫
0+5 1+3 2 2+3 1
use ntheory 'factorial';

sub comma { reverse ((reverse shift) =~ s/(.{3})/$1,/gr) =~ s/^,//r }

my($m,$n, $arrangements) = (7,8, 1);
for my $j (1 .. $m/2) {
for my $k (1 .. $n/2) {
$arrangements *= 4*cos(PI*$j/($m+1))**2 + 4*cos(PI*$k/($n+1))**2
⚫
}
}

printf "%32s:%60s\n", 'Arrangements ignoring values', comma $arrangements;
printf "%32s:%60s\n", 'Permutations of 28 dominos', comma my $permutations = factorial 28;
printf "%32s:%60s\n", 'Flip configurations', comma my $flips = 2**28;
printf "%32s:%60s\n", 'Permuted arrangements with flips', comma $flips * $permutations * $arrangements;</syntaxhighlight>
⚫
{{out}}
⚫
<pre>0+5 1+3 2 2+3 1
+ +
+ +
0 5+5 0 5 2+4 6
0 5+5 0 5 2+4 6
Line 408: Line 425:
6 4+5 1+5 4 1+4
6 4+5 1+5 4 1+4


=======
found:


0+0 0+1 1+1 0+2
0+0 0+1 1+1 0+2
Line 422: Line 439:
5 5 0+6 1+6 2 6
5 5 0+6 1+6 2 6
+ +
+ +
3+6 4+6 5+6 6 6</pre>
3+6 4+6 5+6 6 6

=======

0+0 1+1

0+2 2+2

1+2 0+1

=======

Arrangements ignoring values: 1,292,697
Permutations of 28 dominos: 304,888,344,611,713,860,501,504,000,000
Flip configurations: 268,435,456
Permuted arrangements with flips: 105,797,996,085,635,281,181,632,579,889,767,907,328,000,000</pre>


=={{header|Phix}}==
=={{header|Phix}}==
Retrieved from "https://rosettacode.org/wiki/Dominoes"