Menu Close

Etiqueta: Dinámica

Máxima longitud de sublistas crecientes

Definir la función

   longitudMayorSublistaCreciente :: Ord a => [a] -> Int

tal que (longitudMayorSublistaCreciente xs) es la el máximo de las longitudes de las sublistas crecientes de xs. Por ejemplo,

   λ> longitudMayorSublistaCreciente [3,2,6,4,5,1]
   3
   λ> longitudMayorSublistaCreciente [10,22,9,33,21,50,41,60,80]
   6
   λ> longitudMayorSublistaCreciente [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]
   6
   λ> longitudMayorSublistaCreciente [1..2000]
   2000
   λ> longitudMayorSublistaCreciente [2000,1999..1]
   1
   λ> import System.Random
   λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]
   λ> longitudMayorSublistaCreciente2 xs
   61
   λ> longitudMayorSublistaCreciente3 xs
   61

Soluciones

import Data.List  (nub, sort)
import Data.Array (Array, (!), array, elems, listArray)
 
-- 1ª solución
-- ===========
 
longitudMayorSublistaCreciente1 :: Ord a => [a] -> Int
longitudMayorSublistaCreciente1 =
  length . head . mayoresCrecientes
 
-- (mayoresCrecientes xs) es la lista de las sublistas crecientes de xs
-- de mayor longitud. Por ejemplo, 
--    λ> mayoresCrecientes [3,2,6,4,5,1]
--    [[3,4,5],[2,4,5]]
--    λ> mayoresCrecientes [3,2,3,2,3,1]
--    [[2,3],[2,3],[2,3]]
--    λ> mayoresCrecientes [10,22,9,33,21,50,41,60,80]
--    [[10,22,33,50,60,80],[10,22,33,41,60,80]]
--    λ> mayoresCrecientes [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]
--    [[0,4,6,9,13,15],[0,2,6,9,13,15],[0,4,6,9,11,15],[0,2,6,9,11,15]]
mayoresCrecientes :: Ord a => [a] -> [[a]]
mayoresCrecientes xs =
  [ys | ys <- xss
      , length ys == m]
  where xss = sublistasCrecientes xs
        m   = maximum (map length xss)
 
-- (sublistasCrecientes xs) es la lista de las sublistas crecientes de
-- xs. Por ejemplo,
--    λ> sublistasCrecientes [3,2,5]
--    [[3,5],[3],[2,5],[2],[5],[]]
sublistasCrecientes :: Ord a => [a] -> [[a]]
sublistasCrecientes []  = [[]]
sublistasCrecientes (x:xs) =
  [x:ys | ys <- yss, null ys || x < head ys] ++ yss
  where yss = sublistasCrecientes xs
 
-- 2ª solución
-- ===========
 
longitudMayorSublistaCreciente2 :: Ord a => [a] -> Int
longitudMayorSublistaCreciente2 xs =
  longitudSCM xs (sort (nub xs))
 
-- (longitudSCM xs ys) es la longitud de la subsecuencia máxima de xs e
-- ys. Por ejemplo, 
--   longitudSCM "amapola" "matamoscas" == 4
--   longitudSCM "atamos" "matamoscas"  == 6
--   longitudSCM "aaa" "bbbb"           == 0
longitudSCM :: Eq a => [a] -> [a] -> Int
longitudSCM xs ys = (matrizLongitudSCM xs ys) ! (n,m)
  where n = length xs
        m = length ys
 
