Febrero2016

Un ciclo euleriano en un grafo es un camino que empieza y termina en el mismo vértice y que visita todas las aristas del grafo exactamente una vez. Leonhard Euler conjeturó en 1736 que un grafo conectado tiene ciclo euleriano si y solo si todos sus vértices tienen grado par. Años más tarde Carl Hierholzer demostró esta conjetura. El objetivo del examen es escribir programas para calcular un ciclo euleriano de un grafo euleriano usando un algoritmo propuesto por el propio Hierholzer. En el examen asumiremos que los grafos son conexos y tienen al menos dos vértices.

Haskell

Descarga del campus virtual el archivo comprimido que contiene las fuentes para resolver el problema y comprobar tu solución. Completa las definiciones de funciones del fichero DataStructures\Graph\EulerianCycle.hs. Este es el único fichero que tienes que modificar y el único fichero que debes subir a través del enlace de entrega del campus virtual. Ten en cuenta que tu solución debe compilar sin errores para que se considere adecuada.

H.1) (0.5 puntos) Un grafo es euleriano si tiene ciclo euleriano. Basándote en la conjetura de Euler, define una función isEulerian que recibe un grafo y devuelve True si y solo si es euleriano.

H.2) (0.5 puntos) La biblioteca DataStructures.Graph.Graph exporta la función:
 deleteVertex :: (Eq a) => Graph a -> a -> Graph a
para borrar un vértice de un grafo, y la función:
 deleteEdge :: (Eq a) => Graph a -> (a,a) -> Graph a
para borrar una arista de un grafo.
Un vértice se dice aislado si su grado es cero. Define una función remove que toma un grafo y una arista y borra la arista del grafo, así como todos los nodos que queden aislados después de borrar la arista.

H.3) (0.75 puntos) Sean g un grafo euleriano y v0 uno de sus vértices (puedes asumir estas precondiciones en tu programa). Define una función extractCycle que tome el grafo g y el vértice v0 y extraiga un ciclo (no necesariamente euleriano) de g que comienza en v0. Utiliza para ello el siguiente algoritmo voraz:
Inicialmente el ciclo contiene solo el vértice v0. Sea v inicialmente el vértice v0, y u algún sucesor del vértice v, añade u al ciclo, elimina la arista (v,u) así como cualquier vértice aislado del grafo g (utiliza la función del apartado anterior). Repite estos pasos desde el vértice u hasta alcanzar el vértice inicial v0.

Además del ciclo extraído, la función extractCycle debe devolver el nuevo grafo que queda tras borrar todas las aristas contenidas en el ciclo extraído, así como todos los vértices que han quedado aislados tras la extracción.

H.4) (0.75 puntos) Sean xs un ciclo euleriano parcial1 e ys un ciclo no vacío. La función connectCycles devuelve una combinación de ambos ciclos. Si xs es vacío, entonces el resultado es ys. Si xs no es vacío, podemos asumir la siguiente precondición: el primer vértice de ys, al que llamaremos y, aparece en xs. En este caso, el ciclo combinado resultante se obtiene reemplazando la primera aparición del vértice y en xs por ys. Por ejemplo:
 connectCycles [] [A,B,C,D,E,A] => [A,B,C,D,E,A]
 connectCycles [A,B,C,D,E,A] [C,F,G,C] => [A,B,C,F,G,C,D,E,A]
Define la función connectCycles.

H.5) (0.5 puntos) Define una función vertexInCommon que toma como parámetros un grafo g y un ciclo xs y devuelve un vértice que aparece tanto en el grafo g como en el ciclo xs. Puedes asumir que siempre hay al menos un vértice en común.

H.6) (0.75 puntos) Define una función eulerianCycle que toma un grafo y devuelve un ciclo euleriano del grafo. Si el grafo no es euleriano, se debe terminar con error. En otro caso, se deben extraer y conectar ciclos del grafo hasta que éste quede vacío. La combinación de todos los ciclos extraídos será un ciclo euleriano. Empieza extrayendo un ciclo desde un vértice cualquiera del grafo. Éste es el primer ciclo euleriano parcial. Mientras el grafo resultante de la extracción no esté vacío, repite el siguiente proceso: toma un vértice del grafo resultante que también aparezca en el ciclo euleriano parcial, extrae un ciclo del grafo que comience en ese vértice, y conecta ese nuevo ciclo al ciclo euleriano parcial para obtener el nuevo ciclo euleriano parcial. Al finalizar el proceso, el ciclo euleriano estará completo. Utiliza las funciones definidas anteriormente para implementar el algoritmo.

Java

Descarga del campus virtual el archivo comprimido que contiene el proyecto Eclipse para resolver el problema y comprobar tu solución. Completa las definiciones de métodos del fichero dataStructures\graph\EulerianCycle.java. Este es el único fichero que tienes que modificar y el único fichero que debes subir a través del enlace de entrega del campus virtual. Ten en cuenta que tu solución debe compilar sin errores para que se considere adecuada.

J.1) (0.5 puntos) Define un método:
 private static boolean isEulerian(Graph g) 
que devuelva true si y solo si el grafo es euleriano.

J.2) (0.5 puntos) Define un método: 
 private static void remove(Graph g, V v, V u) 
similar a la función Haskell remove del apartado H.2.

J.3) (0.75 puntos) Define un método:
 private static List extractCycle(Graph g, V v0) 
similar a la función Haskell extractCycle del apartado H.3. En este caso, en lugar de devolver una tupla con el ciclo y el grafo, el ciclo extraído se devuelve como resultado del método, y el grafo g pasado como parámetro se modifica durante la extracción. 

J.4) (0.75 puntos) Define un método: 
 private static void connectCycles(List xs, List ys) 
similar a la función Haskell connectCycles del apartado H.4. En este caso, el método es void y el resultado queda almacenado en el primer parámetro xs.

J.5) (0.5 puntos) Define un método: 
 private static V vertexInCommon(Graph g, List xs) 
similar a la función Haskell vertexInCommon del apartado H.5.

J.6) (0.75 puntos) Define un método: private static List eulerianCycle(Graph g) similar a la función Haskell eulerianCycle del apartado H.6.

Mensajes y semaforos

Ejercicio1
public class MaxminDemo {
    public static final int numProcesos=5;


    public static void main(String[] args) {
        ArrayList<Channel<Integer>> izq=new ArrayList<Channel<Integer>>();
        ArrayList<Channel<Integer>> der=new ArrayList<Channel<Integer>>();

        for (int i = 0; i < numProcesos+1; i++) {
            izq.add(new Channel<Integer>());
            der.add(new Channel<Integer>());
        }
       
        Nodo []p=new Nodo[numProcesos];
        for (int i = 0; i < numProcesos; i++) {
            p[i]=new Nodo(i,der.get(i),izq.get(i+1),izq.get(i),der.get(i+1));
            p[i].start();
        }
   
    }
}
class Nodo extends Thread {
    int id;
    Channel<Integer> entradaIzq, entradaDer, salidaIzq, salidaDer;

    public Nodo(int id, Channel<Integer> enti, Channel<Integer> entd, Channel<Integer> sali, Channel<Integer> sald) {
        this.id = id;
        this.entradaIzq = enti;
        this.entradaDer = entd;
        this.salidaIzq = sali;
        this.salidaDer = sald;
    }

    public void run() {
        Random r = new Random();
        int num, min, max;

        num = r.nextInt(1000);
        min = max = num;
        System.out.println("se inicializa el nodo con: "+ min+"-"+max);
        try {
            //si no es el primero recibe de la izquierda el valor minimo y maximo
            if (id != 0) {
                min = entradaIzq.receive().intValue(); // recibe el minimo actual desde la izquierda
                max = entradaIzq.receive().intValue(); // recibe el maximo actual desde la izquierda
                System.out.println(min+"-"+max);
            }
            // actualiza min y max
            if (num < min) {
                min = num;
            }
            if (num > max) {
                max = num;
            }

            //siempre que no sea el ultimo envia a la derecha el minimo y el maximo
            if (id != MaxminDemo.numProcesos - 1) { // enviar hacia la derecha
                salidaDer.send(new Integer(min));
                salidaDer.send(new Integer(max));

                // esperar min y max definitivos
                min = entradaDer.receive().intValue();
                max = entradaDer.receive().intValue();
            }
            System.out.println("nodo " + id + " minimo: " + min + " maximo: "
                    + max);

            if (id != 0) { // enviar hacia la izquierda
                salidaIzq.send(new Integer(min));
                salidaIzq.send(new Integer(max));
            }
        } catch (InterruptedException ex) {
        }
    }
}
- - - -
public class HebrasIguales {

    public static int numProcesos = 5;
   
