-
Notifications
You must be signed in to change notification settings - Fork 0
/
othello.rkt
294 lines (246 loc) · 13.5 KB
/
othello.rkt
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
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
#lang racket
(define partida1 (list
'libre 'libre 'libre 'libre 'libre 'libre 'libre 'libre
'libre 'libre 'libre 'libre 'libre 'libre 'libre 'libre
'libre 'libre 'libre 'libre 'libre 'libre 'libre 'libre
'libre 'libre 'libre 'blanc 'negra 'libre 'libre 'libre
'libre 'libre 'libre 'negra 'blanc 'libre 'libre 'libre
'libre 'libre 'libre 'libre 'libre 'libre 'libre 'libre
'libre 'libre 'libre 'libre 'libre 'libre 'libre 'libre
'libre 'libre 'libre 'libre 'libre 'libre 'libre 'libre)) ;posiciones 0-63
;---------------------------------------------------------------------------------------------------------------------
(define (get-pos fila columna) ;devuelve posicion dentro de la lista inicial
(+ (* fila 8) columna))
;---------------------------------------------------------------------------------------------------------------------
(define (get-numcolumna pos)(modulo pos 8)) ;devuelve el numero de columna en el que se encuentra pos
;---------------------------------------------------------------------------------------------------------------------
(define (get-elem lista pos) (list-ref lista pos)); devuelve el elemento de una lista dada una posicion
;---------------------------------------------------------------------------------------------------------------------
(define (get-numfila pos) (floor (/ pos 8))) ;devuelve el numero de fila en el que se encuentra pos
;---------------------------------------------------------------------------------------------------------------------
(define (get-diagonalID partida pos) ;devuelve la diagonal de izq a dcha
(define fila (get-numfila pos))
(define columna (get-numcolumna pos))
(append ;une las listas
;suma filas y columnas
(for/list ;coge las posiciones de la diagonal de arriba a abajo (incluida la pos introducida)
([i (in-range fila 8)] ;desde la fila pasada hasta la ultima
[j (in-range columna 8)]) ;desde la columna pasada hasta la ultima
(get-pos i j)
)
;resta filas y columnas
(for/list ;coge las posiciones de la diagonal de abajo a arriba
([i (in-range (- fila 1) -1 -1)] ;desde la fila-1 (ignora la fila pasada) hasta la primera (para atras)
[j (in-range (- columna 1) -1 -1)]) ;desde la columna-1 (ignora la fila pasada) hasta la primera (para atras)
(get-pos i j)
))
)
;---------------------------------------------------------------------------------------------------------------------
(define (get-diagonalDI partida pos) ;devuelve la diagonal de dcha a izq
(define fila (get-numfila pos))
(define columna (get-numcolumna pos))
(append ;une las listas
;suma columnas y resta filas
(for/list ;coge las posiciones de la diagonal de abajo a arriba (incluida la pos introducida)
([i (in-range fila -1 -1)] ;desde la fila pasada hasta la primera (para atras)
[j (in-range columna 8)]) ;desde la columna pasada hasta la ultima
(get-pos i j)
)
;suma filas y restar columnas
(for/list ;coge las posiciones de la diagonal de arriba a abajo
([i (in-range (+ fila 1) 8)] ;desde la fila+1 (ignora la fila pasada) hasta la ultima
[j (in-range (- columna 1) -1 -1)]) ;desde la columna-1 (ignora la fila pasada) hasta la primera (para atras)
(get-pos i j)
))
)
;---------------------------------------------------------------------------------------------------------------------
(define (cambiar-ficha partida pos color) ;cambiar el color de la ficha en pos
(list-set partida pos color)
)
;---------------------------------------------------------------------------------------------------------------------
(define (print-tablero partida) ;imprime el tablero por pantalla
(for ([i (in-range 0 64)])
(if (= (get-numcolumna i) 7)
(printf "~a\n" (get-elem partida i))
(printf "~a " (get-elem partida i)))
)
(printf "\n")
)
;---------------------------------------------------------------------------------------------------------------------
(define (get-pos-ficha-igual partida direccion pos lista) ;devuelve la ficha igual a pos (mismo color) mas cercana por la direccion introducida. Si entre est ficha y la encontrada hay alguna libre devuelve #f
(cond
[(equal? direccion 'izq) ;desde pos hacia la izq
(for/first ([i (in-range (- (index-of lista pos) 1) -1 -1)] ;recorre la lista hacia la izq
#:break (equal? (get-elem partida (get-elem lista i)) 'libre) ;para si encuentra una casilla libre
#:when (equal? (get-elem partida (get-elem lista i)) (get-elem partida pos))) ;comprueba si es del mismo color
i
)
]
[(equal? direccion 'dcha) ;desde pos hacia la dcha
(for/first ([i (in-range (+ (index-of lista pos) 1) (length lista))] ;recorre la lista hacia la dcha
#:break (equal? (get-elem partida (get-elem lista i)) 'libre) ;para si encuentra una casilla libre
#:when (equal? (get-elem partida (get-elem lista i)) (get-elem partida pos))) ;comprueba si es del mismo color
i
)
]
)
)
;---------------------------------------------------------------------------------------------------------------------
(define (get-cambios partida pos list) ;devuelve una lista con las posiciones a cambiar de una lista (si no hay nada que cambiar la lista es vacia)
(define lista (sort list <)) ;ordena la lista de menor a mayor
(append
(if (not (equal? (get-pos-ficha-igual partida 'izq pos lista) #f))
(for/list ([i (in-range (- (index-of lista pos) 1) (get-pos-ficha-igual partida 'izq pos lista) -1)]) ;recorre la lista desde pos-1 hasta la primera ficha igual por la izq
(get-elem lista i)
)
'()
)
(if (not (equal? (get-pos-ficha-igual partida 'dcha pos lista) #f))
(for/list ([i (in-range (+ (index-of lista pos) 1) (get-pos-ficha-igual partida 'dcha pos lista))]) ;recorre la lista desde pos+1 hasta la primera ficha igual por la dcha
(get-elem lista i)
)
'()
)
)
)
;---------------------------------------------------------------------------------------------------------------------
(define (get-cambios-tablero partida pos) ;devuelve una lista con los cambios a realizar en el tablero al colocar una ficha
(define fila
(lambda (partida pos) ;devuelve las posiciones de una fila a partir de una posicion
(define primer-pos-fila (* (get-numfila pos) 8)) ;coge la primera posicion de la fila
(for/list ([i 8])
;coge los elementos de la fila (empezando por el primer elemento y sumando de 1 en 1)
(+ primer-pos-fila i)
)
))
(define columna (lambda (partida pos) ;devuelve las posiciones de una columna a partir de una posicion
;coge la columna correspondiente a la posicion (= primera posicion de la columna)
(for/list ([i (in-range (get-numcolumna pos) 64 8)]) ;coge los elementos de la columna (empezando en el primer elemento y yendo de 8 en 8)
i)
))
(define diagonalID (get-diagonalID partida pos))
(define diagonalDI (get-diagonalDI partida pos))
(append
(get-cambios partida pos (fila partida pos))
(get-cambios partida pos (columna partida pos))
(get-cambios partida pos diagonalID)
(get-cambios partida pos diagonalDI)
)
)
;---------------------------------------------------------------------------------------------------------------------
(define (cambiar-tablero partida pos cambios) ;cambia el tablero con las fichas correspondientes cambiadas de color, es recursivo
(define color (get-elem partida pos))
(if (not(empty? cambios))
(cambiar-tablero (cambiar-ficha partida (car cambios) color) pos (cdr cambios))
partida))
;---------------------------------------------------------------------------------------------------------------------
(define (get-num-fichas partida jugador) ;obtiene el numero de fichas de un jugador en un tablero (jugador = 'blanc/'negra)
(for/sum ([i 64]
#:when (equal? (get-elem partida i) jugador))
1)
)
;------------------------------------------------------------------------------------------
(define (get-ganador partidafinal) ;obtiene el ganador
(cond [(> (get-num-fichas partidafinal 'negra) (get-num-fichas partidafinal 'blanc)) " negras"]
[(< (get-num-fichas partidafinal 'negra) (get-num-fichas partidafinal 'blanc)) "blancas"]
[else ""]))
;------------------------------------------------------------------------------------------
(define (casillas-posibles? partida jugador) ;devuelve si hay casillas posibles
(if (empty? (get-movimientos-posibles partida jugador))
#f
#t
)
)
;------------------------------------------------------------------------------------------
(define (get-movimientos-posibles partida jugador) ;devuelve una lista con los movimientos posibles del jugador
(for/list ([i 64] ;recorre todas las casillas
#:when (and (equal? (get-elem partida i) 'libre) (not (empty? (get-cambios-tablero (cambiar-ficha partida i jugador) i))))) ;comprueba que este libre y tenga cambios
i
)
)
;------------------------------------------------------------------------------------------
(define (get-oponente jugador) ;obtiene el oponente
(if (equal? jugador 'blanc)
'negra
'blanc
)
)
;------------------------------------------------------------------------------------------
(define (heuristica partida) ;dvuelve el valor de la heuristica (diferencia entre l numero de fichas de un jugador y su oponente), siempre sera blanco, orque la maquina es blanco
(- (get-num-fichas partida 'blanc) (get-num-fichas partida (get-oponente 'blanc)))
)
;------------------------------------------------------------------------------------------
;saca el valor mas alto de una lista
(define (sacar-max lista num)
(cond
[(empty? lista)
num]
[else
(if(> (car lista) num)
(sacar-max (cdr lista) (car lista))
(sacar-max (cdr lista) num))]))
;------------------------------------------------------------------------------------------
;saca todos los posibles othellos que se generan cambiando la fucha correspondiente de posibles-movimientos de un jugador
(define (hijos partida posibles-movimientos jugador)
(for/list ([i (length posibles-movimientos)])
(cambiar-tablero (cambiar-ficha partida (get-elem posibles-movimientos i) jugador) (get-elem posibles-movimientos i) (get-cambios-tablero (cambiar-ficha partida (get-elem posibles-movimientos i) jugador) (get-elem posibles-movimientos i)))
))
;------------------------------------------------------------------------------------------
(define (modo-jugar-maquina estrategia partida jugador alpha beta prof) ;aplicacion de los algoritmos minimax y poda alfa-beta (recursiva)
(cond
[(= prof 0) ;profundidad = 0
(cons (heuristica partida) null)]
[else ;resto profundidades
(define posibles-jugadas (hijos partida (get-movimientos-posibles partida jugador) jugador))
(cond
[(empty? posibles-jugadas) ;si no tiene movimientos
(define posibles-jugadas-oponente (hijos partida (get-movimientos-posibles partida (get-oponente jugador)) (get-oponente jugador)))
(cond
[(empty? posibles-jugadas-oponente) ;si el oponente no tiene movimientos
(cons -1 -1)
]
[else ;si el oponente tiene movimientos
(if (equal? estrategia "poda")
(cons (- (get-elem (modo-jugar-maquina "poda" partida (get-oponente jugador) (- beta) (- alpha) (- prof 1)) 0)) -1)
(cons (- (get-elem (modo-jugar-maquina "minimax" partida (get-oponente jugador) null null (- prof 1)) 0)) -1))
]
)
]
[else ;si tiene movimientos
(cond
[(equal? estrategia "poda")
(define lista-evaluaciones (for/list [(i (length posibles-jugadas)) #:break (or (> alpha beta) (= alpha beta))]
(- (get-elem (modo-jugar-maquina "poda" (get-elem posibles-jugadas i) (get-oponente jugador) (- beta) (- alpha) (- prof 1)) 0))))
(define maximo (sacar-max lista-evaluaciones alpha)) ;val > alpha = actualiza
(define casilla (get-elem (get-movimientos-posibles partida jugador) (index-of lista-evaluaciones maximo)))
(cons maximo casilla)
]
[else
(define lista-evaluaciones (for/list [(i (length posibles-jugadas))]
(- (get-elem (modo-jugar-maquina "minimax" (get-elem posibles-jugadas i) (get-oponente jugador) null null (- prof 1)) 0))))
(define maximo (sacar-max lista-evaluaciones -9999999999))
(define casilla (get-elem (get-movimientos-posibles partida jugador) (index-of lista-evaluaciones maximo)))
(cons maximo casilla)]
)])]))
;------------------------------------------------------------------------------------------
(provide get-pos
get-numfila
get-numcolumna
get-diagonalDI
get-diagonalID
get-elem
partida1
cambiar-tablero
get-cambios
get-oponente
get-cambios-tablero
cambiar-ficha
get-ganador
heuristica
get-num-fichas
casillas-posibles?
get-movimientos-posibles
get-pos-ficha-igual
print-tablero
modo-jugar-maquina
)