-- (matrizLongitudSCM xs ys) es la matriz de orden (n+1)x(m+1) (donde n
-- y m son los números de elementos de xs e ys, respectivamente) tal que
-- el valor en la posición (i,j) es la longitud de la SCM de los i
-- primeros elementos de xs y los j primeros elementos de ys. Por ejemplo,
--    λ> elems (matrizLongitudSCM "amapola" "matamoscas")
--    [0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,1,1,1,1,2,2,2,2,2,2,
--     0,1,2,2,2,2,2,2,2,3,3,0,1,2,2,2,2,2,2,2,3,3,0,1,2,2,2,2,3,3,3,3,3,
--     0,1,2,2,2,2,3,3,3,3,3,0,1,2,2,3,3,3,3,3,4,4]
-- Gráficamente,
--       m a t a m o s c a s
--    [0,0,0,0,0,0,0,0,0,0,0,
-- a   0,0,1,1,1,1,1,1,1,1,1,
-- m   0,1,1,1,1,2,2,2,2,2,2,
-- a   0,1,2,2,2,2,2,2,2,3,3,
-- p   0,1,2,2,2,2,2,2,2,3,3,
-- o   0,1,2,2,2,2,3,3,3,3,3,
-- l   0,1,2,2,2,2,3,3,3,3,3,
-- a   0,1,2,2,3,3,3,3,3,4,4]
matrizLongitudSCM :: Eq a => [a] -> [a] -> Array (Int,Int) Int
matrizLongitudSCM xs ys = q
  where
    n = length xs
    m = length ys
    v = listArray (1,n) xs
    w = listArray (1,m) ys
    q = array ((0,0),(n,m)) [((i,j), f i j) | i <- [0..n], j <- [0..m]]
      where f 0 _ = 0
            f _ 0 = 0
            f i j | v ! i == w ! j = 1 + q ! (i-1,j-1)
                  | otherwise      = max (q ! (i-1,j)) (q ! (i,j-1))
 
-- 3ª solución
-- ===========
 
longitudMayorSublistaCreciente3 :: Ord a => [a] -> Int
longitudMayorSublistaCreciente3 xs =
  maximum (elems (vectorlongitudMayorSublistaCreciente xs))
 
-- (vectorlongitudMayorSublistaCreciente xs) es el vector de longitud n
-- (donde n es el tamaño de xs) tal que el valor i-ésimo es la longitud
-- de la sucesión más larga que termina en el elemento i-ésimo de
-- xs. Por ejemplo,  
--    λ> vectorlongitudMayorSublistaCreciente [3,2,6,4,5,1]
--    array (1,6) [(1,1),(2,1),(3,2),(4,2),(5,3),(6,1)]
vectorlongitudMayorSublistaCreciente :: Ord a => [a] -> Array Int Int
vectorlongitudMayorSublistaCreciente xs = v
  where v = array (1,n) [(i,f i) | i <- [1..n]]
        n = length xs
        w = listArray (1,n) xs
        f 1 = 1
        f i | null ls   = 1
            | otherwise = 1 + maximum ls
          where ls = [v ! j | j <-[1..i-1], w ! j < w ! i]
 
-- Comparación de eficiencia
-- =========================
 
--    λ> longitudMayorSublistaCreciente1 [1..20]
--    20
--    (4.60 secs, 597,014,240 bytes)
--    λ> longitudMayorSublistaCreciente2 [1..20]
--    20
--    (0.03 secs, 361,384 bytes)
--    λ> longitudMayorSublistaCreciente3 [1..20]
--    20
--    (0.03 secs, 253,944 bytes)
--    
--    λ> longitudMayorSublistaCreciente2 [1..2000]
--    2000
--    (8.00 secs, 1,796,495,488 bytes)
--    λ> longitudMayorSublistaCreciente3 [1..2000]
--    2000
--    (5.12 secs, 1,137,667,496 bytes)
--    
--    λ> longitudMayorSublistaCreciente1 [1000,999..1]
--    1
--    (0.95 secs, 97,029,328 bytes)
--    λ> longitudMayorSublistaCreciente2 [1000,999..1]
--    1
--    (7.48 secs, 1,540,857,208 bytes)
--    λ> longitudMayorSublistaCreciente3 [1000,999..1]
--    1
--    (0.86 secs, 160,859,128 bytes)
--    
--    λ> longitudMayorSublistaCreciente1 (show (2^300))
--    10
--    (7.90 secs, 887,495,368 bytes)
--    λ> longitudMayorSublistaCreciente2 (show (2^300))
--    10
--    (0.04 secs, 899,152 bytes)
--    λ> longitudMayorSublistaCreciente3 (show (2^300))
--    10
--    (0.04 secs, 1,907,936 bytes)
--    
--    λ> longitudMayorSublistaCreciente2 (show (2^6000))
--    10
--    (0.06 secs, 9,950,592 bytes)
--    λ> longitudMayorSublistaCreciente3 (show (2^6000))
--    10
--    (3.46 secs, 686,929,744 bytes)
--    
--    λ> import System.Random
--    (0.00 secs, 0 bytes)
--    λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]
--    (0.02 secs, 1,993,032 bytes)
--    λ> longitudMayorSublistaCreciente2 xs
--    61
--    (7.73 secs, 1,538,771,392 bytes)
--    λ> longitudMayorSublistaCreciente3 xs
--    61
--    (1.04 secs, 212,538,648 bytes)
--    λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]
--    (0.03 secs, 1,993,032 bytes)
--    λ> longitudMayorSublistaCreciente2 xs
--    57
--    (7.56 secs, 1,538,573,680 bytes)
--    λ> longitudMayorSublistaCreciente3 xs
--    57
--    (1.05 secs, 212,293,984 bytes)

