{ "cells": [ { "cell_type": "markdown", "metadata": {}, "source": [ "\n", " Tema 23: Técnicas de diseño descendente de algoritmos\n", " \n", "\n", "----------\n", "\n", "[José A. Alonso](https://www.cs.us.es/~jalonso) \n", "[Departamento de Ciencias de la Computación e I.A.](https://www.cs.us.es) \n", "[Universidad de Sevilla](http://www.us.es) \n", "Sevilla, 19 de agosto de 2019" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "> __Notas:__ \n", "+ La versión interactiva de este tema se encuentra en [Binder](https://mybinder.org/v2/gh/jaalonso/Temas_interactivos_de_PF_con_Haskell/master?urlpath=lab/tree/temas/Tema-23.ipynb).\n", "+ Se desactiva el [corrector estilo de Haskell](https://github.com/gibiansky/IHaskell/wiki#opt-no-lint)." ] }, { "cell_type": "code", "execution_count": 1, "metadata": {}, "outputs": [], "source": [ ":opt no-lint" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "# La técnica de divide y vencerás\n", "\n", "+ La técnica *divide y vencerás* consta de los siguientes pasos:\n", " + *Dividir* el problema en subproblemas menores.\n", " + *Resolver* por separado cada uno de los subproblemas:\n", " + si los subproblemas son complejos, usar la misma técnica\n", " recursivamente;\n", " + si son simples, resolverlos directamente.\n", " + *Combinar* todas las soluciones de los subproblemas en una solución simple.\n", " \n", "+ `(divideVenceras ind resuelve divide combina pbInicial)` resuelve el problema\n", " `pbInicial` mediante la técnica de divide y vencerás, donde\n", " + `(ind pb)` se verifica si el problema `pb` es indivisible,\n", " + `(resuelve pb)` es la solución del problema indivisible `pb`,\n", " + `(divide pb)` es la lista de subproblemas de `pb`,\n", " + `(combina pb ss)` es la combinación de las soluciones `ss` de los\n", " subproblemas del problema `pb` y\n", " + `pbInicial` es el problema inicial." ] }, { "cell_type": "code", "execution_count": 2, "metadata": {}, "outputs": [], "source": [ "module DivideVenceras (divideVenceras) where\n", "\n", "-- ---------------------------------------------------------------------\n", "-- El patrón de diseño \"divide y vencerás\" --\n", "-- ---------------------------------------------------------------------\n", "\n", "-- La técnica \"divide y vencerás\" consta de los siguientes pasos:\n", "-- 1. Dividir el problema en subproblemas menores.\n", "-- 2. Resolver por separado cada uno de los subproblemas; si los\n", "-- subproblemas son complejos, usar la misma técnica recursivamente;\n", "-- si son simples, resolverlos directamente.\n", "-- 3. Combinar todas las soluciones de los subproblemas en una solución\n", "-- simple. \n", "\n", "-- (divideVenceras ind resuelve divide combina pbInicial) resuelve el\n", "-- problema pbInicial mediante la técnica de divide y vencerás, donde\n", "-- * (ind pb) se verifica si el problema pb es indivisible \n", "-- * (resuelve pb) es la solución del problema indivisible pb\n", "-- * (divide pb) es la lista de subproblemas de pb\n", "-- * (combina pb ss) es la combinación de las soluciones ss de los\n", "-- subproblemas del problema pb.\n", "-- * pbInicial es el problema inicial\n", "divideVenceras :: (p -> Bool) \n", " -> (p -> s) \n", " -> (p -> [p]) \n", " -> (p -> [s] -> s) \n", " -> p \n", " -> s\n", "divideVenceras ind resuelve divide combina = dv' \n", " where\n", " dv' pb\n", " | ind pb = resuelve pb\n", " | otherwise = combina pb [dv' sp | sp <- divide pb]" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "## La ordenación por mezcla como ejemplo de DyV" ] }, { "cell_type": "code", "execution_count": 3, "metadata": {}, "outputs": [], "source": [ "module DivideVencerasOrdMezcla where\n", "\n", "import DivideVenceras \n", "\n", "-- (ordenaPorMezcla xs) es la lista obtenida ordenando xs por el\n", "-- procedimiento de ordenación por mezcla. Por ejemplo,\n", "-- ghci> ordenaPorMezcla [3,1,4,1,5,9,2,8]\n", "-- [1,1,2,3,4,5,8,9]\n", "ordenaPorMezcla :: Ord a => [a] -> [a]\n", "ordenaPorMezcla = divideVenceras ind id divide combina \n", " where \n", " ind xs = length xs <= 1\n", " divide xs = [take n xs, drop n xs]\n", " where n = length xs `div` 2\n", " combina _ [l1,l2] = mezcla l1 l2\n", "\n", "-- (mezcla xs ys) es la lista obtenida mezclando xs e ys. Por ejemplo,\n", "-- mezcla [1,3] [2,4,6] == [1,2,3,4,6]\n", "mezcla :: Ord a => [a] -> [a] -> [a]\n", "mezcla [] b = b\n", "mezcla a [] = a\n", "mezcla a@(x:xs) b@(y:ys) \n", " | x <= y = x : mezcla xs b\n", " | otherwise = y : mezcla a ys" ] }, { "cell_type": "code", "execution_count": 4, "metadata": {}, "outputs": [ { "data": { "text/plain": [ "[1,1,2,3,4,5,8,9]" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "ordenaPorMezcla [3,1,4,1,5,9,2,8]" ] }, { "cell_type": "code", "execution_count": 5, "metadata": {}, "outputs": [], "source": [ ":m - DivideVencerasOrdMezcla" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "## La ordenación rápida como ejemplo de DyV" ] }, { "cell_type": "code", "execution_count": 6, "metadata": {}, "outputs": [], "source": [ "module DivideVencerasOrdRapida where\n", "\n", "import DivideVenceras\n", "\n", "-- (ordenaRapida xs) es la lista obtenida ordenando xs por el\n", "-- procedimiento de ordenación rápida. Por ejemplo,\n", "-- ghci> ordenaRapida [3,1,4,1,5,9,2,8]\n", "-- [1,1,2,3,4,5,8,9]\n", "ordenaRapida :: Ord a => [a] -> [a]\n", "ordenaRapida = divideVenceras ind id divide combina \n", " where \n", " ind xs = length xs <= 1\n", " divide (x:xs) = [[ y | y<-xs, y<=x],\n", " [ y | y<-xs, y>x] ]\n", " combina (x:_) [l1,l2] = l1 ++ [x] ++ l2" ] }, { "cell_type": "code", "execution_count": 7, "metadata": {}, "outputs": [ { "data": { "text/plain": [ "[1,1,2,3,4,5,8,9]" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "ordenaRapida [3,1,4,1,5,9,2,8]" ] }, { "cell_type": "code", "execution_count": 8, "metadata": {}, "outputs": [], "source": [ ":m - DivideVencerasOrdRapida" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "# Búsqueda en espacios de estados" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "## El patrón de búsqueda en espacios de estados\n", "\n", "**Descripción de los problemas de espacios de estados**\n", "\n", "Las características de los problemas de espacios de estados son:\n", "\n", "+ un conjunto de las posibles situaciones o *nodos* que constituye el *espacio\n", " de estados* (estos son las potenciales soluciones que se necesitan explorar),\n", "\n", "+ un conjunto de movimientos de un nodo a otros nodos, llamados los *sucesores*\n", " del nodo,\n", "\n", "+ un *nodo inicial* y\n", "\n", "+ un *nodo objetivo* que es la solución.\n", "\n", "Se supone que el grafo implícito de espacios de estados es acíclico.\n", "\n", " \n", "**El patrón de búsqueda en espacios de estados**" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "**Nota:** Se usa el TAD Pila de la librería [I1M](http://hackage.haskell.org/package/I1M-0.0.2)." ] }, { "cell_type": "code", "execution_count": 9, "metadata": {}, "outputs": [], "source": [ "module BusquedaEnEspaciosDeEstados (buscaEE) where\n", "\n", "-- ---------------------------------------------------------------------\n", "-- Importaciones --\n", "-- ---------------------------------------------------------------------\n", "\n", "import I1M.Pila\n", "\n", "-- (buscaEE s o e) es la lista de soluciones del problema de espacio de\n", "-- estado definido por la función sucesores (s), el objetivo (o) y el\n", "-- estado inicial (e).\n", "buscaEE :: (nodo -> [nodo]) -- sucesores\n", " -> (nodo -> Bool) -- esFinal\n", " -> nodo -- nodo actual\n", " -> [nodo] -- soluciones\n", "buscaEE sucesores esFinal x = busca' (apila x vacia) \n", " where\n", " busca' p \n", " | esVacia p = [] \n", " | esFinal (cima p) = cima p : busca' (desapila p)\n", " | otherwise =\n", " busca' (foldr apila (desapila p) (sucesores (cima p)))" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "## El problema de las n reinas\n", "\n", "+ El problema de las n reinas consiste en colocar n reinas en un tablero\n", " cuadrado de dimensiones n por n de forma que no se encuentren más de una en\n", " la misma línea: horizontal, vertical o diagonal.\n", "\n", "+ Se resolverá mediante búsqueda en espacio de estados" ] }, { "cell_type": "code", "execution_count": 10, "metadata": {}, "outputs": [], "source": [ "module BEE_Reinas where\n", "\n", "import BusquedaEnEspaciosDeEstados\n", "\n", "-- El problema de las n reinas consiste en colocar n reinas en un\n", "-- tablero cuadrado de dimensiones n por n de forma que no se encuentren\n", "-- más de una en la misma línea: horizontal, vertical o diagonal.\n", "\n", "-- Las posiciones de las reinas en el tablero se representan por su\n", "-- columna y su fila.\n", "type Columna = Int\n", "type Fila = Int\n", "\n", "-- Una solución del problema de las n reinas es una lista de\n", "-- posiciones. \n", "type SolNR = [(Columna,Fila)]\n", "\n", "-- (valida sp p) se verifica si la posición p es válida respecto de la\n", "-- solución parcial sp; es decir, la reina en la posición p no amenaza a\n", "-- ninguna de las reinas de la sp (se supone que están en distintas\n", "-- columnas). Por ejemplo, \n", "-- valida [(1,1)] (2,2) == False\n", "-- valida [(1,1)] (2,3) == True\n", "valida :: SolNR -> (Columna,Fila) -> Bool\n", "valida solp (c,r) = and [test s | s <- solp]\n", " where test (c',r') = c'+r'/=c+r && c'-r'/=c-r && r'/=r\n", "\n", "-- Los nodos del problema de las n reinas son ternas formadas por la\n", "-- columna de la última reina colocada, el número de columnas del\n", "-- tablero y la solución parcial de las reinas colocadas anteriormente. \n", "type NodoNR = (Columna,Columna,SolNR)\n", "\n", "-- (sucesoresNR e) es la lista de los sucesores del estado e en el\n", "-- problema de las n reinas. Por ejemplo,\n", "-- ghci> sucesoresNR (1,4,[])\n", "-- [(2,4,[(1,1)]),(2,4,[(1,2)]),(2,4,[(1,3)]),(2,4,[(1,4)])]\n", "sucesoresNR :: NodoNR -> [NodoNR]\n", "sucesoresNR (c,n,solp) =\n", " [(c+1,n,solp++[(c,r)]) | r <- [1..n] , valida solp (c,r)]\n", "\n", "-- (esFinalNR e) se verifica si e es un estado final del problema de las\n", "-- n reinas. \n", "esFinalNR :: NodoNR -> Bool\n", "esFinalNR (c,n,solp) = c > n\n", "\n", "-- (buscaEE_NR n) es la primera solución del problema de las n reinas,\n", "-- por búsqueda en espacio de estados. Por ejemplo,\n", "-- ghci> buscaEE_NR 8\n", "-- [(1,1),(2,5),(3,8),(4,6),(5,3),(6,7),(7,2),(8,4)]\n", "buscaEE_NR :: Columna -> SolNR\n", "buscaEE_NR n = s\n", " where ((_,_,s):_) = buscaEE sucesoresNR esFinalNR (1,n,[])\n", "\n", "-- (nSolucionesNR n) es el número de soluciones del problema de las n\n", "-- reinas, por búsqueda en espacio de estados. Por ejemplo, \n", "-- nSolucionesNR 8 == 92\n", "nSolucionesNR :: Columna -> Int\n", "nSolucionesNR n = \n", " length (buscaEE sucesoresNR \n", " esFinalNR \n", " (1,n,[]))" ] }, { "cell_type": "code", "execution_count": 11, "metadata": {}, "outputs": [ { "data": { "text/plain": [ "False" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "valida [(1,1)] (2,2)" ] }, { "cell_type": "code", "execution_count": 12, "metadata": {}, "outputs": [ { "data": { "text/plain": [ "True" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "valida [(1,1)] (2,3) " ] }, { "cell_type": "code", "execution_count": 13, "metadata": {}, "outputs": [ { "data": { "text/plain": [ "[(2,4,[(1,1)]),(2,4,[(1,2)]),(2,4,[(1,3)]),(2,4,[(1,4)])]" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "sucesoresNR (1,4,[])" ] }, { "cell_type": "code", "execution_count": 14, "metadata": {}, "outputs": [ { "data": { "text/plain": [ "[(1,1),(2,5),(3,8),(4,6),(5,3),(6,7),(7,2),(8,4)]" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "buscaEE_NR 8" ] }, { "cell_type": "code", "execution_count": 15, "metadata": {}, "outputs": [ { "data": { "text/plain": [ "92" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "nSolucionesNR 8 " ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "## El problema de la mochila\n", "\n", "+ Se tiene una mochila de capacidad de peso p y una lista de n objetos\n", " para colocar en la mochila. Cada objeto i tiene un peso w(i) y un valor\n", " v(i). Considerando la posibilidad de colocar el mismo objeto varias veces en\n", " la mochila, el problema consiste en determinar la forma de colocar los\n", " objetos en la mochila sin sobrepasar la capacidad de la mochila colocando el\n", " máximo valor posible.\n", "\n", "+ Se resolverá mediante búsqueda en espacio de estados" ] }, { "cell_type": "code", "execution_count": 16, "metadata": {}, "outputs": [], "source": [ "module BEE_Mochila where\n", "\n", "import BusquedaEnEspaciosDeEstados\n", "import Data.List (sort)\n", "\n", "-- Se tiene una mochila de capacidad de peso p y una lista de n objetos\n", "-- para colocar en la mochila. Cada objeto i tiene un peso w_i y un\n", "-- valor v_i. Considerando la posibilidad de colocar el mismo objeto\n", "-- varias veces en la mochila, el problema consiste en determinar la\n", "-- forma de colocar los objetos en la mochila sin sobrepasar la\n", "-- capacidad de la mochila colocando el máximmo valor posible.\n", "\n", "-- Los pesos son número enteros\n", "type Peso = Int\n", "\n", "-- Los valores son números reales.\n", "type Valor = Float\n", "\n", "-- Los objetos son pares formado por un peso y un valor\n", "type Objeto = (Peso,Valor)\n", "\n", "-- Una solución del problema de la mochila es una lista de objetos.\n", "type SolMoch = [Objeto]\n", "\n", "-- Los estados del problema de la mochila son 5-tupla de la forma\n", "-- (v,p,l,o,s) donde v es el valor de los objetos colocados, p es el\n", "-- peso de los objetos colocados, l es el límite de la capacidad de la\n", "-- mochila, o es la lista de los objetos colocados (ordenados de forma\n", "-- creciente según sus pesos) y s es la solución parcial.\n", "type NodoMoch = (Valor,Peso,Peso,[Objeto],SolMoch)\n", "\n", "\n", "-- (sucesoresMoch e) es la lista de los sucesores del estado e en el\n", "-- problema de la mochila.\n", "sucesoresMoch :: NodoMoch -> [NodoMoch]\n", "sucesoresMoch (v,p,limite,objetos,solp) =\n", " [( v+v',\n", " p+p',\n", " limite,\n", " [o | o@(p'',_) <- objetos, p''>=p'], \n", " (p',v'):solp )\n", " | (p',v') <- objetos, \n", " p+p' <= limite]\n", "\n", "-- (esObjetivoMoch e) se verifica si e es un estado final el problema de\n", "-- la mochila.\n", "esObjetivoMoch :: NodoMoch -> Bool\n", "esObjetivoMoch (_,p,limite,((p',_):_),_) = p+p'>limite\n", "\n", "-- (buscaEE_Mochila os l) es la solución del problema de la mochila para\n", "-- la lista de objetos os y el límite de capacidad l. Por ejemplo,\n", "-- > buscaEE_Mochila [(2,3),(3,5),(4,6),(5,10)] 8\n", "-- ([(5,10.0),(3,5.0)],15.0)\n", "-- > buscaEE_Mochila [(2,3),(3,5),(5,6)] 10\n", "-- ([(3,5.0),(3,5.0),(2,3.0),(2,3.0)],16.0)\n", "-- > buscaEE_Mochila [(8,15),(15,10),(3,6),(6,13),(2,4),(4,8),(5,6),(7,7)] 35\n", "-- ([(6,13.0),(6,13.0),(6,13.0),(6,13.0),(6,13.0),(3,6.0),(2,4.0)],75.0)\n", "-- > buscaEE_Mochila [(2,2.8),(3,4.4),(5,6.1)] 10\n", "-- ([(3,4.4),(3,4.4),(2,2.8),(2,2.8)],14.4)\n", "buscaEE_Mochila :: [Objeto] -> Peso -> (SolMoch,Valor)\n", "buscaEE_Mochila objetos limite = (sol,v) \n", " where \n", " (v,_,_,_,sol) = \n", " maximum (buscaEE sucesoresMoch \n", " esObjetivoMoch \n", " (0,0,limite,sort objetos,[]))\n", "\n", "mochila :: [Objeto] -> Peso -> [(SolMoch, Valor)]\n", "mochila objetos limite = \n", " [(sol,v) | (v,w,_,_,sol) <- buscaEE sucesoresMoch \n", " esObjetivoMoch \n", " (0,0,limite,sort objetos,[]),\n", " (w==10) || (w==9) ||(w==8) ]" ] }, { "cell_type": "code", "execution_count": 17, "metadata": {}, "outputs": [ { "data": { "text/plain": [ "([(5,10.0),(3,5.0)],15.0)" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "buscaEE_Mochila [(2,3),(3,5),(4,6),(5,10)] 8" ] }, { "cell_type": "code", "execution_count": 18, "metadata": {}, "outputs": [ { "data": { "text/plain": [ "([(3,5.0),(3,5.0),(2,3.0),(2,3.0)],16.0)" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "buscaEE_Mochila [(2,3),(3,5),(5,6)] 10" ] }, { "cell_type": "code", "execution_count": 19, "metadata": {}, "outputs": [ { "data": { "text/plain": [ "([(3,4.4),(3,4.4),(2,2.8),(2,2.8)],14.4)" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "buscaEE_Mochila [(2,2.8),(3,4.4),(5,6.1)] 10" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "# Búsqueda por primero el mejor" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "## El patrón de búsqueda por primero el mejor" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "**Nota:** Se usa el TAD ColaDePrioridad de la librería \n", "[I1M](http://hackage.haskell.org/package/I1M-0.0.2)." ] }, { "cell_type": "code", "execution_count": 20, "metadata": {}, "outputs": [], "source": [ "module BusquedaPrimeroElMejor (buscaPM) where\n", "\n", "-- ---------------------------------------------------------------------\n", "-- Importaciones --\n", "-- ---------------------------------------------------------------------\n", "\n", "import I1M.ColaDePrioridad\n", "\n", "-- (buscaPM s o e) es la lista de soluciones del problema de espacio de\n", "-- estado definido por la función sucesores (s), el objetivo (o) y el\n", "-- estado inicial (e), obtenidas buscando por primero el mejor.\n", "buscaPM :: (Ord nodo) => \n", " (nodo -> [nodo]) -- sucesores\n", " -> (nodo -> Bool) -- esFinal\n", " -> nodo -- nodo actual\n", " -> [nodo] -- solución\n", "buscaPM sucesores esFinal x = busca' (inserta x vacia)\n", " where\n", " busca' c\n", " | esVacia c = []\n", " | esFinal (primero c) =\n", " primero c : busca' (resto c)\n", " | otherwise = \n", " busca' (foldr inserta (resto c) (sucesores (primero c)))" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "## El problema del 8 puzzle\n", "\n", "Para el 8-puzzle se usa un cajón cuadrado en el que hay situados 8\n", "bloques cuadrados. El cuadrado restante está sin rellenar. Cada bloque tiene\n", "un número. Un bloque adyacente al hueco puede deslizarse hacia él. El juego\n", "consiste en transformar la posición inicial en la posición final mediante el\n", "deslizamiento de los bloques. En particular, consideramos el estado inicial\n", "y final siguientes:\n", "\n", "```sesion\n", "+---+---+---+ +---+---+---+\n", "| 2 | 6 | 3 | | 1 | 2 | 3 | \n", "+---+---+---+ +---+---+---+ \n", "| 5 | | 4 | | 8 | | 4 | \n", "+---+---+---+ +---+---+---+ \n", "| 1 | 7 | 8 | | 7 | 6 | 5 | \n", "+---+---+---+ +---+---+---+ \n", "Estado inicial Estado final\n", "```\n", "\n", "+ Se resolverá mediante primero el mejor.\n", "\n" ] }, { "cell_type": "code", "execution_count": 21, "metadata": {}, "outputs": [], "source": [ "module BPM_8Puzzle where\n", "\n", "import BusquedaPrimeroElMejor\n", "import Data.Array\n", "\n", "-- Representación del problema:\n", "-- ============================\n", "\n", "-- Nota: La representación del problema está copiado de\n", "-- BusquedaEnEspaciosDeEstados.hs \n", "\n", "-- Una posición es un par de enteros.\n", "type Posicion = (Int,Int)\n", "\n", "-- Un tablero es un vector de posiciones, en el que el índice indica el\n", "-- elemento que ocupa la posición.\n", "type Tablero = Array Int Posicion\n", "\n", "-- inicial8P es el estado inicial del 8 puzzle. En el ejemplo es\n", "-- +---+---+---+\n", "-- | 2 | 6 | 3 | \n", "-- +---+---+---+ \n", "-- | 5 | | 4 | \n", "-- +---+---+---+ \n", "-- | 1 | 7 | 8 | \n", "-- +---+---+---+ \n", "inicial8P :: Tablero \n", "inicial8P = array (0,8) [(2,(1,3)),(6,(2,3)),(3,(3,3)),\n", " (5,(1,2)),(0,(2,2)),(4,(3,2)),\n", " (1,(1,1)),(7,(2,1)),(8,(3,1))]\n", "\n", "-- final8P es el estado final del 8 puzzle. En el ejemplo es\n", "-- +---+---+---+\n", "-- | 1 | 2 | 3 | \n", "-- +---+---+---+ \n", "-- | 8 | | 4 | \n", "-- +---+---+---+ \n", "-- | 7 | 6 | 5 | \n", "-- +---+---+---+ \n", "final8P :: Tablero\n", "final8P = array (0,8) [(1,(1,3)),(2,(2,3)),(3,(3,3)),\n", " (8,(1,2)),(0,(2,2)),(4,(3,2)),\n", " (7,(1,1)),(6,(2,1)),(5,(3,1))]\n", "\n", "-- (distancia p1 p2) es la distancia Manhatan entre las posiciones p1 y\n", "-- p2. Por ejemplo,\n", "-- distancia (2,7) (4,1) == 8\n", "distancia :: Posicion -> Posicion -> Int\n", "distancia (x1,y1) (x2,y2) = abs (x1-x2) + abs (y1-y2)\n", "\n", "-- (adyacente p1 p2) se verifica si las posiciones p1 y p2 son\n", "-- adyacentes. Por ejemplo,\n", "-- adyacente (3,2) (3,1) == True\n", "-- adyacente (3,2) (1,2) == False\n", "adyacente :: Posicion -> Posicion -> Bool\n", "adyacente p1 p2 = distancia p1 p2 == 1\n", "\n", "-- (todosMovimientos t) es la lista de los tableros obtenidos\n", "-- aplicándole al tablero t todos los posibles movimientos; es decir,\n", "-- intercambiando la posición del hueco con sus adyacentes. Por ejemplo, \n", "-- *Main> inicial8P\n", "-- array (0,8) [(0,(2,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))]\n", "-- *Main> todosMovimientos inicial8P\n", "-- [array (0,8) [(0,(3,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(2,2)),\n", "-- (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))],\n", "-- array (0,8) [(0,(1,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(2,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))],\n", "-- array (0,8) [(0,(2,3)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(1,2)),(6,(2,2)),(7,(2,1)),(8,(3,1))],\n", "-- array (0,8) [(0,(2,1)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(1,2)),(6,(2,3)),(7,(2,2)),(8,(3,1))]]\n", "todosMovimientos :: Tablero -> [Tablero]\n", "todosMovimientos t = [t//[(0,t!i),(i,t!0)] | i<-[1..8], adyacente (t!0) (t!i)] \n", "\n", "-- Los nodos del espacio de estados son listas de tableros [t_n,...,t_1]\n", "-- tal que t_i es un sucesor de t_(i-1).\n", "newtype Tableros = Est [Tablero] deriving Show\n", "\n", "-- (sucesores8P e) es la lista de sucesores del estado e. Por ejemplo,\n", "-- *Main> sucesores8P (Est [inicial8P])\n", "-- [Est [array (0,8) [(0,(3,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(2,2)),\n", "-- (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))],\n", "-- array (0,8) [(0,(2,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))]],\n", "-- Est [array (0,8) [(0,(1,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(2,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))],\n", "-- array (0,8) [(0,(2,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))]],\n", "-- Est [array (0,8) [(0,(2,3)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(1,2)),(6,(2,2)),(7,(2,1)),(8,(3,1))],\n", "-- array (0,8) [(0,(2,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))]],\n", "-- Est [array (0,8) [(0,(2,1)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(1,2)),(6,(2,3)),(7,(2,2)),(8,(3,1))],\n", "-- array (0,8) [(0,(2,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))]]]\n", "sucesores8P :: Tableros -> [Tableros]\n", "sucesores8P (Est(n@(t:ts))) = \n", " filter (noEn ts) [ Est (t':n) | t' <- todosMovimientos t]\n", " where noEn ts' (Est(t':_)) = elems t' `notElem` map elems ts'\n", "\n", "esFinal8P :: Tableros -> Bool\n", "esFinal8P (Est (n:_)) = elems n == elems final8P\n", "\n", "-- Heurísticas\n", "-- ===========\n", "\n", "-- (heur1 t) es la suma de la distancia Manhatan desde la posición de\n", "-- cada objeto del tablero a su posición en el estado final. Por\n", "-- ejemplo,\n", "-- heur1 inicial8P == 12\n", "heur1 :: Tablero -> Int\n", "heur1 b = sum [distancia (b!i) (final8P!i) | i <- [0..8]]\n", "\n", "-- Dos estados se consideran iguales si tienen la misma heurística.\n", "instance Eq Tableros\n", " where Est(t1:_) == Est(t2:_) = heur1 t1 == heur1 t2\n", "\n", "-- Un estado es menor o igual que otro si tiene una heurística menor o\n", "-- igual. \n", "instance Ord Tableros where \n", " Est (t1:_) <= Est (t2:_) = heur1 t1 <= heur1 t2\n", "\n", "-- (buscaPM_8P) es la lista de las soluciones del 8 puzzle por búsqueda\n", "-- primero el mejor. Por ejemplo,\n", "-- ghci> head buscaPM_8P\n", "-- (Est [array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(3,1)),(6,(2,1)),(7,(1,1)),(8,(1,2))],\n", "-- array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(3,1)),(6,(2,2)),(7,(1,1)),(8,(1,2))],\n", "-- array (0,8) [(0,(1,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(3,1)),(6,(2,2)),(7,(2,1)),(8,(1,2))],\n", "-- array (0,8) [(0,(1,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(3,1)),(6,(2,2)),(7,(2,1)),(8,(1,1))],\n", "-- array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(3,1)),(6,(1,2)),(7,(2,1)),(8,(1,1))],\n", "-- array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(3,1)),(6,(1,2)),(7,(2,2)),(8,(1,1))],\n", "-- array (0,8) [(0,(3,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(2,1)),(6,(1,2)),(7,(2,2)),(8,(1,1))],\n", "-- array (0,8) [(0,(3,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),\n", "-- (5,(2,1)),(6,(1,2)),(7,(2,2)),(8,(1,1))],\n", "-- array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),\n", "-- (5,(2,1)),(6,(1,2)),(7,(3,2)),(8,(1,1))],\n", "-- array (0,8) [(0,(1,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),\n", "-- (5,(2,1)),(6,(2,2)),(7,(3,2)),(8,(1,1))],\n", "-- array (0,8) [(0,(1,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),\n", "-- (5,(2,1)),(6,(2,2)),(7,(3,2)),(8,(1,2))],\n", "-- array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),\n", "-- (5,(1,1)),(6,(2,2)),(7,(3,2)),(8,(1,2))],\n", "-- array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),\n", "-- (5,(1,1)),(6,(2,1)),(7,(3,2)),(8,(1,2))],\n", "-- array (0,8) [(0,(3,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),\n", "-- (5,(1,1)),(6,(2,1)),(7,(2,2)),(8,(1,2))],\n", "-- array (0,8) [(0,(3,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(1,1)),(6,(2,1)),(7,(2,2)),(8,(1,2))],\n", "-- array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(1,1)),(6,(3,1)),(7,(2,2)),(8,(1,2))],\n", "-- array (0,8) [(0,(1,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(2,1)),(6,(3,1)),(7,(2,2)),(8,(1,2))],\n", "-- array (0,8) [(0,(1,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(2,1)),(6,(3,1)),(7,(2,2)),(8,(1,1))],\n", "-- array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(2,1)),(6,(3,1)),(7,(1,2)),(8,(1,1))],\n", "-- array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(2,2)),(6,(3,1)),(7,(1,2)),(8,(1,1))],\n", "-- array (0,8) [(0,(3,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(2,2)),(6,(2,1)),(7,(1,2)),(8,(1,1))],\n", "-- array (0,8) [(0,(3,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),\n", "-- (5,(2,2)),(6,(2,1)),(7,(1,2)),(8,(1,1))],\n", "-- array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),\n", "-- (5,(3,2)),(6,(2,1)),(7,(1,2)),(8,(1,1))],\n", "-- array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),\n", "-- (5,(3,2)),(6,(2,2)),(7,(1,2)),(8,(1,1))],\n", "-- array (0,8) [(0,(1,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),\n", "-- (5,(3,2)),(6,(2,2)),(7,(1,2)),(8,(2,1))],\n", "-- array (0,8) [(0,(1,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),\n", "-- (5,(3,2)),(6,(2,2)),(7,(1,1)),(8,(2,1))],\n", "-- array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),\n", "-- (5,(3,2)),(6,(1,2)),(7,(1,1)),(8,(2,1))],\n", "-- array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),\n", "-- (5,(3,2)),(6,(1,2)),(7,(1,1)),(8,(2,2))],\n", "-- array (0,8) [(0,(3,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,1)),\n", "-- (5,(3,2)),(6,(1,2)),(7,(1,1)),(8,(2,2))],\n", "-- array (0,8) [(0,(3,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,1)),\n", "-- (5,(3,1)),(6,(1,2)),(7,(1,1)),(8,(2,2))],\n", "-- array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,1)),\n", "-- (5,(3,1)),(6,(1,2)),(7,(1,1)),(8,(3,2))],\n", "-- array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,2)),\n", "-- (5,(3,1)),(6,(1,2)),(7,(1,1)),(8,(3,2))],\n", "-- array (0,8) [(0,(3,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,2)),\n", "-- (5,(2,1)),(6,(1,2)),(7,(1,1)),(8,(3,2))],\n", "-- array (0,8) [(0,(3,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,2)),\n", "-- (5,(2,1)),(6,(1,2)),(7,(1,1)),(8,(3,1))],\n", "-- array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(2,1)),(6,(1,2)),(7,(1,1)),(8,(3,1))],\n", "-- array (0,8) [(0,(1,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(2,1)),(6,(2,2)),(7,(1,1)),(8,(3,1))],\n", "-- array (0,8) [(0,(1,3)),(1,(1,2)),(2,(2,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(2,1)),(6,(2,2)),(7,(1,1)),(8,(3,1))],\n", "-- array (0,8) [(0,(2,3)),(1,(1,2)),(2,(1,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(2,1)),(6,(2,2)),(7,(1,1)),(8,(3,1))],\n", "-- array (0,8) [(0,(2,2)),(1,(1,2)),(2,(1,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(2,1)),(6,(2,3)),(7,(1,1)),(8,(3,1))],\n", "-- array (0,8) [(0,(2,1)),(1,(1,2)),(2,(1,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(2,2)),(6,(2,3)),(7,(1,1)),(8,(3,1))],\n", "-- array (0,8) [(0,(1,1)),(1,(1,2)),(2,(1,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(2,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))],\n", "-- array (0,8) [(0,(1,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(2,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))],\n", "-- array (0,8) [(0,(2,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),\n", "-- (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))]],\n", "-- 78)\n", "buscaPM_8P :: [Tableros]\n", "buscaPM_8P = buscaPM sucesores8P \n", " esFinal8P \n", " (Est [inicial8P])\n", "\n", "-- (nSolucionesPM_8P) es el número de soluciones del 8 puzzle por\n", "-- búsqueda primero el mejor. Por ejemplo,\n", "-- nSolucionesPM_8P == 43\n", "nSolucionesPM_8P :: Int\n", "nSolucionesPM_8P = length ls\n", " where (Est ls : _) = buscaPM sucesores8P \n", " esFinal8P \n", " (Est [inicial8P])" ] }, { "cell_type": "code", "execution_count": 22, "metadata": {}, "outputs": [ { "data": { "text/plain": [ "8" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "distancia (2,7) (4,1) " ] }, { "cell_type": "code", "execution_count": 23, "metadata": {}, "outputs": [ { "data": { "text/plain": [ "True" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "adyacente (3,2) (3,1) " ] }, { "cell_type": "code", "execution_count": 24, "metadata": {}, "outputs": [ { "data": { "text/plain": [ "False" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "adyacente (3,2) (1,2) " ] }, { "cell_type": "code", "execution_count": 25, "metadata": {}, "outputs": [ { "data": { "text/plain": [ "12" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "heur1 inicial8P " ] }, { "cell_type": "code", "execution_count": 26, "metadata": {}, "outputs": [ { "data": { "text/plain": [ "array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),(5,(3,1)),(6,(2,1)),(7,(1,1)),(8,(1,2))]\n", "array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),(5,(3,1)),(6,(2,2)),(7,(1,1)),(8,(1,2))]\n", "array (0,8) [(0,(1,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),(5,(3,1)),(6,(2,2)),(7,(2,1)),(8,(1,2))]\n", "array (0,8) [(0,(1,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),(5,(3,1)),(6,(2,2)),(7,(2,1)),(8,(1,1))]\n", "array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),(5,(3,1)),(6,(1,2)),(7,(2,1)),(8,(1,1))]\n", "array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),(5,(3,1)),(6,(1,2)),(7,(2,2)),(8,(1,1))]\n", "array (0,8) [(0,(3,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),(5,(2,1)),(6,(1,2)),(7,(2,2)),(8,(1,1))]\n", "array (0,8) [(0,(3,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),(5,(2,1)),(6,(1,2)),(7,(2,2)),(8,(1,1))]\n", "array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),(5,(2,1)),(6,(1,2)),(7,(3,2)),(8,(1,1))]\n", "array (0,8) [(0,(1,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),(5,(2,1)),(6,(2,2)),(7,(3,2)),(8,(1,1))]\n", "array (0,8) [(0,(1,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),(5,(2,1)),(6,(2,2)),(7,(3,2)),(8,(1,2))]\n", "array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),(5,(1,1)),(6,(2,2)),(7,(3,2)),(8,(1,2))]\n", "array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),(5,(1,1)),(6,(2,1)),(7,(3,2)),(8,(1,2))]\n", "array (0,8) [(0,(3,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),(5,(1,1)),(6,(2,1)),(7,(2,2)),(8,(1,2))]\n", "array (0,8) [(0,(3,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),(5,(1,1)),(6,(2,1)),(7,(2,2)),(8,(1,2))]\n", "array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),(5,(1,1)),(6,(3,1)),(7,(2,2)),(8,(1,2))]\n", "array (0,8) [(0,(1,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),(5,(2,1)),(6,(3,1)),(7,(2,2)),(8,(1,2))]\n", "array (0,8) [(0,(1,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),(5,(2,1)),(6,(3,1)),(7,(2,2)),(8,(1,1))]\n", "array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),(5,(2,1)),(6,(3,1)),(7,(1,2)),(8,(1,1))]\n", "array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),(5,(2,2)),(6,(3,1)),(7,(1,2)),(8,(1,1))]\n", "array (0,8) [(0,(3,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),(5,(2,2)),(6,(2,1)),(7,(1,2)),(8,(1,1))]\n", "array (0,8) [(0,(3,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),(5,(2,2)),(6,(2,1)),(7,(1,2)),(8,(1,1))]\n", "array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),(5,(3,2)),(6,(2,1)),(7,(1,2)),(8,(1,1))]\n", "array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),(5,(3,2)),(6,(2,2)),(7,(1,2)),(8,(1,1))]\n", "array (0,8) [(0,(1,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),(5,(3,2)),(6,(2,2)),(7,(1,2)),(8,(2,1))]\n", "array (0,8) [(0,(1,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),(5,(3,2)),(6,(2,2)),(7,(1,1)),(8,(2,1))]\n", "array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),(5,(3,2)),(6,(1,2)),(7,(1,1)),(8,(2,1))]\n", "array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),(5,(3,2)),(6,(1,2)),(7,(1,1)),(8,(2,2))]\n", "array (0,8) [(0,(3,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,1)),(5,(3,2)),(6,(1,2)),(7,(1,1)),(8,(2,2))]\n", "array (0,8) [(0,(3,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,1)),(5,(3,1)),(6,(1,2)),(7,(1,1)),(8,(2,2))]\n", "array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,1)),(5,(3,1)),(6,(1,2)),(7,(1,1)),(8,(3,2))]\n", "array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,2)),(5,(3,1)),(6,(1,2)),(7,(1,1)),(8,(3,2))]\n", "array (0,8) [(0,(3,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,2)),(5,(2,1)),(6,(1,2)),(7,(1,1)),(8,(3,2))]\n", "array (0,8) [(0,(3,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,2)),(5,(2,1)),(6,(1,2)),(7,(1,1)),(8,(3,1))]\n", "array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),(5,(2,1)),(6,(1,2)),(7,(1,1)),(8,(3,1))]\n", "array (0,8) [(0,(1,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),(5,(2,1)),(6,(2,2)),(7,(1,1)),(8,(3,1))]\n", "array (0,8) [(0,(1,3)),(1,(1,2)),(2,(2,3)),(3,(3,3)),(4,(3,2)),(5,(2,1)),(6,(2,2)),(7,(1,1)),(8,(3,1))]\n", "array (0,8) [(0,(2,3)),(1,(1,2)),(2,(1,3)),(3,(3,3)),(4,(3,2)),(5,(2,1)),(6,(2,2)),(7,(1,1)),(8,(3,1))]\n", "array (0,8) [(0,(2,2)),(1,(1,2)),(2,(1,3)),(3,(3,3)),(4,(3,2)),(5,(2,1)),(6,(2,3)),(7,(1,1)),(8,(3,1))]\n", "array (0,8) [(0,(2,1)),(1,(1,2)),(2,(1,3)),(3,(3,3)),(4,(3,2)),(5,(2,2)),(6,(2,3)),(7,(1,1)),(8,(3,1))]\n", "array (0,8) [(0,(1,1)),(1,(1,2)),(2,(1,3)),(3,(3,3)),(4,(3,2)),(5,(2,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))]\n", "array (0,8) [(0,(1,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),(5,(2,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))]\n", "array (0,8) [(0,(2,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),(5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))]" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "(Est ms) = head buscaPM_8P\n", "mapM_ print ms" ] }, { "cell_type": "code", "execution_count": 27, "metadata": {}, "outputs": [ { "data": { "text/plain": [ "[(2,2),(1,3),(2,3),(3,3),(3,2),(3,1),(2,1),(1,1),(1,2)]\n", "[(2,1),(1,3),(2,3),(3,3),(3,2),(3,1),(2,2),(1,1),(1,2)]\n", "[(1,1),(1,3),(2,3),(3,3),(3,2),(3,1),(2,2),(2,1),(1,2)]\n", "[(1,2),(1,3),(2,3),(3,3),(3,2),(3,1),(2,2),(2,1),(1,1)]\n", "[(2,2),(1,3),(2,3),(3,3),(3,2),(3,1),(1,2),(2,1),(1,1)]\n", "[(2,1),(1,3),(2,3),(3,3),(3,2),(3,1),(1,2),(2,2),(1,1)]\n", "[(3,1),(1,3),(2,3),(3,3),(3,2),(2,1),(1,2),(2,2),(1,1)]\n", "[(3,2),(1,3),(2,3),(3,3),(3,1),(2,1),(1,2),(2,2),(1,1)]\n", "[(2,2),(1,3),(2,3),(3,3),(3,1),(2,1),(1,2),(3,2),(1,1)]\n", "[(1,2),(1,3),(2,3),(3,3),(3,1),(2,1),(2,2),(3,2),(1,1)]\n", "[(1,1),(1,3),(2,3),(3,3),(3,1),(2,1),(2,2),(3,2),(1,2)]\n", "[(2,1),(1,3),(2,3),(3,3),(3,1),(1,1),(2,2),(3,2),(1,2)]\n", "[(2,2),(1,3),(2,3),(3,3),(3,1),(1,1),(2,1),(3,2),(1,2)]\n", "[(3,2),(1,3),(2,3),(3,3),(3,1),(1,1),(2,1),(2,2),(1,2)]\n", "[(3,1),(1,3),(2,3),(3,3),(3,2),(1,1),(2,1),(2,2),(1,2)]\n", "[(2,1),(1,3),(2,3),(3,3),(3,2),(1,1),(3,1),(2,2),(1,2)]\n", "[(1,1),(1,3),(2,3),(3,3),(3,2),(2,1),(3,1),(2,2),(1,2)]\n", "[(1,2),(1,3),(2,3),(3,3),(3,2),(2,1),(3,1),(2,2),(1,1)]\n", "[(2,2),(1,3),(2,3),(3,3),(3,2),(2,1),(3,1),(1,2),(1,1)]\n", "[(2,1),(1,3),(2,3),(3,3),(3,2),(2,2),(3,1),(1,2),(1,1)]\n", "[(3,1),(1,3),(2,3),(3,3),(3,2),(2,2),(2,1),(1,2),(1,1)]\n", "[(3,2),(1,3),(2,3),(3,3),(3,1),(2,2),(2,1),(1,2),(1,1)]\n", "[(2,2),(1,3),(2,3),(3,3),(3,1),(3,2),(2,1),(1,2),(1,1)]\n", "[(2,1),(1,3),(2,3),(3,3),(3,1),(3,2),(2,2),(1,2),(1,1)]\n", "[(1,1),(1,3),(2,3),(3,3),(3,1),(3,2),(2,2),(1,2),(2,1)]\n", "[(1,2),(1,3),(2,3),(3,3),(3,1),(3,2),(2,2),(1,1),(2,1)]\n", "[(2,2),(1,3),(2,3),(3,3),(3,1),(3,2),(1,2),(1,1),(2,1)]\n", "[(2,1),(1,3),(2,3),(3,3),(3,1),(3,2),(1,2),(1,1),(2,2)]\n", "[(3,1),(1,3),(2,3),(3,3),(2,1),(3,2),(1,2),(1,1),(2,2)]\n", "[(3,2),(1,3),(2,3),(3,3),(2,1),(3,1),(1,2),(1,1),(2,2)]\n", "[(2,2),(1,3),(2,3),(3,3),(2,1),(3,1),(1,2),(1,1),(3,2)]\n", "[(2,1),(1,3),(2,3),(3,3),(2,2),(3,1),(1,2),(1,1),(3,2)]\n", "[(3,1),(1,3),(2,3),(3,3),(2,2),(2,1),(1,2),(1,1),(3,2)]\n", "[(3,2),(1,3),(2,3),(3,3),(2,2),(2,1),(1,2),(1,1),(3,1)]\n", "[(2,2),(1,3),(2,3),(3,3),(3,2),(2,1),(1,2),(1,1),(3,1)]\n", "[(1,2),(1,3),(2,3),(3,3),(3,2),(2,1),(2,2),(1,1),(3,1)]\n", "[(1,3),(1,2),(2,3),(3,3),(3,2),(2,1),(2,2),(1,1),(3,1)]\n", "[(2,3),(1,2),(1,3),(3,3),(3,2),(2,1),(2,2),(1,1),(3,1)]\n", "[(2,2),(1,2),(1,3),(3,3),(3,2),(2,1),(2,3),(1,1),(3,1)]\n", "[(2,1),(1,2),(1,3),(3,3),(3,2),(2,2),(2,3),(1,1),(3,1)]\n", "[(1,1),(1,2),(1,3),(3,3),(3,2),(2,2),(2,3),(2,1),(3,1)]\n", "[(1,2),(1,1),(1,3),(3,3),(3,2),(2,2),(2,3),(2,1),(3,1)]\n", "[(2,2),(1,1),(1,3),(3,3),(3,2),(1,2),(2,3),(2,1),(3,1)]" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "import Data.Array\n", "(Est ms) = head buscaPM_8P\n", "mapM_ print (map elems ms)" ] }, { "cell_type": "code", "execution_count": 28, "metadata": {}, "outputs": [ { "data": { "text/plain": [ "43" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "nSolucionesPM_8P" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "# Búsqueda en escalada" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "## El patrón de búsqueda en escalada" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "**Nota:** Se usa el TAD ColaDePrioridad de la librería \n", "[I1M](http://hackage.haskell.org/package/I1M-0.0.2)." ] }, { "cell_type": "code", "execution_count": 30, "metadata": {}, "outputs": [], "source": [ "module BusquedaEnEscalada where\n", "\n", "-- ---------------------------------------------------------------------\n", "-- Importaciones --\n", "-- ---------------------------------------------------------------------\n", "\n", "import I1M.ColaDePrioridad\n", "\n", "-- ---------------------------------------------------------------------\n", "-- El patrón de búsqueda en escalada --\n", "-- ---------------------------------------------------------------------\n", "\n", "-- (buscaEscalada s o e) es la lista de soluciones del problema de espacio de\n", "-- estado definido por la función sucesores (s), el objetivo (o) y el\n", "-- estado inicial (e), obtenidas buscando por escalada.\n", "buscaEscalada :: Ord nodo => \n", " (nodo -> [nodo]) -- sucesores\n", " -> (nodo -> Bool) -- es final\n", " -> nodo -- nodo actual\n", " -> [nodo] -- soluciones\n", "buscaEscalada sucesores esFinal x = busca' (inserta x vacia) where\n", " busca' c \n", " | esVacia c = [] \n", " | esFinal (primero c) = [primero c]\n", " | otherwise = busca' (foldr inserta vacia (sucesores (primero c)))" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "## El problema del cambio de monedas por escalada\n", "\n", "+ El problema del cambio de monedas consiste en determinar cómo conseguir una\n", " cantidad usando el menor número de monedas disponibles.\n", "\n", "+ Se resolverá por búsqueda en escalada.\n" ] }, { "cell_type": "code", "execution_count": 31, "metadata": {}, "outputs": [], "source": [ "module Escalada_Monedas where\n", "\n", "import BusquedaEnEscalada\n", "\n", "-- El problema del cambio de monedas consiste en determinar cómo\n", "-- conseguir una cantidad usando el menor número de monedas disponibles. \n", "\n", "-- Las monedas son números enteros.\n", "type Moneda = Int\n", "\n", "-- monedas es la lista del tipo de monedas disponibles. Se supone que\n", "-- hay un número infinito de monedas de cada tipo.\n", "monedas :: [Moneda]\n", "monedas = [1,2,5,10,20,50,100]\n", "\n", "-- Las soluciones son listas de monedas.\n", "type Soluciones = [Moneda]\n", "\n", "-- Los estados son pares formados por la cantidad que falta y la lista\n", "-- de monedas usadas.\n", "type NodoMonedas = (Int, [Moneda])\n", "\n", "-- (sucesoresMonedas e) es la lista de los sucesores del estado e en el\n", "-- problema de las monedas. Por ejemplo,\n", "-- ghci> sucesoresMonedas (199,[])\n", "-- [(198,[1]),(197,[2]),(194,[5]),(189,[10]),\n", "-- (179,[20]),(149,[50]),(99,[100])]\n", "sucesoresMonedas :: NodoMonedas -> [NodoMonedas]\n", "sucesoresMonedas (r,p) = \n", " [(r-c,c:p) | c <- monedas, r-c >= 0]\n", "\n", "-- (esFinalMonedas e) se verifica si e es un estado final del problema\n", "-- de las monedas.\n", "esFinalMonedas :: NodoMonedas -> Bool\n", "esFinalMonedas (v,_) = v==0\n", "\n", "-- (cambio n) es la solución del problema de las monedas por búsqueda en\n", "-- escalada. Por ejemplo,\n", "-- cambio 199 == [2,2,5,20,20,50,100]\n", "cambio :: Int -> Soluciones\n", "cambio n = \n", " snd (head (buscaEscalada sucesoresMonedas \n", " esFinalMonedas \n", " (n,[])))" ] }, { "cell_type": "code", "execution_count": 32, "metadata": {}, "outputs": [ { "data": { "text/plain": [ "[(198,[1]),(197,[2]),(194,[5]),(189,[10]),(179,[20]),(149,[50]),(99,[100])]" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "sucesoresMonedas (199,[])" ] }, { "cell_type": "code", "execution_count": 33, "metadata": {}, "outputs": [ { "data": { "text/plain": [ "[2,2,5,20,20,50,100]" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "cambio 199 " ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "## El algoritmo de Prim del árbol de expansión mínimo por escalada\n", "\n", "+ Se resolverá mediante búsqueda en escalada." ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "**Nota:** Se usa el TAD Grafo de la librería \n", "[I1M](http://hackage.haskell.org/package/I1M-0.0.2)." ] }, { "cell_type": "code", "execution_count": 34, "metadata": {}, "outputs": [], "source": [ "module Escalada_Prim where\n", "\n", "import BusquedaEnEscalada\n", "import I1M.Grafo\n", "import Data.Array\n", "import Data.List\n", "\n", "g1 :: Grafo Int Int \n", "g1 = creaGrafo ND (1,5) [(1,2,12),(1,3,34),(1,5,78),\n", " (2,4,55),(2,5,32),\n", " (3,4,61),(3,5,44),\n", " (4,5,93)]\n", "\n", "-- Una arista esta formada dos nodos junto con su peso.\n", "type Arista a b = (a,a,b)\n", "\n", "-- Un nodo (NodoAEM (p,t,r,aem)) está formado por el peso p de la última\n", "-- arista añadida el árbol de expansión mínimo (aem), la lista t\n", "-- de nodos del grafo que están en el aem, la lista r de nodos del\n", "-- grafo que no están en el aem y el aem. \n", "type NodoAEM a b = (b,[a],[a],[Arista a b])\n", "\n", "-- (sucesoresAEM g n) es la lista de los sucesores del nodo n en el\n", "-- grafo g. Por ejemplo,\n", "-- ghci> sucesoresAEM g1 (0,[1],[2..5],[])\n", "-- [(12,[2,1],[3,4,5],[(1,2,12)]),\n", "-- (34,[3,1],[2,4,5],[(1,3,34)]),\n", "-- (78,[5,1],[2,3,4],[(1,5,78)])]\n", "sucesoresAEM\n", " :: (Ix a, Num b, Eq b) => Grafo a b -> NodoAEM a b -> [NodoAEM a b]\n", "sucesoresAEM g (_,t,r,aem)\n", " = [(peso x y g, y:t, delete y r, (x,y,peso x y g):aem)\n", " | x <- t , y <- r, aristaEn g (x,y)]\n", "\n", "-- (esFinalAEM n) se verifica si n es un estado final; es decir, si no\n", "-- queda ningún elemento en la lista de nodos sin colocar en el árbol de\n", "-- expansión mínimo.\n", "esFinalAEM :: NodoAEM a b -> Bool\n", "esFinalAEM (_,_,[],_) = True\n", "esFinalAEM _ = False\n", "\n", "-- (prim g) es el árbol de expansión mínimo del grafo g, por el\n", "-- algoritmo de Prim como búsqueda en escalada. Por ejemplo,\n", "-- prim g1 == [(2,4,55),(1,3,34),(2,5,32),(1,2,12)]\n", "prim :: (Ix a, Num b, Ord b) => Grafo a b -> [Arista a b]\n", "prim g = sol\n", " where [(_,_,_,sol)] = buscaEscalada (sucesoresAEM g) \n", " esFinalAEM\n", " (0,[n],ns,[])\n", " (n:ns) = nodos g" ] }, { "cell_type": "code", "execution_count": 35, "metadata": {}, "outputs": [ { "data": { "text/plain": [ "[(12,[2,1],[3,4,5],[(1,2,12)]),(34,[3,1],[2,4,5],[(1,3,34)]),(78,[5,1],[2,3,4],[(1,5,78)])]" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "sucesoresAEM g1 (0,[1],[2..5],[])" ] }, { "cell_type": "code", "execution_count": 36, "metadata": {}, "outputs": [ { "data": { "text/plain": [ "[(2,4,55),(1,3,34),(2,5,32),(1,2,12)]" ] }, "metadata": {}, "output_type": "display_data" } ], "source": [ "prim g1" ] }, { "cell_type": "code", "execution_count": 37, "metadata": {}, "outputs": [ { "data": { "text/plain": [] }, "metadata": {}, "output_type": "display_data" } ], "source": [ ":! rm -f *.hs *.hi *.o *.dyn_*" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "# Bibliografía\n", "\n", "+ F. Rabhi y G. Lapalme\n", " [Algorithms: A functional programming approach](https://www.iro.umontreal.ca/~lapalme/Algorithms-functional.html)\n", " + Cap. 8. Top-down design techniques." ] } ], "metadata": { "kernelspec": { "display_name": "Haskell", "language": "haskell", "name": "haskell" }, "language_info": { "codemirror_mode": "ihaskell", "file_extension": ".hs", "name": "haskell", "pygments_lexer": "Haskell", "version": "8.6.5" } }, "nbformat": 4, "nbformat_minor": 4 }