;;;------------------------------------------------------------
;;; Gerenciador de campeonato
;;;
;;; Para o jogo de sudoku - um bola, o outro resolve.
;;;
;;; Funcao principal: campeonato
;;;
;;; Recebe uma lista de nomes de pacotes e promove um campeonato entre
;;; os ditos cujos.  Cada pacote e devera conter as seguintes funcoes:
;;;
;;;   manda-probl
;;;   resolve problema
;;;
;;; A funcao manda-probl deve retornar uma lista de dois elementos,
;;; sendo o primeiro deles um problema de sudoku, e o segundo uma
;;; solucao deste problema.  O formato de uma solucao e' uma lista de
;;; 81 digitos de 1 a 9, que descreve linha a linha a situacao de um
;;; tabuleiro resolvido de sudoku.  Por exemplo, o tabuleiro abaixo
;;; 
;;; 9  6  5 | 3  1  8 | 4  7  2
;;;         |         |
;;; 1  8  3 | 4  2  7 | 6  5  9
;;;         |         |
;;; 4  7  2 | 5  9  6 | 3  8  1
;;; --------+---------+--------
;;; 5  3  4 | 7  8  9 | 1  2  6
;;;         |         |
;;; 6  1  7 | 2  3  4 | 5  9  8
;;;         |         |
;;; 8  2  9 | 6  5  1 | 7  3  4
;;; --------+---------+--------
;;; 3  9  6 | 8  4  5 | 2  1  7
;;;         |         |
;;; 7  5  1 | 9  6  2 | 8  4  3
;;;         |         |
;;; 2  4  8 | 1  7  3 | 9  6  5
;;; 
;;; seria representado por:
;;; 
;;; ( 9  6  5  3  1  8  4  7  2
;;;   1  8  3  4  2  7  6  5  9
;;;   4  7  2  5  9  6  3  8  1
;;;   5  3  4  7  8  9  1  2  6
;;;   6  1  7  2  3  4  5  9  8
;;;   8  2  9  6  5  1  7  3  4
;;;   3  9  6  8  4  5  2  1  7
;;;   7  5  1  9  6  2  8  4  3
;;;   2  4  8  1  7  3  9  6  5 )
;;;
;;; Um problema tem representacao semelhante, so' que os espacos em
;;; branco sao identificados por 0.
;;; 
;;; Cada jogo e' iniciado com uma chamada da funcao "manda-probl" do
;;; pacote do primeiro jogador, seguida por uma chamada da funcao
;;; "resolve" do pacote do segundo jogador.
;;;
;;; Todos jogam contra todos.  O valor retornado por campeonato e' uma
;;; lista contendo o placar final, no seguinte formato:
;;;
;;; ( (jog1 pontos1)
;;;   (jog2 pontos2)
;;;    ...
;;;   (jogn pontosn)
;;; )
;;;
;;; onde (jog1 jog2 ... jogn) e' a lista de entrada e pontosi
;;; sao os pontos obtidos por cada jogador.
;;;
;;; Obs.: Cada par de jogadores joga duas partidas para que cada
;;; jogador tenha a chance de jogar tanto bolando como resolvendo.
;;;
;;; A pontuacao e' 10 pontos para uma bolacao correta, e T - tempo
;;; gasto para uma resolucao correta, onde T e' o temp maximo
;;; permitido.  Se usar mais de T segundos para resolver, ganha zero
;;; pontos.
;;;
;;; O gerenciador verifica se o primeiro jogador bolou um problema
;;; compativel com a solucao e se a solucao e' correta.  Verifica
;;; ainda se o segundo jogador deu numa solucao correta e compativel
;;; com o problema.  Se a solucao dada pelo resolvedor for diferente
;;; da indicada pelo bolador, o bolador perde seus 10 pontos de
;;; bolacao.
;;; 
;;; Tentaremos impor o limite de tempo de T segundos, mas vai depender
;;; das funcionalidades disponiveis nos interpretadores que usaremos.

(defun campeonato (jogadores)
  "Recebe lista de jogadores; imprime placar final"

  ;; inicializa placar - tudo zero
  (let ((placar (placar-inicial jogadores)))
    
    ;; joga todos contra todos
    ;; serao jogadas (n*n - n) partidas (quadrado todo menos a diagonal)
    (dolist (jog1 jogadores)
      (dolist (jog2 jogadores)
	(unless (equal jog1 jog2)
	  (terpri)
	  (carrega jog1)
	  (carrega jog2)
	  (format t "~s versus ~s" jog1 jog2)
	  (registra jog1
		    jog2
		    (print
		     (partida-por-nome jog1 jog2)
		     )
		    placar)
	  (terpri)
	  (tira-tudo (list jog1 jog2))
	  )
	)
      )
    (imprime placar)
    )
  )

;;;------------------------------------------------------------
;;; Placar-inicial: tudo zerado