Pensamiento

No es el yo fundamental
eso que busca el poeta,
sino el tú esencial.

Antonio Machado

Camino de máxima suma en una matriz

Los caminos desde el extremo superior izquierdo (posición (1,1)) hasta el extremo inferior derecho (posición (3,4)) en la matriz

   (  1  6 11  2 )
   (  7 12  3  8 )
   (  3  8  4  9 )

moviéndose en cada paso una casilla hacia abajo o hacia la derecha, son los siguientes:

   1, 7,  3, 8, 4, 9
   1, 7, 12, 8, 4, 9
   1, 7, 12, 3, 4, 9
   1, 7, 12, 3, 8, 9
   1, 6, 12, 8, 4, 9
   1, 6, 12, 3, 4, 9
   1, 6, 12, 3, 8, 9
   1, 6, 11, 3, 4, 9
   1, 6, 11, 3, 8, 9
   1, 6, 11, 2, 8, 9

Las sumas de los caminos son 32, 41, 36, 40, 40, 35, 39, 34, 38 y 37, respectivamente. El camino de máxima suma es el segundo (1, 7, 12, 8, 4, 9) que tiene una suma de 41.

Definir la función

   caminoMaxSuma :: Matrix Int -> [Int]

tal que (caminoMaxSuma m) es un camino de máxima suma en la matriz m desde el extremo superior izquierdo hasta el extremo inferior derecho, moviéndose en cada paso una casilla hacia abajo o hacia la derecha. Por ejemplo,

   λ> caminoMaxSuma (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]])
   [1,7,12,8,4,9]
   λ> sum (caminoMaxSuma (fromList 800 800 [1..]))
   766721999

Soluciones

import Data.Matrix
import Test.QuickCheck
 
-- 1ª definición
-- =============
 
caminoMaxSuma1 :: Matrix Int -> [Int]
caminoMaxSuma1 m =
  head [c | c <- cs, sum c == k] 
  where cs = caminos1 m
        k  = maximum (map sum cs)
 
caminos1 :: Matrix Int -> [[Int]]
caminos1 m =
  map reverse (caminos1Aux m (nf,nc))
  where nf = nrows m
        nc = ncols m
 
-- (caminos1Aux p x) es la lista de los caminos invertidos en la matriz p
-- desde la posición (1,1) hasta la posición x. Por ejemplo,
caminos1Aux :: Matrix Int -> (Int,Int) -> [[Int]]
caminos1Aux m (1,1) = [[m!(1,1)]]
caminos1Aux m (1,j) = [[m!(1,k) | k <- [j,j-1..1]]]
caminos1Aux m (i,1) = [[m!(k,1) | k <- [i,i-1..1]]]
caminos1Aux m (i,j) = [m!(i,j) : xs
                      | xs <- caminos1Aux m (i,j-1) ++
                              caminos1Aux m (i-1,j)]
 
-- 2ª definición
-- =============
 
caminoMaxSuma2 :: Matrix Int -> [Int]
caminoMaxSuma2 m =
  head [c | c <- cs, sum c == k] 
  where cs = caminos2 m
        k  = maximum (map sum cs)
 
caminos2 :: Matrix Int -> [[Int]]
caminos2 m =
  map reverse (matrizCaminos m ! (nrows m, ncols m))
 
