Menu Close

Mes: marzo 2021

Lista muy decreciente

Una lista de números es muy decreciente si cada elemento es mayor que la suma de los restantes. Por ejemplo, [19,9,6,2] es muy decreciente ya que

  • 19 > 9 + 6 + 2,
  • 9 > 6 + 2 y
  • 6 > 2

En cambio, [19,8,6,2] no lo es ya que 8 = 6 + 2.

Definir la función

   muyDecreciente :: [Integer] -> Bool

tal que (muyDecreciente xs) se verifica si xs es muy decreciente. Por ejemplo,

   muyDecreciente [19,9,6,2]  ==  True
   muyDecreciente [19,8,6,2]  ==  False
   muyDecreciente [2^k | k <- [60000,59999..0]]  ==  True

Soluciones

-- 1ª solución
-- ===========
 
muyDecreciente :: [Integer] -> Bool
muyDecreciente []     = True
muyDecreciente (x:xs) = x > sum xs && muyDecreciente xs
 
-- 2ª solución
-- ===========
 
muyDecreciente2 :: [Integer] -> Bool
muyDecreciente2 = snd . aux
  where aux []     = (0,True)
        aux (x:xs) = (x + s, x > s && b)
          where (s,b) = aux xs
 
-- 3ª solución
-- ===========
 
muyDecreciente3 :: [Integer] -> Bool
muyDecreciente3 xs =
  and (zipWith (>) xs (tail (scanr1 (+) xs)))
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> muyDecreciente [2^k | k <- [10000,9999..0]]
--    True
--    (6.72 secs, 48,095,728,720 bytes)
--    λ> muyDecreciente2 [2^k | k <- [10000,9999..0]]
--    True
--    (0.08 secs, 67,222,960 bytes)
--    λ> muyDecreciente3 [2^k | k <- [10000,9999..0]]
--    True
--    (0.10 secs, 66,664,928 bytes)
--
--    λ> muyDecreciente2 [2^k | k <- [50000,49999..0]]
--    True
--    (1.88 secs, 857,128,312 bytes)
--    λ> muyDecreciente3 [2^k | k <- [50000,49999..0]]
--    True
--    (1.67 secs, 854,326,736 bytes)

Nuevas soluciones

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

Menor prefijo con suma positiva

Definir la función

   menorPrefijoSumaPositiva1 :: [[Int]] -> Maybe [[Int]]

tal que (menorPrefijoSumaPositiva1 xss) es justamente el menor prejijo de xss tal que la suma de lsas sumas de sus elementos es positivo y es Nothing si tal prefijo no existe. Por ejemplo,

   menorPrefijoSumaPositiva [[1],[-3],[2,4]]     == Just [[1]]
   menorPrefijoSumaPositiva [[-2,1],[-3],[2,4]]  == Just [[-2,1],[-3],[2,4]]
   menorPrefijoSumaPositiva [[-2,1],[3],[2,4]]   == Just [[-2,1],[3]]
   menorPrefijoSumaPositiva [[-2,1],[-3],[2,-4]] == Nothing
   menorPrefijoSumaPositiva [[-k..k] | k <- [1..5000]]              == Nothing
   fmap length (menorPrefijoSumaPositiva [[-3000..k] | k <- [0..]]) == Just 5198

Soluciones

import Data.List (inits)
import Data.Maybe (listToMaybe)
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
menorPrefijoSumaPositiva1 :: [[Int]] -> Maybe [[Int]]
menorPrefijoSumaPositiva1 xss =
  listToMaybe [xs | xs <- tail (inits xss),
                    sum (concat xs) > 0]
 
-- 2ª solución
-- ===========
 
menorPrefijoSumaPositiva2 :: [[Int]] -> Maybe [[Int]]
menorPrefijoSumaPositiva2 xss = aux [] xss
  where aux yss _  | sum (concat yss) > 0 = Just (reverse yss)
        aux _   []                        = Nothing
        aux yss (zs:zss)                  = aux (zs : yss) zss
 
-- 3ª solución
-- ===========
 
menorPrefijoSumaPositiva3 :: [[Int]] -> Maybe [[Int]]
menorPrefijoSumaPositiva3 xss =
  aux (0,[]) (zip (map sum xss) xss)
  where aux (s,yss) _  | s > 0   = Just (reverse yss)
        aux _ []                 = Nothing
        aux (s,yss) ((t,zs):zss) = aux (s+t,zs:yss) zss
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_equivalencia :: [[Int]] -> Bool
prop_equivalencia xss =
  all (== (menorPrefijoSumaPositiva1 xss))
      [ menorPrefijoSumaPositiva2 xss,
        menorPrefijoSumaPositiva3 xss ]
 