(defun placar-inicial (jogadores)
  (if (null jogadores)
      nil
    (cons (list (car jogadores) 0)
	  (placar-inicial (cdr jogadores))
	  )
    )
  )

;;;------------------------------------------------------------
;;; Funcao registra: atualiza o placar com o resultado de uma
;;; partida.  Entrada: jog1 jog2 resultado placar.  Saida:
;;; nao importa.  O importante e' o efeito colateral na variavel
;;; placar.
;;; Possiveis resultados: veja comentario na funcao PARTIDA

(defun registra (jog1 jog2 resultado placar)
  "Recebe JOG1, JOG2, o RESULTADO e o PLACAR.
   Tem como efeito colateral a modificacao do
   PLACAR para refletir o resultado."
  (incf (second (assoc jog1 placar)) (first  resultado))
  (incf (second (assoc jog2 placar)) (second resultado))
  )

;;;------------------------------------------------------------
;;; Partida-por-nome: o mesmo que partida, mas so' que recebe
;;; apenas os nomes dos pacotes que vao jogar, e nao as funcoes.

(defun partida-por-nome (jog1 jog2)
  (partida (symbol-function (find-symbol "MANDA-PROBL" jog1))
	   (symbol-function (find-symbol "RESOLVE" jog2))
	   )
  )


;;;------------------------------------------------------------
;;; Remove os pacotes de uma lista de jogadores

(defun tira-tudo (jogadores)
  (dolist (jogador jogadores)
	  (delete-package jogador)
	  )
  )

;;;------------------------------------------------------------
;;; Funcao carrega: carrega o pacote de um jogador

(defun carrega (jogador)
  (load (string-downcase (symbol-name jogador)))
  )

;;;------------------------------------------------------------
;;; Funcao imprime: ordena e imprime o placar

(defun imprime (placar)
  (format t "~%Placar final:~%")
  (dolist (jog-ptos (sort placar #'> :key #'cadr))
    (format t "~s ~s~%" (first jog-ptos) (second jog-ptos))
    )
  )

;;;--------------------------------------------------
;;; Parte mais especifica do jogo de sudoku.
;;;
;;;---------------------------------------------------------

;;; A funcao partida recebe duas funcoes (manda-probl do primeiro jogador,
;;; resolve  do segundo jogador) e executa uma partida entre os dois.
;;; O valor retornado e' uma lista com a pontuacao de cada um.

(defvar *limite* 50)			; em segundos

(defun partida (manda-probl resolve)
  "Executa partida entre dois jogadores"

  (let* ((antes (get-internal-run-time))
	 (probl-sol (funcall manda-probl))
	 (depois (get-internal-run-time))
	 (tempo-em-seg
	  (float (/ (- depois antes) internal-time-units-per-second)))
	 )
    (print probl-sol)
    (format t "~% tempo: ~f seg.~%" tempo-em-seg)
    (if (and
	 (<= tempo-em-seg *limite*)
	 (validos probl-sol))
	(resultado probl-sol resolve)
      (list 0 *limite*)
      )
    )
  )

(defun validos (probl-sol)
  "Verifica se retorno de manda-probl esta' correto"
  (and
     (listp probl-sol)
     (= (length probl-sol) 2)
     (valida (second probl-sol))
     (valido (first probl-sol))
     (compativel (first probl-sol) (second probl-sol))
     )
  )

(defun resultado (probl-sol resolve)
  "O primeiro argumento ja' foi verificado, e' um par correto de
problema e solucao.  Esta funcao retorna o resultado a partir da
chamada de resolve"
  (let*
      ((problema (first  probl-sol))
       (solucao  (second probl-sol))
       (antes (get-internal-run-time))
       (retornada (funcall resolve problema))
       (depois (get-internal-run-time))
       (tempo-em-seg
	(float (/ (- depois antes) internal-time-units-per-second)))
       )
    (print retornada)
    (format t "~% tempo: ~f seg.~%" tempo-em-seg)
    (if (resposta-ok problema retornada)
	(list (if (equal solucao retornada)
		  10
		0)
	      (if (<= tempo-em-seg *limite*)
		  (- *limite* tempo-em-seg)
		0))
      (list 10 0)
      )
    )
  )

(defun valida (solucao)
  "Verifica se uma dada solucao e' valida"
  (and
   (consp solucao)
   (= (length solucao) 81)
   (eval (cons 'and (mapcar #'integerp solucao)))
   (eval (cons 'and (mapcar #'(lambda (n) (and (<= 1 n) (<= n 9))) solucao)))
   (linhas-ok solucao)
   (colunas-ok solucao)
   (quadrados-ok solucao)
   )
  )

(defun valido (problema)
  "Verifica se um dado problema e' valido"
  (and
   (consp problema)
   (= (length problema) 81)
   (eval (cons 'and (mapcar #'integerp problema)))
   (eval (cons 'and (mapcar #'(lambda (n) (and (<= 0 n) (<= n 9))) problema)))
   )
  )

