Find Chess960 starting position identifier: Difference between revisions

Content added Content deleted
Line 621: Line 621:
=={{header|Perl}}==
=={{header|Perl}}==
{{trans|Raku}}
{{trans|Raku}}
<lang perl>use strict;
<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) {
8 == length $setup or return 'Illegal position: should have exactly eight pieces';
my $setup = shift // 'RNBQKBNR';
1 == @{[ $setup =~ /$_/g ]} or return "Illegal position: should have exactly one $_" for <K Q>;

8 == length $setup or die 'Illegal position: should have exactly eight pieces';
2 == @{[ $setup =~ /$_/g ]} or return "Illegal position: should have exactly two $_\'s" for <B N R>;
1 == @{[ $setup =~ /$_/g ]} or die "Illegal position: should have exactly one $_" for <K Q>;
$setup =~ m/R .* K .* R/x or return 'Illegal position: King not between rooks.';
2 == @{[ $setup =~ /$_/g ]} or die "Illegal position: should have exactly two $_\'s" for <B N R>;
index($setup,'B')%2 != rindex($setup,'B')%2 or return 'Illegal position: Bishops not on opposite colors.';
$setup =~ m/R .* K .* R/x or die 'Illegal position: King not between rooks.';
index($setup,'B')%2 != rindex($setup,'B')%2 or die '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</pre>
RNQBBKRN 617
QNBRBNKR Illegal position: Bishops not on opposite colors.</pre>


=={{header|Phix}}==
=={{header|Phix}}==