Menu Close

Etiqueta: Combinatoria

Número de particiones en k subconjuntos

José A. Alonso, ,

Definir la función

   numeroParticiones :: Int -> Int -> Int

tal que (numeroParticiones n k) es el número de particiones de conjunto de n elementos en k subconjuntos disjuntos. Por ejemplo,

   numeroParticiones 3 2    ==  3
   numeroParticiones 3 3    ==  1
   numeroParticiones 4 3    ==  6
   numeroParticiones 4 1    ==  1
   numeroParticiones 4 4    ==  1
   numeroParticiones 91 89  ==  8139495

Soluciones

import Data.Array (Array, (!), array)
import Test.QuickCheck (Positive (Positive), quickCheckWith)
 
-- 1ª solución
-- ===========
 
numeroParticiones1 :: Int -> Int -> Int
numeroParticiones1 n k =
  length (particiones1 [1..n] k)
 
particiones1 :: [a] -> Int -> [[[a]]]
particiones1 [] _     = []
particiones1 _  0     = []
particiones1 xs 1     = [[xs]]
particiones1 (x:xs) k = [[x]:ys | ys <- particiones1 xs (k-1)] ++ 
                        concat [inserta x ys | ys <- particiones1 xs k]
 
-- (inserta x yss) es la lista obtenida insertando x en cada uno de los
-- conjuntos de yss. Por ejemplo,
--    inserta 4 [[3],[2,5]]  ==  [[[4,3],[2,5]],[[3],[4,2,5]]]
inserta :: a -> [[a]] -> [[[a]]]
inserta _ []       = []
inserta x (ys:yss) = ((x:ys):yss) : [ys:zss | zss <- inserta x yss]
 
-- 2ª solución
-- ===========
 
numeroParticiones2 :: Int -> Int -> Int
numeroParticiones2 0 _ = 0
numeroParticiones2 _ 0 = 0
numeroParticiones2 _ 1 = 1
numeroParticiones2 n k = k * numeroParticiones2 (n-1) k +
                         numeroParticiones2 (n-1) (k-1) 
 
-- 3ª solución
-- ===========
 
numeroParticiones3 :: Int -> Int -> Int
numeroParticiones3 n k = matrizNumeroParticiones n k ! (n,k)
 
matrizNumeroParticiones :: Int -> Int -> Array (Int,Int) Int
matrizNumeroParticiones n k = q where
  q = array ((0,0),(n,k)) [((i,j), f i j) | i <- [0..n], j <- [0..k]]
  f _ 0 = 0
  f 0 _ = 0
  f _ 1 = 1
  f i j | i == j    = 1
        | otherwise = j * f (i-1) j + f (i-1) (j-1)
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_numeroParticiones :: Positive Int -> Positive Int -> Bool
prop_numeroParticiones (Positive n) (Positive k) =
  all (== numeroParticiones1 n k)
      [numeroParticiones2 n k,
       numeroParticiones3 n k]
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=10}) prop_numeroParticiones
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> numeroParticiones1 12 6
--    1323652
--    (1.22 secs, 1,152,945,608 bytes)
--    λ> numeroParticiones2 12 6
--    1323652
--    (0.00 secs, 1,283,152 bytes)
--    λ> numeroParticiones3 12 6
--    1323652
--    (0.01 secs, 1,155,864 bytes)
--
--    λ> numeroParticiones2 21 19
--    19285
--    (2.04 secs, 990,274,976 bytes)
--    λ> numeroParticiones3 21 19
--    19285
--    (0.00 secs, 940,736 bytes)

El código se encuentra en GitHub.

Leer más →

Particiones en k subconjuntos

José A. Alonso, ,

Definir la función

   particiones :: [a] -> Int -> [[[a]]]

tal que (particiones xs k) es la lista de las particiones de xs en k subconjuntos disjuntos. Por ejemplo,

   λ> particiones [2,3,6] 2
   [[[2],[3,6]],[[2,3],[6]],[[3],[2,6]]]
   λ> particiones [2,3,6] 3
   [[[2],[3],[6]]]
   λ> particiones [4,2,3,6] 3
   [[[4],[2],[3,6]],[[4],[2,3],[6]],[[4],[3],[2,6]],
    [[4,2],[3],[6]],[[2],[4,3],[6]],[[2],[3],[4,6]]]
   λ> particiones [4,2,3,6] 1
   [[[4,2,3,6]]]
   λ> particiones [4,2,3,6] 4
   [[[4],[2],[3],[6]]]

Soluciones

import Data.List (nub, sort)
import Data.Array (Array, (!), array, listArray)
import Test.QuickCheck (Positive (Positive), quickCheckWith)
 
