not – Exercitium

Sucesión de sumas de dos números abundantes

José A. Alonso, 17-mayo-2022, Ejercicio

Un número n es abundante si la suma de los divisores propios de n es mayor que n. El primer número abundante es el 12 (cuyos divisores propios son 1, 2, 3, 4 y 6 cuya suma es 16). Por tanto, el menor número que es la suma de dos números abundantes es el 24.

Definir la sucesión

   sumasDeDosAbundantes :: [Integer]

cuyos elementos son los números que se pueden escribir como suma de dos números abundantes. Por ejemplo,

   take 10 sumasDeDosAbundantes  ==  [24,30,32,36,38,40,42,44,48,50]

Soluciones

import Data.List (genericLength, group)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
sumasDeDosAbundantes1 :: [Integer]
sumasDeDosAbundantes1 = [n | n <- [1..], esSumaDeDosAbundantes n]
 
-- (esSumaDeDosAbundantes n) se verifica si n es suma de dos números
-- abundantes. Por ejemplo,
--    esSumaDeDosAbundantes 24           ==  True
--    any esSumaDeDosAbundantes [1..22]  ==  False
esSumaDeDosAbundantes :: Integer -> Bool
esSumaDeDosAbundantes n = (not . null) [x | x <- xs, n-x `elem` xs]
  where xs = takeWhile (<n) abundantes
 
-- abundantes es la lista de los números abundantes. Por ejemplo,
--    take 10 abundantes  ==  [12,18,20,24,30,36,40,42,48,54]
abundantes :: [Integer]
abundantes = [n | n <- [2..], abundante n]
 
-- (abundante n) se verifica si n es abundante. Por ejemplo,
--    abundante 12  ==  True
--    abundante 11  ==  False
abundante :: Integer -> Bool
abundante n = sum (divisores n) > n
 
-- (divisores n) es la lista de los divisores propios de n. Por ejemplo,
--    divisores 12  ==  [1,2,3,4,6]
divisores :: Integer -> [Integer]
divisores n = [x | x <- [1..n `div` 2], n `mod` x == 0]
 
-- 2ª solución
-- ===========
 
sumasDeDosAbundantes2 :: [Integer]
sumasDeDosAbundantes2 = filter esSumaDeDosAbundantes2 [1..]
 
esSumaDeDosAbundantes2 :: Integer -> Bool
esSumaDeDosAbundantes2 n = (not . null) [x | x <- xs, n-x `elem` xs]
  where xs = takeWhile (<n) abundantes2
 
abundantes2 :: [Integer]
abundantes2 = filter abundante2 [2..]
 
abundante2 :: Integer -> Bool
abundante2 n = sumaDivisores n > n
 
sumaDivisores :: Integer -> Integer
sumaDivisores x =
  product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x] - x
 
-- (factorizacion x) es la lista de las bases y exponentes de la
-- descomposición prima de x. Por ejemplo,
--    factorizacion 600  ==  [(2,3),(3,1),(5,2)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion = map primeroYlongitud . group . primeFactors
 
-- (primeroYlongitud xs) es el par formado por el primer elemento de xs
-- y la longitud de xs. Por ejemplo,
--    primeroYlongitud [3,2,5,7] == (3,4)
primeroYlongitud :: [a] -> (a,Integer)
primeroYlongitud (x:xs) =
  (x, 1 + genericLength xs)
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_sumasDeDosAbundantes :: Positive Int -> Bool
prop_sumasDeDosAbundantes (Positive n) =
  sumasDeDosAbundantes1 !! n == sumasDeDosAbundantes2 !! n
 
-- La comprobación es
--    λ> quickCheck prop_sumasDeDosAbundantes
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> sumasDeDosAbundantes1 !! (2*10^3)
--    2887
--    (2.54 secs, 516,685,168 bytes)
--    λ> sumasDeDosAbundantes2 !! (2*10^3)
--    2887
--    (1.43 secs, 141,606,136 bytes)

import Data.List (genericLength, group) import Data.Numbers.Primes (primeFactors) import Test.QuickCheck -- 1ª solución -- =========== sumasDeDosAbundantes1 :: [Integer] sumasDeDosAbundantes1 = [n | n <- [1..], esSumaDeDosAbundantes n] -- (esSumaDeDosAbundantes n) se verifica si n es suma de dos números -- abundantes. Por ejemplo, -- esSumaDeDosAbundantes 24 == True -- any esSumaDeDosAbundantes [1..22] == False esSumaDeDosAbundantes :: Integer -> Bool esSumaDeDosAbundantes n = (not . null) [x | x <- xs, n-x `elem` xs] where xs = takeWhile (<n) abundantes -- abundantes es la lista de los números abundantes. Por ejemplo, -- take 10 abundantes == [12,18,20,24,30,36,40,42,48,54] abundantes :: [Integer] abundantes = [n | n <- [2..], abundante n] -- (abundante n) se verifica si n es abundante. Por ejemplo, -- abundante 12 == True -- abundante 11 == False abundante :: Integer -> Bool abundante n = sum (divisores n) > n -- (divisores n) es la lista de los divisores propios de n. Por ejemplo, -- divisores 12 == [1,2,3,4,6] divisores :: Integer -> [Integer] divisores n = [x | x <- [1..n `div` 2], n `mod` x == 0] -- 2ª solución -- =========== sumasDeDosAbundantes2 :: [Integer] sumasDeDosAbundantes2 = filter esSumaDeDosAbundantes2 [1..] esSumaDeDosAbundantes2 :: Integer -> Bool esSumaDeDosAbundantes2 n = (not . null) [x | x <- xs, n-x `elem` xs] where xs = takeWhile (<n) abundantes2 abundantes2 :: [Integer] abundantes2 = filter abundante2 [2..] abundante2 :: Integer -> Bool abundante2 n = sumaDivisores n > n sumaDivisores :: Integer -> Integer sumaDivisores x = product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x] - x -- (factorizacion x) es la lista de las bases y exponentes de la -- descomposición prima de x. Por ejemplo, -- factorizacion 600 == [(2,3),(3,1),(5,2)] factorizacion :: Integer -> [(Integer,Integer)] factorizacion = map primeroYlongitud . group . primeFactors -- (primeroYlongitud xs) es el par formado por el primer elemento de xs -- y la longitud de xs. Por ejemplo, -- primeroYlongitud [3,2,5,7] == (3,4) primeroYlongitud :: [a] -> (a,Integer) primeroYlongitud (x:xs) = (x, 1 + genericLength xs) -- Comprobación de equivalencia -- ============================ -- La propiedad es prop_sumasDeDosAbundantes :: Positive Int -> Bool prop_sumasDeDosAbundantes (Positive n) = sumasDeDosAbundantes1 !! n == sumasDeDosAbundantes2 !! n -- La comprobación es -- λ> quickCheck prop_sumasDeDosAbundantes -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> sumasDeDosAbundantes1 !! (2*10^3) -- 2887 -- (2.54 secs, 516,685,168 bytes) -- λ> sumasDeDosAbundantes2 !! (2*10^3) -- 2887 -- (1.43 secs, 141,606,136 bytes)