    public static void main(String[] args) {
        ArrayList<Channel<Integer>> izq = new ArrayList<Channel<Integer>>();
        ArrayList<Channel<Integer>> der = new ArrayList<Channel<Integer>>();
       
        for (int i =0 ;i<numProcesos+1;i++){
            izq.add(new Channel<Integer>());
            der.add(new Channel<Integer>());
        }
       
        Nodo_2 [] p = new Nodo_2[numProcesos];
       
        for (int i =0 ;i<numProcesos;i++){
            p[i] = new Nodo_2(i, der.get(i),der.get(i+1),izq.get(i),izq.get(i+1));
            p[i].start();
           
        }    
    }
}
 public class Nodo_2 extends Thread {

    int num, id, izq, der;
    int cont = 0;
    Channel<Integer> entradaI, entradaD, salidaD, salidaI;
    String fin = "";
    ArrayList<Integer> numeros = new ArrayList<Integer>();


    public Nodo_2(int id, Channel<Integer> entradaD, Channel<Integer> salidaD,
            Channel<Integer> salidaI, Channel<Integer> entradaI) {
        this.id = id;
        this.entradaD = entradaD;
        this.entradaI = entradaI;
        this.salidaD = salidaD;
        this.salidaI = salidaI;
    }

    public void run() {

        Random rnd = new Random();
        num = rnd.nextInt(10) + 1;

        try {
            if (id != 0) {
                izq = entradaD.receive().intValue();
            }

            if (id != HebrasIguales.numProcesos - 1) {
                salidaD.send(num);
            }
            if (id != 0) {
                salidaI.send(num);
            }
            if (id != HebrasIguales.numProcesos - 1) {
                der = entradaI.receive().intValue();
            }
            numeros.add(num);

            //System.out.println("[" + izq + "-" + num + "-" + der + "]");
        } catch (InterruptedException e) {

        }
      
        for (int i = 0; i < numeros.size(); ++i) {
            System.out.print("["+numeros.get(i)+",p:"+id+"]");
        }
      
    }

}
- - - -

public class hebranum {
    private static final int NHEBRAS = 10;
    static class BidirChannel<T> {
        private Channel<T> canal1 = new Channel<T>();
        private Channel<T> canal2 = new Channel<T>();
        private int mode = 0;
        public class EndPoint {
            private Channel<T> canal_s;
            private Channel<T> canal_r;
            private EndPoint(int mode) {
                switch (mode) {
                case 0:
                    canal_s = canal1;
                    canal_r = canal2;
                    break;
                case 1:
                    canal_s = canal2;
                    canal_r = canal1;
                    break;
                default:
                    throw new IllegalArgumentException();
                }
            }
            public void send(T v) throws InterruptedException {
                canal_s.send(v);
            }
            public T receive() throws InterruptedException {
                return canal_r.receive();
            }
            public void addToSelect(Select sel) {
                sel.add(canal_r);
            }
            public void guard(boolean g) {
                canal_r.guard(g);
            }
            public Channel<T> sendChannel() {
                return canal_s;
            }
            public Channel<T> recvChannel() {
                return canal_r;
            }
        }
        public EndPoint getEndPoint() {
            return new EndPoint(mode++);
        }
        public EndPoint getEndPoint(int mode) {
            return new EndPoint(mode);
        }
    }
    static class Hebra implements Runnable {
        private Random rnd = new Random();
        private int nhebras;
        private int id;
        private BidirChannel<Integer>.EndPoint izq;
        private BidirChannel<Integer>.EndPoint dch;
        public Hebra(int nhebras, int id,
                     BidirChannel<Integer>.EndPoint i,
                     BidirChannel<Integer>.EndPoint d) {
            this.nhebras = nhebras;
            this.id = id;
            this.izq = i;
            this.dch = d;
        }
        public void run () {
            ArrayList<Integer> hebras_ids = new ArrayList<Integer>();
            int num, h, n;
            num = rnd.nextInt(10);
            synchronized (System.out) {
                System.out.println("INICIO Id: "+id+" Num: "+num);
            }
            try {
                if (izq != null) {
                    for (int i = 0; i < id; ++i) {
                        h = izq.receive();
                        n = izq.receive();
                        if (dch != null) {
                            dch.send(h);
                            dch.send(n);
                        }
                        if (n == num) {
                            hebras_ids.add(h);
                        }
                    }
                }
                if (dch != null) {
                    dch.send(id);
                    dch.send(num);
                }
                if (dch != null) {
                    for (int i = 0; i < (nhebras-id-1); ++i) {
                        h = dch.receive();
                        n = dch.receive();
                        if (izq != null) {
                            izq.send(h);
                            izq.send(n);
                        }
                        if (n == num) {
                            hebras_ids.add(h);
                        }
                    }
                }
                if (izq != null) {
                    izq.send(id);
                    izq.send(num);
                }
            } catch (InterruptedException e) {
                e.printStackTrace();
            }

            synchronized (System.out) {
                System.out.print("Id: "+id+" Num: "+num+" [");
                for (int i = 0; i < hebras_ids.size(); ++i) {
                    System.out.print(" "+hebras_ids.get(i));
                }
                System.out.println(" ]");
            }
        }
    }

    public static void main(String[] args) {
        // H0 <--0--> H1 <--1--> H2 <--2--> H3 ... Hn-1
        try {
            ArrayList<BidirChannel<Integer>> canal=new ArrayList<BidirChannel<Integer>>();
            for (int i = 0; i < NHEBRAS-1; ++i) {
                canal.add(new BidirChannel<Integer>());
            }
            Thread[] hebra = new Thread[NHEBRAS];
            for (int i = 0; i < hebra.length; ++i) {
                BidirChannel<Integer>.EndPoint izq = null;
                BidirChannel<Integer>.EndPoint dch = null;
                if (i-1 >= 0) { izq = canal.get(i-1).getEndPoint(0); }
                if (i < canal.size()) { dch = canal.get(i).getEndPoint(1); }
                hebra[i] = new Thread(new Hebra(NHEBRAS, i, izq, dch));
                hebra[i].start();
            }
            for (int i = 0; i < hebra.length; ++i) {
                hebra[i].join();
            }
        } catch (Exception e) {
            e.printStackTrace();
        }
    }
}
- - - -
Ejercicio 4(Camellos)
enum Estado { gana, pierde, sigue};

public class CamelloDemo {
    static final int NUMC=10;
   
    /**
     * @param args
     */
    public static void main(String[] args) {
        ArrayList<Channel<Integer>> c=new ArrayList<Channel<Integer>>();
        ArrayList<Channel<Estado>> gana=new ArrayList<Channel<Estado>>();


        for (int i = 0; i < NUMC; i++) {
            c.add(new Channel<Integer>());
            gana.add(new Channel<Estado>());
        }
       
        Camello []cam=new Camello[NUMC];
        for (int i = 0; i < NUMC; i++) {
            cam[i]=new Camello(i,c.get(i),gana.get(i));
            cam[i].setName("cam"+i);
        }
       
        Caseta cas=new Caseta(c,gana);
        cas.setName("cas");
       
        for (int i = 0; i < NUMC; i++) {
            cam[i].start();
        }
       
        cas.start();
    }

}



class Camello extends Thread {
    Channel<Integer> sal;
    Channel<Estado> gana;
    int id;
   
    Camello(int id,Channel<Integer> sal,Channel<Estado> gana) {
        this.id=id;
        this.sal=sal;
        this.gana=gana;
    }
   
   
    public void run() {
        Random r=new Random();
        int v;
        Estado est;
        boolean fin=false;
       
        try {
        do {
            v=r.nextInt(3);
            sal.send(new Integer(v));
            est=gana.receive();
            fin=est==Estado.pierde || est==Estado.gana;
            if (est==Estado.gana) {
           
                System.out.println("Camello "+id+" soy el ganador");           
            }
            else if (est==Estado.pierde) {
                System.out.println("Camello "+id+" pierdo");
            }
        } while (!fin);
        } catch (InterruptedException ex) {}
    }
}



class Caseta extends Thread {
    ArrayList<Channel<Integer>> c;
    ArrayList<Channel<Estado>> gana;
    Select sel;
   
