Generate random chess position

From Rosetta Code
Revision as of 23:05, 13 December 2015 by Rdm (talk | contribs) (→‎{{header|J}})
Generate random chess position is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

The purpose of this task is to generate a random chess position in FEN format. The position does not have to be realistic or even balanced, but it must comply to the following rules:

  • there is one and only one king of each color (one black king and one white king);
  • the kings must not be placed on adjacent squares;
  • there can not be any pawn in the promotion square (no white pawn in the eighth rank, and no black pawn in the first rank);
  • including the kings, up to 32 pieces of either color can be placed. There is no requirement for material balance between sides; The picking of pieces does not have to comply to a regular chess set : there can be five knights, twenty rooks, whatever... as long as the total number of pieces do not exceed thirty-two.
  • it is white's turn, it is assumed that both sides have lost castling rights and that there is no possibility for en passant (the FEN should thus end in w - - 0 1);

No requirement is made regarding the probability distribution of your method, but your program should be able to span a reasonably representative sample of all possible positions. For instance, programs that would always generate positions with say five pieces on the board, or with kings on a corner, would not be considered truly random.

J

Implementation:

<lang J>getlayout=:3 :0

 whilst. NB. first two positions are non-adjacent kings
   (0{pos) e. (1{pos)+(,-)1 7 8 9
 do.
   pos=: y?64
 end.

)

randboard=:3 :0

 n=: ?30  NB. number of non-king pieces on board
 layout=: getlayout 2+n   NB. where they go
 white=: 0 1,?n#2         NB. which ones are white?
 pawns=: 0 0,?n#2             NB. where are the pawns?
 pawns=: 0 (I.white*pawns*layout e.56+i.8)} pawns
 pawns=: 0 (I.(1-white)*pawns*layout e.i.8)} pawns
 ptyp=: 'pkqbjnPKQBJN'{~(6*white)+1 1,(1-2}.pawns)*2+?n#4
 8 8$ptyp layout}64#'.'

)

NB. fen compress a line fen1=:3 :0

 for_n.8-i.8 do.
   y=. y rplc (#&'.';":) n
 end.

)

NB. translate 8x8 board to fen notation NB. (just the task specific crippled fen) b2fen=:3 :0

 (}.;<@(('/',fen1)"1) y),' w - - 0 1'

)

randfen=:b2fen@randboard</lang>

Example use:

<lang J> randfen 2B2nk1/pJ2q2P/1b4PK/7N/2P3jj/4n1Pj/p1Jp2b1/JB3n2 w - - 0 1

  randfen

1P6/7B/2k5/j1P3P1/1pp2P2/2J2p2/2Kn2b1/N7 w - - 0 1

  randfen

Q1n1JP2/pK1p2k1/1p2P1q1/1pQp4/J1bBjjN1/3qPP1J/1qp1p1n1/2N4J w - - 0 1

  randfen

8/8/6K1/8/5B2/8/4k3/8 w - - 0 1</lang>

Perl 6

