Menu Close

Etiqueta: concat

Números de Bell

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}}

El n-ésimo número de Bell, B(n), es el número de particiones de un conjunto de n elementos. Por lo visto anteriormentem B(3) = 5.

Definir las funciones

   particiones :: [a] -> [[[a]]]
   bell :: Integer -> Integer

tales que

  • (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 "abcd"
     [["abcd"],["a","bcd"],["ab","cd"],["b","acd"],["abc","d"],["bc","ad"],
      ["ac","bd"],["c","abd"],["a","b","cd"],["a","bc","d"],["a","c","bd"],
      ["ab","c","d"],["b","ac","d"],["b","c","ad"],["a","b","c","d"]]
  • (bell n) es el n-ésimo número de Bell. Por ejemplo,
     λ> bell 3
     5
     λ> map bell [0..10]
     [1,1,2,5,15,52,203,877,4140,21147,115975]

Comprobar con QuickCheck que (bell n) es equivalente a la función B(n) definida por

  • B(0) = 1
  • B(n) = \displaystyle \sum_{k=0}^{n-1} \binom{n-1}{k} B(k)

Soluciones

import Data.List (genericLength)
import Test.QuickCheck
 
-- Definición de particiones
-- =========================
 
particiones :: [a] -> [[[a]]]
particiones [] = [[]]
particiones (x:xs) =
  concat [([x] : yss) : inserta x yss | yss <- ysss]
  where ysss = particiones xs
 
-- (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] 
 
-- Definición de Bell
-- ==================
 
bell :: Integer -> Integer
bell n = genericLength (particiones [1..n])
 
-- Propiedad
-- =========
 
prop_Bell :: Integer -> Property
prop_Bell n =
  n >= 0 ==> bell n == b n
 
b :: Integer -> Integer
b 0 = 1
b n = sum [comb (n-1) k * b k | k <- [0..n-1]]
 
comb :: Integer -> Integer -> Integer
comb n k = product [n-k+1..n] `div` product [1..k]
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=10}) prop_Bell
--    +++ OK, passed 100 tests.

Otras soluciones

  • Se pueden escribir otras soluciones en los comentarios.
  • El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

«Cambiemos nuestra actitud tradicional en la construcción de programas. En lugar de imaginar que nuestra tarea principal es indicarle a una computadora lo que debe hacer, concentrémonos más bien en explicarle a los seres humanos lo que queremos que haga una computadora.»

Donald Knuth.

Números sin 2 en base 3

Definir la sucesión

   numerosSin2EnBase3 :: [Integer]

cuyos términos son los números cuya representación en base 3 no contiene el dígito 2. Por ejemplo,

   λ> take 20 numerosSin2EnBase3
   [0,1,3,4,9,10,12,13,27,28,30,31,36,37,39,40,81,82,84,85]

Se observa que

  • 12 está en la sucesión ya que su representación en base 3 es 110 (porque 1·3² + 1·3¹ + 0.3⁰ = 12) y no contiene a 2.
  • 14 no está en la sucesión ya que su representación en base 3 es 112 (porque 1·3² + 1·3¹ + 2.3⁰ = 14) y contiene a 2.

Comprobar con QuickCheck que las sucesiones numerosSin2EnBase3 y sucesionSin3enPA (del ejercicio anterior) son iguales; es decir, para todo número natural n, el n-ésimo término de numerosSin2EnBase3 es igual al n-ésimo término de sucesionSin3enPA.

Soluciones

import Data.List ((\\))
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
numerosSin2EnBase3a :: [Integer]
numerosSin2EnBase3a =
  [n | n <- [0..]
     , 2 `notElem` (enBase3 n)]
 
-- (enBase3 n) es la representación de n en base 3. Por ejemplo,
--    enBase3 7   ==  [1,2]
--    enBase3 9   ==  [0,0,1]
--    enBase3 10  ==  [1,0,1]
--    enBase3 11  ==  [2,0,1]
enBase3 :: Integer -> [Integer]
enBase3 n | n < 3     = [n]
          | otherwise = r : enBase3 q
  where (q,r) = quotRem n 3
 
-- 2ª definición
-- =============
 
-- Se puede construir como un triángulo:
--    0
--    1
--    3 4
--    9 10 12 13
--    27 28 30 31 36 37 39 40
--    ....
 
numerosSin2EnBase3b :: [Integer]
numerosSin2EnBase3b = 0 : concat (iterate siguientes [1])
  where siguientes xs = concatMap (\x -> [3*x,3*x+1]) xs
 
