;;; practica-3.lsp
;;; Ejercicios de matrices, entrada/salida, programacion de segundo orden y funciones
;;; como argumentos de entrada de otras funciones
;;; ---------------------------------------------------------------------------------


;;; (1) Supongamos que tenemos una matriz 3x3 tal que en una de sus
;;; componentes hay una 'X almacenada y en el resto NIL. Se pide:
;;;
;;;    a) Definir una funcion (escribe-matriz A) que recibiendo como
;;;    entrada una matriz A como las descritas, la presente en pantalla
;;;    de la siguiente manera (en el dibujo suponemos que la 'X esta
;;;    en la componente (0 1)):
;;;
;;;    +-+-+-+
;;;    | |X| |
;;;    +-+-+-+
;;;    | | | |
;;;    +-+-+-+
;;;    | | | |
;;;    +-+-+-+
;;;
;;;    b) Definir una funcion (mueve) que interactua con el
;;;    usuario, que indica como "mover" la 'X por la matriz. Esta
;;;    funcion debe de leer por pantalla el comando tecleado por el
;;;    usuario y mostrar el correspondiente mensaje o dibujo. En
;;;    concreto:
;;;      - Si se teclea arriba, abajo, derecha o izquierda, debe
;;;        mover la X una casilla en la direccion indicada, siempre
;;;        que sea posible, mostrando el correspondiente dibujo, y
;;;        permitiendo la introduccion de un nuevo comando. En el
;;;        caso de que el movimiento no fuera posible, debe mostrar el
;;;        correspondiente mensaje de error, e igualmente permitir la
;;;        introduccion de un nuevo comando. 
;;;      - Si se teclea fin, debe parar.
;;;      - Con cualquier otro palabra, debe mostrar el
;;;        correspondiente mensaje de error, e igualmente permitir la
;;;        introduccion de un nuevo comando. 
;;;    Considerar que inicialmente la 'X esta en (0 0)
;;;    ATENCION: No se permite el uso de variables globales.




(defun escribe-matriz (a)
       (let* ((dim (array-dimensions a))
                       (f (first dim))
                       (c (second dim)))
               (escribe-linea-aux c)
               (loop for i from 0 to (- f 1)
                       do (loop for j from 0 to (- c 1)
                               do (if (equal (aref a i j) NIL)
                                       (format t "| ")
                                       (format t "|~a" (aref a i j))))
                       (format t "|~%")
                       (escribe-linea-aux c))))

(defun escribe-linea-aux (col)
       (loop for i from 0 to (- col 1)
               do (format t "+-"))
       (format t "+~%"))

(setf A
      (make-array '(3 3)
                  :initial-contents '((X nil nil)
                                      (nil nil nil)
                                      (nil nil nil))))