-- La comprobación es
--    λ> quickCheck prop_equivalencia
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
--
-- La comparación es
--    λ> fmap length (menorPrefijoSumaPositiva1 [[-200..k] | k <- [0..]])
--    Just 348
--    (2.40 secs, 2,801,967,392 bytes)
--    λ> fmap length (menorPrefijoSumaPositiva2 [[-200..k] | k <- [0..]])
--    Just 348
--    (2.46 secs, 2,800,717,720 bytes)
--    λ> fmap length (menorPrefijoSumaPositiva3 [[-200..k] | k <- [0..]])
--    Just 348
--    (0.01 secs, 18,128,464 bytes)
 
--    λ> menorPrefijoSumaPositiva1 [[-k..k] | k <- [1..500]]
--    Nothing
--    (6.39 secs, 6,127,124,136 bytes)
--    λ> menorPrefijoSumaPositiva2 [[-k..k] | k <- [1..500]]
--    Nothing
--    (6.47 secs, 6,124,201,288 bytes)
--    λ> menorPrefijoSumaPositiva3 [[-k..k] | k <- [1..500]]
--    Nothing
--    (0.03 secs, 37,944,760 bytes)

Nuevas soluciones

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

Autonúmeros

Un autonúmero es un número entero n tal que no existe ningún número entero positivo k tal que n sea igual a la suma de k y los dígitos de k. Por ejemplo, 5 es un autonúmero pero 21 no lo es ya que 21=15+1+5.

Definir la lista

   autonumeros :: [Integer]

cuyos elementos son los autonúmeros. Por ejemplo,

   λ> take 20 autonumeros
   [1,3,5,7,9,20,31,42,53,64,75,86,97,108,110,121,132,143,154,165]
   λ> autonumeros !! 1200
   12236

Soluciones

-- 1ª solución
-- ===========
 
autonumeros :: [Integer]
autonumeros = filter autonumero [1..]
 
-- (autonumero n) se verifica si n es un autonúmero. Por ejemplo,
--    autonumero 5  == True
--    autonumero 21 == False
autonumero :: Integer -> Bool
autonumero n =
  all (/=n) [k + sum (digitos k) | k <- [1..n]]
 
-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 325 == [3,2,5]
digitos :: Integer -> [Integer]
digitos a = [read [c] | c <-show a]
 
-- 2ª solución
-- ===========
 
autonumeros2 :: [Integer]
autonumeros2 = map head sucesionSucesionesSumasDigitales
 
-- sucesionSucesionesSumasDigitales es la lista de las sucesiones de
-- sumas parciales tal que el primer elemento de cada sucesión es el
-- menor elemento que no pertenece a las sucesiones anteriores. Por
-- ejemplo,
--    λ> map (take 4) (take 8 sucesionSucesionesSumasDigitales)
--    [[1,2,4,8],[3,6,12,15],[5,10,11,13],[7,14,19,29],
--     [9,18,27,36],[20,22,26,34],[31,35,43,50],[42,48,60,66]]
sucesionSucesionesSumasDigitales :: [[Integer]]
sucesionSucesionesSumasDigitales = aux [1..]
  where aux xs = sucesion xs : aux (diferencia xs (sucesion xs))
        sucesion xs = sucesionSumasDigitales (head xs)
 
-- (diferencia xs ys) es la diferencia las listas infinitas ordenadas
-- crecientes xs e ys. Por ejemplo,
--    λ> take 8 (diferencia [1..] [2,4..])
--    [1,3,5,7,9,11,13,15]
diferencia :: [Integer] -> [Integer] -> [Integer]
diferencia (x:xs) (y:ys)
  | x == y    = diferencia xs ys
  | otherwise = x : diferencia xs (y:ys)
 
-- (sucesionSumasDigitales a) es la sucesión de las sumas digitales
-- definida por un número a. Por ejemplo,
--    λ> take 16 (sucesionSumasDigitales 1)
--    [1,2,4,8,16,23,28,38,49,62,70,77,91,101,103,107]
--    λ> take 16 (sucesionSumasDigitales 3)
--    [3,6,12,15,21,24,30,33,39,51,57,69,84,96,111,114]
--    λ> take 16 (sucesionSumasDigitales 5)
--    [5,10,11,13,17,25,32,37,47,58,71,79,95,109,119,130]
--    λ> take 16 (sucesionSumasDigitales 7)
--    [7,14,19,29,40,44,52,59,73,83,94,107,115,122,127,137]
--    λ> take 16 (sucesionSumasDigitales 9)
--    [9,18,27,36,45,54,63,72,81,90,99,117,126,135,144,153]
--    λ> take 16 (sucesionSumasDigitales 20)
--    [20,22,26,34,41,46,56,67,80,88,104,109,119,130,134,142]
sucesionSumasDigitales :: Integer -> [Integer]
sucesionSumasDigitales a =
  iterate siguienteSumaDigital a
 
-- (siguienteSumaDigital a) es el siguiente de a en la sucesión de sumas
-- digitales. Por ejemplo,
--    siguienteSumaDigital 23 == 28
siguienteSumaDigital :: Integer -> Integer
siguienteSumaDigital a =
  a + sum (digitos a)
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> autonumeros !! 150
--    1502
--    (4.54 secs, 13,302,379,936 bytes)
--    λ> autonumeros2 !! 150
--    1502
--    (0.06 secs, 41,794,872 bytes)