-- Comparación de eficiencia
-- =========================
 
-- La compración es
--    λ> numerosSin2EnBase3a !! (10^4)
--    1679697
--    (4.06 secs, 2,245,415,808 bytes)
--    λ> numerosSin2EnBase3b !! (10^4)
--    1679697
--    (0.03 secs, 2,109,912 bytes)
 
-- Definición
-- ==========
 
-- En lo que sigue usaremos la 2ª definición.
numerosSin2EnBase3 :: [Integer]
numerosSin2EnBase3 = numerosSin2EnBase3b
 
-- Propiedad
-- =========
 
-- La propiedad es
prop_equivalencia :: Int -> Property
prop_equivalencia n =
  n > 0 ==> sucesionSin3enPA !! n == numerosSin2EnBase3 !! n
 
-- sucesionSin3enPA donde cada uno de sus términos es el menor número
-- natural tal que no está en PA con cualesquiera dos términos
-- anteriores de la sucesión. 
sucesionSin3enPA :: [Integer]
sucesionSin3enPA = aux [] [0..] 
  where
    aux xs (y:ys) = y : aux (y:xs) (ys \\ [2 * y - x | x <- xs])
 
-- La comprobación es
--    λ> quickCheck prop_equivalencia
--    +++ OK, passed 100 tests.

Otras soluciones

  • Se pueden escribir otras soluciones en los comentarios.
  • El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

O que yo pueda asesinar un día
en mi alma, al despertar, esa persona
que me hizo el mundo mientras yo dormía.

Antonio Machado

Teorema de Liouville sobre listas CuCu

Una lista CuCu es una lista de números enteros positivos tales que la suma de sus Cubos es igual al Cuadrado de su suma. Por ejemplo, [1, 2, 3, 2, 4, 6] es una lista CuCu ya que

   1³ + 2³ + 3³ + 2³ + 4³ + 6³ = (1 + 2 + 3 + 2 + 4 + 6)²

La lista de Liouville correspondiente al número entero positivo n es la lista formada por el número de divisores de cada divisor de n. Por ejemplo, para el número 20 se tiene que sus divisores son

   1, 2, 4, 5, 10, 20

puesto que el número de sus divisores es

  • El 1 tiene 1 divisor (el 1 solamente).
  • El 2 tiene 2 divisores (el 1 y el 2).
  • El 4 tiene 3 divisores (el 1, el 2 y el 4).
  • El 5 tiene 2 divisores (el 1 y el 5).
  • El 10 tiene 4 divisores (el 1, el 2, el 5 y el 10).
  • El 20 tiene 6 divisores (el 1, el 2, el 4, el 5, el 10 y el 20).

la lista de Liouville de 20 es [1, 2, 3, 2, 4, 6] que, como se comentó anteriormente, es una lista CuCu.

El teorema de Lioville afirma que todas las lista de Lioville son CuCu.

Definir las funciones

   esCuCu :: [Integer] -> Bool
   liouville :: Integer -> [Integer]

tales que

  • (esCuCu xs) se verifica si la lista xs es CuCu; es decir, la suma de los cubos de sus elementos es igual al cuadrado de su suma. Por ejemplo,
     esCuCu [1,2,3]        ==  True
     esCuCu [1,2,3,2]      ==  False
     esCuCu [1,2,3,2,4,6]  ==  True
  • (liouville n) es la lista de Lioville correspondiente al número n. Por ejemplo,
     liouville 20  ==  [1,2,3,2,4,6]
     liouville 60  ==  [1,2,2,3,2,4,4,6,4,6,8,12]
     length (liouville (product [1..25]))  ==  340032

Comprobar con QuickCheck

  • que para todo entero positivo n, (liouville (2^n)) es la lista [1,2,3,…,n+1] y
  • el teorema de Lioville; es decir, para todo entero positivo n, (liouville n) es una lista CuCu.

Nota: Este ejercicio está basado en Cómo generar conjuntos CuCu de Gaussianos.

Soluciones

import Data.List (genericLength, group, inits, sort)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck
 
esCuCu :: [Integer] -> Bool
esCuCu xs = sum (map (^3) xs) == (sum xs)^2
 
-- 1ª definición de liouville
-- ==========================
 
liouville :: Integer -> [Integer]
liouville n = map numeroDivisores (divisores n)
 
-- (divisores x) es el conjunto de divisores de los x. Por ejemplo, 
--   divisores 30  ==  [1,2,3,5,6,10,15,30]
divisores :: Integer -> [Integer]
divisores n = [x | x <- [1..n], n `mod` x == 0]
 