El código se encuentra en GitHub.

Leer más →

Elementos de una matriz con algún vecino menor

José A. Alonso, 7-abril-2022, Ejercicio

Las matrices pueden representarse mediante tablas cuyos índices son pares de números naturales. Su tipo se define por

   type Matriz = Array (Int,Int) Int

Por ejemplo, la matriz

   |9 4 6 5|
   |8 1 7 3|
   |4 2 5 4|

se define por

   ej :: Matriz
   ej = listArray ((1,1),(3,4)) [9,4,6,5,8,1,7,3,4,2,5,4]

Los vecinos de un elemento son los que están a un paso en la misma fila, columna o diagonal. Por ejemplo, en la matriz anterior, el 1 tiene 8 vecinos (el 9, 4, 6, 8, 7, 4, 2 y 5) pero el 9 sólo tiene 3 vecinos (el 4, 8 y 1).

Definir la función

   algunoMenor :: Matriz -> [Int]

tal que (algunoMenor p) es la lista de los elementos de p que tienen algún vecino menor que él. Por ejemplo,

   algunoMenor ej == [9,4,6,5,8,7,4,2,5,4]

pues sólo el 1 y el 3 no tienen ningún vecino menor en la matriz.

Soluciones

import Data.Array (Array, (!), bounds, indices, inRange, listArray)
import Test.QuickCheck (Arbitrary, Gen, arbitrary, chooseInt, quickCheck,
                        vectorOf)
 
type Matriz = Array (Int,Int) Int
 
ej :: Matriz
ej = listArray ((1,1),(3,4)) [9,4,6,5,8,1,7,3,4,2,5,4]
 
type Pos = (Int,Int)
 
-- 1ª solución
-- ===========
 
algunoMenor1 :: Matriz -> [Int]
algunoMenor1 a =
  [a!p| p <- indices a,
        any (< a!p) (vecinos1 a p)]
 
-- (vecinos q p) es la lista de los vecinos en la matriz a de la
-- posición p. Por ejemplo,
--    vecinos1 ej (2,2)  ==  [9,4,6,8,7,4,2,5]
--    vecinos1 ej (1,1)  ==  [4,8,1]
vecinos1 :: Matriz -> Pos -> [Int]
vecinos1 a p =
  [a!p' | p' <- posicionesVecinos1 a p]
 
-- (posicionesVecinos a p) es la lista de las posiciones de los
-- vecino de p en la matriz a. Por ejemplo,
--    λ> posicionesVecinos1 3 3 (2,2)
--    [(1,1),(1,2),(1,3),(2,1),(2,3),(3,1),(3,2),(3,3)]
--    λ> posicionesVecinos1 3 3 (1,1)
--    [(1,2),(2,1),(2,2)]
posicionesVecinos1 :: Matriz -> Pos -> [Pos]
posicionesVecinos1 a (i,j) =
  [(i+di,j+dj) | (di,dj) <- [(-1,-1),(-1,0),(-1,1),
                             ( 0,-1),       ( 0,1),
                             ( 1,-1),( 1,0),( 1,1)],
                 inRange (bounds a) (i+di,j+dj)]
 
-- 2ª solución
-- ===========
 
algunoMenor2 :: Matriz -> [Int]
algunoMenor2 a =
  [a!p | p <- indices a,
         any (<a!p) (vecinos2 p)]
  where
    vecinos2 p =
      [a!p' | p' <- posicionesVecinos2 p]
    posicionesVecinos2 (i,j) =
      [(i+di,j+dj) | (di,dj) <- [(-1,-1),(-1,0),(-1,1),
                                 ( 0,-1),       ( 0,1),
                                 ( 1,-1),( 1,0),( 1,1)],
                     inRange (bounds a) (i+di,j+dj)]
 
-- 3ª solución
-- ===========
 
algunoMenor3 :: Matriz -> [Int]
algunoMenor3 a =
  [a!p | p <- indices a,
         any (<a!p) (vecinos3 p)]
  where
    vecinos3 p =
      [a!p' | p' <- posicionesVecinos3 p]
    posicionesVecinos3 (i,j) =
      [(i',j') | i' <- [i-1..i+1],
                 j' <- [j-1..j+1],
                 (i',j') /= (i,j),
                 inRange (bounds a) (i',j')]
 
-- 4ª solución
-- ===========
 
algunoMenor4 :: Matriz -> [Int]
algunoMenor4 a =
  [a!p | p <- indices a,
         any (<a!p) (vecinos4 p)]
  where
    vecinos4 p =
      [a!p' | p' <- posicionesVecinos4 p]
    posicionesVecinos4 (i,j) =
      [(i',j') | i' <- [max 1 (i-1)..min m (i+1)],
                 j' <- [max 1 (j-1)..min n (j+1)],
                 (i',j') /= (i,j)]
      where (_,(m,n)) = bounds a
 
 
-- 5ª solución
-- ===========
 
algunoMenor5 :: Matriz -> [Int]
algunoMenor5 a =
  [a!p | p <- indices a,
         any (<a!p) (vecinos5 p)]
  where
    vecinos5 p =
      [a!p' | p' <- posicionesVecinos5 p]
    posicionesVecinos5 (i,j) =
      [(i-1,j-1) | i > 1, j > 1] ++
      [(i-1,j)   | i > 1]        ++
      [(i-1,j+1) | i > 1, j < n] ++
      [(i,j-1)   | j > 1]        ++
      [(i,j+1)   | j < n]        ++
      [(i+1,j-1) | i < m, j > 1] ++
      [(i+1,j)   | i < m]        ++
      [(i+1,j+1) | i < m, j < n]
      where (_,(m,n)) = bounds a
 
-- ---------------------------------------------------------------------
 
-- Comprobación de equivalencia
-- ============================
 
newtype Matriz2 = M Matriz
  deriving Show
 
-- Generador de matrices arbitrarias. Por ejemplo,
--    λ> generate matrizArbitraria
--    M (array ((1,1),(3,4))
--             [((1,1),18),((1,2),6), ((1,3),-23),((1,4),-13),
--              ((2,1),-2),((2,2),22),((2,3),-25),((2,4),-5),
--              ((3,1),2), ((3,2),16),((3,3),-15),((3,4),7)])
matrizArbitraria :: Gen Matriz2
matrizArbitraria = do
  m  <- chooseInt (1,10)
  n  <- chooseInt (1,10)
  xs <- vectorOf (m*n) arbitrary
  return (M (listArray ((1,1),(m,n)) xs))
 
-- Matriz es una subclase de Arbitrary.
instance Arbitrary Matriz2 where
  arbitrary = matrizArbitraria
 
-- La propiedad es
prop_algunoMenor :: Matriz2 -> Bool
prop_algunoMenor (M p) =
  all (== algunoMenor1 p)
      [algunoMenor2 p,
       algunoMenor3 p,
       algunoMenor4 p,
       algunoMenor5 p]
 