Nuevas soluciones

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

Nuevas soluciones

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

Sucesiones de sumas digitales

La sucesión de las sumas digitales definida por un número a es sucesión a(n) tal que a(0) = a y a(n+1) es la suma de a(n) y los dígitos de a(n). Por ejemplo, los primeros términos de la sucesión de las sumas digitales definida por 1 son

   1,2,4,8,16,23,28,38,49,62,70,77,91,101,103,107,...

Se observa que el menor número que no pertenece a la sucesión anterior es 3. Los primeros términos de la sucesión de las sumas digitales definida por 3 son

   3,6,12,15,21,24,30,33,39,51,57,69,84,96,111,114,...

Se observa que el menor número que no pertenece a las 2 anteriores es 5. Los primeros términos de la sucesión de las sumas digitales definida por 5 son

   5,10,11,13,17,25,32,37,47,58,71,79,95,109,119,130,...

Se observa que el menor número que no pertenece a las 3 sucesiones anteriores es 7. Los primeros términos de la sucesión de las sumas digitales definida por 7 son

   7,14,19,29,40,44,52,59,73,83,94,107,115,122,127,137,...

Se observa que el menor número que no pertenece a las 4 anteriores es 9. Los primeros términos de la sucesión de las sumas digitales definida por 9 son

   9,18,27,36,45,54,63,72,81,90,99,117,126,135,144,153,...

Se observa que el menor número que no pertenece a las 5 sucesiones anteriores es 20. Los primeros términos de la sucesión de las sumas digitales definida por 20 son

   20,22,26,34,41,46,56,67,80,88,104,109,119,130,134,142,...

Definir la función

   sucesionSucesionesSumasDigitales :: [[Integer]]

tal que sus elementos son las sucesiones de sumas parciales tal que el primer elemento de cada sucesión es el menor elemento que no pertenece a las sucesiones anteriores. Por ejemplo,

   λ> map (take 4) (take 8 sucesionSucesionesSumasDigitales)
   [[1,2,4,8],[3,6,12,15],[5,10,11,13],[7,14,19,29],
    [9,18,27,36],[20,22,26,34],[31,35,43,50],[42,48,60,66]]
   λ> take 10 (sucesionSucesionesSumasDigitales3 !! 1000)
   [10199,10219,10232,10240,10247,10261,10271,10282,10295,10312]

Soluciones

-- 1ª solución
-- ===========
 
sucesionSucesionesSumasDigitales :: [[Integer]]
sucesionSucesionesSumasDigitales =
  map aux [1..]
  where aux 1 = sucesionSumasDigitales 1
        aux n = sucesionSumasDigitales m
          where m = head [a | a <- [1..],
                              all (a `noPertenece`)
                                  [aux k | k <- [1..n-1]]]
 
-- (sucesionSumasDigitales a) es la sucesión de las sumas digitales
-- definida por un número a. Por ejemplo,
--    λ> take 16 (sucesionSumasDigitales 1)
--    [1,2,4,8,16,23,28,38,49,62,70,77,91,101,103,107]
--    λ> take 16 (sucesionSumasDigitales 3)
--    [3,6,12,15,21,24,30,33,39,51,57,69,84,96,111,114]
--    λ> take 16 (sucesionSumasDigitales 5)
--    [5,10,11,13,17,25,32,37,47,58,71,79,95,109,119,130]
--    λ> take 16 (sucesionSumasDigitales 7)
--    [7,14,19,29,40,44,52,59,73,83,94,107,115,122,127,137]
--    λ> take 16 (sucesionSumasDigitales 9)
--    [9,18,27,36,45,54,63,72,81,90,99,117,126,135,144,153]
--    λ> take 16 (sucesionSumasDigitales 20)
--    [20,22,26,34,41,46,56,67,80,88,104,109,119,130,134,142]
sucesionSumasDigitales :: Integer -> [Integer]
sucesionSumasDigitales a =
  iterate siguienteSumaDigital a
 
-- (siguienteSumaDigital a) es el siguiente de a en la sucesión de sumas
-- digitales. Por ejemplo,
--    siguienteSumaDigital 23 == 28
siguienteSumaDigital :: Integer -> Integer
siguienteSumaDigital a =
  a + sum (digitos a)
 
-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 325 == [3,2,5]
digitos :: Integer -> [Integer]
digitos a = [read [c] | c <-show a]
 
-- (noPertenece x ys) se verifica si x no pertenece a la lista infinita
-- ordenada creciente ys. Por ejemplo,
--    noPertenece 2 [1,3..] == True
--    noPertenece 5 [1,3..] == False
noPertenece :: Integer -> [Integer] -> Bool
noPertenece x ys =
  x < head (dropWhile (<x) ys)
 
-- 2ª solución
-- ===========
 
sucesionSucesionesSumasDigitales2 :: [[Integer]]
sucesionSucesionesSumasDigitales2 =
  map sucesionSumasDigitales autonumeros
 