    Caseta(ArrayList<Channel<Integer>> c,ArrayList<Channel<Estado>> gana) {
        this.c=c;
        this.gana=gana;
        sel=new Select();
        for (int i=0;i<c.size();i++) {
            sel.add(c.get(i));
        }       
    }
   
   
    public void run() {
        boolean terminado=false;
        int []posiciones=new int[CamelloDemo.NUMC];
        int rama=0,ju;
        Estado res;

        for (int i=0;i<posiciones.length;i++)
            posiciones[i]=0;

        try {
        do {           
            rama=sel.choose();
            ju=c.get(rama-1).receive().intValue();
            System.out.println("camello "+(rama-1)+" avanza "+ju+" queda: "+(10-posiciones[rama-1]-ju));
            posiciones[rama-1]=posiciones[rama-1]+ju;

            terminado=posiciones[rama-1]>=10;
            if (terminado)
                res=Estado.gana;
            else
                res=Estado.sigue;
            gana.get(rama-1).send(res);       
           
        } while (!terminado);

        // Informar al resto de la derrota
        for (int i=0;i<CamelloDemo.NUMC-1;i++) {
            // Acepto sus jugadas
            rama=sel.choose();
            c.get(rama-1).receive();
           
            // Informo de derrota
            res=Estado.pierde;
            gana.get(rama-1).send(res);   
        }

        } catch (InterruptedException ex) {}

    }

}

- - - -
Semaforos

public class Robots {
    static int tamCinta = 10;
    static int numEmpaq = 0;
    static int[] cinta = new int[tamCinta];
    static Semaphore semHayDatos = new Semaphore(tamCinta);
    static Semaphore[] semProd = {new Semaphore(0), new Semaphore(0), new Semaphore(0)};
    static Semaphore mutexNumEmpaq = new Semaphore(1);
//    static Semaphore mutexCinta = new Semaphore(1);
   
   
    static class Productor extends Thread {
        public void run() {
            int tipo,i;
            char producto;
            Random r=new Random();
           
            try {
                while (true) {
                    tipo=r.nextInt(3);
                    System.out.printf("Produciendo tipo %d\n", tipo);
                    //Thread.sleep((int) (Math.random() * 3000));
                    semHayDatos.acquire();
                    i=0;
                    //mutexCinta.acquire();
                    while (cinta[i] != -1) i++;
                    cinta[i] = tipo;
                    //mutexCinta.release();

                    semProd[tipo].release();
                }
            } catch (InterruptedException e) {}
        }
    }
   
    static class Empaquetador extends Thread {
        private int tipo;
       
        Empaquetador(int tipo) {
            this.tipo = tipo;
        }
       
        public void run() {
            int i;
            try {
                while (true) {
                    semProd[tipo].acquire();
                    i=0;
                    //mutexCinta.acquire();

                    while (cinta[i] != tipo) i++;
                                       
                    System.out.printf("Empaquetando tipo %d en pos %d\n", tipo, i);                   
                    cinta[i] = -1;
                    //mutexCinta.release();

                    semHayDatos.release();
                   
                    //Thread.sleep((int) (Math.random() * 3000));
                    mutexNumEmpaq.acquire();
                    numEmpaq++;
                    System.out.printf("%d empaquetados.\n", numEmpaq);
                    mutexNumEmpaq.release();
                }
            } catch (InterruptedException e) {}
        }
    }
   
    public static void main(String[] args) {
        Productor prod = new Productor();
        Empaquetador[] empaqs = {new Empaquetador(0), new Empaquetador(1), new Empaquetador(2)};
        for (int i=0;i<tamCinta;i++)
            cinta[i]=-1;
        prod.start();
        for (Empaquetador e : empaqs)
            e.start();
    }
}

- - - -
public class Grupo {
// suponemos la sala vacia
private Semaphore semProcesoA = new Semaphore(1, true);
private Semaphore semProcesoB = new Semaphore(1, true);
private Semaphore mutex = new Semaphore(1, true);
private boolean completoGrupoA = false, completoGrupoB = false;
private int idA, idB;
public void nuevoGrupoA(int id) throws InterruptedException {
//se obtiene un permiso para A y se bloquea
semProcesoA.acquire();
mutex.acquire();
System.out.println("proceso A = [" + id + "] llega");
idA = id;
completoGrupoA = true;
this.formarGrupo();
mutex.release();
}
public void nuevoGrupoB(int id) throws InterruptedException {
semProcesoB.acquire();
mutex.acquire();
System.out.println("proceso B = [" + id + "] llega");
idB = id;
completoGrupoB = true;
this.formarGrupo();
mutex.release();
}
//verifica que los dos esten en la sala y crea
public void formarGrupo() throws InterruptedException {
if (completoGrupoA && completoGrupoB) {
//libera la sala permitiendo el acceso a A y B
semProcesoA.release();
semProcesoB.release();
completoGrupoA = false;
completoGrupoB = false;
System.out.println("Se crea el grupo con [A =" + idA + "
y B= " + idB + "]"+"\n");
//espera un tiempo antes de pedir crear otro grupo
new Thread().sleep(2000);
}
}
}

Tema 1- Examples/Ejercicios

1. Tres enteros positivos x, y, z constituyen una terna pitagórica si x2+y2=z2, es decir, si son los lados
de un triángulo rectángulo.
a) Define la función
          esTerna :: Integer -> Integer -> Integer -> Bool
que compruebe si tres valores forman una terna pitagórica. Por ejemplo:
          Main> esTerna 3 4 5 Main> esTerna 3 4 6
          True False
b) Es fácil demostrar que para cualesquiera x e y enteros positivos con x>y, la terna (x2-y2, 2xy,    x2+y2) es pitagórica. Usando esto, escribe una función terna que tome dos parámetros y devuelva una
terna pitagórica. Por ejemplo:
          Main> terna 3 1
         (8,6,10)
         Main> esTerna 8 6 10
        True
c) Lee y entiende la siguiente propiedad, para comprobar que todas las ternas generadas por la
función terna son pitagóricas:
p_ternas x y = x>0 && y>0 && x>y ==> esTerna l1 l2 h where (l1,l2,h) = terna x y
d) Comprueba esta propiedad usando QuickCheck (recuerda importar Test.QuickCheck al principio
de tu programa y copiar la propiedad en tu fichero). Verás que la respuesta es parecida a:
         Main> quickCheck p_ternas
         *** Gave up!Passed only 62 tests
lo que indica que, aunque sólo se generaron 62 casos de pruebas con las condiciones precisas,
todos estos los casos pasaron la prueba.

esTerna :: Integer -> Integer -> Integer -> Bool
esTerna x y z = x^2+y^2==z^2

terna :: Integer -> Integer -> (Integer,Integer,Integer)
terna x y = if x>y then ( x^2 -  y^2 , 2*x*y ,  x^2 +  y^2) else error "no hay terna"
--Otra forma
terna x y =( x^2-y^2, 2*x*y, x^2+y^2)   --el uso del if then else equivale al uso de guardas 
                 |x>y
                 |otherwise error "no hay terna"

p_ternas x y = x>0 && y>0 && x>y ==> esTerna l1 l2 h
  where
    (l1,l2,h) = terna x y
-- *Main> quickCheck p_ternas
-- *** Gave up! Passed only 77 tests.

2. Define una función polimórfica intercambia :: (a,b) -> (b,a) que intercambie de posición los datos de la tupla:
           Main> intercambia (1,True) Main> intercambia ('X','Y')
           (True,1) ('Y','X')


intercambia :: (a,b)->(b,a)
intercambia (x,y) = (y,x)

3. Este ejercicio versa sobre ordenación de tuplas.

a) Define una función sobrecargada para tipos con orden ordena2 :: Ord a => (a,a) -> (a,a)
que tome una tupla con dos valores del mismo tipo y la devuelva ordenada de menor a mayor:
                Main> ordena2 (10,3) Main> ordena2 ('a','z')(3,10) ('a','z')
Copia en tu fichero las siguientes propiedades relativas a la función ordena2:
             p1_ordena2 x y = enOrden (ordena2 (x,y))
                     where enOrden (x,y) = x<=y
                            p2_ordena2 x y = mismosElementos (x,y) (ordena2 (x,y))
                               where
                                  mismosElementos (x,y) (a,b) = (x==a && y==b) || (x==b && y==a)
               (o, alternativamente, (x,y)==(a,b)||(x,y)==(b,a))
Entiende lo que cada una significa, y compruébalas usando QuickCheck.
b) Define una función sobrecargada para tipos con orden
            ordena3 :: Ord a => (a,a,a) -> (a,a,a)
que tome una tupla con tres valores del mismo tipo y la devuelva ordenada, con los elementos de
menor a mayor:
             Main> ordena3 (10,3,7) (3,7,10)
c) Escribe propiedades análogas a las del apartado anterior pero para esta función, y compruébalas
usando QuickCheck.

ordena2 :: Ord a => (a,a) -> (a,a)
ordena2 (x,y) 
              | x<=y = (x,y)
              | otherwise = (y,x)

p1_ordena2 x y = enOrden (ordena2 (x,y))
  where enOrden (x,y) = x<=y

p2_ordena2 x y = mismosElementos (x,y) (ordena2 (x,y))
  where
    mismosElementos (x,y) (a,b) = (x==a && y==b) || (x==b && y==a)
