Find Chess960 starting position identifier: Difference between revisions
Content added Content deleted
SqrtNegInf (talk | contribs) m (→{{header|Perl}}: tweaks) |
|||
Line 621: | Line 621: | ||
=={{header|Perl}}== |
=={{header|Perl}}== |
||
{{trans|Raku}} |
{{trans|Raku}} |
||
<lang perl>use |
<lang perl>use v5.36; |
||
use warnings; |
|||
use feature 'say'; |
|||
use List::AllUtils 'indexes'; |
use List::AllUtils 'indexes'; |
||
sub sp_id { |
sub sp_id ($setup) { |
||
⚫ | |||
my $setup = shift // 'RNBQKBNR'; |
|||
1 == @{[ $setup =~ /$_/g ]} or return "Illegal position: should have exactly one $_" for <K Q>; |
|||
2 == @{[ $setup =~ /$_/g ]} or return "Illegal position: should have exactly two $_\'s" for <B N R>; |
|||
$setup =~ m/R .* K .* R/x or return 'Illegal position: King not between rooks.'; |
|||
2 |
index($setup,'B')%2 != rindex($setup,'B')%2 or return 'Illegal position: Bishops not on opposite colors.'; |
||
⚫ | |||
⚫ | |||
my @knights = indexes { 'N' eq $_ } split '', $setup =~ s/[QB]//gr; |
my @knights = indexes { 'N' eq $_ } split '', $setup =~ s/[QB]//gr; |
||
my $knight = indexes { join('', @knights) eq $_ } <01 02 03 04 12 13 14 23 24 34>; # combinations(5,2) |
my $knight = indexes { join('', @knights) eq $_ } <01 02 03 04 12 13 14 23 24 34>; # combinations(5,2) |
||
my @bishops = indexes { 'B' eq $_ } split '', $setup; |
my @bishops = indexes { 'B' eq $_ } split '', $setup; |
||
my $dark = int ((grep { $_ % 2 == 0 } @bishops)[0]) / 2; |
my $dark = int ((grep { $_ % 2 == 0 } @bishops)[0]) / 2; |
||
my $light = int ((grep { $_ % 2 == 1 } @bishops)[0]) / 2; |
my $light = int ((grep { $_ % 2 == 1 } @bishops)[0]) / 2; |
||
my $queen = index(($setup =~ s/B//gr), 'Q'); |
my $queen = index(($setup =~ s/B//gr), 'Q'); |
||
int 4*(4*(6*$knight + $queen)+$dark)+$light; |
int 4*(4*(6*$knight + $queen)+$dark)+$light; |
||
} |
} |
||
say "$_ " . sp_id($_) for <QNRBBNKR RNBQKBNR RQNBBKRN RNQBBKRN>;</lang> |
say "$_ " . sp_id($_) for <QNRBBNKR RNBQKBNR RQNBBKRN RNQBBKRN QNBRBNKR>;</lang> |
||
{{out}} |
{{out}} |
||
<pre>QNRBBNKR 105 |
<pre>QNRBBNKR 105 |
||
RNBQKBNR 518 |
RNBQKBNR 518 |
||
RQNBBKRN 601 |
RQNBBKRN 601 |
||
RNQBBKRN 617 |
RNQBBKRN 617 |
||
⚫ | |||
=={{header|Phix}}== |
=={{header|Phix}}== |