;;; 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)