(defun compativel (problema solucao)
  "Verifica se um problema e' compativel com uma solucao"
  (cond
   ((and (null problema) (null solucao)) t)
   ((or  (null problema) (null solucao)) nil)
   (t (and
       (compat (car problema) (car solucao))
       (compativel (cdr problema) (cdr solucao)))
      )
   )
  )

(defun resposta-ok (problema retornada)
  "Verifica se retorno de resolve esta' correto"
  (and
   (valida retornada)
   (compativel problema retornada)
   )
  )

(defun linhas-ok (solucao)
  "Verifica se as linhas estao ok numa solucao"
  (listas-ok (linhas-em-lista solucao))
  )

(defun colunas-ok (solucao)
  "Verifica se as colunas estao ok numa solucao"
  (listas-ok (colunas-em-lista solucao))
  )

(defun quadrados-ok (solucao)
  "Verifica se os quadrados estao ok numa solucao"
  (listas-ok (quadrados-em-lista solucao))
  )

(defun compat (n1 n2)
  "Verifica compatibilidade entre numeros. Zero e' compativel com
todos os outros.  Os outros sao apenas compativeis consigo mesmos."
  (if (or (= n1 0) (= n2 0))
      t
    (= n1 n2)
    )
  )

(defun linhas-em-lista (solucao)
  "Transforma uma solucao numa lista de 9 elementos, cada um deles
representando uma linha"
  (linear (distribui 9 solucao (circular (nove-nils))))
  )

(defun colunas-em-lista (solucao)
  "Transforma uma solucao numa lista de 9 elementos, cada um deles
representando uma coluna"
  (linear (distribui 1 solucao (circular (nove-nils))))
  )

(defun quadrados-em-lista (solucao)
  "Transforma uma solucao numa lista de 9 elementos, cada um deles
representando um quadrado"
  (append-all
   (mapcar #'(lambda (l) 
	       (linear (distribui 9 l (circular
				       (tres-nils))))
	       )
	   (linear (distribui 3 solucao (circular
					 (tres-nils)))
		   )
	   )
   )
  )

(defun listas-ok (lista)
  "Verifica se uma lista de 9 elementos, cada um deles sendo uma lista
de 9 digitos, esta' correta no sentido de cada lista ter os digitos de
1 a 9, uma vez cada um"
  (eval (cons 'and (mapcar #'lista-ok lista)))
  )

(defun nove-nils ()
  "Retorna uma lista com nove nils"
  (make-list 9 :initial-element nil)
  )

(defun tres-nils ()
  "Retorna uma lista com nove nils"
  (make-list 3 :initial-element nil)
  )

(defun circular (lista)
  "Transforma uma lista nao vazia em circular.  Nao mande vazia!"
  (setf (cdr (last lista)) lista)
  )

(defun distribui (n lista circular)
  "Distribui os elementos de lista de n em n numa outra lista circular
de listas.  Ou seja, os n primeiros de lista sao adicionados `a
primeira de circular, os proximos n `a segunda, e assim por diante.
Ao final, retorna-se a circular resultante.  O numero n tem que ser
divisor do comprimento de lista"
  (if (null lista)
      circular
    (distribui n 
	       (nthcdr n lista) 
	       (cdr (push-into-car (nfirst n lista) circular))
	       )
    )
  )

(defun lista-ok (linha)
  "Verifica se uma lista de 9 digitos contem os digitos de 1 a 9, uma
vez cada um"
  (is-permutation linha '(1 2 3 4 5 6 7 8 9))
  )

(defun linear (circular)
  "Transforma uma lista circular em linear"
  (let ((retval (cdr circular)))
    (setf (cdr circular) nil)
    retval
    )
  )

(defun append-all (lista-de-listas)
  "Concatena todas as listas presentes na lista recebida como
parametro"
  (if (null lista-de-listas)
      ()
    (append (car lista-de-listas)
	    (append-all (cdr lista-de-listas))
	    )
    )
  )

(defun nfirst (n lista)
  "Retorna uma lista com os n primeiros elementos de lista"
  (if (= n 0)
      nil
    (cons (car lista) (nfirst (1- n) (cdr lista)))
    )
  )
  
(defun push-into-car (nova lista)
  "Adiciona a nova lista ao primeiro elemento de lista, que deve ser
uma lista de listas (pode ser circular)"
  (let ((retval lista))
    (setf (car lista) (append nova (car lista)))
    retval
    )
  )

(defun is-permutation (lista1 lista2)
  "Verifica se duas listas sao permutacao uma da outra."
  (cond
   ((and (null lista1) (null lista2)) t)
   ((or  (null lista1) (null lista2)) nil)
   (t (and
       (member (car lista1) lista2)
       (is-permutation (cdr lista1) 
		       (remove (car lista1) lista2 :count 1))
       )
      )
   )
  )