--otra forma
    mismosElementos (x,y) (a,b) = (x,y)==(a,b) || (x,y)==(b,a)

ordena3 :: Ord a => (a,a,a) -> (a,a,a)
ordena3 (x,y,z) |x>y = ordena3(y,x,z)
                |y>z = ordena3(x,z,y)
                |x>z = ordena3(z,x,y)
                |otherwise = (x,y,z)

p1_ordena3 x y z = enOrden(ordena3(x,y,z))
                where enOrden(x,y,z) = x<=y && y<=z


4. Aunque ya existe una función predefinida (max :: Ord a => a -> a -> a) para calcular el
máximo de dos valores, el objetivo de este ejercicio es que definas tu propia versión de dicha
función.

a) Como no está permitido redefinir una función predefinida, define una nueva y llámala
           max2 ::Ord a => a -> a -> a
de forma que satisfaga:
          Main> 10 `max2` 7 Main> max2 'a' 'z' 10 'z'
b) Define las siguientes propiedades que debería verificar tu función max2 y compruébalas con
QuickCheck (recuerda importar Test.QuickCheck al principio de tu programa):
        i. p1_max2: el máximo de dos números x e y coincide o bien con x o bien con y.
        ii. p2_max2: el máximo de x e y es mayor o igual que x , así como mayor o igual que y.
        iii. p3_max2: si x es mayor o igual que y, entonces el máximo de x e y es x.
        iv. p4_max2: si y es mayor o igual que x, entonces el máximo de x e y es y.

max2:: Ord a => a -> a -> a
max2 x y
  | x>y = x
  | otherwise = y

p1_max2 x y = True ==> max2 x y == x || max2 x y == y
p2_max2 x y = True ==> max2 x y >= x || max2 x y >= y
p3_max2 x y = x>=y ==> max2 x y == x
p4_max2 x y = y>=x ==> max2 x y == y

5. Define una función sobrecargada para tipos con orden 
        entre :: Ord a => a -> (a,a) -> a 
que tome un valor x además de una tupla con dos valores (max,min) y compruebe si x pertenece al
intervalo determinado por min y max, es decir, si x ∈ [min,max], devolviendo True o False según
corresponda. Por ejemplo:
           Main> 5 `entre` (1,10) Main> entre 'z' ('a','d')
           True False

entre :: Ord a => a -> (a, a) -> Bool
entre x (p,q)  | x>p && x<q = True
               | otherwise  =  False
--Otra forma
entre x(p,q)=x>=y && x<=q

 6. Define una función sobrecargada para tipos con igualdad
iguales3 :: Eq a => (a,a,a) -> Bool
que tome una tupla con tres valores del mismo tipo y devuelva True si todos son iguales. Por
ejemplo:
        Main> iguales3 ('z','a','z')
        False
        Main> iguales3 (5+1,6,2*3)
       True

iguales3 :: Eq a => (a,a,a)-> Bool
iguales3 (x,y,z)
  | x==y && y==z   = True    
  | otherwise = False
--Otra forma
ifguales3 (x,y,z) = x==y && y==z

7. Recuerda que el cociente y el resto de la división de enteros se corresponde con las funciones
predefinidas div y mod.
a) Define una función descomponer que, dada una cantidad positiva de segundos, devuelva la
descomposición en horas, minutos y segundos en forma de tupla, de modo que los minutos y
segundos de la tupla estén en el rango 0 a 59. Por ejemplo:
descomponer 5000  (1,23,20) descomponer 100  (0,1,40)
Para ello, completa la siguiente definición:
      type TotalSegundos = Integer
      type Horas = Integer
      type Minutos = Integer
      type Segundos = Integer
      descomponer :: TotalSegundos -> (Horas,Minutos,Segundos)
      descomponer x = (horas, minutos, segundos)
      where
      horas = ...
      ...
b) Comprueba la corrección de tu función verificando con QuickCheck que cumple la siguiente
propiedad:
      p_descomponer x = x>=0 ==> h*3600 + m*60 + s == x
      && entre m (0,59)
      && entre s (0,59)
      where (h,m,s) = descomponer x


-- Para este ejercicio nos interesa utilizar la función predefinida en Prelude:
--              divMod :: a -> a -> (a, a)
-- que calcula simultáneamente el cociente y el resto:
--
--   *Main> divMod 30 7
--   (4,2)

type TotalSegundos = Integer
type Horas         = Integer
type Minutos       = Integer
type Segundos      = Integer

descomponer :: TotalSegundos -> (Horas,Minutos,Segundos)
descomponer x = (horas, minutos, segundos)
   where
     (horas,resto)      = divMod x 3600
     (minutos,segundos)    = divMod resto 60
    
    
p_descomponer x = x>=0 ==> h*3600 + m*60 + s == x
                           && m `entre` (0,59)
                           && s `entre` (0,59)
     where (h,m,s) = descomponer x
-- *Main> quickCheck p_descomponer
-- +++ OK, passed 100 tests.

8. Sea la siguiente definición que representa que un euro son 166.386 pesetas:
      unEuro :: Double
      unEuro = 166.386
a) Define una función pesetasAEuros que convierta una cantidad (de tipo Double) de pesetas en los
correspondientes euros. Por ejemplo:
pesetasAEuros 1663.86  10.0
b) Define la función eurosAPesetas que convierta euros en pesetas. Por ejemplo:
eurosAPesetas 10  1663.86
c) Sea la siguiente propiedad, que establece que si pasamos una cantidad de pesetas a euros y los
euros los volvemos a pasar a pesetas, obtenemos las pesetas originales (es decir, que las funciones
son inversas):
       p_inversas x = eurosAPesetas (pesetasAEuros x) == x
Compruébala con QuickCheck para ver que no se verifica. ¿por qué falla? (pista: estamos trabajando
con números flotantes).

unEuro :: Double
unEuro = 166.386

pesetasAEuros ::  Double -> Double
pesetasAEuros x = x/unEuro

eurosAPesetas ::  Double -> Double
eurosAPesetas x = x*unEuro

p_inversas :: Double -> Bool
p_inversas x = eurosAPesetas (pesetasAEuros x) ~= x
-- p_inversas x no se cumple debido a que las pruebas las ejecuta con numeros en punto flotante y pueden variar unas milesimas y no encajar en la igualdad


9. Sea el siguiente operador que comprueba si dos valores de tipo Double son aproximadamente
iguales:
        infix 4 ~=(~=) :: Double -> Double -> Bool
        x ~= y = abs (x-y) < epsilon
            where epsilon = 1/1000
Por ejemplo: (1/3) ~= 0.33  False (1/3) ~= 0.333  True
Copia esta definición de operador en tu fichero de programa, y cambia la propiedad p_inversas
del ejercicio anterior para que verifique que si pasamos una cantidad de pesetas a euros y los euros
los volvemos a pasar a pesetas, obtenemos las pesetas originales aproximadamente. Comprueba
con QuickCheck que esta propiedad sí se verifica.



infix 4 ~=
(~=) :: Double -> Double -> Bool
x ~= y = abs (x-y) < epsilon
  where epsilon = 1/1000

10. Consideremos la ecuación de segundo grado ax2 + bx + c = 0.
a) Define una función raíces que tome tres parámetros (correspondientes a los coeficientes a, b y c
de la ecuación) y devuelva una tupla con las dos soluciones reales de la ecuación (para calcular la
raíz cuadrada, usa la función predefinida sqrt). Recuerda que el discriminante se define como b24ac
y que la ecuación tiene raíces reales si el discriminante no es negativo. Por ejemplo:
          raíces 1 (-2) 1.0  (1.0,1.0)
          raíces 1.0 2 4  Exception: Raíces no reales
b) Sea la siguiente propiedad que comprueba que las valores devueltos por la función raíces son
efectivamente raíces de la ecuación:
         p1_raíces a b c = esRaíz r1 && esRaíz r2
             where
                (r1,r2) = raíces a b c
       esRaíz r = a*r^2 + b*r + c ~= 0
Comprueba esta propiedad con QuickCheck y verifica que falla. Piensa por qué falla, y añade
condiciones a la propiedad para que no falle, es decir, completa las interrogaciones:
          p2_raíces a b c = ??????? && ?????? ==> esRaíz r1 && esRaíz r2
             where
                 (r1,r2) = raíces a b c
         esRaíz r = a*r^2 + b*r + c ~= 0
de forma que se verifique el siguiente diálogo:
         Main> quickCheck p2_raíces
         +++ OK, passed 100 tests



raices :: Double-> Double -> Double ->(Double,Double)
raices a b c
  | b^2-4*a*c>0 =  ((-b+sqrt (b^2- 4*a*c))/2*a ,(-b-sqrt (b^2- 4*a*c))/2*a)
  | otherwise   =  error"Raices no reales"

