Tema 11: Aplicaciones de programación funcional

Librerías auxiliares

import Data.List
import Test.QuickCheck

1 El juego de cifras y letras

1.1 Introducción

Presentación del juego

Formalización del problema: Operaciones

data Op = Sum | Res | Mul | Div  

instance Show Op where
   show Sum = "+"
   show Res = "-"
   show Mul = "*"
   show Div = "/"
ops :: [Op]
ops = [Sum,Res,Mul,Div]

Operaciones válidas

valida Res 5 3  ==  True
valida Res 3 5  ==  False
valida Div 6 3  ==  True
valida Div 6 4  ==  False
valida :: Op -> Int -> Int -> Bool
valida Sum _ _ = True
valida Res x y = x > y
valida Mul _ _ = True
valida Div x y = y /= 0 && x `mod` y == 0

Aplicación de operaciones

aplica Sum 2 3  ==  5
aplica Div 6 3  ==  2
aplica :: Op -> Int -> Int -> Int
aplica Sum x y = x + y
aplica Res x y = x - y
aplica Mul x y = x * y
aplica Div x y = x `div` y

Expresiones

data Expr = Num Int | Apl Op Expr Expr  

instance Show Expr where
   show (Num n)     = show n
   show (Apl o i d) = parentesis i ++ show o ++ parentesis d
                      where
                         parentesis (Num n) = show n
                         parentesis e       = "(" ++ show e ++ ")"
ejExpr :: Expr
ejExpr =  Apl Mul e1 e2
    where e1 = Apl Sum (Num 1) (Num 50)
          e2 = Apl Res (Num 25) (Num 10)

Números de una expresión

ghci> numeros (Apl Mul (Apl Sum (Num 2) (Num 3)) (Num 7))  
[2,3,7]  
numeros :: Expr -> [Int]
numeros (Num n)     = [n]
numeros (Apl _ l r) = numeros l ++ numeros r

Valor de una expresión

valor (Apl Mul (Apl Sum (Num 2) (Num 3)) (Num 7)) == [35]
valor (Apl Res (Apl Sum (Num 2) (Num 3)) (Num 7)) == []
valor (Apl Sum (Apl Res (Num 2) (Num 3)) (Num 7)) == []
valor :: Expr -> [Int]
valor (Num n)     = [n | n > 0]
valor (Apl o i d) = [aplica o x y | x <- valor i
                                  , y <- valor d
                                  , valida o x y]

Funciones combinatorias: Sublistas

ghci> sublistas "bc"   
["","c","b","bc"]
ghci> sublistas "abc"  
["","c","b","bc","a","ac","ab","abc"]
sublistas :: [a] -> [[a]]
sublistas []     = [[]]
sublistas (x:xs) = yss ++ map (x:) yss
    where yss = sublistas xs

Funciones combinatoria: Intercalado

intercala 'x' "bc"   ==  ["xbc","bxc","bcx"]
intercala 'x' "abc"  ==  ["xabc","axbc","abxc","abcx"]
intercala :: a -> [a] -> [[a]]
intercala x []     = [[x]]
intercala x (y:ys) = 
    (x:y:ys) : map (y:) (intercala x ys)

Funciones combinatoria: Permutaciones

ghci> permutaciones "bc"   
["bc","cb"]
ghci> permutaciones "abc"  
["abc","bac","bca","acb","cab","cba"]
permutaciones :: [a] -> [[a]]
permutaciones []     = [[]]
permutaciones (x:xs) = 
    concat (map (intercala x) (permutaciones xs))

Funciones combinatoria: Elecciones

ghci> elecciones "abc"
["","c","b","bc","cb","a","ac","ca","ab","ba",
 "abc","bac","bca","acb","cab","cba"]
elecciones :: [a] -> [[a]]
elecciones xs = 
    concat (map permutaciones (sublistas xs))

Reconocimiento de las soluciones

solucion ejExpr [1,3,7,10,25,50] 765  =>  True
solucion :: Expr -> [Int] -> Int -> Bool
solucion e ns n = 
    elem (numeros e) (elecciones ns) && valor e == [n]

1.2 Búsqueda de la solución por fuerza bruta

Divisiones de una lista

ghci> divisiones "bcd"   
[("b","cd"),("bc","d")]
ghci> divisiones "abcd"  
[("a","bcd"),("ab","cd"),("abc","d")]
divisiones :: [a] -> [([a],[a])]
divisiones []     = []
divisiones [_]    = []
divisiones (x:xs) = 
    ([x],xs) : [(x:is,ds) | (is,ds) <- divisiones xs]

Expresiones construibles

