Anonymous user
Generate random chess position: Difference between revisions
no edit summary
SqrtNegInf (talk | contribs) m (→{{header|zkl}}: Fix link: Perl 6 --> Raku) |
No edit summary |
||
Line 553:
1q6/3p3K/7b/1r1b4/3k4/6p1/8/1nn5/ w - - 0 1
</pre>
=={{header|Haskell}}==
Uses System.Random library: https://hackage.haskell.org/package/random-1.1/docs/System-Random.html
caveat: I'm learning the language and as such my approach <span style="text-decoration: line-through">may</span> is not be the simplest way to do this.
<lang haskell>{-# LANGUAGE LambdaCase #-}
import System.Random (getStdRandom, randomR, Random, random)
import Data.Maybe (isJust)
import Data.List (find, sortBy)
import Data.Ord (comparing)
type Pos = (Char, Int)
type ChessBoard = [(Square, Pos)]
data PieceRank = King | Queen | Rook | Bishop | Knight | Pawn
deriving (Enum, Bounded, Show, Eq, Ord)
data PieceColor = Black | White
deriving (Enum, Bounded, Show, Eq, Ord)
data Square = ChessPiece PieceRank PieceColor | EmptySquare
deriving (Eq, Ord)
type PieceCount = [(Square, Int)]
instance Show Square where
show (ChessPiece King Black) = "♚"
show (ChessPiece Queen Black) = "♛"
show (ChessPiece Rook Black) = "♜"
show (ChessPiece Bishop Black) = "♝"
show (ChessPiece Knight Black) = "♞"
show (ChessPiece Pawn Black) = "♟"
show (ChessPiece King White) = "♔"
show (ChessPiece Queen White) = "♕"
show (ChessPiece Rook White) = "♖"
show (ChessPiece Bishop White) = "♗"
show (ChessPiece Knight White) = "♘"
show (ChessPiece Pawn White) = "♙"
show EmptySquare = " "
instance Random PieceRank where
randomR (a, b) g =
case randomR (fromEnum a, fromEnum b) g of
(x, g') -> (toEnum x, g')
random g = randomR (minBound, maxBound) g
instance Random PieceColor where
randomR (a, b) g =
case randomR (fromEnum a, fromEnum b) g of
(x, g') -> (toEnum x, g')
random g = randomR (minBound, maxBound) g
fullBoard :: PieceCount
fullBoard =
[ (ChessPiece King Black, 1)
, (ChessPiece Queen Black, 1)
, (ChessPiece Rook Black, 2)
, (ChessPiece Bishop Black, 2)
, (ChessPiece Knight Black, 2)
, (ChessPiece Pawn Black, 8)
, (ChessPiece King White, 1)
, (ChessPiece Queen White, 1)
, (ChessPiece Rook White, 2)
, (ChessPiece Bishop White, 2)
, (ChessPiece Knight White, 2)
, (ChessPiece Pawn White, 8)
, (EmptySquare, 32)
]
emptyBoard :: ChessBoard
emptyBoard = map (\p -> (EmptySquare, p)) [(x,y) | x <-['a'..'h'], y <- [1..8]]
replaceSquareByPos :: (Square, Pos) -> ChessBoard -> ChessBoard
replaceSquareByPos (s, p) = map (\(s'', p'') -> if p == p'' then (s, p) else (s'', p''))
isPosOccupied :: Pos -> ChessBoard -> Bool
isPosOccupied p = occupied . found
where found = find (\(s, p'') -> p == p'')
occupied (Just (EmptySquare, _)) = False
occupied _ = True
isAdjacent :: Pos -> Pos -> Bool
isAdjacent (x, y) (x'', y'') =
let upOrDown = (pred y == y'' || succ y == y'')
leftOrRight = (pred x == x'' || succ x == x'')
in (x'' == x && upOrDown) ||
(pred x == x'' && upOrDown) ||
(succ x == x'' && upOrDown) ||
(leftOrRight && y == y'')
fen :: Square -> String
fen (ChessPiece King Black) = "k"
fen (ChessPiece Queen Black) = "q"
fen (ChessPiece Rook Black) = "r"
fen (ChessPiece Bishop Black) = "b"
fen (ChessPiece Knight Black) = "n"
fen (ChessPiece Pawn Black) = "p"
fen (ChessPiece King White) = "K"
fen (ChessPiece Queen White) = "Q"
fen (ChessPiece Rook White) = "R"
fen (ChessPiece Bishop White) = "B"
fen (ChessPiece Knight White) = "N"
fen (ChessPiece Pawn White) = "P"
boardSort :: (Square, Pos) -> (Square, Pos) -> Ordering
boardSort (_, (x, y)) (_, (x'', y''))
| y < y'' = GT
| y > y'' = LT
| y == y'' = compare x x''
toFen :: ChessBoard -> String
toFen [] = " w - - 0 1" <> []
toFen b = scanRow (map fst $ take 8 b) 0
where scanRow [] 0 = nextRow
scanRow [] n = show n <> nextRow
scanRow ((EmptySquare): xs) n = scanRow xs (succ n)
scanRow (x:xs) 0 = nextPiece x xs
scanRow (x:xs) n = show n <> nextPiece x xs
nextRow = "/" <> toFen (drop 8 b)
nextPiece x xs = fen x <> scanRow xs 0
-- impure functions
randomPos :: ChessBoard -> IO Pos
randomPos b = pos >>= \p -> if isPosOccupied p b
then randomPos b
else pos
where pos = (,) <$> chr <*> num
num :: IO Int
num = getStdRandom (randomR (1,8))
chr :: IO Char
chr = getStdRandom (randomR ('a', 'h'))
randomPiece :: IO Square
randomPiece = ChessPiece <$> rank <*> color
where rank :: IO PieceRank
rank = getStdRandom random
color :: IO PieceColor
color = getStdRandom random
placeKings :: ChessBoard -> IO ChessBoard
placeKings b = do
p1 <- randomPos b
p2 <- randomPos b
if p1 `isAdjacent` p2 || p1 == p2
then placeKings b
else
pure (replaceSquareByPos ((ChessPiece King White), p1) $
replaceSquareByPos ((ChessPiece King Black), p2) b)
placePawns :: PieceColor -> ChessBoard -> IO ChessBoard
placePawns c b = num >>= go b
where go :: ChessBoard -> Int -> IO ChessBoard
go b'' 0 = pure b''
go b'' n = do
p <- randomPos b''
if promoted c == snd p || isPosOccupied p b''
|| enpassant c == snd p || firstPos c == snd p
then go b'' n
else
go (replaceSquareByPos ((ChessPiece Pawn c), p) b'') (pred n)
promoted White = 8
promoted Black = 1
enpassant White = 5
enpassant Black = 4
firstPos White = 1
firstPos Black = 8
num :: IO Int
num = getStdRandom (randomR (1,8))
placeRemaining :: ChessBoard -> IO ChessBoard
placeRemaining b = do
n <- num (sum $ map (\(_, c) -> c) remaining)
putStrLn $ "Taking " <> show n <> " more random positions after placing 2 kings and "
<> (show $ totalPawns b) <> " pawns. "
go remaining b n
where remaining :: [(Square, Int)]
remaining =
filter (\case
((ChessPiece King _), _) -> False
((ChessPiece Pawn _), _) -> False
(EmptySquare, _) -> False
_ -> True) fullBoard
num :: Int -> IO Int
num mx = getStdRandom $ randomR (5, mx)
totalPawns = length . filter (\case ((ChessPiece Pawn _), _) -> True
_ -> False)
go :: [(Square, Int)] -> ChessBoard -> Int -> IO ChessBoard
go _ b'' 0 = pure b''
go permitted b'' n = do
position <- randomPos b''
piece <- randomPiece
if (not $ isPermitted piece) || isPosOccupied position b''
then go permitted b'' n
else
go (consume piece permitted) (replaceSquareByPos (piece, position) b'') (pred n)
where isPermitted p = case find (\x -> fst x == p) permitted of
Just (_, count) -> count > 0
Nothing -> False
consume p'' = map (\(p, c) -> if p == p'' then (p, pred c) else (p, c))
draw :: ChessBoard -> IO ()
draw b = do
showXAxis
line
mapM_ (\b@(p, (x,y)) ->
case x of 'h' -> putStr (" | " <> show p <> " | " <> show y <> "\n") >> line
'a' -> putStr (show y <> " | " <> show p)
_ -> putStr (" | " <> show p)
)
sorted
showXAxis
putStrLn ""
putStrLn $ toFen sorted
-- mapM_ print $ sortBy (comparing fst) $ filter (\(s, _) -> s /= EmptySquare) b
where sorted = sortBy boardSort b
line = putStrLn (" " <> (replicate 33 '-'))
showXAxis = do
putStr " "
mapM_ (\(_, (x, _)) -> putStr $ " " <> [x]) (take 8 sorted)
putStrLn ""
main :: IO ()
main =
placeKings emptyBoard >>=
placePawns White >>=
placePawns Black >>=
placeRemaining >>=
draw</lang>
{{out}}
Run 1
<pre>
Taking 8 more random positions after placing 2 kings and 11 pawns.
a b c d e f g h
---------------------------------
8 | | | | ♔ | | | | | 8
---------------------------------
7 | ♕ | ♘ | ♟ | ♖ | ♙ | | ♖ | | 7
---------------------------------
6 | ♙ | ♜ | | ♙ | | | ♙ | ♝ | 6
---------------------------------
5 | | | ♟ | | | | ♜ | ♟ | 5
---------------------------------
4 | | | | | ♚ | | | | 4
---------------------------------
3 | ♗ | | | | | ♙ | | | 3
---------------------------------
2 | ♙ | | ♙ | | | | ♟ | | 2
---------------------------------
1 | | | | | | | | | 1
---------------------------------
a b c d e f g h
3K4/QNpRP1R1/Pr1P2Pb/2p3rp/4k3/B4P2/P1P3p1/8/ w - - 0 1
</pre>
Run 2
<pre>
Taking 12 more random positions after placing 2 kings and 9 pawns.
a b c d e f g h
---------------------------------
8 | | | ♞ | ♖ | | ♝ | | ♔ | 8
---------------------------------
7 | | ♙ | | | | | ♙ | ♙ | 7
---------------------------------
6 | | | | | ♜ | | ♙ | | 6
---------------------------------
5 | | ♟ | | | | ♖ | ♚ | | 5
---------------------------------
4 | | | ♙ | ♗ | | | | ♜ | 4
---------------------------------
3 | ♕ | ♞ | | ♗ | ♛ | | ♙ | ♙ | 3
---------------------------------
2 | | | | | ♙ | | | | 2
---------------------------------
1 | | | ♝ | | | | | | 1
---------------------------------
a b c d e f g h
2nR1b1K/1P4PP/4r1P1/1p3Rk1/2PB3r/Qn1Bq1PP/4P3/2b5/ w - - 0 1
</pre>
etc...
=={{header|J}}==
| |||