p1_raices :: Double-> Double -> Double ->Bool
p1_raices a b c = esRaíz r1 && esRaíz r2
  where
    (r1,r2) = raices a b c
    esRaíz r = a*r^2 + b*r + c ~= 0


--en cuanto una raiz sea negativa esto no funciona, ver
p2_raices :: Double-> Double -> Double ->Property
p2_raices a b c = (a,b,c)/=(0,0,0) && (b*b-4*a*c) >= 0 ==> esRaiz r1 && esRaiz r2
    where
      (r1,r2) = raices a b c
      esRaiz r = a*r^2 + b*r + c ~= 0


11. Define una función esMúltiplo sobrecargada para tipos integrales que tome dos valores x e y, y
devuelva True si x es múltiplo de y. Por ejemplo:
            esMúltiplo 9 3  True
            esMúltiplo 7 3  False

esMultiplo :: (Integral a) => a->a->Bool
esMúltiplo x y = if mod x y ==0 then True else False

12. Define el operador de implicación lógica (==>>) :: Bool -> Bool -> Bool de forma que
sea asociativo a la izquierda, con precedencia menor que los operadores conjunción y disyunción:
         Main> 3 < 1 ==>> 4 > 2
         True
         Main> 3 < 1 || 3 > 1 ==>> 4 > 2 && 4 < 2
         False
Ayuda: puedes escribir ecuaciones directamente para la definición del operador, o bien patrones,
completando definiciones tales como:
        False ==>> y = y
        ??? ==>> ??? = ???

infixl 1 ==>>
(==>>) :: Bool->Bool->Bool
False ==>> y=True
True ==>> y=y                             --Devuelve lo que valga y




13. Los años bisiestos son los años múltiplos de 4. Una excepción a esta regla son los años múltiplos de 100, que sólo se consideran bisiestos si además son múltiplos de 400. Define una función
esBisiesto que tome como parámetro un año y devuelva True si es bisiesto. Por ejemplo:
        esBisiesto 1984 True
       esBisiesto 1985  False
       esBisiesto 1800  False
       esBisiesto 2000  True
Ayuda: utiliza el operador de implicación lógica y la siguiente frase: “n es bisiesto si satisface las dos
condiciones siguientes: (a) es múltiplo de 4, y (b) si n es múltiplo de 100 entonces n es múltiplo de
400”.

esBisiesto :: Integral a => a-> Bool
esBisiesto x = esMultiploB x
  where
    esMultiploB x = esMúltiplo x 4 && esMúltiplo x 100 ==>> esMúltiplo x 400

--Otra forma

esBisiesto :: Integer->Bool
esBisiesto x = esMultiplo x 4 && (esMultiplo x 100 ==>> esMultiplo x 400)

14. Aunque ya existe en Haskell el operador predefinido (^) para calcular potencias, el objetivo de este
problema es que definas tus propias versiones recursiva de este operador.
a) A partir de la propiedad
   

define una función recursiva potencia' que tome un entero b y un exponente natural n y devuelva bn. Por ejemplo:
        potencia 2 3  8
b) A partir de la siguiente propiedad:
define una función recursiva potencia' que tome un entero b y un exponente natural n y devuelva bn. Por ejemplo:
        potencia' 2 3  8 potencia' 2 4  16
c) Comprueba con QuickCheck la corrección de ambas funciones mediante la siguiente propiedad:
       p_pot b n = n>=0 ==> potencia b n == sol && potencia' b n == sol
           where sol = b^n
d) Teniendo en cuenta que elevar al cuadrado equivale a realizar un producto, determina el número
de productos que realizan ambas funciones para elevar cierta base a un exponente n.
Ayuda: para analizar la eficiencia de potencia' considera exponentes que sean potencia de 2.



potencia :: Integer-> Integer -> Integer
otencia x y
  | y== 0        = 1
  | otherwise   = potencia x (y-1) * x


potencia' ::   Integer-> Integer -> Integer
potencia' x y
  | mod y 2 == 0        = (potencia x (div y 2))^2
  | otherwise           = ((potencia x (div (y-1) 2))^2) * x

p_pot :: Integer->Integer->Property
p_pot b n = n>=0 ==> potencia b n == sol && potencia' b n == sol
  where sol = b^n
 
15. Dado un conjunto finito con todos sus elementos diferentes, llamamos permutación a cada una de
las posibles ordenaciones de los elementos de dicho conjunto. Por ejemplo, para el conjunto
{1,2,3}, existen un total de 6 permutaciones de sus elementos: {1,2,3}, {1,3,2}, {2,1,3}, {2,3,1}, {3,1,2}
y {3,2,1}. El número de permutaciones posibles para un conjunto con n elementos viene dada por el
factorial de n (se suele escribir n!), que se define como el producto de todos los números naturales
menores o iguales a n. Escribe una función factorial que tome como parámetro un número
natural y devuelva su factorial. Dado que el factorial crece muy rápido, usa el tipo Integer, es
decir, factorial :: Integer -> Integer. Por ejemplo:
        factorial 3  6 factorial 20  2432902008176640000


factorial :: Integer -> Integer
factorial x
  | x==0        = 1
  | otherwise   = factorial (x-1) * x

16. Este ejercicio estudia la división entera (exacta) de números enteros.
a) Define una función divideA que compruebe si su primer argumento divide exactamente al
segundo. Por ejemplo:
          2 `divideA` 10  True 4 `divideA` 10  False
b) Lee, entiende y comprueba con QuickCheck la siguiente propiedad referente a la función divideA:
          p1_divideA x y = y/=0 && y `divideA` x ==> div x y * y == x
c) Escribe una propiedad p2_divideA para comprobar usando QuickCheck que si un número divide a
otros dos, también divide a la suma de ambos.

divideA :: Integer->Integer -> Bool
divideA x y = mod y x ==0

p1_divideA :: Integer->Integer -> Property
p1_divideA x y = y/=0 && y `divideA` x ==> div x y * y == x

p2_divideA :: Integer->Integer->Integer -> Property
p2_divideA a b c = a/=0 && b/=0 && c/=0 && divideA a b && divideA b c ==> divideA a (b+c)





17. La mediana de un conjunto de valores es aquel valor tal que el 50% de los valores del conjunto son menores o iguales a él, y los restantes mayores o iguales. Queremos definir una función para
calcular la mediana de los valores de una tupla de cinco elementos
        mediana :: Ord a => (a,a,a,a,a) -> a
de forma que se tenga:
        mediana (3,20,1,10,50)  10
Observa que se satisface 1 , 3 ≤ 10 ≤ 20,50. Teniendo en cuenta este detalle, define la función a
través de ecuaciones con guardas, completando el siguiente esquema:
          
mediana :: Ord a => (a, a, a, a, a) -> a
mediana (x,y,z,t,u)
 | x > z         = mediana (z,y,x,t,u)
 | y > z           = mediana (x,z,y,t,u)
 | z > u                = mediana (x,y,u,t,z)
 | z >t                 = mediana (x,y,u,z,t)
 | otherwise            = z

Tema 2 - Examples/Ejercicios

2. Define una función
            máximoYresto :: Ord a => [a] -> (a,[a])
que “devuelva” en forma de par el máximo de la lista y los restantes elementos. Considera dos casos:
      a.- el orden en que aparecen los restantes puede ser arbitrario:
             máximoYresto [1,2,30,4,5,6,7]   (30,[1,2,7,4,5,6])
      b.- los restantes deben aparecer en el orden original
             máximoYresto’ [1,2,30,4,5,6,7]  (30,[1,2,4,5,6,7])


maximoYresto :: Ord a => [a] -> (a,[a])
maximoYresto [] = (null,[])
maximoYresto (x:xs) = if(x>=head xs) then maximoYresto (x:tail xs)
                        else maximoYresto xs

8. Un número natural p es primo si tiene exactamente dos divisores positivos distintos: 1 y p; por
tanto, 1 no es un número primo.
        a) Define una función esPrimo para comprobar si un número es primo. Por ejemplo:
               esPrimo 7  True esPrimo 10  False
        b) Usando una lista por comprensión, define una función primosHasta que devuelva una lista
            con todos los números primos menores o iguales a un valor dado. Por ejemplo:
               primosHasta 50  [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47]
         c) Da otra definición (con nombre primosHasta') que use la función predefinida filter en vez
          de la lista por comprensión.
        d) Comprueba que las dos funciones que has definido se comportan del mismo modo
         comprobando con QuickCheck la siguiente propiedad:
                p1_primos x = primosHasta x == primosHasta' x
        Nota: existen métodos más eficientes para calcular listas de primos( Criba de  Eratóstenes.)