matrizCaminos :: Matrix Int -> Matrix [[Int]]
matrizCaminos m = q
  where
    q = matrix (nrows m) (ncols m) f
    f (1,y) = [[m!(1,z) | z <- [y,y-1..1]]]
    f (x,1) = [[m!(z,1) | z <- [x,x-1..1]]]
    f (x,y) = [m!(x,y) : cs | cs <- q!(x-1,y) ++ q!(x,y-1)]  
 
-- 3ª definición (con programación dinámica)
-- =========================================
 
caminoMaxSuma3 :: Matrix Int -> [Int]
caminoMaxSuma3 m = reverse (snd (q ! (nf,nc)))
  where nf = nrows m
        nc = ncols m
        q  = caminoMaxSumaAux m
 
caminoMaxSumaAux :: Matrix Int -> Matrix (Int,[Int])
caminoMaxSumaAux m = q 
  where
    nf = nrows m
    nc = ncols m
    q  = matrix nf nc f
      where
        f (1,1) = (m!(1,1),[m!(1,1)])
        f (1,j) = (k + m!(1,j), m!(1,j):xs)
          where (k,xs) = q!(1,j-1)
        f (i,1) = (k + m!(i,1), m!(i,1):xs)
          where (k,xs) = q!(i-1,1)        
        f (i,j) | k1 > k2   = (k1 + m!(i,j), m!(i,j):xs)
                | otherwise = (k2 + m!(i,j), m!(i,j):ys)
          where (k1,xs) = q!(i,j-1)
                (k2,ys) = q!(i-1,j)
 
-- Equivalencia de las definiciones
-- ================================
 
-- El generador es
instance Arbitrary a => Arbitrary (Matrix a) where
  arbitrary =  do
    m <- choose (1,7)
    n <- choose (1,7)
    xs <- Test.QuickCheck.vector (n*m)
    return (fromList m n xs)
 
 