-- (numeroDivisores x) es el número de divisores de x. Por ejemplo, 
--    numeroDivisores 12  ==  6
--    numeroDivisores 25  ==  3
numeroDivisores :: Integer -> Integer
numeroDivisores n = genericLength (divisores n) 
 
  -- 2ª definición de liouville
-- ============================
 
liouville2 :: Integer -> [Integer]
liouville2 n = map numeroDivisores2 (divisores2 n)
 
-- Se usan las funciones
-- + divisores de "Conjunto de divisores" http://bit.ly/2OtbFIj
-- + numeroDivisores de "Número de divisores" http://bit.ly/2DgVh74
 
-- (divisores2 x) es el conjunto de divisores de los x. Por ejemplo, 
--   divisores2 30  ==  [1,2,3,5,6,10,15,30]
divisores2 :: Integer -> [Integer]
divisores2 = sort
           . map (product . concat)
           . sequence
           . map inits
           . group
           . primeFactors
 
-- (numeroDivisores2 x) es el número de divisores de x. Por ejemplo, 
--    numeroDivisores2 12  ==  6
--    numeroDivisores2 25  ==  3
numeroDivisores2 :: Integer -> Integer
numeroDivisores2 =
  product . map ((+1) . genericLength) . group . primeFactors
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> length (liouville (product [1..11]))
--    540
--    (13.66 secs, 7,983,550,640 bytes)
--    λ> length (liouville2 (product [1..11]))
--    540
--    (0.01 secs, 1,255,328 bytes)
 
-- Propiedad
-- =========
 
-- La propiedad es
prop_Liouville :: Integer -> Property
prop_Liouville n =
  n > 0 ==> liouville2 (2^n) == [1..n+1]
 
-- La comprobación es
--    λ> quickCheck prop_Liouville
--    +++ OK, passed 100 tests.
 
-- Teorema de Liouville
-- ====================
 
-- La propiedad es
teorema_Liouville :: Integer -> Property
teorema_Liouville n =
  n > 0 ==> esCuCu (liouville n)
 
-- La comprobación es
--    λ> quickCheck teorema_Liouville
--    +++ OK, passed 100 tests.

Pensamiento

¡Oh, tarde viva y quieta
que opuso al panta rhei su nada corre.

Antonio Machado

Pares definidos por su MCD y su MCM

Definir las siguientes funciones

   pares  :: Integer -> Integer -> [(Integer,Integer)]
   nPares :: Integer -> Integer -> Integer

tales que

  • (pares a b) es la lista de los pares de números enteros positivos tales que su máximo común divisor es a y su mínimo común múltiplo es b. Por ejemplo,
     pares 3 3  == [(3,3)]
     pares 4 12 == [(4,12),(12,4)]
     pares 2 12 == [(2,12),(4,6),(6,4),(12,2)]
     pares 2 60 == [(2,60),(4,30),(6,20),(10,12),(12,10),(20,6),(30,4),(60,2)]
     pares 2 7  == []
     pares 12 3  ==  []
     length (pares 3 (product [3,5..91]))  ==  8388608
  • (nPares a b) es el número de pares de enteros positivos tales que su máximo común divisor es a y su mínimo común múltiplo es b. Por ejemplo,
     nPares 3 3   ==  1
     nPares 4 12  ==  2
     nPares 2 12  ==  4
     nPares 2 60  ==  8
     nPares 2 7   ==  0
     nPares 12 3  ==  0
     nPares 3 (product [3..3*10^4]) `mod` (10^12)  ==  477999992832
     length (show (nPares 3 (product [3..3*10^4])))  ==  977

Soluciones

import Data.Numbers.Primes (primeFactors)
import Data.List (genericLength, group, nub, sort, subsequences)
import Test.QuickCheck
 
-- 1ª definición de pares
-- ======================
 
pares1 :: Integer -> Integer -> [(Integer,Integer)]
pares1 a b = [(x,y) | x <- [1..b]
                    , y <- [1..b]
                    , gcd x y == a
                    , lcm x y == b]
 
-- 2ª definición de pares
-- ======================
 
pares2 :: Integer -> Integer -> [(Integer,Integer)]
pares2 a b = [(x,y) | x <- [a,a+a..b]
                    , y <- [a,a+a..b]
                    , gcd x y == a
                    , lcm x y == b]
 