-- 1ª solución
-- ===========
 
particiones1 :: [a] -> Int -> [[[a]]]
particiones1 [] _     = []
particiones1 _  0     = []
particiones1 xs 1     = [[xs]]
particiones1 (x:xs) k = [[x]:ys | ys <- particiones1 xs (k-1)] ++ 
                        concat [inserta x ys | ys <- particiones1 xs k]
 
-- (inserta x yss) es la lista obtenida insertando x en cada uno de los
-- conjuntos de yss. Por ejemplo,
--    inserta 4 [[3],[2,5]]  ==  [[[4,3],[2,5]],[[3],[4,2,5]]]
inserta :: a -> [[a]] -> [[[a]]]
inserta _ []       = []
inserta x (ys:yss) = ((x:ys):yss) : [ys:zss | zss <- inserta x yss]
 
-- 2ª solución
-- ===========
 
particiones2 :: [a] -> Int -> [[[a]]]
particiones2 [] _     = []
particiones2 _  0     = []
particiones2 xs 1     = [[xs]]
particiones2 (x:xs) k = map ([x]:) (particiones2 xs (k-1)) ++ 
                        concatMap (inserta x) (particiones2 xs k)
 
-- 3ª solución
-- ===========
 
particiones3 :: [a] -> Int -> [[[a]]]
particiones3 xs k = matrizParticiones xs k ! (length xs, k)
 
