56 lines
1.5 KiB
Factor
56 lines
1.5 KiB
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
|