<lang perl6>sub pick-FEN {

   # First we chose how many pieces to place
   my $n = (2..32).pick;
   # Then we pick $n squares
   my @n = (^64).pick($n);
   # We try to find suitable king positions on non-adjacent squares.
   # If we could not find any, we return recursively
   return pick-FEN() unless
   my @kings[2] = first -> [$a, $b] { $a !== $b && abs($a div 8 - $b div 8) | abs($a mod 8 - $b mod 8) > 1 }, (@n X @n);
   # We make a list of pieces we can pick (apart from the kings)

my @pieces =

; # We make a list of two king symbols to pick randomly a black or white king my @k = <K k>.pick(*); return (gather for ^64 -> $sq { if $sq == @kings.any { take @k.shift } elsif $sq == @n.any { my $row = 7 - $sq div 8; take $row == 7 ?? @pieces.grep(none('P')).pick !! $row == 0 ?? @pieces.grep(none('p')).pick !! @pieces.pick; } else { take 'ø' } }).rotor(8)».join».subst(/ø+/,{ .chars }, :g).join('/') ~ ' w - - 0 1'; } say pick-FEN();</lang>

Output:
q2n1n2/1Qpk3Q/1r3bP1/1b1b4/2pRBR2/4P1bN/2R3K1/N1r2rPB w - - 0 1

REXX

This REXX version generates balanced pieces   (both sides have an equal number of total pieces). <lang rexx>/*REXX pgm generates a chess position (rand pieces & positions) in FEN format.*/ parse arg seed . /*obtain optional argument from the CL.*/ if seed\== & seed\="," then call random ,,seed /*RANDOM repeatability? */ @.=. /*initialize the chessboard to default.*/

            do p=1  for random(2,32)  /* [↓]  generate random # of chessmen. */
            if p<3  then call piece 'k'
                    else call piece substr('bnpqr',random(1,5),1)
            end   /*p*/               /* [↑]  place a king or other piece.   */

call FEN /*display the FEN for the chessboard.*/ exit /*stick a fork in it, we're all done. */ /*────────────────────────────────────────────────────────────────────────────*/ piece: parse arg x; if p//2 then upper x; arg ux /*use white if odd P.*/

        do #=0  by 0;  r=random(1,8);  f=random(1,8)    /*random rank & file.*/
        if @.r.f\==.   then iterate                     /*position occupied? */
        if (x=='p' & r==1)|(x=='P' & r==8) then iterate /*any promoting pawn?*/
        if ux=='K'  then do    rr=-1  for 3             /*[↓]  neighbor≡king?*/
                            do ff=-1  for 3;  r_=r+rr;  f_=f+ff   /*neighbor.*/
                            z=@.r_.f_;    upper z;    if z=='K'  then iterate #
                            end  /*rr*/
                         end     /*ff*/
        @.r.f=x                                         /*place random piece.*/
        return
        end   /*#*/

/*────────────────────────────────────────────────────────────────────────────*/ FEN: fen=; do r=8 for 8 by -1; $=

              do f=8  for 8  by -1;  $=$ || @.r.f;  end  /*f*/
            say $                           /*display a chessboard rank.     */
            $=strip($,'T',.)                /*remove any trailing periods.   */
              do e=7  for 6  by -1;   $=changestr(copies(.,e),$,e);  end  /*e*/
            fen=fen || translate($,1,.)left('/',r\==1)   /*append  /  if ¬1st./
            end   /*r*/
    say
    say 'FEN='fen   "w - -"  0  1           /*show  Forsyth-Edwards Notation.*/
    return</lang>

Some older REXXes don't have a   changestr   BIF,   so one is included here:   ───►   CHANGESTR.REX.

output   (using some random chess position):

....N.r.
kn....NP
..B..K..
..nq...R
..b..Q.b
N.Q....q
P..QPq.p
..q.....

FEN=4N1r/kn4NP/2B2K/2nq3R/2b2Q1b/N1Q4q/P2QPq1p/2q w - - 0 1

zkl

Translation of: perl6

<lang zkl>fcn pickFEN{

  # First we chose how many pieces to place: 2 to 32
  n := (0).random(2,33);

  # Then we pick $n squares: first n of shuffle (0,1,2,3...63)
  n = [0..63].walk().shuffle()[0,n]; 

  # We try to find suitable king positions on non-adjacent squares.
  # If we could not find any, we return recursively
  kings := Utils.Helpers.cprod2(n,n).filter(fcn([(a,b)]){  // cross product
     a!=b and (a/8 - b/8).abs() or (a%8 - b%8).abs()>1
  })[0,1]; # ((a,b),..) on success, () on fail
  if(not kings) return(pickFEN());

  # We make a list of pieces we can pick (apart from the kings)
  pieces,pnp,pnP := "p P n N b B r R q Q".split(" "), pieces-"p", pieces-"P";

  # We make a list of two king symbols to pick randomly a black or white king
  k := "K k".split(" ").shuffle();

  [0..63].apply('wrap(sq){  # look at each square
     if(kings.holds(sq)) k.pop();
     else if(n.holds(sq)){
        row,n,n2 := 7 - sq/8, (0).random(pieces.len()), (0).random(pnp.len());

if( row == 7) pnP[n2] // no white pawn in the promotion square else if(row == 0) pnp[n2] // no black pawn in the promotion square else pieces[n] // otherwise, any ole random piece

     }
     else "#"  // empty square
  })
  .pump(List,T(Void.Read,7),"".append,subst)  // chunkize into groups of 8 chars (1 row)
  .concat("/") + " w - - 0 1"

} fcn subst(str){ // replace "#" with count of #s

  re :=RegExp("#+");
  while(re.search(str,1)){ n,m:=re.matched[0]; str=String(str[0,n],m,str[n+m,*]) }
  str

}</lang> <lang zkl>do(5){ pickFEN().println() }</lang>

Output:
b3rQBr/n2b1Q1q/1R6/1BQRQ2n/RnB2r2/q3b1nQ/1BqB1bBQ/2q1Q3 w - - 0 1
b7/5qqB/qb3B2/8/3b4/Q1n3r1/3B2Q1/n6r w - - 0 1
r2R3N/Q1n5/1N6/1N1R1RBB/8/Rn1b1r2/3QbNN1/2n3rQ w - - 0 1
5b2/1R6/r4b1q/3Q4/8/8/8/5b2 w - - 0 1
8/1BQ5/8/1q6/1q6/3B1Rq1/5b2/3N3R w - - 0 1