matrizParticiones :: [a] -> Int -> Array (Int,Int) [[[a]]]
matrizParticiones xs k = q where
  q = array ((0,0),(n,k)) [((i,j), f i j) | i <- [0..n], j <- [0..k]]
  n = length xs
  v = listArray (1,n) xs
  f _ 0 = []
  f 0 _ = []
  f m 1 = [[take m xs]]
  f i j | i == j = [[[x] | x <- take i xs]]
        | otherwise = map ([v!i] :) (q!(i-1,j-1)) ++
                      concatMap (inserta (v!i)) (q!(i-1,j))
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_particiones :: [Int] -> Positive Int -> Bool
prop_particiones xs (Positive k) =
  all (iguales (particiones1 xs' k))
      [particiones2 xs' k,
       particiones3 xs' k]
  where
    xs' = nub xs
    iguales xss yss = sort (map sort [map sort x | x <- xss]) ==
                      sort (map sort [map sort y | y <- yss])
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=10}) prop_particiones
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> length (particiones1 [1..12] 6)
--    1323652
--    (1.33 secs, 1,152,945,584 bytes)
--    λ> length (particiones2 [1..12] 6)
--    1323652
--    (1.07 secs, 1,104,960,360 bytes)
--    λ> length (particiones3 [1..12] 6)
--    1323652
--    (1.68 secs, 1,047,004,368 bytes)

El código se encuentra en GitHub.

Leer más →

Descomposiciones con sumandos 1 ó 2

José A. Alonso, ,

Definir la funciones

   sumas  :: Int -> [[Int]]
   nSumas :: Int -> Integer

tales que

  • (sumas n) es la lista de las descomposiciones de n como sumas cuyos sumandos son 1 ó 2. Por ejemplo,
      sumas 1            ==  [[1]]
      sumas 2            ==  [[1,1],[2]]
      sumas 3            ==  [[1,1,1],[1,2],[2,1]]
      sumas 4            ==  [[1,1,1,1],[1,1,2],[1,2,1],[2,1,1],[2,2]]
      length (sumas 26)  ==  196418
      length (sumas 33)  ==  5702887
  • (nSumas n) es el número de descomposiciones de n como sumas cuyos sumandos son 1 ó 2. Por ejemplo, 
      nSumas 4                      ==  5
      nSumas 123                    ==  36726740705505779255899443
      length (show (nSumas 123456)) ==  25801

Soluciones

import Data.List  (genericIndex, genericLength)
import Data.Array ((!), array)
import Test.QuickCheck (Positive(Positive), quickCheckWith)
 
-- 1ª solución de sumas
-- ====================
 
sumas1 :: Int -> [[Int]]
sumas1 0 = [[]]
sumas1 1 = [[1]]
sumas1 n = [1:xs | xs <- sumas1 (n-1)] ++ [2:xs | xs <- sumas1 (n-2)]
 
-- 2ª solución de sumas
-- ====================
 
sumas2 :: Int -> [[Int]]
sumas2 0 = [[]]
sumas2 1 = [[1]]
sumas2 n = map (1:) (sumas2 (n-1)) ++ map (2:) (sumas2 (n-2))
 
-- 3ª solución de sumas
-- ====================
 
sumas3 :: Int -> [[Int]]
sumas3 n = v ! n
  where v = array (0,n) [(i, f i) | i <- [0..n]]
        f 0 = [[]]
        f 1 = [[1]]
        f k = map (1:) (v!(k-1)) ++ map (2:) (v!(k-2))
 
-- 4ª solución de sumas
-- ====================
 
sumas4 :: Int -> [[Int]]
sumas4 n = sucSumas !! n
 
-- sucSumas es la sucesión cuyo n-ésimo elemento es la lista de las
-- descomposiciones de n como sumas cuyos sumandos son 1 ó 2. Por
-- ejemplo,
--    λ> take 4 sucSumas
--    [[[]],[[1]],[[1,1],[2]],[[1,1,1],[1,2],[2,1]]]
--    λ> mapM_ print (take 5 sucSumas)
--    [[]]
--    [[1]]
--    [[1,1],[2]]
--    [[1,1,1],[1,2],[2,1]]
--    [[1,1,1,1],[1,1,2],[1,2,1],[2,1,1],[2,2]]
sucSumas :: [[[Int]]]
sucSumas = [[]] : [[1]] : zipWith f (tail sucSumas) sucSumas
  where f xs ys = map (1:) xs ++ map (2:) ys
 
-- Comprobación de equivalencia de sumas
-- =====================================
 
-- La propiedad es
prop_sumas :: Positive Int -> Bool
prop_sumas (Positive n) =
  all (== sumas1 n)
      [sumas2 n,
       sumas3 n,
       sumas4 n]
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_sumas
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia de sumas
-- ==================================
 
-- La comparación es
--    λ> length (sumas1 28)
--    514229
--    (2.79 secs, 1,739,784,512 bytes)
--    λ> length (sumas2 28)
--    514229
--    (1.33 secs, 1,512,291,248 bytes)
--    λ> length (sumas3 28)
--    514229
--    (0.20 secs, 165,215,800 bytes)
--    λ> length (sumas4 28)
--    514229
--    (0.17 secs, 165,201,592 bytes)
--
--    λ> length (sumas3 33)
--    5702887
--    (2.16 secs, 1,830,761,864 bytes)
--    λ> length (sumas4 33)
--    5702887
--    (1.44 secs, 1,830,749,832 bytes)
 
-- Definición de sumas
-- ===================
 
-- La cuarta solución es más eficiente y es la que usaremos en lo
-- sucesivo:
sumas :: Int -> [[Int]]
sumas = sumas4
 
-- 1ª solución de nSumas
-- =====================
 
nSumas1 :: Int -> Integer
nSumas1 = genericLength . sumas2
 
-- 2ª solución de nSumas
-- =====================
 
nSumas2 :: Int -> Integer
nSumas2 0 = 1
nSumas2 1 = 1
nSumas2 n = nSumas2 (n-1) + nSumas2 (n-2)
 
-- 3ª solución de nSumas
-- =====================
 
nSumas3 :: Int -> Integer
nSumas3 n = v ! n
  where v = array (0,n) [(i,f i) | i <- [0..n]]
        f 0 = 1
        f 1 = 1
        f k = v ! (k-1) + v ! (k-2)
 
-- 4ª solución de nSumas
-- =====================
 
nSumas4 :: Int -> Integer
nSumas4 n = aux `genericIndex` n
  where aux = 1 : 1 : zipWith (+) aux (tail aux) 
 
-- Comprobación de equivalencia de nSumas
-- ======================================
 
-- La propiedad es
prop_nSumas :: Positive Int -> Bool
prop_nSumas (Positive n) =
  all (== nSumas1 n)
      [nSumas2 n,
       nSumas3 n,
       nSumas4 n]
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_nSumas
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia de nSumas
-- ===================================
 
-- La comparación es
--    λ> nSumas1 33
--    5702887
--    (17.32 secs, 23,140,562,600 bytes)
--    λ> nSumas2 33
--    5702887
--    (3.48 secs, 1,870,676,904 bytes)
--    λ> nSumas3 33
--    5702887
--    (0.00 secs, 152,960 bytes)
--    λ> nSumas4 33
--    5702887
--    (0.00 secs, 139,456 bytes)
--    
--    λ> length (show (nSumas3 (2*10^5)))
--    41798
--    (1.41 secs, 1,895,295,528 bytes)
--    λ> length (show (nSumas4 (2*10^5)))
--    41798
--    (2.39 secs, 1,834,998,800 bytes)
 
-- Nota. El valor de (nSumas n) es el n-ésimo término de la sucesión de
-- Fibonacci 1, 1, 2, 3, 5, 8, ...

El código se encuentra en GitHub.

Leer más →