-- Comparación de eficiencia
--    λ> length (pares1 3 (product [3,5..11]))
--    16
--    (95.12 secs, 86,534,165,528 bytes)
--    λ> length (pares2 3 (product [3,5..11]))
--    16
--    (15.80 secs, 14,808,762,128 bytes)
 
-- 3ª definición de pares
-- ======================
 
pares3 :: Integer -> Integer -> [(Integer,Integer)]
pares3 a b = [(x,y) | x <- [a,a+a..b]
                    , c `rem` x == 0
                    , let y = c `div` x
                    , gcd x y == a
                    ]
  where c = a * b
 
-- Comparacioń de eficiencia
--    λ> length (pares2 3 (product [3,5..11]))
--    16
--    (15.80 secs, 14,808,762,128 bytes)
--    λ> length (pares3 3 (product [3,5..11]))
--    16
--    (0.01 secs, 878,104 bytes)
 
-- 4ª definición de pares
-- ======================
 
-- Para la cuarta definición de pares se observa la relación con los
-- factores primos
--    λ> [(primeFactors x, primeFactors y) | (x,y) <- pares1 2 12]
--    [([2],[2,2,3]),([2,2],[2,3]),([2,3],[2,2]),([2,2,3],[2])]
--    λ> [primeFactors x | (x,y) <- pares1 2 12]
--    [[2],[2,2],[2,3],[2,2,3]]
--    λ> [primeFactors x | (x,y) <- pares1 2 60]
--    [[2],[2,2],[2,3],[2,5],[2,2,3],[2,2,5],[2,3,5],[2,2,3,5]]
--    λ> [primeFactors x | (x,y) <- pares1 6 60]
--    [[2,3],[2,2,3],[2,3,5],[2,2,3,5]]
--    λ> [primeFactors x | (x,y) <- pares1 2 24]
--    [[2],[2,3],[2,2,2],[2,2,2,3]]
-- Se observa que cada pares se obtiene de uno de los subconjuntos de los
-- divisores primos de b/a. Por ejemplo,
--    λ> (a,b) = (2,24)
--    λ> b `div` a
--    12
--    λ> primeFactors it
--    [2,2,3]
--    λ> group it
--    [[2,2],[3]]
--    λ> subsequences it
--    [[],[[2,2]],[[3]],[[2,2],[3]]]
--    λ> map concat it
--    [[],[2,2],[3],[2,2,3]]
--    λ> map product it
--    [1,4,3,12]
--    λ> [(a * x, b `div` x) | x <- it]
--    [(2,24),(8,6),(6,8),(24,2)]
-- A partir de la observación se construye la siguiente definición
 
pares4 :: Integer -> Integer -> [(Integer,Integer)]
pares4 a b
  | b `mod` a /= 0 = []
  | otherwise =
    [(a * x, b `div` x)
    | x <- map (product . concat)
               ((subsequences . group . primeFactors) (b `div` a))]
 
-- Nota. La función pares4 calcula el mismo conjunto que las anteriores,
-- pero no necesariamente en el mismo orden. Por ejemplo,
--    λ> pares3 2 60 
--    [(2,60),(4,30),(6,20),(10,12),(12,10),(20,6),(30,4),(60,2)]
--    λ> pares4 2 60 
--    [(2,60),(4,30),(6,20),(12,10),(10,12),(20,6),(30,4),(60,2)]
--    λ> pares3 2 60 == sort (pares4 2 60)
--    True
 
-- Comparacioń de eficiencia
--    λ> length (pares3 3 (product [3,5..17]))
--    64
--    (4.44 secs, 2,389,486,440 bytes)
--    λ> length (pares4 3 (product [3,5..17]))
--    64
--    (0.00 secs, 177,704 bytes)
 
-- Propiedades de equivalencia de pares
-- ====================================
 
prop_pares :: Integer -> Integer -> Property
prop_pares a b =
  a > 0 && b > 0 ==>
  all (== pares1 a b)
      [sort (f a b) | f <- [ pares2
                           , pares3
                           , pares4
                           ]]
 
prop_pares2 :: Integer -> Integer -> Property
prop_pares2 a b =
  a > 0 && b > 0 ==>
  all (== pares1 a (a * b))
      [sort (f a (a * b)) | f <- [ pares2
                                 , pares3
                                 , pares4
                                 ]]
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=10}) prop_pares
--    +++ OK, passed 100 tests.
--    λ> quickCheckWith (stdArgs {maxSize=10}) prop_pares
--    +++ OK, passed 100 tests.
--    λ> quickCheckWith (stdArgs {maxSize=10}) prop_pares2
--    +++ OK, passed 100 tests.
 