-- Por ejemplo,
--    λ> sample' (arbitrary :: Gen (Matrix Int))
--    [( 0 )
--     ( 0 )
--     ( 0 )
--     ( 0 )
--    ,(  1  2 )
--     ( -1  1 )
--     ( -1 -2 )
--     (  1 -1 )
--     (  1  0 )
--     (  2  0 )
--     (  2 -2 )
--    ,( -4  4 -2 )
--     ( -2  0 -2 )
--     (  0 -1 -2 )
--     ( -4 -1  2 )
--    ,( -2  7 -3  1 -5 -3  5 )
--     (  0  2  7 -1 -5  7 -6 )
--     (  1  7 -8  1  6 -7  5 )
--     ( -4  7 -2 -7 -5  5 -8 )
--    ...
 
-- La propiedad es
prop_caminoMaxSuma :: Matrix Int -> Bool
prop_caminoMaxSuma m =
  x1 == x2 && x2 == x3
  where x1 = sum (caminoMaxSuma1 m)
        x2 = sum (caminoMaxSuma2 m)
        x3 = sum (caminoMaxSuma1 m)
 
-- La comprobación es
--    λ> quickCheck prop_caminoMaxSuma
--    +++ OK, passed 100 tests.
 
 
-- Comparación de eficiencia
-- -------------------------
 
--    λ> length (caminoMaxSuma1 (fromList 11 11 [1..]))
--    21
--    (10.00 secs, 1,510,120,328 bytes)
--    λ> length (caminoMaxSuma2 (fromList 11 11 [1..]))
--    21
--    (3.84 secs, 745,918,544 bytes)
--    λ> length (caminoMaxSuma3 (fromList 11 11 [1..]))
--    21
--    (0.01 secs, 0 bytes)

Pensamiento

Caminante, no hay camino,
sino estelas en la mar.

Antonio Machado

Número de descomposiciones en sumas de cuatro cuadrados

Definir la función

   nDescomposiciones       :: Int -> Int
   graficaDescomposiciones :: Int -> IO ()

tales que

  • (nDescomposiciones x) es el número de listas de los cuadrados de cuatro números enteros positivos cuya suma es x. Por ejemplo.
     nDescomposiciones 4      ==  1
     nDescomposiciones 5      ==  0
     nDescomposiciones 7      ==  4
     nDescomposiciones 10     ==  6
     nDescomposiciones 15     ==  12
     nDescomposiciones 50000  ==  5682
  • (graficaDescomposiciones n) dibuja la gráfica del número de descomposiciones de los n primeros números naturales. Por ejemplo, (graficaDescomposiciones 500) dibuja

Soluciones

import Data.Array
import Graphics.Gnuplot.Simple
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
nDescomposiciones :: Int -> Int
nDescomposiciones = length . descomposiciones
 
-- (descomposiciones x) es la lista de las listas de los cuadrados de
-- cuatro números enteros positivos cuya suma es x. Por  ejemplo. 
--    λ> descomposiciones 4
--    [[1,1,1,1]]
--    λ> descomposiciones 5
--    []
--    λ> descomposiciones 7
--    [[1,1,1,4],[1,1,4,1],[1,4,1,1],[4,1,1,1]]
--    λ> descomposiciones 10
--    [[1,1,4,4],[1,4,1,4],[1,4,4,1],[4,1,1,4],[4,1,4,1],[4,4,1,1]]
--    λ> descomposiciones 15
--    [[1,1,4,9],[1,1,9,4],[1,4,1,9],[1,4,9,1],[1,9,1,4],[1,9,4,1],
--     [4,1,1,9],[4,1,9,1],[4,9,1,1],[9,1,1,4],[9,1,4,1],[9,4,1,1]]
descomposiciones :: Int -> [[Int]]
descomposiciones x = aux x 4
  where 
    aux 0 1 = []
    aux 1 1 = [[1]]
    aux 2 1 = []
    aux 3 1 = []
    aux y 1 | esCuadrado y = [[y]]
            | otherwise    = []
    aux y n = [x^2 : zs | x <- [1..raizEntera y]
                        , zs <- aux (y - x^2) (n-1)]
 
-- (esCuadrado x) se verifica si x es un número al cuadrado. Por
-- ejemplo,
--    esCuadrado 25  ==  True
--    esCuadrado 26  ==  False
esCuadrado :: Int -> Bool
esCuadrado x = (raizEntera x)^2 == x
 
-- (raizEntera n) es el mayor entero cuya raíz cuadrada es menor o igual
-- que n. Por ejemplo,
--    raizEntera 15  ==  3
--    raizEntera 16  ==  4
--    raizEntera 17  ==  4
raizEntera :: Int -> Int
raizEntera = floor . sqrt . fromIntegral 
 
-- 2ª solución
-- =============
 
nDescomposiciones2 :: Int -> Int
nDescomposiciones2 = length . descomposiciones2
 
descomposiciones2 :: Int -> [[Int]]
descomposiciones2 x = a ! (x,4)
  where
    a = array ((0,1),(x,4)) [((i,j), f i j) | i <- [0..x], j <- [1..4]]
    f 0 1 = []
    f 1 1 = [[1]]
    f 2 1 = []
    f 3 1 = []
    f i 1 | esCuadrado i = [[i]]
          | otherwise    = []
    f i j = [x^2 : zs | x <- [1..raizEntera i]
                      , zs <- a ! (i - x^2,j-1)]
 
-- 3ª solución
-- ===========
 
nDescomposiciones3 :: Int -> Int
nDescomposiciones3 x = aux x 4
  where
    aux 0 1 = 0
    aux 1 1 = 1
    aux 2 1 = 0
    aux 3 1 = 0
    aux y 1 | esCuadrado y = 1
            | otherwise    = 0
    aux y n = sum [aux (y - x^2) (n-1) | x <- [1..raizEntera y]]
 
-- 4ª solución
-- ===========
 
nDescomposiciones4 :: Int -> Int
nDescomposiciones4 x = a ! (x,4)
  where
    a = array ((0,1),(x,4)) [((i,j), f i j) | i <- [0..x], j <- [1..4]]
    f 0 1 = 0
    f 1 1 = 1
    f 2 1 = 0
    f 3 1 = 0
    f i 1 | esCuadrado i = 1
          | otherwise    = 0
    f i j = sum [a ! (i- x^2,j-1) | x <- [1..raizEntera i]]
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_nDescomposiciones :: Positive Int -> Bool
prop_nDescomposiciones (Positive x) =
  all (== nDescomposiciones x) [f x | f <- [ nDescomposiciones2
                                           , nDescomposiciones3
                                           , nDescomposiciones4]]
 
-- La comprobación es
--    λ> quickCheck prop_nDescomposiciones
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
--    λ> nDescomposiciones 20000
--    1068
--    (3.69 secs, 3,307,250,128 bytes)
--    λ> nDescomposiciones2 20000
--    1068
--    (0.72 secs, 678,419,328 bytes)
--    λ> nDescomposiciones3 20000
--    1068
--    (3.94 secs, 3,485,725,552 bytes)
--    λ> nDescomposiciones4 20000
--    1068
--    (0.74 secs, 716,022,456 bytes)
--    
--    λ> nDescomposiciones2 50000
--    5682
--    (2.64 secs, 2,444,206,000 bytes)
--    λ> nDescomposiciones4 50000
--    5682
--    (2.77 secs, 2,582,443,448 bytes)
 
-- Definición de graficaDescomposiciones
-- =====================================
 
graficaDescomposiciones :: Int -> IO ()
graficaDescomposiciones n =
  plotList [ Key Nothing
           , PNG ("Numero_de_descomposiciones_en_sumas_de_cuadrados.png")
           ]
           (map nDescomposiciones3 [0..n])

Pensamiento

Ya habrá cigüeñas al sol,
mirando la tarde roja,
entre Moncayo y Urbión.

Antonio Machado

Descomposiciones en sumas de cuatro cuadrados

Definir la función

   descomposiciones :: Int -> [[Int]]

tal que (descomposiciones x) es la lista de las listas de los cuadrados de cuatro números enteros positivos cuya suma es x. Por ejemplo.

   λ> descomposiciones 4
   [[1,1,1,1]]
   λ> descomposiciones 5
   []
   λ> descomposiciones 7
   [[1,1,1,4],[1,1,4,1],[1,4,1,1],[4,1,1,1]]
   λ> descomposiciones 10
   [[1,1,4,4],[1,4,1,4],[1,4,4,1],[4,1,1,4],[4,1,4,1],[4,4,1,1]]
   λ> descomposiciones 15
   [[1,1,4,9],[1,1,9,4],[1,4,1,9],[1,4,9,1],[1,9,1,4],[1,9,4,1],
    [4,1,1,9],[4,1,9,1],[4,9,1,1],[9,1,1,4],[9,1,4,1],[9,4,1,1]]
   λ> length (descomposiciones 50000)
   5682

Soluciones

import Data.Array
import Test.QuickCheck
 
-- 1ª definición
-- =============
 
descomposiciones :: Int -> [[Int]]
descomposiciones x = aux x 4
  where 
    aux 0 1 = []
    aux 1 1 = [[1]]
    aux 2 1 = []
    aux 3 1 = []
    aux y 1 | esCuadrado y = [[y]]
            | otherwise    = []
    aux y n = [x^2 : zs | x <- [1..raizEntera y]
                        , zs <- aux (y - x^2) (n-1)]
 
-- (esCuadrado x) se verifica si x es un número al cuadrado. Por
-- ejemplo,
--    esCuadrado 25  ==  True
--    esCuadrado 26  ==  False
esCuadrado :: Int -> Bool
esCuadrado x = (raizEntera x)^2 == x
 
-- (raizEntera n) es el mayor entero cuya raíz cuadrada es menor o igual
-- que n. Por ejemplo,
--    raizEntera 15  ==  3
--    raizEntera 16  ==  4
--    raizEntera 17  ==  4
raizEntera :: Int -> Int
raizEntera = floor . sqrt . fromIntegral 
 
-- 2ª definición
-- =============
 
descomposiciones2 :: Int -> [[Int]]
descomposiciones2 x = a ! (x,4)
  where
    a = array ((0,1),(x,4)) [((i,j), f i j) | i <- [0..x], j <- [1..4]]
    f 0 1 = []
    f 1 1 = [[1]]
    f 2 1 = []
    f 3 1 = []
    f i 1 | esCuadrado i = [[i]]
          | otherwise    = []
    f i j = [x^2 : zs | x <- [1..raizEntera i]
                      , zs <- a ! (i - x^2,j-1)]
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_descomposiciones :: Positive Int -> Bool
prop_descomposiciones (Positive x) =
  descomposiciones x == descomposiciones2 x
 
-- La comprobación es
--    λ> quickCheck prop_descomposiciones
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> length (descomposiciones (2*10^4))
--    1068
--    (3.70 secs, 3,307,251,704 bytes)
--    λ> length (descomposiciones2 (2*10^4))
--    1068
--    (0.72 secs, 678,416,144 bytes)

Pensamiento

No extrañéis, dulces amigos,
que esté mi frente arrugada;
yo vivo en paz con los hombres
y en guerra con mis entrañas.

Antonio Machado

Número de particiones de un conjunto

Una partición de un conjunto A es un conjunto de subconjuntos no vacíos de A, disjuntos dos a dos y cuya unión es A. Por ejemplo, el conjunto {1, 2, 3} tiene exactamente 5 particiones:

   {{1}, {2}, {3}}
   {{1,2}, {3}}
   {{1,3}, {2}}
   {{1}, {2,3}}
   {{1,2,3}}

Definir la función

   nParticiones :: [a] -> Integer

tal que (nParticiones xs) es el número de particiones de xs. Por ejemplo,

   nParticiones [1,2]                     ==  2
   nParticiones [1,2,3]                   ==  5
   nParticiones "abcd"                    ==  15
   length (show (nParticiones [1..500]))  ==  844

Soluciones

import Data.List  ( genericLength
                  )
import Data.Array ( Array
                  , (!)
                  , array
                  )
 
-- 1ª definición
-- =============
 
nParticiones :: [a] -> Integer
nParticiones xs =
  genericLength (particiones xs)
 
-- (particiones xs) es el conjunto de las particiones de xs. Por
-- ejemplo, 
--    λ> particiones [1,2]
--    [[[1,2]],[[1],[2]]]
--    λ> particiones [1,2,3]
--    [[[1,2,3]],[[1],[2,3]],[[1,2],[3]],[[2],[1,3]],[[1],[2],[3]]]
particiones :: [a] -> [[[a]]]
particiones [] = [[]]
particiones xs =
  concat [particionesFijas xs k | k <- [0..length xs]]
 
-- (particionesFijas xs k) es el conjunto de las particiones de xs en k
-- subconjuntos. Por ejemplo,
--    particionesFijas [1,2,3] 0  ==  []
--    particionesFijas [1,2,3] 1  ==  [[[1,2,3]]]
--    particionesFijas [1,2,3] 2  ==  [[[1],[2,3]],[[1,2],[3]],[[2],[1,3]]]
--    particionesFijas [1,2,3] 3  ==  [[[1],[2],[3]]]
--    particionesFijas [1,2,3] 4  ==  []
particionesFijas :: [a] -> Int -> [[[a]]]
particionesFijas [] _ = []
particionesFijas xs 1 = [[xs]]
particionesFijas (x:xs) k =
   [[x]:ys | ys <- particionesFijas xs (k-1)] ++
   concat [inserta x ys | ys <- particionesFijas xs k]
 
-- (inserta x yss) es la lista obtenida insertando x en cada uno de los
-- elementos de yss. Por ejemplo, 
--    λ> inserta 1 [[2,3],[4],[5,6,7]]
--    [[[1,2,3],[4],[5,6,7]],[[2,3],[1,4],[5,6,7]],[[2,3],[4],[1,5,6,7]]]
inserta :: a -> [[a]] -> [[[a]]]
inserta _ []       = []
inserta x (ys:yss) = ((x:ys):yss) : [ys : zs | zs <- inserta x yss] 
 
-- 2ª definición
-- =============
 
nParticiones2 :: [a] -> Integer
nParticiones2 xs = sum [nParticionesFijas n k | k <- [0..n]]
  where n = genericLength xs
 
-- nPparticionesFijas n k) es el número de las particiones de un
-- conjunto con n elementos en k subconjuntos. Por ejemplo,
--    nParticionesFijas 3 0  ==  0
--    nParticionesFijas 3 1  ==  1
--    nParticionesFijas 3 2  ==  3
--    nParticionesFijas 3 3  ==  1
--    nParticionesFijas 3 4  ==  0
nParticionesFijas :: Integer -> Integer -> Integer
nParticionesFijas 0 0 = 1
nParticionesFijas 0 _ = 0
nParticionesFijas n 1 = 1
nParticionesFijas n k = nParticionesFijas (n-1) (k-1) + k * nParticionesFijas (n-1) k
 