-- La comprobación es
--    λ> quickCheck prop_algunoMenor
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> maximum (algunoMenor1 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (2.20 secs, 1,350,075,240 bytes)
--    λ> maximum (algunoMenor2 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (2.24 secs, 1,373,139,968 bytes)
--    λ> maximum (algunoMenor3 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (2.08 secs, 1,200,734,112 bytes)
--    λ> maximum (algunoMenor4 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (2.76 secs, 1,287,653,136 bytes)
--    λ> maximum (algunoMenor5 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (1.67 secs, 953,937,600 bytes)

import Data.Array (Array, (!), bounds, indices, inRange, listArray) import Test.QuickCheck (Arbitrary, Gen, arbitrary, chooseInt, quickCheck, vectorOf) type Matriz = Array (Int,Int) Int ej :: Matriz ej = listArray ((1,1),(3,4)) [9,4,6,5,8,1,7,3,4,2,5,4] type Pos = (Int,Int) -- 1ª solución -- =========== algunoMenor1 :: Matriz -> [Int] algunoMenor1 a = [a!p| p <- indices a, any (< a!p) (vecinos1 a p)] -- (vecinos q p) es la lista de los vecinos en la matriz a de la -- posición p. Por ejemplo, -- vecinos1 ej (2,2) == [9,4,6,8,7,4,2,5] -- vecinos1 ej (1,1) == [4,8,1] vecinos1 :: Matriz -> Pos -> [Int] vecinos1 a p = [a!p' | p' <- posicionesVecinos1 a p] -- (posicionesVecinos a p) es la lista de las posiciones de los -- vecino de p en la matriz a. Por ejemplo, -- λ> posicionesVecinos1 3 3 (2,2) -- [(1,1),(1,2),(1,3),(2,1),(2,3),(3,1),(3,2),(3,3)] -- λ> posicionesVecinos1 3 3 (1,1) -- [(1,2),(2,1),(2,2)] posicionesVecinos1 :: Matriz -> Pos -> [Pos] posicionesVecinos1 a (i,j) = [(i+di,j+dj) | (di,dj) <- [(-1,-1),(-1,0),(-1,1), ( 0,-1), ( 0,1), ( 1,-1),( 1,0),( 1,1)], inRange (bounds a) (i+di,j+dj)] -- 2ª solución -- =========== algunoMenor2 :: Matriz -> [Int] algunoMenor2 a = [a!p | p <- indices a, any (<a!p) (vecinos2 p)] where vecinos2 p = [a!p' | p' <- posicionesVecinos2 p] posicionesVecinos2 (i,j) = [(i+di,j+dj) | (di,dj) <- [(-1,-1),(-1,0),(-1,1), ( 0,-1), ( 0,1), ( 1,-1),( 1,0),( 1,1)], inRange (bounds a) (i+di,j+dj)] -- 3ª solución -- =========== algunoMenor3 :: Matriz -> [Int] algunoMenor3 a = [a!p | p <- indices a, any (<a!p) (vecinos3 p)] where vecinos3 p = [a!p' | p' <- posicionesVecinos3 p] posicionesVecinos3 (i,j) = [(i',j') | i' <- [i-1..i+1], j' <- [j-1..j+1], (i',j') /= (i,j), inRange (bounds a) (i',j')] -- 4ª solución -- =========== algunoMenor4 :: Matriz -> [Int] algunoMenor4 a = [a!p | p <- indices a, any (<a!p) (vecinos4 p)] where vecinos4 p = [a!p' | p' <- posicionesVecinos4 p] posicionesVecinos4 (i,j) = [(i',j') | i' <- [max 1 (i-1)..min m (i+1)], j' <- [max 1 (j-1)..min n (j+1)], (i',j') /= (i,j)] where (_,(m,n)) = bounds a -- 5ª solución -- =========== algunoMenor5 :: Matriz -> [Int] algunoMenor5 a = [a!p | p <- indices a, any (<a!p) (vecinos5 p)] where vecinos5 p = [a!p' | p' <- posicionesVecinos5 p] posicionesVecinos5 (i,j) = [(i-1,j-1) | i > 1, j > 1] ++ [(i-1,j) | i > 1] ++ [(i-1,j+1) | i > 1, j < n] ++ [(i,j-1) | j > 1] ++ [(i,j+1) | j < n] ++ [(i+1,j-1) | i < m, j > 1] ++ [(i+1,j) | i < m] ++ [(i+1,j+1) | i < m, j < n] where (_,(m,n)) = bounds a -- --------------------------------------------------------------------- -- Comprobación de equivalencia -- ============================ newtype Matriz2 = M Matriz deriving Show -- Generador de matrices arbitrarias. Por ejemplo, -- λ> generate matrizArbitraria -- M (array ((1,1),(3,4)) -- [((1,1),18),((1,2),6), ((1,3),-23),((1,4),-13), -- ((2,1),-2),((2,2),22),((2,3),-25),((2,4),-5), -- ((3,1),2), ((3,2),16),((3,3),-15),((3,4),7)]) matrizArbitraria :: Gen Matriz2 matrizArbitraria = do m <- chooseInt (1,10) n <- chooseInt (1,10) xs <- vectorOf (m*n) arbitrary return (M (listArray ((1,1),(m,n)) xs)) -- Matriz es una subclase de Arbitrary. instance Arbitrary Matriz2 where arbitrary = matrizArbitraria -- La propiedad es prop_algunoMenor :: Matriz2 -> Bool prop_algunoMenor (M p) = all (== algunoMenor1 p) [algunoMenor2 p, algunoMenor3 p, algunoMenor4 p, algunoMenor5 p] -- La comprobación es -- λ> quickCheck prop_algunoMenor -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> maximum (algunoMenor1 (listArray ((1,1),(600,800)) [0..])) -- 479999 -- (2.20 secs, 1,350,075,240 bytes) -- λ> maximum (algunoMenor2 (listArray ((1,1),(600,800)) [0..])) -- 479999 -- (2.24 secs, 1,373,139,968 bytes) -- λ> maximum (algunoMenor3 (listArray ((1,1),(600,800)) [0..])) -- 479999 -- (2.08 secs, 1,200,734,112 bytes) -- λ> maximum (algunoMenor4 (listArray ((1,1),(600,800)) [0..])) -- 479999 -- (2.76 secs, 1,287,653,136 bytes) -- λ> maximum (algunoMenor5 (listArray ((1,1),(600,800)) [0..])) -- 479999 -- (1.67 secs, 953,937,600 bytes)

El código se encuentra en GitHub.

La elaboración de las soluciones se describe en el siguiente vídeo

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>

Leer más →

Familias de números con algún dígito en común

José A. Alonso, 31-marzo-2022, Ejercicio

Una familia de números es una lista de números tal que todos tienen la misma cantidad de dígitos y, además, dichos números tienen al menos un dígito común.

Por ejemplo, los números 72, 32, 25 y 22 pertenecen a la misma familia ya que son números de dos dígitos y todos tienen el dígito 2, mientras que los números 123, 245 y 568 no pertenecen a la misma familia, ya que no hay un dígito que aparezca en los tres números.

Definir la función

   esFamilia :: [Integer] -> Bool

tal que (esFamilia ns) se verifica si ns es una familia de números. Por ejemplo,

   esFamilia [72, 32, 25, 22]  ==  True
   esFamilia [123,245,568]     ==  False
   esFamilia [72, 32, 25, 223] ==  False
   esFamilia [56]              ==  True
   esFamilia []                ==  True

Soluciones

import Data.List (intersect, nub)
import Test.QuickCheck (quickCheck)
 
-- 1ª solución
-- ===========
 
esFamilia1 :: [Integer] -> Bool
esFamilia1 [] = True
esFamilia1 ns =
  igualNumeroElementos dss && tieneElementoComun dss
  where dss = map show ns
 
-- (igualNumeroElementos xss) se verifica si todas las listas de xss
-- tienen el mismo número de elementos. Por ejemplo,
--    igualNumeroElementos [[1,3],[2,2],[4,9]]    ==  True
--    igualNumeroElementos [[1,3],[2,1,2],[4,9]]  ==  False
igualNumeroElementos :: [[a]] -> Bool
igualNumeroElementos xss =
  iguales (map length xss)
 
-- (iguales xs) se verifica si todos los elementos de xs son
-- iguales. Por ejemplo,
--    iguales [3,3,3,3]  ==  True
--    iguales [3,3,7,3]  ==  False
iguales :: Eq a => [a] -> Bool
iguales []     = True
iguales (x:xs) = all (==x) xs
 
-- (tieneElementoComun xss) se verifican si todas las listas de xss
-- tienen algún elemento común. Por ejemplo,
--    tieneElementoComun [[1,2],[2,3],[4,2,7]]  ==  True
--    tieneElementoComun [[1,2],[2,3],[4,3,7]]  ==  False
tieneElementoComun :: Eq a => [[a]] -> Bool
tieneElementoComun []       = False
tieneElementoComun (xs:xss) = any (`esElementoComun` xss) xs
 
-- (esElementoComun x yss) se verifica si x pertenece a todos los
-- elementos de yss. Por ejemplo,
--    esElementoComun 2 [[1,2],[2,3],[4,2,7]]  ==  True
--    esElementoComun 2 [[1,2],[2,3],[4,3,7]]  ==  False
esElementoComun :: Eq a => a -> [[a]] -> Bool
esElementoComun x = all (x `elem`)
 
-- 2ª solución
-- ===========
 
esFamilia2 :: [Integer] -> Bool
esFamilia2 [] = True
esFamilia2 ns =
  igualNumeroElementos2 dss && tieneElementoComun2 dss
  where dss = map show ns
 
igualNumeroElementos2 :: [[a]] -> Bool
igualNumeroElementos2 xss =
  length (nub (map length xss)) == 1
 
tieneElementoComun2 :: Eq a => [[a]] -> Bool
tieneElementoComun2 xss =
  not (null (foldl1 intersect xss))
 
-- 3ª solución
-- ===========
 
esFamilia3 :: [Integer] -> Bool
esFamilia3 [] = True
esFamilia3 ns =
  igualNumeroElementos3 dss && tieneElementoComun3 dss
  where dss = map show ns
 
igualNumeroElementos3 :: [[a]] -> Bool
igualNumeroElementos3 = ((==1) . length) . nub . map length
 
tieneElementoComun3 :: Eq a => [[a]] -> Bool
tieneElementoComun3 = (not . null) . foldl1 intersect
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_esFamilia :: [Integer] -> Bool
prop_esFamilia xss =
  all (== esFamilia1 xss)
      [esFamilia2 xss,
       esFamilia3 xss]
 
-- La comprobación es
--    λ> quickCheck prop_esFamilia
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> esFamilia1 [10^6..4*10^6]
--    False
--    (1.85 secs, 1,931,162,984 bytes)
--    λ> esFamilia2 [10^6..4*10^6]
--    False
--    (2.31 secs, 2,288,177,752 bytes)
--    λ> esFamilia3 [10^6..4*10^6]
--    False
--    (2.23 secs, 2,288,177,864 bytes)

import Data.List (intersect, nub) import Test.QuickCheck (quickCheck) -- 1ª solución -- =========== esFamilia1 :: [Integer] -> Bool esFamilia1 [] = True esFamilia1 ns = igualNumeroElementos dss && tieneElementoComun dss where dss = map show ns -- (igualNumeroElementos xss) se verifica si todas las listas de xss -- tienen el mismo número de elementos. Por ejemplo, -- igualNumeroElementos [[1,3],[2,2],[4,9]] == True -- igualNumeroElementos [[1,3],[2,1,2],[4,9]] == False igualNumeroElementos :: [[a]] -> Bool igualNumeroElementos xss = iguales (map length xss) -- (iguales xs) se verifica si todos los elementos de xs son -- iguales. Por ejemplo, -- iguales [3,3,3,3] == True -- iguales [3,3,7,3] == False iguales :: Eq a => [a] -> Bool iguales [] = True iguales (x:xs) = all (==x) xs -- (tieneElementoComun xss) se verifican si todas las listas de xss -- tienen algún elemento común. Por ejemplo, -- tieneElementoComun [[1,2],[2,3],[4,2,7]] == True -- tieneElementoComun [[1,2],[2,3],[4,3,7]] == False tieneElementoComun :: Eq a => [[a]] -> Bool tieneElementoComun [] = False tieneElementoComun (xs:xss) = any (`esElementoComun` xss) xs -- (esElementoComun x yss) se verifica si x pertenece a todos los -- elementos de yss. Por ejemplo, -- esElementoComun 2 [[1,2],[2,3],[4,2,7]] == True -- esElementoComun 2 [[1,2],[2,3],[4,3,7]] == False esElementoComun :: Eq a => a -> [[a]] -> Bool esElementoComun x = all (x `elem`) -- 2ª solución -- =========== esFamilia2 :: [Integer] -> Bool esFamilia2 [] = True esFamilia2 ns = igualNumeroElementos2 dss && tieneElementoComun2 dss where dss = map show ns igualNumeroElementos2 :: [[a]] -> Bool igualNumeroElementos2 xss = length (nub (map length xss)) == 1 tieneElementoComun2 :: Eq a => [[a]] -> Bool tieneElementoComun2 xss = not (null (foldl1 intersect xss)) -- 3ª solución -- =========== esFamilia3 :: [Integer] -> Bool esFamilia3 [] = True esFamilia3 ns = igualNumeroElementos3 dss && tieneElementoComun3 dss where dss = map show ns igualNumeroElementos3 :: [[a]] -> Bool igualNumeroElementos3 = ((==1) . length) . nub . map length tieneElementoComun3 :: Eq a => [[a]] -> Bool tieneElementoComun3 = (not . null) . foldl1 intersect -- Comprobación de equivalencia -- ============================ -- La propiedad es prop_esFamilia :: [Integer] -> Bool prop_esFamilia xss = all (== esFamilia1 xss) [esFamilia2 xss, esFamilia3 xss] -- La comprobación es -- λ> quickCheck prop_esFamilia -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> esFamilia1 [10^6..4*10^6] -- False -- (1.85 secs, 1,931,162,984 bytes) -- λ> esFamilia2 [10^6..4*10^6] -- False -- (2.31 secs, 2,288,177,752 bytes) -- λ> esFamilia3 [10^6..4*10^6] -- False -- (2.23 secs, 2,288,177,864 bytes)

El código se encuentra en GitHub.

La elaboración de las soluciones se describe en el siguiente vídeo

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>

Leer más →

Las sucesiones de Loomis

José A. Alonso, 22-mayo-2020, Medio

La sucesión de Loomis generada por un número entero positivo x es la sucesión cuyos términos se definen por

f(0) es x
f(n) es la suma de f(n-1) y el producto de los dígitos no nulos de f(n-1)

Los primeros términos de las primeras sucesiones de Loomis son

Generada por 1: 1, 2, 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, …
Generada por 2: 2, 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, …
Generada por 3: 3, 6, 12, 14, 18, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, …
Generada por 4: 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, 138, …
Generada por 5: 5, 10, 11, 12, 14, 18, 26, 38, 62, 74, 102, 104, 108, 116, 122, …

Se observa que a partir de un término todas coinciden con la generada por 1. Dicho término se llama el punto de convergencia. Por ejemplo,

la generada por 2 converge a 2
la generada por 3 converge a 26
la generada por 4 converge a 4
la generada por 5 converge a 26

Definir las siguientes funciones

   sucLoomis           :: Integer -> [Integer]
   convergencia        :: Integer -> Integer
   graficaConvergencia :: [Integer] -> IO ()

tales que

(sucLoomis x) es la sucesión de Loomis generada por x. Por ejemplo,

     λ> take 15 (sucLoomis 1)
     [1,2,4,8,16,22,26,38,62,74,102,104,108,116,122]
     λ> take 15 (sucLoomis 2)
     [2,4,8,16,22,26,38,62,74,102,104,108,116,122,126]
     λ> take 15 (sucLoomis 3)
     [3,6,12,14,18,26,38,62,74,102,104,108,116,122,126]
     λ> take 15 (sucLoomis 4)
     [4,8,16,22,26,38,62,74,102,104,108,116,122,126,138]
     λ> take 15 (sucLoomis 5)
     [5,10,11,12,14,18,26,38,62,74,102,104,108,116,122]
     λ> take 15 (sucLoomis 20)
     [20,22,26,38,62,74,102,104,108,116,122,126,138,162,174]
     λ> take 15 (sucLoomis 100)
     [100,101,102,104,108,116,122,126,138,162,174,202,206,218,234]
     λ> sucLoomis 1 !! (2*10^5)
     235180736652

(convergencia x) es el término de convergencia de la sucesioń de Loomis generada por x xon la geerada por 1. Por ejemplo,

     convergencia  2      ==  2
     convergencia  3      ==  26
     convergencia  4      ==  4
     convergencia 17      ==  38
     convergencia 19      ==  102
     convergencia 43      ==  162
     convergencia 27      ==  202
     convergencia 58      ==  474
     convergencia 63      ==  150056
     convergencia 81      ==  150056
     convergencia 89      ==  150056
     convergencia (10^12) ==  1000101125092

(graficaConvergencia xs) dibuja la gráfica de los términos de convergencia de las sucesiones de Loomis generadas por los elementos de xs. Por ejemplo, (graficaConvergencia ([1..50]) dibuja

y graficaConvergencia ([1..148] \ [63,81,89,137]) dibuja

Soluciones

import Data.List               ((\\))
import Data.Char               (digitToInt)
import Graphics.Gnuplot.Simple (plotList, Attribute (Key, Title, XRange, PNG))
 
-- 1ª definición de sucLoomis
-- ==========================
 
sucLoomis :: Integer -> [Integer]
sucLoomis x = map (loomis x) [0..]
 
loomis :: Integer -> Integer -> Integer
loomis x 0 = x
loomis x n = y + productoDigitosNoNulos y
  where y = loomis x (n-1)
 
productoDigitosNoNulos :: Integer -> Integer
productoDigitosNoNulos = product . digitosNoNulos
 
digitosNoNulos :: Integer -> [Integer]
digitosNoNulos x =
  [read [c] | c <- show x, c /= '0']
 
-- 2ª definición de sucLoomis
-- ==========================
 
sucLoomis2 :: Integer -> [Integer]
sucLoomis2 = iterate siguienteLoomis 
 
siguienteLoomis :: Integer -> Integer
siguienteLoomis y = y + productoDigitosNoNulos y
 
-- 3ª definición de sucLoomis
-- ==========================
 
sucLoomis3 :: Integer -> [Integer]
sucLoomis3 =
  iterate ((+) <*> product .
           map (toInteger . digitToInt) .
           filter (/= '0') . show)
 
-- Comparación de eficiencia
-- =========================
 
--    λ> sucLoomis 1 !! 30000
--    6571272766
--    (2.45 secs, 987,955,944 bytes)
--    λ> sucLoomis2 1 !! 30000
--    6571272766
--    (2.26 secs, 979,543,328 bytes)
--    λ> sucLoomis3 1 !! 30000
--    6571272766
--    (0.31 secs, 88,323,832 bytes)
 
-- 1ª definición de convergencia
-- =============================
 
convergencia1 :: Integer -> Integer
convergencia1 x =
  head (dropWhile noEnSucLoomisDe1 (sucLoomis x))
 
noEnSucLoomisDe1 :: Integer -> Bool
noEnSucLoomisDe1 x = not (pertenece x sucLoomisDe1)
 
sucLoomisDe1 :: [Integer]
sucLoomisDe1 = sucLoomis 1
 
pertenece :: Integer -> [Integer] -> Bool
pertenece x ys =
  x == head (dropWhile (<x) ys)
 
-- 2ª definición de convergencia
-- =============================
 
convergencia2 :: Integer -> Integer
convergencia2 = aux (sucLoomis3 1) . sucLoomis3
 where aux as@(x:xs) bs@(y:ys) | x == y    = x
                               | x < y     = aux xs bs
                               | otherwise = aux as ys
 
-- 3ª definición de convergencia
-- =============================
 
convergencia3 :: Integer -> Integer
convergencia3 = head . interseccion (sucLoomis3 1) . sucLoomis3
 
-- (interseccion xs ys) es la intersección entre las listas ordenadas xs
-- e ys. Por ejemplo,
--    λ> take 10 (interseccion (sucLoomis3 1) (sucLoomis3 2))
--    [2,4,8,16,22,26,38,62,74,102]
interseccion :: Ord a => [a] -> [a] -> [a]
interseccion = aux
  where aux as@(x:xs) bs@(y:ys) = case compare x y of
                                    LT ->     aux xs bs
                                    EQ -> x : aux xs ys
                                    GT ->     aux as ys
        aux _         _         = []                           
 
-- 4ª definición de convergencia
-- =============================
 
convergencia4 :: Integer -> Integer
convergencia4 x = perteneceA (sucLoomis3 x) 1
  where perteneceA (y:ys) n | y == c    = y
                            | otherwise = perteneceA ys c
          where c = head $ dropWhile (< y) $ sucLoomis3 n
 
-- Comparación de eficiencia
-- =========================
 
--    λ> convergencia1 (10^4)
--    150056
--    (2.94 secs, 1,260,809,808 bytes)
--    λ> convergencia2 (10^4)
--    150056
--    (0.03 secs, 700,240 bytes)
--    λ> convergencia3 (10^4)
--    150056
--    (0.03 secs, 1,165,496 bytes)
--    λ> convergencia4 (10^4)
--    150056
--    (0.02 secs, 1,119,648 bytes)
--    
--    λ> convergencia2 (10^12)
--    1000101125092
--    (1.81 secs, 714,901,080 bytes)
--    λ> convergencia3 (10^12)
--    1000101125092
--    (1.92 secs, 744,932,184 bytes)
--    λ> convergencia4 (10^12)
--    1000101125092
--    (1.82 secs, 941,053,328 bytes)
 
-- Definición de graficaConvergencia
-- ==================================
 
graficaConvergencia :: [Integer] -> IO ()
graficaConvergencia xs =
  plotList [ Key Nothing
           , Title "Convergencia de sucesiones de Loomis"
           , XRange (fromIntegral (minimum xs),fromIntegral (maximum xs))
           , PNG "Las_sucesiones_de_Loomis_2.png"
           ]
           [(x,convergencia2 x) | x <- xs]

import Data.List ((\\)) import Data.Char (digitToInt) import Graphics.Gnuplot.Simple (plotList, Attribute (Key, Title, XRange, PNG)) -- 1ª definición de sucLoomis -- ========================== sucLoomis :: Integer -> [Integer] sucLoomis x = map (loomis x) [0..] loomis :: Integer -> Integer -> Integer loomis x 0 = x loomis x n = y + productoDigitosNoNulos y where y = loomis x (n-1) productoDigitosNoNulos :: Integer -> Integer productoDigitosNoNulos = product . digitosNoNulos digitosNoNulos :: Integer -> [Integer] digitosNoNulos x = [read [c] | c <- show x, c /= '0'] -- 2ª definición de sucLoomis -- ========================== sucLoomis2 :: Integer -> [Integer] sucLoomis2 = iterate siguienteLoomis siguienteLoomis :: Integer -> Integer siguienteLoomis y = y + productoDigitosNoNulos y -- 3ª definición de sucLoomis -- ========================== sucLoomis3 :: Integer -> [Integer] sucLoomis3 = iterate ((+) <*> product . map (toInteger . digitToInt) . filter (/= '0') . show) -- Comparación de eficiencia -- ========================= -- λ> sucLoomis 1 !! 30000 -- 6571272766 -- (2.45 secs, 987,955,944 bytes) -- λ> sucLoomis2 1 !! 30000 -- 6571272766 -- (2.26 secs, 979,543,328 bytes) -- λ> sucLoomis3 1 !! 30000 -- 6571272766 -- (0.31 secs, 88,323,832 bytes) -- 1ª definición de convergencia -- ============================= convergencia1 :: Integer -> Integer convergencia1 x = head (dropWhile noEnSucLoomisDe1 (sucLoomis x)) noEnSucLoomisDe1 :: Integer -> Bool noEnSucLoomisDe1 x = not (pertenece x sucLoomisDe1) sucLoomisDe1 :: [Integer] sucLoomisDe1 = sucLoomis 1 pertenece :: Integer -> [Integer] -> Bool pertenece x ys = x == head (dropWhile (<x) ys) -- 2ª definición de convergencia -- ============================= convergencia2 :: Integer -> Integer convergencia2 = aux (sucLoomis3 1) . sucLoomis3 where aux as@(x:xs) bs@(y:ys) | x == y = x | x < y = aux xs bs | otherwise = aux as ys -- 3ª definición de convergencia -- ============================= convergencia3 :: Integer -> Integer convergencia3 = head . interseccion (sucLoomis3 1) . sucLoomis3 -- (interseccion xs ys) es la intersección entre las listas ordenadas xs -- e ys. Por ejemplo, -- λ> take 10 (interseccion (sucLoomis3 1) (sucLoomis3 2)) -- [2,4,8,16,22,26,38,62,74,102] interseccion :: Ord a => [a] -> [a] -> [a] interseccion = aux where aux as@(x:xs) bs@(y:ys) = case compare x y of LT -> aux xs bs EQ -> x : aux xs ys GT -> aux as ys aux _ _ = [] -- 4ª definición de convergencia -- ============================= convergencia4 :: Integer -> Integer convergencia4 x = perteneceA (sucLoomis3 x) 1 where perteneceA (y:ys) n | y == c = y | otherwise = perteneceA ys c where c = head $ dropWhile (< y) $ sucLoomis3 n -- Comparación de eficiencia -- ========================= -- λ> convergencia1 (10^4) -- 150056 -- (2.94 secs, 1,260,809,808 bytes) -- λ> convergencia2 (10^4) -- 150056 -- (0.03 secs, 700,240 bytes) -- λ> convergencia3 (10^4) -- 150056 -- (0.03 secs, 1,165,496 bytes) -- λ> convergencia4 (10^4) -- 150056 -- (0.02 secs, 1,119,648 bytes) -- -- λ> convergencia2 (10^12) -- 1000101125092 -- (1.81 secs, 714,901,080 bytes) -- λ> convergencia3 (10^12) -- 1000101125092 -- (1.92 secs, 744,932,184 bytes) -- λ> convergencia4 (10^12) -- 1000101125092 -- (1.82 secs, 941,053,328 bytes) -- Definición de graficaConvergencia -- ================================== graficaConvergencia :: [Integer] -> IO () graficaConvergencia xs = plotList [ Key Nothing , Title "Convergencia de sucesiones de Loomis" , XRange (fromIntegral (minimum xs),fromIntegral (maximum xs)) , PNG "Las_sucesiones_de_Loomis_2.png" ] [(x,convergencia2 x) | x <- xs]

Leer más →

Mayor capicúa producto de dos números de n cifras

José A. Alonso, 29-abril-2020, Inicial

Un capicúa es un número que es igual leído de izquierda a derecha que de derecha a izquierda.

Definir la función

   mayorCapicuaP :: Integer -> Integer

tal que (mayorCapicuaP n) es el mayor capicúa que es el producto de dos números de n cifras. Por ejemplo,

   mayorCapicuaP 2  ==  9009
   mayorCapicuaP 3  ==  906609
   mayorCapicuaP 4  ==  99000099
   mayorCapicuaP 5  ==  9966006699
   mayorCapicuaP 6  ==  999000000999
   mayorCapicuaP 7  ==  99956644665999

Soluciones

-- 1ª solución
-- ===========
 
mayorCapicuaP1 :: Integer -> Integer
mayorCapicuaP1 n = head (capicuasP n)
 
-- (capicuasP n) es la lista de las capicúas de 2*n cifras que
-- pueden escribirse como productos de dos números de n cifras. Por
-- ejemplo, Por ejemplo,
--    ghci> capicuasP 2
--    [9009,8448,8118,8008,7227,7007,6776,6336,6006,5775,5445,5335,
--     5225,5115,5005,4884,4774,4664,4554,4224,4004,3773,3663,3003,
--     2992,2772,2552,2442,2332,2112,2002,1881,1771,1551,1221,1001]
capicuasP n = [x | x <- capicuas n,
                        not (null (productosDosNumerosCifras n x))]
 
-- (capicuas n) es la lista de las capicúas de 2*n cifras de mayor a
-- menor. Por ejemplo, 
--    capicuas 1           ==  [99,88,77,66,55,44,33,22,11]
--    take 7 (capicuas 2)  ==  [9999,9889,9779,9669,9559,9449,9339]
capicuas :: Integer -> [Integer]
capicuas n = [capicua x | x <- numerosCifras n]
 
-- (numerosCifras n) es la lista de los números de n cifras de mayor a
-- menor. Por ejemplo,
--    numerosCifras 1           ==  [9,8,7,6,5,4,3,2,1]
--    take 7 (numerosCifras 2)  ==  [99,98,97,96,95,94,93]
--    take 7 (numerosCifras 3)  ==  [999,998,997,996,995,994,993]
numerosCifras :: Integer -> [Integer]
numerosCifras n = [a,a-1..b]
  where a = 10^n-1
        b = 10^(n-1) 
 
-- (capicua n) es la capicúa formada añadiendo el inverso de n a
--  continuación de n. Por ejemplo,
--    capicua 93  ==  9339
capicua :: Integer -> Integer
capicua n = read (xs ++ (reverse xs))
  where xs = show n
 
-- (productosDosNumerosCifras n x) es la lista de los números y de n
-- cifras tales que existe un z de n cifras y x es el producto de y por
-- z. Por ejemplo, 
--    productosDosNumerosCifras 2 9009  ==  [99,91]
productosDosNumerosCifras n x = [y | y <- numeros,
                                     mod x y == 0,
                                     div x y `elem` numeros]
  where numeros = numerosCifras n
 
-- 2ª solución
-- ===========
 
mayorCapicuaP2 :: Integer -> Integer
mayorCapicuaP2 n = maximum [x*y | x <- [a,a-1..b],
                                  y <- [a,a-1..b],
                                  esCapicua (x*y)] 
  where a = 10^n-1
        b = 10^(n-1)
 
-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,
--    esCapicua 353  ==  True
--    esCapicua 357  ==  False
esCapicua :: Integer -> Bool
esCapicua n = xs == reverse xs
  where xs = show n
 
-- 3ª solución
-- ===========
 
mayorCapicuaP3 :: Integer -> Integer
mayorCapicuaP3 n = maximum [x*y | (x,y) <- pares a b, 
                                  esCapicua (x*y)] 
  where a = 10^n-1
        b = 10^(n-1)
 
-- (pares a b) es la lista de los pares de números entre a y b de forma
-- que su suma es decreciente. Por ejemplo,
--    pares 9 7  ==  [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]
pares a b = [(x,z-x) | z <- [a1,a1-1..b1],
                       x <- [a,a-1..b],
                       x <= z-x, z-x <= a]
  where a1 = 2*a
        b1 = 2*b
 
-- 4ª solución
-- ===========
 
mayorCapicuaP4 :: Integer -> Integer
mayorCapicuaP4 n = maximum [x | y <- [a..b],
                                z <- [y..b],
                                let x = y * z,
                                let s = show x,
                                s == reverse s]
  where a = 10^(n-1)
        b = 10^n-1
 
-- 5ª solución
-- ===========
 
mayorCapicuaP5 :: Integer -> Integer
mayorCapicuaP5 n = maximum [x*y | (x,y) <- pares2 b a, esCapicua (x*y)]
  where a = 10^(n-1)
        b = 10^n-1
 
-- (pares2 a b) es la lista de los pares de números entre a y b de forma
-- que su suma es decreciente. Por ejemplo,
--    pares2 9 7  ==  [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]
pares2 a b = [(x,y) | x <- [a,a-1..b], y <- [a,a-1..x]]
 
-- 6ª solución
-- ===========
 
mayorCapicuaP6 :: Integer -> Integer
mayorCapicuaP6 n = maximum [x*y | x <- [a..b], 
                                  y <- [x..b] , 
                                  esCapicua (x*y)]
  where a = 10^(n-1)
        b = 10^n-1
 
-- (cifras n) es la lista de las cifras de n en orden inverso. Por
-- ejemplo,  
--    cifras 325  == [5,2,3]
cifras :: Integer -> [Integer]
cifras n 
    | n < 10    = [n]
    | otherwise = (ultima n) : (cifras (quitarUltima n))
 
-- (ultima n) es la última cifra de n. Por ejemplo,
--    ultima 325  ==  5
ultima  :: Integer -> Integer
ultima n =  n - (n `div` 10)*10
 
-- (quitarUltima n) es el número obtenido al quitarle a n su última
-- cifra. Por ejemplo,
--    quitarUltima 325  =>  32 
quitarUltima :: Integer -> Integer
quitarUltima n = (n - (ultima n)) `div` 10
 
-- 7ª solución
-- ===========
 
mayorCapicuaP7 :: Integer -> Integer
mayorCapicuaP7 n = head [x | x <- capicuas n, esFactorizable x n]
 
-- (esFactorizable x n) se verifica si x se puede escribir como producto
-- de dos números de n dígitos. Por ejemplo,
--    esFactorizable 1219 2  ==  True
--    esFactorizable 1217 2  ==  False
esFactorizable x n = aux i x
  where b = 10^n-1
        i = floor (sqrt (fromIntegral x))
        aux i x | i > b          = False
                | x `mod` i == 0 = x `div` i < b 
                | otherwise      = aux (i+1) x
 
-- Comparación de eficiencia
-- =========================
 
--    λ> mayorCapicuaP1 3
--    906609
--    (0.07 secs, 18,248,224 bytes)
--    λ> mayorCapicuaP2 3
--    906609
--    (0.51 secs, 555,695,720 bytes)
--    λ> mayorCapicuaP3 3
--    906609
--    (0.96 secs, 780,794,768 bytes)
--    λ> mayorCapicuaP4 3
--    906609
--    (0.24 secs, 255,445,448 bytes)
--    λ> mayorCapicuaP5 3
--    906609
--    (0.33 secs, 317,304,080 bytes)
--    λ> mayorCapicuaP6 3
--    906609
--    (0.26 secs, 274,987,472 bytes)
--    λ> mayorCapicuaP7 3
--    906609
--    (0.02 secs, 1,807,720 bytes)
--    
--    λ> mayorCapicuaP1 5
--    9966006699
--    (9.90 secs, 6,349,454,544 bytes)
--    λ> mayorCapicuaP7 5
--    9966006699
--    (0.06 secs, 15,958,616 bytes)

-- 1ª solución -- =========== mayorCapicuaP1 :: Integer -> Integer mayorCapicuaP1 n = head (capicuasP n) -- (capicuasP n) es la lista de las capicúas de 2*n cifras que -- pueden escribirse como productos de dos números de n cifras. Por -- ejemplo, Por ejemplo, -- ghci> capicuasP 2 -- [9009,8448,8118,8008,7227,7007,6776,6336,6006,5775,5445,5335, -- 5225,5115,5005,4884,4774,4664,4554,4224,4004,3773,3663,3003, -- 2992,2772,2552,2442,2332,2112,2002,1881,1771,1551,1221,1001] capicuasP n = [x | x <- capicuas n, not (null (productosDosNumerosCifras n x))] -- (capicuas n) es la lista de las capicúas de 2*n cifras de mayor a -- menor. Por ejemplo, -- capicuas 1 == [99,88,77,66,55,44,33,22,11] -- take 7 (capicuas 2) == [9999,9889,9779,9669,9559,9449,9339] capicuas :: Integer -> [Integer] capicuas n = [capicua x | x <- numerosCifras n] -- (numerosCifras n) es la lista de los números de n cifras de mayor a -- menor. Por ejemplo, -- numerosCifras 1 == [9,8,7,6,5,4,3,2,1] -- take 7 (numerosCifras 2) == [99,98,97,96,95,94,93] -- take 7 (numerosCifras 3) == [999,998,997,996,995,994,993] numerosCifras :: Integer -> [Integer] numerosCifras n = [a,a-1..b] where a = 10^n-1 b = 10^(n-1) -- (capicua n) es la capicúa formada añadiendo el inverso de n a -- continuación de n. Por ejemplo, -- capicua 93 == 9339 capicua :: Integer -> Integer capicua n = read (xs ++ (reverse xs)) where xs = show n -- (productosDosNumerosCifras n x) es la lista de los números y de n -- cifras tales que existe un z de n cifras y x es el producto de y por -- z. Por ejemplo, -- productosDosNumerosCifras 2 9009 == [99,91] productosDosNumerosCifras n x = [y | y <- numeros, mod x y == 0, div x y `elem` numeros] where numeros = numerosCifras n -- 2ª solución -- =========== mayorCapicuaP2 :: Integer -> Integer mayorCapicuaP2 n = maximum [x*y | x <- [a,a-1..b], y <- [a,a-1..b], esCapicua (x*y)] where a = 10^n-1 b = 10^(n-1) -- (esCapicua x) se verifica si x es capicúa. Por ejemplo, -- esCapicua 353 == True -- esCapicua 357 == False esCapicua :: Integer -> Bool esCapicua n = xs == reverse xs where xs = show n -- 3ª solución -- =========== mayorCapicuaP3 :: Integer -> Integer mayorCapicuaP3 n = maximum [x*y | (x,y) <- pares a b, esCapicua (x*y)] where a = 10^n-1 b = 10^(n-1) -- (pares a b) es la lista de los pares de números entre a y b de forma -- que su suma es decreciente. Por ejemplo, -- pares 9 7 == [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)] pares a b = [(x,z-x) | z <- [a1,a1-1..b1], x <- [a,a-1..b], x <= z-x, z-x <= a] where a1 = 2*a b1 = 2*b -- 4ª solución -- =========== mayorCapicuaP4 :: Integer -> Integer mayorCapicuaP4 n = maximum [x | y <- [a..b], z <- [y..b], let x = y * z, let s = show x, s == reverse s] where a = 10^(n-1) b = 10^n-1 -- 5ª solución -- =========== mayorCapicuaP5 :: Integer -> Integer mayorCapicuaP5 n = maximum [x*y | (x,y) <- pares2 b a, esCapicua (x*y)] where a = 10^(n-1) b = 10^n-1 -- (pares2 a b) es la lista de los pares de números entre a y b de forma -- que su suma es decreciente. Por ejemplo, -- pares2 9 7 == [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)] pares2 a b = [(x,y) | x <- [a,a-1..b], y <- [a,a-1..x]] -- 6ª solución -- =========== mayorCapicuaP6 :: Integer -> Integer mayorCapicuaP6 n = maximum [x*y | x <- [a..b], y <- [x..b] , esCapicua (x*y)] where a = 10^(n-1) b = 10^n-1 -- (cifras n) es la lista de las cifras de n en orden inverso. Por -- ejemplo, -- cifras 325 == [5,2,3] cifras :: Integer -> [Integer] cifras n | n < 10 = [n] | otherwise = (ultima n) : (cifras (quitarUltima n)) -- (ultima n) es la última cifra de n. Por ejemplo, -- ultima 325 == 5 ultima :: Integer -> Integer ultima n = n - (n `div` 10)*10 -- (quitarUltima n) es el número obtenido al quitarle a n su última -- cifra. Por ejemplo, -- quitarUltima 325 => 32 quitarUltima :: Integer -> Integer quitarUltima n = (n - (ultima n)) `div` 10 -- 7ª solución -- =========== mayorCapicuaP7 :: Integer -> Integer mayorCapicuaP7 n = head [x | x <- capicuas n, esFactorizable x n] -- (esFactorizable x n) se verifica si x se puede escribir como producto -- de dos números de n dígitos. Por ejemplo, -- esFactorizable 1219 2 == True -- esFactorizable 1217 2 == False esFactorizable x n = aux i x where b = 10^n-1 i = floor (sqrt (fromIntegral x)) aux i x | i > b = False | x `mod` i == 0 = x `div` i < b | otherwise = aux (i+1) x -- Comparación de eficiencia -- ========================= -- λ> mayorCapicuaP1 3 -- 906609 -- (0.07 secs, 18,248,224 bytes) -- λ> mayorCapicuaP2 3 -- 906609 -- (0.51 secs, 555,695,720 bytes) -- λ> mayorCapicuaP3 3 -- 906609 -- (0.96 secs, 780,794,768 bytes) -- λ> mayorCapicuaP4 3 -- 906609 -- (0.24 secs, 255,445,448 bytes) -- λ> mayorCapicuaP5 3 -- 906609 -- (0.33 secs, 317,304,080 bytes) -- λ> mayorCapicuaP6 3 -- 906609 -- (0.26 secs, 274,987,472 bytes) -- λ> mayorCapicuaP7 3 -- 906609 -- (0.02 secs, 1,807,720 bytes) -- -- λ> mayorCapicuaP1 5 -- 9966006699 -- (9.90 secs, 6,349,454,544 bytes) -- λ> mayorCapicuaP7 5 -- 9966006699 -- (0.06 secs, 15,958,616 bytes)

Leer más →

Etiqueta: not

Elementos de una matriz con algún vecino menor

Soluciones

Nuevas soluciones

Familias de números con algún dígito en común

Soluciones

Nuevas soluciones

Las sucesiones de Loomis

Soluciones

Mayor capicúa producto de dos números de n cifras

Soluciones

Subscribe to Blog via Email

Entradas recientes

Etiquetas