Generate random chess position: Difference between revisions

Add Factor
(Generate random chess position en FreeBASIC)
(Add Factor)
Line 288:
</pre>
 
=={{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>
 
=={{header|FreeBASIC}}==
1,808

edits