divisoresDe :: Integer -> [Integer]
divisoresDe n | n > 0       = [d | d <- [1..n], n `mod` d == 0]
              | otherwise   = error "no existen"
           

esPrimo :: Integer -> Bool
esPrimo  x = length (divisoresDe x) ==2

-- B) Define una lista por compresión
primosHasta :: Integer -> [Integer]
primosHasta  m  = [x | x<-[1..m],esPrimo (x)]

-- C) Misma función usando filter
primosHasta':: Integer -> [Integer]
primosHasta'  m = filter esPrimo [1..m]
-- D) quickCheck
p1_primos x = primosHasta x == primosHasta' x


14. La función predefinida
             takeWhile :: (a -> Bool) -> [a] -> [a]
devuelve el prefijo más largo con los elementos de una lista (2º argumento) que cumplen una
condición (1er argumento). Por ejemplo:
             takeWhile even [2,4,6,8,11,13,16,20]  [2,4,6,8]
ya que el 11 es el primer elemento que no es par. Otro ejemplo de uso es:
            takeWhile (<5) [2,4,6,1]  [2,4]
ya que 6 es el primer elemento de la lista mayor o igual a 5. Para los mismos argumentos, la función
dropWhile suprime el prefijo que takeWhile devuelve. Por ejemplo:
           dropWhile even [2,4,6,8,11,13,16,20]  [11,13,16,20]
           dropWhile (<5) [2,4,6,1]  [6,1]
a) Usando estas funciones, define una función inserta que tome un elemento x y una lista xs que ya
está ordenada ascendentemente (asume que esta precondición se cumple), y que devuelva la lista
ordenada que se obtiene al insertar x en su posición adecuada dentro de xs. Por ejemplo:
             inserta 5 [1,2,4,7,8,11 ]  [1,2,4,5,7,8,11]
             inserta 2 [1,2,4,7,8,11]  [1,2,2,4,7,8,11]
             inserta 0 [1,2,4,7,8,11]  [0,1,2,4,7,8,11]
             inserta 20 [1,2,4,7,8,11]  [1,2,4,7,8,11,20]
b) Sin usar ninguna función auxiliar, define directamente y en forma recursiva la función inserta.
c) Lee, entiende y comprueba con QuickCheck la siguiente propiedad referente a la función inserta:
             p1_inserta x xs = desconocida xs ==> desconocida (inserta x xs)
d) Podemos utilizar la función inserta que hemos definido para ordenar ascendentemente una lista
desordenada. Por ejemplo, si quisiéramos ordenar la lista [9,3,7], podríamos hacerlo evaluando
la expresión:
            9 `inserta` (3 `inserta` (7 `inserta` []))
Razona por qué funciona este algoritmo para ordenar una lista.
e) Usando la función foldr y la función inserta, define una función ordena que tome una lista de
valores y la devuelva ordenada. Por ejemplo:
            ordena [9,3,7]  [3,7,9] ordena "abracadabra" "aaaaabbcdrr"
f) Escribe y comprueba con QuickCheck la siguiente propiedad: para cualquier lista xs, ordena xs es
una lista ordenada.
g) Demuestra la propiedad anterior por inducción sobre listas.



desconocida :: (Ord a) => [a] -> Bool
desconocida xs = and [ x<=y | (x,y) <- zip xs (tail xs) ]

-- A)
inserta :: Ord a => a -> [a] -> [a]
inserta x xs = (takeWhile (<x) (xs)) ++ [x] ++ (dropWhile (<=x) (xs))

-- B) inserta directamente  y versión recursiva
inserta' :: Ord a => a -> [a] -> [a]
inserta' x [ ]  = [x]
inserta' x (y:ys) = [y] ++ inserta x (ys)

-- C)
p_inserta x xs = length xs <= 10 && desconocida xs ==> desconocida (inserta x xs)
p_inserta' x xs = length xs <= 10 &&  desconocida xs ==> desconocida (inserta' x xs)
pinserta = quickCheck  (p_inserta :: Int -> [Int] -> Property)
pinserta' = quickCheck (p_inserta' :: Int -> [Int] -> Property)

-- D) ¿por qué está ordenada la lista 9 `inserta` (3 `inserta` (7 `inserta` []))

-- E) algoritmo de ordenación a través de foldr e inserta
ordena :: Ord a => [a] -> [a]
ordena xs = foldr inserta [] xs

16. Aunque la función predefinida lcm (least common multiple) ya lo hace, el objetivo de este ejercicio es escribir una función mcm para calcular el mínimo común múltiplo de dos naturales.
       a) Define una función múltiplosDe, que tome como parámetro un número mayor que cero y
          devuelva una lista infinita con sus múltiplos positivos. Por ejemplo:
                múltiplosDe 3  [3,6,9,12,15,...
       Ayuda: usa la función predefinida iterate, descrita en un ejercicio anterior.
       b) Define la función sobrecargada para tipos con orden
               primeroComún :: Ord a => [a] -> [a] -> a
       que tome dos listas ordenadas ascendentemente y devuelva el menor elemento común a ambas.
       Por ejemplo:
               primeroComún [1,2,5,7,9] [3,3,4,5,7]  5
        c) El mínimo común múltiplo de dos naturales x e y es el menor natural positivo múltiplo de
        ambos. Utilizando las funciones definidas en los apartados previos, escribe una función mcm
        que calcule el mínimo común múltiplo de dos naturales usando esta definición.
        d) Comprueba usando QuickCheck tu definición mediante esta propiedad:
               p_mcm x y = x>=0 && y>=0 ==> mcm x y == lcm x y

-- A)
múltiplosDe :: Integer -> [Integer]
múltiplosDe x = map (*x) [1,2..]

-- B)
primeroComún :: Ord a => [a] -> [a] -> a
primeroComún              (x:xs) (y:ys)
  | x > y    = primeroComún (x:xs)    ys
  | x< y     = primeroComún (xs)    (y:ys)
  |otherwise = x

-- C)
 mcm de dos naturales como menor mútiplo común positivo
mcm x y = primeroComún (múltiplosDe x) (múltiplosDe y)
-- D)
p_mcm x y = x>=0 && y>=0 ==> mcm x y == lcm x y

Tema 3 - Examples/Ejercicios

1. Haskell. Escribe una función que permita determinar si una cadena de caracteres está bien
balanceada o equilibrada en lo que se refiere a los paréntesis, corchetes y llaves que contiene. El
resto de caracteres no interesan. Por ejemplo la cadena “v(hg(jij)hags{ss[dd]dd})” está
balanceada pero no así la cadena “ff(h([sds)sds]ss)hags”.

Para ello, se utilizará una pila en la que cada vez que aparezca un signo de apertura, se
introduce en la pila y cada vez que aparece un signo de cierre se extrae la cima de la pila y se
comprueba que corresponde al signo de apertura correspondiente. Si al finalizar de recorrer la
cadena la pila está vacía entonces la expresión está equilibrada.
   module WellBalanced where

   import DataStructures.Stack.LinearStack

    wellBalanced :: String -> Bool
   wellBalanced xs = wellBalanced' xs S.empty

   wellBalanced' :: String -> Stack Char -> Bool
   wellBalanced' [] s = isEmpty s
   wellBalanced' (x:xs) s ...
*WellBalanced > wellBalanced "vv(hg(jij)hags{ss[dd]dd})"
True




module WellBalanced where

import DataStructures.Stack.LinearStack

wellBalanced :: String -> Bool
wellBalanced xs = wellBalanced' xs empty

wellBalanced' :: String -> Stack Char -> Bool
wellBalanced' [] s = True
wellBalanced' (x:xs) s
   | isOpen x   = wellBalanced' xs (push x s)

   | isClosed x = if (match (top s) x) then wellBalanced' xs (pop s) else wellBalanced' (xs) s

   | otherwise  = wellBalanced' (xs) s

isOpen x = elem x "([{"
isClosed x = elem x ")]}"

match '(' ')' = True
match '[' ']' = True
match '{' '}' = True
match _ _ = False