-- 3ª definición
-- =============
 
nParticiones3 :: [a] -> Integer
nParticiones3 xs = sum [a ! (n,k) | k <- [0..n]]
  where n = genericLength xs
        a = matrizNParticiones n
 
-- (matrizNParticiones n) es la matriz de dimensión ((0,0),(n,n)) que en
-- la posición (i,j) tiene el número de particiones de un conjunto de i
-- elementos en j subconjuntos. Por ejemplo,
--    λ> matrizNParticiones 3
--    array ((0,0),(3,3))
--          [((0,0),0),((0,1),0),((0,2),0),((0,3),0),
--           ((1,0),0),((1,1),1),((1,2),0),((1,3),0),
--           ((2,0),0),((2,1),1),((2,2),1),((2,3),0),
--           ((3,0),0),((3,1),1),((3,2),3),((3,3),1)]
--    λ> matrizNParticiones 4
--    array ((0,0),(4,4))
--          [((0,0),0),((0,1),0),((0,2),0),((0,3),0),((0,4),0),
--           ((1,0),0),((1,1),1),((1,2),0),((1,3),0),((1,4),0),
--           ((2,0),0),((2,1),1),((2,2),1),((2,3),0),((2,4),0),
--           ((3,0),0),((3,1),1),((3,2),3),((3,3),1),((3,4),0),
--           ((4,0),0),((4,1),1),((4,2),7),((4,3),6),((4,4),1)]
matrizNParticiones :: Integer -> Array (Integer,Integer) Integer
matrizNParticiones n = a 
  where
    a = array ((0,0),(n,n)) [((i,j), f i j) | i <- [0..n], j <- [0..n]]
    f 0 0 = 1
    f 0 _ = 0
    f _ 0 = 0
    f _ 1 = 1
    f i j = a ! (i-1,j-1) + j * a ! (i-1,j)
 