-- (autonumero n) se verifica si n es un autonúmero; es decir, números
-- que no se pueden escribir como la suma de un número k y los dígitos
-- de k. Por ejemplo,
--    autonumero 5  == True
--    autonumero 21 == False
autonumero :: Integer -> Bool
autonumero n =
  all (/=n) [k + sum (digitos k) | k <- [1..n]]
 
-- autonumeros es la lista de los autonúmeros. Por ejemplo,
--    λ> take 20 autonumeros
--    [1,3,5,7,9,20,31,42,53,64,75,86,97,108,110,121,132,143,154,165]
autonumeros :: [Integer]
autonumeros = filter autonumero [1..]
 
-- 3ª solución
-- ===========
 
sucesionSucesionesSumasDigitales3 :: [[Integer]]
sucesionSucesionesSumasDigitales3 = aux [1..]
  where aux xs = sucesion xs : aux (diferencia xs (sucesion xs))
        sucesion xs = sucesionSumasDigitales (head xs)
 
-- (diferencia xs ys) es la diferencia las listas infinitas ordenadas
-- crecientes xs e ys. Por ejemplo,
--    λ> take 8 (diferencia [1..] [2,4..])
--    [1,3,5,7,9,11,13,15]
diferencia :: [Integer] -> [Integer] -> [Integer]
diferencia (x:xs) (y:ys)
  | x == y    = diferencia xs ys
  | otherwise = x : diferencia xs (y:ys)

Nuevas soluciones

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

Coste del recorrido ordenado

El coste de visitar los elementos de la lista [4,3,2,5,1] de manera creciente empezando en el primer elemento y siendo el coste de dada paso el valor absoluto de la diferencia de las posiciones se calcula de la siguiente manera

  • Coste de 4 a 1 = |0-4| = 4
  • Coste de 1 a 2 = |4-2| = 2
  • Coste de 2 a 3 = |2-1| = 1
  • Coste de 3 a 4 = |1-0| = 1
  • Coste de 4 a 5 = |0-3| = 3

Por tanto, el coste del recorrido es 4+2+1+1+3 = 11.

Definir la función coste :: Ord a => [a] -> Int tal que (coste xs) es el coste de visitar los elementos de xs de manera creciente empezando en el primer elemento y siendo el coste de dada paso el valor absoluto de la diferencia de las posiciones (se supone que los elementos de xs son distintos). Por ejemplo,

   coste [4,3,2,5,1] ==  11
   coste "betis"     ==  6

Soluciones

import Data.List (sort)
 
coste :: Ord  a => [a] -> Int
coste xs =
  sum [abs (i-j) | (i,j) <- zip aux (tail aux)]
  where aux = recorrido xs
 
-- (recorrido xs) esla lista de las posiciones al visitar los elementos
-- de xs de manera creciente empezando en el primer elemento. Por
-- ejemplo,
--    recorrido [4,3,2,5,1] == [0,4,2,1,0,3]
recorrido :: Ord  a => [a] -> [Int]
recorrido xs =
  0 : map snd (sort (zip xs [0..]))

Nuevas soluciones

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

Mínimo número de divisiones para igualar

El mínimo número de divisiones por 2, 3 ó 5 que hay que realizar igualar 15 y 20 es 6. En efecto, 15 se reduce a 5 dividiéndolo por 3 y 20 se reduce a 5 diviéndolo dos veces por 2.

Definir la función

   minimoNumeroDivisiones :: Integer -> Integer -> Maybe Int

tal que (minimoNumeroDivisiones x y) es justamente el mínimo número de divisiones por 2, 3 ó 5 que hay que realizar para igualar x e y, o Nothing si no se pueden igualar. Por ejemplo,

   minimoNumeroDivisiones 15 20       ==  Just 3
   minimoNumeroDivisiones 15 15       ==  Just 0
   minimoNumeroDivisiones 15 16       ==  Just 6
   minimoNumeroDivisiones 15 17       ==  Nothing
   minimoNumeroDivisiones (10^99) 21  ==  Nothing

Soluciones

import Data.List (group, intersect, nub, sort)
import Data.Maybe (fromJust, isNothing, listToMaybe)
import Data.Numbers.Primes (primeFactors)
import Data.Tree (Tree (Node), flatten, levels)
import Test.QuickCheck (Property, (==>), quickCheck)
 
-- 1ª solución
-- ===========
 
minimoNumeroDivisiones :: Integer -> Integer -> Maybe Int
minimoNumeroDivisiones x y
  | isNothing a = Nothing
  | otherwise   = Just (fst (fromJust a))
  where a = minimoNumeroDivisionesAux x y
 
-- La definición anterior se puede simplificar
minimoNumeroDivisiones' :: Integer -> Integer -> Maybe Int
minimoNumeroDivisiones' x y =
  Just fst <*> minimoNumeroDivisionesAux x y
 