11. Haskell. Un saco (o multiconjunto) es parecido a un conjunto salvo que un elemento puede estar
incluido varias veces. Por ejemplo, {‘b’, ‘a’, ‘d’, ‘d’, ‘a’, ‘c’ , b’, ‘a’} es un saco que
incluye tres ocurrencias del carácter ‘a’ , dos ocurrencias del ‘b’, una del ‘c’ y dos del ‘d’.
        a) Implementa sacos en Haskell usando el siguiente tipo de datos:
                   data Bag a = Empty | Node a Int (Bag a)
           de forma que en cada nodo aparece, además del saco restante, cada elemento junto con
           su contador de ocurrencias, o sea, el número de veces que aparece. Para agilizar
           las operaciones de inserción y borrado en un Bag, interesa que los nodos estén ordenados
           atendiendo al orden de los elementos a incluir. Además, no deben aparecer elementos con
           contador nulo (o negativo). Por ejemplo, el saco anterior se representa por:
                  Node ‘a’ 3 (Node ‘b’ 2 (Node ‘c’ 1 (Node ‘d’ 2 Empty)))
           La implementación debe incluir las siguientes funciones:
                  empty :: Bag a -- Devuelve un saco vacío
                  isEmpty :: Bag a -> Bool -- Comprueba si un saco está vacío
                  insert :: (Ord a) => a -> Bag a -> Bag a --Inserta una nueva ocurrencia
                 occurrences :: (Ord a) => a -> Bag a -> Int -- Devuelve el número de
                  -- ocurrencias de un elemento en un saco (0 si el elemento no está) -}
                 delete :: (Ord a) => a -> Bag a -> Bag a -- Borra una ocurrencia de un
                -- elemento de un saco. Devuelve el mismo saco si el elemento no estaba incluido
        b) Proporciona una especificación de Bag definiendo sus axiomas para las diferentes
         operaciones y comprueba la implementación realizada con QuickCheck. Para ello,
         incluye en el módulo la siguiente instancia para generar sacos aleatorios:
                  instance (Ord a, Arbitrary a) => Arbitrary (Bag a) where arbitrary = do
                       xs <- listOf arbitrary return (foldr insert empty xs)
        c) Añade al módulo las siguientes funciones para manipular sacos: unión, intersección,
        diferencia y una función que determine si un saco está contenido en otro. Estas
        funciones son semejantes a las de los conjuntos pero teniendo en cuenta las
        ocurrencias de cada elemento.
      d) Analiza la complejidad de las diferentes operaciones y justifica las ventajas de
       mantener los elementos ordenados.


module Bag
  ( Bag
  , empty
  , isEmpty
  , insert
  , delete
  , occurrences
  ) where
import Test.QuickCheck 
----------------
--- a)
----------------
data Bag a =  Empty | Node a Int  (Bag a) deriving Eq --Node tiene 3 argumentos: a, n (entero) y la bolsa
-- no deben aparecer nodos con el contador a cero.
-- es decir, los eliminamos
-- mantenemos los objetos ordenados
-- imponemos una relación de orden al tipo base.
-- esto permitirá comparar dos sacos: igualdad, pertenencia, etc.
empty :: Bag a            
empty = Empty
isEmpty :: Bag a -> Bool   
isEmpty Empty = True
isEmpty (Node a n s) = False
--'a' -> Empty
--'c' -> Nodo 'a' 1 Empty
--'a' -> Nodo 'a' 1 (Nodo 'c' 1 Empty)
--'c' -> Nodo 'a' 1 (Nodo 'c' 2 Empty)
--         Nodo 'a' 2 (Nodo 'c' 2 Empty)
--Las bolsas se expresan: Nodo 'a' 3 (Nodo 'c' 5 (Nodo 'd' 1 Empty) = 'a' aparece 3 veces, 'c' 5 veces y 'd' 1 vez
-- (a 3):((c 5):((d 2) : [ ])) = ':' es nodo y [ ] es Empty
insert :: (Ord a) => a -> Bag a -> Bag a   
-- Inserta una nueva ocurrencia en un saco
-- pedimos Ord para mantener el orden 
insert x Empty          =  Node x 1 Empty
insert x (Node y oy s) | x < y = Node x 1 (Node y oy s)
                                | x == y =  Node y (oy+1) s
                                | x > y =  Node y oy (insert x s)
occurrences :: (Ord a) => a -> Bag a -> Int    
-- Devuelve el número de ocurrencias de un elemento en un saco
-- 0 si el elemento no está
occurrences x Empty     = 0
occurrences x (Node y oy s) | x ==y = oy
                                          | x < y = 0
                                          | x > y = occurrences x s
delete :: (Ord a) => a -> Bag a -> Bag a       
-- Borra  una ocurrencia de un elemento de un saco.
-- Devuelve el mismo saco si el elemento no estaba incluido
delete x Empty          =  Empty
delete x (Node y oy s) | x == y = Node y (oy-1) s
                                 | x < y = Node y oy s
                                 | x > y = Node y oy (delete x s)
instance (Show a) => Show (Bag a) where
        show s = "Bag { " ++ show' s
          where
                show' Empty = "}"
                show' (Node x ox s) = muestra x ox ++  show' s   
                muestra x 0  = ""
                muestra x ox = show x ++ ' ':muestra x (ox-1)
----------------
--- b) Proporcionar una especificación de sacos definiendo sus axiomas
--     para las diferentes operaciones y comprobar la implementación
--     realizada con QuickCheck.
----------------
instance (Ord a, Arbitrary a) => Arbitrary (Bag a) where
  arbitrary =  do
                xs <- listOf arbitrary
                return (foldr insert empty xs)
-- Sobre insertar
ax1  x y s      =       insert x(insert y s) == insert y(insert x s)
-- Sobre ocurrences
ax2  x         =       empty
ax3 x y s     | x==y = occurrences x (insert y s) == 1 + occurrences x s
                  | x/=y = occurrences x (insert y s) == occurrences x s

-- Sobre delete
ax4 x           =       empty
ax5 x   s       =       delete x (insert x s) == s
ax6 x y s       =    x /= y  ==>   (delete x (insert y s) == insert y (delete x s))
-- Sobre isEmpty
ax7             =       isEmpty empty
ax8 x s         =      isEmpty (insert x s) == False
{- Si no tipificamos, solo genera pruebas con 'data () = ()'
*Bag> quickCheck ax6
*** Gave up! Passed only 0 tests.
*Bag> quickCheck (ax6 :: Char -> Char -> Bag Char -> Property)
+++ OK, passed 100 tests.
*Bag> quickCheck (ax6 (12::Integer))
+++ OK, passed 100 tests.
*Bag> quickCheck (ax6 'a')
+++ OK, passed 100 tests.
*Bag> quickCheck (ax5 'a')
+++ OK, passed 100 tests.
*Bag> quickCheck (ax5 True)
+++ OK, passed 100 tests.
-}

----------------
-- c)    Añadir al módulo las siguientes funciones para manipular sacos:
-- unión, intersección, diferencia y una función que determine si un saco
-- está contenido en otro.
-- Estas funciones son semejantes a las de conjunto pero teniendo
-- en cuenta las ocurrencias de cada elemento.
----------------
union :: Ord a => Bag a -> Bag a -> Bag a
-- queda curioso la unión al estilo de merge
union s     Empty = s
union Empty t     = t
union (Node x ox s) (Node y oy t)
      |x<y = (Node x ox (Node y oy (union s t)))
      |x>y = (Node y oy (Node x ox (union s t)))
      |x==y = Node x (ox + oy) (union s t)
intersection :: Ord a => Bag a -> Bag a -> Bag a
intersection s     Empty = Empty
intersection Empty t     =  Empty
intersection (Node x ox s) (Node y oy t)
      | x == y = Node x (ox+oy) (intersection s t)
      | x < y = intersection s (Node y oy t)
      | x > y = intersection (Node x ox s) t


difference  :: Ord a => Bag a -> Bag a -> Bag a
difference s     Empty =  s
difference Empty t     =  Empty
difference (Node x ox s) (Node y oy t)
      | x == y = difference s t
      | x < y = Node x ox (difference s (Node y oy t))
      | x > y = difference (Node x ox s) t

inBag :: Ord a => Bag a -> Bag a -> Bool
inBag    Empty t     =  True
inBag    t     Empty =  False
inBag   (Node x ox s) (Node y oy t)
      | x==y = inBag s t
      | x < y = False
      | x > y = inBag (Node x ox s) t
-- Ejercicio: Encontrar axiomas para estas operaciones
-- union
ax_union1  s t    = union s t == union t s
-- quickCheck (ax_union1 saco1)
-- union e insert
ax_union2  x s t  = union (insert x s) t == union (insert x t) s
-- quickCheck (ax_union2 3)
-- intersection
ax_intersection1  s t    = intersection s t == intersection t s
-- intersection y delete
ax_intersection2  x s t  = occurrences x s == occurrences x t ==> intersection(delete x s) (delete x t) == intersection(delete x t) (delete x s)
--
-- difference y empty
ax_difference1  s     =  difference s s == Empty
-- quickCheck (ax_difference1 :: Set Integer -> Bool)
-- difference, insert y empty
ax_difference3  x s     = difference s (insert x s) == Empty
-- quickCheck (ax_difference3 :: Int -> Bag Int -> Bool)
-- difference e insert
ax_difference4  x s t  = difference t (insert x s) == difference (insert x t) s
-- quickCheck (ax_difference4 :: Int -> Bag Int -> Bag Int -> Bool)
-- otra propiedad de los conjuntos que es falsa para Bag
-- difference y union
ax_difference2  s t u  = difference (union s t) u == union (difference s u) (difference t u)
-- quickCheck (ax_difference2 :: Bag Int -> Bag Int -> Bag Int -> Bool)
-- ATENCION: falla la distributiva
ax_uni_inter1  s t  u  = intersection (union s t) u  ==
                         union (intersection s u) (intersection t u)