-- 4ª definición
-- =============
 
nParticiones4 :: [a] -> Integer
nParticiones4 xs = sum [a ! (n,k) | k <- [0..n]]
  where
    n = genericLength xs
    a = array ((0,0),(n,n)) [((i,j), f i j) | i <- [0..n], j <- [0..n]]
    f 0 0 = 1
    f 0 _ = 0
    f _ 0 = 0
    f _ 1 = 1
    f i j = a ! (i-1,j-1) + j * a ! (i-1,j)
 
-- Comparación de eficiencia
-- =========================
 
--    λ> nParticiones [1..11]
--    678570
--    (3.77 secs, 705,537,480 bytes)
--    λ> nParticiones2 [1..11]
--    678570
--    (0.07 secs, 6,656,584 bytes)
--    λ> nParticiones3 [1..11]
--    678570
--    (0.01 secs, 262,176 bytes)
--    λ> nParticiones4 [1..11]
--    678570
--    (0.01 secs, 262,264 bytes)
--    
--    λ> nParticiones2 [1..16]
--    10480142147
--    (2.24 secs, 289,774,408 bytes)
--    λ> nParticiones3 [1..16]
--    10480142147
--    (0.01 secs, 437,688 bytes)
--    λ> nParticiones4 [1..16]
--    10480142147
--    (0.01 secs, 437,688 bytes)
--    
--    λ> length (show (nParticiones3 [1..500]))
--    844
--    (2.23 secs, 357,169,528 bytes)
--    λ> length (show (nParticiones4 [1..500]))
--    844
--    (2.20 secs, 357,172,680 bytes)

Pensamiento

Yo he visto garras fieras en las pulidas manos;
conozco grajos mélicos y líricos marranos …
El más truhán se lleva la mano al corazón,
y el bruto más espeso se carga de razón.

Antonio Machado