-- (minimoNumeroDivisiones x y) es justamente el par formado por el
-- mínimo número de divisiones por 2, 3 ó 5 que hay que realizar para
-- igualar x e y junto con el número al que se reducen, o Nothing si no
-- se pueden igualar. Por ejemplo,
--    minimoNumeroDivisionesAux 15 20  ==  Just (3,5)
--    minimoNumeroDivisionesAux 15 15  ==  Just (0,15)
--    minimoNumeroDivisionesAux 15 16  ==  Just (6,1)
--    minimoNumeroDivisionesAux 15 17  ==  Nothing
minimoNumeroDivisionesAux :: Integer -> Integer -> Maybe (Int,Integer)
minimoNumeroDivisionesAux x y
  | null as   = Nothing
  | otherwise = Just (head as)
  where as = sort [(m+n,z) | (z,(m,n)) <- minimasProfundidadesComunes x y]
 
-- La definición anterior se puede simplificar
minimoNumeroDivisionesAux2 :: Integer -> Integer -> Maybe (Int,Integer)
minimoNumeroDivisionesAux2 x y =
  listToMaybe (sort [(m+n,z) | (z,(m,n)) <- minimasProfundidadesComunes x y])
 
-- (arbolDivisiones x) es el árbol de las divisiones enteras de x entre
-- 2, 3 ó 5. Por ejemplo,
--    λ> putStrLn (drawTree (fmap show (arbolDivisiones 30)))
--    30
--    |
--    +- 15
--    |  |
--    |  +- 5
--    |  |  |
--    |  |  `- 1
--    |  |
--    |  `- 3
--    |     |
--    |     `- 1
--    |
--    +- 10
--    |  |
--    |  +- 5
--    |  |  |
--    |  |  `- 1
--    |  |
--    |  `- 2
--    |     |
--    |     `- 1
--    |
--    `- 6
--       |
--       +- 3
--       |  |
--       |  `- 1
--       |
--       `- 2
--          |
--          `- 1
arbolDivisiones :: Integer -> Tree Integer
arbolDivisiones x =
  Node x (map arbolDivisiones (divisiones x))
 
-- (divisiones x) es la lista de las divisiones enteras de x entre 2, 3
-- y 5. Por ejemplo,
--    divisiones 30  ==  [15,10,6]
--    divisiones 15  ==  [5,3]
divisiones :: Integer -> [Integer]
divisiones x =
  [x `div` y | y <- [2,3,5], x `mod` y == 0]
 
-- (nodos a) es el conjunto de nodos del árbol a. Por ejemplo,
--    nodos (Node 2 [Node 2 [], Node 5 []])  ==  [2,5]
--    nodos (arbolDivisiones 30)  ==  [30,15,5,1,3,10,2,6]
nodos :: Tree Integer -> [Integer]
nodos = nub . flatten
 
-- (divisionesComunes x y) es la lista de los nodos comunes de los
-- árboles de las divisiones de x e y entre 2, 3 ó 5. Por ejemplo,
--    divisionesComunes 15 20  ==  [5,1]
divisionesComunes :: Integer -> Integer -> [Integer]
divisionesComunes x y =
  nodos (arbolDivisiones x) `intersect` nodos (arbolDivisiones y)
 
-- (minimaProfundidad x ns) es justamente la mínima produndidad
-- donde aparece x en el árbol ns, si aparece y Nothing, en caso
-- contrario. Por ejemplo,minimaProfundidad :: Ord a => a -> Tree a -> Maybe Int
--    λ> minimaProfundidad 3 (Node 1 [Node 6 [],Node 3 [Node 1 []]])
--    Just 1
--    λ> minimaProfundidad 4 (Node 1 [Node 6 [],Node 3 [Node 1 []]])
--    Nothing
minimaProfundidad :: Ord a => a -> Tree a -> Maybe Int
minimaProfundidad x ns =
  listToMaybe [z | (z,ys) <- zip [0..] (levels ns), x `elem` ys]
 
-- (minimasProfundidadesComunes x e y) es la lista de pares formadas por
-- los nodos comunes de los árboles de las divisiones de x e y entre 2,
-- 3 ó 5 junto con las mínimas profundidades en cada uno de los
-- árboles. Por ejemplo,
--    minimasProfundidadesComunes 15 20  ==  [(5,(1,2)),(1,(2,3))]
--    minimasProfundidadesComunes 15 22  ==  []
minimasProfundidadesComunes :: Integer -> Integer -> [(Integer,(Int,Int))]
minimasProfundidadesComunes x1 x2 =
  [(c,(fromJust (minimaProfundidad c a1), fromJust (minimaProfundidad c a2)))
  | c <- cs]
  where a1 = arbolDivisiones x1
        a2 = arbolDivisiones x2
        cs = divisionesComunes x1 x2
 
-- Propiedad
-- =========
 
-- El mínimo número de divisiones se alcanza en el máximo común divisor.
prop_minimoNumeroDivisiones :: Integer -> Integer -> Property
prop_minimoNumeroDivisiones x y =
  x > 0 && y > 0 ==>
  isNothing a || snd (fromJust a) == gcd x y
  where a = minimoNumeroDivisionesAux x y
 