--  *Bag> quickCheck (ax_uni_inter1)
--  *** Failed! Falsifiable (after 4 tests): 
--  Bag { () () }
--  Bag { () }
--  Bag { () }

------------
-- d)    Analizad la complejidad de las diferentes operaciones
-- y justificar las ventajas de mantener los elementos ordenados.
------------
--- Otras funciones
cardinal :: Ord a => Bag a -> Int
cardinal Empty = 0
cardinal (Node x ox s) = ox + cardinal s
foldBag :: ( a -> Int -> b -> b) -> b -> Bag a -> b
foldBag f z Empty         = z
foldBag f z (Node x ox s) = f x ox (foldBag f z s)
 
elemBag y =  foldBag esta False
   where esta x ox b = x==y && b
sumBag = foldBag sum3 0
  where sum3 x ox z = x*(fromIntegral ox) + z
cardinal' = foldBag (const (+) ) 0
-- Las ventajas de tener los elementos ordenados es que permite que se puede operar
--con las bolsas de una forma más rápida y además las funciones necesitan menos casos base. 

--------------------------------------------------------------------------------
Demas ejercicios de las relaciones de otros años
 --------------------------------------------------------------------------------

1. Consideremos la función:
        dosVeces :: (Integer -> Integer) -> Integer -> Integer
        dos Veces f x = f (f x)
    a) ¿Cuál es el tipo de la función: fun = dosVeces (+1)?
        fun :: Integer -> Integer
    b) Escribe una λ-expresión equivalente a la función fun
        fun’ :: Integer -> Integer
         fun’ = λx -> x + 2
    c) Escribe una sección equivalente a la función fun
        fun'’ :: Integer -> Integer
        fun’’ = (+2)
2. Escribe una función derivada que devuelva la derivada de una función de reales en reales
usando la aproximación:
Por ejemplo:
     coseno :: Float -> Float
     coseno= derivada sin
     MAIN> derivada sqrt 1.0
      > 0.499487 :: Float
     MAIN> coseno 0.0
     > 1.0 :: Float
¿Cuál es el tipo de la función derivada?
      derivada :: (Float -> Float) -> Float -> Float
      derivada f x = (f (x + epsilon) – f x) / épsilon
          where
               epsilon = 1e - 4
3. ¿Cuáles son los tipos polimórficos de las siguientes funciones?
         swap (x, y) = (y, x) (a,b) -> (b,a)
         const x y = x a -> b -> a
         subst f g x = f x (g x) (a -> b -> c) -> (a -> b) -> a -> c
         pair (f,g) x = (f x, g x) (a -> b, a -> c) -> a -> (b, c)
        cross (f,g) (x,y) = (f x, g y) (a -> b, c -> d) -> (a, c) -> (b, d)
        comp f g x = f (g x) (a -> b) -> (c -> a) -> c -> b
        fix f = f (fix f) (a -> a) -> a
4. ¿Qué hace el siguiente operador?
       infixr 0 >$>
       (>$>) :: (a -> a) -> a -> a
       f >$> x = f (f x)
         Aplica la función dos veces
¿Por qué su tipo no es (>$>) :: (a -> b) -> a -> b?
      La función f debe devolver un parámetro del mismo tipo que su parámetro de entrada
      porque el resultado de aplicar la primera vez la función será el parámetro de entrada
      en la segunda aplicación de la función
5. Define el operador (>$>) del ejercicio anterior usando la composición de funciones (.)
      infixr 0 >$> (>$>) :: (a->a) -> a -> a (>$>) f = f . f
6. Consideremos el siguiente operador:
      infixl 9 >.>f >.> g = λ x -> g (f x)
 ¿Cuál es su tipo polimórfico)
     (a -> b) -> (b -> c) -> a -> c
¿Qué hace la siguiente función?
     fun :: Integer -> Integer
     fun = (+2) >.> (*2) >.> (+1)
         Debido a la asociación a la izquierda del operador, sería como tener ((+2) >.>
         (*2)) >.> (+1). Dado un número natural, primero le suma 2, luego lo multiplica por 2, y
         luego le suma 1.
7. La función predefinida reverse invierte el orden de los elementos de una lista. Por ejemplo
      MAIN> reverse [1,2,3]
      [3,2,1] :: Integer
Defínela y da su tipo polimórfico. ¿Cuál es el tipo de la función palíndromo xs = (reverse xs ==
xs)?
      reverse :: [a] -> [a]
      reverse [] = []
      reverse (x:xs) = reverse xs ++ [x]
      palíndromo :: [a] -> Bool
      palíndromo xs = (reverse xs == xs)
8. ¿Cuál es el tipo polimórfico de la función twice?
     twice f x = f (f x)
      twice :: (a -> a) -> a -> a
¿Cuál es el valor de cada una de las siguintes expresiones?
    twice (+1) 0 2
     twice twice (+1) 0 4
Demostración:
    twice (+1) 0 -- f = (+1) ; x = 0
     => definición de twice
     (+1) ( (+1) 0 )
    => definición de la función (+1) (la más interna, pues es la única aplicable)
     (+1) 1
    => definición de la función (+1)
   2
   twice twice (+1) 0 -- f = twice (+1) ; x = 0
    => definición de twice (en el rédex más externo)
    twice (+1) (twice (+1) 0)
    => definición de twice (en el twice más interno)
    twice (+1) ( (+1) ( (+1) 0 ))
    => definición de la función (+1) (la más interna, pues es la única aplicable)
    twice (+1) ( (+1) 1 )
    => definición de la función (+1) (la más interna, pues es la única aplicable)
    twice (+1) 2
    => definición de la función twice
    (+1) ( (+1) 2 )
    => definición de la función (+1) (la más interna, pues es la única aplicable)
    (+1) 3
    => definición de la función (+1)
    4
9 La función predefinida zip empareja dos listas. Por ejemplo
    ? zip [1, 2, 3] [4, 5, 6]
    [(1, 4), (2, 5), (3, 6)] :: [(Integer , Integer )]
    ? zip [1, 2, 3] [True, False]
    [(1,True), (2, False)] :: [(Integer ,Bool )]
    ? zip [True, False] [1, 2, 3]
   [(True, 1), (False, 2)] :: [(Bool , Integer )]
    Defínela y da su tipo polimórfico
   zip :: [a] -> [b] -> [(a,b)]
   zip' (x:xs) (y:ys) = (x,y) : zip' xs ys
   zip' _ _ = []
10. ¿Cuál es el tipo de las siguientes expresiones (en caso de que sean correctas)?
     not . even Int -> Bool (Bool -> Bool) -> (Int -> Bool)
     even . not Incorrecto, ya que la función not produce un Booleano y
     la función even necesita como entrada un número
     chr . ord Char -> Char (Int -> Char) -> (Char -> Int)
    ord . chr Int -> Int (Char -> Int) -> (Int -> Char)
    ord . chr . (+1) Int -> Int (Char -> Int) -> ( (Int -> Char) -> (Int -> Int) )
    map not [Bool] -> [Bool]
    map (λ x -> not x ) [Bool] -> [Bool]
    map (not . even) [Int] -> [Bool]
    map not [True, False] [Bool]
    map ord [Char] -> [Int]
    map (+1) [a] -> [a], donde a es un número
    map (map (+1)) [[a]] -> [[a]], donde a es un número
    map (++[1]) [[a]] -> [[a]]
    map (1 :) [[a]] -> [[a]]
 Cuál es el valor de la expresión map (map (+1)) [[1, 2, 3], [10, 11]]?
    [[2,3,4], [10,11]]
    map (map (+1)) ([1,2,3] : [[10,11]]) = map (+1) [1,2,3] : map (map (+1)) [[10,11]]
 Primera parte:
    map (+1) [1,2,3] = [2,3,4]
Segunda parte:
    map (map (+1)) ([10,11] : []) = map (+1) [10,11] : map (map (+1)) []
Primera parte:
    map (+1) [10,11] = [11,12]
Segunda parte:
   map (map (+1)) [] = []
Uniendo todo, resulta:
   [2,3,4] : [11.12] : [] = [[2,3,4], [11,12]]