-- 1ª definición de nPares
-- =======================
 
nPares1 :: Integer -> Integer -> Integer
nPares1 a b = genericLength (pares4 a b)
 
-- 2ª definición de nPares
-- =======================
 
nPares2 :: Integer -> Integer -> Integer
nPares2 a b = 2^(length (nub (primeFactors (b `div` a))))
 
-- Comparación de eficiencia
--    λ> nPares1 3 (product [3,5..91])
--    8388608
--    (4.68 secs, 4,178,295,920 bytes)
--    λ> nPares2 3 (product [3,5..91])
--    8388608
--    (0.00 secs, 234,688 bytes)
 
-- Propiedad de equivalencia de nPares
-- ===================================
 
prop_nPares :: Integer -> Integer -> Property
prop_nPares a b =
  a > 0 && b > 0 ==>
  nPares1 a (a * b) == nPares2 a (a * b)
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=10}) prop_nPares
--    +++ OK, passed 100 tests.

Pensamiento

Largo es el camino de la enseñanza por medio de teorías; breve y eficaz por medio de ejemplos. ~ Séneca

Múltiplos con ceros y unos

Se observa que todos los primeros números naturales tienen al menos un múltiplo no nulo que está formado solamente por ceros y unos. Por ejemplo, 1×10=10, 2×5=10, 3×37=111, 4×25=100, 5×2=10, 6×185=1110; 7×143=1001; 8X125=1000; 9×12345679=111111111.

Definir la función

   multiplosCon1y0 :: Integer -> [Integer]

tal que (multiplosCon1y0 n) es la lista de los múltiplos de n cuyos dígitos son 1 ó 0. Por ejemplo,

   take 4 (multiplosCon1y0 3)      ==  [111,1011,1101,1110]
   take 3 (multiplosCon1y0 23)     ==  [110101,1011011,1101010]
   head (multiplosCon1y0 1234658)  ==  110101101101000000110

Comprobar con QuickCheck que todo entero positivo tiene algún múltiplo cuyos dígitos son 1 ó 0.

Soluciones

import Test.QuickCheck
 
-- 1ª definición
-- =============
 
multiplosCon1y0 :: Integer -> [Integer]
multiplosCon1y0 n = [x | x <- multiplos n
                       , todos1y0 x]
 
-- (multiplos n) es la lista de los múltiplos de n. Por ejemplo, 
--    take 12 (multiplos 5)  ==  [5,10,15,20,25,30,35,40,45,50,55,60]
multiplos :: Integer -> [Integer]
multiplos n = [n,2*n..]
 
-- (todos1y0 n) se verifica si todos los dígitos de n son el 1 o el
-- 0. Por ejmplo,
--    todos1y0 1101110  ==  True
--    todos1y0 1102110  ==  False
todos1y0 :: Integer -> Bool
todos1y0 n = all (`elem` "01") (show n)
 
-- 2ª definición
-- =============
 
multiplosCon1y0b :: Integer -> [Integer] 
multiplosCon1y0b n = 
    [x | x <- numerosCon1y0
       , x `rem` n == 0] 
 
-- numerosCon1y0 es la lista de los números cuyos dígitos son 1 ó 0. Por
-- ejemplo,  
--    ghci> take 15 numerosCon1y0
--    [1,10,11,100,101,110,111,1000,1001,1010,1011,1100,1101,1110,1111]
numerosCon1y0 :: [Integer]
numerosCon1y0 = 1 : concat [[10*x,10*x+1] | x <- numerosCon1y0]
 
-- Comparación de eficiencia
-- =========================
 
--    λ> head (multiplosCon1y0 9)
--    111111111
--    (7.70 secs, 10,853,320,456 bytes)
--    λ> head (multiplosCon1y0b 9)
--    111111111
--    (0.01 secs, 167,992 bytes)
 
-- Comprobación de la propiedad
-- ============================
 
-- La propiedad es
prop_existe_multiplosCon1y0 :: Integer -> Property
prop_existe_multiplosCon1y0 n = 
    n > 0 ==> (not . null) (multiplosCon1y0b n)
 
-- La comprobación es
--    λ> quickCheck prop_existe_multiplosCon1y0
--    +++ OK, passed 100 tests.

Pensamiento

Huye del triste amor, amor pacato,
sin peligro, sin venda ni aventura,
que espera del amor prenda segura,
porque en amor locura es lo sensato.

Antonio Machado