Tema 24: Técnicas de diseño ascendente de algoritmos

1 Programación dinámica

1.1 Introducción a la programación dinámica

Divide y vencerás vs programación dinámica

Cálculo de Fibonacci por divide y vencerás

fib 0 = 0
fib 1 = 1
fib n = fib (n-1) + fib (n-2)
                      fib 4
                     /     \
              +-----+       +--+ 
              |                |
            fib 3             fib 2 
           /     \           /     \
      fib 2       fib 1 fib 1       fib 0
     /     \
fib 1       fib 0

Calcula 2 veces (fib 2) y 3 veces (fib 1) y (fib 0).

Cálculo de Fibonacci por programación dinámica

fib 0
 |    fib 1
 |     |
 +-----+=== fib 2    
       |     |
       +-----+=== fib 3
             |     |
             +-----+=== fib 4

1.2 El patrón de la programación dinámica

module Dinamica (module Tabla, dinamica)  where
-- Hay que elegir una implementación de TAD Tabla
-- import TablaConFunciones as Tabla
import TablaConListasDeAsociacion as Tabla
-- import TablaConMatrices as Tabla

import Data.Array
dinamica :: Ix i => (Tabla i v -> i -> v) -> (i,i)
                    -> Tabla i v
dinamica calcula cotas = t
    where t = tabla [(i,calcula t i) | i <- range cotas]

2 Fibonacci como ejemplo de programación dinámica

2.1 Definición de Fibonacci mediante programación dinámica

Definición de Fibonacci mediante programación dinámica

import Dinamica
fib 8  ==  21
fib :: Int -> Int
fib n = valor t n
    where t = dinamica calculaFib (cotasFib n) 