ghci> expresiones [2,3,5]
[2+(3+5),2-(3+5),2*(3+5),2/(3+5),2+(3-5),2-(3-5),
 2*(3-5),2/(3-5),2+(3*5),2-(3*5),2*(3*5),2/(3*5),
 2+(3/5),2-(3/5),2*(3/5),2/(3/5),(2+3)+5,(2+3)-5,
 ...
expresiones :: [Int] -> [Expr]
expresiones []  = []
expresiones [n] = [Num n]
expresiones ns  = [e | (is,ds) <- divisiones ns
                     , i       <- expresiones is
                     , d       <- expresiones ds
                     , e       <- combina i d]

Combinación de expresiones

ghci> combina (Num 2) (Num 3)  
[2+3,2-3,2*3,2/3]  
combina :: Expr -> Expr -> [Expr]
combina e1 e2 = [Apl o e1 e2 | o <- ops]

Búsqueda de las soluciones

ghci> soluciones [1,3,7,10,25,50] 765
[3*((7*(50-10))-25), ((7*(50-10))-25)*3, ...
ghci> length (soluciones [1,3,7,10,25,50] 765)
780
ghci>
length (soluciones [1,3,7,10,25,50] 831)
0
soluciones :: [Int] -> Int -> [Expr]
soluciones ns n =  [e | ns' <- elecciones ns
                      , e   <- expresiones ns'
                      , valor e == [n]]

Estadísticas de la búsqueda por fuerza bruta

ghci> :set +s
ghci> head (soluciones [1,3,7,10,25,50] 765)
3*((7*(50-10))-25)
(8.47 secs, 400306836 bytes)
ghci> length (soluciones [1,3,7,10,25,50] 765)
780
(997.76 secs, 47074239120 bytes)
ghci> length (soluciones [1,3,7,10,25,50] 831)
0
(1019.13 secs, 47074535420 bytes)
ghci> :unset +s

1.3 Búsqueda combinando generación y evaluación

Resultados

type Resultado = (Expr,Int)  
ghci> resultados [2,3,5]
[(2+(3+5),10), (2*(3+5),16), (2+(3*5),17), (2*(3*5),30), ((2+3)+5,10), 
 ((2+3)*5,25), ((2+3)/5,1),  ((2*3)+5,11), ((2*3)-5,1),  ((2*3)*5,30)]
resultados :: [Int] -> [Resultado]
resultados []  = []
resultados [n] = [(Num n,n) | n > 0]
resultados ns  = [res | (is,ds) <- divisiones ns
                      , ix      <- resultados is
                      , dy      <- resultados ds
                      , res     <- combina' ix dy]

Combinación de resultados

ghci> combina' (Num 2,2) (Num 3,3)  
[(2+3,5),(2*3,6)]
ghci> combina' (Num 3,3) (Num 2,2)  
[(3+2,5),(3-2,1),(3*2,6)]
ghci> combina' (Num 2,2) (Num 6,6)  
[(2+6,8),(2*6,12)]
ghci> combina' (Num 6,6) (Num 2,2)  
[(6+2,8),(6-2,4),(6*2,12),(6/2,3)]
combina' :: Resultado -> Resultado -> [Resultado]
combina' (i,x) (d,y) =  
    [(Apl o i d, aplica o x y) | o <- ops
                               , valida o x y] 

Búsqueda combinando generación y evaluación

ghci> head (soluciones' [1,3,7,10,25,50] 765)
3*((7*(50-10))-25)
ghci> length (soluciones' [1,3,7,10,25,50] 765)
780
ghci> length (soluciones' [1,3,7,10,25,50] 831)
0
soluciones' :: [Int] -> Int -> [Expr]
soluciones' ns n = [e | ns'   <- elecciones ns
                      , (e,m) <- resultados ns'
                      , m == n]

Estadísticas de la búsqueda combinada

ghci> head (soluciones' [1,3,7,10,25,50] 765)
3*((7*(50-10))-25)
(0.81 secs, 38804220 bytes)
ghci> length (soluciones' [1,3,7,10,25,50] 765)
780
(60.73 secs, 2932314020 bytes)
ghci> length (soluciones' [1,3,7,10,25,50] 831)
0
(61.68 secs, 2932303088 bytes)

1.4 Búsqueda mejorada mediante propiedades algebraicas

Aplicaciones válidas

x + y = y + x
x * y = y * x
x * 1 = x
1 * y = y
x / 1 = x
valida' :: Op -> Int -> Int -> Bool
valida' Sum x y = x <= y
valida' Res x y = x > y
valida' Mul x y = x /= 1 && y /= 1 && x <= y
valida' Div x y = y /= 0 && y /= 1 && x `mod` y == 0

Resultados válidos construibles

ghci> resultados' [5,3,2]
[(5-(3-2),4),((5-3)+2,4),((5-3)*2,4),((5-3)/2,1)]
resultados' :: [Int] -> [Resultado]
resultados' []  = []
resultados' [n] = [(Num n,n) | n > 0]
resultados' ns  = [res | (is,ds) <- divisiones ns
                       , ix      <- resultados' is
                       , dy      <- resultados' ds
                       , res     <- combina'' ix dy]

Combinación de resultados válidos

combina'' (Num 2,2) (Num 3,3)  =>  [(2+3,5),(2*3,6)]
combina'' (Num 3,3) (Num 2,2)  =>  [(3-2,1)]
combina'' (Num 2,2) (Num 6,6)  =>  [(2+6,8),(2*6,12)]
combina'' (Num 6,6) (Num 2,2)  =>  [(6-2,4),(6/2,3)]
combina'' :: Resultado -> Resultado -> [Resultado]
combina'' (i,x) (d,y) = 
    [(Apl o i d, aplica o x y) | o <- ops
                               , valida' o x y]

Búsqueda mejorada mediante propiedades algebraicas

ghci> head (soluciones'' [1,3,7,10,25,50] 765)
3*((7*(50-10))-25)
ghci> length (soluciones'' [1,3,7,10,25,50] 765)
49
ghci> length (soluciones'' [1,3,7,10,25,50] 831)
0
soluciones'' :: [Int] -> Int -> [Expr]
soluciones'' ns n = [e | ns'   <- elecciones ns
                       , (e,m) <- resultados' ns'
                       , m == n]

Estadísticas de la búsqueda mejorada

ghci> head (soluciones'' [1,3,7,10,25,50] 765)
3*((7*(50-10))-25)
(0.40 secs, 16435156 bytes)
ghci> length (soluciones'' [1,3,7,10,25,50] 765)
49
(10.30 secs, 460253716 bytes)
ghci> length (soluciones'' [1,3,7,10,25,50] 831)
0
(10.26 secs, 460253908 bytes)§

Comparación de las búsquedas

               +---------------------+
               | segs. | bytes       |
+--------------+-------+-------------+ 
| soluciones   | 8.47  | 400.306.836 |
| soluciones'  | 0.81  |  38.804.220 |
| soluciones'' | 0.40  |  16.435.156 |
+--------------+-------+-------------+
               +--------+----------------+
               | segs.  | bytes          |
+--------------+--------+----------------+ 
| soluciones   | 997.76 | 47.074.239.120 |
| soluciones'  |  60.73 |  2.932.314.020 |
| soluciones'' |  10.30 |    460.253.716 |
+--------------+--------+----------------+
                  +---------+----------------+
                  | segs.   | bytes          |
   +--------------+---------+----------------+ 
   | soluciones   | 1019.13 | 47.074.535.420 |
   | soluciones'  |   61.68 |  2.932.303.088 |
   | soluciones'' |   10.26 |    460.253.908 |
   +--------------+---------+----------------+

2 El problema de las reinas

type Tablero = [Int]
|---|---|---|---|
|   | R |   |   |
|---|---|---|---|
|   |   |   | R |
|---|---|---|---|
| R |   |   |   |
|---|---|---|---|
|   |   | R |   |
|---|---|---|---|
reinas :: Int -> [Tablero]
reinas n = aux n
    where aux 0 = [[]]
          aux m = [r:rs | rs <- aux (m-1),
                          r <- ([1..n] \\ rs),
                          noAtaca r rs 1]
noAtaca :: Int -> Tablero -> Int -> Bool
noAtaca _ [] _ = True
noAtaca r (a:rs) distH = abs(r-a) /= distH &&
                         noAtaca r rs (distH+1)

3 Números de Hamming

take 12 hamming == [1,2,3,4,5,6,8,9,10,12,15,16]
hamming :: [Int]
hamming = 1 : mezcla3 [2*i | i <- hamming]  
                      [3*i | i <- hamming]  
                      [5*i | i <- hamming]  
Main> mezcla3 [2,4,6,8,10] [3,6,9,12] [5,10]
[2,3,4,5,6,8,9,10,12]
mezcla3 :: [Int] -> [Int] -> [Int] -> [Int]
mezcla3 xs ys zs = mezcla2 xs (mezcla2 ys zs)  
Main> mezcla2 [2,4,6,8,10,12] [3,6,9,12]
[2,3,4,6,8,9,10,12]
mezcla2 :: [Int] -> [Int] -> [Int]
mezcla2 p@(x:xs) q@(y:ys) | x < y     = x:mezcla2 xs q
                          | x > y     = y:mezcla2 p  ys  
                          | otherwise = x:mezcla2 xs ys
mezcla2 []       ys                   = ys
mezcla2 xs       []                   = xs

4 Bibliografía



Universidad de Sevilla

José A. Alonso Jiménez
Grupo de Lógica Computacional
Dpto. de Ciencias de la Computación e I.A.
Universidad de Sevilla