-- La comprobación es
--    λ> quickCheck prop_minimoNumeroDivisiones
--    +++ OK, passed 100 tests.
 
-- 2ª solución
-- ===========
 
minimoNumeroDivisiones2 :: Integer -> Integer -> Maybe Int
minimoNumeroDivisiones2 x y
  | as' == bs' = Just (sum [abs (a - b) | (a,b) <- zip as bs])
  | otherwise  = Nothing
  where (as,as') = factorizacion x
        (bs,bs') = factorizacion y
 
-- (factorización n) es la lista de pares cuya primera componente es la
-- lista de los exponentes de 2, 3 y 5 en la factorización de n y la
-- segunda esla lista delos restantes divisores primos. Por ejemplo,
--    factorizacion 15   ==  ([0,1,1],[])
--    factorizacion 20   ==  ([2,0,1],[])
--    factorizacion 17   ==  ([0,0,0],[17])
--    factorizacion 147  ==  ([0,1,0],[7,7])
factorizacion :: Integer -> ([Int],[Integer])
factorizacion n =
  (map length [bs,cs,ds], es)
  where as = primeFactors n
        (bs,bs') = span (==2) as
        (cs,cs') = span (==3) bs'
        (ds,es)  = span (==5) cs'
 
-- Equivalencia
-- ============
 
-- La propies de la equivalencia de las dos definiciones es
prop_equivalencia :: Integer -> Integer -> Property
prop_equivalencia x y =
  x > 0 && y > 0 ==>
  minimoNumeroDivisiones x y == minimoNumeroDivisiones2 x y
 
-- La comprobación es
--    λ> quickCheck prop_equivalencia
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
--    λ> minimoNumeroDivisiones (10^11) (3^10*7)
--    Nothing
--    (6.08 secs, 2,725,931,872 bytes)
--    λ> minimoNumeroDivisiones2(10^11) (3^10*7)
--    Nothing
--    (0.01 secs, 128,944 bytes)

Nuevas soluciones

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

Mínima profundidad

En la librería Data.Tree se definen los árboles y los bosques como sigue

   data Tree a   = Node a (Forest a)
   type Forest a = [Tree a]

Por ejemplo, los árboles

     1               3
    / \             /|\
   6   3           / | \
       |          5  4  7
       1          |     /\
                  3    6  5

se representan por

   ej1, ej2 :: Tree Int
   ej1 = Node 1 [Node 6 [],Node 3 [Node 1 []]]
   ej2 = Node 3 [Node 5 [Node 3 []], Node 4 [], Node 7 [Node 6 [], Node 5 []]]

Definir la función

    minimaProfundidad :: Ord a => a -> Tree a -> Maybe Int

tal que (minimaProfundidad x ns) es justamente la mínima donde aparece x en el árbol ns, si aparece y Nothing, en caso contrario. Por ejemplo,

    minimaProfundidad 1 ej1  ==  Just 0
    minimaProfundidad 3 ej1  ==  Just 1
    minimaProfundidad 2 ej1  ==  Nothing
    minimaProfundidad 3 ej2  ==  Just 0
    minimaProfundidad 4 ej2  ==  Just 1
    minimaProfundidad 6 ej2  ==  Just 2
    minimaProfundidad 9 ej2  ==  Nothing

Soluciones

import Data.Tree (Tree (Node), levels)
import Data.Maybe (isNothing, fromJust, listToMaybe)
 
ej1, ej2 :: Tree Int
ej1 = Node 1 [Node 6 [],Node 3 [Node 1 []]]
ej2 = Node 3 [Node 5 [Node 3 []], Node 4 [], Node 7 [Node 6 [], Node 5 []]]
 
-- 1ª definición
minimaProfundidad1 :: Ord a => a -> Tree a -> Maybe Int
minimaProfundidad1 x (Node y ns)
  | x == y    = Just 0
  | null zs   = Nothing
  | otherwise = Just (1 + minimum zs)
  where zs = [z | Just z <- filter (/=Nothing) (map (minimaProfundidad1 x) ns)]
 
-- 2ª definición
minimaProfundidad2 :: Ord a => a -> Tree a -> Maybe Int
minimaProfundidad2 x (Node y ns)
  | x == y       = Just 0
  | z == Nothing = Nothing
  | otherwise    = Just (1 + fromJust z)
  where z = minimum (map (minimaProfundidad2 x) ns)
 
-- 3ª definición
minimaProfundidad3 :: Ord a => a -> Tree a -> Maybe Int
minimaProfundidad3 x (Node y ns)
  | x == y       = Just 0
  | otherwise    = Just (+1) <*> minimum (map (minimaProfundidad3 x) ns)
 
-- 4ª definición
minimaProfundidad4 :: Ord a => a -> Tree a -> Maybe Int
minimaProfundidad4 x ns
  | null zs   = Nothing
  | otherwise = Just (head zs)
  where zs = [z | (z,ys) <- zip [0..] (levels ns), x `elem` ys]
 
-- 5ª definición
minimaProfundidad5 :: Ord a => a -> Tree a -> Maybe Int
minimaProfundidad5 x ns =
  listToMaybe [z | (z,ys) <- zip [0..] (levels ns), x `elem` ys]

Nuevas soluciones

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

Árbol de las divisiones por 2, 3 ó 5

En la librería Data.Tree se definen los árboles y los bosques como sigue

   data Tree a   = Node a (Forest a)
   type Forest a = [Tree a]

Se pueden definir árboles. Por ejemplo,

   ej = Node 3 [Node 5 [Node 9 []], Node 7 []]

Y se pueden dibujar con la función drawTree. Por ejemplo,

   λ> putStrLn (drawTree (fmap show ej))
   3
   |
   +- 5
   |  |
   |  `- 9
   |
   `- 7

Definir la función

   arbolDivisiones :: Int -> Tree Int

tal que (arbolDivisiones x) es el árbol de las divisiones enteras de x entre 2, 3 ó 5. Por ejemplo,

   λ> putStrLn (drawTree (fmap show (arbolDivisiones 20)))
   20
   |
   +- 10
   |  |
   |  +- 5
   |  |  |
   |  |  `- 1
   |  |
   |  `- 2
   |     |
   |     `- 1
   |
   `- 4
      |
      `- 2
         |
         `- 1
 
   λ> putStrLn (drawTree (fmap show (arbolDivisiones 30)))
   30
   |
   +- 15
   |  |
   |  +- 5
   |  |  |
   |  |  `- 1
   |  |
   |  `- 3
   |     |
   |     `- 1
   |
   +- 10
   |  |
   |  +- 5
   |  |  |
   |  |  `- 1
   |  |
   |  `- 2
   |     |
   |     `- 1
   |
   `- 6
      |
      +- 3
      |  |
      |  `- 1
      |
      `- 2
         |
         `- 1

Soluciones

import Data.Tree (Tree (Node), drawTree)
 
arbolDivisiones :: Int -> Tree Int
arbolDivisiones x =
  Node x (map arbolDivisiones (divisiones x))
 
-- (divisiones x) es la lista de las divisiones enteras de x entre 2, 3
-- y 5. Por ejemplo,
--    divisiones 30  ==  [15,10,6]
--    divisiones 15  ==  [5,3]
divisiones :: Int -> [Int]
divisiones x =
  [x `div` y | y <- [2,3,5], x `mod` y == 0]

Nuevas soluciones

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

Cálculo de pi mediante la fórmula de Beeler

El pasado 12 de marzo se publicó en Twitter un mensaje con una fórmula de Beeler para el cálculo de pi

Los primeros valores son

   λ> 2*1
   2
   λ> 2*(1+1/3)
   2.6666666666666665
   λ> 2*(1+1/3+(1*2)/(3*5))
   2.933333333333333
   λ> 2*(1+1/3+(1*2)/(3*5)+(1*2*3)/(3*5*7))
   3.0476190476190474
   λ> 2*(1+1/3+(1*2)/(3*5)+(1*2*3)/(3*5*7)+(1*2*3*4)/(3*5*7*9))
   3.098412698412698

Definir las funciones

   aproximacionPi :: Int -> Double
   grafica        :: [Int] -> IO ()

tales que

  • (aproximacionPi n) es la n-ésima aproximación de pi con la fórmula de Beeler. Por ejemplo,
     aproximacionPi 0    ==  2.0
     aproximacionPi 1    ==  2.6666666666666665
     aproximacionPi 2    ==  2.933333333333333
     aproximacionPi 3    ==  3.0476190476190474
     aproximacionPi 4    ==  3.098412698412698
     aproximacionPi 10   ==  3.141106021601377
     aproximacionPi 100  ==  3.1415926535897922
     pi                  ==  3.141592653589793
  • (grafica xs) dibuja la gráfica de las k-ésimas aproximaciones de pi para k en xs. Por ejemplo, (grafica [0..99]) dibuja

Soluciones

import Graphics.Gnuplot.Simple (Attribute (Key, PNG), plotList)
 
aproximacionPi :: Int -> Double
aproximacionPi n =
  aproximacionesPi !! n
 
aproximacionesPi :: [Double]
aproximacionesPi =
  map (*2) (scanl1 (+) (1 : scanl1 (*) [(x/y) | (x,y) <- zip [1..] [3,5..]]))
 
 
-- Gráfica
-- =======
 
grafica :: [Int] -> IO ()
grafica xs =
  plotList [ Key Nothing
           -- , PNG "Calculo_de_pi_mediante_la_formula_de_Beeler_1.png"
           ]
           [(k,aproximacionPi k) | k <- xs]

Nuevas soluciones

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

Números ordenados con cuadrados ordenados

Un número es ordenado si cada uno de sus dígitos es menor o igual el siguiente dígito. Por ejemplo, 116 es un número creciente y su cuadrado es 13456, que también es ordenado. En cambio, 115 es ordenado pero su cuadrado es 13225 que no es ordenado.

Definir la lista

   numerosOrdenadosConCuadradosOrdenados :: [Integer]

cuyos elementos son los números ordenados cuyos cuadrados también lo son. Por ejemplo,

   λ> take 20 numerosOrdenadosConCuadradosOrdenados
   [0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117]
   λ> length (show (numerosOrdenadosConCuadradosOrdenados !! (10^6)))
   1411
   λ> length (show (numerosOrdenadosConCuadradosOrdenados !! (5*10^6)))
   3159

Soluciones

import Data.List
 
-- 1ª solución
-- ===========
 
numerosOrdenadosConCuadradosOrdenados :: [Integer]
numerosOrdenadosConCuadradosOrdenados =
  filter numeroOrdenadoConCuadradoOrdenado [0..]
 
-- (numeroOrdenadoConCuadradoOrdenado n) se verifica si n es un número
-- ordenado cuyo cuadrado también lo es. Por ejemplo,
--    numeroOrdenadoConCuadradoOrdenado 116  ==  True
--    numeroOrdenadoConCuadradoOrdenado 115  ==  False
numeroOrdenadoConCuadradoOrdenado :: Integer -> Bool
numeroOrdenadoConCuadradoOrdenado n =
  ordenado n && ordenado (n^2)
 
-- (ordenado n) se verifica si n es un número ordenado. Por ejemplo,
--    ordenado 115  ==  True
--    ordenado 151  ==  False
ordenado :: Integer -> Bool
ordenado n =
  and [x <= y | (x,y) <- zip xs (tail xs)]
  where xs = show n
 
-- 2ª solución
-- ===========
 
-- Se basa en la observación de los sisuientes cálculos con la primera
-- solución
--    λ> take 30 numerosOrdenadosConCuadradosOrdenados
--    [0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117,
--     167,334,335,337,367,667,1667,3334,3335,3337]
--    λ> take 21 (dropWhile (<= 117) numerosOrdenadosConCuadradosOrdenados)
--    [167,334,335,337,367,667,
--     1667,3334,3335,3337,3367,3667,6667,
--     16667,33334,33335,33337,33367,33667,36667,66667]
--
-- Se observa que a partir del 167 todos los elementos son de 4 tipos
-- como se ve en la siguente tabla
--    |-------+--------+--------+--------+--------|
--    |       | Tipo A | Tipo B | Tipo C | Tipo D |
--    |-------+--------+--------+--------+--------|
--    |   167 | 16¹7   |        |        |        |
--    |   334 |        | 3²4    |        |        |
--    |   335 |        |        | 3²5    |        |
--    |   337 |        |        |        | 3²6⁰7  |
--    |   367 |        |        |        | 3¹6¹7  |
--    |   667 |        |        |        | 3⁰6²7  |
--    |  1667 | 16²7   |        |        |        |
--    |  3334 |        | 3³4    |        |        |
--    |  3335 |        |        | 3³5    |        |
--    |  3337 |        |        |        | 3³6⁰7  |
--    |  3367 |        |        |        | 3²6¹7  |
--    |  3667 |        |        |        | 3¹6²7  |
--    |  6667 |        |        |        | 3⁰6³7  |
--    | 16667 | 16³7   |        |        |        |
--    | 33334 |        | 3⁴4    |        |        |
--    | 33335 |        |        | 3⁴5    |        |
--    | 33337 |        |        |        | 3⁴6⁰7  |
--    | 33367 |        |        |        | 3³6¹7  |
--    | 33667 |        |        |        | 3²6²7  |
--    | 36667 |        |        |        | 3¹6³7  |
--    | 66667 |        |        |        | 3⁰6⁴7  |
--    |-------+--------+--------+--------+--------|
-- donde el exponente en cad dígito indica el número de repeticiones de
-- dicho dígito.
 
numerosOrdenadosConCuadradosOrdenados2 :: [Integer]
numerosOrdenadosConCuadradosOrdenados2 =
  [0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117] ++
  map read (concat [['1' : replicate n '6' ++ "7",
                     replicate (n+1) '3' ++ "4",
                     replicate (n+1) '3' ++ "5"] ++
                    [replicate a '3' ++ replicate b '6' ++ "7"
                    | b <- [0..n+1], let a = (n+1) - b]
                   | n <- [1..]])
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> numerosOrdenadosConCuadradosOrdenados !! 50
--    1666667
--    (2.35 secs, 2,173,983,096 bytes)
--    λ> numerosOrdenadosConCuadradosOrdenados2 !! 50
--    1666667
--    (0.01 secs, 125,296 bytes)
 
-- Comprobación de equivalencia
-- ============================
 
-- La comprobación es
--    λ> take 50 numerosOrdenadosConCuadradosOrdenados == take 50 numerosOrdenadosConCuadradosOrdenados2
--    True

Nuevas soluciones

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