(make-package 'gatao)
(in-package gatao)
(lisp::use-package 'lisp)

;;; Super-Gato para jogar o jogo do gato e rato
;;; 
;;; Estrategia baseada em analise de casos.
;;; De acordo com a posicao, segue-se uma
;;; regra.  As regras foram boladas para cobrirem
;;; todas as situacoes alcancaveis a partir da
;;; posicao inicial aplicando as proprias regras.
;;; As regras NAO cobrem todas as possiveis posicoes.
;;;
;;; As regras foram encontradas por analise de todas as variantes que
;;; surgiram a partir da estrategia basica de nao deixar caminhos do
;;; rato ate' a primeira linha.
;;;
;;;----------------------------------------------
;;; Dada uma posicao qualquer, o PIVOT e' o gato
;;; mais `a esquerda; se houver varios, aquele mais
;;; abaixo entre os mais `a esquerda.
;;; Em outras palavras: o de menor linha entre
;;; aqueles de menor coluna.
;;; Ou ainda: o minimo em relacao `a ordem:
;;; (l1 c1) < (l2 c2) := (c1 < c2) ou 
;;;                      (c1 = c2) e  (l1 < l2)
;;;
;;;----------------------------------------------
;;; Cada REGRA possui cinco itens:
;;; 1.  uma lista de tres VETORES que representam as
;;;     posicoes relativas dos outros gatos em
;;;     relacao ao PIVOT.
;;; 2.  uma COLUNA onde o PIVOT deve estar.
;;; 3.  um vetor que indica a posicao CRITICA desta
;;;     regra (ou configuracao).
;;; 4.  uma FUNCAO, que pode ser #'equal ou #'noteq,
;;;     usada para verificar se o Rato esta' ou nao
;;;     esta' na posicao CRITICA.
;;; 5.  uma RESPOSTA relativa ao PIVOT.
;;;
;;;-------------------------------------------------
;;; As REGRAS sao mutuamente exclusivas, e cobrem todas
;;; as possibilidades que podem ocorrer durante o jogo.
;;; Se uma POSICAO encaixa na REGRA, sua RESPOSTA e'
;;; retornada.  Para que uma POSICAO encaixe numa REGRA
;;; e' necessario que:
;;; 1. as posicoes relativas dos gatos na POSICAO coincida
;;;    com o especificado na REGRA.
;;; 2. o PIVOT esteja na COLUNA da REGRA.
;;; 3. o Rato esteja (#'equal) ou nao esteja (#'noteq)
;;;    na posicao CRITICA da REGRA.
;;;
;;; Se tudo isto for satisfeito, a RESPOSTA da REGRA e'
;;; somada ao PIVOT e retornada como a jogada a fazer.
;;; Note que colocando CRITICA = (0 0) e FUNCAO = #'noteq
;;; conseguimos uma regra valida para todas as posicoes
;;; do Rato, pois ele nunca estara' na posicao do PIVOT.
;;;
;;;---------------------------------------------------
;;; Foram necessarias 35 regras, listadas abaixo:

(defvar *regras* '(

  ;;       VETORES         COL. CRIT. FUNC.   RESPOSTA

  ( (( 0 2) ( 0 4) ( 0 6))  1  (1  1)  <>  (( 0  0) ( 1  1)) )
  ( ((-1 1) (-1 3) (-1 5))  2  (0  2)  <>  ((-1  1) ( 0  2)) )
  ( (( 0 2) ( 0 4) ( 1 5))  2  (1  3)  <>  (( 0  4) ( 1  3)) )
  ( (( 0 2) (-1 3) (-1 5))  2  (0  4)  <>  ((-1  3) ( 0  4)) )
  ( (( 0 2) ( 1 3) ( 1 5))  2  (1  1)  <>  (( 0  2) ( 1  1)) )
  ( (( 0 2) ( 0 4) (-1 5))  2  (0  6)  <>  ((-1  5) ( 0  6)) )
  ( (( 1 1) ( 1 3) ( 1 5))  2  (1 -1)  <>  (( 0  0) ( 1 -1)) )
  ( (( 0 2) ( 0 4) ( 0 6))  2  (1  5)  <>  (( 0  6) ( 1  5)) )
  ( (( 0 2) ( 0 4) (-1 5))  2  (0  6)  =   (( 0  4) ( 1  5)) )
  ( (( 0 2) ( 1 3) ( 1 5))  2  (1  1)  =   (( 1  5) ( 2  4)) )
  ( (( 0 2) ( 1 3) ( 2 4))  2  (2  0)  =   (( 0  2) ( 1  1)) )
  ( (( 0 2) ( 1 3) ( 2 4))  2  (2  2)  =   (( 0  0) ( 1  1)) )
  ( (( 1 1) ( 1 3) ( 2 4))  2  (0  0)  <>  (( 1  1) ( 2  0)) )
  ( (( 2 0) ( 1 3) ( 2 4))  2  (0  0)  <>  (( 0  0) ( 1  1)) )
  ( ((-1 1) (-1 3) ( 0 4))  2  (0  0)  <>  ((-1  1) ( 0  2)) )
  ( (( 0 2) (-1 3) ( 0 4))  2  (0  0)  <>  (( 0  4) ( 1  5)) )
  ( (( 0 2) (-1 3) ( 1 5))  2  (0  0)  <>  ((-1  3) ( 0  4)) )
  ( ((-1 1) ( 0 2) ( 1 3))  3  (2  0)  =   (( 0  0) ( 1 -1)) )
  ( ((-2 2) (-1 3) ( 0 4))  2  (0  0)  <>  ((-2  2) (-1  1)) )
  ( ((-1 1) ( 0 2) ( 1 3))  3  (2  2)  =   (( 0  0) ( 1  1)) )
  ( (( 2 0) ( 1 1) ( 2 2))  4  (4  0)  =   (( 0  0) ( 1 -1)) )
  ( (( 1 1) ( 0 2) ( 1 3))  3  (0  0)  <>  (( 0  0) ( 1 -1)) )
  ( (( 2 0) ( 1 1) ( 2 2))  4  (4  2)  =   (( 2  2) ( 3  3)) )
  ( (( 2 0) ( 1 1) ( 3 3))  4  (0  0)  <>  (( 1  1) ( 2  2)) )
  ( (( 2 0) ( 2 2) ( 3 3))  4  (0  0)  <>  (( 0  0) ( 1 -1)) )
  ( (( 1 1) ( 1 3) ( 2 4))  3  (0  0)  <>  (( 0  0) ( 1 -1)) )
  ( ((-1 1) (-1 3) (-1 5))  2  (0  2)  =   ((-1  5) ( 0  4)) )
  ( (( 0 2) ( 0 4) ( 0 6))  2  (1  5)  =   (( 0  0) ( 1  1)) )
  ( ((-1 1) (-1 3) (-1 5))  3  (0  0)  <>  ((-1  5) ( 0  4)) )
  ( ((-1 1) (-1 3) ( 0 4))  3  (0  2)  =   (( 0  4) ( 1  3)) )
  ( ((-1 1) (-1 3) ( 1 3))  3  (0  0)  <>  ((-1  3) ( 0  2)) )
  ( ((-1 1) (-1 3) ( 0 4))  3  (0  2)  <>  ((-1  3) ( 0  2)) )
  ( ((-1 1) ( 0 2) ( 0 4))  3  (1  1)  =   (( 0  4) ( 1  3)) )
  ( ((-1 1) ( 0 2) ( 0 4))  3  (1  1)  <>  (( 0  0) ( 1 -1)) )
  ( ((-2 2) (-1 3) (-1 5))  2  (0  0)  <>  ((-2  2) (-1  1)) )

  )
)

;;;---------------------------------------------------------
;;; Funcoes de jogada do  Gato :
;;; simplesmente chamam uma funcao comum que joga

(defun gato-inicia (jogada)
  (gato-joga jogada)
  )

(defun gato-responde (jogada)
  (gato-joga jogada)
  )

;;;----------------------------------------------------------
;;; Jogada do Gato : Procura uma regra que sirva e
;;; aplica-a.  Se nenhuma regra servir (nao deve
;;; acontecer nunca), entao chama funcao last-resort.

(defun gato-joga (jogada)
  (let*
    ((gatos (user::extrai-casas (cdr user::*posicao*)))
     (sorted (sort gatos #'menor))
     (pivot (car sorted))
     (vetor-rato (relativiza-casa (user::rato user::*posicao*) pivot))
     (vetores-gatos (relativiza (cdr sorted) pivot))
     )
    (usa-regras pivot vetor-rato vetores-gatos *regras*)
    )
  )

(defun usa-regras (pivot vetor-rato vetores-gatos regras)
  (if (null regras)
    (last-resort)
    (or
      (processa pivot vetor-rato vetores-gatos (car regras))
      (usa-regras pivot vetor-rato vetores-gatos (cdr regras))
      )
    )
  )

;;;--------------------------------------------------
;;; Processa: verifica se a regra em questao se aplica
;;; nesta posicao.  Caso se aplique, retorna a resposta;
;;; caso nao se aplique, retorna NIL.

(defun processa (pivot vetor-rato vetores-gatos regra)
  (if (matches (user::coluna pivot) vetores-gatos vetor-rato regra)
    (combina (nth 4 regra) pivot)
    nil
    )
  )

;;;--------------------------------------------------
;;; Usada na chamada de sort.  Coloca os gatos em
;;; ordem, para definir quem e' o pivot e a ordem
;;; dos restantes.

(defun menor (casa1 casa2)
  (or
    (< (user::coluna casa1) (user::coluna casa2))
    (and
      (= (user::coluna casa1) (user::coluna casa2))
      (< (user::linha  casa1) (user::linha  casa2))
      )
    )
  )

;;;--------------------------------------------------
;;; Verifica se a regra se aplica.

(defun matches (coluna vetores-gatos vetor-rato padrao)
  (and
    (equal vetores-gatos (first padrao))
    (= coluna (second padrao))
    (funcall (if (eq '= (fourth padrao)) #'equal #'noteq)
             vetor-rato (third padrao)
             )
    )
  )

(defun noteq (a b)
  (not (equal a b))
  )

;;;--------------------------------------------------
;;; Transforma casas absolutas em casas relativas ao
;;; PIVOT.

(defun relativiza-casa (casa pivot)
  (list 
    (- (user::linha  casa) (user::linha  pivot))
    (- (user::coluna casa) (user::coluna pivot))
    )
  )

;;;--------------------------------------------------
;;; Relativiza uma lista de casas.

(defun relativiza (lista pivot)
  (if (null lista)
    ()
    (cons (relativiza-casa (car lista) pivot)
          (relativiza (cdr lista) pivot)
          )
    )
  )

;;;--------------------------------------------------
;;; Faz o contrario de RELATIVIZA: dada uma casa
;;; relativa ao PIVOT e o proprio PIVOT, retorna
;;; a casa absoluta correspondente.

(defun combina-casa (casa pivot)
  (list 
    (+ (user::linha  casa) (user::linha  pivot))
    (+ (user::coluna casa) (user::coluna pivot))
    )
  )

;;;--------------------------------------------------
;;; Combina uma lista de casas relativas com um PIVOT
;;; fixo, dado.

(defun combina (lista pivot)
  (if (null lista)
    ()
    (cons (combina-casa (car lista) pivot)
          (combina (cdr lista) pivot)
          )
    )
  )

;;;------------------------------------------------------------
;;; Rato sera' ainda aleatorio --- para testes

(defun jogada-random (posicao frente)
  "Faz jogada aleatoria.
   Recebe a POSICAO, cujo primeiro
   elemento servira' de origem.
   Para verificar liberdade, usa
   *posicao* global.  Parametro
   FRENTE quando setado significa
   que so' vale ir pra frente (Gato)."
  (let* ((origem (user::rato posicao))
        (destino
          (random-list 
            (user::validas-e-livres
              (if frente
                (user::adj-frente origem)
                (user::adjacentes origem)
                )
              user::*posicao*
              )
            )
          )
        )
    (if (null destino)
      nil
      (list origem destino)
      )
    )
  )

(defun random-list (lista)
  "Retorna elemento ao acaso da LISTA.
   Se for vazia, retorna NIL"
  (if (null lista)
    nil
    (nth (random (length lista)) lista)
    )
  )

(defun gato-random (posicao)
  "Faz jogada aleatoria de  Gato .
   Testa cada gatinho por vez, para
   ver se algum pode jogar.  Seleciona
   uma jogada aleatoria do primeiro
   que puder"
  (if (null posicao)
    nil
    (let ((jogada (jogada-random posicao t)))
      (if (null jogada)
        (gato-random (cdr posicao))
        jogada
        )
      )
    )
  )

;;;-----------------------------------------
;;; Agora as funcoes propriamente ditas

(defun rato-inicia ()
  (jogada-random user::*posicao* nil)
  )

(defun rato-responde (jogada)
  (rato-inicia)
  )