1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
| {-^
Крестики-нолики.
Игра «крестики-нолики» на доске 3 х 3. Пронумеруем клетки следующим образом:
1 | 2 | 3
---+---+---
4 | 5 | 6
---+---+---
7 | 8 | 9
Тогда позиция во время игры может быть представлена как data Pos = Pos [Integer] [Integer],
где первый список содержит позиции игрока компьютера O,
а второй — позиции противника человека Х.
-}
module Main where
import Data.List
import Random
data Pos = Pos [Integer] [Integer] deriving Show --директива позволяет использовать тип как строки
-- ^ функция validPos :: Pos -> Bool, которая проверяет необходимые условия правильности позиции.
validPos :: Pos -> Bool
validPos (Pos [][]) = True
validPos (Pos ol xl) = res where
sp = (xl++ol)
res = all (\a -> a == True) [maximum sp < 10, minimum sp > 0, nub sp == sp, True] --nub удаляет все повторяющиеся эл-ты
-- ^ Test
validPosTest = [validPos (Pos [][]), validPos (Pos [1,0,-1] [4,5,11]),
validPos (Pos [1,6,5] [4,5,11]), validPos (Pos [1,4] [5,7,9])]
-- ^ функция vacant :: Pos -> [Integer], которая возвращает пустые клетки для данной позиции.
vacant :: Pos -> [Integer]
vacant (Pos ol xl) = res where
sp = (xl++ol)
res = drop (length sp)(nub (sp ++ [1..9]))
vacantTest = [vacant (Pos [1,5] [2])]
-- ^ функция play :: Integer -> Pos -> Pos, которая возвращает позицию,
-- где текущий игрок компьютер ставит свой знак в заданную клетку.
play :: Integer -> Pos -> Pos
play m (Pos o x) = (Pos o ([m]++o))
playTest = [play 1 (Pos [5] [2]), play 3 (Pos [1,5] [2])]
play' :: Integer -> Pos -> Pos --для игрока человака
play' m (Pos o x) = (Pos o ([m]++x))
playTest' = [play' 1 (Pos [5] [2]), play' 3 (Pos [1,5] [2])]
-- ^Строки, столбцы, диагонали доски 3Х3
rcd :: [[Integer]]
rcd = [[1,2,3], [4,5,6], [7,8,9], [1,4,7], [2,5,8], [3,6,9], [1,5,9], [3,5,7]]
-- ^Функция won :: Pos -> Bool, которая определяет, выиграл ли игрок компьютер.
-- Например: won (Pos [1,5] [2,3]) == False; won (Pos [1,4,5,7] [2,3,9]) == True.
won :: Pos -> Bool
won (Pos xl o) = length (filter (\f -> (length f) == (length xl)) (map (\n -> nub (xl++n)) rcd)) > 0
wonTest = [won (Pos [1,5] [2,3]), won (Pos [1,4,5,7] [2,3,9]), won (Pos [9,7,1,5] [2,3,9])]
won' :: Pos -> Bool --выигал ли игрок человек
won' (Pos o xl) = length (filter (\f -> (length f) == (length xl)) (map (\n -> nub (xl++n)) rcd)) > 0
wonTest' = [won (Pos [1,5] [2,3]), won (Pos [1,4,5,7] [2,3,9]), won (Pos [9,7,1,5] [2,3,9])]
{-^
Н. Нильсон "Принципы исскуственного интеллекта" c. 100
Статическая оценочная функция. Задается тремя условиями:
1) Если в позиции Pos не выигрывает ни один из игроков, то scope(Pos) -
(число строк, столбцов и диагоналей, на данный момент целиком свободных
для игрока max (comp)) - (число строк, столбцов и диагоналей, на данный момент целиком свободных для игрока min). Т.е. число строк, столбцов и диагоналей, на игровой доске 3Х3, в которых
игрок min не поставил пока ни одного знака.
2) Если в Pos выигрыш получает max, то scope(Pos) = очень большому числу
3) Если в Pos выигрыш получает min, то scope(Pos) = очень большому отрицательному числу
-}
score :: Pos -> Integer
score (Pos ol xl) =
if won (Pos ol xl)
then 1000000000 -- max (comp) победил
else if won' (Pos ol xl)
then -1000000000 -- max проиграл
else (rcdEmpty xl) - (rcdEmpty ol)
--
rcdEmpty :: [Integer] -> Integer --оценка ситуации
rcdEmpty l = (sum $ concat (map (\m -> map (\r -> if (elem m r) then 0 else 1) rcd) l))
scoreTest = [score (Pos [5] [1]), score (Pos [5] [4]), score (Pos [4] [5]),
score (Pos [4] [2]), score (Pos [1] [4]), score (Pos [9,5] [2,7])]
-- Сравнение позиций для сортировки функцией sortBy
cmpPos :: (Pos, Integer) -> (Pos, Integer) -> Ordering
cmpPos p1 p2 = if (snd p1) > (snd p2) then GT else LT --snd выбирает второй из пары
-- ^Программа, которая в интерактивном режиме играет с человеком,
-- отображая изменение состояния игрового поля.
replace :: Eq a => [a] -> [a] -> [a] -> [a] -- заменяет в s find на repl
replace [] _ _ = []
replace s find repl =
if take (length find) s == find
then repl ++ (replace (drop (length find) s) find repl)
else [head s] ++ (replace (tail s) find repl)
{-^
Для вывода позиции на экран преобразует стуктуру данных Pos в
строковое представление номеров, нулей и крестов.
Первый список это будут ходы компа которые обозначим символом O.
-}
makeStringPos2 :: Pos -> String
makeStringPos2 (Pos o x) = res where
empty = "\n123\n456\n789\n"
res = add' (add' empty x "X") o "O"
makeStringPos1 :: Pos -> String
makeStringPos1 (Pos o x) = res where
empty = "\n 1 | 2 | 3 \n---+---+---\n 4 | 5 | 6 \n---+---+---\n 7 | 8 | 9 \n"
res = add' (add' empty x "X") o "O"
add' :: String -> [Integer] -> String -> String
add' s [] a = s
add' s (r:rs) a = add' (replace s (show r) a) rs a
game :: Pos -> IO ()
game (Pos x o) = do
putStr "hod dostup: "
putStrLn $ show (vacant (Pos x o))
putStrLn (makeStringPos1 (Pos x o))
if null$ vacant (Pos x o)
then
if won (Pos x o)
then do putStrLn "Player2! ;)"
else if won' (Pos x o)
then do putStrLn "PLayer1 is winner! ;("
else do putStrLn "ok ichelyash' :)"
else do
putStrLn "PLayer1:"
pos <- getLine
let newPos = play' ((read pos)::Integer) (Pos x o)
putStrLn (show newPos)
if validPos newPos
then do
if won' newPos
then do
putStrLn (makeStringPos1 newPos)
putStrLn "PLayer1 is winner! ;(";
else do
if (null $ vacant newPos) == False
then do
let newPos2 = play ((read pos)::Integer) (Pos x o)
putStrLn (show newPos2)
if validPos newPos2
then do
if won newPos2
then do
putStrLn (makeStringPos2 newPos2)
putStrLn "Humans is winner! ;("
else do game newPos2
else do putStrLn (makeStringPos1 newPos); putStrLn "ok ichelyash' :)"
else do putStrLn("\nInvalid course! Repeat!\n"); game (Pos x o)
main = do
putStrLn ""
game (Pos [][]) |
(
Сообщение от Catstail
