59 lines
2.3 KiB
Haskell
59 lines
2.3 KiB
Haskell
forgivingStrategy :: [Char] -> [Char] -> Int -> [Char]
|
||
forgivingStrategy opponentMoves generatedMoves n
|
||
| n > 100 || length opponentMoves == 1 = generatedMoves
|
||
| n == 0
|
||
= forgivingStrategy opponentMoves (generatedMoves ++ ['С']) (n + 1)
|
||
| head opponentMoves == 'С'
|
||
= forgivingStrategy (tail opponentMoves) (generatedMoves ++ ['С']) (n + 1)
|
||
| otherwise
|
||
= forgivingStrategy (tail opponentMoves) (generatedMoves ++ ['П']) (n + 1)
|
||
|
||
indexOf :: (Eq t) => [t] -> t -> Int
|
||
indexOf [] _ = -1
|
||
indexOf (x : xs) target
|
||
| x == target = 0
|
||
| otherwise = 1 + indexOf xs target
|
||
|
||
nashEquilibriumStrategy :: [a] -> [Char] -> Int -> [Char]
|
||
nashEquilibriumStrategy opponentMoves generatedMoves n =
|
||
if n <= 100 && length opponentMoves > 0
|
||
then
|
||
nashEquilibriumStrategy (tail opponentMoves) (generatedMoves ++ [nextStep]) (n + 1)
|
||
else generatedMoves
|
||
where
|
||
cases = [['П', 'С'], ['П', 'П']]
|
||
results = [[0, 10], [5, 5]]
|
||
result =
|
||
[ min (results !! 0 !! 1) (results !! 1 !! 1),
|
||
max (results !! 0 !! 0) (results !! 1 !! 0)
|
||
]
|
||
nextStep = cases !! indexOf results result !! 1
|
||
|
||
getScore :: Num t => [Char] -> [Char] -> t -> t -> (t, t)
|
||
getScore moves1 moves2 score1 score2 =
|
||
if length moves1 == 0 then (score1, score2)
|
||
else getScore (tail moves1) (tail moves2) newScore1 newScore2
|
||
where
|
||
cases = [['С', 'С'], ['С', 'П'], ['П', 'С'], ['П', 'П']]
|
||
results = [[1, 1], [10, 0], [0, 10], [5, 5]]
|
||
newScore1 = score1 + results !! indexOf cases [head moves1, head moves2] !! 0
|
||
newScore2 = score2 + results !! indexOf cases [head moves1, head moves2] !! 1
|
||
|
||
|
||
game :: [Char] -> ([Char] -> [Char] -> Int -> [Char]) -> [Char]
|
||
game playerMoves gameStrategy
|
||
| null playerMoves = []
|
||
| otherwise = gameStrategy playerMoves [] 0
|
||
|
||
|
||
playerMoves = ['С', 'П', 'С', 'С', 'П', 'П', 'С', 'С', 'П', 'П']
|
||
gameStrategy = forgivingStrategy -- forgivingStrategy, nashEquilibriumStrategy
|
||
computerMoves = game playerMoves gameStrategy
|
||
(score1, score2) = getScore playerMoves computerMoves 0 0
|
||
|
||
main :: IO ()
|
||
main = do
|
||
putStrLn $ "Ходы компьютера: " ++ computerMoves
|
||
putStrLn $ "Очки: " ++ show score1 ++ " - " ++ show score2
|
||
|