Generate random chess position: Difference between revisions

=={{header|Factor}}==

<lang factor>USING: combinators.short-circuit grouping io kernel math

math.parser math.ranges math.vectors prettyprint random

sequences sets splitting.monotonic strings ;

IN: rosetta-code.random-chess-position

<PRIVATE

CONSTANT: pieces "RNBQBNRPPPPPPPPrnbqbnrpppppppp"

CONSTANT: empty CHAR: .

: <empty-board> ( -- seq ) 64 [ empty ] "" replicate-as ;

: empty-index ( seq -- n ) empty swap indices random ;

: place ( seq elt n -- seq' ) rot [ set-nth ] keep ;

! return a list of indices that are adjacent to n

: adj ( n -- seq )

[ 1 - ] [ 1 + ] bi [a,b] { 8 8 8 } [ v- ] 2keep dupd v+

append append ;

: rand-non-adjacent ( m -- n ) 64 <iota> swap adj diff random ;

: place-kings ( seq -- seq' )

CHAR: K over empty-index [ place ] keep [ CHAR: k ] dip

rand-non-adjacent place ;

: non-pawn ( seq elt -- seq' ) over empty-index place ;

! prevent placing of pawns in ranks 1 and 8

: pawn ( seq elt -- seq' )

over empty swap indices

[ { [ 7 > ] [ 56 < ] } 1&& ] filter random place ;

: place-piece ( seq -- seq' )

pieces random dup "Pp" member? [ pawn ] [ non-pawn ] if ;

PRIVATE>

: position ( -- seq )

<empty-board> place-kings 30 random [ place-piece ] times ;

: position. ( seq -- )

[ 1string ] { } map-as 8 group simple-table. ;

: position>fen ( seq -- seq' )

8 group [

[ = ] monotonic-split

[ dup first empty = [ length number>string ] when ]

map concat

] map "/" join "/ w - - 0 1" append ;

: random-chess-position-demo ( -- )

position [ position. ] [ position>fen print ] bi ;

MAIN: random-chess-position-demo</lang>

{{out}}

<pre>

. . . . . . . .

. p . . . . . .

. . . Q R . . .

. . . . . . k .

. P . . b . . .

. . P . . . K .

. . . . . . b .

. . . . . . r .

8/1p6/3QR3/6k1/1P2b3/2P3K1/6b1/6r1/ w - - 0 1

</pre>