calculaFib (tabla []) 0                       == 0
calculaFib (tabla [(0,0),(1,1),(2,1),(3,2)] 4 == 3 

Además,

ghci> dinamica calculaFib (0,6)
Tbl [(0,0),(1,1),(2,1),(3,2),(4,3),(5,5),(6,8)]
calculaFib :: Tabla Int Int -> Int -> Int
calculaFib t i 
   | i <= 1    = i
   | otherwise = valor t (i-1) + valor t (i-2)
cotasFib :: Int -> (Int,Int)
cotasFib n = (0,n)

Definición de Fibonacci mediante divide y vencerás

fibR :: Int -> Int
fibR 0 = 0
fibR 1 = 1
fibR n = fibR (n-1) + fibR (n-2)
ghci> fib 30
832040
(0.01 secs, 0 bytes)
ghci> fibR 30
832040
(6.46 secs, 222602404 bytes)

Definición de Fibonacci mediante evaluación perezosa

take 10 fibs  ==  [0,1,1,2,3,5,8,13,21,34]
fibs :: [Int]
fibs = 0:1:[x+y | (x,y) <- zip fibs (tail fibs)]
fib' 8  ==  21
fib' :: Int -> Int
fib' n = fibs!!n
ghci> fib 30
832040
(0.02 secs, 524808 bytes)
ghci> fib' 30
832040
(0.01 secs, 542384 bytes)
ghci> fibR 30
832040
(6.46 secs, 222602404 bytes)

3 Producto de cadenas de matrices (PCM)

3.1 Descripción del problema PCM

Descripción del problema

((AB)C)D  30 x  1 x 40 + 30 x 40 x 10 + 30 x 10 x 25 = 20700
A(B(CD))  40 x 10 x 25 +  1 x 40 x 25 + 30 x  1 x 25 = 11750
(AB)(CD)  30 x  1 x 40 + 40 x 10 x 25 + 30 x 40 x 25 = 41200
A((BC)D)   1 x 40 x 10 +  1 x 10 x 25 + 30 x  1 x 25 =  1400 
(A(BC))D   1 x 40 x 10 + 30 x  1 x 10 + 30 x 10 x 25 =  8200 

3.2 El algoritmo del PCM

El algoritmo del PCM

c(i,i) = 0
c(i,j) = minimo {c(i,k)+c(k+1,j)+d(i-1)*d(k)*d(j) | i ≤ k < j} 

El algoritmo del PCM

3.3 Solución del PCM mediante programación dinámica

import Dinamica
P (A 1) (P (A 2) (A 3))  ==  (A1*(A2*A3))
P (P (A 1) (A 2)) (A 3)  ==  ((A1*A2)*A3)
data Cadena = A Int 
            | P Cadena Cadena

instance Show Cadena where
    show (A x)     = "A" ++ show x
    show (P p1 p2) = concat ["(",show p1,"*",show p2,")"]
type IndicePCM = (Int,Int)
type ValorPCM  = (Int,Int)
pcm [30,1,40,10,25]  == (1400,(A1*((A2*A3)*A4)))
pcm :: [Int] -> (Int, Cadena)
pcm ds = (v, cadena t 1 n)
    where n     = length ds - 1
          t     = dinamica (calculaPCM ds) (cotasPCM n)
          (v,_) = valor t (1,n)
calculaPCM :: [Int] -> Tabla IndicePCM ValorPCM 
              -> IndicePCM -> ValorPCM
calculaPCM ds t (i,j) 
    | i == j    = (0,i)
    | otherwise = 
         minimum [(fst(valor t (i,k)) 
                  + fst(valor t (k+1,j)) 
                  + ds!!(i-1) * ds!!k * ds!!j, k) 
                  | k <- [i..j-1]]
cotasPCM :: Int -> (IndicePCM,IndicePCM)
cotasPCM n = ((1,1),(n,n)) 
cadena :: Tabla IndicePCM ValorPCM -> Int -> Int -> Cadena
cadena t i j 
    | i == j-1  = P (A i) (A j)
    | k == i    = P (A i) (cadena t (i+1) j)
    | k == j-1  = P (cadena t i (j-1)) (A j)
    | otherwise = P (cadena t i (k-1)) (cadena t k j)
    where (_,k) = valor t (i,j)
ghci> pcm' [30,1,40,10,25]
[((1,1),(0,1)),((1,2),(1200,1)),((1,3),(700,1)),((1,4),(1400,1)),
 ((2,2),(0,2)),((2,3),(400,2)),((2,4),(650,3)),
 ((3,3),(0,3)),((3,4),(10000,3)),
 ((4,4),(0,4))]
pcm' :: [Int] -> [((Int, Int), ValorPCM)]
pcm' ds = [((i,j),valor t (i,j)) | i <- [1..n], j <- [i..n]] 
    where n = length ds - 1
          t = dinamica (calculaPCM ds) (cotasPCM n)

3.4 Solución del PCM mediante divide y vencerás

pcmDyV [30,1,40,10,25]  ==  (1040,(A1*((A2*A3)*A4)))
pcmDyV :: [Int] -> (Int, Cadena)
pcmDyV ds = cadenaDyV ds 1 n
    where n = length ds - 1
cadenaDyV [30,1,40,10,25] 1 4  ==  (1040,(A1*((A2*A3)*A4)))
cadenaDyV [30,1,40,10,25] 2 4  ==  (650,((A2*A3)*A4))
cadenaDyV :: [Int] -> Int -> Int -> (Int, Cadena)
cadenaDyV ds i j 
    | i == j    = (0, A i)
    | i == j-1  = (ds!!(i-1)*ds!!i*ds!!j, P (A i) (A j))
    | k == i    = (v, P (A i) (subcadena (i+1) j))
    | k == j-1  = (v, P (subcadena i (j-1)) (A j))
    | otherwise = (v, P (subcadena i (k-1)) (subcadena k j))
    where (v,k) = minimum [((valor i k) 
                            + (valor (k+1) j) 
                            + ds!!(i-1) * ds!!k * ds!!j, k) 
                           | k <- [i..j-1]]
          valor p q     = fst (cadenaDyV ds p q)
          subcadena p q = snd (cadenaDyV ds p q)

Comparación de las métodos de solucionar el PCM

ghci> :set +s

ghci> fst (pcm [1..20])
2658
(0.04 secs, 4144552 bytes)

ghci> fst (pcmDyV [1..20])
2658
(1582.60 secs, 340414297896 bytes)

4 Árboles binarios de búsqueda optimales (ABBO)

4.1 Descripción del problema de ABBO

Descripción del problema de ABBO

4.2 El algoritmo del ABBO

El algoritmo del ABBO

4.3 Solución del ABBO mediante programación dinámica

type Indice = (Int,Int)
type Valor  = (Float,Int)
data ABB a = Vacio
           | Nodo a (ABB a) (ABB a)
           deriving Show
ghci> abbo ejProblema
(Nodo 4 (Nodo 1 Vacio 
                (Nodo 3 Vacio Vacio)) 
        (Nodo 10 
              (Nodo 8 Vacio Vacio) 
              (Nodo 15 
                    (Nodo 11 Vacio Vacio) 
                    Vacio)),
2.15)
abbo :: Problema  -> (ABB Int,Float)
abbo pb = (solucion c t (1,n) , fst (valor t (1,n)))
    where (cs,ps) = pb
          n       = length ps
          c       = listArray (1,n) cs
          p       = listArray (1,n) ps
          t       = dinamica (calcula p) (cotas n) 
calcula :: Array Int Float -> Tabla Indice Valor 
           -> Indice -> Valor
calcula p t (i,j) 
    | i > j     = (0.0,0)
    | i == j    = (p!i,i)
    | otherwise = suma1 (minimum [(fst(valor t (i,k-1)) 
                                  + fst(valor t (k+1,j)), k) 
                                  | k <- [i..j]])
                        (sumaSegmento i j p)
                  where suma1 (x,y) z = (x+z,y)
> sumaSegmento 2 4 (array (1,5) 
                          [(i,fromIntegral i/2) | i <- [1..5]])
4.5
sumaSegmento :: Int -> Int -> Array Int Float -> Float
sumaSegmento i j p = sum [p!l | l <- [i..j]]
cotas :: Int -> ((Int,Int),(Int,Int))
cotas n = ((1,0),(n+1,n))
solucion :: Array Int Int -> Tabla Indice Valor 
            -> Indice -> ABB Int
solucion cs t (i,j)
        | i > j     = Vacio
        | i == j    = Nodo c Vacio Vacio
        | otherwise = Nodo c (solucion cs t (i,k-1))
                             (solucion cs t (k+1,j))
        where (_,k) = valor t (i,j)
              c     = cs ! k

5 Caminos mínimos entre todos los pares de nodos de un grafo(CM)

5.1 Descripción del problema

5.2 Solución del problema de los caminos mínimos (CM)

import Dinamica

-- Nota: Elegir una implementación de los grafos.
import GrafoConVectorDeAdyacencia
-- import GrafoConMatrizDeAdyacencia
ej1Grafo :: Grafo Int Int
ej1Grafo = creaGrafo True (1,6) 
                     [(i,j,(v!!(i-1))!!(j-1)) 
                      | i <- [1..6], j <- [1..6]]

v::[[Int]]
v = [[  0,  4,  1,  6,100,100],
     [  4,  0,  1,100,  5,100],
     [  1,  1,  0,100,  8,  2],
     [  6,100,100,  0,100,  2],
     [100,  5,  8,100,  0,  5],
     [100,100,  2,  2,  5,  0]]
ej2Grafo :: Grafo Int Int
ej2Grafo = creaGrafo True (1,6) 
                     [(i,j,(v'!!(i-1))!!(j-1)) 
                     | i <- [1..6], j <- [1..6]]

v'::[[Int]]
v' =[[  0,  4,100,100,100,  2],
     [  1,  0,  3,  4,100,100],
     [  6,  3,  0,  7,100,100],
     [  6,100,100,  0,  2,100],
     [100,100,100,  5,  0,100],
     [100,100,100,  2,  3,  0]]
type IndiceCM = (Int,Int,Int)
type ValorCM  = (Int,[Int])
ghci> caminosMinimos ej1Grafo
[((1,2),(2,[1,3,2])),  ((1,3),(1,[1,3])),  ((1,4),(5,[1,3,6,4])),
 ((1,5),(7,[1,3,2,5])),((1,6),(3,[1,3,6])),((2,3),(1,[2,3])),
 ((2,4),(5,[2,3,6,4])),((2,5),(5,[2,5])),  ((2,6),(3,[2,3,6])),
 ((3,4),(4,[3,6,4])),  ((3,5),(6,[3,2,5])),((3,6),(2,[3,6])),
 ((4,5),(7,[4,6,5])),  ((4,6),(2,[4,6])),  ((5,6),(5,[5,6]))]
caminosMinimos :: (Grafo Int Int) -> [((Int,Int), ValorCM)]
caminosMinimos g = 
    [((i,j), valor t (i,j,n)) | i <- [1..n], j <- [i+1..n]]
    where n = length (nodos g)
          t = dinamica (calculaCM g) (cotasCM n) 
calculaCM :: (Grafo Int Int) -> Tabla IndiceCM ValorCM 
             -> IndiceCM -> ValorCM
calculaCM g t (i,j,k)
  | k==0      = (peso i j g, if i==j then [i] else [i,j])
  | v1<=v2    = (v1,p)  
  | otherwise = (v2,p1++p2)
  where (v1,p)   = valor t (i,j,k-1)
        (a,p1)   = valor t (i,k,k-1)
        (b,_:p2) = valor t (k,j,k-1)
        v2 = a+b
cotasCM :: Int -> ((Int,Int,Int),(Int,Int,Int))
cotasCM n = ((1,1,0),(n,n,n))

6 Problema del viajante (PV)

6.1 Descripción del problema

6.2 Solución del problema del viajante (PV)

import Dinamica

-- Nota: Elegir una implementación de los grafos.
import GrafoConVectorDeAdyacencia
-- import GrafoConMatrizDeAdyacencia
type Conj = Int
conj2Lista 24  ==  [3,4]
conj2Lista 30  ==  [1,2,3,4]
conj2Lista 22  ==  [1,2,4]
conj2Lista :: Conj -> [Int]
conj2Lista s = c2l s 0
    where 
      c2l 0 _             = []
      c2l n i | odd n     = i : c2l (n `div` 2) (i+1)
              | otherwise = c2l (n `div` 2) (i+1)
maxConj :: Int
maxConj = 
   truncate (logBase 2 (fromIntegral maxInt)) - 1
   where maxInt = maxBound::Int
vacio :: Conj
vacio = 0
esVacio :: Conj -> Bool
esVacio n = n==0
conjCompleto :: Int -> Conj
conjCompleto n 
   | (n>=0) && (n<=maxConj) = 2^(n+1)-2
   | otherwise = error ("conjCompleto:" ++ show n)
inserta :: Int -> Conj -> Conj
inserta i s
    | i>=0 && i<=maxConj = d'*e+m
    | otherwise          = error ("inserta:" ++ show i)
    where (d,m) = divMod s e
          e     = 2^i
          d'    = if odd d then d else d+1
elimina :: Int -> Conj -> Conj
elimina i s = d'*e+m
    where (d,m) = divMod s e
          e = 2^i
          d' = if odd d then d-1 else d
   4       5
+----- 2 -----+
|      |1     |
|  1   |   8  |
1----- 3 -----5
|        \2  /
|  6     2\ /5
+----- 4 --6
ej1 :: Grafo Int Int
ej1 = creaGrafo True (1,6) 
                     [(i,j,(v1!!(i-1))!!(j-1)) 
                      | i <- [1..6], j <- [1..6]]
v1::[[Int]]
v1 =[[  0,  4,  1,  6,100,100],
     [  4,  0,  1,100,  5,100],
     [  1,  1,  0,100,  8,  2],
     [  6,100,100,  0,100,  2],
     [100,  5,  8,100,  0,  5],
     [100,100,  2,  2,  5,  0]]
type IndicePV = (Int,Conj)
type ValorPV  = (Int,[Int])
ghci> viajante ej1
(20,[6,4,1,3,2,5,6])
viajante :: Grafo Int Int -> (Int,[Int])
viajante g = valor t (n,conjCompleto (n-1))
    where n = length (nodos g)
          t = dinamica (calculaPV g n) (cotasPV n)
calculaPV :: Grafo Int Int -> Int -> Tabla IndicePV ValorPV 
           -> IndicePV -> ValorPV 
calculaPV g n t (i,k) 
    | esVacio k = (peso i n g,[i,n])
    | otherwise = minimum [sumaPrim (valor t (j, elimina j k))
                                    (peso i j g)
                           | j <- conj2Lista k]
    where sumaPrim (v,xs) v' = (v+v',i:xs)
cotasPV :: Int -> ((Int,Conj),(Int,Conj))
cotasPV n = ((1,vacio),(n,conjCompleto n))

6.3 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