(defun mueve (a)
  (let* ((dim (array-dimensions a))
	 (f (first dim))
	 (c (second dim))
         (mov t)
         (posx 0)
         (posy 0))
    (loop until (equal mov 'fin) do 
	  (format t "~%Escribe una movimiento : ")	  
	  (setf mov (read))
	  (cond 
	   ((and (eq mov 'arriba) (< -1 (- posx 1)))
	    (mover A posx posy (- posx 1) posy)
	    (setf posx (- posx 1))
	    (format t "x:~a y:~a" posx posy))
	   ((and (eq mov 'abajo) (> f (+ posx 1)))
	    (mover A posx posy (+ posx 1) posy)
	    (setf posx (+ posx 1))
	    (format t "x:~a y:~a" posx posy))	    
	   ((and (eq mov 'izquierda) (< -1 (- posy 1)))
	    (mover A posx posy posx (- posy 1))
	    (setf posy (- posy 1))
	    (format t "x:~a y:~a" posx posy))
	   ((and (eq mov 'derecha) (> f (+ posy 1)))
	    (mover A posx posy posx (+ posy 1))
	    (setf posy (+ posy 1))
	    (format t "x:~a y:~a" posx posy))
	   (t
	    (format t "movimiento no permitido~%")
	    (escribe-matriz A))))))

(defun mover (A posx posy nposx nposy)
  (setf (aref A posx posy) nil)
  (setf (aref A nposx nposy) 'X)
  (escribe-matriz A))

  
(mueve A)
 
(setf A
      (make-array '(3 3)
		  :initial-contents '((X nil nil)
				       (nil nil nil)
				       (nil nil nil))))




;;; (2) Definir una funcion (ORDENA-LINEAS <ARCHIVO1> <ARCHIVO2>)
;;; que recibiendo como entrada el nombre de un archivo existente de texto
;;; <ARCHIVO1>  cree un fichero nuevo <ARCHIVO2> en el que aparecen las
;;; mismas lineas que en <ARCHIVO1> pero ordenadas alfabeticamente.


(setq m (make-array '(10 2)))
(setq salida (open "temporal" :direction :output))
(do ((n 1 (+ n 1)))((> n 10))(format salida "~&~4D~10D" n (* n n n)))
(close salida)
(setq entrada (open "temporal" :direction :input))
(do ((n 0 (+ n 1)))((> n 9))
   (setf (aref m n 0) (read entrada))
   (setf (aref m n 1) (read entrada)))

(defun mi-cat (fichero)
  (let ((list l nil))
  (with-open-file (stream fichero :direction :input)
    (do ((linea (read-line stream nil 'fin)
                (read-line stream nil 'fin)))
        ((eql linea 'fin))
        (format t "~a~%" linea))))

(extrae-lineas 'tmp ())
(ordena-lineas 'temp nil)

(defun ordena-lineas (fichero1 fichero2)
 (let ((lineas ()))
  (extrae-lineas fichero1 lineas)
  (setf lineas (sort lineas #'string-lessp))
  (format t "~a" lineas)))
  (escribe-lineas fichero2 lineas)))
  
  
(defun extrae-lineas (fichero lineas)
  (with-open-file (stream fichero :direction :input)		   
    (do ((linea (read-line stream nil 'fin)
                (read-line stream nil 'fin)))
        ((eql linea 'fin))
        (cons (list linea) lineas))))



(defun escribe-lineas (fichero2 lineas)
  (setq salida (open fichero2 :direction :output))
  (loop for x in lineas do
        (write-line x salida))
  (close salida))

(escribe-lineas 'tmp (("hola")("me gustas")("mucho")))

; (3) Deseamos obtener persistencia de datos para la tabla-hash de tiradores
;;; definida en la anterior practica. Para ello se define el siguiente formato
;;; de fichero:

;;; NICK
;;; NOMBRE
;;; PUNTUACION
;;; Numero de filas del tablero actual (n)
;;; Numero columnas del tablero actual (m)
;;; (X11 X12 X13 ... X1m)
;;;
;;; (Xn1 Xn2 Xn3 ... Xnm)
;;; Numero de acciones (k)
;;; Accion1
;;; Accion2
;;; ...
;;; Accionk

;;; Donde cada accion puede venir definida como una de estas tres:
;;; 1.- ROTAR
;;; 2.- (a b) Siendo 0<=a<n y 0<=b<m (Esto representaria un disparo simple)
;;; 3.- ((a b)) Siendo 0<=a<n y 0<=b<=m (Esto representaria un disparo extra)

;;; (3.1) Definir una funcion (SAVE-TIRADORES <TABLA-HASH> <FICHERO>) que recibe una
;;; tabla-hash de tiradores y crea el fichero cuyo nombre se pasa como parametro.

;;; Ejemplo:

;;; > *tiradores-sw*
;;; #S(HASH-TABLE EQL
;;;    (HAN .
;;;     #S(TIRADOR :NOMBRE "Han Solo" :PUNTUACION 12
;;;        :TABLERO #2A((1 2 3 2 1) (2 4 6 4 2) (4 8 16 8 4) (2 4 6 4 2) (1 2 3 2 1))
;;;        :DISPAROS ((1 0) (3 3) (2 3) ((0 0)) ROTAR (4 1))))
;;;    (BLACKY .
;;;     #S(TIRADOR :NOMBRE "Black Hunter" :PUNTUACION -10
;;;        :TABLERO #2A((1 0 3) (2 1 6) (10 8 16) (2 4 6) (1 2 3))
;;;        :DISPAROS NIL)))

;;; > (save-tiradores *tiradores-sw* "file.txt")

;;; Contenido del fichero "file.txt" resultante:

;;; HAN
;;; Han Solo
;;; 12
;;; 5
;;; 5
;;; (1 2 3 2 1)
;;; (2 4 6 4 2)
;;; (4 8 16 8 4)
;;; (2 4 6 4 2)
;;; (1 2 3 2 1)
;;; 6
;;; (1 0)
;;; (3 3)
;;; (2 3)
;;; ((0 0))
;;; ROTAR
;;; (4 1)
;;; BLACKY
;;; Black Hunter
;;; -10
;;; 5
;;; 3
;;; (1 0 3)
;;; (2 1 6)
;;; (10 8 16)
;;; (2 4 6)
;;; (1 2 3)
;;; 0















;;; (3.2) Definir una funcion (LOAD-TIRADORES <TABLA-HASH> <FICHERO>) que actualiza
;;; <TABLA-HASH> con los tiradores de <FICHERO>. Si algun nick del fichero ya existe
;;; en la tabla-hash, ese tirador no se daria de alta, se mostraria el correspondiente
;;; mensaje de error y se pasaria al tirador siguiente.
;;; Al final de la carga hay que mostrar por pantalla un mensaje con el numero tiradores
;;; cargados.















;;; (4) Un Arbol binario numerico (ABN de aquí en adelante) es una estructura de datos
;;; recursiva que consta de un numero entero no negativo (llamado raiz del Arbol)
;;; y de dos ABN llamados hijo izquierdo e hijo derecho. Existe un ABN particular que no
;;; tiene raiz ni hijos que llamaremos el Arbol vacio.

;;; En nuestra implementacion, usaremos la siguiente representación de
;;; los ABN:
;;;	- El Arbol vacio lo representaremos por NIL.
;;;	- Un Arbol binario con raiz n, hijo izquierdo HI e hijo derecho HD lo
;;;	  representaremos por la lista de tres elementos (HI n HD)
;;;	  donde HI, HD son la representacion del hijo izquierdo e hijo derecho
;;;	  respectivamente.

;;; Ejemplo:
;;; El Arbol:             4
;;;                      / \
;;;                     /   \
;;;                    3     1

;;; lo representamos por la lista  ((() 3 ()) 4 (() 1 ()))
;;;
;;; Para resolver este ejercicio, usaremos las siguientes definiciones:

;;; Constructores y selectores

;;; Es arbol vacio?
(defun vacio? (a)
  (null a))

;;; El arbol vacio
(defun el-vacio ()
  NIL)

;;; Raiz de un arbol
(defun raiz (a)
  (if (vacio? a)
      NIL
      (cadr a)))

;;; Hijo izquierdo
(defun hi (a)
  (if (vacio? a)
      NIL
      (car a)))

;;; Hijo derecho
(defun hd (a)
  (if (vacio? a)
      NIL
      (caddr a)))

;;; Construye un arbol
(defun haz-arbol (raiz hi hd)
  (list hi raiz hd))

;;; Fin de constructores y selectores


;;; Patron de recursion sobre arboles binarios
(defun recursion-abn (germen proc)
  (labels ((aux
            (a)
            (if (vacio? a)
                germen
                (funcall proc (raiz a) (aux (hi a)) (aux (hd a))))))
            (function aux)))

;;; La funcion recursion-abn implementa un patron muy comun de efectuar recursion en ABN.

;;; NOTAS:
;;; Todos los apartados de este ejercicio deben ser resueltos utilizando el patron de
;;; recursion.
;;; Para respetar el tipo abstracto de datos, usar los constructores y selectores anteriores
;;; en las funciones que a continuacion se piden.

;;; EJEMPLOS:
;;; Arbol obtenido sumando 1 a cada nodo:
;;; (defun suma-uno (abn)
;;;   (funcall (recursion-abn (el-vacio)
;;;                           #'(lambda (x y z) (haz-arbol (+ x 1) y z)))
;;;            abn))
  

;;; Arbol obtenido aplicando f a cada nodo:
;;; (defun aplica-f (f abn)
;;;  (funcall (recursion-abn (el-vacio)
;;;                          #'(lambda (x y z) (haz-arbol (funcall f x) y z)))
;;;           abn))

;;; --------------------------------------------------------------------------------------

;;; (4.1) Define una funcion suma-todos que recibe como entrada un ABN A y
;;; devuelve la suma de todos los nodos de A (0 si es vacio)










;;; (4.2) Define una funcion intercambia que recibe como entrada un ABN A y
;;; devuelve el ABN A' obtenido intercambiando el hijo izquierdo con el hijo
;;; derecho a todos los niveles.










;;; (4.3) Define una funcion mayor-de-todos que recibe como entrada un ABN A
;;; y devuelve el mayor de los nodos de A (0 si es vacio).










;;; (4.4) Define una funcion sustituye que recibe como entrada un ABN A y
;;; devuelve el ABN A' obtenido a partir de A sustituyendo cada nodo n por la
;;; suma de todos los nodos de la descendencia de n.










;;; (4.5) Define una funcion es-nodo-de? que recibe como entrada un numero
;;; n y un ABN A y devuelve T si n es nodo de A, y NIL en caso contrario.













;;; (5.1) Define una funcion get-profundidad que obtiene el numero maximo
;;; de listas anidadas que aparecen en una lista.
;;; Para resolver este ejercicio es obligatorio usar las definiciones
;;; MAPCAR y APPLY.

;;; Ejemplo:
;;; > (get-profundidad '((1 (2)) (((5 7))) 4))
;;; > 3













;;; (5.2) Definir una funcion resta-listas que devuelve una lista con los
;;; elementos de la primera lista que no aparecen en la segunda.
;;; Para resolver este ejercicio es obligatorio usar la definicion REMOVE-IF.

;;; Ejemplo:
;;; > (resta-listas '(1 2 3 4) '(2 3))
;;; > (1 4)